Prolog List Predicates - list

I need some help with three prolog predicates for checking and manipulating lists. I'm new to prolog and any help would be much appreciated.
The three predicates are:
double_up(+List1, -List2) is true when List2 has each element of List1 twice. The query double_up([a,b,c],X) should give X=[a,a,b,b,c,c]. The order of the elements in the output list does not matter.
pivot(+List1, +Pivot, -Smaller, -GreaterEq) is true when Smaller is the list of numbers in List1 smaller than Pivot, and GreaterEq is the list of numbers in List1 bigger than or equal to Pivot.
fancy_replace(+List, +Takeout,+Putin, -NewList, -Count) is true when NewList is the same list as the input List, but where each Takeout element in the list is replaced with the Putin element. Count should be the number of Takeouts that got replaced. For example, the query fancy_replace([9,10,1,9,2],9,0, X, C) should give X = [0,10,1,0,2] and C = 2. The order of the elements in the output list does not matter.

The simpler pattern to process lists in Prolog imposes a recursive predicate with 2 arguments, matching - conventionally - input and output data, and a base case, stopping the recursion, matching the empty list. Then
double_up([X|Xs], [X,X|Ys]) :- double_up(Xs, Ys).
double_up([], []).
This predicate it's a bit more general than what's required, because it works also in mode double_up(-List1, +List2). For instance
?- double_up(L,[1,1,2,2]).
L = [1, 2].
To restrict its mode as required, I think it's necessary to uselessly complicate the code, moving that clean loop in a service predicate, and leaving double_up just to test the arguments:
double_up(I, O) :- is_list(I), var(O), double_up_(I, O).
double_up_([X|Xs], [X,X|Ys]) :- double_up_(Xs, Ys).
double_up_([], []).
pivot/4 could be 'one-liner' in SWI-Prolog:
pivot(List1, Pivot, Smaller, GreaterEq) :-
partition(>(Pivot), List1, Smaller, GreaterEq).
like partition, foldl from library(apply) it's an easy inplementation of the last required predicate:
fancy_replace(List, Takeout, Putin, NewList, Count) :-
foldl(swap_n_count(Takeout, Putin), List, NewList, 0, Count).
swap_n_count(Takeout, Putin, L, N, C0, C) :-
( L == Takeout
-> N = Putin, C is C0 + 1
; N = L, C = C0
).

to be honest, i hate prolog... even though it is fun and easy after you learn it
i think this is a good reference as I was having trouble understanding how prolog works couple weeks ago.
what does the follow prolog codes do?
anyway.. this is the answer for your first problem; Hopefully you could solve the rest yourself :D
double([]).
double([H|[]], [H,H|[]]).
double([H|T],[H,H|T1]):- double(T, T1).
btw, this might not the only solution...but it works

Related

Prolog - Finding even elements in a list

I want to write a rule in Prolog that returns the even elements in a given list. For example:
even_elements([1,2,3,4], Result) would return Result: [2,4]
Here is what I have so far:
% This is my base case.
even_elements([H|T], Result) :- (0 is mod(H,2) -> Result = [H|T] ; Result = T).
% This is my recursion.
even_elements([H|T], [H|NT]) :- even_elements(T, NT).
The base case works properly and eliminates the first element if it is odd; but the recursion doesn't change anything. Any tips on how to complete the recursion is appreciated.
Often the base case in list processing deals with the empty list. Indeed, we can just write:
even_elements([], []).
For the recursive case, we can use quite a lot from your base case, the only thin that we still need to do is recurse on the tail of the list, so:
even_elements([H|T], Result) :-
( 0 is mod(H,2)
-> Result = [H|T2]
; Result = T2
),
even_elements(T, T2).
That being said, there is no need to implement the logic to filter a list. You can make use of the include/3 predicate [swi-doc], and thus define an even predicate:
even(N) :-
0 is N mod 2.
Then we can filter with:
even_elements(L, R) :-
include(even, L, R).
This then gives us:
?- even_elements([1,4,2,5], R).
R = [4, 2].
I also found this solution from this post although Willem's answer is way more readable:
even_elements(L1,L2):-findall(X,(member(X,L1), X mod 2=:=0),L2).

Change list of variables according to another list containing the index and atoms in prolog

