Data commit

Task/Nonogram-solver/00-META.yaml

@@ -0,0 +1,4 @@
+---
+category:
+- Puzzles
+from: http://rosettacode.org/wiki/Nonogram_solver

Task/Nonogram-solver/00-TASK.txt

@@ -0,0 +1,61 @@
+A [[wp:Nonogram|nonogram]] is a puzzle that provides 
+numeric clues used to fill in a grid of cells, 
+establishing for each cell whether it is filled or not. 
+The puzzle solution is typically a picture of some kind.
+
+Each row and column of a rectangular grid is annotated with the lengths 
+of its distinct runs of occupied cells. 
+Using only these lengths you should find one valid configuration 
+of empty and occupied cells, or show a failure message.
+
+;Example
+<pre>Problem:                 Solution:
+
+. . . . . . . .  3       . # # # . . . .  3
+. . . . . . . .  2 1     # # . # . . . .  2 1
+. . . . . . . .  3 2     . # # # . . # #  3 2
+. . . . . . . .  2 2     . . # # . . # #  2 2
+. . . . . . . .  6       . . # # # # # #  6
+. . . . . . . .  1 5     # . # # # # # .  1 5
+. . . . . . . .  6       # # # # # # . .  6
+. . . . . . . .  1       . . . . # . . .  1
+. . . . . . . .  2       . . . # # . . .  2
+1 3 1 7 5 3 4 3          1 3 1 7 5 3 4 3
+2 1 5 1                  2 1 5 1</pre>   
+The problem above could be represented by two lists of lists:
+<pre>x = [[3], [2,1], [3,2], [2,2], [6], [1,5], [6], [1], [2]]
+y = [[1,2], [3,1], [1,5], [7,1], [5], [3], [4], [3]]</pre>
+A more compact representation of the same problem uses strings, 
+where the letters represent the numbers, A=1, B=2, etc:
+<pre>x = "C BA CB BB F AE F A B"
+y = "AB CA AE GA E C D C"</pre>
+
+;Task
+For this task, try to solve the 4 problems below, read from a “<tt>nonogram_problems.txt</tt>” file that has this content 
+(the blank lines are separators):
+<pre>C BA CB BB F AE F A B
+AB CA AE GA E C D C
+
+F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
+D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
+
+CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
+BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
+
+E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
+E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM</pre>
+
+'''Extra credit''': generate nonograms with unique solutions, of desired height and width.
+<br><br>
+This task is the problem n.98 of the "[https://sites.google.com/site/prologsite/prolog-problems 99 Prolog Problems]" by Werner Hett (also thanks to Paul Singleton for the idea and the examples).
+<br><br>
+; Related tasks
+* [[Nonoblock]].
+<br>
+;See also
+* [[wp:AC-3_algorithm|Arc Consistency Algorithm]]
+* http://www.haskell.org/haskellwiki/99_questions/Solutions/98 (Haskell)
+* http://twanvl.nl/blog/haskell/Nonograms (Haskell)
+* http://picolisp.com/5000/!wiki?99p98 (PicoLisp)
+<br><br>
+

Task/Nonogram-solver/11l/nonogram-solver.11l

