Prolog约束处理:包装正方形

时间:2012-11-29 10:33:40

标签: prolog constraints clpfd sicstus-prolog clpb

我试图在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 ]=======================

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

5 个答案:

答案 0 :(得分:19)

对于每个方块,定义表示左上角的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)))

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

答案 1 :(得分:17)

从版本3.8.3开始,SICStus Prolog提供了许多专用的placement constraints,可以很好地满足您的包装问题。特别是,由于您的包装问题是二维的,您应该考虑使用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: one solution

第二,一个最小尺寸(9 * 7)的电路板解决方案:9x7: one solution

最后,所有最小尺寸(9 * 7)的电路板解决方案:9x7: all solutions


编辑2015-04-14

自版本7.1.36起,SWI-Prolog clpfd library支持约束disjoint2/1

编辑2015-04-22

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

  1. 对于每对方框,确定这两个方框不重叠的所有位置。
  2. 将有效组合编码为元组列表。
  3. 对于每对框发布一个tuples_in/2约束。
  4. 作为一个私人的概念验证,我按照这个想法实现了一些代码;就像@CapelliC在他的回答中一样,我得到169480个不同的解决方案,用于OP所说的盒子和板尺寸。

    运行时与其他基于clp(FD)的答案相当;事实上,对于小型电路板(10 * 10和更小),非常具有竞争力,但是当电路板尺寸更大时,更差

    请注意,为了体面,我不发布代码:)

答案 2 :(得分: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.

对应解决方案:

solution for original problem

这样的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)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个解决方案。

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

example with triangular shapes

使用CLP(B)以这样的方式挑选解决方案也很容易,即使解决方案的数量太大而无法明确枚举它们。

答案 3 :(得分: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.

答案 4 :(得分:1)

这里是solution,其中不相交仅占一行:

% 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]]