36

我正在尝试解决 prolog 中的约束处理问题。

我需要在 10x10 的网格中打包 4 个 5x5、4x4、3x3 和 2x2 的正方形。它们可能不会重叠。

我的变量如下所示:

Name: SqX(i), i=1..10, domain: 1..10

其中 X 为 5、4、3 或 2。索引 i 表示行,域表示网格中的列。

我的第一个约束尝试定义正方形的宽度和高度。我这样表述:

Constraint: SqX(i) > SqX(j)-X /\ i>j-X, range: i>0 /\ j>0

这样可能的点就被限制在彼此之间的 X 行和列内。然而,Prolog 停止这些约束并给出以下结果:

Adding constraint "(Sq5_I > Sq5_J-5) /\ (I>J-5)" for values:
        I=1, J=1, 
        I=1, J=2, 
        I=1, J=3, 
        I=1, J=4, 
        I=1, J=5, 
        I=1, J=6, 
=======================[ End Solutions ]=======================

所以它停在那里,甚至没有检查其他方格。我的约束很可能太紧了,但我不明白为什么或如何。有什么建议么?

4

5 回答 5

20

对于每个正方形,定义表示左上角的变量XY这些变量将具有域1..10-L,其中L是正方形的长度。如果将域设置为1..10,则正方形可能会部分放置在 10x10 矩形之外。

然后,您可以为每对矩形发布约束,(X,Y)(X1,Y1)声明如果它们在 x 轴上重叠,则它们不能在 y 轴上重叠,反之亦然:

