Problem in generating verses of a poem in prolog

Question

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.

Answer 1

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:

1. 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.
2. 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