Nonograms From Mathematica Characters

MathematicaCharacters ={"á","ā","ă","ä","æ","à","â","ℵ","","","α","\[AltKey]","∧","∠","Å","å","⋰","ã","∖","♫","♬","∵","ℶ","β","˘","•","ć","⌢","Á","Ā","Ă","Ä","Æ","À","Â","Α","Å","Ã","Β","Ć","Ç","Č","Χ","Δ","\[CapitalDifferentialD]","Ϝ","É","Ē","Ĕ","Ë","È","Ê","Ε","Η","Ð","Γ","Í","Ĭ","Ï","Ì","Î","Ι","Κ","Ϟ","Λ","Ł","Μ","Ñ","Ν","Ó","Ő","Ö","Ò","Ô","Ω","Ο","Ø","Õ","Φ","Π","Ψ","Ρ","Ϡ","Š","Σ","Ϛ","Τ","Θ","Þ","Ú","Ű","Ü","Ù","Û","Υ","Ξ","Ý","Ζ","ç","¸","¢","·","⋯","č","✓","χ","⊙","⊖","⊕","⊗","∲","”","’","⌘","♣","∶","⌘","≡","\[Conjugate]","\[ConjugateTranspose]","\[ConstantC]","","∮","\[ControlKey]","∐","©","∳","\[Cross]","⌣","≍","ϒ","ε","ϰ","φ","ϖ","ϱ","ϑ","¤","†","ℸ","–","°","∇","⌫","δ","⋱","⌀","⋄","♢","\[DifferentialD]","ϝ","÷","≐","ı","ȷ","⬚","∯","‡","ℽ","⇓","ℼ","⇐","⇔","⫤","⟸","⟺","⟹","″","⇒","⊨","𝕒","𝕓","𝕔","𝔸","𝔹","ℂ","𝔻","𝔼","𝔽","𝔾","ℍ","𝕀","𝕁","𝕂","𝕃","𝕄","ℕ","𝕆","ℙ","ℚ","ℝ","𝕊","𝕋","𝕌","𝕍","𝕎","𝕏","𝕐","ℤ","𝕕","𝕖","𝟠","𝕗","𝟝","𝟜","𝕘","𝕙","𝕚","𝕛","𝕜","𝕝","𝕞","𝕟","𝟡","𝕠","𝟙","𝕡","𝕢","𝕣","𝕤","𝟟","𝟞","𝕥","𝟛","𝟚","𝕦","𝕧","𝕨","𝕩","𝕪","𝕫","𝟘","⇑","⇕","∥","↓","⤓","⇵","̑","¡","⥐","⥞","↽","⥖","▾","¿","⥟","⇁","⥗","⊤","↧","é","♁","ē","ĕ","ë","è","ê","♪","∈","…","○","◇","▽","▯","∅","◦","◻","□","△","▫","⌤","","","ϵ","==","≂","⇌","\[ErrorIndicator]","\[EscapeKey]","η","ð","€","∃","E","ﬁ","●","◆","▼","◀","▮","▶","•","◼","■","▲","▪","ς","\[FirstPage]","★","♭","ﬂ","ƒ","∀","\[FreakedSmiley]","γ","ℷ","𝔞","𝔟","𝔠","𝔄","𝔅","ℭ","𝔇","𝔈","𝔉","𝔊","ℌ","ℑ","𝔍","𝔎","𝔏","𝔐","𝔑","𝔒","𝔓","𝔔","ℜ","𝔖","𝔗","𝔘","𝔙","𝔚","𝔛","𝔜","ℨ","𝔡","𝔢","\[GothicEight]","𝔣","\[GothicFive]","\[GothicFour]","𝔤","𝔥","𝔦","𝔧","𝔨","𝔩","𝔪","𝔫","\[GothicNine]","𝔬","\[GothicOne]","𝔭","𝔮","𝔯","𝔰","\[GothicSeven]","\[GothicSix]","𝔱","\[GothicThree]","\[GothicTwo]","𝔲","𝔳","𝔴","𝔵","𝔶","𝔷","\[GothicZero]","●","■","≥","⋛","≧","≫","≷","⩾","≳","ˇ","☺","ℏ","♡","\[HermitianConjugate]","─","≎","≏","\[Hyphen]","í","ĭ","ï","ì","î","I","I","\[Implies]","∫","⋂","ι","♃","κ","\[KernelIcon]","ϟ","λ","\[LastPage]","⟨","←","⇤","⇆","\[LeftBracketingBar]","⌈","[[","\[LeftDoubleBracketingBar]","⥡","⇃","⥙","⌊","«","\[LeftModified]","◂","↔","⥎","«","⊣","↤","⥚","⊲","⧏","⊴","⥑","⥠","↿","⥘","↼","⥒","≤","⋚","≦","≶","≪","⩽","≲"," ","💡","—","==","⟵","⟷","⟶","↙","↘","ł","♂","\[MathematicaIcon]","∡","☿","℧","µ","∓","μ","⊼","♮","♆","⪢","⪡","😐","⊽","¬","≢","≭","∦","∉","≠","≂̸","∄","≯","≱","≧̸","≫̸","≹","⩾̸","≵","≎̸","≏̸","⋪","⧏̸","⋬","≮","≰","\[NotLessFullEqual]","≸","≪̸","⩽̸","≴","⪢̸","⪡̸","⊀","⪯̸","⋠","\[NotPrecedesTilde]","∌","⋫","⧐̸","⋭","⊏̸","⋢","⊐̸","⋣","⊄","⊈","⊁","⪰̸","⋡","≿̸","⊅","⊉","≁","≄","≇","≉","∤","ñ","ν","\[Null]","\[NumberSign]","ó","ő","ö","ò","ô","ω","ο","“","‘","⌥","∨","ø","õ","⏞","⎴","⏜","¶","∂","ϕ","π","\[Piecewise]","\[Placeholder]","±","♇","≺","⪯","≼","≾","′","∏","∷","∝","ψ","♩","&","@","`","\\",":",",","-","$",".","=","!",">","{","[","(","<","#","%","+","?","'","}","]",")",";","/"," ","*","~","_","|","^","®","↵","⏎","‶","∋","⇋","‵","⥯","ρ","∟","⟩","→","⇥","⇄","\[RightBracketingBar]","⌉","]]","\[RightDoubleBracketingBar]","⥝","⇂","⥕","⌋","»","\[RightModified]","▸","»","⊢","↦","⥛","⊳","⧐","⊵","⥏","⥜","↾","⥔","⇀","⥓","⥰","␣","->",":>","☹","ϡ","♄","𝒶","𝒷","𝒸","𝒜","ℬ","𝒞","𝒟","ℰ","ℱ","𝒢","ℋ","ℐ","𝒥","𝒦","ℒ","ℳ","𝒩","𝒪","𝒫","𝒬","ℛ","𝒮","𝒯","𝒰","𝒱","𝒲","𝒳","𝒴","𝒵","𝒹","\[ScriptDotlessI]","\[ScriptDotlessJ]","ℯ","\[ScriptEight]","𝒻","\[ScriptFive]","\[ScriptFour]","ℊ","𝒽","𝒾","𝒿","𝓀","ℓ","𝓂","𝓃","\[ScriptNine]","ℴ","\[ScriptOne]","𝓅","𝓆","𝓇","𝓈","\[ScriptSeven]","\[ScriptSix]","𝓉","\[ScriptThree]","\[ScriptTwo]","𝓊","𝓋","𝓌","𝓍","𝓎","𝓏","\[ScriptZero]","§","\[SelectionPlaceholder]","š","♯","←","→","σ","✶","⁃","∘","␣","♠","","","","∢","√","\[Square]","⊓","⊏","⊑","⊐","⊒","⊔","⋆","£","ϛ","⊂","⊆","≻","⪰","≽","≿","∍","∑","⊃","⊇","⌤","ß","⇥","τ","∴","θ","þ","∼","≃","≅","≈","×","™","\[Transpose]","ú","ű","ü","ù","û","⏟","⎵","⏝","⋃","⊎","↑","⤒","⇅","↕","⥮","↖","↗","▴","υ","⊥","↥","♅","⋁","♀","∣","⋮","\[VerticalLine]","\[VerticalSeparator]","≀","⚠","⌚","⋀","℘","🐺","ξ","⊻","ý","ÿ","¥","ζ","∞"};
MathematicaCharacters=Delete[MathematicaCharacters,319];
MathematicaCharacters=Delete[MathematicaCharacters,345];
MathematicaCharacters=Delete[MathematicaCharacters,611];
MathematicaCharacters=Delete[MathematicaCharacters,611];
MathematicaCharacters=Delete[MathematicaCharacters,626];
MathematicaCharacters=Delete[MathematicaCharacters,670];
MathematicaCharacters=Delete[MathematicaCharacters,731];
makegobelin3[i_]:=Module[{rr,tt,zz},rr=Rasterize[
Style[MathematicaCharacters[[i]]],

"Data"];tt=rr/.{{255,255,255}->0,{0,0,0}->1,{x_,y_,z_}->1};zz=ImageCrop[Image[tt]];ImageData[zz]/.{1.->1,0.->0}];
stringfromlist[list_]:=Module[{len=Length[list],str=""},If[len==0,"",Do[str=StringJoin[str,ToString[list[[i]]],", "],{i,1,len-1}];str=StringJoin[str,ToString[list[[len]]]]]];

