Prolog How to write a predicate sum 3 max values in list? - prolog

How to write a predicate sum 3 max values in list?
max3(L,X)
Example:
max3([1,7,9,3,5],X).
X = 21.

As a starting point:
% Can potentially change order of the list in Rest
list_max_rest([H|T], Max, Rest) :-
list_max_rest_(T, H, Max, Rest).
list_max_rest_([], Max, Max, []).
list_max_rest_([H|T], P, Max, [P|Rest]) :-
H #> P,
!,
list_max_rest_(T, H, Max, Rest).
list_max_rest_([H|T], P, Max, [H|Rest]) :-
list_max_rest_(T, P, Max, Rest).
Usage:
?- list_max_rest([2,1,200,9], Max, Res).
Max = 200,
Res = [1, 2, 9].
Use that 3 times...

max3(Ls, X) :-
select(A, Ls, Ls2),
select(B, Ls2, Ls3),
select(C, Ls3, Ls4),
A >= B,
B >= C,
\+ (member(Q, Ls4), Q > C),
X is A+B+C.
Take A from the list, B from the remainder, C from that remainder, they must be A>=B>=C, and there must not be a member Q left in the remainder which is bigger than C. Add those up.
This is not efficient; brebs' suggestion of:
max3(Ls, X) :-
sort(0, #>=, Ls, [A,B,C|_]),
X is A+B+C.
is neater

Related

Swap function in prolog, infinite loop

I am trying to create a swap function in prolog but I ended up with an infinite loop, I tried to debug it using trace()
An example of this function is swap(4, 3, ["You", "Are", "Awesome", "thank", "You"], SwappedList)
With the output being
["You", "Are", "thank", "Awesome", "You"]
In the trace output, it is showing that the problem is in the delete as it is failing and redoes the split
/* Getting the nth element of the list*/
n_thelement(1, [Head|_], Head).
n_thelement(N, [_|Tail], Item):-
NewN is N-1,
n_thelement(NewN, Tail, Item).
/* Deleting the element of the desired Nth element*/
delete(X, [X|Tail], Tail).
delete(X, [Head|Tail], [Head|Item]):-
delete(X, Tail, Item).
/* Adding the deleted element to the beginning of the list*/
append([], Element, Element).
append([Head], Element, [Head|Element]).
swap(X, X, List, List).
swap(X, Y, List, NList):-
n_thelement(X, List, Num1),
n_thelement(Y, List, Num2),
split(X, List, B1, A1),
delete(Num1, A1, L1),
append([Num2], L1, NList1),
append(B1, NList1, NList2),
split(Y, NList2, B2, A2),
delete(Num2, A2, L2),
append([Num1], L2, NList3),
append(B2, NList3, NList).
split(1, [Head|Tail], Head, Tail).
split(N, [Old_List|New_List], Old_List, New_List):-
NewN is N -1,
split(NewN, _, Old_List, New_List).
If I understand your problem statement correctly, given to indices into a list, M and N such that M < N and M and N are both valid indices into the list, you want to swap the elements at those indices.
I would first make the indices zero-relative instead of 1-relative as that makes the math a little easier.
So, you want to break up the list into 5 pieces, 3 of which are themselves lists of any length and two of which are the list entries to be swapped:
As: The lead-in prefix of the list. It is of length M.
B: The 1st item to be swapped.
Cs: The middle segment of the list. It is of length N - (M+1).
D: The 2nd item to be swapped.
Es: The suffix/remainder of the list. It is of any length.
append/3 is useful for deconstruction and reconstruction of lists, making the actual swap easy. You have 3 cases.
First, the special case of both indices being the same, in which case, there is no work to do:
swap( M, M, Ls, Ls ).
Second, the case of the indices being out of order, in which case we just recursively swap them to put them in order:
swap( M, N, Ls, Rs ) :- M > N, swap(N,M,Ls,Rs).
Third, the general case:
swap( M, N, Ls, Rs ) :- % if the 2 indices differ
M < N, % - and are in order
M >= 0, % - and M is greater than or equal to zero
N >= 0, % - and N is greater than or equal to zero
X is N - (M+1), % - compute the length of the middle segment
length( As, M ), % - construct an empty, unbound list of length M, the length of the prefix
length( Cs, X ), % - and construct an empty, unbound list of that length
append( As, [B|T1], Ls), % - get the prefix (As) and the first item (B) to be swapped
append( Cs, [D|Es], T1), % - get the middle segment (Cs), the second item (D) to be swapped, and the suffix (Es)
append( As, [D|Cs], T2), % - concatenate As, D, and Cs, then...
append( T2, [B|Es], Rs ) % - concatenate that with B and the suffix
. % Easy!
You can define a predicate to replace the i-th item of the list for another:
replace(Index, [Old|Rest], [New|Rest], Old, New) :- Index == 0, !.
replace(Index, [First|Rest], [First|NewRest], Old, New) :-
Index > 0,
Previous is Index - 1,
replace(Previous, Rest, NewRest, Old, New).
Examples:
?- replace(1, [a,b,c,d,e], List1, Old1, x).
List1 = [a, x, c, d, e],
Old1 = b.
?- replace(1, [a,b,c,d,e], List1, Old1, New1).
List1 = [a, New1, c, d, e],
Old1 = b.
?- replace(4, [a,b,c,d,e], List2, Old2, New2).
List2 = [a, b, c, d, New2],
Old2 = e.
Then, using this predicate, you can define:
swap(I, J, OldList, NewList) :-
replace(I, OldList, List, X, Y),
replace(J, List, NewList, Y, X).
Examples:
?- swap(3, 2, ["You", "Are", "Awesome", "thank", "You"], L).
L = ["You", "Are", "thank", "Awesome", "You"].
?- swap(1, 4, [a,b,c,d,e], L).
L = [a, e, c, d, b].
?- swap(0, 3, [a,b,c,d,e], L).
L = [d, b, c, a, e].
?- swap(1, 0, [a,b,c,d,e], L).
L = [b, a, c, d, e].
?- swap(2, 2, [a,b,c,d,e], L).
L = [a, b, c, d, e].
?- swap(3, 9, [a,b,c,d,e], L).
false.

Build a new list of elements which appears more than 3 times in old list in Prolog

My main task - build a new list of elements (numbers) that appear in the old list more than three times.
Asking query: res([1,2,2,3,3,3,4,4,4,4,5,5,5,5,5],X).
Expected result: X = [4, 5]
I have a code that counts the number of occurrences of each number:
count(_, [], 0).
count(Num, [H|T], X) :- dif(Num,H), count(Num, T, X).
count(Num, [H|T], X) :- Num = H, count(Num, T, X1), X is X1 + 1.
res(A, X) :- findall(X,count(_,A,X),X).
But it works little bit wrong - it gives X = [0, 5, 4, 3, 2, 1] instead X = [1, 2, 3, 4, 5].
I ignored this problem for while and tried this to finish main task:
count(_, [], 0).
count(Num, [H|T], X) :- dif(Num,H), count(Num, T, X).
count(Num, [H|T], X) :- Num = H, count(Num, T, X1), X is X1 + 1, X<3, X is Num.
res(A, X) :- findall(X,count(_,A,X),X).
But gives strange result: X = [0, 1]
Where i'm wrong? Thank you.
Reusing your first count predicate,
%countElement(Element, List, Nb_Element_in_List)
countElement(_, [], 0).
countElement(Num, [H|T], X) :- dif(Num,H), countElement(Num, T, X).
countElement(Num, [H|T], X) :- Num = H, countElement(Num, T, X1), X is X1 + 1.
Here is the predicate query/1
query(X) :-
L = [1,2,2,3,3,3,4,4,4,4,5,5,5,5,5],
countOneByOne(L, L, [], X).
%countOneByOne(A1,A2,In,Out)
%For each Element of A1, if it satisfies countElement(Element,A2,N) & N>4, is accumulated with In, to give Out
%Out is the list of Elements of A1 that satisfies countElement(Element,A2,N) & N>4, added to In
countOneByOne([], _, X, X).
countOneByOne([H|Xs], L, X1, X2) :-
countElement(H, L, N), N<4, !,
countOneByOne(Xs, L, X1, X2).
countOneByOne([H|Xs], L, X1, X2) :-
removeElement(Xs, H, Ss),
countOneByOne(Ss, L, [H|X1], X2).
%remove(List, Element, List_Without_Element)
removeElement( [], _, []).
removeElement([X|Xs], H, [X|R1]) :-
dif(X,H), removeElement(Xs, H, R1).
removeElement([X|Xs], X, R1) :-
removeElement(Xs, X, R1).
Not an answer but another approach using foldl/4 and the dict of SWI-Prolog.
Whenever I hear "scan through a list to perform a computation with a final result at the end", the appropriate approach is probably the "accumulator idiom". One hands a data structure (the "accumulator") between the calls where something happens with a list element, "accumulating" the result. foldl/N is meant to provide boilerplate code around this.
In this case the accumulator is the SWI_prolog dict accumulating "occurrence counts", which happens at each call to inc_for_key/3. At the end, we just need to select the entries with a high enough occurence count:
filter_occurrences(List,Limit,Reacheds,Finals) :-
foldl(inc_for_key,List,_{},Finals),
findall(Key,(Finals.Key >= Limit),Reacheds).
inc_for_key(Key,DictIn,DictOut) :-
(get_dict(Key,DictIn,X) -> succ(X,XP) ; XP=1),
put_dict(Key,DictIn,XP,DictOut).
Testing using plunit
:- begin_tests(filter_occurrences_less_than_n).
test("filter empty list",true(R == [])) :-
filter_occurrences([],3,R,_).
test("filter nonempty list #1 (limit 3)",true([R,Finals] == [[a,c],foo{a:4,b:2,c:3,d:1,e:1,f:1}])) :-
filter_occurrences([a,b,c,d,c,e,b,a,a,f,a,c],3,R,Finals),
dict_pairs(Finals,foo,_). % Sets the tag of the Finals dict to "foo"
test("filter nonempty list #2 (limit 4)",true([R,Finals] == [[a],foo{a:4,b:2,c:3,d:1,e:1,f:1}])) :-
filter_occurrences([a,b,c,d,c,e,b,a,a,f,a,c],4,R,Finals),
dict_pairs(Finals,foo,_). % Sets the tag of the Finals dict to "foo"
test("filter nonempty list #3 (limit 5)",true([R,Finals] == [[],foo{a:4,b:2,c:3,d:1,e:1,f:1}])) :-
filter_occurrences([a,b,c,d,c,e,b,a,a,f,a,c],5,R,Finals),
dict_pairs(Finals,foo,_). % Sets the tag of the Finals dict to "foo"
:- end_tests(filter_occurrences_less_than_n).
And so:
?- run_tests.
% PL-Unit: filter_occurrences_less_than_n .... done
% All 4 tests passed
true.

implementation of copy in prolog

Given a list of regs regs (1,2,3, ...) what I want the code to do is to copy the position X to X + 1, I put some examples below. I have the following code in prolog:
exe(EA, copy(X), ES):-
EA =.. [reg|TH],
LL1 is X+1,
length(TH,LL),
LL2 is LL+X+1,
length(L1,LL1),
length(L2,LL2),
append(L1,LI1,TH),[EX|L2]=LT1,
flatten(reg[L1,EX,L2], LR),
ES=.. LR.
what i want to show me as a result is:
?- exe(reg(1,2,3,4), copy(2), ES).
result:
?- ES=reg(1,2,2,4)
?- exe(reg(4,6,2,9), copy(1), ES).
result:
?-ES=reg(4,4,2,9).
?- exe(reg(1,2), copy(2), ES).
result:
false
I think the code is wrong
Try to split up your goal into multiple aspects, like: getting the element at position X (nth_element), then try to implement a predicate overwriting a particular value. Below is code that works as you expect. It basically traverses lists in the Prolog-"standard" way.
% Get the nth element of a list, indices starting at 1
nth_element([X|_], 1, X) :- !.
nth_element([_|Xs], N, R) :-
M is N - 1,
nth_element(Xs, M, R).
% Overwrites the N-th position in a list by a new element
% Indices starting with 1
% overwrite(List, N, Element, New_List) :-
% overwrite([], _, _, []) :- !.
overwrite([_|Xs], 1, Y, [Y|Xs]) :- !.
overwrite([X|Xs], N, Y, [X|Ys]) :-
M is N - 1,
overwrite(Xs, M, Y, Ys).
exe(EA, copy(X), Es):-
EA =.. [reg|TH],
nth_element(TH, X, Element),
Y is X + 1,
overwrite(TH, Y, Element, New),
Es =.. [reg|New].

Getting the product of a list from left to right

How do you get the product of a list from left to right?
For example:
?- product([1,2,3,4], P).
P = [1, 2, 6, 24] .
I think one way is to overload the functor and use 3 arguments:
product([H|T], Lst) :- product(T, H, Lst).
I'm not sure where to go from here.
You can use library(lambda) found here : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
Quite unreadable :
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
product(L, R) :-
foldl(\X^Y^Z^(Y = []
-> Z = [X, [X]]
; Y = [M, Lst],
T #= X * M,
append(Lst, [T], Lst1),
Z = [T, Lst1]),
L, [], [_, R]).
Thanks to #Mike_Hartl for his advice, the code is much simple :
product([], []).
product([H | T], R) :-
scanl(\X^Y^Z^( Z #= X * Y), T, H, R).
seems like a list copy, just multiplying by last element handled. Let's start from 1 for the leftmost element:
product(L, P) :-
product(L, 1, P).
product([X|Xs], A, [Y|Ys]) :-
Y is X * A,
product(Xs, Y, Ys).
product([], _, []).
if we use library(clpfd):
:- [library(clpfd)].
product([X|Xs], A, [Y|Ys]) :-
Y #= X * A,
product(Xs, Y, Ys).
product([], _, []).
it works (only for integers) 'backward'
?- product(L, [1,2,6,24]).
L = [1, 2, 3, 4].
Probably very dirty solution (I am new to Prolog):
product([ListHead|ListTail], Answer) :-
product_acc(ListTail, [ListHead], Answer).
product_acc([ListHead|ListTail], [AccHead|AccTail], Answer) :-
Product is ListHead * AccHead,
append([Product, AccHead], AccTail, TempList),
product_acc(ListTail, TempList, Answer).
product_acc([], ReversedList, Answer) :-
reverse(ReversedList, Answer).
So basically at the beginning we call another predicate which has
extra "variable" Acc which is accumulator list.
So we take out head (first number) from original list and put it in
to Accumulator list.
Then we always take head (first number) from original list and
multiply it with head (first number) from accumulator list.
Then we have to append our new number which we got by multiplying
with the head from accumulator and later with the tail
Then we call same predicate again until original list becomes empty
and at the end obviously we need to reverse it.
And it seems to work
?- product([1,2,3,4], L).
L = [1, 2, 6, 24].
?- product([5], L).
L = [5].
?- product([5,4,3], L).
L = [5, 20, 60].
Sorry if my explanation is not very clear. Feel free to comment.

Adding integers in list

For some reason, this is not working. I am getting:
ERROR: is/2: Arguments are not sufficiently instantiated
1 add_list([]).
2 add_list([H|T]):-
3 Sum2 is Sum1 + H,
4 add_list(T).
I am trying to add the contents of a list (containing only numbers).
I'm not sure what you are trying to do. But if you are trying to calc total sum it will be this way (changed name to list_sum as add_list doesn't make any sense):
list_sum([], 0).
list_sum([H|T], Sum):-
list_sum(T, SubSum),
Sum is SubSum + H.
You can have a "functionnal mind" with foldl :
foldl(_P, [], V, V).
foldl(P, [H|T], V1, VF) :-
call(P, H, V1, V2),
foldl(P, T, V2, VF).
sum_list(L, S) :-
foldl(add, L, 0, S).
add(X, Y, Z) :-
Z is X+Y.
Alternatively you could also use an accumulator (the advantage is, that it is tail-recursive and therefore can be optimized)
list_sum(L,R) :- list_sum(L,0,R).
list_sum([],A,A).
list_sum([H|T],A,R) :- A1 is A + H, list_sum(T,A1,R).

Resources