I wrote Prolog code for my assignment to drop the nth element of the give list.
I made a predicate called remove/3 which removes an element from the list by its number, and another predicate called drop2/4 which calls the remove/3 predicate by only the numbers who are divisible by N.
But there is a small logical error as it only removes 1 element from the list which is the last element which is divisible by N. I guess this is because when I call the remove/3 predicate with the list L and X it adds all the elements to X then remove element number N, however, L remains the same, so when I call remove/3 again with another N, it doesn't continue on the previous edit, so the previous element which was deleted is restored, so that's why only the last element is deleted.
Query example:
drop([a,b,c,d,e,f,g,h,i,k], 3, X).
Result should be: X = [a,b,d,e,g,h,k]
drop(L, N, X):-
drop2(L, N, X, N).
drop2(_, _, _, 1).
drop2(L, N, X, C):-
N mod C =:= 0,
remove(L, N, X),
Z is C-1,
drop2(L, N, X, Z).
drop2(L, N, X, C):-
Z is C-1,
drop2(L, N, X, Z).
remove([_|T], 1, T).
remove([H|T1], N, [H|T2]):-
N > 1,
Z is N - 1,
remove(T1, Z, T2).
That seems complicated to me. You could just say
drop(Xs,N,Rs) :-
integer(N) ,
N > 0 ,
drop(Xs,1,N,Rs)
.
where your helper predicate drop/4 is
drop( [] , _ , _ , [] ) .
drop( [X|Xs] , P , N , Rs ) :-
( 0 =:= P mod N -> R1 = Rs ; [X|R1] = Rs ) ,
P1 is P+1 ,
drop(Xs,P1,N,R1)
.
or the equivalent
drop( [] , _ , _ , [] ) .
drop( [X|Xs] , P , N , [X|Rs] ) :- 0 =\= P mod N , P1 is P+1 , drop(Xs,P1,N,Rs) .
drop( [_|Xs] , P , N , Rs ) :- 0 =:= P mod N , P1 is P+1 , drop(Xs,P1,N,Rs) .
or even
drop( [] , _ , _ , [] ) .
drop( [_|Xs] , P , P , Rs ) :- P1 is 1 , drop(Xs,P1,N,Rs) .
drop( [X|Xs] , P , N , [X|Rs] ) :- P < N , P1 is P+1 , drop(Xs,P1,N,Rs) .
No need for writing recursive code... simply use append/3, length/2, and same_length/2!
list_nth1_dropped(As,N1,Bs) :-
same_length(As,[_|Bs]),
append(Prefix,[_|Suffix],As),
length([_|Prefix],N1),
append(Prefix,Suffix,Bs).
Here's the query the OP gave:
?- Xs = [a,b,c,d,e,f,g,h,i,k],
list_nth1_dropped(Xs,3,Ys).
Xs = [a,b,c,d,e,f,g,h,i,k],
Ys = [a,b, d,e,f,g,h,i,k]
; false.
How about a more general query?
?- list_nth1_dropped([a,b,c,d,e,f],N,Xs).
N = 1, Xs = [ b,c,d,e,f]
; N = 2, Xs = [a, c,d,e,f]
; N = 3, Xs = [a,b, d,e,f]
; N = 4, Xs = [a,b,c, e,f]
; N = 5, Xs = [a,b,c,d, f]
; N = 6, Xs = [a,b,c,d,e ]
; false.
Related
i'm trying to do a program that counts the sequence of binary numbers, let me give an example
the input is [0,0,0,1,1,0,0,0,1,1,1,1]
The output should be [0(the first number),3(number of 0 in sequence),2 (number of 1 in sequence),3,4]
the input size is infinite and it needs to be a list, so far what I have done is this:
list([H|T],[X|Y]):-
T = [], X is H, Y is 1.
list([H|T],[X|Y]):-
T \= [], X is H,X1 is 1, contlist([H|T],[X1,Y]).
contlist([H|T],[X,_]):-
T \= [],
H =:= [T|_},
T1 i
contlist([H|T],[X,_]):-
X1 is X+1.
I don't know how to compare the head with the head of the tail and how to continue from there, maybe someone can help me?
This is a special case of Run-length encoding suitable for binary sequences.
You begin noting the first bit and start counting either 1s or 0s, when the bit flips you "output" the number and start counting the other bit value. Every time the sequence flips bits you output the number and start counting again until the whole sequence is processed. Note this procedure is not reversible. To make it reversible you would probably want to use clp(FD).
rle_binary([B|Seq], [B|BRLE]):-
binary(B),
rle_binary(Seq, B, 1, BRLE).
rle_binary([], _, N, [N]).
rle_binary([B|Seq], B, N, BRLE):-
succ(N, N1),
rle_binary(Seq, B, N1, BRLE).
rle_binary([B1|Seq], B, N, [N|BRLE1]):-
binary(B1),
B \= B1,
rle_binary(Seq, B1, 1, BRLE1).
binary(0).
binary(1).
Sample run:
?- rle_binary( [0,0,0,1,1,0,0,0,1,1,1,1], BRLE).
BRLE = [0, 3, 2, 3, 4] ;
false.
What you're talking about is Run-Length Encoding.
It's easy to implement. Executing the below code as
?- run_length_encoding( [a,b,b,c,c,c] , Rs ) .
Yields
Rs = [ a:1, b:2, c:3 ]
[The code doesn't care what the list contains (outside of perhaps unbound variables)]
You can fiddle with it at: https://swish.swi-prolog.org/p/PrtWEfZx.pl
run_length_encoding( Xs, Ys ) :- nonvar(Xs), ! , rle_encode(Xs,Ys) .
run_length_encoding( Xs, Ys ) :- nonvar(Ys), rle_decode(Ys,Xs) .
rle_encode( [] , [] ) .
rle_encode( [X|Xs] , Rs ) :- rle_encode(Xs,X:1,Rs) .
rle_encode( [X|Xs] , Y:N , [Y:N|Rs] ) :- X \= Y , ! , rle_encode(Xs,X:1,Rs) .
rle_encode( [X|Xs] , X:N , Rs ) :- M is N+1 , ! , rle_encode(Xs,X:M,Rs) .
rle_encode( [] , X:N , [X:N] ) .
rle_decode( [] , [] ) .
rle_decode( [X:N|Xs] , [X|Ys] ) :- N > 0, !, M is N-1, rle_decode([X:M|Xs],Ys) .
rle_decode( [_:0|Xs] , Ys ) :- rle_decode(Xs,Ys) .
Using SWI-Prolog predicates clumped/2 and pairs_values/2:
rle([X|Xs], [X|V]) :-
clumped([X|Xs], P),
pairs_values(P, V).
Example:
?- rle([0,0,0,1,1,0,0,0,1,1,1,1], L).
L = [0, 3, 2, 3, 4].
I want to write a code in prolog that gets a list and find its positive numbers and adds them into a new list as below :
?- findPositives([-1,2,3,-5,-7,9],Result)
Result : [2,3,9]
How can I write this code?
Using tfilter/3:
positive_truth(N, true) :-
N >= 0.
positive_truth(N, false) :-
N < 0.
?- tfilter(positive_truth, [-1,2,3,-5,-7,9],Result).
Result = [2,3,9].
Alternatively, using library(clpfd):
pos_truth(Expr, Truth) :-
Expr #>= 0 #<==> Bool,
bool01_truth(Bool, Truth).
bool01_truth(0,false).
bool01_truth(1,true).
?- tfilter(pos_truth, [-1,2,3,-5,-7,9],Result).
Result = [2,3,9].
?- tfilter(pos_truth, [X,Y],Result).
Result = [], X in inf.. -1, Y in inf.. -1
; Result = [Y], X in inf.. -1, Y in 0..sup
; Result = [X], X in 0..sup, Y in inf.. -1
; Result = [X, Y], X in 0..sup, Y in 0..sup.
this would be the simple way:
find_positives( Ns , Ps ) :- findall( X , ( member(X,Ns) , X > 0 ) , Ps ) .
But I suspect that your instructor would like you to figure out a recursive solution on your own. Ergo...
find_positives( [] , [] ) .
find_positives( [N|Ns] , [P|Ps] ) :- N > 0 , find_positives(Ns,Ps) .
find_positives( [N|Ns] , Ps ) :- N =< 0 , find_positives(Ns,Ps) .
Note that you could save a comparison by introducing a deterministic cut, thus:
find_positives( [] , [] ) .
find_positives( [N|Ns] , [P|Ps] ) :- N > 0 , ! , find_positives(Ns,Ps) .
find_positives( [_|Ns] , Ps ) :- find_positives(Ns,Ps) .
And make it a little more succinct by collapsing the 2nd and 3rd clauses by a 'soft cut'/conjunction (->/2):
find_positives( [] , [] ) .
find_positives( [N|Ns] , R ) :-
( N > 0 -> R = [P|Ps]; R = Ps ) ,
find_positives(Ns,Ps) .
Whether that improves comprehension or not is left up to you.
Write a recursive Prolog predicate of three arguments, called common, which returns the number of elements that belong to both lists.
For example:
?- common ( [a, b, c, k, h], [b,c,d,e], N).
N=2.
?- common ( [b, a, c, d], [a, b, c, d, e] , N).
N=4.
Preserve logical-purity!
:- use_module(library(clpfd)).
First, we define meta-predicate tcountd/3 in order to discount duplicate list items. tcount/3 is similar to tcount/3, but uses tfilter/3 and dif/3 for excluding duplicates:
:- meta_predicate tcountd(2,?,?).
tcountd(P_2,List,Count) :-
list_tcountd_pred(List,Count,P_2).
:- meta_predicate list_tcountd_pred(?,?,2).
list_tcountd_pred([] ,0, _ ).
list_tcountd_pred([X|Xs0],N,P_2) :-
if_(call(P_2,X), (N #= N0+1, N0 #>= 0), N = N0),
tfilter(dif(X),Xs0,Xs),
list_tcountd_pred(Xs,N0,P_2).
We define common/3 based upon meta-predicate tcountd/3, Prolog lambdas, and memberd_t/3:
common(Xs,Ys,N) :-
tcountd(Ys+\X^memberd_t(X,Ys),Xs,N).
Let's run the sample queries the OP gave:
?- common([a,b,c,k,h],[b,c,d,e],N).
N = 2.
?- common([b,a,c,d],[a,b,c,d,e],N).
N = 4.
As common/3 is monotone, we get sound answers with non-ground queries, too! Consider:
?- common([A,B],[X,Y],N).
N = 1, A=B , B=X
; N = 2, A=X , B=Y , dif(X,Y)
; N = 1, A=X , dif(B,X), dif(B,Y)
; N = 1, A=B , B=Y , dif(X,Y)
; N = 2, A=Y , B=X , dif(X,Y)
; N = 1, A=Y , dif(B,X), dif(B,Y), dif(X,Y)
; N = 0, A=B , dif(B,X), dif(B,Y)
; N = 1, dif(A,X), dif(A,Y), B=X
; N = 1, dif(A,X), dif(A,Y), B=Y , dif(X,Y)
; N = 0, dif(A,B), dif(A,X), dif(A,Y), dif(B,X), dif(B,Y).
Trivially to do using intersection/3 built-in:
common(A, B, N) :-
intersection(A, B, C),
length(C, N).
Test run:
?- common([a, b, c, k, h], [b,c,d,e], N).
N = 2.
?- common([b, a, c, d], [a, b, c, d, e], N).
N = 4.
Notice that there is no space between "common" and "(" in the queries. This is important. Queries as you stated in the question (with space between "common" and "(") will give syntax error.
This is one way, assuming you want to ensure that the result is a set (unique items) rather than a bag (allows duplicate items) :
set_intersection( Xs, Ys, Zs ) :- % to compute the set intersection,
sort(Xs,X1) , % - sort the 1st set, removing duplicates (so that it's a *set* rather than a *bag* ) ,
sort(Ys,Y1) , % - sort the 2nd set, removing duplicates (so that it's a *set* rather than a *bag* ) ,
common( Xs , Ys , Zs ) % - merge the two now-ordered sets, keeping only the common items
.
common( Xs , Ys , [] ) :-
( Xs=[] ; Ys=[] ) ,
! .
common( [X|Xs] , [X|Ys] , [X|Zs] ) :-
common( Xs , Ys , Zs ) .
Another, simpler way:
set_intersection( Xs , Ys , Zs ) :-
set_of(Z,(member(Z,Xs),member(Z,Ys)),Zs)
.
Another way:
set_intersection( Xs , Ys , Zs ) :- % compute the set intersection by
set_intersectin( Xs , Ys , [] , Zs ) . % invoking the worker predicate
set_intersection( [] , _ , Zs , Zs ) . % when we run out of Xs, we're done.
set_intersection( [X|Xs] , Ys , Ts , Zs ) :- % otherwise,
member(X,Ys) , % if X is a member of Ys,
\+ member(X,Ts) , % and we don't yet have an X,
set_intersection( Xs , Ys , [X|Ts] , Zs ) % add X to the accumulator and recurse down
. %
I am working with Prolog sample list programs and triying to do some operations on them. However, I am stuck at a point and couldn't find any solution or sample.
I want to write a function which takes two lists of integers and return a float value. The two lists size are equal. The float value is the result of comparison divided by list size.
The function should compare every elemen of first list to every elemen of the second list. A pair (i, j) is that i is the location of element in first list and j is the location of the element in second list. If element i greater than element j, result of comparison is incremented by 1. If element i less than element j, result of comparison decremented by 1. If equal, nothing happen. At the end of the above operation, we return the float value described above.
Example:
retVal([4,5,3], [8,2,1], Result).
should return Result = (-1+1+1-1+1+1-1+1+1) / 3 = 0.33
In object oriented language, it is as simple as printing something on the console. However, I don't have any idea in Prolog. Thank you in advance.
What you describe by words could be this snippet
retVal(L1,L2, Result) :-
findall(S, (member(X1,L1), member(X2,L2), (X1 < X2 -> S = -1 ; S = 1)), L),
sum_list(L, Sum),
length(L1, Len),
Result is Sum / Len.
Alas, the test outcome doesn't match your expectation
?- retVal([4,5,3], [8,2,1], X).
X = 1.
As liori noted in his comment, your manual calculation is incorrect...
I think this should work:
sgn(X, Y, -1) :- X<Y.
sgn(X, Y, 1) :- X>Y.
sgn(X, X, 0).
ssapd(L, R, O) :- ssapd(L, R, R, 0, 0, O).
ssapd([LI | LR], RL, [RPI | RPL], ACC, ACCL, O) :-
sgn(LI, RPI, SGN), !,
ACC1 is ACC + SGN,
ssapd([LI | LR], RL, RPL, ACC1, ACCL, O).
ssapd([_ | LR], RL, [], ACC, ACCL, O) :-
ACCL1 is ACCL + 1,
ssapd(LR, RL, RL, ACC, ACCL1, O).
ssapd([], _, _, ACC, ACCL, Result) :-
Result is ACC / ACCL.
It's a nice implementation with tail recursion done by using two accumulators, O(n²) time complexity and constant memory (except for the size of input). To execute it, try:
ssapd([4,5,3], [8,2,1], Result).
This is a tail-recursive approach:
compare_list( Xs , Ys , Z ) :-
compare_list( Xs, Ys, 0 , 0 , S , L ) ,
Z is float(S)/float(L)
.
compare_list( [] , [] , S , L , S , L ) .
compare_list( [X|Xs] , [Y|Ys] , A , B , S , L ) :-
A1 is A + sign(X-V) ,
B1 is B + 1 ,
compare_list(Xs,Ys,A1,B1,S,L)
.
Another approach, this time "head recursive":
compare_list( Xs , Ys , Z ) :-
compare_list( Xs , Ys , S , L ) ,
Z is float(S)/float(L)
.
compare_list( [] , [] , 0 , 0 ) .
compare_list( [X|Xs] , [Y|Ys] , S , L ) :-
compare_list(Xs,Ys,S1,L1) ,
S is S1 + sign(X-Y) ,
L is L1 + 1
.
The former implementation won't overflow the stack on long lists as it gets optimized away into [effectively] iteration, but requires accumulators; the latter implementation doesn't require accumulators, but will blow the stack if the list(s) are of sufficient length.
I just started in Prolog and have the problem:
(a) Given a list L, an object X, and a positive integer K, it returns
the position of the K-th occurrence of X in L if X appears at least K
times in L otherwise 0.
The goal pos([a,b,c,b],b,2,Z) should succeed with the answer Z = 4.
So far I have:
pos1([],H,K,F).
pos1([H],H,1,F).
pos1([H|T],H,K,F):- NewK is K - 1, pos1(T,H,NewK,F), F is F + 1.
pos1([H|T],X,K,F):- pos1(T,X,K,F).
But I can't figure out why I'm getting:
ERROR: is/2: Arguments are not sufficiently instantiated
Any help would be much appreciated!
Use clpfd!
:- use_module(library(clpfd)).
We define pos/4 based on (#>)/2, (#=)/2, if_/3, dif/3, and (#<)/3:
pos(Xs,E,K,P) :-
K #> 0,
pos_aux(Xs,E,K,1,P).
pos_aux([X|Xs],E,K,P0,P) :-
P0+1 #= P1,
if_(dif(X,E),
pos_aux(Xs,E,K,P1,P),
if_(K #< 2,
P0 = P,
(K0+1 #= K,
pos_aux(Xs,E,K0,P1,P)))).
Sample query as given by the OP:
?- X = b, N = 2, pos([a,b,c,b],X,N,P).
X = b, N = 2, P = 4. % succeeds deterministically
How about the following more general query?
?- pos([a,b,c,b],X,N,P).
X = a, N = 1, P = 1
; X = b, N = 1, P = 2
; X = b, N = 2, P = 4 % (exactly like in above query)
; X = c, N = 1, P = 3
; false.
Let's take a high-level approach to it, trading the efficiency of the resulting code for the ease of development:
pos(L,X,K,P):-
numerate(L,X,LN,1), %// [A1,A2,A3...] -> [A1-1,A2-2,A3-3...], where Ai = X.
( drop1(K,LN,[X-P|_]) -> true ; P=0 ).
Now we just implement the two new predicates. drop1(K,L,L2) drops K-1 elements from L, so we're left with L2:
drop1(K,L2,L2):- K<2, !.
drop1(K,[_|T],L2):- K1 is K-1, drop1(K1,T,L2).
numerate(L,X,LN,I) adds an I-based index to each element of L, but keeps only Xs:
numerate([],_,[],_).
numerate([A|B],X,R,I):- I1 is I+1, ( A=X -> R=[A-I|C] ; R=C ), numerate(B,X,C,I1).
Testing:
5 ?- numerate([1,b,2,b],b,R,1).
R = [b-2, b-4].
6 ?- pos([1,b,2,b],b,2,P).
P = 4.
7 ?- pos([1,b,2,b],b,3,P).
P = 0.
I've corrected your code, without changing the logic, that seems already simple enough.
Just added a 'top level' handler, passing to actual worker pos1/4 and testing if worked, else returning 0 - a debatable way in Prolog, imo is better to allow to fail, I hope you will appreciate how adopting this (see comments) simplified your code...
pos(L,X,K,F):- pos1(L,X,K,F) -> true ; F=0.
% pos1([],H,K,F). useless: let it fail
% pos1([H],H,1,F). useless: already handled immediatly bottom
pos1([H|T],H,K,P):- K==1 -> P=1 ; NewK is K - 1, pos1(T,H,NewK,F), P is F + 1.
pos1([_|T],X,K,P):- pos1(T,X,K,F),P is F+1.
I hope you're allowed to use the if/then/else construct. Anyway, yields
7 ?- pos([a,b,c,b],b,2,Z).
Z = 4.
8 ?- pos([a,b,c,b],b,3,Z).
Z = 0.
Something like this. An outer predicate (this one enforces the specified constraints) that invokes an inner worker predicate:
kth( L , X , K , P ) :-
is_list( L ) , % constraint: L must be a list
nonvar(X) , % constriant: X must be an object
integer(K) , K > 0 % constraint: K must be a positive integer
kth( Ls , X , K , 1 , P ) % invoke the worker predicate with its accumulator seeded to 1
. % easy!
is_list/2 ensures you've got a list:
is_list(X) :- var(X) , !, fail .
is_list([]).
is_list([_|_]).
The predicate that does all the work is this one:
kth( [] , _ , _ , _ , 0 ) . % if we hit the end of the list, P is 0.
kth( [X|Ls] , X , K , K , K ) :- ! . % if we find the Kth desired element, succeed (and cut: we won't find another Kth element)
kth( [_|Ls] , X , K , N , P ) :- % otherwise
N < K , % - if we haven't got to K yet ...
N1 is N+1 , % - increment our accumulator , and
kth(Ls,X,K,N1,P) % - recurse down.
. % easy!
Though the notion of returning 0 instead of failure is Not the Prolog Way, if you ask me.