/*  MASTERMIND.PL  */


/****************************************************************/
/*                                                              */
/*                          Mastermind                          */
/*                                                              */
/*     Reference: Emde, M.v., Relational Programming,           */
/*                Research Report, CS-78-48, DCS, Univ. of      */
/*                Waterloo, Canada, 1978                        */
/*                                                              */
/*     also in:   Coelho, H., Cotta, J.C., Prolog by Example,   */
/*                Symbolic Computation, Springer-Verlag,        */
/*                Berlin, 1988.                                 */
/*                                                              */
/*     reimplemented by Herbert Koenig and Thomas Hoppe 1983    */
/*                                                              */
/*                 Technical University of Berlin               */
/*                  Faculty for Computer Science                */
/*                                                              */
/* Description: This program implements the game of mastermind. */
/*              either the user or the program tries to break   */
/*              the hidden color code, consisting of the colors */
/*              black, blue, red, green, yellow, white. The     */
/*              result of a guess (black, a color is at the     */
/*              right position; white, a color occurs in the    */
/*              code) are internally represented as successors  */
/*              of 0. This could be extended to handle integers.*/
/*              If the programm guesses, a simple but powerful  */
/*              generate-and-test procedure is used, where the  */
/*              scores of previous attempts are used as the test*/
/*              criterion.                                      */
/*                                                              */
/* Changes: We have slightly modified the internal represen-    */
/*          tation and the predicate names, documented the main */
/*          routines and have changed the output routines.      */
/*                                                              */
/****************************************************************/
/* 'play' is the toplevel goal for invocation of the system.    */
/* The input of color codes has to be a list of four elements   */
/* containing the atomic colors.                                */
/****************************************************************/

/****************************************************************/
/* This is some M-, C-, and YAP-Prolog specific stuff.          */
/****************************************************************/
:- dynamic code/1.
:- dynamic random/1.

/****************************************************************/
/* operator: 's' is used for the internal representation of the */
/*               black and white scores.                        */
/****************************************************************/
:- op(150,fy,s).

/****************************************************************/
/* Interface to the user.                                       */
/****************************************************************/

play :-
    nl,
    abolish(random,1),
    abolish(code,1),
    write('Mastermind at your service !'), nl, nl,
    write('Color codes should be entered as Prolog list '),
    write('with four elements.'), nl, nl,
        write('Enter an Integer between 0 and 164: '),
        read(RandomSeed), nl,
        assert(random(RandomSeed)),
        game_loop.

game_loop :-
    write('Do you want to break the code (y/n)? '),
    read(Answer), nl,
    game(Answer).

terminatep :-
    write('Another game (y/n)? '),
    read(Answer), nl,
    next_game(Answer).

next_game(y) :-
    !, game_loop.
next_game(n) :-
    retract(random(_)),
    write('Mastermind was pleased to serve you.'),
        nl.

/****************************************************************/
/* Player gives Code, which has to be guessed by mastermind !   */
/****************************************************************/
game(n) :-
    write('Please enter color code, I promise not to look: '),
        read([C1,C2,C3,C4]), nl,
    assert(code([C1,C2,C3,C4])),
        guess(Code),
        write('First try is:'), put(9),
    write_code(Code), put(9),
        evaluate(Code,Score),
        put(9), write_score(Score), nl,
    extend_code([(Code,Score)]),
        retract(code(_)),
        !,
    terminatep.

/****************************************************************/
/* If the code is guessed, i.e. all positions have the correct  */
/* color, we can terminate the recursion.                       */
/****************************************************************/
extend_code([(Code,s s s s _,_)|_]) :-
    nl, write('The hidden code must be:'), put(9),
    write_code(Code), nl, nl.

/****************************************************************/
/* 'extend_code' extends the list of codes for every trial with */
/* a new code.                                                  */
/****************************************************************/
extend_code(CodeList) :-
    code_possible(CodeList,NewTry),
    write('Next try is:'), put(9),
    write_code(NewTry), put(9),
    evaluate(NewTry,Score),
        put(9), write_score(Score), nl,
        extend_code([(NewTry,Score)|CodeList]).

write_code([Color]) :-
    write(Color).
write_code([Color|Colors]) :-
    write(Color), put(9),
    write_code(Colors).

write_score((Black,White)) :-
    count(Black,B),
    count(White,W),
    write('Black:'), write(' '), write(B), write(' '),
    write('White:'), write(' '), write(W).

count(0,0).
count(s(Ss),Y) :-
    count(Ss,X),
    Y is X + 1.

/****************************************************************/
/* 'code_possible' computes through 'mm' from the first try in  */
/* the CodeList a NewTry which isn't inconsistent with the      */
/* first Score. Of course, this NewTry must also be consistent  */
/* with the rest of the CodeList. Thus, we proceed with         */
/* recursion until we have processed all the codes.             */
/****************************************************************/
code_possible([],_).
code_possible([(FirstTry,FirstScore)|CodeList],NewTry) :-
     mm(FirstTry,NewTry,FirstScore),
     code_possible(CodeList,NewTry).

/****************************************************************/
/* Player tries to guess the code.                              */
/****************************************************************/
game(y) :-
    guess(Code),
        assert(code(Code)),
        put(9), put(9), put(9),
    write('Enter first try: '), put(9),
        read([C1,C2,C3,C4]),
    evaluate([C1,C2,C3,C4],Score),
        finished(Score),
        !, terminatep.

