Longest increasing subset Prolog - prolog

I want to create in Prolog to find longest increasing subset of entered list. For example, you enter list of [3,1,2] and the output is [1,2],
?- subset([3,1,2], X).
X = [1,2]
I have code which shows all the subsets of this list:
subset([],[]).
subset([_|X],Y):-subset(X,Y).
subset([A|X],[A|Y]):-subset(X,Y).
Can anyone help me to find just the longest increasing subset?

Do you mean [1,3,5,6,7] to be the answer for [4,1,3,8,9,5,6,7]? IOW, do you really mean subsets, or just sublists, i.e. contiguous portions of the list?
If the latter is the case, you won't need subsets. The search is linear. If in a list [a,b,c,d,e,f] you find that d > e and the increasing sequence [a,b,c,d] stops, you don't need to restart the search from b now: the sequence will still break at d. You will just continue your search from e.
So, we'll just carry around some additional information during the search, viz. the current and the winning-so-far sub-sequences. And their lengths.
longest_incr([],0-[]).
longest_incr([A|B],RL-R):- % R is the result, of length RL
longest_aux(B,[],0, [A],1, RL-R).
longest_aux([], Win,N, Curr,K, RL-R):-
( K>N -> RL=K, reverse(Curr,R) ; RL=N, reverse(Win,R) ).
longest_aux([A|B],Win,N, Curr,K, RL-R):- Curr = [X|_], L is K,
( A>X -> longest_aux(B,Win, N, [A|Curr],L+1,RL-R) % keep adding
; L>N -> longest_aux(B,Curr,K, [A], 1, RL-R) % switch the winner
; longest_aux(B,Win, N, [A], 1, RL-R) % winner unbeaten
).
If OTOH you really need the longest subset ... there's a contradiction there. A set can have its elements rearranged, so the longest subset of a given list will be
longset_subset(L,R):- sort(L,S), R=S.
Perhaps you mean the longest order-preserving sub-sequence, i.e. it is allowed to be non-contiguous. Then you can gather all solutions to your subset with findall or similar predicate, and analyze these results:
longest_subseq(L,R):-
findall( S, subset(L,S), X),
maplist( longest_incr, X, Y),
keysort( Y, Z),
last( Z, _Len-R).
The above has a lot of redundancy in it. We can attempt to improve its efficiency by only allowing the increasing subsequences:
incr_subseq([],[]).
incr_subseq([_|X],Y):- incr_subseq(X,Y).
incr_subseq([A|X],[A|Y]):- incr_subseq(X,Y), ( Y=[] ; Y=[B|_], A<B).
Now all the sub-sequences found by the above predicate will be increasing, so we can just take their lengths:
lenlist(List,Len-List) :- length(List,Len).
longest_subseq(L,R):-
findall( S, incr_subseq(L,S), X),
maplist( lenlist, X, Y),
keysort( Y, Z),
last( Z, _Len-R).
Or, the linear searching longest_incr could be tweaked for a more efficient solution. Instead of maintaining just one winning sub-sequence, it would maintain all the relevant possibilities as it goes along the input list.

Just out of curiosity, would it be possible in prolog to realize something like this for finding longest increasing subsequence:
You find all subsets of list
Than you find, which of these subsets are increasing
And then you search for the longest
If it's possible, how could I do that in Prolog?

Related

Superpermutation in Prolog

