Prolog Flow Free game solver - prolog

I have been trying to write a Flow free solver in Prolog. Here is how the game looks like.
Prolog solver should find the solution for it. I have started doing something but I'm definitely missing some parts and not sure what to do next.
Here's what I have until now. As it is a homework question, I have had some parts provided for me, so they don't require any change.
:-include(entradaFlow9).
:-dynamic(varNumber/3).
symbolicOutput(0).
writeClauses:-
atleastOneColorPerNode,
atmostOneColorPerNode,
atmost1Connected,
atmost2Connected.
atleastOneColorPerNode:-
size(N),
between(1,N,I),
between(1,N,J),
between(1,N,K),
findall( x-I-J-K, between(1,N,J), C ),
writeClause(C),
fail.
atleastOneColorPerNode.
atmostOneColorPerNode:-
size(N),
between(1,N,I),
between(1,N,J),
between(1,N,K1),
between(1,N,K2),
K1<K2,
writeClause([ \+x-I-J-K1, \+x-I-J-K2 ] ), fail.
atmostOneColorPerNode.
atmost1Connected:-
c(I1,X1,Y1),
c(I2,X2,Y2),
I1 < I2,
size(N),
between(1,N,H),
distance((X1,Y1), (X2,Y2), X), X is 1, I2 is I1,
writeClause( [\+r-I1-H, \+r-I2-H] ), fail.
atmost1Connected.
atmost2Connected:-
c(I1,X1,Y1),
c(I2,X2,Y2),
c(I3,X3,Y3),
I1 < I2, I2 < I3,
size(N),
between(1,N,H),
distance((X1,Y1), (X2,Y2), X), X is 1,
distance((X1,Y1), (X3,Y3), Y), Y is 1,
I2 is I1, I3 is I2,
writeClause( [\+o-I1-H, \+o-I2-H, \+o-I3-H] ), fail.
atmost2Connected.
displayFlow(M).
% ========== No need to change the following: =====================================
main:- symbolicOutput(1), !, writeClauses, halt. % escribir bonito, no ejecutar
main:- assert(numClauses(0)), assert(numVars(0)),
tell(clauses), writeClauses, told,
tell(header), writeHeader, told,
unix('cat header clauses > infile.cnf'),
unix('picosat -v -o model infile.cnf'),
unix('cat model'),
see(model), readModel(M), seen, displaySol(M),
halt.
var2num(T,N):-
hash_term(T,Key),
varNumber(Key,T,N),!.
var2num(T,N):-
retract(numVars(N0)), N is N0+1,
assert(numVars(N)),
hash_term(T,Key),
assert(varNumber(Key,T,N)),
assert( num2var(N,T) ), !.
writeHeader:-
numVars(N),
numClauses(C),
write('p cnf '),write(N), write(' '),write(C),nl.
countClause:-
retract(numClauses(N)), N1 is N+1,
assert(numClauses(N1)),!.
writeClause([]):- symbolicOutput(1),!, nl.
writeClause([]):- countClause, write(0), nl.
writeClause([Lit|C]):- w(Lit), writeClause(C),!.
w( Lit ):- symbolicOutput(1), write(Lit), write(' '),!.
w(\+Var):- var2num(Var,N), write(-), write(N), write(' '),!.
w( Var):- var2num(Var,N), write(N), write(' '),!.
unix(Comando):-shell(Comando),!.
unix(_).
readModel(L):-
get_code(Char),
readWord(Char,W),
readModel(L1),
addIfPositiveInt(W,L1,L),!.
readModel([]).
addIfPositiveInt(W,L,[N|L]):-
W = [C|_], between(48,57,C),
number_codes(N,W), N>0, !.
addIfPositiveInt(_,L,L).
readWord(99,W):-
repeat,
get_code(Ch),
member(Ch,[-1,10]), !,
get_code(Ch1),
readWord(Ch1,W),!.
readWord(-1,_):-!, fail. %end of file
readWord(C,[]):- member(C,[10,32]), !. % newline or white space marks end of word
readWord(Char,[Char|W]):- get_code(Char1), readWord(Char1,W), !.
The data I have is:
size(9).
c(blue, 9,1, 2,2).
c(brown, 3,1, 8,4).
c(red, 3,4, 1,7).
c(cyan, 1,8, 4,4).
c(green, 1,9, 5,2).
c(yellow, 7,7, 7,9).
c(pink, 6,5, 8,7).
c(violet, 8,9, 9,6).
c(orange, 5,8, 8,8).

Related

Writing a math function in Prolog

