# Convert QR code to a Nonogram puzzle

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,

How do I then create the Nonogram?

Thanks.

• 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. Jun 30, 2018 at 11:52
• If you just take a QR code and generate a Nonogram directly from it, the Nonogram is very likely to not be unique. Aug 23, 2019 at 10:39

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


Code and graphics done in Mathemathica 11.3.0 on Win7 64

• Use Grid[norogram, ItemSize -> {2, 2}, Frame -> All, Spacings -> {0, 0}] to create the blank puzzle then! Thanks! Jun 30, 2018 at 10:03

### 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]] &


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]


### 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]} &;

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


### 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}]


• Wow useful built-in functions!!!!! Jul 1, 2018 at 8:08

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.sstatic.net/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}]