I have a list of variables E and a list L and I want a predicate that works like this:
E=[A,B,C,D]
L=[(1,b),(3,m)]
solve(E,L).
E=[b,B,m,D]
Basically solve() should run through the list L and change E by using (a,b) to unify the variable at index a with the atom B. Is there any way to do this?
The meaning of the (badly named) solve/2 predicate is something like "for every pair (Index, Element), the Index-th element of the input list is Element". You are likely using a Prolog implementation that already has a predicate called something like nth1/3 which expresses "the Index-th element of List is Element". For example, in SWI-Prolog:
?- List = [A, B, C, D], nth1(3, List, this_is_the_third_element).
List = [A, B, this_is_the_third_element, D],
C = this_is_the_third_element.
So an alternative implementation of your predicate simply calls nth1/3 for each of your (Index, Element) pairs:
solve(_List, []).
solve(List, [(Index, Elem) | Pairs]) :-
nth1(Index, List, Elem),
solve(List, Pairs).
And with this you're done:
?- E = [A, B, C, D], L = [(1, b), (3, m)], solve(E, L).
E = [b, B, m, D],
A = b,
C = m,
L = [(1, b), (3, m)] ;
false.
Note that this solution is simple, but it has quadratic complexity in the length of the input list: nth1/3 might have to visit the entire N-element list N times. In the unlikely case that you need this predicate for a performance-critical part of some larger program, consider the more optimized solution sketched in the other answer.
Is there any way to do this?
Certainly. And as they say in Perl: "There is more than one way to do it".
Couple of problems:
Do not use (1,b). Use the idiomatic -(1,b) instead, which is written as 1-b (the pair). This gives you a list of pairs: L=[1-b,3-m]. There is a library specifically dealing with such pairs: https://www.swi-prolog.org/pldoc/man?section=pairs - alternatively you can use real maps implemented with AVL trees: https://www.swi-prolog.org/pldoc/man?section=assoc
Now you just need to:
sort the list of pairs, probably using keysort: https://www.swi-prolog.org/pldoc/doc_for?object=sort/2 or https://www.swi-prolog.org/pldoc/doc_for?object=sort/4
Go through the list left to right, keeping the current index, and performing a replacement when the next key in your sorted list is hit, or just retaining the existing term from the list otherwise. The result goes into an accumulator variable as head of a list.
Done! Special handling of out-of-bounds indexes etc. to be suitably handled by throwing or failing.
How to go through the sorted list of pairs (I didn not test this!):
% case of Index hit:
go_through([Index-Value|Rest],Index,InList,OutList) :-
InList = [I|Rest],
OutList = [Value|More],
succ(Index,NextIndex),
go_through(Rest,NextIndex,Rest,More).
% case of Index miss:
go_through([NotYetIndex-Value|Rest],Index,InList,OutList) :-
NotYetIndex > Index, % that should be the case
InList = [I|Rest],
OutList = [I|More],
succ(Index,NextIndex),
go_through(Rest,NextIndex,Rest,More).
go_through([],_,L,L). % DONE
Alternatively, you can write a replace0 that replaces-by-index in a list, and go through the L list.
Addendum: Working code using go_through
Actually contains a few subtlties
another_vectorial_replace1(ListIn,ReplacePairs,ListOut) :-
maplist([_,_]>>true,ListIn,ListOut), % Bonus code: This "makes sure" (i.e. fails if not)
% that ListIn and ListOut are the same length
maplist([(A,B),A-B]>>true,ReplacePairs,RealPairs), % Transform all (1,b) into [1,b]
maplist([K-_]>>integer(K),RealPairs), % Make sure the RealPairs all have integers on first place
keysort(RealPairs,RealPairsSorted), % Sorting by key, which are integers; dups are not removed!
debug(topic,"ListIn: ~q",[ListIn]),
debug(topic,"RealPairsSorted: ~q",[RealPairsSorted]),
go_through(RealPairsSorted,1,ListIn,ListOut),
debug(topic,"ListOut: ~q",[ListOut]).
% Case of Index hit, CurIndex is found in the first "Replacement Pair"
go_through([CurIndex-Value|RestPairs],CurIndex,ListIn,ListOut) :-
!, % Commit to choice
ListIn = [_|Rest],
ListOut = [Value|More],
succ(CurIndex,NextIndex),
go_through(RestPairs,NextIndex,Rest,More).
% Case of Index miss:
go_through([NotYetIndex-V|RestPairs],CurIndex,ListIn,ListOut) :-
NotYetIndex > CurIndex, % that should be the case because of sorting; fail if not
!, % Commit to choice
ListIn = [X|Rest],
ListOut = [X|More],
succ(CurIndex,NextIndex),
go_through([NotYetIndex-V|RestPairs],NextIndex,Rest,More).
% Case of DONE with list traversal
% Only succeed if there are not more pairs left (i.e. no out-of-bound replacements)
go_through([],_CurIndex,L,L).
% ===
% Tests
% ===
:- begin_tests(another_vectorial_replace1).
test(empty) :- another_vectorial_replace1([],[],LO),
LO=[].
test(nop_op) :- another_vectorial_replace1([a,b,c,d],[],LO),
LO=[a,b,c,d].
test(one) :- another_vectorial_replace1([a],[(1,xxx)],LO),
LO=[xxx].
test(two) :- another_vectorial_replace1([a,b,c,d],[(4,y),(2,x)],LO),
LO=[a,x,c,y].
test(full) :- another_vectorial_replace1([a,b,c,d],[(1,e),(2,f),(3,g),(4,h)],LO),
LO=[e,f,g,h].
test(duplicate_replacement,[fail]) :- another_vectorial_replace1([a],[(1,x),(1,y)],_).
test(out_of_bounds_high,[fail]) :- another_vectorial_replace1([a],[(2,y)],_).
test(out_of_bounds_low,[fail]) :- another_vectorial_replace1([a],[(0,y)],_).
:- end_tests(another_vectorial_replace1).
rt :- debug(topic),run_tests(another_vectorial_replace1).
Addendum 2
Replacement using maplist/N, foldl/N and library(assoc)
Recursive calls disappear behind the curtain!
https://github.com/dtonhofer/prolog_notes/blob/master/code/vector_replace0.pl
(the following assumes that the indices in the pairs list will be sorted, in increasing order, as the example in the question indicates.)
What you said can be written as one conjunction
E=[A,B,C,D], L=[(1,a),(3,c)], solve(E,L), E=[a,B,c,D].
which you intend to be holding under the proper definition of solve/2 that you seek to find. But isn't it like saying
E=[A|E2], L=[(1,a)|L2],
E2=[B,C,D], L2=[(3,c)],
solve(E2,L2), E2=[B,c,D],
E=[a|E2].
? Although, something doesn't quite fit right, here. c in E2 appears in second position, not 3rd as indicated by its entry in L2.
But naturally, L2 must be indexed from 2, since it is a tail of L which is indexed from 1. So we must make this explicit:
E=[A,B,C,D], L=[(1,a),(3,c)], solve(E,L), E=[a,B,c,D]
==
E=[A,B,C,D], L=[(1,a),(3,c)], solve(E,1,L), E=[a,B,c,D] % starting index 1
==
E=[A|E2], L=[(1,a)|L2],
E2=[B,C,D], L2=[(3,c)],
solve(E2,2,L2), E2=[B,c,D], E=[a|E2]
must, and now can, hold. But where did a get from, in E? What we actually mean here is
E=[A|E2], L=[(1,a)|L2],
p( (1,a), 1, a), % index match
E2=[B,C,D], L2=[(3,c)],
solve(E2,2,L2), E2=[B,c,D], % starting index 2
E=[a|E2]
with p/3 defined as
p( (I,A), I, A).
And so it must also hold that
E2=[B|E3], L2=[(3,c)],
\+ p( (3,c), 2, c), % index mismatch
E3=[C,D], L3=L2,
solve(E3,3,L3), E3=[c,D], E2=[B|E3]
L2 is not traversed along at this step (L3=L2), since p( (3,c), 2, c) does not hold.
Do you see how the recursive definition of solve/3 reveals itself here? Could you finish it up?

