# Solving Puzzle : 4 Pics 1 Word

Posted 8 months ago
1093 Views
|
3 Replies
|
10 Total Likes
|

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];
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".

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];
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},
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];
];


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".

• Some manual operations are necessary.
• launch 4 Pics 1 Word
• get screenshot
• mail it to my PC
• import it to Mathematica

I would like that Mathematica can handle 4 Pics 1 Word as directly as possible.

Any ideas very welcome.

Attachments:
3 Replies
Sort By:
Posted 7 months ago
 - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming!
Posted 7 months ago

Hi Kotaro,

This is a great post. I learned a lot, thank you! I have a small improvement to start automating the task of sending the screenshot by email to your pc. You can use our ServiceConnect function to connect Mathematica to your smartphone using the Pushbullet app.

Download Pushbullet to your phone and create an account. Then:

## 4. Connect to Pushbullet from the Wolfram Language

    pb = ServiceConnect["Pushbullet"]


This will prompt a dialog box to provide your Access Token. To get an access token, go to https://www.pushbullet.com/, log into your account > Go to the Settings option in the menu at the left > Account > Press the Create Access Token at the right > Copy the provided Access Token > Paste it in the dialog box in the Wolfram Language and agree the terms of use > Click Done

## 5. Import the screenshot

This will import the last pushed image from Pushbullet.

  screenshot =  Import[First[pb["PushHistory"]]["FileURL"]]


You can also import multiple images, e.g. the last 5 pushed screenshots

history = pb["PushHistory"]
Import/@(history[1 ;; 5, "FileURL"]//Normal)


Finally, this is not a suggestion but just another way to write your getWordLength function:

getWordLength[screenshot_] :=
Module[{img3, img3b},
img3 = ImageTrim[screenshot, {{0, 555}, {1080, 555}}];
img3b = Binarize[img3];
Length[Split[PixelValuePositions[img3b, 1][[All, 1]], (#2 - #1) == 1 &]]/2 -1
];


I just like using the PixelValuePositions function ;)