I need to write a function in Prolog, but I don't understand how to return the value of R and put it in the final function. I get that Prolog doesn't return values, but I still can't figure it out.
This is what I have now:
run:- write('Input X, Z:'), nl,
read(X), number(X),
read(Z), number(Z),
func(X,Y),
write('Y='), write(Y), nl.
countR(X,Z,R):- X^2>=Z, R is Z*X.
countR(X,Z,R):- X^2<Z, R is Z*e^-X.
func(X,Y):- X>R, Y is 1-X^R.
func(X,Y):- X=<R, Y is 1-X^-R.
It would be like:
run:- write('Input X, Z:'), nl,
read(X), number(X),
read(Z), number(Z),
func(X,Z,Y),
write('Y='), write(Y), nl.
countR(X,Z,R) :-
Xsq is X^2,
Xsq >= Z,
R is Z*X.
func(X,Z,Y) :-
countR(X, Z, R),
X > R,
Y is 1-X^R.
"func holds for X, Z and Y if countR holds for X, Z, R and X is greater than R and Y is 1-X^R"
and same pattern for the other cases.

Prolog Expert System for the Farmer Goat Wolf Cabbage Puzzle

I have been tasked with creating a General Expert System in Prolog which you can plug in different knowledge bases to, so it has to be general. The knowledge base that I have to provide with the Expert System is the Farmer Goat Wolf and Cabbage Puzzle. I am having a really tough time designing the knowledge base and the general inference engine.
After a couple days of searching, I have found a bunch of examples of Expert Systems for the bird hierarchy and some other odds and ends, but they don't seem to help me wrap my head around how to put this project together.
I was just wondering if anyone has some good examples or material of how to design Expert Systems in Prolog or where good places to look are?
Thanks for your help as it is much appreciated.
PS. I would prefer not to purchase material as this is my last month of school and it will be highly unlikely that I will be doing much Prolog programming after this course is finished.
Thanks and Regards,
D
EDIT
Here is my knowledge base.
% Order is Farmer, Goat, Wolf, Cabbage
start_state :: state(west_side, west_side, west_side, west_side).
fact :: current(X, X, X, X) :-
end_state :: state(X, X, X, X),
X = east_side.
move_goat ::
if
state(X, X, W, C) and
opp(X, Y) and
(unsafe(state(Y, Y, W, C)))
then
current(Y, Y, W, C).
move_wolf ::
if
state(X, G, X, C) and
opp(X, Y) and
(unsafe(state(Y, G, Y, C)))
then
current(Y, G, Y, C).
move_cabbage ::
if
state(X, G, W, X) and
opp(X, Y) and
(unsafe(state(Y, G, W, Y)))
then
current(Y, G, W, Y).
% Move the object to the other side of the river
opp(west_side, east_side).
opp(east_side, west_side).
% Is the new state unsafe
fact :: unsafe(state(X,Y,Y,C)) :- opp(X,Y).
fact :: unsafe(state(X,Y,W,Y)) :- opp(X,Y).
Here is the Expert System I am trying to retrofit my knowledge base to.
:-op(900, xfx, ::).
:-op(800, xfx, was).
:-op(880, xfx, then).
:-op(870, fx, if).
:-op(600, xfx, from).
:-op(600, xfx, by).
:-op(550, xfy, or).
:-op(540, xfy, and).
:-op(300, fx, 'derived by').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
main :-
consult('FarmerKB.pl'),
assertz(lastindex(0)),
assertz(wastold(dummy, false, 0)),
assertz(end_answers(dummy)),
expert.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
expert :-
getquestion(Question),
( answeryes(Question)
;
answerno(Question)
).
answeryes(Question) :-
markstatus(negative),
explore(Question, [], Answer),
positive(Answer),
markstatus(positive),
present(Answer), nl,
write('More Solutions?'),
getreply(Reply),
Reply = no.
answerno(Question) :-
retract(no_positive_answer_yet), !,
explore(Question, [], Answer),
negative(Answer),
present(Answer), nl,
write('More Negative Solutions?'),
getreply(Reply),
Reply = no.
markstatus(negative) :-
assertz(no_positive_answer_yet).
markstatus(positive) :-
retract(no_positive_answer_yet), !
;
true.
getquestion(Question) :-
nl, write('Question Please'), nl,
read(Question).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
explore(Goal, Trace, Goal is true was 'found as a fact') :-
fact :: Goal.
explore(Goal, Trace, Goal is TruthValue was 'derived by' Rule from Answer) :-
Rule :: if Condition then Goal,
explore(Condition, [Goal by Rule | Trace], Answer),
truth(Answer, TruthValue).
explore(Goal1 and Goal2, Trace, Answer) :- !,
explore(Goal1, Trace, Answer1),
continue(Answer1, Goal1 and Goal2, Trace, Answer).
explore(Goal1 or Goal2, Trace, Answer) :-
exploreyes(Goal1, Trace, Answer)
;
exploreyes(Goal2, Trace, Answer).
explore(Goal1 or Goal2, Trace, Answer1 and Answer2) :- !,
not(exploreyes(Goal1, Trace, _)),
not(exploreyes(Goal2, Trace, _)),
explore(Goal1, Trace, Answer1),
explore(Goal2, Trace, Answer2).
explore(Goal, Trace, Goal is Answer was told) :-
useranswer(Goal, Trace, Answer).
exploreyes(Goal, Trace, Answer) :-
explore(Goal, Trace, Answer),
positive(Answer).
continue(Answer1, Goal1 and Goal2, Trace, Answer) :-
positive(Answer1),
explore(Goal2, Trace, Answer2),
( positive(Answer2),
Answer = Answer1 and Answer2
;
negative(Answer2),
Answer = Answer2
).
continue(Answer1, Goal1 and Goal2, _, Answer1) :-
negative(Answer1).
truth(Question is TruthValue was found, TruthValue) :- !.
truth(Answer1 and Answer2, TruthValue) :-
truth(Answer1, true),
truth(Answer2, true), !,
TruthValue = true
;
TruthValue = false.
positive(Answer) :-
truth(Answer, true).
negative(Answer) :-
truth(Answer, false).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
getreply(Reply) :-
read(Answer),
means(Answer, Reply), !
;
nl, write('Answer unknown, try again please'), nl,
getreply(Reply).
means(yes, yes).
means(y, yes).
means(no, no).
means(n, no).
means(why, why).
means(w, why).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
useranswer(Goal, Trace, Answer) :-
askable(Goal, _),
freshcopy(Goal, Copy),
useranswer(Goal, Copy, Trace, Answer, 1).
useranswer(Goal, _, _, _, N) :-
N > 1,
instantiated(Goal), !,
fail.
useranswer(Goal, Copy, _, Answer, _) :-
wastold(Copy, Answer, _),
instance_of(Copy, Goal), !.
useranswer(Goal, _, _, true, N) :-
wastold(Goal, true, M),
M >= N.
useranswer(Goal, Copy, _, Answer, _) :-
end_answers(Copy),
instance_of(Copy, Goal), !,
fail.
useranswer(Goal, _, Trace, Answer, N) :-
askuser(Goal, Trace, Answer, N).
askuser(Goal, Trace, Answer, N) :-
askable(Goal, ExternFormat),
format(Goal, ExternFormat, Question, [], Variables),
ask(Goal, Question, Variables, Trace, Answer, N).
ask(Goal, Question, Variables, Trace, Answer, N) :-
nl,
( Variables = [], !,
write('Is it true:')
;
write('Any (more) solution to:')
),
write(Question), write('?'),
getreply(Reply), !,
process(Reply, Goal, Question, Variables, Trace, Answer, N).
process(why, Goal, Question, Variables, Trace, Answer, N) :-
showtrace(Trace),
ask(Goal, Question, Variables, Trace, Answer, N).
process(yes, Goal, _, Variables, Trace, true, N) :-
nextindex(Next),
Next1 is Next + 1,
( askvars(Variables),
assertz(wastold(Goal, true, Next))
;
freshcopy(Goal, Copy),
useranswer(Goal, Copy, Trace, Answer, Next1)
).
process(no, Goal, _, _, _, false, N) :-
freshcopy(Goal, Copy),
wastold(Copy, true, _), !,
assertz(end_answers(Goal)),
fail
;
nextindex(Next),
assertz(wastold(Goal, false, Next)).
format(Var, Name, Name, Vars, [Var/Name | Vars]) :-
var(Var), !.
format(Atom, Name, Atom, Vars, Vars) :-
atomic(Atom), !,
atomic(Name).
format(Goal, Form, Question, Vars0, Vars) :-
Goal =..[Functor | Args1],
Form =..[Functor | Forms],
formatall(Args1, Forms, Args2, Vars0, Vars),
Question =..[Functor | Args2].
formatall([], [], [], Vars, Vars).
formatall([X | XL], [F | FL], [Q | QL], Vars0, Vars) :-
formatall(XL, FL, QL, Vars0, Vars1),
format(X, F, Q, Vars1, Vars).
askvars([]).
askvars([Variable/Name | Variables]) :-
nl, write(Name), write(' = '),
read(Variable),
askvars(Variables).
showtrace([]) :-
nl, write('This was you question'), nl.
showtrace([Goal by Rule | Trace]) :-
nl, write('To investigate, by'),
write(Rule), write(','),
write(Goal),
showtrace(Trace).
instantiated(Term) :-
numbervars(Term, 0, 0).
instance_of(Term, Term1) :-
freshcopy(Term1, Term2),
numbervars(Term2, 0, _), !,
Term = Term2.
freshcopy(Term, FreshTerm) :-
asserta(copy(Term)),
retract(copy(FreshTerm)), !.
nextindex(Next) :-
retract(lastindex(Last)), !,
Next is Last + 1,
assertz(lastindex(Next)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
present(Answer) :-
nl, showconclusion(Answer),
nl, write('Would you like to see how?'),
getreply(Reply),
( Reply = yes, !,
show(Answer)
;
true
).
showconclusion(Answer1 and Answer2) :- !,
showconclusion(Answer1), write('and '),
showconclusion(Answer2).
showconclusion(Conclusion was Found) :-
write(Conclusion).
show(Solution) :-
nl, show(Solution0), !.
show(Answer1 and Answer2, H) :- !,
show(Answer1, H),
tab(H), write(and), nl,
show(Answer2, H).
show(Answer was Found, H) :-
tab(H), writeans(Answer),
nl, tab(H),
write('was '),
show1(Found, H).
show1(Derived from Answer, H) :- !,
write(Derived), write('from'),
nl, H1 is H + 4,
show(Answer, H1).
show1(Found, _) :-
write(Found), nl.
writeans(Goal is true) :- !,
write(Goal).
writeans(Answer) :-
write(Answer).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Negate the current statement
not(P) :-
P, !, fail
;
true.
Thanks,
D
For people that are struggling with similar issues, I was able to work with the tutorial from amzi.com and George Luger's examples to come up with a working knowledge base / Expert System for the Farmer and Goat problem.
http://www.amzi.com/ExpertSystemsInProlog/xsiptop.php
http://www.cs.unm.edu/~luger/
http://www.cs.unm.edu/~luger/ai-final/code/
As this was the toughest part I am only posting the knowledge base.
rule((move(St1, Cu1) :-
(start(state(St1, St2, St3, St4)),
switch(state(St1, St2, St3, St4), state(Cu1, Cu2, Cu3, Cu4), [state(St1, St2, St3, St4)]))), 100).
start(state(east_side, east_side, east_side, east_side)).
end(state(west_side, west_side, west_side, west_side)).
switch(state(F1, G1, W1, C1), state(F2, G2, W2, C2), History) :-
is_end(state(F1, G1, W1, C1))
;
move_state(state(F1, G1, W1, C1), state(F2, G2, W2, C2)),
not(is_history(state(F2, G2, W2, C2), History)),
switch(state(F2, G2, W2, C2), state(F3, G3, W3, C3), [state(F2, G2, W2, C2)|History]).
move_state(state(X,X,W,C), state(Y,Y,W,C)) :-
opp(X,Y), not(unsafe(state(Y,Y,W,C))).
move_state(state(X,G,X,C), state(Y,G,Y,C)) :-
opp(X,Y), not(unsafe(state(Y,G,Y,C))).
move_state(state(X,G,W,X), state(Y,G,W,Y)) :-
opp(X,Y), not(unsafe(state(Y,G,W,Y))).
move_state(state(X,G,W,C), state(Y,G,W,C)) :-
opp(X,Y), not(unsafe(state(Y,G,W,C))).
opp(east_side, west_side).
opp(west_side, east_side).
unsafe(state(X, Y, Y, C)) :- opp(X, Y).
unsafe(state(X, Y, W, Y)) :- opp(X, Y).
is_end(state(F1, G1, W1, C1)) :-
end(state(Side1, Side2, Side3, Side4)),
Side1 == F1, Side2 == G1,
Side3 == W1, Side4 == C1.
is_history(state(F1, G1, W1, C1), []) :-
fail.
is_history(state(F1, G1, W1, C1), [HisHead|HisTail]) :-
state(F1, G1, W1, C1) == HisHead
;
is_history(state(F1, G1, W1, C1), HisTail).
% This has to be added if there are no ask-able questions otherwise the program will fail
askable(test).

Prolog - Recursive movement

I have made this prolog functions for a pacman game:
% I want this to return 0, 1, 2 or 3 to make a move.
other-moves([[Xpacman,Ypacman]], Listpellets, Listwall, Movepacman) :-
count_pellets_above(Listpellets,A),
count_pellets_bellow(Listpellets,B),
A > B,
repeat,
choose(4,2,Movepacman),
iswall(Xpacman,Ypacman,Movepacman,Listwall),
!.
other-moves([[Xpacman,Ypacman]], Listpellets, Listwall, Movepacman) :-
count_pellets_above(Listpellets,C),
count_pellets_bellow(Listpellets,D),
C =< D,
repeat,
choose(4,3,Movepacman),
iswall(Xpacman,Ypacman,Movepacman,Listwall),
!.
% verifies if the coordinate is a wall.
iswall(Xpacman, Ypacman, Random,Listwall) :-
Random==0,
X1 is Xpacman-1,
(member([X1,Ypacman], Listwall)),
!.
iswall(Xpacman, Ypacman, Random,Listwall) :-
Random==1,
X1 is Xpacman+1,
(member([X1,Ypacman],Listwall)),
!.
iswall(Xpacman, Ypacman, Random,Listwall) :-
Random==2,
Y1 is Ypacman-1,
(member([Xpacman,Y1],Listwall)),
!.
iswall(Xpacman, Ypacman, Random,Listwall) :-
Random==3,
Y1 is Ypacman+1,
(member([Xpacman,Y1],Listwall)),
!.
% gives a random number
choose(A, C, B) :-
repeat,
B is random(A),
B \= C,
!.
%count the number of pellets above the coordinate (0,0).
count_pellets_above([],0).
count_pellets_above([[_,Y]|T],N) :-
Y>=0,
count_pellets_above(T,M),
N is M+1,
!.
count_pellets_above([[_,Y]|T],N) :-
Y<0,
count_pellets_above(T,M),
N is M,
!.
% count the number of pellets bellow the coordinate (0,0).
count_pellets_bellow([],0).
count_pellets_bellow([[_,Y]|T],N) :-
Y=<0,
count_pellets_bellow(T,M),
N is M+1,
!.
count_pellets_bellow([[_,Y]|T],N) :-
Y>0,
count_pellets_bellow(T,M),
N is M,
!.
I want other-moves to return a number different from a move to a wall. I don't know why other-moves is returning false instead of a number when I make this command:
other-moves([[1,2]],[[]],[[1,3]],C).
Thanks.
other-moves isn't a valid Prolog identifier. It's parsed as
other - moves([[Xpacman,Ypacman]], Listpellets, Listwall, Movepacman)
so you're effectively defining - on the atom other and certain moves/4 terms.
Use an underscore instead of a dash.

Prolog: how can i count number in prolog?

if the goal can (5,3) the out put could be 5,4,3 this my code found big error
predicates
count(integer, integer)
clauses
count(X, Y) :- X > Y, write(3), !.
count(X < Y) :- X > Y, write(X), nl, X1 = X-1, count(X1, Y).
count(X,X):-write(X),nl.
count(X,Y):-X<Y,write(X),nl,X1 is X+1,count(X1,Y).

how to stochastic search n-queen in prolog?

i'm implement stochastic search in prolog.
code is
queens_rand([],Qs,Qs) :- !.
queens_rand(UnplacedQs,SafeQs,Qs) :-
random_sort(UnplacedQs, UnplacedQs1),
select(UnplacedQs,UnplacedQs1,Q),
not_attack(SafeQs,Q,1),
queens_rand(UnplacedQs1,[Q|SafeQs],Qs),
!.
queen_solve_rand(N) :-
alloc(1,N,Ns),
queens_rand(Ns,[], Q),
write(Q), nl.
random_sort([],_) :- !.
random_sort(_,[]) :- !.
random_sort(Xs, Ys) :-
length(Ys, L),
rnd_select(Xs,L, Ys),
write('Ys : '),write(Ys),nl.
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).
rnd_select(_,0,[]).
rnd_select(Xs,N,[X|Zs]) :- N > 0,
length(Xs,L),
I is random(L) + 1,
remove_at(X,Xs,I,Ys),
N1 is N - 1,
rnd_select(Ys,N1,Zs).
not_attack([],_,_) :- !.
not_attack([Y|Ys],X,N) :-
X =\= Y+N, X =\= Y-N,
N1 is N+1,
not_attack(Ys,X,N1).
select([X|Xs],Xs,X).
select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).
but it returns false. i can't understand prolog well, but i have to implement it. and i cant find where is wrong.
Yyou should remove this rule : random_sort(_,[]) :- !.. It means that whatever is the first arg, the result is [].

Resources