A 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
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
The problem above could be represented by two lists of lists:

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]]
A more compact representation of the same problem uses strings,
where the letters represent the numbers, A=1, B=2, etc:

x = "C BA CB BB F AE F A B"
y = "AB CA AE GA E C D C"
Task
For this task, try to solve the 4 problems below, read from a “nonogram_problems.txt” file that has this content
(the blank lines are separators):

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
Extra credit: generate nonograms with unique solutions, of desired height and width.



This task is the problem n.98 of the "99 Prolog Problems" by Werner Hett (also thanks to Paul Singleton for the idea and the examples).




 Related tasks
 Nonoblock.


See also
 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)


/*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