How do I "reduce" a Prolog list of pairs? - prolog

I'm trying to do some graph analysis using PROLOG. In particular I want a list of pairs which indicate the number of nodes at each deeper level from the root. I'm able to produce a list of pairs of the form:
M = [1-[431, 441, 443, 444, 445, 447, 449], 2-[3, 5, 7, 8, 409, 451|...]].
The pair key is the graph level; the pair value is the list of nodes at that level;
whereas I want the pair value to be a count of the nodes.
But I can't figure out to reduce M to N.
N = [1-7],[2,20,],...........[8-398]
where N indicates 7 nodes at the 1th level etc.... perhaps I need a good set of examples working with pairs.
Simpler data could be M=[1-[a,b,c],],2-[d,e]] should reduce to N=[1-3,2-2] Any pointers would be much appreciated.

You want to map a list of such pairs to another list element-wise as follows
list_bylength(KLs, KNs) :-
maplist(el_len, KLs, KNs).
el_len(I-L,I-N) :-
length(L, N).
Alternatively:
list_bylength2([], []).
list_bylength2([I-L|ILs], [I-N|INs]) :-
length(L, N),
list_bylength2(ILs, INs).
And most compactly, using library(lambda):
..., maplist(\ (I-L)^(I-N)^length(L,N), ILs, INs), ...

a lot of list processing can be performed by findall/3, using member/2 as 'cursor'.
list_bylength(KLs, KNs) :-
findall(K-L, (member(K-Ls,KLs),length(Ls,L)), KNs).

Related

Generate a 3d List

I am trying to make a List of Lists of Lists without values. If N_meses = 4 I want List =[[[A,B,C,D]]].
I get what I want ( List = [[[]]] ) but every lists have the same values as you can see in the print I attached. How can I change this code so every lists have a different "value"?
I am doing this
generate_table(Num_investigadores, Num_actividades, N_Meses, Tabela) :-
length(Row, Num_actividades),
length(X,N_Meses),
maplist(=(X), Row),
length(Tabela, Num_investigadores),
maplist(=(Row), Tabela).
The culprit is in essence the:
%% ...
maplist(=(X), Row),
%% ...
Here you basically defined a list X, and then you set with maplist/2 that all elements in Row are unified with that X. In the unification process. This thus means that all the elements of Row will in essence point to the same list.
Nevertheless, I think it would definitely help if you make the predicate less ambitious: implement helper predicates and let each predicate do a small number of things.
We can for example first design a predicate lengthlist/2 that is the "swapped" version of length/2, and thus has as first parameter the length and as second parameter the list, like:
lengthlist(N, L) :-
length(L, N).
Now we can construct a predicate that generates a 2d rectangular list, for example:
matrix(M, N, R) :-
lengthlist(M, R),
maplist(lengthlist(N), R).
here we thus first use lengthlist to construct a list with N elements, and then we use maplist/2 to call lengthlist(N, ...) on every element, such that every element is unified with a list of N elements. We thus construct a 2d list with M elements where every elements is a list of N elements.
Then finally we can construct a 3d tensor:
tensor3(L, M, N, T) :-
lengthlist(L, T),
maplist(matrix(M, N), T).
Here we thus construct an L×M×N tensor.
We can in fact generalize the above to construct a arbitrary deep cascade of lists that is "rectangular" (in the sense that for each dimension, the lists have the same number of elements), but I leave this as an exercise.

Recurrence in Prolog

I am about to create program in Prolog that returns list of values from recurrence:
f(1) = 3, f(2) = 2, f(n) = f(n-1) * f(n-2)
E.g
rekur(5, S). -> S = [3, 2, 6, 12, 72]
I tried to solve it using:
rekur(2,[3,2]).
rekur(X,[H|T,M]):- X1 is X-1, rekur(X1,[H1,T1,M1], H1 is T*M.
Which has been proven to be completely wrong. Could you demonstrate the solution for this example? The explanation is highly appreciated. I have found that I have no idea how Prolog works. Thanks for the help.
A major problem is probably that [H|T,M] is not a valid list. In fact a list in Prolog looks like what most programmers consider a linked list: it is a tuple containing a reference to the element (called the head) and a reference to the next tuple (called the tail). There is a special list [] which means end of list. [3,2] is simply syntactical sugar for [3|[2|[]]] which is actually nice formatting of [](3,[](2,[])).
Because of this linked list concept, you cannot (nor syntactically nor on O(1) access the last elements).
That's why Prolog usually works the other way around: you generate the head of the list, and by using recursion, the remainder of the list is filled in correctly. For your rekur/2 clause, you can work with two accumulators A and B that somehow store the next elements that will be emitted in the list. Furthermore you use the N (the length of the list to be generated) as loop counter. For example:
rekur(N,L) :-
rekur(N,3,2,L).
rekur(N,_,_,[]) :-
N <= 0,
!.
rekur(N,A,B,[A|T]) :-
N > 0,
C is A*B,
N1 is N-1,
rekur(N1,B,C,T).

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 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).

Longest increasing subset 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?

Resources