@@ -0,0 +1,109 @@
+F gen_row(w, s)
+   ‘Create all patterns of a row or col that match given runs.’
+   F gen_seg([[Int]] o, Int sp) -> [[Int]]
+      I o.empty
+         R [[2] * sp]
+      [[Int]] r
+      L(x) 1 .< sp - o.len + 2
+         L(tail) @gen_seg(o[1..], sp - x)
+            r [+]= [2] * x [+] o[0] [+] tail
+      R r
+
+   R gen_seg(s.map(i -> [1] * i), w + 1 - sum(s)).map(x -> x[1..])
+
+F deduce(hr, vr)
+   ‘Fix inevitable value of cells, and propagate.’
+   F allowable(row)
+      R row.reduce((a, b) -> zip(a, b).map((x, y) -> x [|] y))
+
+   F fits(a, b)
+      R all(zip(a, b).map((x, y) -> x [&] y))
+
+   V (w, h) = (vr.len, hr.len)
+   V rows = hr.map(x -> gen_row(@w, x))
+   V cols = vr.map(x -> gen_row(@h, x))
+   V can_do = rows.map(allowable)
+
+   V mod_rows = Set[Int]()
+   V mod_cols = Set(0 .< w)
+
+   F fix_col(n)
+      ‘See if any value in a given column is fixed;
+        if so, mark its corresponding row for future fixup.’
+      V c = @can_do.map(x -> x[@n])
+      @cols[n] = @cols[n].filter(x -> @@fits(x, @c))
+      L(x) @allowable(@cols[n])
+         V i = L.index
+         I x != @can_do[i][n]
+            @mod_rows.add(i)
+            @can_do[i][n] [&]= x
+
+   F fix_row(n)
+      ‘Ditto, for rows.’
+      V c = @can_do[n]
+      @rows[n] = @rows[n].filter(x -> @@fits(x, @c))
+      L(x) @allowable(@rows[n])
+         V i = L.index
+         I x != @can_do[n][i]
+            @mod_cols.add(i)
+            @can_do[n][i] [&]= x
+
+   F show_gram(m)
+      L(x) m
+         print(x.map(i -> ‘x#.?’[i]).join(‘ ’))
+      print()
+
+   L !mod_cols.empty
+      L(i) mod_cols
+         fix_col(i)
+      mod_cols.clear()
+      L(i) mod_rows
+         fix_row(i)
+      mod_rows.clear()
+
+   I all(multiloop((0 .< w), (0 .< h), (j, i) -> @can_do[i][j] C (1, 2)))
+      print(‘Solution would be unique’)
+   E
+      print(‘Solution may not be unique, doing exhaustive search:’)
+
+   V out = [[Int]()] * h
+
+   F try_all(Int n) -> Int
+      I n >= @h
+         L(j) 0 .< @w
+            I @out.map(x -> x[@j]) !C @cols[j]
+               R 0
+         @show_gram(@out)
+         R 1
+      V sol = 0
+      L(x) @rows[n]
+         @out[n] = x
+         sol += @try_all(n + 1)
+      R sol
+
+   V n = try_all(0)
+   I n == 0
+      print(‘No solution.’)
+   E I n == 1
+      print(‘Unique solution.’)
+   E
+      print(n‘ solutions.’)
+   print()
+
+F solve(p, show_runs = 1B)
+   [[[Int]]] s
+   L(l) p.split("\n")
+      s [+]= l.split(‘ ’).map(w -> w.map(c -> c.code - ‘A’.code + 1))
+   I show_runs
+      print(‘Horizontal runs: ’s[0])
+      print(‘Vertical runs: ’s[1])
+   deduce(s[0], s[1])
+
+L(p) File(‘nonogram_problems.txt’).read().split("\n\n")
+   solve(p)
+
+print(‘Extra example not solvable by deduction alone:’)
+solve("B B A A\nB B A A")
+
+print(‘Extra example where there is no solution:’)
+solve("B A A\nA A A")

Task/Nonogram-solver/C++/nonogram-solver-1.cpp

@@ -0,0 +1,59 @@
+// A class to solve Nonogram (Hadje) Puzzles
+// Nigel Galloway - January 23rd., 2017
+template<uint _N, uint _G> class Nonogram {
+  enum class ng_val : char {X='#',B='.',V='?'};
+  template<uint _NG> struct N {
+    N() {}
+    N(std::vector<int> ni,const int l) : X{},B{},Tx{},Tb{},ng(ni),En{},gNG(l){}
+    std::bitset<_NG> X, B, T, Tx, Tb;
+    std::vector<int> ng;
+    int En, gNG;
+    void        fn (const int n,const int i,const int g,const int e,const int l){
+      if (fe(g,l,false) and fe(g+l,e,true)){
+      if ((n+1) < ng.size()) {if (fe(g+e+l,1,false)) fn(n+1,i-e-1,g+e+l+1,ng[n+1],0);}
+      else {
+        if (fe(g+e+l,gNG-(g+e+l),false)){Tb &= T.flip(); Tx &= T.flip(); ++En;}
+      }}
+      if (l<=gNG-g-i-1) fn(n,i,g,e,l+1);
+    }
+    void        fi (const int n,const bool g) {X.set(n,g); B.set(n, not g);}
+    ng_val      fg (const int n) const{return (X.test(n))? ng_val::X : (B.test(n))? ng_val::B : ng_val::V;}
+    inline bool fe (const int n,const int i, const bool g){
+      for (int e = n;e<n+i;++e) if ((g and fg(e)==ng_val::B) or (!g and fg(e)==ng_val::X)) return false; else T[e] = g;
+      return true;
+    }
+    int         fl (){
+      if (En == 1) return 1;
+      Tx.set(); Tb.set(); En=0;
+      fn(0,std::accumulate(ng.cbegin(),ng.cend(),0)+ng.size()-1,0,ng[0],0);
+      return En;
+    }}; // end of N
+  std::vector<N<_G>> ng;
+  std::vector<N<_N>> gn;
+  int En, zN, zG;
+  void setCell(uint n, uint i, bool g){ng[n].fi(i,g); gn[i].fi(n,g);}
+public:
+  Nonogram(const std::vector<std::vector<int>>& n,const std::vector<std::vector<int>>& i,const std::vector<std::string>& g = {}) : ng{}, gn{}, En{}, zN(n.size()), zG(i.size()) {
+    for (int n=0; n<zG; n++) gn.push_back(N<_N>(i[n],zN));
+    for (int i=0; i<zN; i++) {
+      ng.push_back(N<_G>(n[i],zG));
+      if (i < g.size()) for(int e=0; e<zG or e<g[i].size(); e++) if (g[i][e]=='#') setCell(i,e,true);
+    }}
+  bool solve(){
+    int i{}, g{};
+    for (int l = 0; l<zN; l++) {
+      if ((g = ng[l].fl()) == 0) return false; else i+=g;
+      for (int i = 0; i<zG; i++) if (ng[l].Tx[i] != ng[l].Tb[i]) setCell (l,i,ng[l].Tx[i]);
+    }
+    for (int l = 0; l<zG; l++) {
+      if ((g = gn[l].fl()) == 0) return false; else i+=g;
+      for (int i = 0; i<zN; i++) if (gn[l].Tx[i] != gn[l].Tb[i]) setCell (i,l,gn[l].Tx[i]);
+    }
+    if (i == En)    return false; else En = i;
+    if (i == zN+zG) return true;  else return solve();
+  }
+  const std::string toStr() const {
+    std::ostringstream n;
+    for (int i = 0; i<zN; i++){for (int g = 0; g<zG; g++){n << static_cast<char>(ng[i].fg(g));}n<<std::endl;}
+    return n.str();
+  }};

Task/Nonogram-solver/C++/nonogram-solver-2.cpp

@@ -0,0 +1,30 @@
+// For the purpose of this task I provide a little code to read from a file in the required format
+// Note though that Nonograms may contain blank lines and values greater than 24
+int main(){
+  std::ifstream n ("nono.txt");
+  if (!n) {
+    std::cerr << "Unable to open nono.txt.\n";
+    exit(EXIT_FAILURE);
+  }
+  std::string i;
+  getline(n,i);
+  std::istringstream g(i);
+  std::string e;
+  std::vector<std::vector<int>> N;
+    while (g >> e) {
+      std::vector<int> G;
+      for (char l : e) G.push_back((int)l-64);
+      N.push_back(G);
+    }
+  getline(n,i);
+  std::istringstream gy(i);
+  std::vector<std::vector<int>> G;
+    while (gy >> e) {
+      std::vector<int> N;
+      for (char l : e) N.push_back((int)l-64);
+      G.push_back(N);
+    }
+  Nonogram<32,32> myN(N,G);
+  if (!myN.solve()) std::cout << "I don't believe that this is a nonogram!" << std::endl;
+  std::cout << "\n" << myN.toStr() << std::endl;
+}

Task/Nonogram-solver/C++/nonogram-solver-3.cpp

@@ -0,0 +1,78 @@
+int main(){
+  const std::vector<std::vector<int>> Ngchq={{        7,3,1, 1,7},
+                                             {      1,1,2,2, 1,1},
+                                             {  1,3,1,3,1,1, 3,1},
+                                             {  1,3,1,1,6,1, 3,1},
+                                             {  1,3,1,5,2,1, 3,1},
+                                             {        1,1,2, 1,1},
+                                             {    7,1,1,1,1, 1,7},
+                                             {               3,3},
+                                             {1,2,3,1,1,3,1, 1,2},
+                                             {      1,1,3,2, 1,1},
+                                             {      4,1,4,2, 1,2},
+                                             {  1,1,1,1,1,4, 1,3},
+                                             {      2,1,1,1, 2,5},
+                                             {      3,2,2,6, 3,1},
+                                             {      1,9,1,1, 2,1},
+                                             {      2,1,2,2, 3,1},
+                                             {    3,1,1,1,1, 5,1},
+                                             {          1,2, 2,5},
+                                             {    7,1,2,1,1, 1,3},
+                                             {    1,1,2,1,2, 2,1},
+                                             {      1,3,1,4, 5,1},
+                                             {      1,3,1,3,10,2},
+                                             {      1,3,1,1, 6,6},
+                                             {      1,1,2,1, 1,2},
+                                             {        7,2,1, 2,5}};
+  const std::vector<std::vector<int>> Ggchq={{        7,2,1,1,7},
+                                             {      1,1,2,2,1,1},
+                                             {1,3,1,3,1,3,1,3,1},
+                                             {  1,3,1,1,5,1,3,1},
+                                             {  1,3,1,1,4,1,3,1},
+                                             {      1,1,1,2,1,1},
+                                             {    7,1,1,1,1,1,7},
+                                             {            1,1,3},
+                                             {    2,1,2,1,8,2,1},
+                                             {  2,2,1,2,1,1,1,2},
+                                             {        1,7,3,2,1},
+                                             {  1,2,3,1,1,1,1,1},
+                                             {        4,1,1,2,6},
+                                             {    3,3,1,1,1,3,1},
+                                             {        1,2,5,2,2},
+                                             {2,2,1,1,1,1,1,2,1},
+                                             {    1,3,3,2,1,8,1},
+                                             {            6,2,1},
+                                             {      7,1,4,1,1,3},
+                                             {        1,1,1,1,4},
+                                             {      1,3,1,3,7,1},
+                                             {1,3,1,1,1,2,1,1,4},
+                                             {      1,3,1,4,3,3},
+                                             {    1,1,2,2,2,6,1},
+                                             {      7,1,3,2,1,1}};
+
+  std::vector<std::string> n = {"",
+                                "",
+                                "",
+                                "...##.......##.......#",
+                                "",
+                                "",
+                                "",
+                                "",
+                                "......##..#...##..#",
+                                "",
+                                "",
+                                "",
+                                "",
+                                "",
+                                "",
+                                "",
+                                "......#....#....#...#",
+                                "",
+                                "",
+                                "",
+                                "",
+                                "...##....##....#....##"};
+  Nonogram<25,25> myN(Ngchq,Ggchq,n);
+  if (!myN.solve()) std::cout << "I don't believe that this is a nonogram!" << std::endl;
+  std::cout << "\n" << myN.toStr() << std::endl;
+}

Task/Nonogram-solver/C-sharp/nonogram-solver.cs

@@ -0,0 +1,117 @@
+using System;
+using System.Collections.Generic;
+using static System.Linq.Enumerable;
+
+public static class NonogramSolver
+{
+    public static void Main2() {
+        foreach (var (x, y) in new [] {
+            ("C BA CB BB F AE F A B", "AB CA AE GA E C D C"),
+            ("F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
+                "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"),
+            ("CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+                "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC"),
+            ("E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+                "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")
+            })
+        {
+            Solve(x, y);
+            Console.WriteLine();
+        }
+    }
+
+    static void Solve(string rowLetters, string columnLetters) {
+        var r = rowLetters.Split(" ").Select(row => row.Select(s => s - 'A' + 1).ToArray()).ToArray();
+        var c = columnLetters.Split(" ").Select(column => column.Select(s => s - 'A' + 1).ToArray()).ToArray();
+        Solve(r, c);
+    }
+
+    static void Solve(int[][] rowRuns, int[][] columnRuns) {
+        int len = columnRuns.Length;
+        var rows = rowRuns.Select(row => Generate(len, row)).ToList();
+        var columns = columnRuns.Select(column => Generate(rowRuns.Length, column)).ToList();
+        Reduce(rows, columns);
+        foreach (var list in rows) {
+            if (list.Count != 1) Console.WriteLine(Repeat('?', len).Spaced());
+            else Console.WriteLine(list[0].ToString().PadLeft(len, '0').Replace('1', '#').Replace('0', '.').Reverse().Spaced());
+        }
+    }
+
+    static List<BitSet> Generate(int length, params int[] runs) {
+        var list = new List<BitSet>();
+        BitSet initial = BitSet.Empty;
+        int[] sums = new int[runs.Length];
+        sums[0] = 0;
+        for (int i = 1; i < runs.Length; i++) sums[i] = sums[i - 1] + runs[i - 1] + 1;
+        for (int r = 0; r < runs.Length; r++) initial = initial.AddRange(sums[r], runs[r]);
+        Generate(list, BitSet.Empty.Add(length), runs, sums, initial, 0, 0);
+        return list;
+    }
+
+    static void Generate(List<BitSet> result, BitSet max, int[] runs, int[] sums, BitSet current, int index, int shift) {
+        if (index == runs.Length) {
+            result.Add(current);
+            return;
+        }
+        while (current.Value < max.Value) {
+            Generate(result, max, runs, sums, current, index + 1, shift);
+            current = current.ShiftLeftAt(sums[index] + shift);
+            shift++;
+        }
+    }
+
+    static void Reduce(List<List<BitSet>> rows, List<List<BitSet>> columns) {
+        for (int count = 1; count > 0; ) {
+            foreach (var (rowIndex, row) in rows.WithIndex()) {
+                var allOn  = row.Aggregate((a, b) => a & b);
+                var allOff = row.Aggregate((a, b) => a | b);
+                foreach (var (columnIndex, column) in columns.WithIndex()) {
+                    count  = column.RemoveAll(c => allOn.Contains(columnIndex) && !c.Contains(rowIndex));
+                    count += column.RemoveAll(c => !allOff.Contains(columnIndex) && c.Contains(rowIndex));
+                }
+            }
+            foreach (var (columnIndex, column) in columns.WithIndex()) {
+                var allOn  = column.Aggregate((a, b) => a & b);
+                var allOff = column.Aggregate((a, b) => a | b);
+                foreach (var (rowIndex, row) in rows.WithIndex()) {
+                    count += row.RemoveAll(r => allOn.Contains(rowIndex) && !r.Contains(columnIndex));
+                    count += row.RemoveAll(r => !allOff.Contains(rowIndex) && r.Contains(columnIndex));
+                }
+            }
+        }
+    }
+
+    static IEnumerable<(int index, T element)> WithIndex<T>(this IEnumerable<T> source) {
+        int i = 0;
+        foreach (T element in source) {
+            yield return (i++, element);
+        }
+    }
+
+    static string Reverse(this string s) {
+        char[] array = s.ToCharArray();
+        Array.Reverse(array);
+        return new string(array);
+    }
+
+    static string Spaced(this IEnumerable<char> s) => string.Join(" ", s);
+
+    struct BitSet //Unused functionality elided.
+    {
+        public static BitSet Empty => default;
+        private readonly int bits;
+        public int Value => bits;
+
+        private BitSet(int bits) => this.bits = bits;
+
+        public BitSet Add(int item) => new BitSet(bits | (1 << item));
+        public BitSet AddRange(int start, int count) => new BitSet(bits | (((1 << (start + count)) - 1) - ((1 << start) - 1)));
+        public bool Contains(int item) => (bits & (1 << item)) != 0;
+        public BitSet ShiftLeftAt(int index)  => new BitSet((bits >> index << (index + 1)) | (bits & ((1 << index) - 1)));
+        public override string ToString() => Convert.ToString(bits, 2);
+
+        public static BitSet operator &(BitSet a, BitSet b) => new BitSet(a.bits & b.bits);
+        public static BitSet operator |(BitSet a, BitSet b) => new BitSet(a.bits | b.bits);
+    }
+
+}

Task/Nonogram-solver/Common-Lisp/nonogram-solver.lisp

@@ -0,0 +1,175 @@
+(defpackage :ac3
+  (:use :cl)
+  (:export :var
+           :domain
+           :satisfies-p
+           :constraint-possible-p
+           :ac3)
+  (:documentation "Implements the AC3 algorithm. Extend VAR with the variable
+types for your particular problem and implement SATISFIES-P and
+CONSTRAINT-POSSIBLE-P for your variables. Initialize the DOMAIN of your variables
+with unary constraints already satisfied and then pass them to AC3 in a list."))
+
+(in-package :ac3)
+
+(defclass var ()
+  ((domain :initarg :domain :accessor domain))
+  (:documentation "The base variable type from which all other
+variables should extend."))
+
+(defgeneric satisfies-p (a b va vb)
+  (:documentation "Determine if constrainted variables A and B are
+satisfied by the instantiation of their respective values VA and VB."))
+
+(defgeneric constraint-possible-p (a b)
+  (:documentation "Determine if variables A and B can even be
+checked for a binary constraint."))
+
+(defun arc-reduce (a b)
+  "Assuming A and B truly form a constraint, prune all values
+from A that do not satisfy any value in B. Return T if the domain
+of A changed by any amount, NIL otherwise."
+  (let (change)
+    (setf (domain a)
+          (loop for va in (domain a)
+             when (loop for vb in (domain b)
+                     do (when (satisfies-p a b va vb)
+                          (return t))
+                     finally (setf change t) (return nil))
+             collect va))
+    change))
+
+(defun binary-constraint-p (a b)
+  "Check if variables A and B could form a constraint, then return T
+if any of their values form a contradiction, NIL otherwise."
+  (when (constraint-possible-p a b)
+    (block found
+      (loop for va in (domain a)
+         do (loop for vb in (domain b)
+               do (unless (satisfies-p a b va vb)
+                    (return-from found t)))))))
+
+(defun ac3 (vars)
+  "Run the Arc Consistency 3 algorithm on the given set of variables.
+Assumes unary constraints have already been satisfied."
+  ;; Form a worklist of the constraints of every variable to every other variable.
+  (let ((worklist (loop for x in vars
+                     append (loop for y in vars
+                               when (and (not (eq x y))
+                                         (binary-constraint-p x y))
+                               collect (cons x y)))))
+    ;; Prune the worklist of satisfied arcs until it is empty.
+    (loop while worklist
+       do (destructuring-bind (x . y) (pop worklist)
+            (when (arc-reduce x y)
+              (if (domain x)
+                  ;; If the current arc's domain was reduced, then append any arcs it
+                  ;; is still constrained with to the end of the worklist, as they
+                  ;; need to be rechecked.
+                  (setf worklist (nconc worklist (loop for z in vars
+                                                    when (and (not (eq x z))
+                                                              (not (eq y z))
+                                                              (binary-constraint-p x z))
+                                                    collect (cons z x))))
+                  (error "No values left in ~a" x))))
+       finally (return vars))))
+
+(defpackage :nonogram
+  (:use :cl :ac3)
+  (:documentation "Utilize the AC3 package to solve nonograms."))
+
+(in-package :nonogram)
+
+(defclass line (var)
+  ((depth :initarg :depth :accessor depth))
+  (:documentation "A LINE is a variable that represents either a
+column or row of cells and all of the permutations of values those
+cells can assume"))
+
+(defmethod print-object ((o line) s)
+  (print-unreadable-object (o s :type t)
+    (with-slots (depth domain) o
+      (format s ":depth ~a :domain ~a" depth domain))))
+
+(defclass row (line) ())
+
+(defclass col (line) ())
+
+(defmethod satisfies-p ((a line) (b line) va vb)
+  (eq (aref va (depth b))
+      (aref vb (depth a))))
+
+(defmethod constraint-possible-p ((a line) (b line))
+  (not (eq (type-of a) (type-of b))))
+
+(defun make-line-domain (runs length &optional (start 0) acc)
+  "Enumerate all valid permutations of a line's values."
+  (if runs
+      (loop for i from start
+         to (- length
+               (reduce #'+ (cdr runs))
+               (length (cdr runs))
+               (car runs))
+         append (make-line-domain (cdr runs) length (+ 1 i (car runs)) (cons i acc)))
+      (list (reverse acc))))
+
+(defun make-line (type runs depth length)
+  "Create and initialize a ROW or COL instance."
+  (make-instance
+   type :depth depth :domain
+   (loop for value in (make-line-domain runs length)
+      collect (let ((arr (make-array length :initial-element nil)))
+                (loop for pos in value
+                   for run in runs
+                   do (loop for i from pos below (+ pos run)
+                         do (setf (aref arr i) t)))
+                arr))))
+
+(defun make-lines (type run-set length)
+  "Initialize a set of lines."
+  (loop for runs across run-set
+     for depth from 0
+     collect (make-line type runs depth length)))
+
+(defun nonogram (problem)
+  "Given a nonogram problem description, solve it and print the result."
+  (let* ((nrows (length (aref problem 0)))
+         (ncols (length (aref problem 1)))
+         (vars (ac3 (append (make-lines 'row (aref problem 0) ncols)
+                            (make-lines 'col (aref problem 1) nrows)))))
+    (loop for var in vars
+       while (eq 'row (type-of var))
+       do (terpri)
+         (loop for cell across (car (domain var))
+            do (format t "~a " (if cell #\# #\.))))))
+
+(defparameter *test-set*
+  '("C BA CB BB F AE F A B"
+    "AB CA AE GA E C D C"))
+
+;; Helper functions to read and parse problems from a file.
+
+(defun parse-word (word)
+  (map 'list (lambda (c) (- (digit-char-p c 36) 9)) word))
+
+(defun parse-line (line)
+  (map 'vector #'parse-word (uiop:split-string (string-upcase line))))
+
+(defun parse-nonogram (rows columns)
+  (vector (parse-line rows)
+          (parse-line columns)))
+
+(defun read-until-line (stream)
+  (loop (let ((line (read-line stream)))
+          (when (> (length (string-trim '(#\space) line)) 0)
+            (print line)
+            (return line)))))
+
+(defun solve-from-file (file)
+  (handler-case
+      (with-open-file (s file)
+        (loop
+           (terpri)
+           (nonogram (parse-nonogram (read-until-line s)
+                                     (read-until-line s)))))
+    (end-of-file ())))

Task/Nonogram-solver/D/nonogram-solver.d

@@ -0,0 +1,136 @@
+import std.stdio, std.range, std.file, std.algorithm, std.string;
+
+/// Create all patterns of a row or col that match given runs.
+auto genRow(in int w, in int[] s) pure nothrow @safe {
+    static int[][] genSeg(in int[][] o, in int sp) pure nothrow @safe {
+        if (o.empty)
+            return [[2].replicate(sp)];
+
+        typeof(return) result;
+        foreach (immutable x; 1 .. sp - o.length + 2)
+            foreach (const tail; genSeg(o[1 .. $], sp - x))
+                result ~= [2].replicate(x) ~ o[0] ~ tail;
+        return result;
+    }
+
+    const ones = s.map!(i => [1].replicate(i)).array;
+    return genSeg(ones, w + 1 - s.sum).map!dropOne;
+}
+
+/// Fix inevitable value of cells, and propagate.
+void deduce(in int[][] hr, in int[][] vr) {
+    static int[] allowable(in int[][] row) pure nothrow @safe {
+        //return row.dropOne.fold!q{ a[] |= b[] }(row[0].dup);
+        return reduce!q{ a[] |= b[] }(row[0].dup, row.dropOne);
+    }
+
+    static bool fits(in int[] a, in int[] b)
+    pure /*nothrow*/ @safe /*@nogc*/ {
+        return zip(a, b).all!(xy => xy[0] & xy[1]);
+    }
+
+    immutable int w = vr.length,
+                  h = hr.length;
+    auto rows = hr.map!(x => genRow(w, x).array).array;
+    auto cols = vr.map!(x => genRow(h, x).array).array;
+    auto canDo = rows.map!allowable.array;
+
+    // Initially mark all columns for update.
+    bool[uint] modRows, modCols;
+    modCols = true.repeat.enumerate!uint.take(w).assocArray;
+
+    /// See if any value a given column is fixed; if so,
+    /// mark its corresponding row for future fixup.
+    void fixCol(in int n) /*nothrow*/ @safe {
+        const c = canDo.map!(x => x[n]).array;
+        cols[n] = cols[n].remove!(x => !fits(x, c)); // Throws.
+        foreach (immutable i, immutable x; allowable(cols[n]))
+            if (x != canDo[i][n]) {
+                modRows[i] = true;
+                canDo[i][n] &= x;
+            }
+    }
+
+    /// Ditto, for rows.
+    void fixRow(in int n) /*nothrow*/ @safe {
+        const c = canDo[n];
+        rows[n] = rows[n].remove!(x => !fits(x, c)); // Throws.
+        foreach (immutable i, immutable x; allowable(rows[n]))
+            if (x != canDo[n][i]) {
+                modCols[i] = true;
+                canDo[n][i] &= x;
+            }
+    }
+
+    void showGram(in int[][] m) {
+        // If there's 'x', something is wrong.
+        // If there's '?', needs more work.
+        m.each!(x => writefln("%-(%c %)", x.map!(i => "x#.?"[i])));
+        writeln;
+    }
+
+    while (modCols.length > 0) {
+        modCols.byKey.each!fixCol;
+        modCols = null;
+        modRows.byKey.each!fixRow;
+        modRows = null;
+    }
+
+    if (cartesianProduct(h.iota, w.iota)
+        .all!(ij => canDo[ij[0]][ij[1]] == 1 || canDo[ij[0]][ij[1]] == 2))
+        "Solution would be unique".writeln;
+    else
+        "Solution may not be unique, doing exhaustive search:".writeln;
+
+    // We actually do exhaustive search anyway. Unique
+    // solution takes no time in this phase anyway.
+    auto out_ = new const(int)[][](h);
+
+    uint tryAll(in int n = 0) {
+        if (n >= h) {
+            foreach (immutable j; 0 .. w)
+                if (!cols[j].canFind(out_.map!(x => x[j]).array))
+                    return 0;
+            showGram(out_);
+            return 1;
+        }
+        typeof(return) sol = 0;
+        foreach (const x; rows[n]) {
+            out_[n] = x;
+            sol += tryAll(n + 1);
+        }
+        return sol;
+    }
+
+    immutable n = tryAll;
+    switch (n) {
+        case 0:  "No solution.".writeln;     break;
+        case 1:  "Unique solution.".writeln; break;
+        default: writeln(n, " solutions."); break;
+    }
+    writeln;
+}
+
+void solve(in string p, in bool showRuns=true) {
+    immutable s = p.splitLines.map!(l => l.split.map!(w =>
+                    w.map!(c => int(c - 'A' + 1)).array).array).array;
+                    //w.map!(c => c - 'A' + 1))).to!(int[][][]);
+
+    if (showRuns) {
+        writeln("Horizontal runs: ", s[0]);
+        writeln("Vertical runs: ", s[1]);
+    }
+    deduce(s[0], s[1]);
+}
+
+void main() {
+    // Read problems from file.
+    immutable fn = "nonogram_problems.txt";
+    fn.readText.split("\n\n").filter!(p => !p.strip.empty).each!(p => p.strip.solve);
+
+    "Extra example not solvable by deduction alone:".writeln;
+    "B B A A\nB B A A".solve;
+
+    "Extra example where there is no solution:".writeln;
+    "B A A\nA A A".solve;
+}

Task/Nonogram-solver/F-Sharp/nonogram-solver-1.fs

@@ -0,0 +1,35 @@
+(*
+I define a discriminated union to provide Nonogram Solver functionality.
+Nigel Galloway May 28th., 2016
+*)
+type N =
+  |X |B |V
+  static member fn n i =
+    let     fn n i = [for g = 0 to i-n do yield Array.init (n+g) (fun e -> if e >= g then X else B)]
+    let rec fi n i = [
+      match n with
+      | h::t -> match t with
+                | [] -> for g in fn h i do yield Array.append g (Array.init (i-g.Length) (fun _ -> B))
+                | _  -> for g in fn h ((i-List.sum t)+t.Length) do for a in fi t (i-g.Length-1) do yield Array.concat[g;[|B|];a]
+      | []   -> yield Array.init i (fun _ -> B)
+    ]
+    fi n i
+  static member fi n i = Array.map2 (fun n g -> match (n,g) with |X,X->X |B,B->B |_->V) n i
+  static member fg (n: N[]) (i: N[][]) g = n |> Seq.mapi (fun e n -> i.[e].[g] = n || i.[e].[g] = V) |> Seq.forall (fun n -> n)
+  static member fe (n: N[][]) = n|> Array.forall (fun n -> Array.forall (fun n -> n <> V) n)
+  static member fl n = n |> Array.Parallel.map (fun n -> Seq.reduce (fun n g -> N.fi n g) n)
+  static member fa (nga: list<N []>[]) ngb = Array.Parallel.mapi (fun i n -> List.filter (fun n -> N.fg n ngb i) n) nga
+  static member fo n i g e =
+    let na = N.fa n e
+    let ia = N.fl na
+    let ga = N.fa g ia
+    (na, ia, ga, (N.fl ga))
+  static member toStr n = match n with |X->"X"|B->"."|V->"?"
+  static member presolve ((na: list<N []>[]), (ga: list<N []>[])) =
+    let nb = N.fl na
+    let x = N.fa ga nb
+    let rec fn n i g e l =
+      let na,ia,ga,ea = N.fo n i g e
+      let el = ((Array.map (fun n -> List.length n) na), (Array.map (fun n -> List.length n) ga))
+      if ((fst el) = (fst l)) && ((snd el) = (snd l)) then (n,i,g,e,(Array.forall (fun n -> n = 1) (fst l))) else fn na ia ga ea el
+    fn na nb x (N.fl x) ((Array.map (fun n -> List.length n) na), (Array.map (fun n -> List.length n) ga))

Task/Nonogram-solver/F-Sharp/nonogram-solver-2.fs

@@ -0,0 +1,7 @@
+let fe (n : array<string>) i = n |> Array.collect (fun n -> [|N.fn [for g in n -> ((int)g-64)] i|])
+let fl (n : array<string>) (i : array<string>) = (fe n i.Length), (fe i n.Length)
+let rFile =
+  try
+    use file = File.OpenText @"nonogram.txt"
+    Some(fl (file.ReadLine().Split ' ') (file.ReadLine().Split ' '))
+  with | _  -> printfn "Error reading file" ; None

Task/Nonogram-solver/F-Sharp/nonogram-solver-3.fs

@@ -0,0 +1,2 @@
+let n,i,g,e,l = N.presolve rFile.Value
+if l then i |> Array.iter (fun n -> n |> Array.iter (fun n -> printf "%s" (N.toStr n));printfn "") else printfn "No unique solution"

Task/Nonogram-solver/Go/nonogram-solver.go

@@ -0,0 +1,184 @@
+package main
+
+import (
+    "fmt"
+    "strings"
+)
+
+type BitSet []bool
+
+func (bs BitSet) and(other BitSet) {
+    for i := range bs {
+        if bs[i] && other[i] {
+            bs[i] = true
+        } else {
+            bs[i] = false
+        }
+    }
+}
+
+func (bs BitSet) or(other BitSet) {
+    for i := range bs {
+        if bs[i] || other[i] {
+            bs[i] = true
+        } else {
+            bs[i] = false
+        }
+    }
+}
+
+func iff(cond bool, s1, s2 string) string {
+    if cond {
+        return s1
+    }
+    return s2
+}
+
+func newPuzzle(data [2]string) {
+    rowData := strings.Fields(data[0])
+    colData := strings.Fields(data[1])
+    rows := getCandidates(rowData, len(colData))
+    cols := getCandidates(colData, len(rowData))
+
+    for {
+        numChanged := reduceMutual(cols, rows)
+        if numChanged == -1 {
+            fmt.Println("No solution")
+            return
+        }
+        if numChanged == 0 {
+            break
+        }
+    }
+
+    for _, row := range rows {
+        for i := 0; i < len(cols); i++ {
+            fmt.Printf(iff(row[0][i], "# ", ". "))
+        }
+        fmt.Println()
+    }
+    fmt.Println()
+}
+
+// collect all possible solutions for the given clues
+func getCandidates(data []string, le int) [][]BitSet {
+    var result [][]BitSet
+    for _, s := range data {
+        var lst []BitSet
+        a := []byte(s)
+        sumBytes := 0
+        for _, b := range a {
+            sumBytes += int(b - 'A' + 1)
+        }
+        prep := make([]string, len(a))
+        for i, b := range a {
+            prep[i] = strings.Repeat("1", int(b-'A'+1))
+        }
+        for _, r := range genSequence(prep, le-sumBytes+1) {
+            bits := []byte(r[1:])
+            bitset := make(BitSet, len(bits))
+            for i, b := range bits {
+                bitset[i] = b == '1'
+            }
+            lst = append(lst, bitset)
+        }
+        result = append(result, lst)
+    }
+    return result
+}
+
+func genSequence(ones []string, numZeros int) []string {
+    le := len(ones)
+    if le == 0 {
+        return []string{strings.Repeat("0", numZeros)}
+    }
+    var result []string
+    for x := 1; x < numZeros-le+2; x++ {
+        skipOne := ones[1:]
+        for _, tail := range genSequence(skipOne, numZeros-x) {
+            result = append(result, strings.Repeat("0", x)+ones[0]+tail)
+        }
+    }
+    return result
+}
+
+/* If all the candidates for a row have a value in common for a certain cell,
+   then it's the only possible outcome, and all the candidates from the
+   corresponding column need to have that value for that cell too. The ones
+   that don't, are removed. The same for all columns. It goes back and forth,
+   until no more candidates can be removed or a list is empty (failure).
+*/
+
+func reduceMutual(cols, rows [][]BitSet) int {
+    countRemoved1 := reduce(cols, rows)
+    if countRemoved1 == -1 {
+        return -1
+    }
+    countRemoved2 := reduce(rows, cols)
+    if countRemoved2 == -1 {
+        return -1
+    }
+    return countRemoved1 + countRemoved2
+}
+
+func reduce(a, b [][]BitSet) int {
+    countRemoved := 0
+    for i := 0; i < len(a); i++ {
+        commonOn := make(BitSet, len(b))
+        for j := 0; j < len(b); j++ {
+            commonOn[j] = true
+        }
+        commonOff := make(BitSet, len(b))
+
+        // determine which values all candidates of a[i] have in common
+        for _, candidate := range a[i] {
+            commonOn.and(candidate)
+            commonOff.or(candidate)
+        }
+
+        // remove from b[j] all candidates that don't share the forced values
+        for j := 0; j < len(b); j++ {
+            fi, fj := i, j
+            for k := len(b[j]) - 1; k >= 0; k-- {
+                cnd := b[j][k]
+                if (commonOn[fj] && !cnd[fi]) || (!commonOff[fj] && cnd[fi]) {
+                    lb := len(b[j])
+                    copy(b[j][k:], b[j][k+1:])
+                    b[j][lb-1] = nil
+                    b[j] = b[j][:lb-1]
+                    countRemoved++
+                }
+            }
+            if len(b[j]) == 0 {
+                return -1
+            }
+        }
+    }
+    return countRemoved
+}
+
+func main() {
+    p1 := [2]string{"C BA CB BB F AE F A B", "AB CA AE GA E C D C"}
+
+    p2 := [2]string{
+        "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
+        "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA",
+    }
+
+    p3 := [2]string{
+        "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH " +
+            "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+        "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF " +
+            "AAAAD BDG CEF CBDB BBB FC",
+    }
+
+    p4 := [2]string{
+        "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+        "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ " +
+            "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM",
+    }
+
+    for _, puzzleData := range [][2]string{p1, p2, p3, p4} {
+        newPuzzle(puzzleData)
+    }
+}

Task/Nonogram-solver/Haskell/nonogram-solver.hs

@@ -0,0 +1,132 @@
+import           Control.Applicative          ((<|>))
+import           Control.Monad
+import           Control.Monad.CSP
+import           Data.List                    (transpose)
+import           System.Environment           (getArgs)
+import           Text.ParserCombinators.ReadP (ReadP)
+import qualified Text.ParserCombinators.ReadP as P
+import           Text.Printf                  (printf)
+
+main :: IO ()
+main = do
+    file <- parseArgs
+    printf "reading problem file from %s\n" file
+    ps <- parseProblems file
+    forM_ ps $ \p -> do
+        print p
+        putStrLn ""
+        printSolution $ solve p
+        putStrLn ""
+
+-------------------------------------------------------------------------------
+-- parsing
+-------------------------------------------------------------------------------
+
+parseArgs :: IO FilePath
+parseArgs = do
+    args <- getArgs
+    case args of
+        [file] -> return file
+        _      -> ioError $ userError "expected exactly one command line argument, the name of the problem file"
+
+data Problem = Problem
+    { rows :: [[Int]]
+    , cols :: [[Int]]
+    } deriving (Show, Read, Eq, Ord)
+
+entryP :: ReadP Int
+entryP = do
+    n <- fromEnum <$> P.get
+    if n < 65 || n > 90
+        then P.pfail
+        else return $ n - 64
+
+blankP, eolP :: ReadP Char
+blankP = P.char ' '
+eolP   = P.char '\n'
+
+entriesP :: ReadP [Int]
+entriesP = ([] <$ blankP) <|> P.many1 entryP
+
+lineP :: ReadP [[Int]]
+lineP = P.sepBy1 entriesP blankP <* eolP
+
+problemP :: ReadP Problem
+problemP = Problem <$> lineP <*> lineP
+
+problemsP :: ReadP [Problem]
+problemsP = P.sepBy1 problemP (P.many blankP <* eolP) <* P.eof
+
+parseProblems :: FilePath -> IO [Problem]
+parseProblems file = do
+    s <- readFile file
+    case P.readP_to_S problemsP s of
+        [(ps, "")] -> return ps
+        _          -> ioError $ userError $ "error parsing file " <> file
+
+-------------------------------------------------------------------------------
+-- CSP
+-------------------------------------------------------------------------------
+
+solve :: Problem -> [[Bool]]
+solve = oneCSPSolution . problemCSP
+
+problemCSP :: Problem -> CSP r [[DV r Bool]]
+problemCSP p = do
+    let rowCount = length $ rows p
+        colCount = length $ cols p
+    cells <- replicateM rowCount
+           $ replicateM colCount
+           $ mkDV [False, True]
+
+    forM_ (zip cells             $ rows p) $ uncurry rowOrColCSP
+    forM_ (zip (transpose cells) $ cols p) $ uncurry rowOrColCSP
+
+    return cells
+
+rowOrColCSP :: [DV r Bool] -> [Int] -> CSP r ()
+rowOrColCSP ws [] = forM_ ws $ constraint1 not
+rowOrColCSP ws xs = do
+    let vs = zip [0 ..] ws
+        n  = length ws
+
+    blocks <- forM xs $ \x ->
+        mkDV [(i, i + x - 1) | i <- [0 .. n - x]] -- the blocks, given by first and last index
+
+    -- blocks must be separate and not overlapping
+    f blocks
+
+    -- cells in blocks are set
+    forM_ blocks $ \x ->
+        forM_ vs $ \(i, y) ->
+            constraint2 (\(x1, x2) b -> i < x1 || i > x2 || b) x y
+
+    -- cells before the first block are not set
+    forM_ vs $ \(i, y) ->
+        constraint2 (\(y', _) b -> i >= y' || not b) (head blocks) y
+
+    -- cells after the last block are not set
+    forM_ vs $ \(i, y) ->
+        constraint2 (\(_, y') b -> i <= y' || not b) (last blocks) y
+
+    -- cells between blocks are not set
+    forM_ (zip blocks $ tail blocks) $ \(x, y) ->
+        forM_ vs $ \(i, z) ->
+            constraint3 (\(_, x') (y', _) b -> i <= x' || i >= y' || not b) x y z
+  where
+    f :: [DV r (Int, Int)] -> CSP r ()
+    f (u : v : bs) = do
+        constraint2 (\(_, u') (v', _) -> v' >= u' + 2)  u v
+        f $ v : bs
+    f _            = return ()
+
+-------------------------------------------------------------------------------
+-- printing
+-------------------------------------------------------------------------------
+
+printSolution :: [[Bool]] -> IO ()
+printSolution bss =
+    forM_ bss $ \bs -> do
+        forM_ bs $ \b ->
+            putChar $ if b then '#' else '.'
+        putChar '\n'

Task/Nonogram-solver/Java/nonogram-solver.java

@@ -0,0 +1,142 @@
+import java.util.*;
+import static java.util.Arrays.*;
+import static java.util.stream.Collectors.toList;
+
+public class NonogramSolver {
+
+    static String[] p1 = {"C BA CB BB F AE F A B", "AB CA AE GA E C D C"};
+
+    static String[] p2 = {"F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC", "D D AE "
+        + "CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"};
+
+    static String[] p3 = {"CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH "
+        + "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+        "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF "
+        + "AAAAD BDG CEF CBDB BBB FC"};
+
+    static String[] p4 = {"E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q "
+        + "R AN AAN EI H G", "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ "
+        + "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"};
+
+    public static void main(String[] args) {
+        for (String[] puzzleData : new String[][]{p1, p2, p3, p4})
+            newPuzzle(puzzleData);
+    }
+
+    static void newPuzzle(String[] data) {
+        String[] rowData = data[0].split("\\s");
+        String[] colData = data[1].split("\\s");
+
+        List<List<BitSet>> cols, rows;
+        rows = getCandidates(rowData, colData.length);
+        cols = getCandidates(colData, rowData.length);
+
+        int numChanged;
+        do {
+            numChanged = reduceMutual(cols, rows);
+            if (numChanged == -1) {
+                System.out.println("No solution");
+                return;
+            }
+        } while (numChanged > 0);
+
+        for (List<BitSet> row : rows) {
+            for (int i = 0; i < cols.size(); i++)
+                System.out.print(row.get(0).get(i) ? "# " : ". ");
+            System.out.println();
+        }
+        System.out.println();
+    }
+
+    // collect all possible solutions for the given clues
+    static List<List<BitSet>> getCandidates(String[] data, int len) {
+        List<List<BitSet>> result = new ArrayList<>();
+
+        for (String s : data) {
+            List<BitSet> lst = new LinkedList<>();
+
+            int sumChars = s.chars().map(c -> c - 'A' + 1).sum();
+            List<String> prep = stream(s.split(""))
+                    .map(x -> repeat(x.charAt(0) - 'A' + 1, "1")).collect(toList());
+
+            for (String r : genSequence(prep, len - sumChars + 1)) {
+                char[] bits = r.substring(1).toCharArray();
+                BitSet bitset = new BitSet(bits.length);
+                for (int i = 0; i < bits.length; i++)
+                    bitset.set(i, bits[i] == '1');
+                lst.add(bitset);
+            }
+            result.add(lst);
+        }
+        return result;
+    }
+
+    // permutation generator, translated from Python via D
+    static List<String> genSequence(List<String> ones, int numZeros) {
+        if (ones.isEmpty())
+            return asList(repeat(numZeros, "0"));
+
+        List<String> result = new ArrayList<>();
+        for (int x = 1; x < numZeros - ones.size() + 2; x++) {
+            List<String> skipOne = ones.stream().skip(1).collect(toList());
+            for (String tail : genSequence(skipOne, numZeros - x))
+                result.add(repeat(x, "0") + ones.get(0) + tail);
+        }
+        return result;
+    }
+
+    static String repeat(int n, String s) {
+        StringBuilder sb = new StringBuilder();
+        for (int i = 0; i < n; i++)
+            sb.append(s);
+        return sb.toString();
+    }
+
+    /* If all the candidates for a row have a value in common for a certain cell,
+    then it's the only possible outcome, and all the candidates from the
+    corresponding column need to have that value for that cell too. The ones
+    that don't, are removed. The same for all columns. It goes back and forth,
+    until no more candidates can be removed or a list is empty (failure). */
+
+    static int reduceMutual(List<List<BitSet>> cols, List<List<BitSet>> rows) {
+        int countRemoved1 = reduce(cols, rows);
+        if (countRemoved1 == -1)
+            return -1;
+
+        int countRemoved2 = reduce(rows, cols);
+        if (countRemoved2 == -1)
+            return -1;
+
+        return countRemoved1 + countRemoved2;
+    }
+
+    static int reduce(List<List<BitSet>> a, List<List<BitSet>> b) {
+        int countRemoved = 0;
+
+        for (int i = 0; i < a.size(); i++) {
+
+            BitSet commonOn = new BitSet();
+            commonOn.set(0, b.size());
+            BitSet commonOff = new BitSet();
+
+            // determine which values all candidates of ai have in common
+            for (BitSet candidate : a.get(i)) {
+                commonOn.and(candidate);
+                commonOff.or(candidate);
+            }
+
+            // remove from bj all candidates that don't share the forced values
+            for (int j = 0; j < b.size(); j++) {
+                final int fi = i, fj = j;
+
+                if (b.get(j).removeIf(cnd -> (commonOn.get(fj) && !cnd.get(fi))
+                        || (!commonOff.get(fj) && cnd.get(fi))))
+                    countRemoved++;
+
+                if (b.get(j).isEmpty())
+                    return -1;
+            }
+        }
+        return countRemoved;
+    }
+}

Task/Nonogram-solver/Julia/nonogram-solver.julia

@@ -0,0 +1,150 @@
+using Base.Iterators
+
+struct NonogramPuzzle
+    nrows::Int
+    ncols::Int
+    xhints::Vector{Vector{Int}}
+    yhints::Vector{Vector{Int}}
+    solutions:: Vector{Any}
+    NonogramPuzzle(xh, yh) = new(length(xh), length(yh), xh, yh, Vector{NTuple{4,Array{Int64,1}}}())
+end
+
+ycols2xrows(ycols) = [[ycols[i][j] for i in eachindex(ycols)] for j in eachindex(ycols[1])]
+
+function hintsfromcol(rowvec, col, nrows)
+    hints = Vector{Int}()
+    hintrun = 0
+    for row in rowvec
+        if row[col] != 0
+            hintrun += 1
+            if col == nrows
+                push!(hints, hintrun)
+            end
+        elseif hintrun > 0
+            push!(hints, hintrun)
+            hintrun = 0
+        end
+    end
+    hints
+end
+
+function nonoblocks(hints, len)
+    minsized(arr) = vcat(map(x -> vcat(fill(1, x), [0]), arr)...)[1:end-1]
+    minlen(arr) = sum(arr) + length(arr) - 1
+    if isempty(hints)
+        return fill(0, len)
+    elseif minlen(hints) == len
+        return minsized(hints)
+    end
+    possibilities = Vector{Vector{Int}}()
+    allbuthead = hints[2:end]
+    for leftspace in 0:(len - minlen(hints))
+        header = vcat(fill(0, leftspace), fill(1, hints[1]), [0])
+        rightspace = len - length(header)
+        if isempty(allbuthead)
+            push!(possibilities, rightspace <= 0 ? header[1:len] : vcat(header, fill(0, rightspace)))
+        elseif minlen(allbuthead) == rightspace
+            push!(possibilities, vcat(header, minsized(allbuthead)))
+        else
+            foreach(x -> push!(possibilities, vcat(header, x)), nonoblocks(allbuthead, rightspace))
+        end
+    end
+    possibilities
+end
+
+function exclude!(xchoices, ychoices)
+    andvec(a) = findall(x -> x == 1, foldl((x, y) -> [x[i] & y[i] for i in 1:length(x)], a))
+    orvec(a)  = findall(x -> x == 0, foldl((x, y) -> [x[i] | y[i] for i in 1:length(x)], a))
+    filterbyval!(arr, val, pos) =  if !isempty(arr) filter!(x -> x[pos] == val, arr); end
+    ensurevecvec(arr::Vector{Vector{Int}}) = arr
+    ensurevecvec(arr::Vector{Int}) = [arr]
+    function excl!(choices, otherchoices)
+        for i in 1:length(choices)
+            if length(choices[i]) > 0
+                all1 = andvec(choices[i])
+                all0 = orvec(choices[i])
+                foreach(n -> filterbyval!(otherchoices[n], 1, i), all1)
+                foreach(n -> filterbyval!(otherchoices[n], 0, i), all0)
+            end
+        end
+    end
+    xclude!(x, y) = (excl!(x, y); x = map(ensurevecvec, x); y = map(ensurevecvec, y); (x, y))
+    xlen, ylen = sum(map(length, xchoices)), sum(map(length, ychoices))
+    while true
+        ychoices, xchoices = xclude!(ychoices, xchoices)
+        if any(isempty, xchoices)
+            return
+        end
+        xchoices, ychoices = xclude!(xchoices, ychoices)
+        if any(isempty, ychoices)
+            return
+        end
+        newxlen, newylen = sum(map(length, xchoices)), sum(map(length, ychoices))
+        if newxlen == xlen && newylen == ylen
+            return
+        end
+        xlen, ylen = newxlen, newylen
+    end
+end
+
+function trygrids(nonogram)
+    xchoices = [nonoblocks(nonogram.xhints[i], nonogram.ncols) for i in 1:nonogram.nrows]
+    ychoices = [nonoblocks(nonogram.yhints[i], nonogram.nrows) for i in 1:nonogram.ncols]
+    exclude!(xchoices, ychoices)
+    if all(x -> length(x) == 1, xchoices)
+        println("Unique solution.")
+        push!(nonogram.solutions, [x[1] for x in xchoices])
+    elseif all(x -> length(x) == 1, ychoices)
+        println("Unique solution.")
+        ycols = [y[1] for y in ychoices]
+        push!(nonogram.solutions, ycols2xrows(ycols))
+    else
+        println("Brute force: $(prod(map(length, xchoices))) possibilities.")
+        for stack in product(xchoices...)
+            arr::Vector{Vector{Int}} = [i isa Vector ? i : [i] for i in stack]
+            if all(x -> length(x) == nonogram.ncols, arr) &&
+               all(y -> hintsfromcol(arr, y, nonogram.nrows) == nonogram.yhints[y], 1:nonogram.ncols)
+                push!(nonogram.solutions, arr)
+            end
+        end
+        nsoln = length(nonogram.solutions)
+        println(nsoln == 0 ? "No" : nsoln, " solutions.")
+    end
+end
+
+# The first puzzle below requires brute force, and the second has no solutions.
+const testnonograms = """
+B B A A
+B B A A
+
+B A A
+A A A
+
+C BA CB BB F AE F A B
+AB CA AE GA E C D C
+
+F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
+D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
+
+CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
+BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
+
+E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
+E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM
+"""
+
+function processtestpuzzles(txt)
+    solutiontxt(a) = (s = ""; for r in a for c in r; s *= (c == 0 ? "." : "#") end; s *= "\n" end; s)
+    txtline2ints(s) = [[UInt8(ch - 'A' + 1) for ch in r] for r in split(s, r"\s+")]
+    linepairs = uppercase.(string.(split(txt, "\n\n")))
+    pcount = 0
+    for xyhints in linepairs
+        xh, yh = map(x -> txtline2ints(strip(x)), split(xyhints, "\n"))
+        nonogram = NonogramPuzzle(xh, yh)
+        println("\nPuzzle $(pcount += 1):")
+        trygrids(nonogram)
+        foreach(x -> println(solutiontxt(x), "\n"), nonogram.solutions)
+    end
+end
+
+processtestpuzzles(testnonograms)

Task/Nonogram-solver/Kotlin/nonogram-solver.kotlin

@@ -0,0 +1,130 @@
+// version 1.2.0
+
+import java.util.BitSet
+
+typealias BitSets = List<MutableList<BitSet>>
+
+val rx = Regex("""\s""")
+
+fun newPuzzle(data: List<String>) {
+    val rowData = data[0].split(rx)
+    val colData = data[1].split(rx)
+    val rows = getCandidates(rowData, colData.size)
+    val cols = getCandidates(colData, rowData.size)
+
+    do {
+        val numChanged = reduceMutual(cols, rows)
+        if (numChanged == -1) {
+            println("No solution")
+            return
+        }
+    }
+    while (numChanged > 0)
+
+    for (row in rows) {
+        for (i in 0 until cols.size) {
+            print(if (row[0][i]) "# " else ". ")
+        }
+        println()
+    }
+    println()
+}
+
+// collect all possible solutions for the given clues
+fun getCandidates(data: List<String>, len: Int): BitSets {
+    val result = mutableListOf<MutableList<BitSet>>()
+    for (s in data) {
+        val lst = mutableListOf<BitSet>()
+        val a = s.toCharArray()
+        val sumChars = a.sumBy { it - 'A' + 1 }
+        val prep = a.map { "1".repeat(it - 'A' + 1) }
+
+        for (r in genSequence(prep, len - sumChars + 1)) {
+            val bits = r.substring(1).toCharArray()
+            val bitset = BitSet(bits.size)
+            for (i in 0 until bits.size) bitset[i] = bits[i] == '1'
+            lst.add(bitset)
+        }
+        result.add(lst)
+    }
+    return result
+}
+
+fun genSequence(ones: List<String>, numZeros: Int): List<String> {
+    if (ones.isEmpty()) return listOf("0".repeat(numZeros))
+    val result = mutableListOf<String>()
+    for (x in 1 until numZeros - ones.size + 2) {
+        val skipOne = ones.drop(1)
+        for (tail in genSequence(skipOne, numZeros - x)) {
+            result.add("0".repeat(x) + ones[0] + tail)
+        }
+    }
+    return result
+}
+
+/* If all the candidates for a row have a value in common for a certain cell,
+    then it's the only possible outcome, and all the candidates from the
+    corresponding column need to have that value for that cell too. The ones
+    that don't, are removed. The same for all columns. It goes back and forth,
+    until no more candidates can be removed or a list is empty (failure).
+*/
+
+fun reduceMutual(cols: BitSets, rows: BitSets): Int {
+    val countRemoved1 = reduce(cols, rows)
+    if (countRemoved1 == -1) return -1
+    val countRemoved2 = reduce(rows, cols)
+    if (countRemoved2 == -1) return -1
+    return countRemoved1 + countRemoved2
+}
+
+fun reduce(a: BitSets, b: BitSets): Int {
+    var countRemoved = 0
+    for (i in 0 until a.size) {
+        val commonOn = BitSet()
+        commonOn[0] = b.size
+        val commonOff = BitSet()
+
+        // determine which values all candidates of a[i] have in common
+        for (candidate in a[i]) {
+            commonOn.and(candidate)
+            commonOff.or(candidate)
+        }
+
+        // remove from b[j] all candidates that don't share the forced values
+        for (j in 0 until b.size) {
+            val fi = i
+            val fj = j
+            if (b[j].removeIf { cnd ->
+                (commonOn[fj] && !cnd[fi]) ||
+                (!commonOff[fj] && cnd[fi]) }) countRemoved++
+            if (b[j].isEmpty()) return -1
+        }
+    }
+    return countRemoved
+}
+
+val p1 = listOf("C BA CB BB F AE F A B", "AB CA AE GA E C D C")
+
+val p2 = listOf(
+    "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
+    "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"
+)
+
+val p3 = listOf(
+    "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH " +
+    "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+    "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF " +
+    "AAAAD BDG CEF CBDB BBB FC"
+)
+
+val p4 = listOf(
+    "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+    "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ " +
+    "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"
+)
+
+fun main(args: Array<String>) {
+    for (puzzleData in listOf(p1, p2, p3, p4)) {
+        newPuzzle(puzzleData)
+    }
+}

Task/Nonogram-solver/Mathematica/nonogram-solver.math

@@ -0,0 +1,65 @@
+ClearAll[VisualizeGrid, Possibilities, TryRow, TryColumn]
+VisualizeGrid[candgrid_List] := StringRiffle[StringJoin/@Replace[candgrid,{{0}->" ",{1}->"#",{0,1}|{1,0}->"."},{2}],"\n"]
+Possibilities[clues_List, len_Integer] := Module[{spaces, numclue, spacecands, cands},
+  numclue = Length[clues];
+  spaces = len - Total[clues];
+  spacecands = IntegerPartitions[spaces, {numclue - 1}];
+  spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
+  cands = Catenate[Riffle[ConstantArray[1, #] & /@ clues, ConstantArray[0, #] & /@ #]] & /@ spacecands;
+  spacecands = IntegerPartitions[spaces, {numclue}];
+  spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
+  cands = Join[cands, Catenate[Riffle[ConstantArray[1, #] & /@ clues, ConstantArray[0, #] & /@ #]] & /@ spacecands];
+  cands = Join[cands, Catenate[Riffle[ConstantArray[0, #] & /@ #, ConstantArray[1, #] & /@ clues]] & /@ spacecands];
+
+  spacecands = IntegerPartitions[spaces, {numclue + 1}];
+  spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
+  cands = Join[cands, Catenate[Riffle[ConstantArray[0, #] & /@ #, ConstantArray[1, #] & /@ clues]] & /@ spacecands];
+
+  cands
+ ]
+TryRow[candgrid_List, i_Integer, hclues_List] := Module[{row, clue, len, poss, newgrid},
+  row = candgrid[[i]];
+  clue = hclues[[i]];
+  len = Length[row];
+  poss = Possibilities[clue, len];
+  poss //= Select[MatchQ[Alternatives @@@ row]];
+  poss //= Transpose;
+  poss //= Map[Union];
+  newgrid = candgrid;
+  newgrid[[i]] = poss;
+  newgrid
+ ]
+TryColumn[candgrid_List, i_Integer, hclues_List] := Transpose[TryRow[Transpose[candgrid], i, hclues]]
+puzzles = "C BA CB BB F AE F A B
+AB CA AE GA E C D C
+
+F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
+D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
+
+CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
+BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
+
+E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
+E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM";
+puzzles = StringSplit[puzzles, "\n\n"];
+puzzles = StringSplit[#, "\n"] & /@ puzzles;
+puzzles = Map[StringSplit[#, " "] &, puzzles, {2}];
+puzzles = Map[Characters, puzzles, {3}];
+puzzles = puzzles /. Thread[CharacterRange["A", "Z"] -> (ToString /@ Range[26])];
+puzzles = Map[ToExpression, puzzles, {4}];
+
+Do[
+ hclues = puzzles[[n, 1]];
+ vclues = puzzles[[n, 2]];
+ {hsize, vsize} = {vclues // Length, hclues // Length};
+ cand = ConstantArray[{0, 1}, {vsize, hsize}];
+ oldcand = {};
+ While[oldcand =!= cand,
+  oldcand = cand;
+  Do[cand = TryRow[cand, i, hclues], {i, Length[hclues]}];
+  Do[cand = TryColumn[cand, i, vclues], {i, Length[vclues]}];
+  ];
+ Print@VisualizeGrid[cand]
+ ,
+ {n, 4}
+ ]

Task/Nonogram-solver/Nim/nonogram-solver.nim

@@ -0,0 +1,151 @@
+import std/[bitops, math, sequtils, strutils]
+
+type
+
+  # Lengths of distinct runs of occupied cells.
+  Lengths = seq[int]
+
+  # Possibility, i.e. sequence of bits managed as an integer.
+  Possibility = int
+
+  # Possibilities described by two masks and a list of integer values.
+  Possibilities = object
+    mask0: int        # Mask indicating the positions of free cells.
+    mask1: int        # Mask indicating the positions of occupied cells.
+    list: seq[int]    # List of possibilities.
+
+
+proc genSequence(ones: seq[int]; numZeroes: Natural): seq[Possibility] =
+  ## Generate a sequence of possibilities.
+  if ones.len == 0: return @[0]
+  for x in 1..(numZeroes - ones.len + 1):
+    for tail in genSequence(ones[1..^1], numZeroes - x):
+      result.add (tail shl countSetBits(ones[0]) or ones[0]) shl x
+
+
+proc initPossibilities(lengthsList: openArray[Lengths]; length: Positive): seq[Possibilities] =
+  ## Initialize the list of possibilities from a list of lengths.
+
+  let initMask0 = 1 shl length - 1
+  for lengths in lengthsList:
+    let sumLengths = sum(lengths)
+    let prep = lengths.mapIt(1 shl it - 1)
+    let possList = genSequence(prep, length - sumLengths + 1).mapIt(it shr 1)
+    result.add Possibilities(mask0: initMask0, mask1: 0, list: possList)
+
+
+func updateUnset(possList: var seq[Possibilities]; mask, rank: int) =
+  ## Update the lists of possibilities keeping only those
+  ## compatible with the mask (for bits not set only).
+  var mask = mask
+  for poss in possList.mitems:
+    if (mask and 1) == 0:
+      for i in countdown(poss.list.high, 0):
+        if poss.list[i].testBit(rank):
+          # Bit is set, so the value is not compatible: remove it.
+          poss.list.delete(i)
+    mask = mask shr 1
+
+
+func updateSet(possList: var seq[Possibilities]; mask, rank: int) =
+  ## Update the lists of possibilities keeping only those
+  ## compatible with the mask (for bits set only).
+  var mask = mask
+  for poss in possList.mitems:
+    if (mask and 1) != 0:
+      for i in countdown(poss.list.high, 0):
+        if not poss.list[i].testBit(rank):
+          # Bit is not set, so the value is not compatible: remove it.
+          poss.list.delete(i)
+    mask = mask shr 1
+
+
+proc process(poss1, poss2: var seq[Possibilities]): bool =
+  ## Look at possibilities in list "poss1", compute the masks for
+  ## bits unset and bits set and update "poss2" accordingly.
+
+  var num = 0
+  for poss in poss1.mitems:
+
+    # Check bits unset.
+    var mask = 0
+    for value in poss.list:
+      mask = mask or value
+    if mask != poss.mask0:
+      # Mask has changed: update.
+      result = true
+      poss2.updateUnset(mask, num)
+      poss.mask0 = mask
+
+    # Check bits set.
+    mask = 1 shl poss2.len - 1
+    for value in poss.list:
+      mask = mask and value
+    if mask != poss.mask1:
+      # Mask has changed: update.
+      result = true
+      poss2.updateSet(mask, num)
+      poss.mask1 = mask
+
+    inc num
+
+
+proc solve(rowLengths, colLengths: openArray[Lengths]) =
+  ## Solve nonogram defined by "rowLengths" and "colLengths".
+
+  var
+    rowPoss = initPossibilities(rowLengths, colLengths.len)
+    colPoss = initPossibilities(colLengths, rowLengths.len)
+
+    # Solve nonogram.
+  var hasChanged = true
+  while hasChanged:
+    hasChanged = process(rowPoss, colPoss) or process(colPoss, rowPoss)
+
+  # Check if solved.
+  for poss in rowPoss:
+    if poss.list.len != 1:
+      echo "Unable to solve the nonogram."
+      return
+
+  # Display the solution.
+  for poss in rowPoss:
+    var line = ""
+    var val = poss.list[0]
+    for i in 0..colPoss.high:
+      line.add if val.testBit(i): "# " else: "  "
+    echo line
+
+
+func expand(s: string): seq[Lengths] =
+  ## Expand a compact description into a sequence of lengths.
+  for elem in s.splitWhitespace():
+    result.add elem.mapIt(ord(it) - ord('A') + 1)
+
+
+proc solve(rows, cols: string) =
+  ## Solve using compact description parameters.
+  solve(rows.expand(), cols.expand())
+
+
+when isMainModule:
+
+  const
+
+    Data1 = ("C BA CB BB F AE F A B", "AB CA AE GA E C D C")
+
+    Data2 = ("F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
+             "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA")
+
+    Data3 = ("CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+             "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC")
+
+    Data4 = ("E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+             "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")
+
+  for (rows, cols) in [Data1, Data2, Data3, Data4]:
+    echo rows
+    echo cols
+    echo ""
+    solve(rows, cols)
+    echo ""

Task/Nonogram-solver/Ol/nonogram-solver.ol

@@ -0,0 +1,161 @@
+(import (owl parse))
+
+; notation parser
+(define (subA x) (- x #\A -1))
+
+(define line
+   (let-parse* (
+         (words (greedy+ (let-parse* (
+               (* (greedy* (imm #\space)))
+               (word (greedy+ (byte-if (lambda (x) (<= #\A x #\Z))))))
+            (map subA word))))
+         (* (maybe (imm #\newline) #f)))
+      words))
+
+(define nonogram-parser
+   (let-parse* (
+         (rows line)
+         (cols line))
+      (cons rows cols)))
+
+; nonogram printer
+(define (print-nonogram ng solve)
+   (for-each (lambda (row y)
+         (for-each (lambda (x)
+               (if (list-ref (list-ref (car solve) y) x)
+                  (display "X ")
+                  (display ". ")))
+            (iota (length (cdr ng))))
+         (for-each (lambda (i)
+               (display " ")
+               (display i))
+            row)
+         (print))
+      (car ng)
+      (iota (length (car ng))))
+   (for-each (lambda (i)
+         (for-each (lambda (col)
+               (let ((n (lref col i)))
+                  (if n (display n) (display " ")))
+               (display " "))
+            (cdr ng))
+         (print))
+      (iota (fold (lambda (f col) (max f (length col))) 0 (cdr ng)) 0)))
+
+; possible permutation generator
+(define (permutate blacks len)
+   ; empty cells distibutions (with minimal count)
+   (define whites (append '(0) (repeat 1 (- (length blacks) 1)) '(0)))
+   (define total (- len (apply + blacks))) ; total summ of empty cells
+
+   (define (combine whites blacks)
+      ; size of whites is always equal to size of blacks+1
+      (let loop ((line #null) (v #f) (w (reverse whites)) (b (reverse blacks)))
+         (if (null? w)
+            line
+         else
+            (loop (append (repeat v (car w)) line)
+                  (not v)
+                  b
+                  (cdr w)))))
+
+   (map (lambda (whites) (combine whites blacks))
+      (let loop ((ll whites) (max total))
+         (if (null? (cdr ll))
+            (list (list max))
+         else
+            (define sum (apply + ll))
+            (define left (- max sum))
+            (if (eq? left 0)
+               (list ll)
+               else
+                  (define head (car ll))
+                  (fold (lambda (f i)
+                           (define sublist (loop (cdr ll) (- max head i)))
+                           (fold (lambda (f x)
+                                    (cons (cons (+ head i) x) f))
+                              f
+                              sublist))
+                     #null
+                     (iota (+ left 1))))))))
+
+; siever of impossible combinations
+(define (sieve rows cols) ; -> new cols
+   (fold (lambda (cols i)
+         ; for every cell define a "definitely black" and "definitely white" cells
+         (define blacks (fold (lambda (f x)
+               (map (lambda (a b) (and a b)) f x))
+               (repeat #t (length cols))
+               (list-ref rows i)))
+         (define whites (fold (lambda (f x)
+               (map (lambda (a b) (or a b)) f x))
+               (repeat #f (length cols))
+               (list-ref rows i)))
+         ; now filter the second list
+         (map (lambda (cols j)
+               (filter (lambda (col)
+                     (not (or
+                        (and (list-ref blacks j) (not (list-ref col i)))
+                        (and (not (list-ref whites j)) (list-ref col i)))))
+                  cols))
+            cols
+            (iota (length cols))))
+      cols
+      (iota (length rows))))
+
+; main solver cycle
+(define (solve rows-permuted cols-permuted)
+   (let loop ((rows rows-permuted) (cols cols-permuted) (flip #f))
+      (define new-cols (sieve rows cols))
+
+      (define fail (fold (lambda (f l) (or f (null? l))) #f new-cols))
+      (define done (fold (lambda (f l) (and f (null? (cdr l)))) #t new-cols))
+
+      (cond
+         (fail
+            #false)
+         (done
+            (if flip
+               (cons (map car new-cols) (map car rows))
+               (cons (map car rows) (map car new-cols))))
+         (else
+            (loop new-cols rows (not flip))))))
+
+; -=( main )=----------------------------------
+(define first "C BA CB BB F AE F A B
+AB CA AE GA E C D C")
+
+(define second "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
+D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA")
+
+(define third "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
+BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC")
+
+(define fourth "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
+E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")
+
+(for-each (lambda (str)
+      (print "nonogram:")
+      (print str) (print)
+      ; decode nonogram notation
+      (define nonogram (parse nonogram-parser (str-iter str) #f #f #f))
+
+      ; prepare arrays of all possible line b/w permutations
+      (define rows (car nonogram))
+      (define cols (cdr nonogram))
+
+      (define row-length (length cols))
+      (define col-length (length rows))
+
+      (define rows-permuted (map (lambda (x) (permutate x row-length)) rows))
+      (define cols-permuted (map (lambda (x) (permutate x col-length)) cols))
+
+      ; solve nonogram
+      (define answer (solve rows-permuted cols-permuted))
+
+      ; show the output
+      (if answer
+         (print-nonogram nonogram answer)
+         (print "Sorry, no aorrect answer found."))
+      (print))
+   (list first second third fourth))

Task/Nonogram-solver/Perl/nonogram-solver.pl

@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+
+my $file = 'nonogram_problems.txt';
+open my $fd, '<', $file or die "$! opening $file";
+
+while(my $row = <$fd> )
+  {
+  $row =~ /\S/ or next;
+  my $column = <$fd>;
+  my @rpats = makepatterns($row);
+  my @cpats = makepatterns($column);
+  my @rows = ( '.' x @cpats ) x @rpats;
+  for( my $prev = ''; $prev ne "@rows"; )
+    {
+    $prev = "@rows";
+    try(\@rows, \@rpats);
+    my @cols = map { join '', map { s/.//; $& } @rows } 0..$#cpats;
+    try(\@cols, \@cpats);
+    @rows = map { join '', map { s/.//; $& } @cols } 0..$#rpats;
+    }
+  print "\n", "@rows" =~ /\./ ? "Failed\n" : map { tr/01/.#/r, "\n" } @rows;
+  }
+
+sub try
+  {
+  my ($lines, $patterns) = @_;
+  for my $i ( 0 .. $#$lines )
+    {
+    while( $lines->[$i] =~ /\./g )
+      {
+      for my $try ( 0, 1 )
+        {
+        $lines->[$i] =~ s/.\G/$try/r =~ $patterns->[$i] or
+          $lines->[$i] =~ s// 1 - $try /e;
+        }
+      }
+    }
+  }
+
+sub makepatterns {                         #    numbered to show the 'logical' order of operations
+    map { qr/^$_$/                          # 7  convert strings to regex
+        } map {  '[0.]*'                    # 6a prepend static pattern
+               . join('[0.]+',              # 5  interleave with static pattern
+                       map { "[1.]{$_}"     # 4  require to match exactly 'n' times
+                           } map { -64+ord  # 3  convert letter value to repetition count 'n'
+                                 } split // # 2  for each letter in group
+                     )
+               . '[0.]*'                    # 6b append static pattern
+              } split ' ', shift;           # 1  for each letter grouping
+}

Task/Nonogram-solver/Phix/nonogram-solver.phix

@@ -0,0 +1,135 @@
+(phixonline)-->
+ <span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
+ <span style="color: #004080;">sequence</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">y</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">grid</span>
+ <span style="color: #004080;">integer</span> <span style="color: #000000;">unsolved</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">count_grid</span><span style="color: #0000FF;">()</span>
+ <span style="color: #004080;">integer</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)*</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+             <span style="color: #000000;">res</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'?'</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">match_mask</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">neat</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">ms</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">me</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">ms</span> <span style="color: #008080;">to</span> <span style="color: #000000;">me</span> <span style="color: #008080;">do</span>
+         <span style="color: #008080;">if</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'?'</span> <span style="color: #008080;">then</span>
+             <span style="color: #008080;">if</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">1</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">innr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">mi</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">=</span><span style="color: #008000;">""</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">neat</span><span style="color: #0000FF;">=</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
+         <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">mi</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+             <span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">' '</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+         <span style="color: #008080;">if</span> <span style="color: #000000;">match_mask</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mi</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">))</span> <span style="color: #008080;">then</span>
+             <span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
+                 <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">neat</span>
+             <span style="color: #008080;">else</span>
+                 <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+                     <span style="color: #008080;">if</span> <span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
+                         <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">'?'</span>
+                     <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+                 <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+             <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">else</span>
+         <span style="color: #004080;">integer</span> <span style="color: #000000;">b</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
+         <span style="color: #000000;">blocks</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
+         <span style="color: #004080;">integer</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)+</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span>
+                 <span style="color: #000000;">e</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">l</span><span style="color: #0000FF;">-</span><span style="color: #000000;">b</span>
+         <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">mi</span> <span style="color: #008080;">to</span> <span style="color: #000000;">e</span> <span style="color: #008080;">do</span>
+             <span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">i</span> <span style="color: #008080;">to</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
+                 <span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">'#'</span>
+             <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+             <span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
+                 <span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">' '</span>
+             <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+             <span style="color: #008080;">if</span> <span style="color: #000000;">match_mask</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mi</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">min</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">)))</span> <span style="color: #008080;">then</span>
+                 <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">innr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span>
+             <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+             <span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">' '</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">inner</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">innr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">res</span><span style="color: #0000FF;">:</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">global</span> <span style="color: #008080;">function</span> <span style="color: #000000;">vmask</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">source</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">column</span><span style="color: #0000FF;">)</span>
+ <span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">source</span><span style="color: #0000FF;">))</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">source</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">source</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">column</span><span style="color: #0000FF;">]</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">logic</span><span style="color: #0000FF;">()</span>
+ <span style="color: #004080;">integer</span> <span style="color: #000000;">wasunsolved</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">unsolved</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inner</span><span style="color: #0000FF;">(</span><span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">x</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #004080;">string</span> <span style="color: #000000;">tmp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inner</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vmask</span><span style="color: #0000FF;">(</span><span style="color: #000000;">grid</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">),</span><span style="color: #000000;">y</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
+         <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tmp</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+             <span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tmp</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #000000;">unsolved</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">count_grid</span><span style="color: #0000FF;">()</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">wasunsolved</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">unsolved</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #004080;">sequence</span> <span style="color: #000000;">tests</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"""
+ C BA CB BB F AE F A B
+ AB CA AE GA E C D C
+
+ F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
+ D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
+
+ CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
+ BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
+
+ E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
+ E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"""</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'\n'</span><span style="color: #0000FF;">)</span>
+ <span style="color: #000080;font-style:italic;">--Alternatively:
+ --integer fn = open("nonogram_problems.txt","r")
+ --tests = get_text(fn,GT_LF_STRIPPED)
+ --close(fn)</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">unpack</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
+ <span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #004080;">string</span> <span style="color: #000000;">ri</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
+         <span style="color: #004080;">sequence</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
+         <span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ri</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+             <span style="color: #000000;">r</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">ri</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]-</span><span style="color: #008000;">'A'</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+         <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">r</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">by</span> <span style="color: #000000;">3</span> <span style="color: #008080;">do</span>
+     <span style="color: #000000;">x</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">unpack</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
+     <span style="color: #000000;">y</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">unpack</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
+     <span style="color: #000000;">grid</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'?'</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)),</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">))</span>
+     <span style="color: #000000;">unsolved</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)*</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span>
+
+     <span style="color: #008080;">while</span> <span style="color: #000000;">unsolved</span> <span style="color: #008080;">do</span>
+         <span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">logic</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">then</span>
+             <span style="color: #0000FF;">?</span><span style="color: #008000;">"partial"</span>
+             <span style="color: #008080;">exit</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
+
+     <span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">grid</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)&</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+<!--

Task/Nonogram-solver/Picat/nonogram-solver.picat

@@ -0,0 +1,51 @@
+import util, sat.
+
+main =>
+    Hr = "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+    Hc = "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM",
+    Lr = [token_to_hints(Token) : Token in split(Hr)],
+    Lc = [token_to_hints(Token) : Token in split(Hc)],
+    MaxR = len(Lr),
+    MaxC = len(Lc),
+    foreach (Hints in Lr)
+        constrain_starts(Hints,MaxC)
+    end,
+    foreach (Hints in Lc)
+        constrain_starts(Hints,MaxR)
+    end,
+    M = new_array(MaxR,MaxC),
+    M :: 0..1,
+    foreach ({R,Hints} in zip(1..MaxR, Lr))
+        sum([M[R,C] : C in 1..MaxC]) #= sum([Num : (Num,_) in Hints])
+    end,
+    foreach ({R,Hints} in zip(1..MaxR, Lr), (Num,Start) in Hints, C in 1..MaxC-Num+1)
+        Start #= C #=> sum([M[R,C+I] : I in 0..Num-1]) #= Num
+    end,
+    %
+    foreach ({C,Hints} in zip(1..MaxC, Lc))
+        sum([M[R,C] : R in 1..MaxR]) #= sum([Num : (Num,_) in Hints])
+    end,
+    foreach ({C,Hints} in zip(1..MaxC, Lc), (Num,Start) in Hints, R in 1..MaxR-Num+1)
+        Start #= R #=> sum([M[R+I,C] : I in 0..Num-1]) #= Num
+    end,
+    solve((Lr,Lc,M)),
+    foreach (R in 1..MaxR)
+        foreach (C in 1..MaxC)
+            printf("%2c", cond(M[R,C] == 1, '#', '.'))
+        end,
+        nl
+    end.
+
+% convert "BCB" to [(2,_),(3,_),(2,_)]
+% a hint is a pair (Num,Start), where Num is the length of the 1 segment and Start is the starting row number or column number
+token_to_hints([]) = [].
+token_to_hints([C|Cs]) = [(ord(C)-ord('A')+1, _)|token_to_hints(Cs)].
+
+% there must be a gap between two neighboring segments
+constrain_starts([(Num,Start)],Max) =>
+    Start :: 1..Max,
+    Start+Num-1 #<= Max.
+constrain_starts([(Num1,Start1),(Num2,Start2)|L],Max) =>
+    Start1 :: 1..Max,
+    Start1+Num1 #< Start2,
+    constrain_starts([(Num2,Start2)|L],Max).

Task/Nonogram-solver/Prolog/nonogram-solver-1.pro

@@ -0,0 +1,67 @@
+/*
+* Nonogram/paint-by-numbers solver in SWI-Prolog. Uses CLP(FD),
+* in particular the automaton/3 (finite-state/RE) constraint.
+* Copyright (c) 2011 Lars Buitinck.
+* Do with this code as you like, but don't remove the copyright notice.
+*/
+
+:- use_module(library(clpfd)).
+
+nono(RowSpec, ColSpec, Grid) :-
+	rows(RowSpec, Grid),
+	transpose(Grid, GridT),
+	rows(ColSpec, GridT).
+
+rows([], []).
+rows([C|Cs], [R|Rs]) :-
+	row(C, R),
+	rows(Cs, Rs).
+
+row(Ks, Row) :-
+	sum(Ks, #=, Ones),
+	sum(Row, #=, Ones),
+	arcs(Ks, Arcs, start, Final),
+	append(Row, [0], RowZ),
+	automaton(RowZ, [source(start), sink(Final)], [arc(start,0,start) | Arcs]).
+
+% Make list of transition arcs for finite-state constraint.
+arcs([], [], Final, Final).
+arcs([K|Ks], Arcs, CurState, Final) :-
+	gensym(state, NextState),
+	(   K == 0
+	->  Arcs = [arc(CurState,0,CurState), arc(CurState,0,NextState) | Rest],
+	    arcs(Ks, Rest, NextState, Final)
+	;   Arcs = [arc(CurState,1,NextState) | Rest],
+	    K1 #= K-1,
+	    arcs([K1|Ks], Rest, NextState, Final)).
+
+
+make_grid(Grid, X, Y, Vars) :-
+	length(Grid,X),
+	make_rows(Grid, Y, Vars).
+
+make_rows([], _, []).
+make_rows([R|Rs], Len, Vars) :-
+	length(R, Len),
+	make_rows(Rs, Len, Vars0),
+	append(R, Vars0, Vars).
+
+print([]).
+print([R|Rs]) :-
+	print_row(R),
+	print(Rs).
+
+print_row([]) :- nl.
+print_row([X|R]) :-
+	(   X == 0
+	->  write(' ')
+	;   write('x')),
+	print_row(R).
+
+nonogram(Rows, Cols) :-
+	length(Rows, X),
+	length(Cols, Y),
+	make_grid(Grid, X, Y, Vars),
+	nono(Rows, Cols, Grid),
+	label(Vars),
+	print(Grid).

Task/Nonogram-solver/Prolog/nonogram-solver-2.pro

@@ -0,0 +1,24 @@
+nonogram :-
+	open('C:/Users/Utilisateur/Documents/Prolog/Rosetta/nonogram/nonogram.txt',
+	     read, In, []),
+	repeat,
+	     read_line_to_codes(In, Line_1),
+	     read_line_to_codes(In, Line_2),
+	     compute_values(Line_1, [], [], Lines),
+	     compute_values(Line_2, [], [], Columns),
+	     nonogram(Lines, Columns) , nl, nl,
+	read_line_to_codes(In, end_of_file),
+	close(In).
+
+compute_values([], Current, Tmp, R) :-
+	reverse(Current, R_Current),
+	reverse([R_Current | Tmp], R).
+
+compute_values([32 | T], Current, Tmp, R) :-
+	!,
+	reverse(Current, R_Current),
+	compute_values(T, [], [R_Current | Tmp], R).
+
+compute_values([X | T], Current, Tmp, R) :-
+	V is X - 64,
+	compute_values(T, [V | Current], Tmp, R).

Task/Nonogram-solver/Python/nonogram-solver-1.py

@@ -0,0 +1,119 @@
+from itertools import izip
+
+def gen_row(w, s):
+    """Create all patterns of a row or col that match given runs."""
+    def gen_seg(o, sp):
+        if not o:
+            return [[2] * sp]
+        return [[2] * x + o[0] + tail
+                for x in xrange(1, sp - len(o) + 2)
+                for tail in gen_seg(o[1:], sp - x)]
+
+    return [x[1:] for x in gen_seg([[1] * i for i in s], w + 1 - sum(s))]
+
+
+def deduce(hr, vr):
+    """Fix inevitable value of cells, and propagate."""
+    def allowable(row):
+        return reduce(lambda a, b: [x | y for x, y in izip(a, b)], row)
+
+    def fits(a, b):
+        return all(x & y for x, y in izip(a, b))
+
+    def fix_col(n):
+        """See if any value in a given column is fixed;
+        if so, mark its corresponding row for future fixup."""
+        c = [x[n] for x in can_do]
+        cols[n] = [x for x in cols[n] if fits(x, c)]
+        for i, x in enumerate(allowable(cols[n])):
+            if x != can_do[i][n]:
+                mod_rows.add(i)
+                can_do[i][n] &= x
+
+    def fix_row(n):
+        """Ditto, for rows."""
+        c = can_do[n]
+        rows[n] = [x for x in rows[n] if fits(x, c)]
+        for i, x in enumerate(allowable(rows[n])):
+            if x != can_do[n][i]:
+                mod_cols.add(i)
+                can_do[n][i] &= x
+
+    def show_gram(m):
+        # If there's 'x', something is wrong.
+        # If there's '?', needs more work.
+        for x in m:
+            print " ".join("x#.?"[i] for i in x)
+        print
+
+    w, h = len(vr), len(hr)
+    rows = [gen_row(w, x) for x in hr]
+    cols = [gen_row(h, x) for x in vr]
+    can_do = map(allowable, rows)
+
+    # Initially mark all columns for update.
+    mod_rows, mod_cols = set(), set(xrange(w))
+
+    while mod_cols:
+        for i in mod_cols:
+            fix_col(i)
+        mod_cols = set()
+        for i in mod_rows:
+            fix_row(i)
+        mod_rows = set()
+
+    if all(can_do[i][j] in (1, 2) for j in xrange(w) for i in xrange(h)):
+        print "Solution would be unique" # but could be incorrect!
+    else:
+        print "Solution may not be unique, doing exhaustive search:"
+
+    # We actually do exhaustive search anyway. Unique solution takes
+    # no time in this phase anyway, but just in case there's no
+    # solution (could happen?).
+    out = [0] * h
+
+    def try_all(n = 0):
+        if n >= h:
+            for j in xrange(w):
+                if [x[j] for x in out] not in cols[j]:
+                    return 0
+            show_gram(out)
+            return 1
+        sol = 0
+        for x in rows[n]:
+            out[n] = x
+            sol += try_all(n + 1)
+        return sol
+
+    n = try_all()
+    if not n:
+        print "No solution."
+    elif n == 1:
+        print "Unique solution."
+    else:
+        print n, "solutions."
+    print
+
+
+def solve(p, show_runs=True):
+    s = [[[ord(c) - ord('A') + 1 for c in w] for w in l.split()]
+         for l in p.splitlines()]
+    if show_runs:
+        print "Horizontal runs:", s[0]
+        print "Vertical runs:", s[1]
+    deduce(s[0], s[1])
+
+
+def main():
+    # Read problems from file.
+    fn = "nonogram_problems.txt"
+    for p in (x for x in open(fn).read().split("\n\n") if x):
+        solve(p)
+
+    print "Extra example not solvable by deduction alone:"
+    solve("B B A A\nB B A A")
+
+    print "Extra example where there is no solution:"
+    solve("B A A\nA A A")
+
+main()

Task/Nonogram-solver/Python/nonogram-solver-2.py

@@ -0,0 +1,104 @@
+from functools import reduce
+
+def gen_row(w, s):
+    """Create all patterns of a row or col that match given runs."""
+    def gen_seg(o, sp):
+        if not o:
+            return [[2] * sp]
+        return [[2] * x + o[0] + tail
+                for x in range(1, sp - len(o) + 2)
+                for tail in gen_seg(o[1:], sp - x)]
+
+    return [x[1:] for x in gen_seg([[1] * i for i in s], w + 1 - sum(s))]
+
+
+def deduce(hr, vr):
+    """Fix inevitable value of cells, and propagate."""
+    def allowable(row):
+        return reduce(lambda a, b: [x | y for x, y in zip(a, b)], row)
+
+    def fits(a, b):
+        return all(x & y for x, y in zip(a, b))
+
+    def fix_col(n):
+        """See if any value in a given column is fixed;
+        if so, mark its corresponding row for future fixup."""
+        c = [x[n] for x in can_do]
+        cols[n] = [x for x in cols[n] if fits(x, c)]
+        for i, x in enumerate(allowable(cols[n])):
+            if x != can_do[i][n]:
+                mod_rows.add(i)
+                can_do[i][n] &= x
+
+    def fix_row(n):
+        """Ditto, for rows."""
+        c = can_do[n]
+        rows[n] = [x for x in rows[n] if fits(x, c)]
+        for i, x in enumerate(allowable(rows[n])):
+            if x != can_do[n][i]:
+                mod_cols.add(i)
+                can_do[n][i] &= x
+
+    def show_gram(m):
+        # If there's 'x', something is wrong.
+        # If there's '?', needs more work.
+        for x in m:
+            print(" ".join("x#.?"[i] for i in x))
+        print()
+
+    w, h = len(vr), len(hr)
+    rows = [gen_row(w, x) for x in hr]
+    cols = [gen_row(h, x) for x in vr]
+    can_do = list(map(allowable, rows))
+
+    # Initially mark all columns for update.
+    mod_rows, mod_cols = set(), set(range(w))
+
+    while mod_cols:
+        for i in mod_cols:
+            fix_col(i)
+        mod_cols = set()
+        for i in mod_rows:
+            fix_row(i)
+        mod_rows = set()
+
+    if all(can_do[i][j] in (1, 2) for j in range(w) for i in range(h)):
+        print("Solution would be unique")  # but could be incorrect!
+    else:
+        print("Solution may not be unique, doing exhaustive search:")
+
+    # We actually do exhaustive search anyway. Unique solution takes
+    # no time in this phase anyway, but just in case there's no
+    # solution (could happen?).
+    out = [0] * h
+
+    def try_all(n = 0):
+        if n >= h:
+            for j in range(w):
+                if [x[j] for x in out] not in cols[j]:
+                    return 0
+            show_gram(out)
+            return 1
+        sol = 0
+        for x in rows[n]:
+            out[n] = x
+            sol += try_all(n + 1)
+        return sol
+
+    n = try_all()
+    if not n:
+        print("No solution.")
+    elif n == 1:
+        print("Unique solution.")
+    else:
+        print(n, "solutions.")
+    print()
+
+
+def solve(s, show_runs=True):
+    s = [[[ord(c) - ord('A') + 1 for c in w] for w in l.split()]
+         for l in p.splitlines()]
+    if show_runs:
+        print("Horizontal runs:", s[0])
+        print("Vertical runs:", s[1])
+    deduce(s[0], s[1])

Task/Nonogram-solver/REXX/nonogram-solver.rexx

@@ -0,0 +1,316 @@
+/*REXX*/
+    Parse Arg fn
+    Parse Var fn ou'.'
+    maxpn = 10000               /* maximum possibilities to check through */
+    output = ou'.out.txt'
+ /* read row/col values into rowpp. and colpp. arrays */
+    cc = linein(fn)
+    rows = words(cc)
+    dd = linein(fn)
+    cols = words(dd)
+    char = '0ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijk'
+    cntr = 0
+    Do i = 1 To rows
+       rowpp.i = CV(cc,i)
+       cntr = cntr + sum
+    End
+    cntc = 0
+    Do i = 1 To cols
+       colpp.i = CV(dd,i)
+       cntc = cntc + sum
+    End
+    If (cntr <> cntc)|(cntr = 0) Then Do
+       Say 'error Sum of rows <> sum of cols'
+       Exit 999
+    End
+    Say cntr 'colored cells'
+    ar = copies('-',rows*cols)
+ /* values are -=unknown .=blank @=Color */
+ /* PREFILL  array */
+    'erase' output
+ /**********COL PREFILL ************/
+    Do col = 1 To cols
+       r = colpp.col
+       Parse Var r z r
+       Do While r <> ''
+          Parse Var r q r
+          z = z + q + 1
+       End
+       result = copies('-',rows)
+       If z = rows Then result = FILL_LINE(colpp.col)
+       Else If z = 0 Then result = copies('.',rows)
+       Do row = 1 To rows
+          ar = overlay(substr(result,row,1),ar,(row-1)*cols+col)
+       End
+    End
+ /**********ROW PREFILL ************/
+    Do row = 1 To rows
+       c = rowpp.row
+       Parse Var c t c
+       Do While c <> ''
+          Parse Var c q c
+          t = t + q + 1
+       End
+       result = substr(ar,(row-1)*cols+1,cols)
+       If t = cols Then result = left(FILL_LINE(rowpp.row),cols)
+       Else If t = 0 Then result = copies('.',cols)
+       ar = overlay(result,ar,(row-1)*cols+1)
+    End
+ /********** ok here we loop ************/
+    cnttry = 1
+    nexttry = 2
+    next.cnttry = ar
+    sol = 0
+    Do label nextpos While cnttry < nexttry
+       Say 'trying' cnttry 'of' nexttry-1
+       ar = next.cnttry
+       cnttry = cnttry + 1
+       Do Until sar = ar
+          sar = ar
+          Do row = 1 To rows
+             /**********process rows ************/
+             rowcol = substr(ar,(row-1)*cols+1,cols)
+             pp = rowpp.row
+             If PROCESSROW() Then Iterate nextpos
+             Else ar = overlay(left(rowcol,cols),ar,(row-1)*cols+1)
+          End
+          Do col = 1 To cols
+             rowcol = ''
+             Do row = 1 To rows
+                rowcol = rowcol || substr(ar,(row-1)*cols+ col,1)
+             End
+             pp = colpp.col
+             If PROCESSROW() Then Iterate nextpos
+             Do row = 1 To rows
+                ar = overlay(substr(rowcol,row,1),ar,(row-1)*cols + col)
+             End
+          End
+          If pos('-',ar) = 0 Then Do       /* hurray we have a solution */
+             /* at this point we need to verify solution */
+             If CHECKBOARD() Then Iterate nextpos   /* too bad didn't match */
+             sol = sol + 1
+             Call LINEOUT output,'This is solution no:' sol
+             Call DUMPBOARD
+             Iterate nextpos
+          End
+          If sar = ar Then Do
+             fnd = pos('-',ar)
+             next.nexttry = overlay('.',ar,fnd)
+             nexttry = nexttry + 1
+             ar = overlay('@',ar,fnd)
+          End
+       End
+    End nextpos
+    If sol = 0 Then sol = 'No'
+    Say sol 'solutions found'
+    Exit
+
+ CHECKBOARD:
+    Do row = 1 To rows
+      /**********process rows ************/
+       rowcol = substr(ar,(row-1)*cols+1,cols)
+       pp = rowpp.row
+       If CHECKROW() Then Return 1
+    End
+    Do col = 1 To cols
+       rowcol = ''
+       Do row = 1 To rows
+          rowcol = rowcol || substr(ar,(row-1)*cols+ col,1)
+       End
+       pp = colpp.col
+       If CHECKROW() Then Return 1
+    End
+    Return 0                                               /* we did it */
+
+ CHECKROW:
+    len_item = length(rowcol)
+    st = 1
+    If pp = 0 Then Return rowcol <> copies('.',len_item)
+    Else If pp = len_item Then Return rowcol <> copies('@',len_item)
+    Do While (pp <> '') & (st <= len_item)
+       Parse Var pp p1 pp
+       of = pos('@',rowcol'@',st)
+       If of > len_item Then Return 1
+       If substr(rowcol,of,p1) <> copies('@',p1) Then Return 1
+       st = of + p1
+       If substr(rowcol'.',st,1) <> '.' Then Return 1
+    End
+    Return 0
+
+
+ DUMPBOARD:
+    Parse Arg qr
+    p = '..'
+    q = '..'
+    Do i = 1 To cols
+       n = right(i,2)
+       p = p left(n,1)
+       q = q right(n,1)
+    End
+    Call LINEOUT output, p
+    Call LINEOUT output, q
+    Do i = 1 To rows
+       o = right(i,2)
+       p = substr(ar,(i-1)*cols+1,cols)
+       Do j = 1 To cols
+          Parse Var p z +1 p
+          o = o z
+       End
+       Call LINEOUT output, o
+    End
+    Return
+
+ FILL_LINE:
+    Parse Arg items
+    oo = ''
+    Do While items <> ''
+       Parse Var items a items
+       oo = oo||copies('@',a)'.'
+    End
+    Return oo
+
+ CV:
+    Parse Arg cnts, rwcl
+    str = word(cnts,rwcl)
+    ret = ''
+    sum = 0
+    Do k = 1 To length(str)
+       this = pos(substr(str,k,1),char)-1
+       ret = ret this
+       sum = sum + this
+    End
+    Return space(ret)
+
+ PROCESSROW:                           /* rowcol pp in, rowcol pp of ol */
+    prerow = rowcol
+    len_item = length(rowcol)
+    If pos('-',rowcol) = 0 Then Do
+       pp = ''
+       Return 0
+    End
+    of = 1
+    kcnt = 0
+    /* reduce the left side with already populated values */
+    Do While (of < len_item) & (pp <> '')
+       kcnt = kcnt + 1
+       If kcnt > len_item Then Return 1
+       If substr(rowcol,of,1) = '.' Then Do
+          k = verify(substr(rowcol,of)'%','.')
+          of = of + k - 1
+          Iterate
+       End
+       nl = word(pp,1)
+       len = verify(substr(rowcol,of)'%','-@') - 1
+       If len < nl Then Do
+          rowcol = overlay(copies('.',len),rowcol,of)
+          of = of + len
+          Iterate
+       End
+       If (len = nl) & (pos('@',substr(rowcol,of,nl))>0) Then Do
+          rowcol = overlay(copies('@',nl),rowcol,of)
+          of = of + nl
+          pp = subword(pp,2)
+          Iterate
+       End
+       If substr(rowcol,of,1) = '@' Then Do
+          rowcol = overlay(copies('@',nl)'.',rowcol,of)
+          of = of + nl
+          pp = subword(pp,2)
+          Iterate
+       End
+       Leave
+    End
+    /* reduce the right side with already populated values */
+    ofm = len_item + 1 - of
+    ol = 1
+    kcnt = 0
+    Do While (ol < ofm) & (pp <> '')
+       kcnt = kcnt + 1
+       If kcnt > len_item Then Return 1
+       revrow = reverse(rowcol)
+       If substr(revrow,ol,1) = '.' Then Do
+          k = verify(substr(revrow,ol)'%','.')
+          ol = ol + k - 1
+          Iterate
+       End
+       nl = word(pp,words(pp))
+       len = verify(substr(revrow,ol)'%','-@') - 1
+       If len < nl Then Do
+          rowcol = overlay(copies('.',len),rowcol,len_item-ol-len+2)
+          ol = ol + len
+          Iterate
+       End
+       If (len = nl) & (pos('@',substr(revrow,ol,nl))>0) Then Do
+          rowcol = overlay(copies('@',nl),rowcol,len_item-ol-nl+2)
+          ol = ol + nl
+          pp = subword(pp,1,words(pp)-1)
+          Iterate
+       End
+       If substr(revrow,ol,1) = '@' Then Do
+          rowcol = overlay('.'copies('@',nl),rowcol,len_item-ol-nl+1)
+          ol = ol + nl
+          pp = subword(pp,1,words(pp)-1)
+          Iterate
+       End
+       Leave
+    End
+    If pp = 0 Then pp = ''
+    If pp = '' Then rowcol = changestr('-',rowcol,'.')
+    If pp <> '' Then Do
+       lv = len_item-of-ol+2
+       pos. = ''
+       pn = 0
+       pi = substr(rowcol,of,lv)
+       If (copies('-',length(pi)) = pi) Then Do
+          len = CNT(pp)
+          If (len + mx) <= lv Then Do
+             Return 0
+          End
+       End
+       /* oh oh need to check for posibilities */
+       Call TRY '',pp
+       If pn > maxpn Then Do
+          over = over + 1
+          Return 0
+       End
+       fnd = 0
+       fu = pos.1
+       Do z = 2 To pn
+          Do j = 1 To lv
+             If substr(fu,j,1) <> substr(pos.z,j,1) Then fu = overlay('-',fu,j)
+          End
+       End
+       Do z = 1 To lv
+          If substr(fu,z,1) <> '-' Then rowcol = overlay(substr(fu,z,1),rowcol,of+z-1)
+       End
+    End
+    Return 0
+ TRY: Procedure Expose pn pos. maxpn lv pi
+    Parse Arg prev,pp
+    If pp = '' Then Do
+       rem = substr(pi,length(prev)+1)
+       If translate(rem,'..','.-') <> copies('.',length(rem)) Then Return
+       prev = left(prev||copies('.',lv),lv)
+       pn = pn + 1
+       If pn > maxpn Then Return
+       pos.pn = prev
+       Return
+    End
+    Parse Var pp p1 pp
+    If length(prev)+p1 > lv Then Return
+    Do i = 0 To lv - length(prev)-p1
+       If translate(substr(pi,length(prev)+1,i),'..','.-') = copies('.',i) Then
+         If translate(substr(pi,length(prev)+i+1,p1),'@@','@-') = copies('@',p1) Then
+           If substr(pi,length(prev)+i+p1+1,1) <> '@' Then
+             Call TRY prev||copies('.',i)||copies('@',p1)'.',pp
+    End
+    Return
+ CNT: Procedure Expose mx
+    Parse Arg len items
+    mx = len
+    Do While items <> ''
+       Parse Var items ii items
+       len = len + ii + 1
+       If ii > mx Then mx = ii
+    End
+    Return len

Task/Nonogram-solver/Raku/nonogram-solver-1.raku

@@ -0,0 +1,100 @@
+# 20220401 Raku programming solution
+
+sub reduce(\a, \b) {
+   my \countRemoved = $ = 0;
+   for ^+a -> \i {
+      my \commonOn  = @ =  True xx b.elems;
+      my \commonOff = @ = False xx b.elems;
+
+      a[i].map: -> \candidate { commonOn  <<?&=>> candidate ;
+                                commonOff <<?|=>> candidate }
+      # remove from b[j] all candidates that don't share the forced values
+      for ^+b -> \j {
+         my (\fi,\fj) = i, j;
+         for ((+b[j])^...0) -> \k {
+            my \cnd = b[j][k];
+            if (commonOn[fj] ?& !cnd[fi]) ?| (!commonOff[fj] ?& cnd[fi]) {
+	       b[j][k..*-2] = b[j][k+1..*-1];
+               b[j].pop;
+               countRemoved++
+            }
+         }
+         return -1 if b[j].elems == 0
+      }
+   }
+   return countRemoved
+}
+
+sub genSequence(\ones, \numZeros) {
+   if ( my \le = ones.elems ) == 0 { return [~] '0' xx numZeros }
+
+   my @result;
+   loop ( my $x = 1; $x < ( numZeros -le+2); $x++ ) {
+      my @skipOne = ones[1..*];
+      for genSequence(@skipOne, numZeros -$x) -> \tail {
+         @result.push:  ( '0' x $x )~ones[0]~tail
+      }
+   }
+   return @result
+}
+
+# If all the candidates for a row have a value in common for a certain cell,
+#   then it's the only possible outcome, and all the candidates from the
+#   corresponding column need to have that value for that cell too. The ones
+#   that don't, are removed. The same for all columns. It goes back and forth,
+#   until no more candidates can be removed or a list is empty (failure).
+
+sub reduceMutual(\cols, \rows) {
+   return -1 if ( my \countRemoved1 = reduce(cols, rows) ) == -1 ;
+   return -1 if ( my \countRemoved2 = reduce(rows, cols) ) == -1 ;
+
+   return countRemoved1 + countRemoved2
+}
+
+# collect all possible solutions for the given clues
+sub getCandidates(@data, \len) {
+   return gather for @data -> \s {
+      my \sumBytes = [+] (my @a = s.ords)>>.&{ $_ - 'A'.ord + 1 }
+      my @prep = @a.values.map: { [~] '1' xx ($_ - 'A'.ord + 1) }
+      take ( gather for genSequence(@prep, len -sumBytes+1) -> \r {
+         my \bits = r.substr(1..*).ords;
+	 take ( bits.values.map: *.chr == '1' ).Array
+      } ).Array
+   }
+}
+
+sub  newPuzzle (@data) {
+
+   my (@rowData,@colData) := @data.map: *.split: ' ' ;
+
+   my \rows = getCandidates(@rowData, @colData.elems);
+   my \cols = getCandidates(@colData, @rowData.elems);
+
+   loop {
+      my \numChanged = reduceMutual(cols, rows);
+      given (numChanged) { when -1 { say "No solution" andthen return }
+                           when  0 { last }                             }
+   }
+
+   for rows -> \row {
+      for ^+cols -> \k { print row[0][k] ?? '# ' !! '. ' }
+      print "\n"
+   }
+   print "\n"
+}
+
+newPuzzle $_ for (
+   ( "C BA CB BB F AE F A B", "AB CA AE GA E C D C" ),
+
+   ( "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
+     "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA" ),
+
+   ( "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH "
+       ~"BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+     "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF "
+        ~"AAAAD BDG CEF CBDB BBB FC" ),
+
+   ( "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+     "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ "
+        ~"ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM" ),
+);

Task/Nonogram-solver/Raku/nonogram-solver-2.raku

@@ -0,0 +1,37 @@
+for './nonogram_problems.txt'.IO.lines.rotor(3, :partial) {
+
+   my (@rpats,@cpats) := @_[0,1]>>.&makepatterns;
+   my @rows            = ( '.' x +@cpats ) xx +@rpats ;
+
+   loop (my $prev = ''; $prev ne ~@rows; ) {
+      $prev = ~@rows;
+      try(@rows, @rpats);
+      my @cols = (^+@cpats).map: { [~] @rows.map: { ~ s/.// } }
+      try(@cols, @cpats);
+      @rows    = (^+@rpats).map: { [~] @cols.map: { ~ s/.// } }
+   }
+   say();
+   @rows ~~ /\./ ?? say "Failed" !! say TR/01/.@/ for @rows
+}
+
+sub try(@lines, @patterns) {
+   for ^+@lines -> $i {
+      my $pos = 0;
+      while ( @lines[$i] ~~ m:g/\./ and $pos < @lines[$i].chars ) {
+         for 0, 1 -> $try {
+	    with @lines[$i] { S:pos($pos)/\./$try/ ~~ /<{@patterns[$i]}>/ or
+                              s:pos($pos)/./{ 1 - $try }/                   }
+         }
+	 $pos++;
+      }
+   }
+}
+
+sub makepatterns($input) {
+   $input ==> split( ' ' )
+          ==>   map( *.comb )
+	  ==>   map( *>>.&{ .ord - 64 } )
+	  ==>   map( '<[1.]>**' <<~<< * )
+	  ==>   map( *.join:  '<[0.]>+' )
+	  ==>   map( '^<[0.]>*' ~ * ~ '<[0.]>*$' )
+}

Task/Nonogram-solver/Wren/nonogram-solver.wren

@@ -0,0 +1,134 @@
+import "/pattern" for Pattern
+import "/math" for Nums, Boolean
+import "/fmt" for Conv
+
+var p = Pattern.new("/s")
+
+var genSequence // recursive
+genSequence = Fn.new { |ones, numZeros|
+    if (ones.isEmpty) return ["0" * numZeros]
+    var result = []
+    var x = 1
+    while (x < numZeros - ones.count + 2) {
+        var skipOne = ones.skip(1).toList
+        for (tail in genSequence.call(skipOne, numZeros - x)) {
+            result.add("0" * x + ones[0] + tail)
+        }
+        x = x + 1
+    }
+    return result
+}
+
+/* If all the candidates for a row have a value in common for a certain cell,
+    then it's the only possible outcome, and all the candidates from the
+    corresponding column need to have that value for that cell too. The ones
+    that don't, are removed. The same for all columns. It goes back and forth,
+    until no more candidates can be removed or a list is empty (failure).
+*/
+var reduce =  Fn.new { |a, b|
+    var countRemoved = 0
+    for (i in 0...a.count) {
+        var commonOn  = List.filled(b.count, true)
+        var commonOff = List.filled(b.count, false)
+
+        // determine which values all candidates of a[i] have in common
+        for (candidate in a[i]) {
+            for (i in 0...b.count) {
+                commonOn[i]  = Boolean.and(commonOn[i], candidate[i])
+                commonOff[i] = Boolean.or(commonOff[i], candidate[i])
+            }
+        }
+
+        // remove from b[j] all candidates that don't share the forced values
+        for (j in 0...b.count) {
+            var fi = i
+            var fj = j
+            var removals = false
+            b[j].each { |cnd|
+                if ((commonOn[fj] && !cnd[fi]) || (!commonOff[fj] && cnd[fi])) {
+                    b[j].remove(cnd)
+                    removals = true
+                }
+            }
+            if (removals) countRemoved = countRemoved + 1
+            if (b[j].isEmpty) return -1
+        }
+    }
+    return countRemoved
+}
+
+var reduceMutual = Fn.new { |cols, rows|
+    var countRemoved1 = reduce.call(cols, rows)
+    if (countRemoved1 == -1) return -1
+    var countRemoved2 = reduce.call(rows, cols)
+    if (countRemoved2 == -1) return -1
+    return countRemoved1 + countRemoved2
+}
+
+// collect all possible solutions for the given clues
+var getCandidates = Fn.new { |data, len|
+    var result = []
+    for (s in data) {
+        var lst = []
+        var a = s.bytes
+        var sumChars = Nums.sum(a.map { |b| b - 64 })
+        var prep = a.map { |b| "1" * (b - 64) }.toList
+
+        for (r in genSequence.call(prep, len - sumChars + 1)) {
+            var bits = r[1..-1].bytes
+            var len = bits.count
+            if (len % 64 != 0) len = (len/64).ceil * 64
+            var bitset = List.filled(len, false)
+            for (i in 0...bits.count.min(bitset.count)) bitset[i] = bits[i] == 49
+            lst.add(bitset)
+        }
+        result.add(lst)
+    }
+    return result
+}
+
+var newPuzzle = Fn.new { |data|
+    var rowData = p.splitAll(data[0])
+    var colData = p.splitAll(data[1])
+    var rows = getCandidates.call(rowData, colData.count)
+    var cols = getCandidates.call(colData, rowData.count)
+
+    while (true) {
+        var numChanged = reduceMutual.call(cols, rows)
+        if (numChanged == -1) {
+            System.print("No solution")
+            return
+        }
+        if (numChanged <= 0) break
+    }
+
+    for (row in rows) {
+        for (i in 0...cols.count) {
+            System.write(row[0][i] ? "# " : ". ")
+        }
+        System.print()
+    }
+    System.print()
+}
+
+var p1 = ["C BA CB BB F AE F A B", "AB CA AE GA E C D C"]
+
+var p2 = [
+    "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
+    "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"
+]
+
+var p3 = [
+    "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH " +
+    "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
+    "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF " +
+    "AAAAD BDG CEF CBDB BBB FC"
+]
+
+var p4 = [
+    "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
+    "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ " +
+    "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"
+]
+
+for (puzzleData in [p1, p2, p3, p4]) newPuzzle.call(puzzleData)