Removing Duplicates while maintaining order in Prolog

I am trying to create a predicate that removes duplicates from a list while maintaining its relative order. For example a list that is [1,2,2,3,4,5,5,2] should return [1,2,3,4,5]. However, my code is only able to remove consecutive duplicates and for instance, not the 2 at the end.
remove_duplicates([],[]).
remove_duplicates([H],[H]).
remove_duplicates([H,H|T],[H|List]) :- remove_duplicates(T,List).
remove_duplicates([H,X|T],[H|T1]):- X\=H, remove_duplicates([X|T],T1).
Another approach I was thinking of was to use member to see if the Tail contains the Head. However, the only way I can think of solving it that way is where I would remove the head, if head is a member of tail. This would however keep the last instance of the number only and break the relative order of the numbers in the list.
For instance:
[1,2,2,3,4,5,5,2]
[1,3,4,5,2]
When I actually want
[1,2,3,4,5]
You can make use of an accumulator: an extra parameter, here a list that is initially empty and when new elements arise will grow. Each recursive call the list is passed (or an updated copy).
For example:
remove_duplicates(LA, LB) :-
remove_duplicates(LA, LB, []).
remove_duplicates([], [], _).
remove_duplicates([H|T], R, Seen) :-
( member(H, Seen)
-> (R = S, Seen1 = Seen)
; (R = [H|S], Seen1 = [H|Seen])
),
remove_duplicates(T, S, Seen1).
This then gives us:
?- remove_duplicates([1,2,2,3,4,5,5,2], L).
L = [1, 2, 3, 4, 5].
Of course you can make use of more effective datastructures than a list. I leave that as an exercise.

