Deleting Lonely Numbers From a List

list = {1, 2, 5, 6, 8, 10, 11, 12, 14, 16, 17, 18, 19};

With[{nf = Nearest[#], l = #},
   Pick[l, EuclideanDistance @@@ Transpose[{l, nf[#, 2][[2]] & /@ l}],1]] &@list

(* {1, 2, 5, 6, 10, 11, 12, 16, 17, 18, 19} *)

For larger lists, this should be pretty snappy:

Pick[#, Min /@ 
   Transpose@Differences[{Most@Prepend[#, #[[1]] - 2], #, 
                         Rest@Append[#, #[[-1]] + 2]}], 1 | 0] &@list

Lastly, assuming your OP list is an exemplar (sorted and unique elements), this is very fast:

With[{p = Join[#[[{1}]] - 2, #, #[[{-1}]] + 2]},
  Union[Pick[#, Subtract[#, p[[;; -3]]], 1], Pick[#, Subtract[p[[3 ;;]], #], 1]]] &

notLonelyQ[{a_, b_, c_}] := If[b - a == 1 || c - b == 1, True, False]
removeLonely[list_] := Pick[
  list,
  notLonelyQ /@ Partition[list, 3, 1, {2, 2}]
  ]

Example:

removeLonely[list]
(* Out: {1, 2, 5, 6, 10, 11, 12, 16, 17, 18, 19} *)

It treats the list as if it were cyclical, so it compares the last element with the first and the first element with the last. But since the list is sorted this should not be a problem. "Code-golfed"/more compact version:

Pick[list, If[#2 - #1 == 1 || #3 - #2 == 1, True, False] & @@@ Partition[list, 3, 1, 2]]

This is faster than the more verbose version, because it is known that anonymous functions are faster than pre-defined if they are otherwise equivalent.

Another way of doing it with a centered MovingMap :

DeleteCases[MovingMap[If[MemberQ[Abs@Differences@#, 1], #[[2]]] &, 
 list, {3, Center}, 2], Null]