非图

转载自：https://mp.weixin.qq.com/s/_2K_ONH8BWHCMQ67kv4l_Q

1994年前后，一种智力游戏在英国非常流行。《星期日电讯报》写道：“无图是来自日本的谜语，目前每周只在《星期日电讯报》上发表。简单地用你的逻辑和技能来完成网格并展示一张图片或图表。”作为一个Prolog程序员，你的处境更好：你可以让你的计算机来完成这项工作！

 

难题是这样的：本质上，矩形位图的每一行和每一列都用其占用的单元格的不同字符串的相应长度进行注释。解决难题的人必须仅根据这些长度来完成位图。

 

问题陈述：   

|_|_|_|_|_|_|_|_| 3

|_|_|_|_|_|_|_|_| 2 1

|_|_|_|_|_|_|_|_| 3 2

|_|_|_|_|_|_|_|_| 2 2

|_|_|_|_|_|_|_|_| 6

|_|_|_|_|_|_|_|_| 1 5

|_|_|_|_|_|_|_|_| 6

|_|_|_|_|_|_|_|_| 1

|_|_|_|_|_|_|_|_| 2

 1 3 1 7 5 3 4 3

 2 1 5 1

 

解：

|_|X|X|X|_|_|_|_| 3

|X|X|_|X|_|_|_|_| 2 1

|_|X|X|X|_|_|X|X| 3 2

|_|_|X|X|_|_|X|X| 2 2

|_|_|X|X|X|X|X|X| 6

|X|_|X|X|X|X|X|_| 1 5

|X|X|X|X|X|X|_|_| 6

|_|_|_|_|X|_|_|_| 1

|_|_|_|X|X|_|_|_| 2

 1 3 1 7 5 3 4 3

 2 1 5 1

 

对于上面的示例，问题可以表述为两个列表[[3]，[2,1]，[3,2]，[2,2]，[6]，[1,5]，[6] ，[1]，[2]]和[[1,2]，[3,1]，[1,5]，[7,1]，[5]，[3]，[4]，[3] ]，分别给出行和列的“实心”长度，分别是从上到下和从左到右。发布的拼图比此示例大，例如25 x 20，并且显然总是具有独特的解决方案。

 

基本思路 

(1)每个正方形都属于（水平）行和（垂直）列。我们将把每个正方形视为可通过其行或列访问的变量。目的是用“ x”或空格字符实例化每个正方形。

(2)行和列应以类似方式处理。我们将它们统称为“线”，并将连续的“ x”的字符串称为“行程”。通常，对于每条给定的行，都有几种将“ x”放入正方形的可能性。例如，如果我们必须将长度为3的行程放入长度为8的行中，则有6种方法可以这样做。

(3)原则上，必须针对所有线路尝试所有这些可能性。但是，由于我们只对单个解感兴趣，而不对所有解都感兴趣，因此最好首先尝试很少的可能性。

 

程序文件是:p7_08.pl

%nonogram(RowNums,ColNums,Solution,Opt) :- 给定分别为RowNums和ColNums中的行和列的规范，该难题由解决方法求解，该解决方法是填充的难题网格的逐行表示。 Opt = 0不进行优化，Opt = 1优化行任务的顺序（请参见下文）。

%(list-of-int-lists,list-of-int-lists,list-char-lists)    (+,+,-)

 

nonogram(RowNums,ColNums,Solution,Opt) :-

length(RowNums,NRows),

length(ColNums,NCols),

make_rectangle(NRows,NCols,Rows,Cols),

append(Rows,Cols,Lines),

append(RowNums,ColNums,LineNums),

maplist(make_runs,LineNums,LineRuns),

combine(Lines,LineRuns,LineTasks),

optimize(Opt,LineTasks,OptimizedLineTasks),

solve(OptimizedLineTasks),

Solution = Rows.

 

combine([],[],[]).

combine([L1|Ls],[N1|Ns],[task(L1,N1)|Ts]) :- 

combine(Ls,Ns,Ts).

 

solve([]).

solve([task(Line,LineRuns)|Tasks]) :- 

place_runs(LineRuns,Line),

solve(Tasks).

 

 

%(1)第一个基本思想的实现如下。

 

% make_rectangle(NRows,NCols,Rows,Cols) :- 生成具有NRows行和NCols列的矩形变量数组。可以通过行或列列表访问变量。也就是说，第1行和第2列中的变量可以在“行”列表中以[[_,X|_]|_]寻址，在列列表中以[_,[X|_]|_]寻址。

