Procesamiento de restricciones Prolog: cuadrados de embalaje
constraints clpfd (4)
Codifiqué en 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.
aquí están las últimas líneas que se muestran al ejecutar ?- aggregate_all(count,pack_squares,C).
, notablemente C cuenta las ubicaciones totales
...
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.
Estoy tratando de resolver un problema de procesamiento de restricciones en prolog.
Necesito empacar 4 cuadrados de 5x5,4x4,3x3 y 2x2 en una cuadrícula de 10x10. No pueden superponerse.
Mis variables se ven así:
Name: SqX(i), i=1..10, domain: 1..10
Donde X es 5,4,3 o 2. El índice i representa la fila, el dominio la columna en la cuadrícula.
Mis primeras restricciones intentan definir el ancho y la altura de los cuadrados. Lo formulo como tal:
Constraint: SqX(i) > SqX(j)-X // i>j-X, range: i>0 // j>0
De modo que los puntos posibles se limitan a estar dentro de X filas y columnas el uno del otro. Prolog sin embargo, se detiene en estas restricciones y da el siguiente resultado:
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 ]=======================
Entonces se detiene allí, sin siquiera revisar los otros cuadrados. Es probable que mis limitaciones sean demasiado estrictas, pero no puedo ver por qué ni cómo. ¿Alguna sugerencia?
Para cada cuadrado, defina las variables X
e Y
que denotan la esquina superior izquierda. Esta variable tendrá dominios 1..10-L
, donde L
es la longitud del cuadrado. Si configura el dominio en 1..10
, los cuadrados pueden colocarse parcialmente fuera de su rectángulo de 10x10.
Luego puede publicar restricciones para cada par de rectángulos (X,Y)
y (X1,Y1)
que establezcan que si se superponen en el eje x, no deben superponerse en el eje y, y viceversa:
(((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)))
(su sintaxis de restricción particular puede variar)
Desde la versión 3.8.3 SICStus Prolog ofrece una serie de restricciones de ubicación dedicadas que coinciden muy bien con su problema de embalaje. En particular, como su problema de empaque es bidimensional, debería considerar usar la restricción disjoint2/1
.
El siguiente fragmento de código usa disjoint2/1
para expresar que los rectángulos no se solapan. La relación principal es 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).
En algunas consultas! Primero, su problema inicial de empaque:
?- 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] ? ...
A continuación, minimicemos el área total que se requiere para colocar todos los cuadrados:
?- 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 ? ...
Visualizando soluciones
¿Cómo se ven realmente las soluciones individuales? ImageMagick puede producir pequeños y agradables mapas de bits ...
Aquí hay un código rápido y sucio para eliminar el comando apropiado de 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]).
El código anterior para drawWithIM_at_area_name_label/5
depende de dos pequeños ayudantes:
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(_,_,_).
Usando los visualizadores
Usemos las siguientes dos consultas para producir algunas imágenes fijas.
?- 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'').
Usemos la siguiente consulta de hack para producir una imagen para cada solución de la colocación de los rectángulos anteriores en un tablero de tamaño 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.
A continuación, ejecute todos los comandos de ImageMagick generados por las consultas anteriores.
Por fin, crea una animación del conjunto de soluciones de la tercera consulta usando 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
Resultados
Primero, una solución para el tamaño del tablero 10 * 10:
En segundo lugar, una solución para una placa de tamaño mínimo (9 * 7):
Por último, todas las soluciones para una placa de tamaño mínimo (9 * 7):
Editar 2015-04-14
Desde la versión 7.1.36, la biblioteca clpfd de SWI-Prolog admite la restricción disjoint2 disjoint2/1
.
Editar 2015-04-22
Aquí hay un boceto de una implementación alternativa basada en la restricción tuples_in/2
:
- Para cada par de casillas, determine todas las posiciones en las que estas dos no se solapen.
- Codifique las combinaciones válidas como listas de tuplas.
- Para cada par de casillas, publique una restricción de
tuples_in/2
.
Como una prueba de concepto privada, implementé un código siguiendo esa idea; Al igual que @CapelliC en su respuesta, recibo 169480
soluciones distintas para las cajas y el tamaño de la placa que indica el OP.
El tiempo de ejecución es comparable a las otras respuestas basadas en clp (FD); de hecho, es muy competitivo para tableros pequeños (10 * 10 y más pequeños), pero empeora con tablones más grandes.
Por favor, reconozca que, por el bien de la decencia, me abstengo de publicar el código :)
Ya hay varias soluciones excelentes publicadas aquí (¡+1 para todos!), Utilizando restricciones CLP (FD).
Además, me gustaría mostrar una forma conceptualmente diferente de resolver tales tareas de colocación y cobertura, utilizando restricciones CLP ( B ).
La idea es considerar cada ubicación posible de un mosaico como un conjunto de valores VERDADEROS en elementos específicos de la grilla, donde cada elemento de grilla corresponde a una columna de una matriz, y cada colocación posible de una loseta corresponde a una fila. La tarea consiste entonces en seleccionar un conjunto de filas de dicha matriz de modo que cada elemento de la rejilla se cubra como máximo una vez, o en otras palabras, hay como máximo un valor VERDADERO en cada columna de la submatriz compuesta por las filas seleccionadas .
En esta formulación, la selección de filas y, por lo tanto, la colocación de las fichas en posiciones específicas, se indica mediante variables booleanas, una para cada fila de la matriz.
Aquí está el código que me gustaría compartir, funciona en SICStus Prolog y SWI con, como máximo, pequeños cambios:
:- 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).
La siguiente consulta ilustra qué elementos de la grilla están cubiertos ( 1
), donde cada fila corresponde a la ubicación de uno de los rectángulos:
?- 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.
correspondiente a la solución:
Dicha formulación CLP (B) es típicamente menos escalable que una versión CLP (FD), también porque hay más variables involucradas. Sin embargo, también tiene algunas ventajas:
Una ventaja importante es que se generaliza fácilmente a una versión de la tarea donde algunas o todas las formas se pueden usar varias veces . Por ejemplo, en la versión anterior, simplemente podemos cambiar card1/2
a:
custom_cardinality(Vs, card([0,1,2,3,4,5,6,7], Vs)).
y obtenga una versión en la que cada azulejo se pueda usar hasta 7 veces, e incluso se puede omitir por completo (debido a la inclusión de 0
).
En segundo lugar, podemos convertir esto fácilmente en una solución para un problema de cobertura exacto , lo que significa que cada elemento de la rejilla está cubierto por una de las formas, simplemente cambiando la card([0,1], Cs)
a la card([1], Cs)
en all_cardinalities//3
.
Junto con la otra modificación, aquí hay una cubierta para una cuadrícula de 4x4 que usa cuatro rectángulos de 2x2:
[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]
Una tercera ventaja de la formulación CLP (B) es que se puede calcular el número de soluciones sin enumerar explícitamente las soluciones. Por ejemplo, para la tarea original:
?- placement(7, 9, Vs, Sat), sat_count(Sat, Count).
Count = 68.
Estas 68 soluciones ya están bellamente ilustradas por @repeat.
A modo de comparación, esta es la cantidad de soluciones donde cada forma se puede usar entre 0 y 7 veces:
?- placement(7, 9, Vs, Sat), time(sat_count(Sat, Count)).
% 157,970,727 inferences, 19.165 CPU in 19.571 seconds
...
Count = 17548478.
Lo mismo en una grilla de 10x10, calculada en aproximadamente 6 minutos (~ 2 mil millones de inferencias):
?- placement(10, 10, Vs, Sat), sat_count(Sat, Count).
Count = 140547294509.
Y en una grilla 11x11, calculada en aproximadamente media hora (~ 9 mil millones de inferencias):
?- placement(11, 11, Vs, Sat), sat_count(Sat, Count).
Count = 15339263199580.
Por último, y quizás lo más significativo, este enfoque funciona para cualquier forma de fichas, y no está limitado a cuadrados o rectángulos. Por ejemplo, para manejar cuadrados de 1x1 y una forma de triángulo, así como sus reflejos verticales y horizontales, utilice la siguiente definición de 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)
).
Permitiendo que cada una de estas formas se use entre 0 y 7 veces en una placa de 9x7, obtengo, después de un minuto aproximadamente, Count = 58665048314
soluciones.
Aquí hay uno de ellos, elegido al azar:
Elegir soluciones de tal manera que cada una de ellas sea igualmente probable también es bastante fácil con CLP (B), incluso si el número de soluciones es demasiado grande para enumerarlas explícitamente.