Find best result without findall and a filter

Question

I'm in a bit of pickle in Prolog.

I have a collection of objects. These objects have a certain dimension, hence weight.

I want to split up these objects in 2 sets (which form the entire set together) in such a way that their difference in total weight is minimal.

The first thing I tried was the following (pseudo-code):

-> findall with predicate createSets(List, set(A, B))
-> iterate over results while
---> calculate weight of both
---> calculate difference
---> loop with current difference and compare to current difference
       till end of list of sets

This is pretty straightforward. The issue here is that I have a list of +/- 30 objects. Creating all possible sets causes a stack overflow.

Helper predicates:

sublist([],[]).
sublist(X, [_ | RestY]) :-
  sublist(X,RestY).
sublist([Item|RestX], [Item|RestY]) :-
  sublist(RestX,RestY).

subtract([], _, []) :-
  !.
subtract([Head|Tail],ToSubstractList,Result) :-
  memberchk(Head,ToSubstractList),
  !,
  subtract(Tail, ToSubstractList, Result).
subtract([Head|Tail], ToSubstractList, [Head|ResultTail]) :-
  !,
  subtract(Tail,ToSubstractList,ResultTail).

generateAllPossibleSubsets(ListToSplit,sets(Sublist,SecondPart)) :-
  sublist(Sublist,ListToSplit),
  subtract(ListToSplit, Sublist, SecondPart).

These can then be used as follows:

:- findall(Set, generateAllPossibleSubsets(ObjectList,Set), ListOfSets ),
   findMinimalDifference(ListOfSets,Set).

So because I think this is a wrong way to do it, I figured I'd try it in an iterative way. This is what I have so far:

totalWeightOfSet([],0).
totalWeightOfSet([Head|RestOfSet],Weight) :-
  objectWeight(Head,HeadWeight),
  totalWeightOfSet(RestOfSet, RestWeight),
  Weight is HeadWeight + RestWeight.

findBestBalancedSet(ListOfObjects,Sets) :-
  generateAllPossibleSubsets(ListOfObjects,sets(A,B)),
  totalWeightOfSet(A,WeightA),
  totalWeightOfSet(B,WeightB),
  Temp is WeightA - WeightB,
  abs(Temp, Difference),
  betterSets(ListOfObjects, Difference, Sets).

betterSets(ListOfObjects,OriginalDifference,sets(A,B)) :-
  generateAllPossibleSubsets(ListOfObjects,sets(A,B)),
  totalWeightOfSet(A,WeightA),
  totalWeightOfSet(B,WeightB),
  Temp is WeightA - WeightB,
  abs(Temp, Difference),
  OriginalDifference > Difference,
  !,
  betterSets(ListOfObjects, Difference, sets(A, B)).
betterSets(_,Difference,sets(A,B)) :-
  write_ln(Difference).

The issue here is that it returns a better result, but it hasn't traversed the entire solution tree. I have a feeling this is a default Prolog scheme I'm missing here.

So basically I want it to tell me "these two sets have the minimal difference".

Edit:

What are the pros and cons of using manual list iteration vs recursion through fail

This is a possible solution (the recursion through fail) except that it can not fail, since that won't return the best set.

Answer 1

I would generate the 30 objects list, sort it descending on weight, then pop objects off the sorted list one by one and put each into one or the other of the two sets, so that I get the minimal difference between the two sets on each step. Each time we add an element to a set, just add together their weights, to keep track of the set's weight. Start with two empty sets, each with a total weight of 0.

It won't be the best partition probably, but might come close to it.

A very straightforward implementation:

pair(A,B,A-B).

near_balanced_partition(L,S1,S2):-
  maplist(weight,L,W),      %// user-supplied predicate weight(+E,?W).
  maplist(pair,W,L,WL),
  keysort(WL,SL),
  reverse(SL,SLR),
  partition(SLR,0,[],0,[],S1,S2).

partition([],_,A,_,B,A,B).
partition([N-E|R],N1,L1,N2,L2,S1,S2):-
   (    abs(N2-N1-N) < abs(N1-N2-N)
   ->   N3 is N1+N,
        partition(R,N3,[E|L1],N2,L2,S1,S2)
   ;    N3 is N2+N,
        partition(R,N1,L1,N3,[E|L2],S1,S2)
   ).

---

If you insist on finding the precise answer, you will have to generate all the partitions of your list into two sets. Then while generating, you'd keep the current best.

The most important thing left is to find the way to generate them iteratively.

A given object is either included in the first subset, or the second (you don't mention whether they're all different; let's assume they are). We thus have a 30-bit number that represents the partition. This allows us to enumerate them independently, so our state is minimal. For 30 objects there will be 2^30 ~= 10^9 generated partitions.

exact_partition(L,S1,S2):-
  maplist(weight,L,W),      %// user-supplied predicate weight(+E,?W). 
  maplist(pair,W,L,WL),
  keysort(WL,SL),           %// not necessary here except for the aesthetics 
  length(L,Len), length(Num,Len), maplist(=(0),Num),
  .....

You will have to implement the binary arithmetics to add 1 to Num on each step, and generate the two subsets from SL according to the new Num, possibly in one fused operation. For each freshly generated subset, it's easy to calculate its weight (this calculation too can be fused into the same generating operation):

  maplist(pair,Ws,_,Subset1),
  sumlist(Ws,Weight1),
  .....

This binary number, Num, is all that represents our current position in the search space, together with the unchanging list SL. Thus the search will be iterative, i.e. running in constant space.