I want to watch 6 episodes of "friends" in all possible permutations. How can I arrange the episodes in one string so that the substrings of length 6 cover all permutations? What are the shortest such strings?
What would be the Prolog code for that?
Here is a brute-force implementation with an attempt to build shorter solutions first.
superpermutation(Atom, Superpermutation) :-
bagof(Permutation, permute(Atom, Permutation), Permutations),
select(Permutation, Permutations, RemainingPermutations),
join(RemainingPermutations, Permutation, Superpermutation).
join([], Superpermutation, Superpermutation).
join(Permutations, Superpermutation, FinalSuperpermutation) :-
member(OnePermutation, Permutations),
atom_length(OnePermutation, Length), !,
%
between(1, Length, Position),
select(Permutation, Permutations, RemainingPermutations),
sub_atom(Permutation, Position, _, 0, Suffix),
sub_atom(Superpermutation, 0, _, _, Suffix),
sub_atom(Permutation, 0, Position, _, Prefix),
atom_concat(Prefix, Superpermutation, NewSuperpermutation),
join(RemainingPermutations, NewSuperpermutation, FinalSuperpermutation).
permute(Atom, PermutedAtom) :-
atom_chars(Atom, Chars),
permutation(Chars, PermutedChars),
atom_chars(PermutedAtom, PermutedChars).
Here are the first solutions found for n = 2 to 7.
n = 2
212
n = 3 (length = 9)
321323123
n = 4 (length = 33)
432143241324312434213423142341234
n = 5 (length = 153)
543215432514325413254312543521435241352431524351243542135423154235142354123545
321453241532451324531245342153425134253142534125345213452314523415234512345
n = 6 (length = 873, known shorter length = 872)
654321654326154326514326541326543126543621543625143625413625431625436125436521
436524136524316524361524365124365421365423165423615423651423654123654632154632
514632541632546132546312546352146352416352461352463152463512463542163542613542
631542635142635412635462135462315462351462354162354612354653214653241653246153
246513246531246534216534261534265134265314265341265346215346251346253146253416
253461253465213465231465234165234615234651234656432156432516432561432564132564
312564352164352614352641352643152643512643562143562413562431562435162435612435
642135642315642351642356142356412356453216453261453264153264513264531264536214
536241536245136245316245361245364215364251364253164253614253641253645213645231
645236145236415236451236456321456324156324516324561324563124563421563425163425
613425631425634125634521634526134526314526341526345126345621345623145623415623
451623456123456
n = 7 (length = 5913, known shorter length = 5908) (computation time ~ 10 secs)
765432176543271654327615432765143276541327654312765437216543726154372651437265
413726543172654371265437621543762514376254137625431762543716254376125437652143
765241376524317652437165243761524376512437654213765423176542371654237615423765
142376541237654732165473261547326514732654173265471326547312654736215473625147
362541736254713625473162547361254736521473652417365247136524731652473615247365
124736542173654271365427316542736154273651427365412736547213654723165472361547
236514723654172365471236547632154763251476325417632547163254761325476312547635
214763524176352471635247613524763152476351247635421763542716354276135427631542
763514276354127635472163547261354726315472635147263541726354712635476213547623
154762351476235417623547162354761235476532147653241765324716532476153247651324
765312476534217653427165342761534276513427653142765341276534721653472615347265
134726531472653417265347126534762153476251347625314762534176253471625347612534
765213476523147652341765234716523476152347651234765743216574326157432651743265
714326574132657431265743621574362517436257143625741362574316257436125743652174
365271436527413652743165274361527436512743657214365724136572431657243615724365
172436571243657421365742316574236157423651742365714236574123657463215746325174
632571463257416325746132574631257463521746352714635274163527461352746315274635
127463572146357241635724613572463157246351724635712463574216357426135742631574
263517426357142635741263574621357462315746235174623571462357416235746123574653
217465327146532741653274615327465132746531274653721465372416537246153724651372
465317246537124653742165374261537426513742653174265371426537412653746215374625
137462531746253714625374162537461253746521374652317465237146523741652374615237
465123746573214657324165732461573246517324657132465731246573421657342615734265
173426571342657314265734126573462157346251734625713462573146257341625734612573
465217346527134652731465273416527346152734651273465721346572314657234165723461
572346517234657123465764321576432517643257164325761432576413257643125764352176
435271643527614352764135276431527643512764357216435726143572641357264315726435
172643571264357621435762413576243157624351762435716243576124357642135764231576
423517642357164235761423576412357645321764532716453276145327641532764513276453
127645372164537261453726415372645137264531726453712645376214537624153762451376
245317624537162453761245376421537642513764253176425371642537614253764125376452
137645231764523716452376145237641523764512376457321645732614573264157326451732
645713264573126457362145736241573624517362457136245731624573612457364215736425
173642571364257316425736142573641257364521736452713645273164527361452736415273
645127364572136457231645723614572364157236451723645712364576321457632415763245
176324571632457613245763124576342157634251763425716342576134257631425763412576
345217634527163452761345276314527634152763451276345721634572613457263145726341
572634517263457126345762134576231457623415762345176234571623457612345767543216
754326175432671543267514326754132675431267543621754362715436275143627541362754
316275436127543672154367251436725413672543167254361725436712543675214367524136
752431675243617524367152436751243675421367542316754236175423671542367514236754
123675463217546327154632751463275416327546132754631275463721546372514637254163
725461372546317254637125463752146375241637524613752463175246371524637512463754
216375426137542631754263715426375142637541263754621375462317546237154623751462
375416237546123754673215467325146732541673254617325467132546731254673521467352
416735246173524671352467315246735124673542167354261735426713542673154267351426
735412673546217354627135462731546273514627354162735461273546721354672315467235
146723541672354617235467123546753214675324167532461753246715324675132467531246
753421675342617534267153426751342675314267534126753462175346271534627513462753
146275341627534612753467215346725134672531467253416725346172534671253467521346
752314675234167523461752346715234675123467564321756432715643275164327561432756
413275643127564372156437251643725614372564137256431725643712564375216437526143
752641375264317526437152643751264375621437562413756243175624371562437516243756
124375642137564231756423715642375164237561423756412375647321564732516473256147
325641732564713256473125647352164735261473526417352647135264731526473512647356
214735624173562471356247315624735162473561247356421735642713564273156427351642
735614273564127356472135647231564723516472356147235641723564712356475321647532
614753264175326471532647513264753126475362147536241753624715362475136247531624
753612475364217536427153642751364275316427536142753641275364721536472513647253
164725361472536417253647125364752136475231647523614752364175236471523647512364
756321475632417563247156324751632475613247563124756342175634271563427516342756
134275631427563412756347215634725163472561347256314725634172563471256347521634
752613475263147526341752634715263475126347562134756231475623417562347156234751
623475612347567432156743251674325617432567143256741325674312567435216743526174
352671435267413526743152674351267435621743562714356274135627431562743516274356
127435672143567241356724315672435167243561724356712435674213567423156742351674
235617423567142356741235674532167453261745326714532674153267451326745312674536
217453627145362741536274513627453162745361274536721453672415367245136724531672
453617245367124536742153674251367425316742536174253671425367412536745213674523
167452361745236714523674152367451236745632174563271456327415632745163274561327
456312745637214563724156372451637245613724563172456371245637421563742516374256
137425631742563714256374125637452163745261374526317452637145263741526374512637
456213745623174562371456237415623745162374561237456732145673241567324516732456
173245671324567312456734215673425167342561734256713425673142567341256734521673
452617345267134526731452673415267345126734562173456271345627314562734156273451
627345612734567213456723145672341567234516723456172345671234567
n = 8 -> Stack overflow!
The stack overflow for n = 8 is mostly caused by the bagof predicate. Anyone can remove this error?
This is my attempt, which appears to have a bug, but I don't see where it is exactly. If you see it, please let me know where it is.
First, let's follow the algorithm sketched by Wikipedia for N<5:
super([X], [X], 1).
super([X|Xs], Super, N) :-
%% obtain the superpermutation of N-1
super(Xs, Super0, N0),
succ(N0, N),
%% split Super0 into its individual permutations
split_permutations(N0, Super0, Permutations),
%% insert X into the middle of a copy of each of these
maplist(insert_surrounded(X), Permutations, NewPermutations),
%% concatenate the new permutations and deduplicate them
append(NewPermutations, SuperWithDupes),
deduplicate(SuperWithDupes, Super).
Now to make this go, we will need quite a few utility predicates, starting with deduplication and testing whether a sublist is a permutation:
deduplicate([X], [X]).
deduplicate([X,Y|Xs], Dedup) :-
(X == Y ->
deduplicate([Y|Xs], Dedup)
;
deduplicate([Y|Xs], Dedup1),
Dedup = [X|Dedup1]
).
is_unique([]).
is_unique([X|Xs]) :-
\+ memberchk(X, Xs),
is_unique(Xs).
Now to obtain the permutations from the N-1 call, I have split_permutations/3 which gives you back the permutations (in order) of an earlier call to super/2:
split_permutations(_, [], []).
split_permutations(Length, [X|Xs], Permutations) :-
split_permutations(Length, Xs, Permutations1),
length(L, Length),
(prefix(L, [X|Xs]), is_unique(L) ->
Permutations = [L|Permutations1]
;
Permutations = Permutations1
).
insert_surrounded/3 uses SWI-Prolog trick append/2:
insert_surrounded(X, Permutation, NewPermutation) :-
append([Permutation, [X], Permutation], NewPermutation).
For my own edification, I wrote a thing to output a list slammed together so that I could compare my output to Wikipedia's:
write_string([]) :- nl.
write_string([X|Xs]) :- write(X), write_string(Xs).
For N=3, I get the same thing as Wikipedia:
?- super([3,2,1], X, Y), write_string(X).
123121321
X = [1, 2, 3, 1, 2, 1, 3, 2, 1],
Y = 3 .
I note with some dissatisfaction that using the first item in the list rather than the last is forcing me to present the input reversed. I would believe it if this was my problem with the next output, which is N=4:
12341232314231312431213421313241323214321 (mine)
123412314231243121342132413214321 (Wikipedia)
I am thinking now that it would have been better to generate some sort of superpermutation tree, and then have an output or serialization routine that handles the deduplication, and then constructing the tree leaves it in a broken-up state throughout the program until the last step. It seems inefficient and/or a good way to introduce bugs to do the concatenating and then immediately break the concatenated strings back apart. I don't think that is essential to the algorithm though. Perhaps another intrepid Prolog programmer will see a trick here!