Manipulate[
Module[{gob, m, n, empty, cc, cc1, row, col, desno, spodaj},
gob=makegobelin3[k];
m=Length[gob];
n=Length[gob[[1]]];
empty=RandomInteger[{0,0},{m,n}];
cc=Map[Split,gob];
cc1=Map[Split,Transpose[gob]];
row=Map[Length,Table[Select[cc[[i]],MemberQ[#,1]&],{i,1,Length[cc]}],{2}];
col=Map[Length,Table[Select[cc1[[i]],MemberQ[#,1]&],{i,1,Length[cc1]}],{2}];
desno=Map[stringfromlist,row];
spodaj=Map[Column,col];
Grid[{{If[shor,Style[MathematicaCharacters[[k]],30],Invisible[Style[MathematicaCharacters[[k]],30]]],Show[ArrayPlot[If[sh,gob,empty],Mesh->True,Axes->None,ColorRules->{1->GrayLevel[0.6]},MeshStyle->{GrayLevel[0.3]}],Graphics[{Table[Text[Style[desno[[i]],16],{n+0.3,m+0.5-i},{-1,0}],{i,1,m}],Table[Text[Style[spodaj[[i]],16],{i-0.5,-0.1},{0,1}],{i,1,n}]}],ImageSize->{500,400}]}}]],
{{k,1,"choose character"},1,780,1,Appearance->"Labeled"},
Row[{
Control[{{sh,False,"show solution"},{False,True}}],
Spacer[30],
Control[{{shor,False,"show original"},{False,True}}]}],
SaveDefinitions->True,
ContentSize-> {580,440}]

A grid of squares is given. Each square must be filled in gray or left as white. The numbers to the right of the rows or under the columns are the lengths of the runs of gray squares in that row or column. (For example, 1, 2 means there is one gray square followed by two; the number of white squares separating them, before the first one, or after the last two not given.) The aim is to find all gray squares.

Nonogram, http://en.wikipedia.org/wiki/Nonogram

Contributed by: Izidor Hafner