SWIProlog conditional sum inside list and rebuild - list

one of my predicates gives me a list like this as output:
[m(1,2,[v(1,y),v(1,y)]),m(1,6,[v(1,y),v(5,x)]),m(1,4,[v(3,x),v(1,y)]),m(1,8,[v(3,x),v(5,x)])]
When the symbols inside the sublist with v elements are equal (like y here):
[v(1,y),v(1,y)]
or x here:
[v(3,x),v(5,x)]
I have to sum the numbers on the left and rebuild the list like this:
[m(1,2,[v(2,y)]),m(1,6,[v(1,y),v(5,x)]),m(1,4,[v(3,x),v(1,y)]),m(1,8,[v(8,x)])]
I have a similar predicate that works on the main lists but I am not getting this one right.
This is the other predicate that is working:
simplify([], []) :- !.
simplify([X], [X]) :- !.
simplify([m(C, TD, Var), m(C2, TD, Var)| Xs], Ys) :-
sumxp(C, C2, K), simplify([m(K, TD, Var)|Xs], Ys), !.
simplify([X, Y|Xs], [X|Ys]) :- !, simplify([Y|Xs], Ys).
sumxp(Power1, Power2, TotalPower) :- TotalPower is Power1 + Power2.
It acts in this way:
simplify([m(2,2,[v(1,a)]),m(2,2,[v(1,a)])],R).
R = [m(4, 2, [v(1, a)])].

The simplify_01 rule works on each item in the list, e.g. m(1,6,[v(1,y),v(5,x)])
simplify_01(m(A,B,[v(X,Var1),v(Y,Var2)]),m(A,B,[v(X,Var1),v(Y,Var2)])) :-
Var1 \= Var2.
simplify_01(m(A,B,[v(X,Var1),v(Y,Var1)]),m(A,B,[v(Z,Var1)])) :-
Z is X + Y.
and the maplist just applies simplify_01 to all the items in the list.
simplify(L,R) :-
maplist(simplify_01,L,R).
when run using SWI-Prolog
simplify([m(1,2,[v(1,y),v(1,y)]),m(1,6,[v(1,y),v(5,x)]),m(1,4,[v(3,x),v(1,y)]),m(1,8,[v(3,x),v(5,x)])],R).
R = [m(1, 2, [v(2, y)]), m(1, 6, [v(1, y), v(5, x)]), m(1, 4, [v(3, x), v(1, y)]), m(1, 8, [v(8, x)])] ;
false.

Related

DCG and inversion of a list in Prolog