How to maximize the goal in prolog?

I am trying to solve the knapsack problem in prolog. Following is my implementation.
% 'ks' is compound term which has 4 argumets
% 1 - List of items to be chosen from.
% 2 - Maximum weight a knapsack can carry.
% 3 - Selected items which sum of weights is less than or equal to knapsack capacity.
% 4 - The gain after choosing the selected item.
% base conditions where input list contains only one items and
% it is either selected or excluded.
ks([item(W1, V1)], W, [item(W1, V1)], V1):- W1 =< W.
ks([item(W1, _)], W, [], 0):- W1 > W.
% An item from the input list is chosen in the knapsack.
% In that case, we recurse with smaller list with reduced weight constraint.
ks(ItemList, MaxWeight, SelectItems, Gain) :-
append(Prefix, [item(W1, V1)|Suffix], ItemList),
append(Prefix, Suffix, RemList),
NewWeight is MaxWeight - W1,
W1 =< MaxWeight,
append([item(W1, V1)], SelectItems1, SelectItems),
ks(RemList, NewWeight, SelectItems1, Gain1),
Gain is V1 + Gain1.
% An item from the input list is not chosen in the knapsack.
% In that case, we recurse with smaller list but with the same weight constraint.
ks(ItemList, MaxWeight, SelectItems, Gain) :-
append([P1|Prefix], [item(W1, V1)|Suffix], ItemList),
append([P1|Prefix], Suffix, RemList),
not(member(item(W1, V1), SelectItems)),
ks(RemList, MaxWeight, SelectItems, Gain).
The input to the program will be list of items as below. in term item(W, V) W is weight of the item while V is value of the item. Goal to maximize the value for the given weight constraint.
ks([item(2,3), item(3,4), item(4,5), item(5,8), item(9,10)], 20, List, Gain).
List = [item(2, 3), item(3, 4), item(4, 5), item(5, 8)],
Gain = 20 ;
While I am able to generate all the combinations of items with above program, I am not able to code to find out the maximum gain only.
Could any one please point me the right direction?
Thanks.
I think that to find reusable abstractions it's an important point of studying programming. If we have a subset_set/2 that yields on backtracking all subsets, ks/4 becomes really simple:
subset_set([], _).
subset_set([H|T], Set) :-
append(_, [H|Rest], Set),
subset_set(T, Rest).
ks(Set, Limit, Choice, Gain) :-
subset_set(Choice, Set),
aggregate((sum(W), sum(G)), member(item(W, G), Choice), (TotWeight, Gain)),
TotWeight =< Limit.
and then
ks_max(Items, Limit, Sel, WMax) :-
aggregate(max(W,I), ks(Items,Limit,I,W), max(WMax,Sel)).
despite its simplicity, subset_set/2 is not really easy to code, and library available alternatives (subset/2, ord_subset/2) don't enumerate, but only check for the relation.
There are at least two things you can do, depending on how you want to approach this.
You could simply collect all solutions and find the maximum. Something along the lines of:
?- Items = [item(2,3), item(3,4), item(4,5), item(5,8), item(9,10)],
findall(Gain-List, ks(Items, 20, List, Gain), Solutions),
sort(Solutions, Sorted),
reverse(Sorted, [MaxGain-MaxList|_]).
% ...
MaxGain = 26,
MaxList = [item(9, 10), item(5, 8), item(4, 5), item(2, 3)].
So you find all solutions, sort them by Gain, and take the last. This is just one way to do it: if you don't mind collecting all solutions, it is up to you how you want to pick out the solution you need from the list. You might also want to find all maximum solutions: see this question and answers for ideas how to do that.
The cleaner approach would be to use constraints. As the comment to your questions points out, it is not very clear what you are actually doing, but the way to go would be to use a library like CLP(FD). With it, you could simply tell labeling/2 to look for the maximum Gain first (once you have expressed your problem in terms of constraints).
greedy Approximation algorithm :
pw((P,W),Res) :- PW is P/W, Res=(PW,P,W).
pws(Ps_Ws,PWs) :- maplist(pw,Ps_Ws,PWs).
sort_desc(List,Desc_list) :-
sort(List,Slist),
reverse(Slist,Desc_list).
ransack_([],_,_,[]).
ransack_([(_,P,W)|PWs],Const,Sum,Res) :-
Sum1 is W+Sum,
Sum1 < Const ->
Res=[(P,W)|Res1],
ransack_(PWs,Const,Sum1,Res1)
;ransack_(PWs,Const,Sum,Res).
% ransack(+[(P,W)|..],+W,,Res)
ransack(L_PWs,W,Res) :-
pws(L_PWs,Aux),
sort_desc(Aux,PWs),
ransack_(PWs,W,0,Res).
Test
item(W, V)-->(V,W)
| ?- ransack([(3,2),(4,3),(5,4),(8,5),(10,9)],20,Res).
Res = [(8,5),(3,2),(4,3),(5,4)] ? ;
no