%(integer,integer,list-of-char-list,list-of-char-list)(+,+,_,_)

 

make_rectangle(NRows,NCols,Rows,Cols) :-

NRows > 0, NCols > 0,

length(Rows,NRows),

Pred1 =.. [inv_length, NCols],

checklist(Pred1,Rows),

length(Cols,NCols),

Pred2 =.. [inv_length, NRows],

checklist(Pred2,Cols),

unify_rectangle(Rows,Cols).

 

inv_length(Len,List) :- 

length(List,Len).

 

% unify_rectangle([[]|_],[]).

unify_rectangle(_,[]).

unify_rectangle([],_).

unify_rectangle([[X|Row1]|Rows],[[X|Col1]|Cols]) :-

unify_row(Row1,Cols,ColsR), 

unify_rectangle(Rows,[Col1|ColsR]).   

 

unify_row([],[],[]).

unify_row([X|Row],[[X|Col1]|Cols],[Col1|ColsR]) :- 

unify_row(Row,Cols,ColsR).

 

 

%(2)第二个基本思路实现如下

% make_runs(RunLens,Runs) :- “行程”是与给定运行长度RunLens相对应的字符列表的列表。实际上，每次运行都是一个差异列表。例如['x','x'|T]-T.

% (integer-list,list-of-runs) (+,-)

 

make_runs([],[]) :- !.

make_runs([Len1|Lens],[Run1-T|Runs]) :- 

put_x(Len1,Run1,T),

make_runs2(Lens,Runs).

 

% make_runs2(RunLens,Runs) :- 与make_runs相同，除了运行以空格字符开头。

make_runs2([],[]).

make_runs2([Len1|Lens],[[' '|Run1]-T|Runs]) :- 

put_x(Len1,Run1,T),

make_runs2(Lens,Runs).

 

put_x(0,T,T) :- !.

put_x(N,['x'|Xs],T) :- 

N > 0, 

N1 is N-1, 

put_x(N1,Xs,T).

 

% place_runs(Runs,Line) :- “行程”是“行程”列表，每个“行程”都是一个不同的字符列表。行是字符列表。这些“行程”放置在列表中，可以选择由其他空格字符分隔。通过回溯，将产生所有可能性。

%(run-list,square-list)  (+,?)

 

place_runs([],[]).

place_runs([Line-Rest|Runs],Line) :- 

place_runs(Runs,Rest).

place_runs(Runs,[' '|Rest]) :- 

place_runs(Runs,Rest).

 

% 为了了解谓词make_runs/2 make_runs2/2 put_x/3, and place_runs/2, 尝试以下目标:

 

% ?-make_runs([3,1],Runs), Line = [_,_,_,_,_,_,_], place_runs(Runs,Line).

% (3)第三个想法是优化。通过以有利的方式订制列表任务来执行此操作。这是通过谓词优化来完成的。

% optimize(LineTasks,LineTasksOpt)

 

optimize(0,LineTasks,LineTasks).     

 

optimize(1,LineTasks,OptimizedLineTasks) :- 

label(LineTasks,LabelledLineTasks),

sort(LabelledLineTasks,SortedLineTasks),

unlabel(SortedLineTasks,OptimizedLineTasks).

   

label([],[]).

label([task(Line,LineRuns)|Tasks],[task(Count,Line,LineRuns)|LTasks]) :- 

length(Line,N),   

findall(L,(length(L,N), place_runs(LineRuns,L)),Ls),

length(Ls,Count),

label(Tasks,LTasks).

 

unlabel([],[]).

unlabel([task(_,Line,LineRuns)|LTasks],[task(Line,LineRuns)|Tasks]) :- 

unlabel(LTasks,Tasks).

 

% 打印输出解

% print_nonogram(RowNums,ColNums,Solution) :-

 

print_nonogram([],ColNums,[]) :- 

print_colnums(ColNums).

print_nonogram([RowNums1|RowNums],ColNums,[Row1|Rows]) :-

print_row(Row1),

print_rownums(RowNums1),

print_nonogram(RowNums,ColNums,Rows).

 

print_row([]) :- write('  ').

print_row([X|Xs]) :- 

print_replace(X,Y), 

write(' '), 

write(Y), 

print_row(Xs).

   

print_replace(' ',' ') :- 

