Does anyone know why my code is so slow?
I’m at my wit’s end here. I am writing a program where you get a list of chocolates with different shapes that you have to pack in some different boxes. Each box also has a cost and the goal is to get a packing with minimal cost. However when I get above 10 chocolates it just hangs because it’s too inefficient.
Can anyone see why?
:- use_module([library(clpfd),library(lists)]).
chocolate(1, 2, 2). % Small square
chocolate(2, 2, 1). % Small rectangular
chocolate(3, 3, 1). % Small long
chocolate(4, 3, 3). % Large square
chocolate(5, 3, 2). % Large rectangular
chocolate(6, 4, 2). % Large long
example :-
% Products = [4,6,5,1,1,3,3,3,2,2],
% Products = [6,4,4,5,5,1,3,2,1,4,1],
% Products = [1,1,1,1,1,2,2,2,3,4,4,4,5,5,6,6],
Products = [2,2,2,2,3,5,5,6,6,6,6,6,6,6,6],
% Products = [4,6,1,2],
store_chocolates(Products).
store_chocolates( ChocolateList ) :-
length( ChocolateList, N ),
n_boxes(N, boxes(_BoxNumbers, BoxKinds, Widths, Lengths, Costs)),
total_area_constraint(Products, Widths, Lengths),
sum(Costs, #=, Cost),
constrain_chocolates(ChocolateList, Placements, Widths, Lengths),
chain(BoxKinds, #>=),
labeling([],BoxKinds),
term_variables(Placements, Variables, [Cost | Costs]),
time(labeling([bisect,down,ff,min(Cost)], Variables)),
write(Placements),
write(Cost).
chocolate_area(Number, Area) :-
chocolate(Number, W, L),
Area #= W * L.
box_area(Width, Length, Area) :-
Area #= Width * Length.
total_area_constraint(Products, Widths, Lengths) :-
maplist(chocolate_area, Products, Areas),
sum(Areas, #=, TotalArea),
maplist(box_area, Widths, Lengths, BoxAreas),
sum(BoxAreas, #>=, TotalArea).
product_either_way_fd(Number, Width, Length) :-
chocolate(Number, W, L),
(Width #= W #/\ Length #= L) #\/ (Width #= L #/\ Length #= W),
% make sure Width and Length have finite domains
Width #>= min(W, L),
Width #=< max(W, L),
Length #>= min(W, L),
Length #=< max(W, L).
alldisjoint([]).
% Here we check if every chocolate is disjoint with every other chocolate
alldisjoint([Placement | Placements]) :-
maplist(chocolates_dont_overlap(Placement), Placements),
alldisjoint(Placements).
kind_width_length_cost(Kind, Width, Length, Cost) :-
% Unused box
(Kind #= 0 #/\ Width #= 0 #/\ Length #= 0 #/\ Cost #= 0) #\/
(Kind #= 1 #/\ Width #= 4 #/\ Length #= 4 #/\ Cost #= 4) #\/
(Kind #= 2 #/\ Width #= 4 #/\ Length #= 6 #/\ Cost #= 6) #\/
(Kind #= 3 #/\ Width #= 5 #/\ Length #= 5 #/\ Cost #= 7),
% make sure all variables have finite domains, the above disjunction is
% not enough for the system to infer this
Kind in 0..3,
Width in 0..6,
Length in 0..6,
Cost in 0..7.
% a predicate to represent a collection of N boxes, applying the disjunction constraint kind_with_length_cost
n_boxes(N, boxes(Numbers, Kinds, Widths, Lengths, Costs)) :-
numlist(1, N, Numbers),
write(Numbers),
length(Kinds, N),
maplist(kind_width_length_cost, Kinds, Widths, Lengths, Costs).
% Predicate that checks if two chocolates are disjoint
chocolates_dont_overlap(chocolate_placement(Box1, X1, Y1, W1, L1),
chocolate_placement(Box2, X2, Y2, W2, L2)) :-
% If they're in different boxes, they're disjoint by default
% If not, we need to check if they dont overlap
(Box1 #\= Box2) #\/
(Box1 #= Box2 #==>
(X1 + W1 #=< X2 #\/ X2 + W2 #=< X1 #\/ Y1 + L1 #=< Y2 #\/ Y2 + L2 #=< Y1)).
disjoint_with_others(_, []).
disjoint_with_others(Placement,[OtherPlacement | OtherPlacements]) :-
chocolates_dont_overlap(Placement,OtherPlacement),
disjoint_with_others(Placement,OtherPlacements).
% This predicate uses the predicate placement below it to place a chocolate (rotated or not) in a box
% It applies constraints so that it stays in within the box
product_placement(Widths, Lengths, Number, Placement) :-
% Because you can rotate it
product_either_way_fd(Number, W, L),
write(W),
Placement = chocolate_placement(_Box, _X, _Y, W, L),
placement(Widths, Lengths, Placement),
length(Widths, N).
% Helper predicate that makes sure the chocolate fits inside the box (not yet accounting for overlap with other chocolates)
placement(Widths, Lengths, chocolate_placement(Box, X, Y, W, L)) :-
X #>= 0,
X + W #=< Width,
Y #>= 0,
Y + L #=< Length,
element(Box, Widths, Width),
element(Box, Lengths, Length).
constrain_chocolates([], [], _, _).
constrain_chocolates([Number | RestOfChocolates], [Placement | Placements], Widths, Lengths) :-
product_placement(Widths, Lengths, Number, Placement),
disjoint_with_others(Placement, Placements),
constrain_chocolates(RestOfChocolates, Placements, Widths, Lengths).