Prolog: Exam schedule generator - How to avoid permutations in solutions

I'm building an exam scheduler in Prolog.
The scheduler is based on this example:
https://metacpan.org/source/DOUGW/AI-Prolog-0.741/examples/schedule.pl
How can I make sure there are no permutations in my solution?
For example solution
-> ((exam1, teacher1, time1, room1), (exam2, teacher2, time2, room2))
Later solution:
-> ((exam2, teacher2, time2, room2),(exam1, teacher1, time1, room1))
How can I avoid this?
Thanks!
1) The closest/easiest from what you've got is to check that the course you've chosen is strictly bigger in order than the previous one.
For example by adding an extra predicate which also includes the previous course in the combination.
%%makeListPrev(PreviousTakenCourse, ResultCombinationOfCourses, NrOfCoursesToAdd)
makeListPrev(_,[], 0).
makeListPrev(course(Tprev,Ttime,Troom),[course(Teacher,Time,Room)|Rest], N) :-
N > 0,
teacher(Teacher),
classtime(Time),
classroom(Room),
course(Tprev,Ttime,Troom) #< course(Teacher,Time,Room), %% enforce unique combinations
is(M,minus(N,1)),
makeListPrev(course(Teacher,Time,Room),Rest,M).
In this way you eliminate all duplicate permutations of the same combination by always taking the lexographically smallest.
E.g if you have 4 courses:
(a,b,c,d)
(a,b,d,c) % d can't be before c
(a,c,b,d) % c can't be before b
...
2) Another way to solve this quite easily is to first create a list of all possible courses. And then take out all possible combinations of N sequentially.
scheduler(L) :-
%% Find all possible courses
findall(course(Teacher,Time,Room),(teacher(Teacher),classtime(Time),classroom(Room)),Courses),
makeList(Courses,4,L),
different(L).
makeList([],0,[]) :- !. %% list completed
makeList([H|T],N,[H|Res]) :- %% list including H
M is N-1,
makeList(T,M,Res).
makeList([_|T], N, Res) :- makeList(T, N, Res). %% list without H

