CRAZY EIGHTS puzzle

Question

The Sunday New York Times magazine has a puzzle, CRAZY EIGHTS such as this:

The goal is to fill in the $4 \times 4$ unfilled squares with letters to make valid 8-letter words reading both horizontally and vertically.

The horizontal words in the solution are:

CONCEALS, UNEARNED, PHYSIQUE, HABITUAL

and the vertical words in the solution are:

HONEYBEE, OCCASION, APEARITIF, TRANQUIL

The way to get candidate words for a single line are shown in this example:

 `DictionaryLookup["ho"<>_<>_<>_<>_<>"ls"]`

How to code the full solution to the puzzle?

Answer 1

First, we'll search all the choices for the given row/column, then we check their StringTake[ ... , {3,-3}] with transpose and return the first item it finds.

I hardcoded the loops (since the structure probably won't change).

ClearAll[solveCrazyEight];

solveCrazyEight[horizontalWords_,verticalWords_]:=Block[{h1Choices,h2Choices,h3Choices,h4Choices,v1Choices,v2Choices,v3Choices,v4Choices},

{h1Choices,h2Choices,h3Choices,h4Choices,v1Choices,v2Choices,v3Choices,v4Choices}=
DictionaryLookup[StringExpression@@Riffle[#,Repeated[_,{4}]],IgnoreCase->True]&/@Catenate@Outer[StringTake,{horizontalWords,verticalWords},{2,-2}];

Do[If[StringTake[{v1,v2,v3,v4},{3,-3}]==(StringJoin/@Transpose@Characters[StringTake[{h1,h2,h3,h4},{3,-3}]]),Return[{h1,h2,h3,h4,v1,v2,v3,v4}]]
,{h1,h1Choices},{h2,h2Choices},{h3,h3Choices},{h4,h4Choices},{v1,v1Choices},{v2,v2Choices},{v3,v3Choices},{v4,v4Choices}]//AbsoluteTiming
]

Example:

The first timing is for the whole operation, second is for finding the right combination:

solveCrazyEight[{"cols", "uned", "phue", "haal"}, {"hoee", "ocon", "apif", "tril"}] // AbsoluteTiming

(* Out: {0.121019, {0.0132017, {"conceals", "unearned", "physique", "habitual",
                                "honeybee", "occasion", "aperitif", "tranquil" }}} *)

As for the other puzzle, it takes a little more time:

solveCrazyEight[{"leds", "mani", "ints", "vice"}, {"knff", "poes", "stts", "maed"}] // AbsoluteTiming

(* Out: {0.438258, {0.32986, {"leotards", "macaroni", "inkblots", "violence", 
                              "knockoff", "potables", "starlets", "marooned" }}} *)

Answer 2

A 2D array of string patterns

Here I define a function that creates a SparseArray with string patterns defining the constraints available

createpattern[l1_,l2_]:= SparseArray[
{
{1|2|7|8,1|2|7|8}->"",
Splice@Flatten[Thread/@Thread[Outer[List,{3,4,5,6},{1,2,7,8}]->Characters[l1]]],
Splice@Flatten[Thread/@Thread[Outer[Reverse@*List,{3,4,5,6},{1,2,7,8}]->Characters[ l2]]]
}
,{8,8}
,_]

Now we set the problem copying the format proposed by @BenIzd

pattern=createpattern[
   {"cols", "uned", "phue", "haal"},
   {"hoee", "ocon", "apif", "tril"}
];

Now I define some auxiliary functions to solve the problem

updatepattern[pat_]:= ReplaceAll[#,{{a_}:>a,List:>Alternatives}]&/@
Union/@Transpose@Map[
   Characters,
   ToLowerCase@DictionaryLookup[Apply[StringExpression,Normal@pat],IgnoreCase->True]
]
updaterow[n_]:=(pattern[[n]]=updatepattern[pattern[[n]]];)
updatecol[n_]:=(pattern[[All,n]]=updatepattern[pattern[[All,n]]];)

To solve, the pattern defined by columns or rows is given as an argument to DictionaryLookup and a new pattern is defined based on the possible word matching.

For example, on row 6, with an original pattern {"h","a",_,_,_,_,"a","l"} only the words "habitual" and "Hannibal" are possible, so the new pattern for that row is now {"h","a","b"|"n","i"|"n","i"|"t","b"|"u","a","l"}

This way each new DictionaryLookup takes advantage of what was learned on previous searches. Now we only need to apply the update to all columns and rows.

AbsoluteTiming[  
   Table[
     updaterow[k];
     updatecol[k];
     ,{k,{3,4,5,6}}
   ];
MatrixForm@Normal[pattern]
]

This implies 8 update iterations, which is redundant. A solution is possible with fewer iterations, see the animated GIF for a 6-step solution where each step has a unique word.

The other problem

MatrixForm[
pattern=createpattern[
{"leds", "mani", "ints", "vice"},
{"knff", "poes", "stts", "maed"}
];
]

Further problems

It would be nice to find the optimum path for somebody to solve by hand, like in the animation at the beginning of the answer, in which each step has a unique answer.