Convert QR code to a Nonogram puzzle

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 -> {[email protected], [email protected]}] & /@ {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


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


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

Tags:

Matrix

Image Processing

Array

Code Request

Recent Posts