Prolog permutations with condition?

I have this program to generate all the permutations of a list. The thing is, I need to generate only the permutations in which the consecutive terms have the absolute difference less or equal than 3. Something like:
[2,7,5] => [2,5,7] and [7,5,2]. [2 7 5] would be wrong since 2-7 = -5 and |-5| > 3
The permutation program:
perm([X|Y],Z):-
perm(Y,W),
takeout(X,Z,W).
perm([],[]).
takeout(X,[X|R],R).
takeout(X,[F|R],[F|S]):-
takeout(X,R,S).
permutfin(X,R):-
findall(P,perm(X,P),R).
I know I'm supposed to add the condition somewhere in the perm function but I can't figure out exactly what or where to write.
A more intuitive way to write a permutation is:
takeout([X|T],X,T).
takeout([H|L],X,[H|T]) :-
takeout(L,X,T).
Where the first element is the original list, the second the element picked, and the third the list without that element.
In that case the permutation predicate is defined as:
perm([],[]).
perm(L,[E|T]) :-
takeout(L,E,R),
perm(R,T).
this also allows tail-recursion which can imply an important optimization in most Prolog systems.
Now in order to generate only permutations with a consecutive difference of at most three, you can do two things:
The naive way is generate and test: here you let Prolog generate a permutation, but you only accept it if a certain condition is met. For instance:
dif3([_]).
dif3([A,B|T]) :-
D is abs(A-B),
D =< 3,
dif3([B|T]).
and then define:
perm3(L,R) :-
perm(L,R),
dif3(R).
This approach is not very efficient: it can be the case that for an exponential amount of permutations, only a few are valid, and this would imply a large computational effort. If for instance the list of elements is [2,5,7,9] it will generate all permutations starting with [2,9,...] while a more intelligent approach could already see that will never generate a valid solution anyway.
the other more intelligent approach is interleaved generate and test. Here you select only numbers with takeout3/4 that are valid candidates. You can define a predicate takeout3(L,P,X,T). where L is the original list, P the previous number, X the selected number and T the resulting list:
takeout3([X|T],P,X,T) :-
D is abs(X-P),
D =< 3.
takeout3([H|L],N,X,[H|T]) :-
takeout3(L,N,X,T).
Now we can generate a permutation as follows:
perm3([],[]).
perm3(L,[E|T]) :-
takeout(L,E,R),
perm3(R,E,T).
perm3([],_,[]).
perm3(L,O,[E|T]) :-
takeout3(L,O,E,R),
perm3(R,E,T).
Mind we use two versions of perm3: perm3/2 and perm3/3, the first is used to generate the first element (using the old takeout/3), and perm3/3 is used to generate the remainder of the permutation using takeout3/4.
The full source code of this approach is:
takeout([X|T],X,T).
takeout([H|L],X,[H|T]) :-
takeout(L,X,T).
takeout3([X|T],P,X,T) :-
D is abs(X-P),
D =< 3.
takeout3([H|L],N,X,[H|T]) :-
takeout3(L,N,X,T).
perm3([],[]).
perm3(L,[E|T]) :-
takeout(L,E,R),
perm3(R,E,T).
perm3([],_,[]).
perm3(L,O,[E|T]) :-
takeout3(L,O,E,R),
perm3(R,E,T).
Running it with swipl gives:
?- perm3([2,7,5],L).
L = [2, 5, 7] ;
L = [7, 5, 2] ;
false.
The expected behavior.
Here is another solution. I added the condition in takeout to make sure the adjacent items are within 3 of each other:
perm([X|Y],Z):-
perm(Y,W),
takeout(X,Z,W).
perm([],[]).
check(_,[]).
check(X,[H|_]) :-
D is X - H,
D < 4,
D > -4.
takeout(X,[X|R],R) :-
check(X,R).
takeout(X,[F|R],[F|S]):-
takeout(X,R,S),
check(F,R).

