Prolog "switch" statement - prolog

How can I implement a switch statement equivalent to a nested set of if_s?
Ideally something like (don't mind the syntax):
compatible(X, Y) :-
switch X
a1 -> dif(Y, b2),
a2 -> dif(Y, c2), dif(Y, c3),
_ -> true
working the same way as this one:
compatible(X, Y) :-
if_(X = a1,
dif(Y, b2),
if_(X = a2,
(dif(Y, c2), dif(Y, c3)),
true
)
).

:- module(switch_, []).
:- use_module(library(reif)).
:- multifile goal_expansion/2.
user:goal_expansion(switch_(X, ;(->(H, C), T)), if_(X = H, C, switch_(X, T))).
user:goal_expansion(switch_(X, ->(H, C)), if_(X = H, C, fail)).
user:goal_expansion(switch_(_, true), true).
user:goal_expansion(switch_(_, false), false).
:- use_module(switch_).
likes(A, B) :-
switch_(A, (
john -> B = mary ;
mary -> dif(B, john) ;
true
)).
Example
?- likes(A, B).
A = john,
B = mary ;
A = mary,
dif(B, john) ;
dif(A, mary),
dif(A, john).
?- likes(mary, B).
dif(B, john).
?- likes(john, B).
B = mary.

Related

Generate all words of length N and form a list with them in Prolog

Given the letters [a, b, c] generate the list containing all the words of length N, formed out of this letters.
For example:
?- generate(2, L).
should output:
L = [aa, ab, ac, ba, bb, bc, ca, cb, cc].
At first, this seemed like a pretty simple problem, but I've discovered that none of my implementations work.
This is the second implementation, the one that kind of works.
letter(X) :- member(X, [a, b, c]).
generateWord(0, []) :- !.
generateWord(N, [H|T]) :-
letter(H),
NextN is N - 1,
generateWord(NextN, T).
generateAtomicWord(N, Word) :-
generateWord(N, WList),
atomic_list_concat(WList, Word).
maxSolutions(N, R) :- R is N ** 3.
generate(N, CurrentList, ResultList) :-
maxSolutions(N, R),
length(CurrentList, L),
L =:= R,
append(CurrentList, [], ResultList), !.
generate(N, CurrentList, ResultList) :-
generateAtomicWord(N, NewWord),
\+ member(NewWord, CurrentList),
append(CurrentList, [NewWord], NewList),
generate(N, NewList, ResultList).
generate(N, ResultList) :-
generate(N, [], ResultList).
It kind of works because when given N = 3 the program outputs:
L = [aaa, aab, aac, aba, abb, abc, aca, acb, acc|...]
My first implementation is different, but I can't make it work on any case.
letter(X) :- member(X, [a, b, c]).
generateWord(0, []) :- !.
generateWord(N, [H|T]) :-
letter(H),
NextN is N - 1,
generateWord(NextN, T), !.
generateAtomicWord(N, Word) :-
generateWord(N, WList),
atomic_list_concat(WList, Word).
maxSolutions(N, R) :- R is N ** 3.
generate(N, [H]) :- generateAtomicWord(N, H).
generate(N, [H|T]) :-
generate(N, T),
length(T, TailLen),
maxSolutions(N, M),
(TailLen =:= M -> !;
generateAtomicWord(N, H),
\+ member(H, T)).
This one just outputs:
L = [aa]
and when requested for the rest of the solutions it cycles.
The problem must be solved without using predicates such as:
findall, findnsol, bagof, setof, etc...
that find all the solutions.
I've added the tag backtracking because it does resemble a backtracking problem, but I've no idea what a standard implementation might look like in Prolog.
It kind of works because when given N = 3 the program outputs:
L = [aaa, aab, aac, aba, abb, abc, aca, acb, acc|...]
That is not an error, that is the Prolog interpreter that displays the list in a shorter way. If you hit w when it shows the output, it will show the full list. For more information see this answer.
That being said, you make it too hard. You can first make a predicate that will unify a variable with all possible atoms:
letter(X) :- member(X, [a, b, c]).
word(0, []).
word(N, [C|W]) :-
N > 0,
N1 is N-1,
letter(C),
word(N1, W).
Now we can generate all possibilities with findall/3 [swi-doc], and use for example maplist/3 [swi-doc] with atomic_list_concat/2 to convert the list to a single atom:
words(N, L) :-
findall(W, word(N, W), Ws),
maplist(atomic_list_concat, Ws, L).
For example:
?- words(0, L).
L = [''].
?- words(1, L).
L = [a, b, c].
?- words(2, L).
L = [aa, ab, ac, ba, bb, bc, ca, cb, cc].
?- words(3, L).
L = [aaa, aab, aac, aba, abb, abc, aca, acb, acc|...].
We can generate a list of lists ourselves by updating a "difference" list until all possible words are generated:
wordlist(N, L) :-
wordlist(N, [], L, []).
wordlist(0, R, [W|T], T) :-
reverse(R, W),
!.
wordlist(N, C, L, T) :-
N > 0,
N1 is N-1,
wordfold([a,b,c], N1, C, L, T).
wordfold([], _, _, L, L).
wordfold([C|CS], N1, CT, L, T) :-
wordlist(N1, [C|CT], L, L2),
wordfold(CS, N1, CT, L2, T).
For example:
?- wordlist(0, L).
L = [[]].
?- wordlist(1, L).
L = [[a], [b], [c]].
?- wordlist(2, L).
L = [[a, a], [a, b], [a, c], [b, a], [b, b], [b, c], [c, a], [c|...], [...|...]].
You then still need to perform atomic_list_concat on it. I leave that as an exercise.

How to write earlier statement in prolog?

I was looking at prolog progrm and was unable to understand the following
earlier(X, _, [X|_]).
earlier(_, Y, [Y|_]) :- !, fail.
earlier(X, Y, [_|T]) :- earlier(X, Y, T).
Can anyone explain what does it mean??
As the name suggests, earlier(X, Y, Zs) is apparently supposed to check whether the element X appears earlier than the first occurrence of Y in the list Zs. It kind of does this:
?- earlier(a, b, [a, b, c, d]).
true ;
false.
?- earlier(b, d, [a, b, c, d]).
true ;
false.
With peculiar handling if the second argument is not in the given list:
?- earlier(a, not_in_list, [a, b, c, d]).
true ;
false.
How does this work? The first clause says that if X is the head of the list, then X appears earlier in the list than anything, represented by the anonymous variable _. The second clause says that if Y is the head of the list, then nothing (_ in first argument position) is before Y. In this case, the predicate fails and uses a cut to avoid finding spurious solutions. The third clause just recurses on the list of neither the first nor second clauses applied.
Due to the cut, this definition is not very declarative, and some interesting uses don't work as one might expect:
?- earlier(X, Y, Zs).
Zs = [X|_G947] ;
false.
?- earlier(a, b, Zs).
Zs = [a|_G923] ;
false.
?- earlier(X, Y, [a, b, c, d]).
X = a ;
false.
The last case, in particular, might be interesting for some use cases. Here is a more declarative version:
earlier_than(X, Y, Zs) :-
append(InitialPart, [X | _Rest], Zs),
notmember_of(Y, InitialPart).
notmember_of(_X, []).
notmember_of(X, [Y|Xs]) :-
dif(X, Y),
notmember_of(X, Xs).
You can use this to enumerate solutions more nicely:
?- earlier_than(X, Y, Zs).
Zs = [X|_G947] ;
Zs = [_G1162, X|_G1166],
dif(Y, _G1162) ;
Zs = [_G1254, _G1257, X|_G1261],
dif(Y, _G1257),
dif(Y, _G1254) ;
Zs = [_G1346, _G1349, _G1352, X|_G1356],
dif(Y, _G1352),
dif(Y, _G1349),
dif(Y, _G1346) .
?- earlier_than(a, b, Zs).
Zs = [a|_G923] ;
Zs = [_G1086, a|_G1090],
dif(_G1086, b) ;
Zs = [_G1169, _G1172, a|_G1176],
dif(_G1169, b),
dif(_G1172, b) ;
Zs = [_G1252, _G1255, _G1258, a|_G1262],
dif(_G1252, b),
dif(_G1255, b),
dif(_G1258, b) .
?- earlier_than(X, Y, [a, b, c, d]).
X = a ;
X = b,
dif(Y, a) ;
X = c,
dif(Y, b),
dif(Y, a) ;
X = d,
dif(Y, c),
dif(Y, b),
dif(Y, a) ;
false.
Personally, if the specification permits, I would also add a member(Y, Rest) to the definition of earlier_than/3. This makes things even nicer:
?- earlier_than(X, Y, Zs).
Zs = [X, Y|_G950] ;
Zs = [X, _G949, Y|_G953] ;
Zs = [X, _G949, _G952, Y|_G956] .
?- earlier_than(a, b, Zs).
Zs = [a, b|_G926] ;
Zs = [a, _G925, b|_G929] ;
Zs = [a, _G925, _G928, b|_G932] .
?- earlier_than(X, Y, [a, b, c, d]).
X = a,
Y = b ;
X = a,
Y = c ;
X = a,
Y = d ;
X = b,
Y = c ;
X = b,
Y = d ;
X = c,
Y = d ;
false.

Calculation logic formula models with prolog

Given a CNF logic formula
[[a, b, c], [b, d], [not(d), a]] that is equal to ((a or b or c) and (b or d) and (not d or a)), how do I calculate its models (possible values for its atoms that makes the formula true), using prolog? This is what i've got so far:
A valuation to the formula is a list of terms in the form os val(X,B), where X is an atom, and B is its value (0 or 1).
The relation value(X, Vs, B) is given by
value(X, [val(X, B)|_], B) :− !.
value(X, [_|Ps], B) :− value(X, Ps, B).
and its true whenever B is the value for the atom X in the valuation Vs.
The relation sp(F, Ss), given by
sp([],[]).
sp([F|Fs], Ss) :- setof(A, member(A,F), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss).
and its true whenever Ss is the list of atoms in logic formula F.
The relation valuation(As, Vs), given by
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
that is true whenever Vs is a possible valuation for the list of atoms As.
What I need:
The relation ext(F, Vs, B) that is true whenever F is a formula, Vs is a possible valuation for that formula, and B is the value of the formula applying Vs valuation. For example, the consult
ext([[a], [not(b), c]] , [val(a, 1), val(b, 0), val(c , 1)], B).
should return the value B = 1.
The relation model(F,Vs) that is true whenever the valuation Vs is a model for the formula F.
The relation models(F, Ms) that is true whenever Ms is a list which elements are models for the formula F. I guess we need to use prolog’s setof here.
And, at last, I don't know whats the best implementation of val(X,B) to make it work. I dont know if I should specify val(_,1) and val(_,0) to be true or only val(_,1), what is better knowing the other relations to be implemented?
Not sure to understand exactly what you want but...
First of all, let me try to simplify your code.
1) I think your value/2 should be written as
value(X, [val(X, B) | _], B).
value(X, [_ | Ps], B) :-
value(X, Ps, B).
2) I don't understand the purpose of your sp/2 but seems to me that can be simplified as
sp([], []).
sp([[A] | Fs], [A | Ss]) :-
sp(Fs, Ss).
sp([[A | As] | Fs], [A | Ss]) :-
append(As, Fs, N),
sp(N, Ss).
3) I don't understand the purpose of your valutation/2 but seems to me that can be simplified as
isBool(0).
isBool(1).
valuation([], []).
valuation([A | As], [val(A, B) | Vs]) :-
isBool(B),
valuation(As,Vs).
Now I try to respond to your question
4)
I need [...] The relation ext(F, Vs, B) that is true whenever F
is a formula, Vs is a possible valuation for that formula, and B
is the value of the formula applying Vs valuation
I suppose the following should work [caution: not tested really much]
ext([], _, 1).
ext([[] |_], _, 0).
ext([[X | L1] | L2], Vs, B) :-
value(X, Vs, 0),
ext([L1 | L2], Vs, B).
ext([[not(X) | L1] | L2], Vs, B) :-
value(X, Vs, 1),
ext([L1 | L2], Vs, B).
ext([[X | _] | L], Vs, B) :-
value(X, Vs, 1),
ext(L, Vs, B).
ext([[not(X) | _] | L], Vs, B) :-
value(X, Vs, 0),
ext(L, Vs, B).
5)
I need [...] The relation model(F,Vs) that is true whenever the
valuation Vs is a model for the formula F
What about the following ?
model(F, Vs) :-
ext(F, Vs, _). % or ext(F, Vs, 1)?
6)
I need [...] The relation models(F, Ms) that is true whenever Ms is a
list which elements are models for the formula F
If I understand correctly what do you want, given model/2, models/2 could be written as
models(_, []).
models(F, [Vs | Vl]) :-
model(F, Vs),
models(F, Vl).
7)
I don't know whats the best implementation of val(X,B) to make it
work. I dont know if I should specify val(,1) and val(,0) to be true
or only val(_,1)
Not sure to understand your question.
val/2 can't be true for every value; so you can't impose true val(_,1) and/or val(_,0) because given an atom (a, by example) is true val(a,1) or val(a,0) but ins't true val(X,1) for every X.
Another approach here. Translate to executable Prolog, and reify a specific execution (i.e. a proof with specific symbol bindings):
ext(F, Vs, B) :-
or_list(F, [], C, Vs), !,
assign(Vs), ( call(C), B = true ; B = false ).
assign(Dict) :- maplist(domain, Dict).
domain(val(_, true)).
domain(val(_, false)).
or_list([A], D, T, Du) :-
!, and_list(A, D, T, Du).
or_list([A|As], D, ( T ; Ts ), Du) :-
and_list(A, D, T, Dut),
or_list(As, Dut, Ts, Du).
and_list([V], D, T, Du) :-
!, negation(V, D, T, Du).
and_list([V|Vs], D, ( T , Ts ), Du) :-
negation(V, D, T, Dut),
and_list(Vs, Dut, Ts, Du).
negation(not(V), D, \+T, Du) :-
!, sym_bind(V, D, T, Du).
negation(V, D, T, Du) :-
sym_bind(V, D, T, Du).
sym_bind(V, D, T, D) :-
memberchk(val(V, T), D), !.
sym_bind(V, D, T, [val(V, T)|D]).
note:
false/true instead of 0/1
list to structure translation: could be way shorter, using foldl or DCGs or passing down the operators (that is (;)/2 (,)/2 (+)/1), but this way the Prolog patterns should be clearer...
I could finally finish it while waiting for replies, and improved it using max66's answer.
I made it to accept propositional logic forms too, so models/2 accepts both styles (CNF and Propositional form, based on operators and, not, or, imp, iff that I set).
:- op(400, fy , not).
:- op(500, xfy, and).
:- op(600, xfy, or ).
:- op(700, xfy, imp).
:- op(800, xfy, iff ).
distr(_, [], []).
distr([], _, []).
distr([C|Cs], Ds, Es) :- distr_un(C, Ds, Ss), distr(Cs, Ds, Ts), append(Ss, Ts, Es).
distr_un(_, [], []).
distr_un(C, [D|Ds], [E|Es]) :- append(C, D, E), distr_un(C, Ds, Es).
cnf(F, [[F]]) :- atom(F), !.
cnf(not(F), [[not(F )]]) :- atom(F), !.
cnf(not not F, Rs) :- cnf(F, Rs).
cnf(not (F imp G), Rs) :- cnf(F and not G, Rs).
cnf(not (F iff G), Rs) :- cnf((F and not G) or (not F and G), Rs).
cnf(not(F and G), Rs) :- cnf((not F) or (not G), Rs).
cnf(not(F or G), Rs) :- cnf((not F) and (not G), Rs).
cnf(F and G, Rs) :- cnf(F, Cs), cnf(G, Ds), append(Cs, Ds, Rs).
cnf(F or G, Rs) :- cnf(F, Cs), cnf(G, Ds), distr(Cs, Ds, Rs).
cnf(F imp G, Rs) :- cnf((not F) or G, Rs).
cnf(F iff G, Rs) :- cnf((not F or G) and (not G or F), Rs).
val(X,0) :- atom(X).
val(X,1) :- atom(X).
value(X, [val(X, B)|_], B) :- !.
value(X, [_|Ps], B) :- value(X, Ps, B), !.
value(not X, [val(X, B)|_], V) :- V is 1-B, !.
value(not X, [_|Ps], B) :- value(not X, Ps, B), !.
sp([],[]).
sp([F|Fs], Ss) :- setof(A1, member(not A1, F), R1), setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M1), append(M1, R1, M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(not A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
ext([F|Fs], Vs, B) :- sp([F|Fs], Ss), valuation(Ss, Vs), ext_([F|Fs], Vs, B).
ext_([], _, 1).
ext_([F|Fs], Vs, 1) :- cl(F, Vs, 1), ext_(Fs, Vs, 1).
ext_([F|Fs], Vs, 0) :- cl(F, Vs, 0); ext_(Fs, Vs, 0).
cl([A|As], Vs, 1) :- value(A,Vs,1); cl(As, Vs, 1).
cl([A|As], Vs, 0) :- value(A,Vs,0), cl(As,Vs,0).
cl([], _, 0).
model(F, Vs) :- ext(F, Vs, 1).
models(F, Vs) :- cnf(F, Fs), setof(V, model(Fs, V), Vs).
models(F, Vs) :- setof(V, model(F, V), Vs).
I tested it and it seems to be working as intended.

prolog general rule for finding cousins etc

The question is to write a general rule to find any level of relative!
cousin(N,Child1,Child2).
So that it is true if Child1 and Child2 are Nth cousins. So
cousin1(Child1,Child2) = cousin(1,Child1,Child2) and
cousin2(Child1,Child2) = cousin(2,Child1,Child2) and so on
for third and fourth and even higher level cousins.
What I have so far:
/* first person is parent of second person */
parent(a, b).
parent(b, f).
parent(a, d).
parent(f, g).
parent(a, k).
parent(f, h).
parent(k, l).
parent(f, i).
parent(k, m).
parent(l, t).
parent(b, e).
sibling(X,Y) :- parent(Z,X), parent(Z,Y), not(X=Y).
grandparent(X, Z) :-
parent(X, Y),
parent(Y, Z).
greatgrandparent(X, Z) :-
parent(X, Y),
parent(Y, P),
parent(P, Z).
cousin1(Child1,Child2) :-
parent(Y1,Child1),
parent(Y2,Child2),
sibling(Y1,Y2).
cousin2(Child1,Child2) :-
greatgrandparent(Z, Child1),
greatgrandparent(Z, Child2),
\+sibling(Child1, Child2),
\+cousin1(Child1, Child2),
Child1 \= Child2.
This returns false regardless of values input, so clearly I have no idea what I am doing PLEASE help!
cousin(N,Child1,Child2) :-
nth0(N, parent(Y1,Child1),Y1),
nth0(N, parent(Y2,Child2),Y2),
cousin1(Y1,Y2).
I tried:
% first person is parent of second person
parent(a, b).
parent(b, f).
parent(a, d).
parent(f, g).
parent(a, k).
parent(f, h).
parent(k, l).
parent(f, i).
parent(k, m).
parent(l, t).
parent(b, e).
sibling(Sib1,Sib2) :- parent(SomeParent,Sib1),
parent(SomeParent,Sib2),
\+ Sib1 = Sib2.
% first person is ancestor of second person
ancestor(Older,Younger,L) :-
parent(Older,Younger),
L is 1.
ancestor(Older,Younger,Level) :-
parent(Older,Child),
ancestor(Child,Younger,L),
Level is L + 1.
%nth_cousin(Level,Cous1,Cous2) :-
% ancestor(Sib1,Cous1,Level),
% ancestor(Sib2,Cous2,Level),
% sibling(Sib1,Sib2).
nth_cousin(Level,Cous1,Cous2) :-
setof((Cous1,Cous2), Sib1^Sib2^(ancestor(Sib1,Cous1,Level),
ancestor(Sib2,Cous2,Level),
sibling(Sib1,Sib2)
),
Cousins),
member((Cous1,Cous2), Cousins),
\+ (Cous2#<Cous1, member((Cous2,Cous1), Cousins)).
Ex.
1 ?- nth_cousin(1,Cous1,Cous2).
Cous1 = e,
Cous2 = l ;
Cous1 = e,
Cous2 = m ;
Cous1 = f,
Cous2 = l ;
Cous1 = f,
Cous2 = m ;
false.
2 ?- nth_cousin(2,Cous1,Cous2).
Cous1 = g,
Cous2 = t ;
Cous1 = h,
Cous2 = t ;
Cous1 = i,
Cous2 = t ;
false.

substitute in a nested list (prolog)

/* substitute(X,Y,Xs,Ys) is true if the list Ys is the result of substituting Y for all occurrences of X in the list Xs.
This is what I have so far:
subs(_,_,[],[]).
subs(X,Y,[X|L1],[Y|L2]):- subs(X,Y,L1,L2).
subs(X,Y,[H|L1],[H|L2]):- X\=H, not(H=[_|_]), subs(X,Y,L1,L2).
subs(X,Y,[H|_],[L2]):- X\=H, H=[_|_], subs(X,Y,H,L2).
My code works except it omits the elements following the nested list. For example:
?- subs(a,b,[a,[a,c],a],Z).
Z = [b, [b, c]] .
What should I add to this program?
Here is how you could write it using (... -> ... ; ...):
subs(_, _, [], []).
subs(X, Y, [H1|T1], [H2|T2]) :-
(H1 == X ->
H2 = Y
; is_list(H1) ->
subs(X, Y, H1, H2),
subs(X, Y, T1, T2)
;
H1 = H2,
subs(X, Y, T1, T2)
).
The problem is that once you find a nested list, you forget about whatever is behind that nested list. Instead, after recursing with the nested nest, simply continue as before. Thus, you should change the last clause as follows:
subs(X,Y,[H|L1],[H2|L2]):- X\=H, H=[_|_], subs(X,Y,H,H2), subs(X, Y, L1, L2).
Aside from that, there are a couple of ways in which you can improve the code:
Use cuts (!/0) to stop backtracking. In this way you don't have to repeat yourself.
You can use is_list/1 to test whether an argument is a list.
It's okay to use more spaces. Really.
So, an alternative solution is (now using \+/1 instead of not/1):
subs(_, _, [], []).
subs(X, Y, [X|T1], [Y|T2]) :- subs(X, Y, T1, T2), !.
subs(X, Y, [H|T1], [H|T2]) :- \+ is_list(H), subs(X, Y, T1, T2), !.
subs(X, Y, [H1|T1], [H2|T2]) :- subs(X, Y, H1, H2), subs(X, Y, T1, T2).
Demonstration:
?- subs(a, b, [a, [a, [d, f, a]], a, b, a, [g]], Z).
Z = [b, [b, [d, f, b]], b, b, b, [g]].

Resources