Prolog约束处理：填充正方形
我试图用prolog解决一个约束处理问题 我需要在10x10的网格中包装4个5x5、4x4、3x3和2x2的正方形。 它们可能不重叠 我的变量如下所示：Prolog约束处理：填充正方形,prolog,constraints,clpfd,sicstus-prolog,clpb,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 因此，可能的点被
Name: SqX(i), i=1..10, domain: 1..10
Constraint: SqX(i) > SqX(j)-X /\ i>j-X, range: i>0 /\ j>0
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 ]=======================
所以它停在那里，甚至不检查其他方块。我的约束很可能太紧了，但我不知道为什么或者如何。有什么建议吗？对于每个方块，定义表示左上角的
XY1..10-LL1..10（X，Y）（X1，Y1）(((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)))
（（X=X1）和（X+L=X1））=>（（Y+L=Y1）或（Y1+L1=Y）），
（（X1#=X））=>（（Y+L#=Y1））=>（（X+L=X1）或（X1+L1=X）），
（（Y1#=Y））=>（（X+L#= /* 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.
由于版本3.8.3，SICStus Prolog提供了许多专门的解决方案，可以很好地解决您的打包问题。特别是，由于你的装箱问题是二维的，你应该考虑使用<代码> DISJONTIN 2/1 约束。 下面的代码段使用
disjoint2/1区域\框\位置\ 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).
?- 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命令：
:- 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\u at\u area\u name\u label/5drawGridWithIM_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').
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.
$ 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
编辑2015-04-14 自版本7.1.36起，支持约束
分离2/1tuples\u的替代实现的示意图：
对于每对框，确定这两个框不重叠的所有位置
将有效组合编码为元组列表
对于每对框，在/2 元组
作为概念的私人证明，我按照这个想法实现了一些代码；就像他的回答中的@capelical一样，我得到了OP所述的盒子和电路板尺寸的169480
不同的解决方案
运行时可与其他基于clp（FD）的答案进行比较；事实上，对于小型电路板（10*10或更小）来说，这是非常有竞争力的，但对于更大的电路板，情况会变得更糟
请承认，为了体面起见，我没有发布代码：）这里已经发布了几个使用CLP（FD）约束的伟大解决方案（+1！）
此外，我想展示一种在概念上不同的方法，使用CLP（B）约束来解决此类放置和覆盖任务
这个想法是考虑一个瓦片的每一个可能的放置，作为一个集合，在网格上的特定元素上的<强>真/<强>值，其中每个网格元素对应于矩阵的一个列，并且每一个可能的平铺放置对应于一行。然后，任务是选择所述矩阵的一组行，使得每个网格元素最多覆盖一次，或者换句话说，由所选行组成的子矩阵的每列中最多有一个真值
在这个公式中，行的选择——以及瓷砖在特定位置的放置——由布尔变量表示，矩阵的每行一个
下面是我想与大家分享的代码，它在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.
[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）公式通常比CLP（FD）版本的可伸缩性差，这也是因为涉及的变量更多。但是，它也有一些优点：
一个显著的优点是，它很容易推广到任务的一个版本，其中一些或所有形状可以多次使用。例如，在上述版本中，我们只需将card1/2
更改为：
custom_cardinality(Vs, card([0,1,2,3,4,5,6,7], Vs)).
并获得一个版本，其中每个磁贴最多可以使用7次，甚至可以完全省略（由于包含0
）
其次，我们可以很容易地将其转化为一个精确覆盖问题的解决方案，这意味着每个网格元素都被一个形状（siml）覆盖
custom_cardinality(Vs, card([0,1,2,3,4,5,6,7], Vs)).
[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]
?- placement(7, 9, Vs, Sat), sat_count(Sat, Count).
Count = 68.
?- placement(7, 9, Vs, Sat), time(sat_count(Sat, Count)).
% 157,970,727 inferences, 19.165 CPU in 19.571 seconds
...
Count = 17548478.
?- placement(10, 10, Vs, Sat), sat_count(Sat, Count).
Count = 140547294509.
?- placement(11, 11, Vs, Sat), sat_count(Sat, Count).
Count = 15339263199580.
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)
).
% 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]]