I am trying to create a code that can identify the following terms in a grid of letters: MATHEMATICA, STACK, EXCHANGE and USERS.
list1={"M","S","T","A","S","I","S","X","X","T","R","X"};
list2={"A ","T ","H ","X ","R ","X ","G ","R ","S ","H ","X ","A"};
list3={"M","A","T","H","E","M","A","T","I","C","A","I"};
list4={"A","X","S","G","S","X","A","I","R","T","X","T"};
list5={"T","I","T","G","U","C","C","I","R","N","X","A"};
list6={"T","A","S","X","K","G","X","H","X","A","R","C"};
list7={"H","E","R","S","I","S","G","X","A","C","E","C"};
list8={"E","H","T","H","T","I","A","T","X","N","X","X"};
list9={"S","H","H","S","R","S","X","X","S","X","G","X"};
list10={"S","G","A","S","T","A","E","G","A","G","X","E"};
listAll={list1,list2,list3,list4,list5,list6,list7,list8,list9,list10};
Find[listAll,"MATHEMATICA"];
Find[listAll,"STACK"];
Find[listAll,"EXCHANGE"];
Find[listAll,"USERS"];
I am thinking that this command would not be the most appropriate
Animation (Ilustrative):

How can I create more practical way to list "listAll"?
Answer
Here we go...
highlightString[board_, str_] := With[{l = Characters[str]},
board // horizontal[l] // vertical[l] // diagonal[l] // diagonalReversed[l]]
horizontal[letters_][board_] := applyStyle[letters] /@ board
vertical[letters_][board_] := Transpose[applyStyle[letters] /@ Transpose[board]]
diagonal[letters_][board_] := diagonalD[applyStyle[letters] /@ diagonalU[board]]
diagonalReversed[letters_][board_] := diagonalU[applyStyle[letters] /@ diagonalD[board]]
diagonalU[board_] := Transpose@MapIndexed[RotateLeft]@Transpose[board]
diagonalD[board_] := Transpose@MapIndexed[RotateRight]@Transpose[board]
style[character_] := Style[character, Bold, Red]
style[character_Style] := character
applyStyle[letters_][row_] := MapAt[style, row, position[row, letters]]
position[row_, letters_] := Span /@ SequencePosition[row, pattern[letters]]
pattern[letters_] := Alternatives[#, Reverse[#]] &[Alternatives[#, Style[#, ___]] & /@ letters]
Grid[
Fold[highlightString, listAll, {"MATHEMATICA", "USER", "STACK", "EXCHANGE"}],
Background -> LightBrown, Frame -> True
]

Note: The grid of letters in the OP contains letters such as "A ", and "M ", with spaces in them. To fix this, run
listAll = Map[StringTrim, listAll, {2}];
Comments
Post a Comment