13
$\begingroup$

I remember there was a GCHQ puzzle where Nonogram was created to generate a QR code in 2015. It was a quite popular puzzle.

I am wondering if MMA can be used to create a Nonogram from an existing QR code. For example,

BarcodeImage["my test", "QR", 10]

Is it possible to then create a Nonogram from it? Or even further, if I have a QR image,

enter image description here

How do I then create the Nonogram?

Thanks.

$\endgroup$
  • 2
    $\begingroup$ You might take a look at this: github.com/GalAster/Deus The author appears to have implemented this in the package. I don't really know what all that package does, though. $\endgroup$ – b3m2a1 Jun 30 '18 at 11:52
  • $\begingroup$ If you just take a QR code and generate a Nonogram directly from it, the Nonogram is very likely to not be unique. $\endgroup$ – Timwi Aug 23 at 10:39
7
$\begingroup$

I'm assuming that the image has 1 pixel per for each square of the Nonogram puzzle.

Module[
 {
  img = BarcodeImage["my test", "QR", 10],
  data, clue, cluelength, qrdims, nonogram,
  f = ReplaceAll[
     MapAt[
      Total
      , Map[Split, #]
      , {All, All}
      ], 0 -> Nothing
     ] &
  },
 data = ImageData[ColorNegate[img]];
 qrdims = Dimensions[data];
 clue = {f[data], f[Transpose[data]]};
 cluelength = Max[Length /@ Flatten[clue, 1]];
 clue = MapAt[PadLeft[#, cluelength, Null] &, clue, {All, All}];
 nonogram = ConstantArray[Null, (qrdims + {cluelength, cluelength})];
 nonogram[[-First[qrdims] ;; -1, 1 ;; cluelength]] = clue[[1]];
 nonogram[[1 ;; cluelength, -First[qrdims] ;; -1]] = 
  Transpose[clue[[2]]];
 Grid[nonogram
  , ItemSize -> {2, 2}
  , Frame -> {All, All, 
    Flatten@Table[{i, j} -> False, {i, cluelength}, {j, cluelength}]}
  , Spacings -> {0, 0}
  , Background -> {Automatic, Automatic, 
    Rule[{cluelength, cluelength} + #, Black] & /@ Position[data, 1]}
  , Dividers -> {{(cluelength + 1) -> Thick}, {(cluelength + 1) -> 
      Thick}}]
 ]

enter image description here


Code and graphics done in Mathemathica 11.3.0 on Win7 64

$\endgroup$
  • 1
    $\begingroup$ Use Grid[norogram, ItemSize -> {2, 2}, Frame -> All, Spacings -> {0, 0}] to create the blank puzzle then! Thanks! $\endgroup$ – Chen Stats Yu Jun 30 '18 at 10:03
9
$\begingroup$

ComponentMeasurements and MorphologicalComponents

ClearAll[cf1]
cf1 = ComponentMeasurements[MorphologicalComponents[Image@{#}], "Count"][[All, -1]] & /@ 
   # & /@ ({#, Transpose@#}) &;

Using cf1 with the barcode image in OP:

img = BarcodeImage["my test", "QR", 10];

data = 1 - ImageData[img];

cf1 @ data // Panel /@ Grid /@ # & // Row[#, Spacer[20]] & 

enter image description here

Alternatively, we can use a combination of Length, Split and DeleteCases in place of ComponentMeasurements:

ClearAll[cf2]
cf2 = Length /@ Split[DeleteCases[MorphologicalComponents[Image @ {#}][[1]], 0, 2]] & /@ 
  # & /@ {#, Transpose @ #} &;
cf1 @ data == cf2 @ data

True

Visualization using ArrayPlot:

counts = cf1 @ data;
labels = {Row[Style[ToString@#, 14, Black] & /@ #, " "] & /@ #, 
     Column[Style[ToString@#, 14, Black] & /@ #, Alignment -> Bottom]& /@ #2} & @@ counts;
ticks = MapIndexed[{#2[[1]], #} &, #] & /@ labels; 

ArrayPlot[data, FrameTicks -> {{ticks[[1]], None}, {None, ticks[[2]]}}, ImageSize -> 600]

enter image description here

Visualization using Grid:

ClearAll[paddedcf, styleItems, nonogram]
paddedcf = Map[ToString, #, {-1}] & @ 
  {#, ArrayPad[Transpose @ #2, {{0}, {First[Length /@ #], 0}}, ""]} & @@
   (PadLeft[#, Automatic, ""] & /@ cf1[#]) &;
styleItems[bg_: Black, ts_: Directive[FontSize -> 12, FontFamily -> "PanelFontFamily"]] :=
   # /. {0 -> Item[" ", Frame -> True, FrameStyle -> Gray], 
     1 -> Item[" ", Frame -> True, FrameStyle -> Gray,  Background -> bg], 
     Except["", x_String] :> Item[Style[x, ts], Frame -> True, FrameStyle -> Gray]} &;
nonogram[d_] := Join[paddedcf[d][[2]], Join[paddedcf[d][[1]], #, 2]] &;

Row[Grid[styleItems[#] @ nonogram[data] @ data, Spacings -> {0, 0}, 
     ItemSize -> {Scaled@.015, Scaled@.015}] & /@ {White, Red}, Spacer[10]] 

enter image description here

FlipView to flip between two views

{ap1, ap2} =  ArrayPlot[#, Mesh -> All, Frame -> True, ImageSize -> 400,
     FrameTicks -> {{ticks[[1]], None}, {None, ticks[[2]]}}] & /@ 
 {data, Array[0&, Dimensions @ data]};

FlipView[{ap2, ap1}]

enter image description here

$\endgroup$
  • 2
    $\begingroup$ Wow useful built-in functions!!!!! $\endgroup$ – Chen Stats Yu Jul 1 '18 at 8:08
6
$\begingroup$

Since OP asked for solutions given any QR image, here is my version. It first standardizes the image using Mathematica's BarcodeRecognize/BarcodeImage, then finds the actual pixel size m to downsample the matrix to its smallest valid size. I relied here on the string patternmatcher just to get rid of whitespace more easily but one can use of course the Sequence* family of functions.

i = Import@"https://i.stack.imgur.com/gnPp9.jpg";
b = BarcodeImage @@ BarcodeRecognize[i, {"Data", "Format"}];
s = ImageData@b /. {0 -> "0", 1 -> " "};
m = Min[StringLength /@ StringSplit@(StringJoin /@ s)];
s = Downsample[s, m];
f = StringLength /@ StringSplit[StringJoin /@ #] &;
{r, c} = MapThread[Transpose@{Range@#1, #3 /@ #2} &,
     {Dimensions@s, {f@s, f@Transpose@s}, {Row, Rotate[Row@#, -Pi/2] &}}];

ArrayPlot[s, ColorRules -> {"0" -> Black, " " -> White}, Mesh -> True, 
     Frame -> True, FrameTicks -> {r, c}]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.