I'm trying to count the numer of inversions in a list. A predicate inversion(+L,-N) unifies N to the number of inversions in that list. A inversion is defined as X > Y and X appears before Y in the list (unless X or Y is 0). For example:
?- inversions([1,2,3,4,0,5,6,7,8],N).
N = 0.
?- inversions([1,2,3,0,4,6,8,5,7],N).
N = 3.
For what I'm using this for, the list will always have exacly 9 elements, and always containing the numbers 0-8 uniquely.
I'm quite new to Prolog and I'm trying to do this as concise and as elegant as possible; It seems like DCG will probably help a lot. I read into the official definition and some tutorial sites, but still don't quit understand what it is. Any help would be greatly appreciated.
Here is another solution that doesn't leave choice points using if_/3:
inversions([],0).
inversions([H|T], N):-
if_( H = 0,
inversions(T,N),
( find_inv(T,H,N1),inversions(T, N2), N #= N1+N2 )
).
find_inv([],_,0).
find_inv([H1|T],H,N1):-
if_( H1=0,
find_inv(T,H,N1),
if_( H#>H1,
(find_inv(T,H,N2),N1 #= N2+1),
find_inv(T,H,N1)
)
).
#>(X, Y, T) :-
( integer(X),
integer(Y)
-> ( X > Y
-> T = true
; T = false
)
; X #> Y,
T = true
; X #=< Y,
T = false
).
I'm not so sure a DCG would be helpful here. Although we're processing a sequence, there's a lot of examination of the entire list at each point when looking at each element.
Here's a CLPFD approach which implements the "naive" algorithm for inversions, so it's transparent and simple, but not as efficient as it could be (it's O(n^2)). There's a more efficient algorithm (O(n log n)) involving a divide and conquer approach, which I show further below.
:- use_module(library(clpfd)).
inversions(L, C) :-
L ins 0..9,
all_distinct(L),
count_inv(L, C).
% Count inversions
count_inv([], 0).
count_inv([X|T], C) :-
count_inv(X, T, C1), % Count inversions for current element
C #= C1 + C2, % Add inversion count for the rest of the list
count_inv(T, C2). % Count inversions for the rest of the list
count_inv(_, [], 0).
count_inv(X, [Y|T], C) :-
( X #> Y, X #> 0, Y #> 0
-> C #= C1 + 1, % Valid inversion, count it
count_inv(X, T, C1)
; count_inv(X, T, C)
).
?- inversions([1,2,3,4,0,5,6,7,8],N).
N = 0 ;
false.
?- inversions([1,2,3,0,4,6,8,5,7],N).
N = 3 ;
false.
?- inversions([0,2,X],1).
X = 1 ;
false.
It does leave a choice point, as you can see, which I haven't sorted out yet.
Here's the O(n log n) solution, which is using the sort/merge algorithm.
inversion([], [], 0).
inversion([X], [X], 0).
inversion([HU1, HU2|U], [HS1, HS2|S], C) :- % Ensure list args have at least 2 elements
split([HU1, HU2|U], L, R),
inversion(L, SL, C1),
inversion(R, SR, C2),
merge(SL, SR, [HS1, HS2|S], C3),
C #= C1 + C2 + C3.
% Split list into left and right halves
split(List, Left, Right) :-
split(List, List, Left, Right).
split(Es, [], [], Es).
split(Es, [_], [], Es).
split([E|Es], [_,_|T], [E|Ls], Right) :-
split(Es, T, Ls, Right).
% merge( LS, RS, M )
merge([], RS, RS, 0).
merge(LS, [], LS, 0).
merge([L|LS], [R|RS], [L|T], C) :-
L #=< R,
merge(LS, [R|RS], T, C).
merge([L|LS], [R|RS], [R|T], C) :-
L #> R, R #> 0 #<==> D, C #= C1+D,
merge([L|LS], RS, T, C1).
You can ignore the second argument, which is the sorted list (just a side effect if all you want is the count of inversions).
Here is another possibility to define the relation. First, #</3 and #\=/3 can be defined like so:
:- use_module(library(clpfd)).
bool_t(1,true).
bool_t(0,false).
#<(X,Y,Truth) :- X #< Y #<==> B, bool_t(B,Truth).
#\=(X,Y,Truth) :- X #\= Y #<==> B, bool_t(B,Truth).
Based on that, if_/3 and (',')/3 a predicate inv_t/3 can be defined, that yields true in the case of an inversion and false otherwise, according to the definition given by the OP:
inv_t(X,Y,T) :-
if_(((Y#<X,Y#\=0),X#\=0),T=true,T=false).
And subsequently the actual relation can be described like so:
list_inversions(L,I) :-
list_inversions_(L,I,0).
list_inversions_([],I,I).
list_inversions_([X|Xs],I,Acc0) :-
list_x_invs_(Xs,X,I0,0),
Acc1 #= Acc0+I0,
list_inversions_(Xs,I,Acc1).
list_x_invs_([],_X,I,I).
list_x_invs_([Y|Ys],X,I,Acc0) :-
if_(inv_t(X,Y),Acc1#=Acc0+1,Acc1#=Acc0),
list_x_invs_(Ys,X,I,Acc1).
Thus the example queries given by the OP succeed deterministically:
?- list_inversions([1,2,3,4,0,5,6,7,8],N).
N = 0.
?- list_inversions([1,2,3,0,4,6,8,5,7],N).
N = 3.
Such application-specific constraints can often be built using reified constraints (constraints whose truth value is reflected into a 0/1 variable). This leads to a relatively natural formulation, where B is 1 iff the condition you want to count is satisfied:
:- lib(ic).
inversions(Xs, N) :-
( fromto(Xs, [X|Ys], Ys, [_]), foreach(NX,NXs) do
( foreach(Y,Ys), param(X), foreach(B,Bs) do
B #= (X#\=0 and Y#\=0 and X#>Y)
),
NX #= sum(Bs) % number of Ys that are smaller than X
),
N #= sum(NXs).
This code is for ECLiPSe.
Using clpfd et automaton/8 we can write
:- use_module(library(clpfd)).
inversions(Vs, N) :-
Vs ins 0..sup,
variables_signature(Vs, Sigs),
automaton(Sigs, _, Sigs,
[source(s),sink(i),sink(s)],
[arc(s,0,s), arc(s,1,s,[C+1]), arc(s,1,i,[C+1]),
arc(i,0,i)],
[C], [0], [N]),
labeling([ff],Vs).
variables_signature([], []).
variables_signature([V|Vs], Sigs) :-
variables_signature_(Vs, V, Sigs1),
variables_signature(Vs, Sigs2),
append(Sigs1, Sigs2, Sigs).
variables_signature_([], _, []).
variables_signature_([0|Vs], Prev, Sigs) :-
variables_signature_(Vs,Prev,Sigs).
variables_signature_([V|Vs], Prev, [S|Sigs]) :-
V #\= 0,
% Prev #=< V #<==> S #= 0,
% modified after **false** remark
Prev #> V #<==> S,
variables_signature_(Vs,Prev,Sigs).
examples :
?- inversions([1,2,3,0,4,6,8,5,7],N).
N = 3 ;
false.
?- inversions([1,2,3,0,4,5,6,7,8],N).
N = 0 ;
false.
?- inversions([0,2,X],1).
X = 1.
in SWI-Prolog, with libraries aggregate and lists:
inversions(L,N) :-
aggregate_all(count, (nth1(P,L,X),nth1(Q,L,Y),X\=0,Y\=0,X>Y,P<Q), N).
both libraries are autoloaded, no need to explicitly include them.
If you want something more general, you can see the example in library(clpfd), under the automaton section, for some useful ideas. But I would try to rewrite your specification in simpler terms, using element/3 instead of nth1/3.
edit
after #false comment, I tried some variation on disequality operators, but none I've tried have been able to solve the problematic query. Then I tried again with the original idea, to put to good use element/3. Here is the result:
:- use_module(library(clpfd)).
inversions(L) :-
L ins 0..8,
element(P,L,X),
element(Q,L,Y),
X #\= 0, Y #\= 0, X #> Y, P #< Q,
label([P,Q]).
inversions(L,N) :-
aggregate(count, inversions(L), N) ; N = 0.
The last line label([P,Q]) it's key to proper reification: now we can determine the X value.
?- inversions([0,2,X],1).
X = 1.

Predicate to unzip a list

List1=[(x,1),(y,1),(z,1)]
I'm attempting to split this list:
into two lists:
List3=[x,y,z]
List4=[1,1,1]
So I have written this predicate to try to do it:
splt([], [], []).
splt([X|Xs], [Y|Ys], [X,Y|Zs]) :-
splt(Xs,Ys,Zs).
However instead of the desired result, the predicate returns:
1 ?- splt([(x,1),(y,2),(z,3)],L3,L4).
L3 = [_G1760, _G1769, _G1778],
L4 = [ (z, 1), _G1760, (y, 2), _G1769, (z, 3), _G1778].
First, the term you have chosen. This: (a, b), is most definitely not how you would usually represent a "tuple" in Prolog. You almost always use a-b for a "pair", and pairs are used throughout the standard libraries.
So your initial list would look like this: [x-1, y-1, z-1].
This should also explain why you are having your problem. You write (a, b), but your predicate says a, b, and you consume two elements when you expect to get one ,(a,b) term. So, to fix your current predicate you would write:
split([], [], []).
split([X|Xs], [Y|Ys], [(X,Y)|XYs]) :-
split(Xs, Ys, XYs).
?- split(Xs, Ys, [(x,1), (y,1), (z,1)]).
Xs = [x, y, z],
Ys = [1, 1, 1].
But instead, using a more conventional name, term order, and Prolog pairs:
zip([], [], []).
zip([X-Y|XYs], [X|Xs], [Y|Ys]) :-
zip(XYs, Xs, Ys).
?- zip([x-1, y-1, z-1], Xs, Ys).
Xs = [x, y, z],
Ys = [1, 1, 1].
And of course, SWI-Prolog at least has a library(pairs), and it comes with a pairs_keys_values/3:
?- pairs_keys_values([x-1, y-1, z-1], Xs, Ys).
Xs = [x, y, z],
Ys = [1, 1, 1].
I find comfortable using library(yall):
?- maplist([(X,Y),X,Y]>>true, [(x,1),(y,2),(z,3)],L3,L4).
L3 = [x, y, z],
L4 = [1, 2, 3].
or, maybe clearer
?- maplist([A,B,C]>>(A=(B,C)), [(x,1),(y,2),(z,3)],L3,L4).
L3 = [x, y, z],
L4 = [1, 2, 3].
You're matching the tuple as a whole, rather than it's component parts.
You should match on [(X1,Y1)|XS], instead of [X|XS] and [Y|Ys].
splt([],[],[]).
splt([(X1,Y1)|Xs],[X1|T1],[Y1|T2]):-
splt(Xs,T1,T2).
Here the first term is used as input, the second and third as output.
Ideone example, using SWI-Prolog, here.

How to check different between two list integers are greater than or equal to 2?

Given two sorted lists Xs and Ys, how do I ensure the absolute difference between any X in Xs and any Y in Ys is at least two?
Sample queries with expected answers:
?- different([1,2,4],[5,6]). % 5-4 < 2
false
?- different([1,4],[2,6]). % 2-1 < 2
false
?- different([1,2,6],[4,8]). % 4-2 >= 2 and 6-4 >= 2 and 8-6 >= 2
true
?- different([],[4]).
true
How can I get to this result? Any ideas? Thank you!
Edit: Here is the code I have now:
difference([], []).
difference([_|_], []).
difference([], [_|_]).
difference(L1, L2) :-
L1 = [X1|X2],
L2 = [Y1|_],
Dif is X1-Y1,
(-1>Dif|Dif>1),
difference(X2, L2).
In this answer we use clpfd to attain both
versatility and optimum (linear) arithmetic complexity.
diff_to_mdist([], _, _).
diff_to_mdist([_|_], [], _).
diff_to_mdist([X|Xs], [Y|Ys], D) :-
( X #=< Y-D, diff_to_mdist(Xs, [Y|Ys], D)
; X #> Y-D, X #>= Y+D, diff_to_mdist([X|Xs], Ys, D)
).
diff_to_mdist([X0,X1|Xs], [Y0,Y1|Ys], D) :-
X0 #> Y0-D, X0 #< Y0+D,
( X0 #< Y0, X0 #=< Y0-D, X1 #>= Y0+D, diff_to_mdist([X0,X1|Xs], [Y1|Ys], D)
; X0 #> Y0, Y0 #=< X0-D, Y1 #>= X0+D, diff_to_mdist([X1|Xs], [Y0,Y1|Ys], D)
).
Let's use gnu-prolog version 1.4.4 and run queries like the ones suggested by the OP!
| ?- diff_to_mdist([1,2,4], [5,6], 2).
no
| ?- diff_to_mdist([1,4], [2,6], 2).
no
| ?- diff_to_mdist([1,2,6], [4,8], 2).
true ? ;
no
| ?- diff_to_mdist([], [4], 2).
yes
First, you can make your current code a lot neater and easier to read as follows:
different([], []).
different([_|_], []).
different([], [_|_]).
different([X|Xs], [Y|Ys]) :-
abs(X-Y) >= 2, % Prolog evaluates arithmetic expressions for compares
different(Xs, [Y|Ys]).
In this case, you've done one level of the recursion I mentioned in my comment, as it only checks each element of the first list against only the first element of the second. It ignores all the other elements of the second list. So you need to break it down further. You could make a helper predicate which compares each element of a list against a single value. Then have your main predicate call this helper predicate with each element of the other list. The main predicate would then look like:
different([], []).
different([], [_|_]).
different([X|Xs], L) :-
different_element(X, L),
different(Xs, L).
Then the helper predicate would be:
% This predicate succeeds if the first argument has the desired difference
% to each of the elements of the second argument (a list)
%
different_element(_, []).
different_element(X, [Y|Ys]) :-
abs(X-Y) >= 2,
different_element(X, Ys).

Insert a list into another list given a position P. Prolog

I need to finish a prolog exercise, I have half of it but I need something more to finish it, that is the reason I am asking for help.
What I need is an small prolog program, given two lists (L1, L2) and one position as P, insert the first list into the second one and store that list in a third list (L3).
insert_at(L1,L2,P,L3)
Here an example:
?- insert_at ([h1,h2], [a1,a2,a3,a4], 2,L3).
L3 = [a1,h1,h2,a2,a3,a4]
The code I have for this is this one:
remove_at(X,[X|Xs],1,Xs).
remove_at(X,[Y|Xs],K,[Y|Ys]) :-
K > 1,
K1 is K - 1,
remove_at(X,Xs,K1,Ys).
insert_at(X,L,K,R) :- remove_at(X,R,K,L).
What I get is this:
?- insert_at([h1,h2],[a1,a2,a3,a4],2,L3).
L3 = [a1, [h1, h2], a2, a3, a4] % What I get
L3 = [a1, h1, h2, a2, a3, a4] % What I really want
I dont know why I get the brackets inside the list...I dont want them as I explained up.
To finish it I also need to take care about more cases:
If P is higher than the second list lenght, L1 will be inserted at the end of L2.
If we insert a non-empty list in an empty list (no matters P), we will get the inserted list.
If we insert an empty list in a non-empty list (no matters P), we will get the non-empty list.
Thanks in advance
The quick-fix solution:
insert_at(X, L, K, R) :-
remove_at(X, R1, K, L),
flatten(R1, R).
The solution involving rewriting remove_at to manage a list:
remove_at([], Y, _, Y) :- !. % added as a list base case
remove_at(_, [], _, []) :- !. % added as a list base case
remove_at([X|T], [X|Xs], 1, L) :- % handle a list [X|T] instead of just X
remove_at(T, Xs, 1, L).
remove_at(X, [Y|Xs], K, [Y|Ys]) :- % same as before :)
K > 1,
K1 is K - 1,
remove_at(X, Xs, K1, Ys).
insert_at(X, L, K, R) :- remove_at(X, R, K, L).
The second remove_at/4 base case says that if the list I want to remove from is empty, then the result is empty and it succeeds. That means insert_at/4 will succeed if K is greater than the length of L and it will return the original list, L, as the solution.
If you want the insert_at/4 to succeed when K is greater than the length of the list and instantiate R with X appended to L (rather than just L itself), you can replace remove_at(_, [], _, []) :- !. with remove_at(X, X, _, []) :- !.

How do I find the longest list in a list of lists?

I have a list of lists, and I need to find the longest one of them. If there are more than one with the same length it's the same which it returns. Thanks.
Here is a general predicate that scans a list to find a single member defined by a given goal.
select_element(Goal, [Head | Tail], Selected) :-
select_element(Goal, Tail, Head, Selected).
select_element(_Goal, [], Selected, Selected).
select_element(Goal, [Head | Tail], Current, FinalSelected) :-
call(Goal, Head, Current, Selected),
select_element(Goal, Tail, Selected, FinalSelected).
Lets say you define a predicate
get_bigger_number(N1, N2, N) :-
N is max(N1, N2).
Now you can execute:
?- select_element(get_bigger_number, [5, 1, -2, 10, 3.2, 0], Selected).
Selected = 10
So all you need to do now is define a predicate get_longer_list(L1, L2, L),
and use it instead of get_bigger_number/3.
Of course, using a general predicate like select_element/3 might not be very efficient. For example, you should try to avoid calculating the length of the same list several times, because this calculation is slow in Prolog (at least if implemented in Prolog in the standard way).
Please consider my aproach.
longest([L], L) :-
!.
longest([H|T], H) :-
length(H, N),
longest(T, X),
length(X, M),
N > M,
!.
longest([H|T], X) :-
longest(T, X),
!.
Then you can consult it:
?- longest([[1]], N).
N = [1] ;
?- longest([[1],[2]], N).
N = [2] .
?- longest([[1],[2], [3,3,3], [2]], N).
N = [3, 3, 3] ;
?- longest([[1],[2], [3,3,3], [2]], N).
N = [3, 3, 3].
?- longest([[1],[2], [3,3,3], [2], [4,4,4,4]], N).
N = [4, 4, 4, 4] .
?- longest([[1],[2], [3,3,3], [2], [4,4,4,4]], N).
N = [4, 4, 4, 4] ;
Greets!
We define longest/2 based on meta-predicate max_of_by/3 used in tandem with length/2:
longest(Xss,Ys) :-
max_of_by(Ys,Xss,length).
Sample queries:
?- longest([[1],[2]],Xs). % we expect multiple solutions
Xs = [1]
; Xs = [2]. % we _get_ multiple solutions
?- longest([[2,1,3],[7,5],[1,8,2,3,1],[2,7,1,4]],Xs).
Xs = [1,8,2,3,1]. % succeeds deterministically
Here is another approach that is efficient and easy to understand. The idea is to find the lengths of all lists in the list, use max_list to get the length of the longest list, and then find a list that is that long. This has the benefit that it will return all lists of the longest length.
lengths([],[]).
lengths([H|T], [LH|LengthsT]) :-
length(H, LH),
lengths(T, LengthsT).
lengthLongest(ListOfLists, Max) :-
lengths(ListOfLists, Lengths),
max_list(Lengths, Max).
longestList(ListOfLists, Longest) :-
lengthLongest(ListOfLists, Len),
member(Longest, ListOfLists),
length(Longest, Len).
% Correct again.
longest(LL,LX) :-
findmax(Len,(append(_,[L|_],LL),length(L,Len)),MaxLen),
append(_,[LX|_],LL),
length(LX,MaxLen).
findmax(V,P,Max) :-
findall(V,P,L),
max(L,Max).
max([N],N) :- !.
max([N|R],Max) :-
max(R,Max2),
max3(N,Max2,Max).
max3(N,Max2,N) :- N > Max2,!.
max3(N,Max2,Max2).
To have the length of longest list:
%sample: longest([[2,1,3],[7,5],[1,8,2,3,1],[2,7,1,4]],L,LEN).
longest([L], L, _) :-
!.
longest([H|T], H, _) :-
length(H, N),
longest(T, X, N),
length(X, M),
N > M,
!.
longest([_|T], X, LEN) :-
length(X, LEN),
longest(T, X, LEN),
!.