Keys in the vicinity

Question

What I want to do is to recognize keys in the image and create a list of keys around every key that fall within a pentagonal (or similar) region. These are the ones that can be accidentally pressed instead of the intended key. For the following case, the keys around 'y' will be y->{6,7,t,u g h}. For keys at the edges there would be fewer adjacent keys. Any convenient output format will do.

I have seen 27045, but could not get it to work with this keyboard image. To get a fresh image:

img=Import["https://i.stack.imgur.com/le9Jz.png"];

Your help is appreciated. Thanks.

Answer 1

Since I consider image recognizing code as a waste of time and typing keys of keyboard in sequence as pretty easy I produced the following code.

keyboard = 
  Characters@
   StringSplit[
    "Q W E R T Y U I O P\n A S D F G H J K L\n  Z X C V B N M", 
    "\n"];(*keys of keyboard separated and aligned with spaces*)
Grid[keyboard]
keys = DeleteCases[Flatten[keyboard], " " | "\n"];
coo = ({1, -2}*Reverse@First@Position[keyboard, #] & /@ keys);
gr = NearestNeighborGraph[coo, {All, 3}, 
   VertexLabels -> Thread[coo -> (Placed[#, Above] & /@ keys)]];
gr = VertexReplace[gr, Thread[coo -> keys]]
# -> AdjacencyList[gr, #] &@"Y"
# -> AdjacencyList[gr, #] &@"A"
# -> AdjacencyList[gr, #] &@"D"

(* "Y" -> {"T", "U", "G", "H"} *)
(* "A" -> {"Q", "W", "S", "Z"} *)
(* "D" -> {"E", "R", "S", "F", "X", "C"} *)

With

keyboard = 
  Characters@
   StringSplit[
    "1 2 3 4 5 6 7 8 9 0\n Q W E R T Y U I O P\n  A S D F G H J K L\n \
  Z X C V B N M", "\n"];

"Y" -> {"6", "7", "T", "U", "G", "H"}
"A" -> {"Q", "W", "S", "Z"}
"D" -> {"E", "R", "S", "F", "X", "C"}

Answer 2

kb = Reverse @ 
  TakeList[Characters["1234567890qwertyuiopasdfghjklzxcvbnm"], {10, 10, 9, 7}]; 

 vLabels = Join @@ 
  MapIndexed[{1, Sqrt[3]/2} Reverse@#2 - {(#2[[1]] - 1)/2, 0} -> # &, kb, {2}];


qwertyGraph = 
 VertexReplace[#, vLabels] & @ 
  NearestNeighborGraph[Keys @ vLabels, 
  VertexLabels -> Placed["Name", Center], 
  VertexSize -> Large, 
  VertexLabelStyle -> 14]

VertexComponent[qwertyGraph, "t", 1]

{"t", "f", "g", "r", "y", "5", "6"}

VertexComponent[qwertyGraph, "b", 1]

{"b", "v", "n", "g", "h"}

Select[DictionaryWordQ] @
 MapApply[StringJoin] @
  Tuples @  
   Map[VertexComponent[qwertyGraph, #, 1] &] @ 
     Characters["hello"]

{"hello", "brook", "jello"}

---

EDIT by OP

With the dictionary available and the task enunciated in the post mentioned in the comments:

Clear[adjChecker];
adjChecker[k_String] := 
 And @@ (MemberQ[VertexComponent[qwertyGraph, #2, 1], #1] & @@@ 
    Partition[Characters@k, 2, 1])
Select[DictionaryLookup[], adjChecker] // SortBy[StringLength]

{"a", "I", "as", "dc", "er", "es", "lo", "oi", "re", "uh", "we",
"ass", "awe", "dew", "ere", "err", "ewe", "huh", "loo", "lop", "oik", \ "poi", "pol", "pop", "red", "saw", "see", "sew", "was", "wed", "wee", \ "WWW", "awed", "awes", "deed", "deer", "dews", "drew", "ewer", \ "ewes", "free", "kook", "loll", "look", "loop", "plop", "poll", \ "polo", "pool", "poop", "reds", "reed", "sass", "saws", "seed", \ "seer", "sees", "sere", "serf", "sews", "tree", "weds", "weed", \ "weer", "wees", "were", "asses", "deeds", "deres", "dress", "erred", \ "freed", "freer", "frees", "reeds", "resew", "rewed", "sawed", \ "seeds", "sered", "serer", "seres", "sewed", "sewer", "swede", \ "treed", "trees", "tress", "trews", "wases", "weeds", "assert", \ "assess", "deeded", "desert", "lollop", "qwerty", "redder", "redrew", \ "reseed", "resews", "reweds", "sassed", "sasses", "seeded", "seeder", \ "seesaw", "swedes", "wedded", "wedder", "weeded", "weeder", \ "dessert", "dressed", "dresser", "dresses", "redress", "reseeds", \ "resewed", "seesaws", "tresses", "assessed", "assesses", "reseeded", \ "rewedded", "seesawed", "redressed", "redresses"}