(((X  #=< X1) and (X+L   #> X1)) => ((Y+L #=< Y1) or (Y1+L1 #=< Y))),
(((X1 #=< X)  and (X1+L1 #> X))  => ((Y+L #=< Y1) or (Y1+L1 #=< Y))),
(((Y  #=< Y1) and (Y+L   #> Y1)) => ((X+L #=< X1) or (X1+L1 #=< X))),
(((Y1 #=< Y)  and (Y1+L1 #> Y))  => ((X+L #=< X1) or (X1+L1 #=< X)))

(您的特定约束语法可能会有所不同)

于 2012-11-29T15:32:08.050 回答
20

自 3.8.3 版以来,SICStus Prolog 提供了许多专用的放置约束,可以很好地匹配您的打包问题。特别是,由于您的打包问题是二维的,您应该考虑使用disjoint2/1约束。

以下代码片段用于disjoint2/1表示矩形不重叠。主要关系是area_boxes_positions_/4

:- use_module(library(clpfd)).
:- use_module(library(lists)).

area_box_pos_combined(W_total*H_total,W*H,X+Y,f(X,W,Y,H)) :-
    X #>= 1,
    X #=< W_total-W+1,
    Y #>= 1,
    Y #=< H_total-H+1.

positions_vars([],[]).
positions_vars([X+Y|XYs],[X,Y|Zs]) :-
    positions_vars(XYs,Zs).

area_boxes_positions_(Area,Bs,Ps,Zs) :-
    maplist(area_box_pos_combined(Area),Bs,Ps,Cs),
    disjoint2(Cs),
    positions_vars(Ps,Zs).

关于一些查询!首先,您的初始包装问题:

?- area_boxes_positions_(10*10,[5*5,4*4,3*3,2*2],Positions,Zs),
   labeling([],Zs).
Positions = [1+1,1+6,5+6,5+9],
Zs        = [1,1,1,6,5,6,5,9] ? ...

接下来,让我们最小化放置所有正方形所需的总面积:

?- domain([W,H],1,10),
   area_boxes_positions_(W*H,[5*5,4*4,3*3,2*2],Positions,Zs),
   WH #= W*H,
   minimize(labeling([ff],[H,W|Zs]),WH).
W         = 9,
H         = 7,
Positions = [1+1,6+1,6+5,1+6],
Zs        = [1,1,6,1,6,5,1,6],
WH        = 63 ? ...

可视化解决方案

个人解决方案实际上是什么样的? ImageMagick可以生成漂亮的小位图...

这是一些用于转储正确 ImageMagick 命令的快速而肮脏的代码:

:- use_module(library(between)).
:- use_module(library(codesio)).

drawWithIM_at_area_name_label(Sizes,Positions,W*H,Name,Label) :-
    Pix = 20,

    % let the ImageMagick command string begin
    format('convert -size ~dx~d xc:skyblue', [(W+2)*Pix, (H+2)*Pix]),

    % fill canvas 
    format(' -stroke none -draw "fill darkgrey rectangle ~d,~d ~d,~d"', 
           [Pix,Pix, (W+1)*Pix-1,(H+1)*Pix-1]),

    % draw grid
    drawGridWithIM_area_pix("stroke-dasharray 1 1",W*H,Pix),

    % draw boxes
    drawBoxesWithIM_at_pix(Sizes,Positions,Pix),

    % print label
    write( ' -stroke none -fill black'),
    write( ' -gravity southwest -pointsize 16 -annotate +4+0'),
    format(' "~s"',[Label]),

    % specify filename
    format(' ~s~n',[Name]).

上面的代码drawWithIM_at_area_name_label/5依赖于两个小助手:

drawGridWithIM_area_pix(Stroke,W*H,P) :-   % vertical lines
    write(' -strokewidth 1 -fill none -stroke gray'),
    between(2,W,X),
    format(' -draw "~s path \'M ~d,~d L ~d,~d\'"', [Stroke,X*P,P, X*P,(H+1)*P-1]),
    false.
drawGridWithIM_area_pix(Stroke,W*H,P) :-   % horizontal lines
    between(2,H,Y),
    format(' -draw "~s path \'M ~d,~d L ~d,~d\'"', [Stroke,P,Y*P, (W+1)*P-1,Y*P]),
    false.
drawGridWithIM_area_pix(_,_,_).

drawBoxesWithIM_at_pix(Sizes,Positions,P) :-
    Colors = ["#ff0000","#00ff00","#0000ff","#ffff00","#ff00ff","#00ffff"],
    write(' -strokewidth 2 -stroke white'),
    nth1(N,Positions,Xb+Yb),
    nth1(N,Sizes,    Wb*Hb),
    nth1(N,Colors,   Color),
    format(' -draw "fill ~sb0 roundrectangle ~d,~d ~d,~d ~d,~d"',
           [Color, Xb*P+3,Yb*P+3, (Xb+Wb)*P-3,(Yb+Hb)*P-3, P/2,P/2]),
    false.
drawBoxesWithIM_at_pix(_,_,_).

使用可视化工具

让我们使用以下两个查询来生成一些静止图像。

?- drawWithIM_at_area_name_label([5*5,4*4,3*3,2*2],[1+1,6+1,6+5,1+6],9*7,
                                 'dj2_9x7.gif','9x7').

?- drawWithIM_at_area_name_label([5*5,4*4,3*3,2*2],[1+1,1+6,5+6,5+9],10*10,
                                 'dj2_10x10.gif','10x10').

让我们使用以下 hack-query 为在大小板上放置上述矩形的每个解决方案生成一个图像9*7

?- retractall(nSols(_)), 
   assert(nSols(1)), 
   W=9,H=7,
   Boxes = [5*5,4*4,3*3,2*2],
   area_boxes_positions_(W*H,Boxes,Positions,Zs),
   labeling([],Zs), 
   nSols(N), 
   retract(nSols(_)), 
   format_to_codes('dj2_~5d.gif',[N],Name),
   format_to_codes('~dx~d: solution #~d',[W,H,N],Label),
   drawWithIM_at_area_name_label(Boxes,Positions,W*H,Name,Label),
   N1 is N+1,
   assert(nSols(N1)),
   false.

接下来,执行上述查询输出的所有 ImageMagick 命令。

最后,使用 ImageMagick 构建第三个查询的解决方案集的动画:

$ convert -delay 15  dj2_0.*.gif   dj2_9x7_allSolutions_1way.gif 
$ convert dj2_9x7_allSolutions_1way.gif -coalesce -duplicate 1,-2-1 \
          -quiet -layers OptimizePlus -loop 0 dj2_9x7_allSolutions.gif

结果

首先,针对板尺寸 10*10 的一种解决方案:10x10:一种解决方案

其次,针对最小尺寸 (9*7) 的板的一种解决方案:9x7:一种解决方案

最后,对于最小尺寸 (9*7) 的板的所有解决方案:9x7:所有解决方案


编辑 2015-04-14

从版本 7.1.36 开始,SWI-Prolog clpfd 库支持约束disjoint2/1

编辑 2015-04-22

这是基于tuples_in/2约束的替代实现的草图:

  1. 对于每对框,确定这两个框不重叠的所有位置。
  2. 将有效组合编码为元组列表。
  3. 对于每一对框都发布一个tuples_in/2约束。

作为一个私人的概念验证,我按照这个想法实现了一些代码;就像@CapelliC 在他的回答中一样,我得到169480了针对 OP 所述的盒子和电路板大小的不同解决方案。

运行时间与其他基于 clp(FD) 的答案相当;事实上,它对于小板(10*10 和更小)非常有竞争力,但对于更大的板尺寸会变得更糟。

请承认,为了体面,我不会发布代码:)

于 2015-04-01T11:08:20.770 回答
5

这里已经发布了几个很棒的解决方案(全部 +1!),使用 CLP(FD) 约束。

此外,我想展示一种概念上不同的方法来解决此类放置和覆盖任务,使用 CLP( B ) 约束。

这个想法是将瓦片的每个可能放置视为网格上特定元素处的一组TRUE值,其中每个网格元素对应于矩阵的一列,并且每个可能的瓦片放置对应于一行。然后任务是选择所述矩阵的一组行,使得每个网格元素最多被覆盖一次,或者换句话说,在由所选行组成的子矩阵的每一列中最多有一个TRUE值.

在这个公式中,行的选择——以及因此瓷砖在特定位置的放置——由布尔变量表示,一个用于矩阵的每一行。

这是我想分享的代码,它可以在 SICStus Prolog 和 SWI 中工作,最多只做一些小的改动:

:- use_module(library(clpb)).
:- use_module(library(clpfd)).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   The tiles we have available for placement.

   For example, a 2x2 tile is represented in matrix form as:

       [[1,1],
        [1,1]]

   1 indicates which grid elements are covered when placing the tile.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

tile(5*5).
tile(4*4).
tile(3*3).
tile(2*2).

tile_matrix(Rows) :-
        tile(M*N),
        length(Rows, M),
        maplist(length_list(N), Rows),
        append(Rows, Ls),
        maplist(=(1), Ls).

length_list(L, Ls) :- length(Ls, L).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   Describe placement of tiles as SAT constraints.

   Notice the use of Cards1 to make sure that each tile is used
   exactly once. Remove or change this constraint if a shape can be
   used multiple times, or can even be omitted.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

placement(M, N, Vs, *(Cs) * *(Cards1)) :-
        matrix(M, N, TilesRows),
        pairs_keys_values(TilesRows, Tiles, Rows),
        same_length(Rows, Vs),
        pairs_keys_values(TilesVs0, Tiles, Vs),
        keysort(TilesVs0, TilesVs),
        group_pairs_by_key(TilesVs, Groups),
        pairs_values(Groups, SameTiles),
        maplist(card1, SameTiles, Cards1),
        Rows = [First|_],
        phrase(all_cardinalities(First, Vs, Rows), Cs).

card1(Vs, card([1], Vs)).

all_cardinalities([], _, _) --> [].
all_cardinalities([_|Rest], Vs, Rows0) -->
        { maplist(list_first_rest, Rows0, Fs, Rows),
          pairs_keys_values(Pairs0, Fs, Vs),
          include(key_one, Pairs0, Pairs),
          pairs_values(Pairs, Cs) },
        [card([0,1], Cs)],
        all_cardinalities(Rest, Vs, Rows).

key_one(1-_).

list_first_rest([L|Ls], L, Ls).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   We build a matrix M_ij, where each row i describes what placing a
   tile at a specific position looks like: Each cell of the grid
   corresponds to a unique column of the matrix, and the matrix
   entries that are 1 indicate the grid positions that are covered by
   placing one of the tiles at the described position. Therefore,
   placing all tiles corresponds to selecting specific rows of the
   matrix such that, for the selected rows, at most one "1" occurs in
   each column.

   We represent each row of the matrix as Ts-Ls, where Ts is the tile
   that is used in each case.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

matrix(M, N, Ms) :-
        Squares #= M*N,
        length(Ls, Squares),
        findall(Ts-Ls, line(N, Ts, Ls), Ms).

line(N, Ts, Ls) :-
        tile_matrix(Ts),
        length(Ls, Max),
        phrase((zeros(0,P0),tile_(Ts,N,Max,P0,P1),zeros(P1,_)), Ls).

tile_([], _, _, P, P) --> [].
tile_([T|Ts], N, Max, P0, P) -->
        tile_part(T, N, P0, P1),
        { (P1 - 1) mod N >= P0 mod N,
          P2 #= min(P0 + N, Max) },
        zeros(P1, P2),
        tile_(Ts, N, Max, P2, P).

tile_part([], _, P, P) --> [].
tile_part([L|Ls], N, P0, P) --> [L],
        { P1 #= P0 + 1 },
        tile_part(Ls, N, P1, P).

zeros(P, P)  --> [].
zeros(P0, P) --> [0], { P1 #= P0 + 1 }, zeros(P1, P).

以下查询说明了哪些网格元素被覆盖 ( 1),其中每一行对应于其中一个矩形的位置:

?- M = 7, N = 9, placement(M, N, Vs, Sat), sat(Sat),
  labeling(Vs), matrix(M, N, Ms), pairs_values(Ms, Rows),
  pairs_keys_values(Pairs0, Vs, Rows),
  include(key_one, Pairs0, Pairs1), pairs_values(Pairs1, Covers),
  maplist(writeln, Covers).
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,0]
[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,1,1]
[0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
[0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
M = 7,
N = 9,
etc.

对应的解决方案:

原始问题的解决方案

这样的 CLP(B) 公式通常比 CLP(FD) 版本的可扩展性更小,这也是因为涉及的变量更多。但是,它也有一些优点:

一个重要的优点是它很容易推广到可以多次使用部分或全部形状的任务版本。例如,在上面的版本中,我们可以简单地更改card1/2为:

custom_cardinality(Vs, card([0,1,2,3,4,5,6,7], Vs)).

并获得一个版本,每个图块最多可以使用 7 次,甚至可以完全省略(由于包含0)。

其次,我们可以轻松地将其转换为精确覆盖问题的解决方案,这意味着每个网格元素都被其中一个形状覆盖,只需将其更改card([0,1], Cs)card([1], Cs)in即可all_cardinalities//3

连同其他修改,这里是一个使用四个 2x2 矩形的 4x4 网格的覆盖:

[1,1,0,0,1,1,0,0,0,0,0,0,0,0,0,0]
[0,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0]
[0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1]

CLP(B) 公式的第三个优点是无需显式枚举解即可计算解的数量。例如,对于原始任务:

?- placement(7, 9, Vs, Sat), sat_count(Sat, Count).
Count = 68.

@repeat 已经对这 68 个解决方案进行了精美的说明。

为了比较,这里是每个形状可以使用 0 到 7 次的解决方案的数量:

?- placement(7, 9, Vs, Sat), time(sat_count(Sat, Count)).
% 157,970,727 inferences, 19.165 CPU in 19.571 seconds
...
Count = 17548478.

在 10x10 网格上也是如此,在大约 6 分钟内计算(约 20 亿次推理):

?- placement(10, 10, Vs, Sat), sat_count(Sat, Count).
Count = 140547294509.

在 11x11 网格上,大约半小时计算(约 90 亿次推理):

?- placement(11, 11, Vs, Sat), sat_count(Sat, Count).
Count = 15339263199580.

最后,也许最重要的是,这种方法适用于任何形状的瓷砖,并且不限于正方形或矩形。例如,要处理 1x1 正方形和三角形以及其垂直和水平反射,请使用以下定义tile_matrix/1

tile_matrix([[1]]).
tile_matrix(T) :-
        T0 = [[1,1,1,1],
              [1,1,1,0],
              [1,1,0,0],
              [1,0,0,0]],
        (   T = T0
        ;   maplist(reverse, T0, T)
        ;   reverse(T0, T)
        ).

允许这些形状中的每一个在 9x7 板上使用 0 到 7 次,大约一分钟后,我得到了Count = 58665048314解决方案。

这是其中之一,随机挑选:

三角形的例子

使用 CLP(B) 以使每个解决方案都具有同等可能性的方式选择解决方案也很容易,即使解决方案的数量太大而无法明确列举它们。

于 2015-05-17T09:20:38.823 回答
3

我用 SWI-Prolog 编码

/*  File:    pack_squares.lp
    Author:  Carlo,,,
    Created: Nov 29 2012
    Purpose: http://stackoverflow.com/questions/13623775/prolog-constraint-processing-packing-squares
*/

:- module(pack_squares, [pack_squares/0]).
:- [library(clpfd)].

pack_squares :-
    maplist(square, [5,4,3,2], Squares),
    flatten(Squares, Coords),
    not_overlap(Squares),
    Coords ins 1..10,
    label(Coords),
    maplist(writeln, Squares),
    draw_squares(Squares).

draw_squares(Squares) :-
    forall(between(1, 10, Y),
           (   forall(between(1, 10, X),
              sumpts(X, Y, Squares, 0)),
           nl
           )).

sumpts(_, _, [], S) :- write(S).
sumpts(X, Y, [[X1,Y1, X2,Y2]|Qs], A) :-
    ( ( X >= X1, X =< X2, Y >= Y1, Y =< Y2 )
    ->  B is A+X2-X1+1
    ;   B is A
    ),
    sumpts(X, Y, Qs, B).

square(D, [X1,Y1, X2,Y2]) :-
    X1 + D - 1 #= X2,
    Y1 + D - 1 #= Y2.

not_overlap([_]).
not_overlap([A,B|L]) :-
    not_overlap(A, [B|L]),
    !, not_overlap([B|L]).

not_overlap(_, []).
not_overlap(Q, [R|Rs]) :-
    not_overlap_c(Q, R),
    not_overlap_c(R, Q),
    not_overlap(Q, Rs).

not_overlap_c([X1,Y1, X2,Y2], Q) :-
    not_inside(X1,Y1, Q),
    not_inside(X1,Y2, Q),
    not_inside(X2,Y1, Q),
    not_inside(X2,Y2, Q).

not_inside(X,Y, [X1,Y1, X2,Y2]) :-
    X #< X1 #\/ X #> X2 #\/ Y #< Y1 #\/ Y #> Y2.

这是运行时显示的最后几行?- aggregate_all(count,pack_squares,C).,特别是 C 计算总展示位置

...
0002255555
0002255555
[6,6,10,10]
[7,2,10,5]
[4,3,6,5]
[5,1,6,2]
0000220000
0000224444
0003334444
0003334444
0003334444
0000055555
0000055555
0000055555
0000055555
0000055555
C = 169480.
于 2012-11-29T17:13:56.263 回答
0

这是一个解决方案,其中 disjoint 只占用一行:

% disjoint(+Rectangle, +Rectangle)
disjoint([XA1,XA2,YA1,YA2],[XB1,XB2,YB1,YB2]) :-
   XB1 #>= XA2 #\/ XA1 #>= XB2 #\/
   YB1 #>= YA2 #\/ YA1 #>= YB2.

模型设置和标记工作如下:

% squares(-List)
squares(L) :-
   maplist(square, [2,3,4,5], L),
   term_variables(L, V),
   place(L),
   label(V).

% square(+Integer, -Rectangle)
square(S, [X1,X2,Y1,Y2]) :-
   X1 in 0..8,
   X2 in 1..9,
   Y1 in 0..6,
   Y2 in 1..7,
   X2 #= X1+S,
   Y2 #= Y1+S.

% place(+List)
place([]).
place([A|L]) :-
   place(L, A),
   place(L).

% place(+List, +Rectangle)
place([], _).
place([A|L], B) :-
   disjoint(A, B),
   place(L, B).

这是一个示例运行:

Jekejeke Prolog 3, Runtime Library 1.3.7 (May 23, 2019)

?- squares(L), show(L).
555554444
555554444
555554444
555554444
55555333.
22...333.
22...333.
L = [[0,2,5,7],[5,8,4,7],[5,9,0,4],[0,5,0,5]]
于 2019-06-02T12:44:54.737 回答