Given a problem in Prolog,
In a lost-world language, a poem can have any number of verses, each of which takes the following form:
A B B C
D E E C
F F G
H I I C
where the same letter represents rhymed words. For example,
anun kura tama su
unuri bimo co kuru
sonen ariten sicom
kana te shime xanadu.
We have to generate a poem for a given no of verses.
My code
norhyme(X):- X="anun";X="unuri";X="sicom";X="kana".
pairrhyme(X,Y):-X="kura",Y="tama";
X="tama",Y="Kura";
X="bimo",Y="co";
X="co",Y="bimo";
X="sonen",Y="ariten";
X="ariten",Y="sonen";
X="te",Y="shime";
X="shime",Y="te";
X="su",Y="kuru";
X="kuru",Y="su";
X="kuru",Y="shanadu";
X="shanadu",Y="kuru";
X="su",Y="xanadu",
X="xanadu",Y="su".
triplerhyme(X,Y,Z):-X="su",Y="kuru",Z="xanadu".
generatepoem(0).
generatepoem(Y):- norhyme(A),pairrhyme(B,C),triplerhyme(D,E,F),
write(A),write(' '),write(B),write(' '),write(C),write(' '),write(D),nl,
norhyme(G),pairrhyme(H,I),
write(G),write(' '),write(H),write(' '),write(I),write(' '),write(E),nl,
pairrhyme(J,K),norhyme(L),
write(J),write(' '),write(K),write(' '),write(L),nl,
norhyme(M),pairrhyme(N,O),
write(M),write(' '),write(N),write(' '),write(O),write(' '),write(F), nl,
Y1 is Y-1,generatepoem(Y1).
Ideally the output should be
anun kura tama su
anun kura tama kuru
kura tama anun
anun kura tama xanadu
//as well as
anun kura tama su
anun tama kura kuru
bimo co anun
anun kuru su xanadu
//and all other possible combinations
However I don't get all the combinations and my program enters an infinite loop. What is the problem??
For more information,drop a comment below.
Here is a more stylish-correct version:
norhyme(anun).
norhyme(unuri).
norhyme(sicom).
norhyme(kana).
pairrhyme_one_way(kura,tama).
pairrhyme_one_way(bimo,co).
pairrhyme_one_way(sonen,ariten).
pairrhyme_one_way(te,shime).
pairrhyme_one_way(su,kuru).
pairrhyme_one_way(kuru,shanadu).
pairrhyme_one_way(su,xanadu).
pairrhyme(X,Y) :- pairrhyme_one_way(X,Y).
pairrhyme(X,Y) :- pairrhyme_one_way(Y,X).
triplerhyme(su,kuru,xanadu).
generatepoem(0).
generatepoem(Y):-
Y > 0,
norhyme(A),
pairrhyme(B,C),
triplerhyme(D,E,F),
format("~a ~a ~a ~a~n",[A,B,C,D]),
norhyme(G),
pairrhyme(H,I),
format("~a ~a ~a ~a~n",[G,H,I,E]),
pairrhyme(J,K),
norhyme(L),
format("~a ~a ~a~n",[J,K,L]),
norhyme(M),
pairrhyme(N,O),
format("~a ~a ~a ~a~n",[M,N,O,F]),
Y1 is Y-1,
% If we "cut" here, we will always choose the same solution...
generatepoem(Y1).
Even better would be to build a list of lines via generatepoem and output it once instead of performing side-effects "during the proof search".
Note the following:
For generatepoem/1 we succeed with no further side-effects if the argument is 0, and we perform further side-effects otherwise. However, the "otherwise" case is guarded by Y > 0. If we don't do that, the proof search succeeds on the base case 0 and there is another solution where generatepoem(0) performs side-effects, then calls itself with -1, -2, -3 ... ad infinitum.
The solution does not commit to the choices made in a passage through generatepoem/1 because we don't "cut" at the place where I put the comment. SO through backtracking, we will eventually generate all possible poems, but that is not really interesting. Better to select a poem at random...
Change the code to construct a solution and then output once
Solving the uglyness of a spray of format/2 calls first:
generatepoem([],0).
generatepoem([[A,B,C,D],[G,H,I,E],[J,K,L],[M,N,O,F]|More],Y):-
Y > 0,
norhyme(A),
pairrhyme(B,C),
triplerhyme(D,E,F),
norhyme(G),
pairrhyme(H,I),
pairrhyme(J,K),
norhyme(L),
norhyme(M),
pairrhyme(N,O),
Y1 is Y-1,
generatepoem(More,Y1).
dump([]) :- !.
dump([[A,B,C,D]|More]) :-
!,
format("~a ~a ~a ~a~n",[A,B,C,D]),
dump(More).
dump([[A,B,C]|More]) :-
format("~a ~a ~a~n",[A,B,C]),
dump(More).
Note the cuts in the bodies of dump/2 to tell Prolog there are no alternative solutions (SWI-Prolog doesn't see that by itself).
The stream of poems can now be generated through:
?- generatepoem(L,2),dump(L).
Change the code to construct a solution randomly (although we can't backtrack)
This is done by harnessing the power of bagof/3 and random_between/3 (the latter eminently a non-logic predicate):
When all is said and done:
norhyme(anun).
norhyme(unuri).
norhyme(sicom).
norhyme(kana).
pairrhyme_one_way(kura,tama).
pairrhyme_one_way(bimo,co).
pairrhyme_one_way(sonen,ariten).
pairrhyme_one_way(te,shime).
pairrhyme_one_way(su,kuru).
pairrhyme_one_way(kuru,shanadu).
pairrhyme_one_way(su,xanadu).
pairrhyme(X,Y) :- pairrhyme_one_way(X,Y).
pairrhyme(X,Y) :- pairrhyme_one_way(Y,X).
triplerhyme(su,kuru,xanadu).
% we need a 1-arg equivalent to pairrhyme/2
pairrhyme_tuple([X,Y]) :- pairrhyme_one_way(X,Y).
pairrhyme_tuple([X,Y]) :- pairrhyme_one_way(Y,X).
% non-backtrackably select a random element from a list
randomly_select(List,Element) :-
length(List,Length),
MaxIndex is Length-1,
random_between(0,MaxIndex,Index), % fails if MaxIndex < 0, i.e. if List is empty
nth0(Index,List,Element).
% non-backtrackably select a random solution of Goal
% this works because our Goals do not generate all that many solutions
random_solution(Goal,Element) :-
bagof(X,call(Goal,X),Bag), % fails if there is no solution
randomly_select(Bag,Element).
% an equivalent of nohryme/1 which non-backtrackably selects a random solution
norhyme_randomly(X) :- random_solution(norhyme,X).
% an equivalent of pairrhyme/2 which non-backtrackably selects a random solution
pairrhyme_randomly(X,Y) :- random_solution(pairrhyme_tuple,[X,Y]).
% an equivalent of generatepoen/2 which non-backtrackably selects a random solution
generatepoem_randomly([],0).
generatepoem_randomly([[A,B,C,D],[G,H,I,E],[J,K,L],[M,N,O,F]|More],Y):-
Y > 0,
norhyme_randomly(A),
pairrhyme_randomly(B,C),
triplerhyme(D,E,F),
norhyme_randomly(G),
pairrhyme_randomly(H,I),
pairrhyme_randomly(J,K),
norhyme_randomly(L),
norhyme_randomly(M),
pairrhyme_randomly(N,O),
Y1 is Y-1,
generatepoem_randomly(More,Y1).
dump([]) :- !.
dump([[A,B,C,D]|More]) :-
!,
format("~a ~a ~a ~a~n",[A,B,C,D]),
dump(More).
dump([[A,B,C]|More]) :-
format("~a ~a ~a~n",[A,B,C]),
dump(More).
And so:
?- generatepoem_random(L,2),dump(L).
unuri shime te su
sicom sonen ariten kuru
ariten sonen unuri
anun kura tama xanadu
kana shime te su
unuri su xanadu kuru
te shime sicom
kana su xanadu xanadu
Related
If an integers is defined like this in Prolog:
nat(0).
nat(s(X)) :- nat(X).
How do I convert such a number to a decimal number?
The input is for example:
s(s(s(0)))
I probably should add that I am very new to Prolog.
EDIT:
I tried it this way:
nat(0).
nat(s(X)) :- nat(X).
convert(N, C) :-
C is C + 1,
nat(N),
convert(N, C).
There are basically two cases you need to cover:
the base case 0 that maps on 0; and
the recursive case s(X) that makes use of the result for X.
The base case thus looks like:
convert(0, 0).
the recursive case thus looks like:
convert(S(X), N) :-
convert(X, N1),
….
where … is thus a step you need to do to determine N given N1. I leave this as an exercise.
I want to define facts which are true both ways (They all have an arity of 2). I had success with a fact expressing the relationship "opposite" this way:
oppositeDeclare(plus, minus).
opposite(X, Y) :- oppositeDeclare(Y, X).
opposite(X, Y) :- oppositeDeclare(X, Y).
I'm trying to make a simple equation solver, and I would also like to define that if A=B then B=A. I can't just write:
equal(A, B):-equal(B,A).
because I get out of local stack error. However I can't do the same as I did with the "opposite" fact because "equal" needs to work based on the some rules. ("opposite" got it's input from facts only).
Is there a way I can avoid defining all the rules for "equal" twice?
Edit:
I only want to declare simple mathematical facts to see if I can use Prolog to solve other more complicated tasks where I don't know the mechanism for the solution only simple facts.
So far I have used equal/2 to define things like: if A=B+C, then C=A-B. I want to define equal/2 two ways so that I don't have to define if B+C=A, then A-B=C. Ideally after the new rule it could solve an equation for c like this: a=(b+c)/d -> b+c=a/d -> c=(a/d)-b.
The reason I can't use swap is because I have recursive rules for equal/2.
Bear in mind that it will not always work even for simple equations, because not all necessary facts are defined.
Here's the current program with a query:
5 ?- equal(v, X).
X = opr(s, per, t)
% operators: per, times, plus, minus
% equation(LHS, RHS): used to declare physics equations
% equal(LHS, RHS): checks equality in a query
equation(s, opr(v, times, t)). % s=v*t
equation(a, opr(opr(b, plus, c), per, d)). % a=(b+c)/d
oppositeDeclare(plus, minus).
oppositeDeclare(per, times).
opposite(X, Y) :- oppositeDeclare(Y, X).
opposite(X, Y) :- oppositeDeclare(X, Y).
equal(R, opr(A, O, B)) :- equation(R, opr(A, O, B)).
% if there's an equation R=A O B , then R = A O B, where O is an operator (+-*/)
equal(A, opr(R, OY, B)) :- equal(R, opr(A, OX, B)), opposite(OY, OX).
%declaring in one go: if R=A/B then A=R*B, if R=A-B then A=R+B, if R=A+B then A=R-B, if R=A-B then A=R+B
I am not sure I understand you correctly, but aren't you after this simple code?
equal(X, X).
Could you please show some sample input and output that you would like to achieve by using equal/2?
And about opposites, I would write this that way:
oppositeDeclare(plus, minus).
oppositeDeclare(good, evil).
oppositeDeclare(windows, linux).
swap(P, X, Y) :- permutation([X,Y], [X1,Y1]), call(P, X1, Y1).
opposite(X, Y) :- swap(oppositeDeclare, X, Y).
Anytime you would like to use predicate with arity 2 and try swapping arguments, you can use swap/3 in a way presented above.
I am studying Prolog for an universitary exame and I have some problem with the following exercise.
I have the following classic solution of 8-Queens problem (and this is not a problem for me), Modifying this solution I have to create a new solution for the more generic n-Queens problem that handle a variable number of queens.
solution([]).
solution([X/Y|Others]) :- solution(Others),
member(Y,[1,2,3,4,5,6,7,8]),
noattack(X/Y, Others).
noattack(_,[]).
noattack(X/Y, [X1/Y1 | Others]) :-
Y =\= Y1, % Q e Q1 sono su righe diverse
% Q e Q1 sono su diagonali diverse:
Y1-Y =\= X1-X,
Y1-Y =\= X-X1,
% Q non attacca regine nella sottolista Others:
noattack( X/Y, Others).
% TEMPLATE DELLE SOLUZIONI: c'è una regina su ogni colonna:
template([1/Y1,2/Y2,3/Y3,4/Y4,5/Y5,6/Y6,7/Y7,8/Y8]).
Ok, this program look pretty simple: I have a list of queen that have that they must not attack each other.
If the list of queen is empty there is not the possibility that a queen attack another queen in the list, so the empty list is a solution of the problem (it is the base case of the solution)
*If the list of queen is not empty I can divide it into [X/Y|Others] where X/Y rappresent position on the board of the first queen in the list *(the position is rappresentend by the couple (X,Y) where X is the column and Y the line)
So, it is TRUE that the list [X/Y|Others] is a SOLUTION of the problem if the following relations are true:
The sublist Others is itself a solution (Others don't contain queen that attack some other queen in the list)
Y belongs belongs to an integer value between 1 and 8 (because I have 8 line)
The first queen of the list don't attacck the others queens in the sublist Others
Then it is defined the noattack relation that specify when I can say that it is true that a queen don't attack another queen (this is pretty simple: they can't stay on the same line, on the same column, on the same diagonal)
Finally I have a solution template that simplify my life constraining the X value with value from 1 to 8 (because I know that 2 queens can't stay on the same columns...so every queen in the solution stay on a different column from all others queens)
So I think that the biggest problem it is on the line in which I specify the number of columns:
member(Y,[1,2,3,4,5,6,7,8])
and on the line in which I define the solution template:
template([1/Y1,2/Y2,3/Y3,4/Y4,5/Y5,6/Y6,7/Y7,8/Y8]).
I have no idea about how to extend the previous solution to handle a variable number of queens.
seems easy, passing around the size:
solution(_, []).
solution(N, [X/Y|Others]) :-
solution(N, Others),
between(1, N, Y),
noattack(X/Y, Others).
noattack(_,[]).
noattack(X/Y, [X1/Y1 | Others]) :-
Y =\= Y1, % Q e Q1 sono su righe diverse
Y1-Y =\= X1-X, % Q e Q1 sono su diagonali diverse
Y1-Y =\= X-X1,
noattack( X/Y, Others). % Q non attacca regine nella sottolista Others
% TEMPLATE DELLE SOLUZIONI: c'è una regina su ogni colonna:
template(N, L) :-
findall(I/_, between(1,N,I), L).
test:
?- N=6, template(N, L), solution(N, L).
N = 6,
L = [1/5, 2/3, 3/1, 4/6, 5/4, 6/2] ;
N = 6,
L = [1/4, 2/1, 3/5, 4/2, 5/6, 6/3] ;
N = 6,
L = [1/3, 2/6, 3/2, 4/5, 5/1, 6/4] ;
N = 6,
L = [1/2, 2/4, 3/6, 4/1, 5/3, 6/5] ;
false.
(I should draw it to say if it's ok...)
I have the following task:
Write a method that will add two polynoms. I.e 0+2*x^3 and 0+1*x^3+2*x^4 will give 0+3*x^3+2*x^4.
I also wrote the following code:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
(
B1=B2,
B3 = B2,
A3 is A1+A2,
add_poly(P1,P2,P3)
;
B1<B2,
B3=B1,
A3=A1,
add_poly(P1,+A2*x^B2+P2,P3)
;
B1>B2,
B3=B2,
A3=A2,
add_poly(+A1*x^B1+P1,P2,P3)
).
add_poly(X+P1,Y+P2,Z+P3):-
Z is X+Y,
add_poly(P1,P2,P3).
My problem is that I don't know how to stop. I would like to stop when one the arguments is null and than to append the second argument to the third one. But how can I check that they are null?
Thanks.
Several remarks:
Try to avoid disjunctions (;)/2 in the beginning. They need special indentation to be readable. And they make reading a single rule more complex — think of all the extra (=)/2 goals you have to write and keep track of.
Then, I am not sure what you can assume about your polynomials. Can you assume they are written in canonical form?
And for your program: Consider the head of your first rule:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
I will generalize away some of the arguments:
add_poly(+A1*x^B1+P1,_,_):-
and some of the subterms:
add_poly(+_+_,_,_):-
This corresponds to:
add_poly(+(+(_),_),_,_) :-
Not sure you like this.
So this rule applies only to terms starting with a prefix + followed by an infix +. At least your sample data did not contain a prefix +.
Also, please remark that the +-operator is left associative. That means that 1+2+3+4 associates to the left:
?- write_canonical(1+2+3+4).
+(+(+(1,2),3),4)
So if you have a term 0+3*x^3+2*x^4 the first thing you "see" is _+2*x^4. The terms on the left are nested deeper.
For your actual question (how to stop) - you will have to test explicitly that the leftmost subterm is an integer, use integer/1 - or maybe a term (*)/2 (that depends on your assumptions).
I assume that polynomials you are speaking of are in 1 variable and with integer exponents.
Here a procedure working on normal polynomial form: a polynomial can be represented as a list (a sum) of factors, where the (integer) exponent is implicitly represented by the position.
:- [library(clpfd)].
add_poly(P1, P2, Sum) :-
normalize(P1, N1),
normalize(P2, N2),
append(N1, N2, Nt),
aggregate_all(max(L), (member(M, Nt), length(M, L)), LMax),
maplist(rpad(LMax), Nt, Nn),
clpfd:transpose(Nn, Tn),
maplist(sumlist, Tn, NSum),
denormalize(NSum, Sum).
rpad(LMax, List, ListN) :-
length(List, L),
D is LMax - L,
zeros(D, Z),
append(List, Z, ListN).
% the hardest part is of course normalization: here a draft
normalize(Ts + T, [N|Ns]) :-
normalize_fact(T, N),
normalize(Ts, Ns).
normalize(T, [N]) :-
normalize_fact(T, N).
% build a list with 0s left before position E
normalize_fact(T, Normal) :-
fact_exp(T, F, E),
zeros(E, Zeros),
nth0(E, Normal, F, Zeros).
zeros(E, Zeros) :-
length(Zeros, E),
maplist(copy_term(0), Zeros).
fact_exp(F * x ^ E, F, E).
fact_exp(x ^ E, 1, E).
fact_exp(F * x, F, 1).
fact_exp(F, F, 0).
% TBD...
denormalize(NSum, NSum).
test:
?- add_poly(0+2*x^3, 0+1*x^3+2*x^4, P).
P = [0, 0, 0, 3, 2]
the answer is still in normal form, denormalize/2 should be written...
I came across this natural number evaluation of logical numbers in a tutorial and it's been giving me some headache:
natural_number(0).
natural_number(s(N)) :- natural_number(N).
The rule roughly states that: if N is 0 it's natural, if not we try to send the contents of s/1 back recursively to the rule until the content is 0, then it's a natural number if not then it's not.
So I tested the above logic implementation, thought to myself, well this works if I want to represent s(0) as 1 and s(s(0)) as 2, but I´d like to be able to convert s(0) to 1 instead.
I´ve thought of the base rule:
sToInt(0,0). %sToInt(X,Y) Where X=s(N) and Y=integer of X
So here is my question: How can I convert s(0) to 1 and s(s(0)) to 2?
Has been answered
Edit: I modified the base rule in the implementation which the answer I accepted pointed me towards:
decode(0,0). %was orignally decode(z,0).
decode(s(N),D):- decode(N,E), D is E +1.
encode(0,0). %was orignally encode(0,z).
encode(D,s(N)):- D > 0, E is D-1, encode(E,N).
So I can now use it like I wanted to, thanks everyone!
Here is another solution that works "both ways" using library(clpfd) of SWI, YAP, or SICStus
:- use_module(library(clpfd)).
natsx_int(0, 0).
natsx_int(s(N), I1) :-
I1 #> 0,
I2 #= I1 - 1,
natsx_int(N, I2).
No problemo with meta-predicate nest_right/4 in tandem with
Prolog lambdas!
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
:- meta_predicate nest_right(2,?,?,?).
nest_right(P_2,N,X0,X) :-
zcompare(Op,N,0),
ord_nest_right_(Op,P_2,N,X0,X).
:- meta_predicate ord_nest_right_(?,2,?,?,?).
ord_nest_right_(=,_,_,X,X).
ord_nest_right_(>,P_2,N,X0,X2) :-
N0 #= N-1,
call(P_2,X1,X2),
nest_right(P_2,N0,X0,X1).
Sample queries:
?- nest_right(\X^s(X)^true,3,0,N).
N = s(s(s(0))). % succeeds deterministically
?- nest_right(\X^s(X)^true,N,0,s(s(0))).
N = 2 ; % succeeds, but leaves behind choicepoint
false. % terminates universally
Here is mine:
Peano numbers that are actually better adapted to Prolog, in the form of lists.
Why lists?
There is an isomorphism between
a list of length N containing only s and terminating in the empty list
a recursive linear structure of depth N with function symbols s
terminating in the symbol zero
... so these are the same things (at least in this context).
There is no particular reason to hang onto what 19th century mathematicians
(i.e Giuseppe Peano )
considered "good structure structure to reason with" (born from function
application I imagine).
It's been done before: Does anyone actually use Gödelization to encode
strings? No! People use arrays of characters. Fancy that.
Let's get going, and in the middle there is a little riddle I don't know how to
solve (use annotated variables, maybe?)
% ===
% Something to replace (frankly badly named and ugly) "var(X)" and "nonvar(X)"
% ===
ff(X) :- var(X). % is X a variable referencing a fresh/unbound/uninstantiated term? (is X a "freshvar"?)
bb(X) :- nonvar(X). % is X a variable referencing an nonfresh/bound/instantiated term? (is X a "boundvar"?)
% ===
% This works if:
% Xn is boundvar and Xp is freshvar:
% Map Xn from the domain of integers >=0 to Xp from the domain of lists-of-only-s.
% Xp is boundvar and Xn is freshvar:
% Map from the domain of lists-of-only-s to the domain of integers >=0
% Xp is boundvar and Xp is boundvar:
% Make sure the two representations are isomorphic to each other (map either
% way and fail if the mapping gives something else than passed)
% Xp is freshvar and Xp is freshvar:
% WE DON'T HANDLE THAT!
% If you have a freshvar in one domain and the other (these cannot be the same!)
% you need to set up a constraint between the freshvars (via coroutining?) so that
% if any of the variables is bound with a value from its respective domain, the
% other is bound auotmatically with the corresponding value from ITS domain. How to
% do that? I did it awkwardly using a lookup structure that is passed as 3rd/4th
% argument, but that's not a solution I would like to see.
% ===
peanoify(Xn,Xp) :-
(bb(Xn) -> integer(Xn),Xn>=0 ; true), % make sure Xn is a good value if bound
(bb(Xp) -> is_list(Xp),maplist(==(s),Xp) ; true), % make sure Xp is a good value if bound
((ff(Xn),ff(Xp)) -> throw("Not implemented!") ; true), % TODO
length(Xp,Xn),maplist(=(s),Xp).
% ===
% Testing is rewarding!
% Run with: ?- rt(_).
% ===
:- begin_tests(peano).
test(left0,true(Xp=[])) :- peanoify(0,Xp).
test(right0,true(Xn=0)) :- peanoify(Xn,[]).
test(left1,true(Xp=[s])) :- peanoify(1,Xp).
test(right1,true(Xn=1)) :- peanoify(Xn,[s]).
test(left2,true(Xp=[s,s])) :- peanoify(2,Xp).
test(right2,true(Xn=2)) :- peanoify(Xn,[s,s]).
test(left3,true(Xp=[s,s,s])) :- peanoify(3,Xp).
test(right3,true(Xn=3)) :- peanoify(Xn,[s,s,s]).
test(f1,fail) :- peanoify(-1,_).
test(f2,fail) :- peanoify(_,[k]).
test(f3,fail) :- peanoify(a,_).
test(f4,fail) :- peanoify(_,a).
test(f5,fail) :- peanoify([s],_).
test(f6,fail) :- peanoify(_,1).
test(bi0) :- peanoify(0,[]).
test(bi1) :- peanoify(1,[s]).
test(bi2) :- peanoify(2,[s,s]).
:- end_tests(peano).
rt(peano) :- run_tests(peano).