Related
I want to use the results from "extract" (W) in valid_seq which is then use in valid_columns.
I have tried this so far, but it does not work:
extract(_,[],[]).
extract(K,[X|Y],[H|L]) :- nth1(K,X,H), extract(K,Y,L).
valid_columns([],[]).
valid_columns([H|L],[X|Y],K) :- b_w(X),
extract(K,X,W),
valid_seq(H,W),
K1 is K+1,
valid_columns(L,Y,K1).
EDIT:
I am trying to solve a nonogram.
So from each list of lines, I have to extract the columns to validate them. This is the function "extract"
Once the columns are extracted I need to validate them.
Ex
valid_column([[1,1,1,1,1],[1,0,0,0,0],[1,1,1,1,1],[0,0,0,0,1],[1,1,1,1,1]],[3,1],1).
false.
Here I am asking if the first value in each [] complies to [3,1].
In this case should be true. As I have [1 1 1 0 1].
And this is my code:
test_cst(0,[0|S],S).
test_cst(0,[],[]).
test_cst(N,[1|T],S):-
N1 is N-1,
test_cst(N1,T,S).
valid_seq([],[]).
valid_seq(L,[0|T]):-valid_seq(L,T).
valid_seq([H|L],[1|T]):-test_cst(H,[1|T],S),valid_seq(L,S).
b_w([]).
b_w([H|L]) :- H is 0, b_w(L);H is 1, b_w(L).
valid_lines([],[]).
valid_lines([H|L],[X|Y]) :- b_w(X),
valid_seq(H,X),
valid_lines(L,Y).
extract(_,[],[]).
extract(K,[X|Y],[H|L]) :- nth1(K,X,H), extract(K,Y,L).
valid_columns([],_,_).
valid_columns([H|L],X,K) :- valid_column(X,H,K),
K1 is K+1,
valid_columns(L,X,K1).
valid_column(X,H,K) :- b_w(X),
extract(K,X,W),
valid_seq(H,W).
If available, you can put library(apply) to good use:
?- maplist(nth1(I), [[a,b,c],[1,2,3],[x,y,z]], X).
I = 1,
X = [a, 1, x] ;
...
I'm suggesting its usage since it simplifies the code, removing irrelevant details, that blurry your relations.
For your question, you're passing to b_w/1 a list of lists, while it should be a list. If you have library(yall) available, b_w/1 can be rewritten like
b_w(L) :- maplist([X]>>(X=0;X=1), L).
I'm trying to figure out a way to check if two lists are equal regardless of their order of elements.
My first attempt was:
areq([],[]).
areq([],[_|_]).
areq([H1|T1], L):- member(H1, L), areq(T1, L).
However, this only checks if all elements of the list on the left exist in the list on the right; meaning areq([1,2,3],[1,2,3,4]) => true. At this point, I need to find a way to be able to test thing in a bi-directional sense. My second attempt was the following:
areq([],[]).
areq([],[_|_]).
areq([H1|T1], L):- member(H1, L), areq(T1, L), append([H1], T1, U), areq(U, L).
Where I would try to rebuild the lest on the left and swap lists in the end; but this failed miserably.
My sense of recursion is extremely poor and simply don't know how to improve it, especially with Prolog. Any hints or suggestions would be appreciated at this point.
As a starting point, let's take the second implementation of equal_elements/2 by #CapelliC:
equal_elements([], []).
equal_elements([X|Xs], Ys) :-
select(X, Ys, Zs),
equal_elements(Xs, Zs).
Above implementation leaves useless choicepoints for queries like this one:
?- equal_elements([1,2,3],[3,2,1]).
true ; % succeeds, but leaves choicepoint
false.
What could we do? We could fix the efficiency issue by using
selectchk/3 instead of
select/3, but by doing so we would lose logical-purity! Can we do better?
We can!
Introducing selectd/3, a logically pure predicate that combines the determinism of selectchk/3 and the purity of select/3. selectd/3 is based on
if_/3 and (=)/3:
selectd(E,[A|As],Bs1) :-
if_(A = E, As = Bs1,
(Bs1 = [A|Bs], selectd(E,As,Bs))).
selectd/3 can be used a drop-in replacement for select/3, so putting it to use is easy!
equal_elementsB([], []).
equal_elementsB([X|Xs], Ys) :-
selectd(X, Ys, Zs),
equal_elementsB(Xs, Zs).
Let's see it in action!
?- equal_elementsB([1,2,3],[3,2,1]).
true. % succeeds deterministically
?- equal_elementsB([1,2,3],[A,B,C]), C=3,B=2,A=1.
A = 1, B = 2, C = 3 ; % still logically pure
false.
Edit 2015-05-14
The OP wasn't specific if the predicate
should enforce that items occur on both sides with
the same multiplicities.
equal_elementsB/2 does it like that, as shown by these two queries:
?- equal_elementsB([1,2,3,2,3],[3,3,2,1,2]).
true.
?- equal_elementsB([1,2,3,2,3],[3,3,2,1,2,3]).
false.
If we wanted the second query to succeed, we could relax the definition in a logically pure way by using meta-predicate
tfilter/3 and
reified inequality dif/3:
equal_elementsC([],[]).
equal_elementsC([X|Xs],Ys2) :-
selectd(X,Ys2,Ys1),
tfilter(dif(X),Ys1,Ys0),
tfilter(dif(X),Xs ,Xs0),
equal_elementsC(Xs0,Ys0).
Let's run two queries like the ones above, this time using equal_elementsC/2:
?- equal_elementsC([1,2,3,2,3],[3,3,2,1,2]).
true.
?- equal_elementsC([1,2,3,2,3],[3,3,2,1,2,3]).
true.
Edit 2015-05-17
As it is, equal_elementsB/2 does not universally terminate in cases like the following:
?- equal_elementsB([],Xs), false. % terminates universally
false.
?- equal_elementsB([_],Xs), false. % gives a single answer, but ...
%%% wait forever % ... does not terminate universally
If we flip the first and second argument, however, we get termination!
?- equal_elementsB(Xs,[]), false. % terminates universally
false.
?- equal_elementsB(Xs,[_]), false. % terminates universally
false.
Inspired by an answer given by #AmiTavory, we can improve the implementation of equal_elementsB/2 by "sharpening" the solution set like so:
equal_elementsBB(Xs,Ys) :-
same_length(Xs,Ys),
equal_elementsB(Xs,Ys).
To check if non-termination is gone, we put queries using both predicates head to head:
?- equal_elementsB([_],Xs), false.
%%% wait forever % does not terminate universally
?- equal_elementsBB([_],Xs), false.
false. % terminates universally
Note that the same "trick" does not work with equal_elementsC/2,
because of the size of solution set is infinite (for all but the most trivial instances of interest).
A simple solution using the sort/2 ISO standard built-in predicate, assuming that neither list contains duplicated elements:
equal_elements(List1, List2) :-
sort(List1, Sorted1),
sort(List2, Sorted2),
Sorted1 == Sorted2.
Some sample queries:
| ?- equal_elements([1,2,3],[1,2,3,4]).
no
| ?- equal_elements([1,2,3],[3,1,2]).
yes
| ?- equal_elements([a(X),a(Y),a(Z)],[a(1),a(2),a(3)]).
no
| ?- equal_elements([a(X),a(Y),a(Z)],[a(Z),a(X),a(Y)]).
yes
In Prolog you often can do exactly what you say
areq([],_).
areq([H1|T1], L):- member(H1, L), areq(T1, L).
bi_areq(L1, L2) :- areq(L1, L2), areq(L2, L1).
Rename if necessary.
a compact form:
member_(Ys, X) :- member(X, Ys).
equal_elements(Xs, Xs) :- maplist(member_(Ys), Xs).
but, using member/2 seems inefficient, and leave space to ambiguity about duplicates (on both sides). Instead, I would use select/3
?- [user].
equal_elements([], []).
equal_elements([X|Xs], Ys) :-
select(X, Ys, Zs),
equal_elements(Xs, Zs).
^D here
1 ?- equal_elements(X, [1,2,3]).
X = [1, 2, 3] ;
X = [1, 3, 2] ;
X = [2, 1, 3] ;
X = [2, 3, 1] ;
X = [3, 1, 2] ;
X = [3, 2, 1] ;
false.
2 ?- equal_elements([1,2,3,3], [1,2,3]).
false.
or, better,
equal_elements(Xs, Ys) :- permutation(Xs, Ys).
The other answers are all elegant (way above my own Prolog level), but it struck me that the question stated
efficient for the regular uses.
The accepted answer is O(max(|A| log(|A|), |B|log(|B|)), irrespective of whether the lists are equal (up to permutation) or not.
At the very least, it would pay to check the lengths before bothering to sort, which would decrease the runtime to something linear in the lengths of the lists in the case where they are not of equal length.
Expanding this, it is not difficult to modify the solution so that its runtime is effectively linear in the general case where the lists are not equal (up to permutation), using random digests.
Suppose we define
digest(L, D) :- digest(L, 1, D).
digest([], D, D) :- !.
digest([H|T], Acc, D) :-
term_hash(H, TH),
NewAcc is mod(Acc * TH, 1610612741),
digest(T, NewAcc, D).
This is the Prolog version of the mathematical function Prod_i h(a_i) | p, where h is the hash, and p is a prime. It effectively maps each list to a random (in the hashing sense) value in the range 0, ...., p - 1 (in the above, p is the large prime 1610612741).
We can now check if two lists have the same digest:
same_digests(A, B) :-
digest(A, DA),
digest(B, DB),
DA =:= DB.
If two lists have different digests, they cannot be equal. If two lists have the same digest, then there is a tiny chance that they are unequal, but this still needs to be checked. For this case I shamelessly stole Paulo Moura's excellent answer.
The final code is this:
equal_elements(A, B) :-
same_digests(A, B),
sort(A, SortedA),
sort(B, SortedB),
SortedA == SortedB.
same_digests(A, B) :-
digest(A, DA),
digest(B, DB),
DA =:= DB.
digest(L, D) :- digest(L, 1, D).
digest([], D, D) :- !.
digest([H|T], Acc, D) :-
term_hash(H, TH),
NewAcc is mod(Acc * TH, 1610612741),
digest(T, NewAcc, D).
One possibility, inspired on qsort:
split(_,[],[],[],[]) :- !.
split(X,[H|Q],S,E,G) :-
compare(R,X,H),
split(R,X,[H|Q],S,E,G).
split(<,X,[H|Q],[H|S],E,G) :-
split(X,Q,S,E,G).
split(=,X,[X|Q],S,[X|E],G) :-
split(X,Q,S,E,G).
split(>,X,[H|Q],S,E,[H|G]) :-
split(X,Q,S,E,G).
cmp([],[]).
cmp([H|Q],L2) :-
split(H,Q,S1,E1,G1),
split(H,L2,S2,[H|E1],G2),
cmp(S1,S2),
cmp(G1,G2).
A simple solution using cut.
areq(A,A):-!.
areq([A|B],[C|D]):-areq(A,C,D,E),areq(B,E).
areq(A,A,B,B):-!.
areq(A,B,[C|D],[B|E]):-areq(A,C,D,E).
Some sample queries:
?- areq([],[]).
true.
?- areq([1],[]).
false.
?- areq([],[1]).
false.
?- areq([1,2,3],[3,2,1]).
true.
?- areq([1,1,2,2],[2,1,2,1]).
true.
i'm having problems with this subject in Prolog.
The thing is that I want to count the number of repeated elements appearing in a list,
and I also want to fill, in another list with 1, for each appearance of duplicated elements and a 0 if is not duplicated, e.g.
I have a list like this: [420,325,420,582,135,430,582], and the result should be [1,0,1,1,0,0,1].
I've tried some code snippets and it's driving me nuts.
The last code i've tried is:
count_duplicates([],[]).
count_duplicates([Head|Tail],[1|LS]):-
member(Head,Tail),
count_duplicates([Tail|Head],LS).
count_duplicates([Head|Tail],[0|LS]):-
\+ member(Head,Tail),
count_duplicates([Tail|Head],LS).
this predicate receive a list and have to generate the result list
Thanks in advance
You can try this :
count_duplicate(In, Out) :-
maplist(test(In), In, Out).
test(Src, Elem, 1) :-
select(Elem, Src, Result),
member(Elem, Result).
test(_Src, _Elem, 0).
EDIT Without maplist, you can do
count_duplicate(In, Out) :-
test(In, In, Out).
test(_, [], []).
test(In, [Elem | T], [R0 | R]) :-
select(Elem, In, Rest),
( member(Elem, Rest) -> R0 = 1; R0 = 0),
test(In, T, R).
I would rewrite using some of list processing builtins available:
count_duplicates(L, R) :-
maplist(check(L), L, R).
check(L, E, C) :-
aggregate(count, member(E, L), Occurs),
( Occurs > 1 -> C = 1 ; C = 0 ).
with that
?- count_duplicates([420,325,420,582,135,430,582],L).
L = [1, 0, 1, 1, 0, 0, 1].
About your code, I think it's simple to get termination:
count_duplicates([],[]).
count_duplicates([Head|Tail],[1|LS]):-
member(Head,Tail),
count_duplicates(Tail,LS).
count_duplicates([Head|Tail],[0|LS]):-
\+ member(Head,Tail),
count_duplicates(Tail,LS).
Note I corrected the recursive calls, and consider that could be done in a slightly more efficient way (both source and runtime) using the if .. then .. else .. construct.
count_duplicates([],[]).
count_duplicates([Head|Tail],[R|LS]):-
( member(Head,Tail) -> R = 1 ; R = 0 ),
count_duplicates(Tail,LS).
it's cleaner, isn't it? member/2 it's called just once, that's a big gain,
and consider using memberchk/2 instead of member/2.
But that code fails to tag as multiple the last occurrence.
I am trying to calculate the Fibonacci series using the following function:
fib(0,A,_,A).
fib(N,A,B,F) :-
N1 is N-1, Sum is A+B, fib(N1, B, Sum, F).
fib(N, F) :- fib(N, 0, 1, F).
This is intended to works like this:
| ?- fib(20,Result).
Result = 6765 ?
But when I try this, it complains:
| ?- fib(What,6765).
uncaught exception: error(instantiation_error,(is)/2)
Does anyone understand why this is happening?
In the second clause:
fib(N,A,B,F) :-
N1 is N-1, Sum is A+B, fib(N1, B, Sum, F).
N is a variable to be decremented, and in your call to:
fib(What, 6765).
The variable is not yet defined, so you get the instantiation error on N1 is N - 1.
In swipl I do even get the error:
?- fib(W, 6765).
ERROR: fib/4: Arguments are not sufficiently instantiated
Now that you know it's an error, do you mind to know if it's actually possible to answer your query?
How do you would approach the problem? Your function it's ok, isn't it? Exactly, because it's a function, and not a relation, you get the error.
It's a bit complicate to solve it, but CLP can do !
See this fascinating example from CLP(FD) documentation (cited here)
:- use_module(library(clpfd)).
n_factorial(0, 1).
n_factorial(N, F) :-
N #> 0, N1 #= N - 1, F #= N * F1,
n_factorial(N1, F1).
We need something like this, but for fibonacci.
See how easy it is:
:- [library(clpfd)].
fib(0,A,_,A).
fib(N,A,B,F) :-
N #> 0,
N1 #= N-1,
Sum #= A+B,
fib(N1, B, Sum, F).
fib(N, F) :- fib(N, 0, 1, F).
i.e. replace is/2 by #=/2 and we get
?- fib(20,Result).
Result = 6765 .
?- fib(X,6765).
X = 20 ;
^C
note, after the first response the program loops!
Do you a see a way to correct it? Or another question could be worth...
A more clear and more natural predicate definition may be:
//The two base steps
fib1(0,0).
fib1(1,1).
//the recursive step
fib1(N,F) :-
N >= 0, M is N-2, O is N-1, fib1(M,A), fib1(O,B), F is A+B.
It is also a definition with only one predicate: fib/2
Me and a friend are writing a program which is supposed to solve a CLP problem. We want to use minimize to optimize the solution but it won't work, because it keeps saying that the number we get from sum(P,#=,S) is between two numbers (for example 5..7). We haven't been able to find a good way to extract any number from this or manipulate it in any way and are therefore looking for your help.
The problem seems to arise from our gen_var method which says that each element of a list must be between 0 and 1, so some numbers come out as "0..1" instead of being set properly.
Is there any way to use minimize even though we get a number like "5..7" or any way to manipulate that number so that we only get 5? S (the sum of the elements in a list) is what we're trying to minimize.
gen_var(0, []).
gen_var(N, [X|Xs]) :-
N > 0,
M is N-1,
gen_var(M, Xs),
domain([X],0,1).
find([],_).
find([H|T],P):- match(H,P),find(T,P).
match(pri(_,L),P):-member(X,L), nth1(X,P,1).
main(N,L,P,S) :- gen_var(N,P), minimize(findsum(L,P,S),S).
findsum(L,P,S):- find(L,P), sum(P,#=,S).
I've slightly modified your code, to adapt to SWI-Prolog CLP(FD), and it seems to work (kind of). But I think the minimum it's always 0!
:- use_module(library(clpfd)).
gen_var(0, []).
gen_var(N, [X|Xs]) :-
N > 0,
M is N-1,
gen_var(M, Xs),
X in 0..1 .
find([], _).
find([H|T], P):-
match(H, P),
find(T, P).
match(pri(_,L),P):-
member(X, L),
nth1(X, P, 1).
findsum(L,P,S) :-
find(L, P),
sum(P, #=, S).
main(N, L, P, S) :-
gen_var(N, P),
findsum(L, P, S),
labeling([min(S)], P).
Is this output sample a correct subset of the expected outcome?
?- main(3,A,B,C).
A = [],
B = [0, 0, 0],
C = 0 ;
A = [],
B = [0, 0, 1],
C = 1 ;