create a list from a list of lists

I need to do the following: given a list of lists I need to find all possible combinations of the lists such that if some of these lists belong in such a combination, then they have no elements in common and the list created by appending the lists in the combination has a given length. Any ideas?
Example:
Say P= [[1,2,3],[4,5,6],[2,5],[7,9],[7,10],[8],[10]].
N a given number, say N=10. I need to search through P in order to find appropriate lists, with no elements in common, and add them in a list L such that the length of the union of L is 10. So in the above example :
L=[[1,2,3],[4,5,6],[7,9],[8],[10]]. It might be very easy but I'm new in Prolog
Given nobody's answered, and it's been quite a while since I've written anything in Prolog and I figured I needed the practice, here's how you'd do it.
First, to make generating the combinations easier, we create a term to preprocess the lists to pair them with their lengths to avoid having to get the lengths multiple times. The cut avoids needless backtracking:
with_lengths([], []) :- !.
with_lengths([H|T1], [(Len, H)|T2]) :-
length(H, Len),
with_lengths(T1, T2).
Here's the comb/3 predicate, which you use for generating the combinations:
comb(L, R, Max) :-
with_lengths(L, L1),
comb1(L1, R, Max).
comb1/3 does the actual work. The comments explain what's going on:
% Combination works.
comb1([], [], 0).
% Try combining the current element with the remainder.
comb1([(Len, Elem)|T1], [Elem|T2], Max) :-
NewMax is Max - Len,
comb1(T1, T2, NewMax).
% Alternatively, ignore the current element and try
% combinations with the remainder.
comb1([_|T1], T2, Max) :-
comb1(T1, T2, Max).

Resources