!.

print_replace(x,'*').

 

print_rownums([]) :- 

nl.

print_rownums([N|Ns]) :- 

write(N), 

write(' '), 

print_rownums(Ns).

 

print_colnums(ColNums) :-

maxlength(ColNums,M,0),

print_colnums(ColNums,ColNums,1,M).

 

maxlength([],M,M).

maxlength([L|Ls],M,A) :- 

length(L,N), 

B is max(A,N), 

maxlength(Ls,M,B). 

 

print_colnums(_,[],M,M) :- 

!, 

nl.

print_colnums(ColNums,[],K,M) :- 

K < M, 

!, 

nl,

K1 is K+1, 

print_colnums(ColNums,ColNums,K1,M).

print_colnums(ColNums,[Col1|Cols],K,M) :- 

K =< M, 

write_kth(K,Col1), 

print_colnums(ColNums,Cols,K,M).

   

write_kth(K,List) :- 

nth1(K,List,X), 

!, 

writef('%2r',[X]).

write_kth(_,_) :- 

write('  ').

 

% 使用一些“真实”难题进行测试：

specimen_nonogram(

'Hen',

[[3], [2,1], [3,2], [2,2], [6], [1,5], [6], [1], [2]],

[[1,2], [3,1], [1,5], [7,1], [5], [3], [4], [3]]

).

 

specimen_nonogram(

'Jack & The Beanstalk',

[[3,1],[2,4,1],[1,3,3],[2,4],[3,3,1,3],[3,2,2,1,3],[2,2,2,2,2],[2,1,1,2,1,1],[1,2,1,4],[1,1,2,2],[2,2,8],[2,2,2,4], [1,2,2,1,1,1],[3,3,5,1],[1,1,3,1,1,2],[2,3,1,3,3],[1,3,2,8], [4,3,8],[1,4,2,5],[1,4,2,2],[4,2,5],[5,3,5],[4,1,1],[4,2],[3,3]],

[[2,3],[3,1,3],[3,2,1,2],[2,4,4],[3,4,2,4,5],[2,5,2,4,6], [1,4,3,4,6,1],[4,3,3,6,2],[4,2,3,6,3],[1,2,4,2,1],[2,2,6],[1,1,6], [2,1,4,2],[4,2,6],[1,1,1,1,4],[2,4,7],[3,5,6],[3,2,4,2],[2,2,2],[6,3]]).

 

specimen_nonogram(

'WATER BUFFALO',

[[5],[2,3,2],[2,5,1],[2,8],[2,5,11],[1,1,2,1,6],[1,2,1,3],[2,1,1],[2,6,2],[15,4],[10,8],[2,1,4,3,6],[17],[17],[18],[1,14], [1,1,14], [5,9], [8], [7]],

[[5], [3,2], [2,1,2], [1,1,1], [1,1,1], [1,3], [2,2], [1,3,3],[1,3,3,1], [1,7,2], [1,9,1], [1,10], [1,10], [1,3,5], [1,8],[2,1,6], [3,1,7], [4,1,7], [6,1,8], [6,10], [7,10], [1,4,11],[1,2,11], [2,12], [3,13]]).

 

 

 

test(Name,Opt) :- 

specimen_nonogram(Name,Rs,Cs),

nonogram(Rs,Cs,Solution,Opt), nl,

print_nonogram(Rs,Cs,Solution).

 

测试：

非图“ Hen”的结果：

?- consult('p7_08.pl').

true.

 

?- time(test('Hen',0)).

 

   * * *          3 

 * *   *          2 1 

   * * *     * *  3 2 

     * *     * *  2 2 

     * * * * * *  6 

 *   * * * * *    1 5 

 * * * * * *      6 

         *        1 

       * *        2 

 1 3 1 7 5 3 4 3

 2 1 5 1        

% 16,834,200 inferences, 3.866 CPU in 3.872 seconds (100% CPU, 4354084 Lips)

true .

 

?- time(test('Hen',1)).

 

   * * *          3 

 * *   *          2 1 

   * * *     * *  3 2 

     * *     * *  2 2 

     * * * * * *  6 

 *   * * * * *    1 5 

 * * * * * *      6 

         *        1 

       * *        2 

 1 3 1 7 5 3 4 3

 2 1 5 1        

% 5,405 inferences, 0.003 CPU in 0.003 seconds (94% CPU, 1996675 Lips)

true .