I my have code:
locdiff([A|T], [A|_], T).
locdiff([H|T], L2, [H|T2]) :-
locdiff(T, L2, T2).
and when i test it with locdiff([(a,1), (b,2), (b,3), (c,3), (c,4)], [(b,_)], L3), it only finds and removes one of the [(b,_)] which is (b,2). I need it to find and remove both (b,2) and (b,3) or what ever the [(b,_)] contains. can anyone help me with what i have missed?
there is a technical complication that's worth to note if you follow larsman' hint, that I would implement straight in this way
locdiff([], _, []).
locdiff([A|T], [A|_], R) :-
!, locdiff(T, [A|_], R).
locdiff([H|T], L2, [H|T2]) :-
locdiff(T, L2, T2).
with this
?- locdiff([(a,1), (b,2), (b,3), (c,3), (c,4)], [(b,_)], L3).
L3 = [ (a, 1), (b, 3), (c, 3), (c, 4)].
you can see that the first instance is removed, and the last. That's because the first match binds the anonymous variable, and then forbids following matchings, except the last (b,_)
Then a completed procedure would read
locdiff([], _, []).
locdiff([H|T], [A|_], R) :-
\+ \+ H = A, % double negation allows matching without binding
!, locdiff(T, [A|_], R).
locdiff([H|T], L2, [H|T2]) :-
locdiff(T, L2, T2).
now the outcome is what you are requiring.
Alternatively, you need to be more precise in pattern matching, avoiding undue binding
locdiff([], _, []).
locdiff([(A,_)|T], [(A,_)|_], R) :-
!, locdiff(T, [(A,_)|_], R).
locdiff([H|T], L2, [H|T2]) :-
locdiff(T, L2, T2).
?- locdiff([(a,1), (b,2), (b,3), (c,3), (c,4)], [(b,_)], L3).
L3 = [ (a, 1), (c, 3), (c, 4)].
Please note that some library has specific functionality, like exclude/3 in SWI-Prolog, but still you need attention to avoid bindings:
eq([(E,_)|_], (E,_)).
locdiff(L, E, R) :-
exclude(eq(E), L, R).
May be you need something loke that :
locdiff([], _, []).
locdiff([(b,_)|T], [(b,_)], T1) :-
!, locdiff(T, [(b,_)], T1).
locdiff([H|T], L2, [H|T2]) :-
locdiff(T, L2, T2).
But why do you write [A| _] if there is only one element in the list ?
[EDIT] I forgot the ! in the second rule
Related
I have to define a predicate nshift/3 that shift a list N times either way.
Examples:
?- nshift(3,[a,b,c,d,e,f,g,h],Shifted).
Shifted = [d,e,f,g,h,a,b,c]
?-nshift(1,[1,2,3,4,5],Shifted).
Shifted = [2,3,4,5,1]
?-nshift(-2,[a,b,c,d,e,f,g,h],Shifted).
Shifted = [g,h,a,b,c,d,e,f]
I created a code that would take care of the first two examples but I'm having problem with the last example where the N time is -2. Can somebody help me.
My code:
my_shift([], []).
my_shift([H|T], L) :-
append(T, [H], L).
nshift(0, L, L) :- !.
nshift(N, L1, L2) :-
N1 is N-1,
my_shift(L1, L),
nshift(N1, L, L2).
I have this old code
rotate(right, L, [T|H]) :- append(H, [T], L).
rotate(left, [H|T], L) :- append(T, [H], L).
Then, I think you could adapt your nshift/3 testing if the first argument is < 0, something like
nshift(0, L, L) :- !.
nshift(N, L1, L2) :-
N < 0, rotate(right, L1, L), N1 is N+1, nshift(N1, L, L2).
nshift(N, L1, L2) :-
N > 0, rotate(left, L1, L), N1 is N-1, nshift(N1, L, L2).
As hinted in another answer, your type of shift is usually called rotate. Rotates with non-negative N can be written in a nicely declarative way as
naive_rotate(N, Xs, Ys) :-
length(Bs, N),
append(As, Bs, Xs),
append(Bs, As, Ys).
While this works, people will be quick to point out that its termination properties are poor: when you backtrack into rotate/3, i.e. ask for more solutions, it will not terminate. This can be addressed by adding redundant conditions on the list lengths, viz.
rotate(N, Xs, Ys) :-
same_length(Xs, Ys),
leq_length(Bs, Xs),
length(Bs, N),
append(As, Bs, Xs),
append(Bs, As, Ys).
same_length([], []).
same_length([_|Xs], [_|Ys]) :- same_length(Xs, Ys).
leq_length([], _).
leq_length([_|Xs], [_|Ys]) :- leq_length(Xs, Ys).
This now works nicely for various query patterns, e.g.
?- rotate(2, [a,b,c,d,e], Ys). % gives Ys = [d,e,a,b,c]
?- rotate(2, Xs, [a,b,c,d,e]). % gives Xs = [c,d,e,a,b]
?- rotate(N, [a,b,c,d,e], Ys). % 5 solutions
?- rotate(N, Xs, [a,b,c,d,e]). % 5 solutions
?- rotate(N, Xs, Ys). % many solutions
You can then write your original nshift/3 as
nshift(N, Xs, Ys) :-
( N>=0 -> rotate(N, Xs, Ys) ; M is -N, rotate(M, Ys, Xs) ).
I want to write a predicate split(List, Pivot, Result) holds when Result is a list of sublists that List divided by Pivot. For example split([A, B, '#', C, '#', D], '#', [[A, B], [C], [D]]) is true. Note that the elements are lists with logic variables.
I asked a question about how to do this to lists which do not have logic variables as elements. Here's the answer:
split(L,P,R):-split(L,P,[],R).
split([],_,[],[]).
split([],_,S,[S]) :- S \= [].
split([P|T],P,[],R) :- split(T,P,[],R).
split([P|T],P,L,[L|R]) :- L \= [], split(T,P,[],R).
split([H|T],P,S,R) :- H \= P, append(S, [H], S2), split(T,P,S2,R).
However this does not work with the lists which have logic variables as elements. Any suggestions to solve this problem? Thank you!
You were very nearly there.
Consider this slightly modified version:
split(L, P, R) :- split(L, P, [], R).
split([], _P, [], []) :- !.
split([], _P, Acc, [Acc]).
split([X|Xs], P, Acc, Result) :-
X \== P, !,
append(Acc, [X], NewAcc),
split(Xs, P, NewAcc, Result).
split([_X|Xs], P, [], Result) :- !, split(Xs, P, [], Result).
split([_X|Xs], P, Acc, [Acc|Result]) :- split(Xs, P, [], Result).
This implementation relies on the accumulator as you'd tried, but simply shunts the accumulator into the result list as soon as the list item doesn't match the pivot using \==/2.
This is my code
removevowels(L1, L2) :-
removevowels(L1, L2, []).
removevowels([], [], _).
removevowels([X|L1], [X|L2], Aux) :-
consonant(X),
not(member(X, Aux)),
removevowels(L1, L2, [X|Aux]).
removevowels([X|L1], L2, Aux) :-
not(consonant(X)),
removevowels(L1, L2, Aux).
If i run this:
?- removevowels([a,m,m,n], X).
It should print
X = [m, n]
but it's giving false and if i run this
?- removevowels([a,m,n], X).
X = [m,n]
It's alright when it doesn't have repeated elements.
Auxiliar predicates used:
member(X, [X|_]).
member(X, [_|Tail]) :-
member(X, Tail).
consonant(b)
consonant(c), etcetc ....
What's wrong in my code?
The best is to replace not/1 by the ISO (\+)/1 first.
For debugging, the first thing you would do is to minimize the problem. E.g., the query
?- removevowels([m,m],X).
is just as bad. But much smaller. So what are your rules for consonants? There is a single rule:
removevowels([X|L1], [X|L2], Aux) :-
consonant(X),
\+member(X, Aux),
removevowels(L1, L2, [X|Aux]).
So consonants have to occur only once, the next occurrence makes this fail already.
Should you still not be sure why the query fails, you might also want to generalize the query. In stead of seeing that removevowels([m,m],X) fails, you might ask
?- removevowels([m,Y],X).
which means: Is there any Y such that there is a solution. However, this method only works, if your program is "relational". In your case the last rule, however prevents this:
removevowels([X|L1], L2, Aux) :-
\+consonant(X),
removevowels(L1, L2, Aux).
It will never succeed with X being an uninstantiated variable. I'd rather use instead:
removevowels([X|L1], L2, Aux) :-
vowel(X),
removevowels(L1, L2, Aux).
Back to consonants:
What you are missing is either a separate rule for consonants that are already present, or some "defaulty" if-then-else.
Further, this extra checking might not be the most effective way to handle this. Maybe just extract the vowels first, and then sort/2 them.
in second clause, there are two 2 conditions in join, while the last clause has only one. I would commit the good case with a cut, and let the last clause only act as a trusted skip clause:
removevowels([], [], _).
removevowels([X|L1], [X|L2], Aux) :-
consonant(X),
not(member(X, Aux)),
!, removevowels(L1, L2, [X|Aux]).
removevowels([_X|L1], L2, Aux) :-
removevowels(L1, L2, Aux).
using if/then/else construct for the last 2 clauses, we avoid the problem noted by false:
removevowels([], [], _).
removevowels([X|L1], R, Aux) :-
( consonant(X),
not(member(X, Aux))
-> R=[X|L2],
removevowels(L1, L2, [X|Aux])
; removevowels(L1, R, Aux)
).
I've written the following code in prolog:
contains(L1, []).
contains(L1, [X | T2]) :- member(X, L1), contains(L1, T2).
minus(L, [], L).
minus(L1, L2, L3) :- contains(L1, L3), nomembers(L3, L2).
nomembers(L1, []).
nomembers(L1, [X | T2]) :- not(member(X, L1)), nomembers(L1, T2).
contains(L1, L2) returns true if all of the members in L2 appear in L1. (contains([1,2],[1,1,1]) is true).
minus(L1, L2, L3) returns true if L3=L1\L2, meaning L3 consists of members of L1 but not of L2.
When I ask minus([1,2,3,4],[2,1],L), I get the answer that L=[], although logically it should be L=[3,4]. Does someone know why?
Above comment of mbratch is very helpful.
Notice, that your current minus(L1, L2, L3) definition is: All members of L3 are in L1 and no member from L3 is in L2.
Prolog is giving you good answer with L3 = [], it fits for definition I wrote above.
EDIT: Below code should do what you want, but currently I don't have prolog on my computer, so I can't test it.
remove(X, [X|T], T) :- !.
remove(X, [H|T], [H|T2]) :- remove(X, T, T2).
minus(L1,[],L1).
minus(L1,[H|T2],T3) :- member(H, L1), !, remove(H,L1,L4), minus(L4, T2, T3).
minus(L1,[H|T2],[H|T3]) :- minus(L1, T2, T3).
remove(X,LA,LB) which says: LB is LA without it first occurrence of X, so it's just removing element from the list.
I am trying to write a program in Prolog to find a Latin Square of size N.
I have this right now:
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R) :-
permutation(T, X),
delete(H, R, X).
latinSqaure([_]).
latinSquare([A,B|T], N) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
using SWI-Prolog library:
:- module(latin_square, [latin_square/2]).
:- use_module(library(clpfd), [transpose/2]).
latin_square(N, S) :-
numlist(1, N, Row),
length(Rows, N),
maplist(copy_term(Row), Rows),
maplist(permutation, Rows, S),
transpose(S, T),
maplist(valid, T).
valid([X|T]) :-
memberchk(X, T), !, fail.
valid([_|T]) :- valid(T).
valid([_]).
test:
?- aggregate(count,S^latin_square(4,S),C).
C = 576.
edit your code, once corrected removing typos, it's a verifier, not a generator, but (as noted by ssBarBee in a deleted comment), it's flawed by missing test on not adjacent rows.
Here the corrected code
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R):-
permutation(T, X),
delete(H, R, X).
latinSquare([_]).
latinSquare([A,B|T]) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
and some test
?- latinSquare([[1,2,3],[2,3,1],[3,2,1]]).
false.
?- latinSquare([[1,2,3],[2,3,1],[3,1,2]]).
true .
?- latinSquare([[1,2,3],[2,3,1],[1,2,3]]).
true .
note the last test it's wrong, should give false instead.
Like #CapelliC, I recommend using CLP(FD) constraints for this, which are available in all serious Prolog systems.
In fact, consider using constraints more pervasively, to benefit from constraint propagation.
For example:
:- use_module(library(clpfd)).
latin_square(N, Rows, Vs) :-
length(Rows, N),
maplist(same_length(Rows), Rows),
maplist(all_distinct, Rows),
transpose(Rows, Cols),
maplist(all_distinct, Cols),
append(Rows, Vs),
Vs ins 1..N.
Example, counting all solutions for N = 4:
?- findall(., (latin_square(4,_,Vs),labeling([ff],Vs)), Ls), length(Ls, L).
L = 576,
Ls = [...].
The CLP(FD) version is much faster than the other version.
Notice that it is good practice to separate the core relation from the actual search with labeling/2. This lets you quickly see that the core relation terminates also for larger N:
?- latin_square(20, _, _), false.
false.
Thus, we directly see that this terminates, hence this plus any subsequent search with labeling/2 is guaranteed to find all solutions.
I have better solution, #CapelliC code takes very long time for squares with N length higher than 5.
:- use_module(library(clpfd)).
make_square(0,_,[]) :- !.
make_square(I,N,[Row|Rest]) :-
length(Row,N),
I1 is I - 1,
make_square(I1,N,Rest).
all_different_in_row([]) :- !.
all_different_in_row([Row|Rest]) :-
all_different(Row),
all_different_in_row(Rest).
all_different_in_column(Square) :-
transpose(Square,TSquare),
all_different_in_row(TSquare).
all_different_in_column1([[]|_]) :- !.
all_different_in_column1(Square) :-
maplist(column,Square,Column,Rest),
all_different(Column),
all_different_in_column1(Rest).
latin_square(N,Square) :-
make_square(N,N,Square),
append(Square,AllVars),
AllVars ins 1..N,
all_different_in_row(Square),
all_different_in_column(Square),
labeling([ff],AllVars).