Message Boards Message Boards

Solving Puzzle : 4 Pics 1 Word

Kotaro Okazaki, FTI
Posted 6 years ago

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

enter image description here

Goal

Solve this puzzle by using Mathematica. enter image description here

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]

enter image description here

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

enter image description here

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.

enter image description here

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

enter image description here

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]

enter image description here

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

enter image description here enter image description here

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

enter image description here enter image description here

  • 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:
POSTED BY: Kotaro Okazaki
3 Replies
Sort By:

Thanks for your helpful information, Christian.

I would like to take advantage of them.
POSTED BY: Kotaro Okazaki

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:

1. Take screenshot

2. Open the Pushbullet app and go to Pushing

enter image description here

3. Push the screenshot

enter image description here enter image description here

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 ;)
POSTED BY: Christian Pasquel

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming!

POSTED BY: Moderation Team
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract