4 Pics 1 Word is the Android and IOS puzzle that you guess what is the word based on four pictures that have something in common.
For example, the answer of the next screenshot is "TOOL".
Goal
Solve this puzzle by using Mathematica. 
Recognize Characters
TextRecognize[] cannot recognize characters from full screenshot.
TextRecognize[screenshot, Language -> "English", RecognitionPrior -> "Character"]
Output is Null.
Find 12 box characters areas.
img2 = ImageTrim[screenshot, {{0, 150}, {900, 450}}];
img2b = Binarize[img2];
mask = MorphologicalTransform[img2b, "BoundingBoxes", Infinity];
mask = Thinning[mask, 4];
corners = Sort[ImageCorners[mask]];
HighlightImage[img2b, corners]
Trim 12 box characters and assemble them.
c2 = Partition[corners, 8];
rectanglerule = {a_, b_, c_, d_, e_, f_, g_, h_} -> {{a, b, e, f}, {c, d, g, h}};
c3 = Flatten[c2 /. rectanglerule, 1];
asm = ImageTrim[img2b, #] & /@ c3 // ImageAssemble
TextRecognize[] can recognize 12 characters.
TextRecognize[asm, RecognitionPrior -> "Word", Language -> "English"] // Characters
Output is {"L", "T", "K", "W", "J", "M", "H", "D", "U", "O", "O", "I"}.
Recognize Word Length of the Answer
In this screenshot, the word length of the answer is four.
Trim one line within the input area of the answer(above red line).
img3 = ImageTrim[screenshot, {{0, 555}, {1080, 555}}];
img3b = Binarize[img3]
Output is
The word length of the answer is the number of white area -1 (In this case, 4 = 5-1).
The elements of black line are 0 and the elements of white line are 1.
getWordLength[screenshot_] := Module[{img3, img3b},
img3 = ImageTrim[screenshot, {{0, 555}, {1080, 555}}];
img3b = Binarize[img3];
(ImageData[img3b] //. {x___, a_, a_, y___} -> {x, a, y} // Flatten //
Total) - 1
];
getWordLength[screenshot]
Output is 4.
Find Candidates
Find candidates using DictionaryLookup[].
getCandidates[string_String, n_] :=
Module[{list},
list = StringJoin /@ Permutations[Sort[Characters[string]], {n}];
Select[list,
Length[DictionaryLookup[#, IgnoreCase -> True]] != 0 &] //
ToUpperCase
];
getCandidates[StringJoin[{"L", "T", "K", "W", "J", "M", "H", "D", "U", "O", "O", "I"}], 4]
Output is {"DHOW", "DOLT", "DOOM", "DOTH", "HILT", "HOLD", "HOLT", "HOOD", "HOOK", "HOOT", "HOWL", "HTML", "HULK", "IDOL", "JILT", "JODI", "JOLT", "JOWL", "JUDO", "KILO", "KILT", "KITH", "KOHL", "LIDO", "LIMO", "LOKI", "LOOK", "LOOM", "LOOT", "LOUD", "LOUT", "LUDO", "MILD", "MILK", "MILO", "MILT", "MOHO", "MOIL", "MOLD", "MOLT", "MOOD", "MOOT", "MOTH", "ODOM", "OHIO", "OMIT", "THOU", "THUD", "TOIL", "TOJO", "TOLD", "TOOK", "TOOL", "WHIM", "WHIT", "WHOM", "WILD", "WILT", "WITH", "WOLD", "WOOD", "WOOL"}.
Include the answer "TOOL".
Identify Pictures
Identify one of pictures.
ImageTrim[screenshot, {{575, 1215}, {950, 1660}}]
ImageIdentify[%, All, 10]
Trim 4 pictures areas and identify them.
getCommonNames[screenshot_, n_: 10] :=
Module[{img41, img42, img43, img44, entities, cn},
img41 = ImageTrim[screenshot, {{55, 700}, {505, 1145}}];
img42 = ImageTrim[screenshot, {{575, 700}, {950, 1145}}];
img43 = ImageTrim[screenshot, {{55, 1215}, {505, 1660}}];
img44 = ImageTrim[screenshot, {{575, 1215}, {950, 1660}}];
entities = ImageIdentify[#, All, n] & /@ {img41, img42, img43, img44} // Flatten;
cn = CommonName /@ entities;
StringSplit /@ cn // Flatten // Union // Sort // ToUpperCase
];
cns = getCommonNames[screenshot]
Output is {"AIRPLANE", "ALLIGATOR", "ASTRONOMICAL", "BIT", "BOTTLE", "BUFFER", "CARPENTER'S", "CASSEGRAINIAN", "CHUCK", "CHURCHKEY", "CLIP", "COLLET", "COMPOUND", "CUTLERY", "CUTTER", "DRILL", "DRYER", "EDGE", "ELECTRIC", "FASTENING", "HAIR", "HAMMER", "KHUKURI", "KNIFE", "LEVER", "MALLET", "OF", "OPENER", "OPTICAL", "PAIR", "PIPE", "PLIERS", "POCKET", "POWER", "PROPELLER", "REFLECTING", "REGULATOR", "SCISSORS", "SLEDGEHAMMER", "SPIGOT", "TAILPIPE", "TELESCOPE", "TOOL", "TWIST", "VIAL", "WIRE"}.
Include the answer "TOOL".
Get Answer
The answer is the element common to both candidate words and what pictures are.
Intersection[
{"DHOW", "DOLT", "DOOM", "DOTH", "HILT", "HOLD", "HOLT", "HOOD",
"HOOK", "HOOT", "HOWL", "HTML", "HULK", "IDOL", "JILT", "JODI",
"JOLT", "JOWL", "JUDO", "KILO", "KILT", "KITH", "KOHL", "LIDO",
"LIMO", "LOKI", "LOOK", "LOOM", "LOOT", "LOUD", "LOUT", "LUDO",
"MILD", "MILK", "MILO", "MILT", "MOHO", "MOIL", "MOLD", "MOLT",
"MOOD", "MOOT", "MOTH", "ODOM", "OHIO", "OMIT", "THOU", "THUD",
"TOIL", "TOJO", "TOLD", "TOOK", "TOOL", "WHIM", "WHIT", "WHOM",
"WILD", "WILT", "WITH", "WOLD", "WOOD", "WOOL"},
{"AIRPLANE", "ALLIGATOR", "ASTRONOMICAL", "BIT", "BOTTLE", "BUFFER",
"CARPENTER'S", "CASSEGRAINIAN", "CHUCK", "CHURCHKEY", "CLIP",
"COLLET", "COMPOUND", "CUTLERY", "CUTTER", "DRILL", "DRYER", "EDGE",
"ELECTRIC", "FASTENING", "HAIR", "HAMMER", "KHUKURI", "KNIFE",
"LEVER", "MALLET", "OF", "OPENER", "OPTICAL", "PAIR", "PIPE",
"PLIERS", "POCKET", "POWER", "PROPELLER", "REFLECTING", "REGULATOR",
"SCISSORS", "SLEDGEHAMMER", "SPIGOT", "TAILPIPE", "TELESCOPE",
"TOOL", "TWIST", "VIAL", "WIRE"}]
Output is {"TOOL"}.
Integrate
Get 12 box characters from a screenshot.
getCharacters[screenshot_] :=
Module[{img2, img2b, mask, rectanglerule, corners, c2, c3, asm},
img2 = ImageTrim[screenshot, {{0, 150}, {900, 450}}];
img2b = Binarize[img2];
mask = MorphologicalTransform[img2b, "BoundingBoxes", Infinity];
mask = Thinning[mask, 4];
corners = Sort[ImageCorners[mask]];
c2 = Partition[corners, 8];
rectanglerule = {a_, b_, c_, d_, e_, f_, g_, h_} -> {{a, b, e, f}, {c, d, g, h}};
c3 = Flatten[c2 /. rectanglerule, 1];
asm = ImageTrim[img2b, #] & /@ c3 // ImageAssemble;
TextRecognize[asm, RecognitionPrior -> "Word", Language -> "English"] // Characters // ToUpperCase
];
Integrate all functions.
Pics41[screenshot_] := Module[{answer, chars, n, cadidates, cns},
answer = {};
chars = getCharacters[screenshot];
n = getWordLength[screenshot];
Print["Word Length: ", n];
Print["characters: ", chars[[{2, 4, 6, 8, 10, 12, 1, 3, 5, 7, 9, 11}]]];
Print["searching..."];
cadidates = getCandidates[StringJoin[chars], n];
cns = getCommonNames[screenshot];
answer = Intersection[cadidates, cns];
If[answer != {}, Print["found"]; answer, Print["not found"]; cadidates]
];
Another example is
Finally
I have some problems.
Pics41[] cannot often get an answer. Need more information from each picture.
For example, Pics41[] cannot get the answer "COMIC".
Any ideas very welcome.
Attachments:
