crds@ncoast.UUCP (Glenn A. Emelko) (01/08/88)
/*
Written Jan. 6, 1988, posted Jan. 7 1988. I hope this performs bug free
on your system too, I did have to hand edit the file to remove the ^M's
from the ends of each lines, so there may be a period or comma missing
somewhere, please bear with me. Any improvements to this code would most
certainly be welcome, you can mail them to me at:
...!ihnp4!cbosgd!mandrill!hal!ncoast!crds (crds is my login)
I think you'll find that it solves most simple problems with only a 3
number sequence, such as "2 4 8" returns 16, and "3 5 7" returns 9. If
it doesn't, give it more numbers in the sequence. It really surprised
me a couple of times, too. For example, it does solve the following:
Sequence is: 1 4 2 5 3 and it guesses 6, which is correct.
Well, anyhow, have fun. It will look for other solutions if you say it
is wrong, and if none are found, it gives up. The main goal of the
program is "play", which will "guess" over and over again.
Glenn
(crds@ncoast.UUCP)
*/
/* Guess Numbers And Test (GNAT) -- A number sequence guessing game. */
/* Version 1.0 in Turbo Prolog (c) Copyright 1988 by Glenn A. Emelko */
/* All Rights Reserved. This is a published work specifically given */
/* to the general public by the author for free, and all use of this */
/* code in whole or in part must carry on this spirit of profit-free */
/* proliferation of good ideas; whether or not this individual piece */
/* of programming can be considered a good idea is beside the point. */
domains
input=string
number=integer
sequence=number* /* sequence is a set of numbers */
database
used(number) /* keep track of gueses */
predicates
repeat /* standard repeat clause */
play /* play the game */
guess /* actually solve a problem */
startover /* reset database */
parse(string,sequence) /* ascii input into set form */
solve(sequence,number) /* solve for the GNAT test */
same(sequence,number) /* true if all #'s are same */
sums(sequence,number) /* find sums in sequences */
prods(sequence,number) /* find products in sequences */
diff(sequence,sequence) /* find diff sequences in seq's */
quo(sequence,sequence) /* find quotient seq's in seq's */
last(sequence,number) /* get last item in sequence */
chkyn(char) /* valid responses */
clauses
/* repeat -- simple, multi-execution loop with easy system cleanup and
tracking */
repeat.
repeat:-repeat.
/* play -- To play the game, keep guessing forever */
play:-
repeat, /* always succeed */
guess, /* play a round */
fail. /* always fail */
/* guess -- to play a round, reset the database, ask for the
sequence, form a hypothesis, ask about it, and go on until
you get it right or you don't see the pattern */
guess:-
startover, /* reset used list */
write("\nEnter a sequence of numbers: "),
readln(Input),
parse(Input,Problem),
solve(Problem,Guess),
not(used(Guess)), /* check if used */
assert(used(Guess)), /* no, guess and set*/
write("\nI guess the next number is ",Guess),
write(". Right? "),
readchar(Response),
chkyn(Response),
write("\nYeah!\n\n"),
!. /* done is true */
guess:-
write("\nI don't see your pattern.\n\n"),
!. /* done is true */
/* startover -- retract all "used" database entries */
startover:-retract(used(_)),startover,!.
startover:-!.
/* parse -- break up a string into an integer list, ignoring white
space, commas, and handling negative numbers properly */
parse("",[]). /* null string is null set */
parse(String,A):- /* ignore commas */
frontchar(String,',',Rstring),
parse(Rstring,A).
parse(String,A):- /* ignore spaces */
frontchar(String,' ',Rstring),
parse(Rstring,A).
parse(String,[Next1|Rest]):- /* handle negative numbers */
frontchar(String,'-',Rstring),
fronttoken(Rstring,Token1,Rstring1),
str_int(Token1,Next),
Next1=0-Next,
parse(Rstring1,Rest),
!.
parse(String,[Next|Rest]):- /* handle normal numbers */
fronttoken(String,Token,Rstring),
str_int(Token,Next),
parse(Rstring,Rest),
!.
/* solve -- to solve a problem, look for sums, products, or matches
in the list of numbers until a valid hypothesis is generated*/
solve(L,N):- /* look for match -- all items same */
same(L,N).
solve(L,N):- /* look for sums -- scan for pattern*/
sums(L,N).
solve(L,N):-
prods(L,N). /* look at prods -- scan for pattern*/
/* same -- a list is all the same if two or more items are identical,
if they differ by one (special case for two item patterns,
allows the inference if two numbers split by one, then the
third shall in the same direction, thus giving the program the
ability to "guess" when no pattern has been found if there is
one which seems reasonably close) */
same([N,N],N). /* two the same, return **key** */
same([N,O],P):- /* look for "close" patterns */
O=N+1,
P=O+1.
same([N,O],P):- /* look for "close" patterns */
O=N-1,
P=O-1.
same([N|R],N):-same(R,N). /* recurse to last two */
/* sums -- generate a difference list, and look for a pattern in it
to determine the next number */
sums(L,N):- /* given list L with n items */
diff(L,M), /* generate difference list M (n-1 items) */
solve(M,O), /* solve for next item in list M */
last(L,R), /* find last item in list L, call it R */
N=O+R. /* offset R by O to get N */
/* prods -- generate a difference list, and look for a pattern in it
to determine the next number */
prods(L,N):- /* given list L with n items */
quo(L,M), /* generate quotient list M (n-1 items) */
solve(M,O), /* solve for next item in list M */
last(L,R), /* find last item in list L, call it R */
N=O*R. /* multiply R by O to get N */
/* diff -- generate a difference list */
diff([_],[]). /* difference of one item is null set */
diff([A|[B|C]],[D|E]):- /* difference of first two items into list */
D=B-A,
diff([B|C],E).
/* quo -- generate a quotient list */
quo([_],[]). /* quotient of one item is null set */
quo([A|[B|C]],[D|E]):- /* quotient of first two items into list */
D=B/A, /* calculate quotient */
B=A*D, /* be sure remainder is zero (integer math) */
quo([B|C],E).
/* last -- get last item from a list */
last([A],A). /* A is the last item */
last([_|B],C):-last(B,C).
/* chkyn -- characters which will be accepted as "yes" response */
chkyn('Y').
chkyn('y').