/****************************************************************/
/* If the guess of the user evaluates to 'all colors are on the */
/* right positions', we can finish. Otherwise we ask for another*/
/* Try or give the user the opportunity to quit.                */
/****************************************************************/
finished((s s s s _,_)) :-
    nl,
    write('You got it!'), nl, nl,
    retract(code(_)).
finished(Score) :-
    write_score(Score), put(9),
        write('Enter try or quit:'), put(9),
    read(Answer),
    proceedp(Answer).

/****************************************************************/
/* If the user quits we show him/her the code, otherwise we     */
/* evaluate his new try.                                        */
/****************************************************************/
proceedp(quit) :-
    retract(code(Code)), nl, nl,
    write('The hidden code is: '),  put(9),
    write_code(Code), nl, nl.
proceedp(Try) :-
    evaluate(Try,Score),
    finished(Score) .

/****************************************************************/
/* For evaluating a try we pick up the hidden code stored in the*/
/* database and pass it to the function 'mm', which computes the*/
/* Score.                                                       */
/****************************************************************/
evaluate(Try,Score) :-
    clause(code(HiddenCode),true),
    mm(Try,HiddenCode,Score).

/****************************************************************/
/* 'mm' is our work-horse, first we determine the number of     */
/* 'black pins which we have to set on the board'. ReducedTry   */
/* and ReducedCode are the remaining colors and unused          */
/* 'pinholes'.                                                  */
/* If the HiddenCode is uninstantiated, 'determine_blacks'      */
/* looks for the first code, which could produce the Score,     */
/* if one is found 'determine_whites' will check whether the    */
/* remaining colors correspond to the white Score. If so the    */
/* NextTry is determined. Otherwise, we backtrack to the next   */
/* possible combination producing the black score, and continue */
/* as before.                                                   */
/****************************************************************/
mm(Try,HiddenCode,(Black,White)) :-
    determine_blacks(Try,HiddenCode,ReducedTry,ReducedCode,Black),
    determine_whites(ReducedTry,ReducedCode,White,ReducedCode).

/****************************************************************/
/* If we have processed all positions, we have 0 blacks and     */
/* initialize ReducedTry and ReducedCode. Otherwise if there is */
/* the color in the Try and the Code in the same position, we   */
/* increment the counter for the blacks. We forget in ReducedTry*/
/* and ReducedCode the corresponding color information. Other-  */
/* wise, if the colors are different at the same position, we   */
/* have to keep the color information.                          */
/****************************************************************/
determine_blacks([],[],[],[],0).
determine_blacks([Color|Try],[Color|Code],ReducedTry,ReducedCode,s Black) :-
    determine_blacks(Try,Code,ReducedTry,ReducedCode,Black).
determine_blacks([Color1|Try],[Color2|Code],
         [Color1|ReducedTry],[Color2|ReducedCode],Black) :-
    color(_,Color1), color(_,Color2),
    \+(Color1 == Color2),
    determine_blacks(Try,Code,ReducedTry,ReducedCode,Black).

/****************************************************************/
/* 'Determine_whites' tries to delete the Colors of the Try from*/
/* the Code, if this succeeds we can increment the counter for  */
/* the whites. If we reach the end and still have some colors in*/
/* the code table, we determine over 'tuple' a ????             */
/****************************************************************/
determine_whites([],Code,0,NewTry) :-
    tuple(Code,NewTry).
determine_whites([Color|Try],Code, s White,[UnboundColor|NewTry]) :-
        delete(Color,Code,ReducedCode,NewTry),
        determine_whites(Try,ReducedCode,White,NewTry).
determine_whites([Color|Try],Code,White,NewTry) :-
        not_in(Color,Code,NewTry),
        determine_whites(Try,Code,White,NewTry).

/****************************************************************/
/* The following is the random code generator                   */
/****************************************************************/
guess([C1,C2,C3,C4]) :-
    randomcolor(C1),
    randomcolor(C2),
    randomcolor(C3),
    randomcolor(C4) .

randomcolor(Color) :-
    randomnumber(X),
        Y is (X mod 6) + 1,
    color(Y,Color).

randomnumber(R) :-
    random(R),
    retract(random(_)),
        NR is ((R * 125) + 1) mod 165,
        assert(random(NR)).

color(1,black).
color(2,blue).
color(3,green).
color(4,red).
color(5,white).
color(6,yellow).

/*********************************************************************/
/* 'delete' deletes U from the second argument, if it occurs in the  */
/* head it and returns over tuple the rest of the original codelist  */
/* Ms. Otherwise, if U and the head are different, we search the rest*/
/* of the codelist.                                                  */
/*********************************************************************/
delete(U,[U|Y],Y,Ms) :-
    tuple(Y,Ms).
delete(U,[V|Y],[V|Y1],[_|Ms]) :-
    color(_,U), color(_,V),
    \+(U == V),
    delete(U,Y,Y1,Ms).

/*********************************************************************/
/* If U is not in V, 'not_in' will succeed.                          */
/*********************************************************************/
not_in(_,[],[]).
not_in(U,[V|Vs],[_|Ws]) :-
    color(_,U), color(_,V),
    \+(U == V),
    not_in(U,Vs,Ws).

tuple([],[]).
tuple([U|Us],[_|Vs]) :-
    color(_,U),
    tuple(Us,Vs).
