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)


with javascript_semantics
sequence x, y, grid
integer unsolved
 
function count_grid()
integer res = length(x)*length(y)
    for i=1 to length(x) do
        for j=1 to length(y) do
            res -= grid[i][j]!='?'
        end for
    end for
    return res
end function
 
function match_mask(string neat, string mask, integer ms, integer me)
    for i=ms to me do
        if mask[i]!='?' then
            if mask[i]!=neat[i] then return 0 end if
        end if
    end for
    return 1
end function
 
function innr(string mask, sequence blocks, integer mi=1, string res="", string neat=mask)
    if length(blocks)=0 then
        for i=mi to length(neat) do
            neat[i] = ' '
        end for
        if match_mask(neat,mask,mi,length(mask)) then
            if length(res)=0 then
                res = neat
            else
                for i=1 to length(neat) do
                    if neat[i]!=res[i] then
                        res[i] = '?'
                    end if
                end for
            end if
        end if
    else
        integer b = blocks[1]
        blocks = blocks[2..$]
        integer l = (sum(blocks)+length(blocks)-1),
                e = length(neat)-l-b
        for i=mi to e do
            for j=i to i+b-1 do
                neat[j] = '#'
            end for
            if i+b<=length(neat) then
                neat[i+b] = ' '
            end if
            if match_mask(neat,mask,mi,min(i+b,length(mask))) then
                res = innr(mask,blocks,i+b+1,res,neat)
            end if
            neat[i] = ' '
        end for
    end if
    return res
end function
 
function inner(string mask, sequence blocks)
    string res = innr(mask,blocks)
    return iff(length(res)?res:mask)
end function
 
global function vmask(sequence source, integer column)
string res = repeat(' ',length(source))
    for i=1 to length(source) do
        res[i] = source[i][column]
    end for
    return res
end function
 
function logic()
integer wasunsolved = unsolved
    for i=1 to length(x) do
        grid[i] = inner(grid[i],x[i])
    end for
    for j=1 to length(y) do
        string tmp = inner(vmask(grid,j),y[j])
        for i=1 to length(tmp) do
            grid[i][j] = tmp[i]
        end for
    end for
    unsolved = count_grid()
    return wasunsolved!=unsolved
end function
 
sequence tests=split("""
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""",'\n')
--Alternatively:
--integer fn = open("nonogram_problems.txt","r")
--tests = get_text(fn,GT_LF_STRIPPED)
--close(fn)
 
function unpack(string s)
sequence res = split(s)
    for i=1 to length(res) do
        string ri = res[i]
        sequence r = {}
        for j=1 to length(ri) do
            r &= ri[j]-'A'+1
        end for
        res[i] = r
    end for
    return res
end function
 
for i=1 to length(tests) by 3 do
    x = unpack(tests[i])
    y = unpack(tests[i+1])
    grid = repeat(repeat('?',length(y)),length(x))
    unsolved = length(x)*length(y)
 
    while unsolved do
        if not logic() then
            ?"partial"
            exit
        end if
    end while
 
    puts(1,join(grid,"\n")&"\n")
end for