List - counting atoms related to their previous term

I want to count the number of elements in a list which have a relation with the element following.
The predicate I have works by using an accumulator variable which it increments if the predicate related returns true.
The following example code is to check the number of times an element is greater than it's previous element.
So for example
count_list([1,2,3,2,1,3,2],Count).
should return 3.
The code almost works. It increments the accumulator variable correctly. However, the function returns false, when it tries to compare the final 2 at the end with the non-existent next term.
listofitems([],N,N).
%count number of items which are related to the previous
listofitems([A,B|T],Acc,N) :-
write(A),write(' '), write(B),
( related(A,B) -> Acc1 is Acc+1 ; Acc1 = Acc ),
write(Acc1),write('\n'),
listofitems([B|T],Acc1,N).
count_list(L,N):-
listofitems(L,0,N).
%define the relationship to be counted
related(A,B):-
B>A.
Does anyone have any suggestions as to how to create an elegant terminating condition so I can return the accumulated value?
Does anyone have any suggestions as to how to create an elegant terminating condition so I can return the accumulated value?
The problem you have is that your query fails. Try first to minimize the query as much as possible. Certainly, you expect it to work for:
?- listofitems([], Count).
Count = 0.
Yet, it already fails for:
?- listofitems([1], Count).
false.
So let's try to dig into the reason for that.
And since your program is pure (apart from those writes), it is possible to diagnose this a little better by considering a generalization of your program. I prefer to look at such generalizations as I do not want to read too much (eye strain and such):
:- op(950, fy, *).
*_.
listofitems([], N,N).
listofitems([A,B|T], Acc,N) :-
* ( related(A,B) -> Acc1 is Acc+1 ; Acc1 = Acc ),
* listofitems([B|T], Acc1,N).
count_list(L,N):-
listofitems(L,0,N).
?- count_list([1], Count).
false.
Even this generalization fails! So now in desperation I try to ask the most general query. It's like when I ask one thing after the other and get a noe after a no. Good this is Prolog, for we can ask: "Say me just everything you know".
?- count_list(Es,Count).
Es = [], Count = 0
; Es = [_,_|_].
So it is only the case for the empty list and lists with at least two elements. But there is no answer for one-elemented lists! You will thus have to generalize the program somehow.
A natural way would be to add a fact
listofitems([_], N, N).
As a minor remark, this isn't called a "terminating condition" but rather a "base case".
And if you really want to trace your code, I recommend these techniques instead of adding manual writes. They are much too prone to error.
If the all list items are integers and your Prolog system supports clpfd, you can proceed like this:
:- use_module(library(clpfd)).
:- use_module(library(lists), [last/3]).
:- use_module(library(maplist), [maplist/4]).
To relate adjacent items, look at two sublists of [E|Es], Es and Fs. If, say,
[E|Es] = [1,2,3,2,1,3,2] holds ...
... then Fs lacks the last item (Fs = [1,2,3,2,1,3,2]) ...
... and Es lacks the first item (Es = [1,2,3,2,1,3,2]).
maplist/4 and i0_i1_gt01/3 map corresponding list items in Fs and Es to 0 / 1:
i_j_gt01(I, J, B) :- % if I #< J then B #= 1
I #< J #<=> B. % if I #>= J then B #= 0
?- maplist(i_j_gt01, [1,2,3,2,1,3], [2,3,2,1,3,2], Bs).
Bs = [1,1,0,0,1,0].
Last, sum up [1,1,0,0,1,0] using sum/3:
?- sum([1,1,0,0,1,0], #=, N).
N = 3.
Let's put it all together!
count_adj_gt([E|Es], N) :-
last(Fs, _, [E|Es]), % or: `append(Fs, [_], [E|Es])`
% or: `list_butlast([E|Es], Fs)`
maplist(i_j_gt01, Es, Fs, Bs),
sum(Bs, #=, N).
Sample query using SICStus Prolog 4.3.2:
?- count_adj_gt([1,2,3,2,1,3,2], N).
N = 3. % succeeds deterministically
not sure about
an elegant terminating condition
my whole code would be
?- Vs=[1,2,3,2,1,3,2], aggregate_all(count, (append(_,[X,Y|_], Vs), X<Y), Count).
That's all...
If you need something more complex, remember that library(clpfd) has more to offer.

How do I remove supersets in a list of lists?

Let's say I have the following list:
List = [[a],[a,b],[a,c],[b,c],[b,d],[a,b,c],[a,b,d],[b,c,e],[b,d,e,f]]
The goal is to remove every list in the list that is a superset of a list in the list.
The list that contains the lists always has the following properties:
The lists in the list are sorted by length
Each list in the list is sorted
My initial idea was to simply start with the first list in the list and go through all other lists and remove the lists that are a superset. Next I'd look at the second list, et cetera.
After removing all supersets of the list [a] it should look like this:
List = [[a],[b,c],[b,d],[b,c,e],[b,d,e,f]]
Next the supersets of [b,c] should be removed:
List = [[a],[b,c],[b,d],[b,d,e,f]]
Last is the supersets of [b,d]:
List = [[a],[b,c],[b,d]]
And the line above should be the result.
I already made a predicate akin to the member predicate, but instead of taking a single element and comparing it to the list, this takes an entire list and compares it to the list:
memberList([],_).
memberList([X|Xs],Y) :-
member(X,Y),
memberList(Xs,Y).
This only works with lists.
?- memberList(a,[a,b,c]).
false.
?- memberList([a],[a,b,c]).
true .
?- memberList([a,b],[a,b,c]).
true .
But after this I'm a bit lost.
I tried the following which should remove the supersets of a single set, but it did not work:
removeSupersetsList(_,[],[]).
removeSupersetsList(X,[Y|Ys],[Y|Out]) :-
not(memberList(X,Y)),
removeSupersetsList(X,Ys,Out).
removeSupersetsList(X,[Y|Ys],Out) :-
memberList(X,Y),
removeSupersetsList(X,Ys,Out).
So I was wondering if someone could point me in the right direction to remove all supersets from a list or maybe even give the right predicate.
I'm using SWI-Prolog, where I find a crafted libray for ordered sets, and the required test, then using select/3 it's really easy to sanitize the list
rem_super_sets([], []).
rem_super_sets([L|Ls], R) :-
( select(T, Ls, L1), % get any T in Ls
ord_subset(L, T) % is T a superset of L ?
-> rem_super_sets([L|L1], R) % discard T, keep L for further tests
; R = [L|L2],
rem_super_sets(Ls, L2)
).
here a verification and the result
test :-
List = [[a],[a,b],[a,c],[b,c],[b,d],[a,b,c],[a,b,d],[b,c,e],[b,d,e,f]],
rem_super_sets(List, R),
write(R).
?- test.
[[a],[b,c],[b,d]]
true.
memberList([],_).
memberList([X|Xs],Y) :- member(X,Y),
memberList(Xs,Y).
%remove(ToRemove,ListWithSublists,LocRez,FinalRez)
%A list from ListWithSublists is removed,depending on ToRemove
% LocRez is accumulator used to obtain the FinalRez ( at the end )
remove(_,[],LocRez,LocRez) :- !.
remove(ToRemove,ListWithSublists,LocRez,FinalRez) :- ListWithSublists=[Sublist|Rest],
memberList(ToRemove,Sublist),
remove(ToRemove,Rest,LocRez,FinalRez),!.
remove(ToRemove,ListWithSublists,LocRez,FinalRez) :- ListWithSublists=[Sublist|Rest],
not(memberList(ToRemove,Sublist)),
append(LocRez,[Sublist],LocRezNew),
remove(ToRemove,Rest,LocRezNew,FinalRez),!.
> removeSupersetsList(List,Rez) :- removeSupersetsList(List,[],Rez). % call this for testing
%removeSupersetsList(List,LocRez,Final)
%remove the Head from List from the List itself if needed(obtain Rez in the process)
%append the Head into our LocRez(get LocRezNew),
%call this recursively for the Rez
removeSupersetsList(List,LocRez,LocRez) :- List=[] ,!.
removeSupersetsList(List,LocRez,Final) :- ( List=[ToRemove|_] ; List=[ToRemove] ),
remove(ToRemove,List,[],Rez),
append(LocRez,[ToRemove],LocRezNew),
removeSupersetsList(Rez,LocRezNew,Final),!.