ai.prolog - jgrey4296/jgrey4296.github.io GitHub Wiki
# for emacs:
swipl -tty
3 basic constructs: Facts, Rules, and Queries
%% Facts start lower case.
a_face.
%% Variables start Upper case.
%% Statements conclude with '.'.
%% if (body) then (head).
head :- body.
%% AND two conditions using a comma: (cond1), (cond2).
head :- body1, body2.
%% OR two conditions using a semicolon: (cond1); (cond2).
head :- body1 ; body2.
list([1,2,3,4,5]).
accum([], A, A).
accum([H|T], C, L) :- D is H+C, accum(T, D, L).
main :- list(X), accum(X, 0, Y), print(Y), format(" True").
main :- format("False").
test(A) :- A = 2 + 3.
main :- test(A), B is A, format("True: ~p", B).
main :- format("False").
Use the difference between two lists for information Similar to parser combinators
Instead of:
s(Z) :- np(X), vp(Y), append(X,Y,Z).
np(Z) :- det(X), n(Y), append(X,Y,Z).
vp(Z) :- v(X), np(Y), append(X,Y,Z).
vp(Z) ;- v(Z).
det([the]). det([a]).
n([woman]). n([man]).
v([shoots]).
main :- s([a, woman, shoots, a, man]), format("True").
%% main :- findall(s(X), s(X), Y), format("Result: ~p", [Y]).
main :- format("False").
Use:
s(X,Z):- np(X,Y), vp(Y,Z).
np(X,Z):- det(X,Y), n(Y,Z).
vp(X,Z):- v(X,Y), np(Y,Z).
vp(X,Z):- v(X,Z).
det([the|W],W). det([a|W],W).
n([woman|W],W). n([man|W],W).
v([shoots|W],W).
main :- np([the,man|W], W), format("true").
main :- format("false").
loves(vincent, mia).
loves(marcellus, mia).
jealous(A,B) :- loves(A,C), loves(B,C), A \= B.
main :- findall(jealous(X,Y), jealous(X,Y), Z), print(Z).
[name(bob), name(bill), [1,2,3,4]]
%% Prolog has a separation operator
[Head|Tail] = [mia, vincent, jules, yolanda].
list([aweg, bloo, blee]).
main :- list(Y), [aweg | Z] = Y, format("True ~p : ~p", [aweg, Z]).
main :- format("False").
list([a,b,c,d,e]).
member(X, [X|T]).
member(X, [H|T]) :- member(X, T).
main(A) :- list(X), member(A, X), format("True ~a in ~p", [A, X]) ; format("False ~p", A).
list([a,b,c,d,e]).
list2([a,b,c]).
eq([], []).
eq([_|Ta], [_| Tb]) :- eq(Ta, Tb).
main :- list(L), list2(L2), eq(L,L2), format("True").
main :- format("False").
person(mia).
person(sue).
person(vincent).
woman(mia).
woman(sue).
man(X) :- person(X), \+ woman(X).
main :- man(X), format(true) ; format(false).
is_digesting(X,Y) :- just_ate(X,Y).
is_digesting(X,Y) :- just_ate(X,Z), is_digesting(Z,Y).
just_ate(mosquito, blood(john)).
just_ate(frog, mosquito).
just_ate(stork, frog).
main :- is_digesting(stork, mosquito), format("True").
main :- format("False").
If term1 and term2 are constants, then term1 and term2 unify if and only if they are the same atom, or the same number.
If term1 is a variable and term2 is any type of term, then term1 and term2 unify, and term1 is instantiated to term2 . Similarly, if term2 is a variable and term1 is any type of term, then term1 and term2 unify, and term2 is instantiated to term1 . (So if they are both variables, they’re both instantiated to each other, and we say that they share values.)
If term1 and term2 are complex terms, then they unify if and only if:
- They have the same functor and arity, and
- All their corresponding arguments unify, and
- The variable instantiations are compatible.
(For example, it is not possible to instantiate variable X to mia when
unifying one pair of arguments, and to instantiate X to vincent when
unifying another pair of arguments .)
Two terms unify if and only if it follows from the previous three clauses that they unify.
Prolog unification skips occur check. (So does not guard against variables unifying with terms that contain the variable).
:- op(500, xfy, test).
test(X,Y) :- name(X), name(Y).
name(bob).
name(bill).
main :- bob test bill, format("True").
main :- format("False").
”!” is an atom. Always succeeds. Side effect is to block backtracking. Enables mutually exclusive rules by putting a cut at the end of one.
s(X,Y) :- q(X,Y).
s(0,0).
%% ! blocks attempts of i(2).
q(X,Y) :- i(X), !, j(Y).
i(1). i(2).
j(1). j(2). j(3).
main :- findall(s(X,Y), s(X,Y), Z), format("True: ~p", [Z]).
main :- format("False").
“b(X) :- a(X), !, fail.”
neg(X) :- X, !, fail.
neg(X).
a(1).
main :- neg(a(2)), format("True").
main :- format("False").
:- module(ModuleName, [exports]).
:- use_module(moduleName).
s --> np, vp.
np --> det, n. vp --> v, np.
vp --> v.
det --> [the]. det--> [a].
n --> [woman]. n --> [man].
v --> [shoots].
main :- s([a, woman, shoots, the, woman], []), format("True ~p", a).
main :- format("False").
s --> np(subject),vp.
np(_) --> det,n.
np(X) --> pro(X).
vp --> v,np(object).
vp --> v.
det --> [the]. det --> [a].
n --> [woman]. n --> [man].
pro(subject) --> [he]. pro(subject) --> [she].
pro(object) --> [him]. pro(object) --> [her].
v --> [shoots].
main :- format("True").
main :- format("False").
a(Count) --> [b], { Count = 1 }.
np --> det, n.
vp --> v, np.
vp --> v.
det --> [Word],{lex(Word,det)}.
n --> [Word],{lex(Word,n)}.
v --> [Word],{lex(Word,v)}.
lex(the,det).
lex(a,det).
lex(woman,n).
lex(man,n).
lex(shoots,v).
s(s(NP,VP)) --> np(NP),vp(VP).
np(np(DET,N)) --> det(DET),n(N).
vp(vp(V,NP)) --> v(V),np(NP).
vp(vp(V)) --> v(V).
det(det(the)) --> [the].
det(det(a)) --> [a].
n(n(woman)) --> [woman].
n(n(man)) --> [man].
v(v(shoots)) --> [shoots].
main :- format("True").
main :- format("False").
See swipl debugger and the gnu prolog debugger
%% Debugger ports are: call, exit, redo, fail.
%% Which to show:
visible(+all).
%% Which not to halt on:
leash(-exit).
%% Trace the next query:
trace.
Commands: L : Listing g : goals C : show context A : alternatives
Also print all listings with:
listing.
Never write as the leftmost goal of the body something that is identical with the goal given in the head, place those clauses as far right as possible.
Use Tail Recursion
Arithmetic comparisons implicitly evaluate both sides.
4 = 4. %% True
2+2 = 4. %% False
2+2 =:= 4. %% True
From trying to do 12 is (X+3)*2 Where uninstantiated variables are on the right of ‘is’.
Module:
:- module(MODULE_NAME, [MODULE_EXPORTS/0]).
And use:
:- use_module(MODULE_NAME).
MODULE_NAME:MODULE_EXPORTS.
Predicate | Notes |
---|---|
is/2 | performs arithmetic |
”==/2” | does not unify, strict comparison |
”=/2” | unifies |
\=/2 | unification failure |
unify_with_occurs_check/2 | |
addLen/3 | |
findall/3 | finds all unifications |
bagof/3 | doesn’t flatten results of findall |
setof/3 | returns lists with no redundancies |
fail/0 | force backtracking. |
assert/1, retract/1 | add and remove facts and rules from kb |
asserta/1 | add to beginning of kb |
assertz/1 | add to end of kb |
Typing: | |
atom/1 | |
integer/1 | |
float/1 | |
number/1 | |
atomic/1 | |
var/1 | |
nonvar/1 | |
functor/3 | functor(f(a,b), F, A) : gives functor and arity |
arg/3 | arg(2, loves(vincent,mia), X). : X -> mia |
”=../2” | turns the given arg into a list [head, terms] |
f(a). f(b). g(a). g(b).
h(b).
k(X) :- f(X), g(X), h(X).
main :- k(X), format("Result: ~a", X).
%%-- rules
fullDeps(T, []) :- before(T, []).
fullDeps(T, S) :- T,
format("~q Exists~n", [T]),
listDeps([T], D),
list_to_set(D, S).
listDeps([], []).
listDeps([H|T], DD) :- before(H, D1),
listDeps(D1, D1b),
listDeps(T, TD),
append([[H], D1b, TD], DD).
printPretty([]).
printPretty([H|T]) :- H = task(X, Y),
format("- ~q::~q~n", [X, Y]),
printPretty(T).
printPretty([H|T]) :- H = file(X),
format("- file::>~q~n", [X]),
printPretty(T).
%%-- end rules
%%-- data
%% task(group, name).
%% job(group, name).
%% file(name).
task(top, top).
task(top, cleanup).
task(bookmark, update).
task(bookmark, firefox).
task(bookmark, archived).
file(archive).
file(database).
action(copyfile).
%% deps
before(file(archive), []).
before(file(database), []).
before(task(bookmark,archived), [file(archive)]).
before(task(bookmark,firefox), [file(database)]).
before(task(bookmark,update), [task(bookmark,firefox), task(bookmark,archived)]).
%%-- end data
%%-- main
main :-
current_prolog_flag(argv, [Group,Name|_]),
format("Task: ~q::~q~n", [Group, Name]),
task(Group, Name) = Task,
trace,
fullDeps(Task, Deps),
format("~q dependencies are:~n", [Task]),
printPretty(Deps),
halt().
main :- format("Call with a task group and name"),
Task = task(_,_),
printPretty([Task]),
halt().
%%-- end main
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/temperature.pl
% temperature conversions using prolog structures
temperature(kelvin, T) :- number(T), T >= 0.
temperature(celsius, T) :- number(T), T >= -273.15.
temperature(fahrenheit, T) :- number(T), T >= -459.67.
% if both scales are the same then both temperatures should be too
convert(temperature(Scale, T), temperature(Scale, T)).
% if we're given the kelvin, we can figure out the celsius
convert(temperature(kelvin, T1), temperature(celsius, T2)) :-
temperature(kelvin, T1), Temp is T1 - 273.15, T2 = Temp.
% if we're given the kelvin, we can figure out the farenheight
convert(temperature(kelvin, T1), temperature(fahrenheit, T2)) :-
temperature(kelvin, T1), Temp is T1 * 1.8 - 459.67, T2 = Temp.
% if we're given the celsius, we can figure out the farenheight
convert(temperature(celsius, T1), temperature(fahrenheit, T2)) :-
temperature(celsius, T1), Temp is T1 * 1.8 + 32, T2 = Temp.
% if we're given the celsius, we can figure out the kelvin
convert(temperature(celsius, T1), temperature(kelvin, T2)) :-
temperature(celsius, T1), Temp is T1 + 273.15, T2 = Temp.
% if we're given the fahrenheit, we can figure out the kelvin
convert(temperature(fahrenheit, T1), temperature(kelvin, T2)) :-
temperature(fahrenheit, T1), Temp is (T1 + 459.67)/1.8, T2 = Temp.
% if we're given the fahrenheit, we can figure out the celsius
convert(temperature(fahrenheit, T1), temperature(celsius, T2)) :-
temperature(fahrenheit, T1), Temp is (T1 -32)/1.8, T2 = Temp.
% if we're given the second one but NOT the first,
% then solve it with a call to the reverse
convert(temperature(Scale1, T1), temperature(Scale2, T2)) :-
temperature(Scale2, T2), var(T1),
convert(temperature(Scale2, T2), temperature(Scale1, T1)).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/bstree.pl
% File: bstree.pl
% Author: Dave Wessels
%
% Purpose: to represent and manipulate binary search trees
% of unique keys that are positive integers
% paired with any kind of associated data values
%
% Representation:
% bstree(Key,Value,Left,Right)
%
% Rules:
% Left and Right are the left and right subtrees, nil if the subtrees are empty,
% Left is a valid bstree and keys in Left must be < Key
% Right is a valid bstree and keys in Right must be > Key
%
% Supported query set:
% binTree(T): succeeds iff T is a valid binary tree with integer keys
% validKeys(T,Min,Max): succeeds iff T's key structure is valid for binary search trees
% bstree(T): succeeds iff T is a valid binary search tree
% bstInsert(K,V,T,NewT): succeeds iff K,V can be inserted into T to create NewT,
% fails if K is already in T
% bstLookup(K,V,T): succeeds iff T contains K and V is K's associated data value
% bstPrint(T): succeeds iff an inorder traversal of T can be performed,
% printing each key,value pair on a line of its own
% binTree(T)
% -----------
% succeeds iff T is a valid binary tree with integer keys
% and instantiated values
binTree(nil).
binTree(bstree(K,V,L,R)) :-
integer(K), nonvar(V),
binTree(L), binTree(R).
% validKeys(T,Min,Max)
% --------------------
% succeeds iff either T is nil or T has the form bstree(K,V,L,R)
% such that all of the following apply:
% (1) T's key, K, is in the range Min..Max (inclusive)
% (2) validKeys(L,Min,K-1) succeeds
% (3) validKeys(R,K+1,Max) succeeds
% IMPORTANT NOTE:
% validKey assumes binTree(T) has already been checked and succeeded
validKeys(nil, _, _).
validKeys(bstree(K,_,L,R), Min, Max) :-
integer(Min), integer(Max), Min =< K, K =< Max,
newMax is K - 1, newMin is K + 1,
validKeys(L, Min, newMax),
validKeys(R, newMin, Max).
% bstree(T)
% ---------
% succeeds iff T is a valid binary search tree,
% i.e. it has valid structure and valid keys
bstree(nil).
bstree(T) :- binTree(T), current_prolog_flag(max_integer,Max), validKeys(T,1,Max).
% bstInsert(K,V,T,NewT)
% ---------------------
% succeeds iff K,V can be inserted into T to create NewT,
% fails if K is already in T
% can insert any valid K,V pair into an empty tree
bstInsert(K, V, nil, bstree(K,V,nil,nil)) :-
nonvar(V), integer(K), K > 0.
% if K is less than the root's key then
% attempt an insert in the left subtree
bstInsert(K, V, bstree(Kr,Vr,L,R), bstree(Kr,Vr,L1,R)) :-
integer(K), nonvar(V), K < Kr, bstInsert(K,V,L,L1).
% if K is greater than the root's key then
% attempt an insert in the right subtree
bstInsert(K,V, bstree(Kr,Vr,L,R), bstree(Kr,Vr,L,R1)) :-
integer(K), nonvar(V), Kr < K, bstInsert(K,V,R,R1).
% bstLookup(K,V,T)
% ----------------
% succeeds iff T contains K and V is K's associated data value
% find it in the root
bstLookup(K,V,bstree(K,V,_,_)).
% if K is less than the root's key then search the left subtree
bstLookup(K,V,bstree(Kr,_,L,_)) :-
integer(K), K < Kr, bstLookup(K,V,L).
% if K is greater than the root's key then search the right subtree
bstLookup(K,V,bstree(Kr,_,_,R)) :-
integer(K), Kr < K, bstLookup(K,V,R).
% bstPrint(T)
% -----------
% succeeds iff an inorder traversal of T can be performed,
% printing each key,value pair on a line of its own
bstPrint(nil).
bstPrint(bstree(K,V,L,R)) :-
bstPrint(L),
write(K), put(0':), write(V), nl,
bstPrint(R).
% -------------------------------------------------------------
% Collection of test trees
testcase(t00,nil).
testcase(t01,bstree(8,1, nil, nil)).
testcase(t02,bstree(8,1,
bstree(4,2,nil,nil),
nil)).
testcase(t03,bstree(8,1,
bstree(4,2,nil,nil),
bstree(12,3,nil,nil))).
testcase(t04,bstree(8,1,bstree(4,2,
bstree(2,4,nil,nil),
nil),
bstree(12,3,
nil,
bstree(14,5,nil,nil)))).
testcase(t05,bstree(8,1,bstree(4,2,
bstree(2,4,nil,nil),
nil),
bstree(12,3,
nil,
bstree(14,5,nil,nil)))).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/archives.pl
% set of rules to handle queries about file archive data
%
% an archive is a list of lists, where each sublist is the
% information regarding one archived file, and consists
% of the following elements (in order)
% [ base_filename, archive_directory, owner, modification_time, filesize ]
% (where modification time is seconds since the epoch and file size is bytes)
% e.g. an archive for just one file might look like
% [["foo.txt", "/archives/data/2019", "jdoe", 1552240465, 1903]]
% and an archive containing two files might look like
% [["file1", "/home/whoever/archive", "whoever", 1230005, 10017],
% ["anotherFile", "/misc/archive", "someone", 973024601, 200]]
% Queries supported
% -----------------
% validFileInfo(F)
% succeeds iff F has the valid format for a file record,
% i.e. [ string, string, string, posInt, posInt ]
% dateRange(Archive, FileList, StartTime, EndTime)
% gets the list of records for all files whose modification time is within
% the given range
% oldest(Archive, FileList, ModTime)
% gets the list of records for all files with the oldest modification time
% (i.e. lowest number) - it is a list in case multiple files have an equal
% oldest date
% largest(Archive, FileList)
% gets the list of records for all files with the largest size (in bytes)
% Again, it is a list in case multiple files have an equal largest size
% ownerFiles(Archive, Owner, FileList)
% gets the list of records for all files belonging to the specified owner
% dirFiles(Archive, Dir, FileList)
% gets the list of records for all files in the specified directory
% fileVersions(Archive, FileBaseName, FileList)
% gets the list of records for all files matching the specified base name
% okInt(I, Min)
% -------------
% succeeds iff I and Min are integers, I >= Min
okInt(I, Min) :- integer(I), integer(Min), I >= Min.
% validFileInfo(F)
% ----------------
% succeeds iff F has the valid format for a file record,
% i.e. [ string, string, string, posInt, posInt ]
validFileInfo([Fname, Dir, Owner, Time, Size]) :-
string(Fname), string(Dir), string(Owner), okInt(Time, 0), okInt(Size, 0).
% dateRange(Archive, FileList, StartTime, EndTime)
% ------------------------------------------------
% gets the list of records for all files whose modification time is within
% the given range
dateRange([], [], _, _).
dateRange([H|T], [H|Rest], Start, End) :- okInt(Start, 0), okInt(End, Start),
validFileInfo(H), H = [ _, _, _, Time, _ ], okInt(Time, Start),
End >= Time, dateRange(T, Rest, Start, End).
dateRange([_|T], Rest, Start, End) :- okInt(Start, 0), okInt(End, Start),
dateRange(T, Rest, Start, End).
% oldest(Archive, FileList, ModTime)
% ----------------------------------
% gets the list of records for all files with the oldest modification time
% (i.e. lowest number) - it is a list in case multiple files have an equal
% oldest date
% base cases, zero or one item
oldest([], [], Time) :- get_time(Time). % assumes latest possible time is NOW
oldest([H], [H], Time) :- validFileInfo(H), H = [_, _, _, Time, _].
% H isn't valid, skip it and process the rest
oldest([H|Rest], L, Time) :- not(validFileInfo(H)), oldest(Rest,L, Time).
% H is older than anything in the rest
oldest([H|Rest], [H], Time) :- validFileInfo(H), H = [_, _, _, Time, _],
oldest(Rest, _, RTime), Time < RTime.
% H is same age as oldest stuff in the rest
oldest([H|Rest], [H|Old], Time) :- validFileInfo(H), H = [_, _, _, Time, _],
oldest(Rest, Old, Time).
% H is not as old as oldest stuff in the rest
oldest([H|Rest], Old, Time) :- validFileInfo(H), H = [_, _, _, HTime, _],
oldest(Rest, Old, Time), HTime > Time.
% largest(Archive, FileList)
% --------------------------
% gets the list of records for all files with the largest size (in bytes)
% Again, it is a list in case multiple files have an equal largest size
% base case, no items or only one item
largest([], [], Size) :- Max is 2^32, Max = Size. % assumes largest file size is 4GB
largest([H], [H], Size) :- validFileInfo(H), H = [_, _, _, _, Size].
% H isn't valid, skip it and process the rest
largest([H|Rest], L, Size) :- not(validFileInfo(H)), largest(Rest,L, Size).
% H is larger than anything in the rest
largest([H|Rest], [H], Size) :- validFileInfo(H), H = [_, _, _, _, Size],
largest(Rest, _, RSize), Size > RSize.
% H is same size as largest stuff in the rest
largest([H|Rest], [H|Old], Size) :- validFileInfo(H), H = [_, _, _, _, Size],
largest(Rest, Old, Size).
% H is not as large as largest stuff in the rest
largest([H|Rest], Old, Size) :- validFileInfo(H), H = [_, _, _, _, HSize],
largest(Rest, Old, Size), HSize < Size.
% ownerFiles(Archive, Owner, FileList)
% ------------------------------------
% gets the list of records for all files belonging to the specified owner
ownerFiles([], _, []).
ownerFiles([H], Owner, [H]) :- validFileInfo(H), H = [_, _, Owner, _, _].
ownerFiles([H|T], Owner, [H|Rest]) :- validFileInfo(H),
H = [_, _, Owner, _, _], ownerFiles(T, Owner, Rest).
ownerFiles([_|T], Owner, Rest) :- ownerFiles(T, Owner, Rest).
% dirFiles(Archive, Dir, FileList)
% --------------------------------
% gets the list of records for all files in the specified directory
dirFiles([], _, []).
dirFiles([H], Dir, [H]) :- validFileInfo(H), H = [_, Dir, _, _, _].
dirFiles([H|T], Dir, [H|Rest]) :- validFileInfo(H),
H = [_, Dir, _, _, _], dirFiles(T, Dir, Rest).
dirFiles([_|T], Dir, Rest) :- dirFiles(T, Dir, Rest).
% fileVersions(Archive, FileBaseName, FileList)
% ---------------------------------------------
% gets the list of records for all files matching the specified base name
fileVersions([], _, []).
fileVersions([H], Fname, [H]) :- validFileInfo(H), H = [Fname, _, _, _, _].
fileVersions([H|T], Fname, [H|Rest]) :- validFileInfo(H),
H = [Fname, _, _, _, _], fileVersions(T, Fname, Rest).
fileVersions([_|T], Fname, Rest) :- fileVersions(T, Fname, Rest).
% ---------------- Sample Test Data -------------------
% loadTest(Num, Data)
% -------------------
% loads the test case data with the specified number
% test case 0 is empty archive
testcase(0, []).
% test case 1: single entry
testcase(1, [ ["file1", "/home/whoever/archive", "whoever", 123, 200] ]).
% test case 2: two entries in same archive with same owner
testcase(2, [
["file1", "/home/whoever/archive", "whoever", 123, 100],
["file2", "/home/whoever/archive", "whoever", 246, 200]
]).
% test case 3: three entries in different archives with different owners
testcase(3, [
["file1", "/home/whoever/archive", "whoever", 123, 100],
["file2", "/home/someone/archive", "someone", 246, 200],
["file3", "/home/another/archive", "another", 100, 150]
]).
% test case 4: four distinct entries with overlapping field values
% - two with the same matching oldest date
% - two with the same largest size
% - two with the same filename
% - two in the same directory
% - two with the same owner
testcase(4, [
["file4", "/home/whoever/archive", "whoever", 100, 200],
["file1", "/home/someone/archive", "someone", 246, 200],
["file2", "/home/someone/archive", "another", 100, 100],
["file1", "/home/extra/archive", "whoever", 123, 150]
]).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/flights.pl
% simple flight-planning system
% airport(City,Code)
% ------------------
% matches a city name with an airport code, e.g. "nanaimo" with "ycd"
airport('Nanaimo', 'YCD').
airport('Vancouver', 'YVR').
airport('Victoria', 'YYJ').
airport('Calgary', 'YYC').
airport('Lethbridge', 'YQL').
airport('Kamloops', 'YKA').
% flight(DeptAC, ArrAC)
% ---------------------
% as a fact, states there is a direct flight between the
% departure airport and arrival airport,
% under the given flight code (e.g. "AC123")
flight('YCD', 'YYC').
flight('YCD', 'YVR').
flight('YKA', 'YQL').
flight('YKA', 'YYC').
flight('YQL', 'YKA').
flight('YQL', 'YVR').
flight('YQL', 'YYC').
flight('YYJ', 'YVR').
flight('YYJ', 'YYC').
flight('YVR', 'YYC').
flight('YVR', 'YQL').
flight('YVR','YCD').
flight('YVR','YYJ').
flight('YYC', 'YQL').
flight('YYC', 'YKA').
flight('YYC','YCD').
flight('YYC', 'YYJ').
flight('YYC', 'YVR').
% flights(DeptAC, ArrAC)
% ----------------------
% as a rule, finds a sequence (list) of flights connecting
% the departure airport to the arrival airport
% direct flight
flights(D,A) :- airport(Dname,D), airport(Aname,A),
flight(D,A), format("Direct flight ~w(~w) to ~w(~w)~n",[Dname,D,Aname,A]).
% one-stop
flights(D,A) :-
flight(D,I), I \= A, flight(I,A), airport(Dname,D), airport(Iname,I), airport(Aname,A),
format("Flight ~w(~w) to ~w(~w) via ~w(~w)~n", [Dname,D,Aname,A,Iname,I]).
% two-stop
flights(D,A) :-
flight(D,I), I \= A, flight(I,J), J \= A, J \= D, flight(J,A), airport(Dname,D),
airport(Aname,A), airport(Iname,I), airport(Jname,J),
format("Flight ~w(~w) to ~w(~w) via ~w(~w) and ~w(~w)~n", [Dname,D,Aname,A,Iname,I,Jname,J]).
% flights(DeptCity, ArrCity)
% --------------------------
% run a flights query, but starting with the city name (translate to airport codes)
flights(DC,AC) :- airport(DC,D), airport(AC,A), flights(D,A).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/circuits.pl
% representing logic circuits using one- and two-input gates
% and, or, nand, nor, xor, xnor,
% but using inv for negation
% define the behaviour of the individual gates,
% (the last value is the gate output, the first value(s) are the inputs)
inv(false, true).
inv(true, false).
and(true, true, true).
and(false, false, false).
and(false, true, false).
and(true, false, false).
or(true, true, true).
or(false, true, true).
or(true, false, true).
or(false, false, false).
nand(false, false, true).
nand(false, true, true).
nand(true, false, true).
nand(true, true, false).
nor(true, false, false).
nor(false, true, false).
nor(true, true, false).
nor(false, false, true).
xor(true, false, true).
xor(false, true, true).
xor(true, true, false).
xor(false, false, true).
xnor(true, false, false).
xnor(true, true, true).
xnor(false, false, true).
xnor(false, true, false).
% --- define a test circuit ---
% circuit 1: a simple sum-of-products circuit where F is xz' + x'y
% (uses locals L1, L2, L3, L4 to represent the lines between gates)
circuit1(X,Y,Z,F) :- inv(X, L1), inv(Z,L2),
and(X,L2,L3), and(Y,L1,L4),
or(L3,L4,F).
% use findall to group all combinations of X,Y,Z that make F true for circuit 1
test1:- format("Detecting circuit 1 minterms [X,Y,Z]:~n "),
findall([X,Y,Z], circuit1(X,Y,Z,true), Results), write_ln(Results).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/rpslv.pl
% Rock-paper-scissors-lizard-spock
% played against a random ai
% To play a round enter the query
% play.
% ------------------------------------------------------------------
% message(Msg) or message(Msg, Value)
% -----------------------------------
% display the message (and value if supplied) and a newline
message(Msg) :- name(Atom,Msg), write(Atom), nl.
message(Msg,Value) :- name(Atom,Msg), write(Atom), write(Value), nl.
% makeChoice(Choice)
% ------------------
% prompt the user until they give a valid response
makeChoice(Choice) :- repeat,
message("Enter rock. paper. scissors. lizard. or spock."),
read(C), playerChoice(C), Choice = C.
playerChoice(rock).
playerChoice(paper).
playerChoice(scissors).
playerChoice(lizard).
playerChoice(spock).
% aiChoice(C)
% -----------
% randomly choose rock, paper, scissors, lizard, or spock
aiChoice(C) :- random(0,5,M), selected(M,C).
selected(0,rock).
selected(1,paper).
selected(2,scissors).
selected(3,lizard).
selected(4,spock).
% result(PlayerChoice,AIChoice,Result)
% ------------------------------------
% given the player and ai choices,
% determines result as win, loss, draw (from player perspective)
% fails if invalid choices are given
% handle ties
result(Choice,Choice,draw).
% handle losing choices
result(rock,paper,loss).
result(rock,spock,loss).
result(paper,lizard,loss).
result(paper,scissors,loss).
result(scissors,rock,loss).
result(scissors,spock,loss).
result(lizard,scissors,loss).
result(lizard,rock,loss).
result(spock,lizard,loss).
result(spock,paper,loss).
% handle winning choices
result(rock,scissors,win).
result(rock,lizard,win).
result(paper,rock,win).
result(paper,spock,win).
result(scissors,paper,win).
result(scissors,lizard,win).
result(lizard,spock,win).
result(lizard,paper,win).
result(spock,rock,win).
result(spock,scissors,win).
% play
% ----
% play one round
play :- makeChoice(Plyr), aiChoice(Ai), result(Plyr,Ai,Res),
message("Player chose: ", Plyr),
message("AI chose: ", Ai),
message("Result: ", Res).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/hanoi.pl
% towers of hanoi: displays instructions, format
% move(Number, Src, Dest, Using).
% base case, move one disc (write from where to where)
move(1, A, B, _) :- write('move from '), write(A),
write(' to '), write(B), nl.
% general case, move the top N-1 to an intermediate,
% move the Nth to the destination, then move the N-1
% from the intermediate to the destination
move(N, Src, Dest, Using) :- number(N), N > 1, M is N-1,
move(M, Src, Using, Dest), move(1, Src, Dest, Using),
move(M, Using, Dest, Src).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/ttt.pl
% Prolog tic-tac-toe versus an ai that tries to choose
% good moves by looking several turns ahead.
% The human player is X, the AI is O.
% A single game can be invoked using the prolog query
% start.
% Multiple games can be invoked using the prolog query
% start(N).
% If multiple games are played, player X goes first
% in the first game, then the players alternate who
% goes first from one game to the next.
% The game state is represented using a six part list
% [Board, State, XScore, OScore, Turn, Moves]
% - Board is the current game board
% - State is one of 'playing, winX, winO, draw'
% - XScore and OScore are the players' scores,
% each win scores 1 for the winner, 0 for the loser
% (draws leave the score unchanged)
% - Turn records whose turn it is, plyrX or plyrO
% - Moves records the list of moves taken so far
% by which positions were taken each turn,
% e.g. [1,5,...] indicates
% X took position 1 then O took position 5
% =============================================================================
% OVERALL CONTROL
% =============================================================================
% start(NumGames)
% ===============
% play NumGames games, default 0
start :- playGame(0, 0, plyrX, _).
start(N) :- integer(N), N > 0, NewN is N - 1,
playGame(0, 0, plyrX, GameResult),
quitOrPlay(GameResult, NewN, plyrX).
quitOrPlay(GameResult, N, WhoStarts) :-
N > 0, NewN is N - 1,
write('*****'), write(N), write(' game(s) to go!'),
write('*****'), nl, write('.'), nl, sleep(1),
write('.'), nl, sleep(1), write('.'), nl, sleep(1), nl,
getScore(GameResult, XScore, OScore),
switchPlayer(WhoStarts, OtherPlyr),
playGame(XScore, OScore, OtherPlyr, NewResult),
quitOrPlay(NewResult, NewN, OtherPlyr).
quitOrPlay(_,0,_).
% =============================================================================
% SINGLE GAME CONTROL
% =============================================================================
% playGame(XScore, OScore, FinalState)
% ====================================
% plays one game
playGame(XScore, OScore, WhoStarts, FinalState) :-
initGame(GameState, XScore, OScore, WhoStarts),
!,
playTurn(GameState, FinalState), !,
displayFinalResult(FinalState), !.
% initGame(GameState, XScore, OScore)
% ===================================
% game setup
initGame([
% initialize the board
[empty, empty, empty, empty, empty, empty, empty, empty, empty ],
XScore, OScore, % XScore, OScore at the start of this game
playing, % initial state
WhoStarts, % who gets the first turn
[] ], % moves list is initially empty
XScore, OScore, WhoStarts ) :- %
displayRules. % display the game rules on screen
% playTurn(GameState, FinalState)
% ===============================
% playing a turn involves current player picking their move
% then applying the results
% GameState is the state coming into the turn,
% FinalState is the end-of-game state that is eventually returned
playTurn(GameState, FinalState) :-
drawBoard(GameState), % display the current board
drawInfo(GameState), % display the score and whose turn it is
pickMove(GameState, Move), % current player picks a valid board position
!,
applyMove(GameState, Move, NewState), % create the revised board
% check if the game is over,
% if so update the winner, otherwise play another turn.
checkResults(NewState, FinalState).
% checkResults(NewState, FinalState)
% ====================================
% check the newly created state to see if it is an end state,
% (i.e. either a win for X/O or a tie)
% if so return the final game state
% otherwise continue playing,
% eventually getting the final state back
% check if the game is over because X has won
checkResults([Board, XScore, OScore, playing, Plyr, Moves],
[Board, NewX, OScore, winX, Plyr, Moves]) :-
winner(Board, plyrX),
NewX is XScore + 1.
% check if the game is over because O has won
checkResults([Board, XScore, OScore, playing, Plyr, Moves],
[Board, XScore, NewO, winO, Plyr, Moves]) :-
winner(Board, plyrO),
NewO is OScore + 1.
% check if the game is over because board is full
checkResults([Board, XScore, OScore, playing, Plyr, Moves],
[Board, XScore, OScore, draw, Plyr, Moves]) :-
tieGame(Board).
% otherwise the game isn't over,
% so let the other player take their next turn
checkResults(GameState, FinalState) :- switchPlayer(GameState, NewState),
playTurn(NewState, FinalState).
% winner(Board, Player)
% =====================
% Based on the current board,
% see if the specified player has won
% see if the specified player has won
winner([A, A, A, _, _, _, _, _, _], Player) :- A == Player.
winner([_, _, _, A, A, A, _, _, _], Player) :- A == Player.
winner([_, _, _, _, _, _, A, A, A], Player) :- A == Player.
winner([A, _, _, A, _, _, A, _, _], Player) :- A == Player.
winner([A, _, _, _, A, _, _, _, A], Player) :- A == Player.
winner([_, A, _, _, A, _, _, A, _], Player) :- A == Player.
winner([_, _, A, _, _, A, _, _, A], Player) :- A == Player.
winner([_, _, A, _, A, _, A, _, _], Player) :- A == Player.
% tieGame(Board)
% ==============
% see if the game board is full, i.e. the empty symbol is no
% longer on the board. Assumes we have already checked
% to make sure the game has not been won
tieGame(Board) :- frequency(Board, empty, Count), !, Count < 1.
% switchPlayer(OldState, NewState)
% ================================
% switching players simply alternates the current turn
% between plyrX and plyrO
switchPlayer([Board, XScore, OScore, State, plyrX, Moves],
[Board, XScore, OScore, State, plyrO, Moves]).
switchPlayer([Board, XScore, OScore, State, plyrO, Moves],
[Board, XScore, OScore, State, plyrX, Moves]).
% switchPlayer(OldPlyr, NewPlyr)
% ==============================
% switching between players
switchPlayer(plyrX, plyrO).
switchPlayer(plyrO, plyrX).
% applyMove(OldState, Position, NewState)
% =======================================
% applying the move involves updating right the board
% to create a new game state,
% assumes the validity of the move has already been checked
applyMove([Board, XScore, OScore, playing, Player, Moves],
Position,
[NewBoard, XScore, OScore, playing, Player, NewMoves]) :-
appendElem(Moves, Position, NewMoves),
changeBoard(Board, NewBoard, Position, Player).
% getLastMove(GameState, Move)
% ============================
% get the last move made to get to the current game state
getLastMove([_, _, _, _, _, Moves], Move) :- getLast(Moves, Move).
% getCurrPlayer(GameState, Plyr)
% ============================
% get the current player from the game state
getCurrPlayer([_, _, _, _, Plyr, _], Plyr).
% getScore(GameState, XScore, OScore)
% ===================================
% get the scores from the game state
getScore([_, XScore, OScore, _, _, _], XScore, OScore).
% changeBoard(OldBoard, NewBoard, Position, Symbol)
% =================================================
% change the specified position to the specified player,
% assumes validity of the move has already been checked
changeBoard(OldBoard, NewBoard, Position, Symbol) :-
setElem(OldBoard, NewBoard, Position, Symbol).
% pickMove(GameState, Move)
% =========================
% given the current game state (which includes whose turn it is)
% pick the next move and check it for validity
% the human player picks a valid board position,
% which is then recorded in Move
pickMove([Board, _, _, _, plyrX, _], Move) :-
write('Enter a position and a period, e.g. 3.'), nl,
write('position: '), read(Move),
validMove(Board, Move).
% the AI uses minimax to determine its move
% if an invalid spot is chosen)
pickMove([Board, XScore, OScore, State, plyrO, Moves], BestMove) :-
write('************************************'), nl,
% pick how far ahead minimax should look
frequency(Board, empty, Avail),
minimaxSearchDepth(Avail, Depth),
write('The AI is running minimax, depth: '), write(Depth), nl,
minimax([Board, XScore, OScore, State, plyrO, Moves],
Depth, BestMove, _),
write('The AI chose: '), write(BestMove), nl,
write('************************************'), nl,
validMove(Board, BestMove).
% the validity check for the move failed,
% print an error message and pick a new move
pickMove(GameState, Move) :- write('Please try again'), nl,
pickMove(GameState, Move).
% validMove(Board, Move)
% =====================
% check if the specified position is valid (1-9 and not taken),
% otherwise display an error message
validMove(Board, Move) :- integer(Move), 1 =< Move, Move =< 9, notTaken(Move, Board).
validMove(_, Move) :- write('Error, invalid move: '), write(Move), nl, fail.
% notTaken(Position, Board)
% =========================
% ensure a position isn't taken, i.e. the empty
% symbol appears in that position in the board
notTaken(Pos, Board) :- matches(Board, Pos, empty).
% otherPlayer(OldPlayer, NewPlayer)
% =================================
% matches opposite players
otherPlayer(plyrX, plyrO).
otherPlayer(plyrO, plyrX).
% calcTurns(Board, Turns)
% =======================
% calculate the number of turns that have been taken,
% i.e. 9 minus the number of spots still empty
calcTurns(Board, Turns) :- frequency(Board, empty, LeftOver),
Turns is 9 - LeftOver.
% =============================================================================
% DISPLAY HANDLING
% =============================================================================
% displayRules
% ============
% display the game rules
displayRules :- write('Basic tic tac toe, X goes first'), nl.
% displayFinalResult(GameState)
% ============================
% display the end of game information
displayFinalResult([_, XScore, OScore, winX, _, _]) :-
write('************************************'), nl,
write('Player X won, new score is X: '), write(XScore),
write(' O: '), write(OScore), nl,
write('************************************'), nl.
displayFinalResult([_, XScore, OScore, winO, _, _]) :-
write('************************************'), nl,
write('Player O won, new score is X: '), write(XScore),
write(' O: '), write(OScore), nl,
write('************************************'), nl.
displayFinalResult([_, XScore, OScore, draw, _, _]) :-
write('*************************************'), nl,
write('Tie game, current score is X: '), write(XScore),
write(', O: '), write(OScore), nl,
write('*************************************'), nl.
% drawBoard(GameState)
% ====================
% display the current board and the numbering of board positions
drawBoard([[R11, R12, R13, R21, R22, R23, R31, R32, R33] | _]) :-
write('Positions Board'), nl,
write(' 1 2 3 '), drawLine(R11, R12, R13),
write(' 4 5 6 '), drawLine(R21, R22, R23),
write(' 7 8 9 '), drawLine(R31, R32, R33).
% drawInfo(GameState)
% ===================
% display the current score, last move, and whose turn it is
drawInfo([_, XScore, OScore, _, Player, Moves]) :-
write('X score: '), write(XScore),
write(', O Score: '), write(OScore), nl,
write('Last move: '), getLast(Moves, Move), write(Move), nl,
write('Current player:'), writeSym(Player), nl.
% drawLine(SymA, SymB, SymC)
% =========================
% draw one row of the board
drawLine(A, B, C) :- writeSym(A), writeSym(B), writeSym(C), nl.
% writeSym(Sym)
% =============
% draw the symbol corresponding to plyrX, plyrO, or empty
writeSym(empty) :- write(' - ').
writeSym(plyrX) :- write(' X ').
writeSym(plyrO) :- write(' O ').
% =============================================================================
% GENERAL LIST HANDLING
% =============================================================================
% appendElem(OldList, Element, NewList)
% =====================================
% append an element to the end of a list,
% EXCEPT: will NOT append an empty list as an element
appendElem(L, [], L).
appendElem([], V, [V]).
appendElem([H|T], V, [H|NewT]) :- appendElem(T, V, NewT).
% setElem(OldList, NewList, Position, Value)
% ==========================================
% set the value of the i'th element in a list
setElem([_|Tail], [Value|Tail], 1, Value).
setElem([Head|Tail], [Head|NewTail], I, Value) :- integer(I), I > 0,
NewI is I - 1, setElem(Tail, NewTail, NewI, Value).
% frequency(List, Element, Count)
% ===============================
% count number of times an element appears in a list
frequency([], _, 0).
frequency([Elem|Tail], Elem, Count) :- frequency(Tail, Elem, C), C1 is C+1, Count = C1.
frequency([_|Tail], Elem, Count) :- frequency(Tail, Elem, Count).
% matches(List, Position, Value)
% ==============================
% determine if the i'th element in a list
% matches the element provided
matches([Elem|_], 1, Elem).
matches([_|Tail], I, Elem) :- integer(I), I > 1, NewI is I - 1,
matches(Tail, NewI, Elem).
% getLast(List, Elem)
% ===================
% get the last element of a list
getLast([], none).
getLast([V], V).
getLast([_|T], V) :- getLast(T, V).
% =============================================================================
% MINIMAX HANDLING
% =============================================================================
% minimaxSearchDepth(AvailableSpots, Depth)
% =========================================
% base the depth on how many moves are available
minimaxSearchDepth(9, 4). % if first move, only go depth 4
minimaxSearchDepth(8, 5). % second move go depth 5
minimaxSearchDepth(7, 6). % third move go depth 6
% otherwise search the entire remaining space
minimaxSearchDepth(Avail, Depth) :- Depth is min(Avail, 5).
% minimax(CurrentState, DepthToGo, BestMove, MoveValue)
% ===================================================
% from the current state,
% if DepthToGo > 0
% generate all legal next states, if any
% if any:
% pick the best of all those states,
% the move that takes you there,
% and the 'value' of that state
% otherwise this is a terminal state,
% establish its value
% 0 is used for BestMove if there is no next move,
% otherwise move indicates which position to take next
% base case, we've reached our turn limit
minimax(CurrState, 0, 0, BestValue) :-
% just evaluate the score at our current state
evaluateState(CurrState, BestValue).
% base case: CurrState is a winner, don't explore this branch further
minimax([Board|_], _, 0, Score) :- winner(Board, plyrX), calcTurns(Board, Turns),
Score is 300 - Turns.
minimax([Board|_], _, 0, Score) :- winner(Board, plyrO), calcTurns(Board, Turns),
Score is Turns - 300.
% base case: the game has ended in a tie, don't explore further
minimax([Board|_], _, 0, 0) :- tieGame(Board).
% general case, there are still branches to explore
minimax(CurrState, TurnLimit, BestMove, MoveValue) :-
% make sure the turn limit is valid
integer(TurnLimit), 0 < TurnLimit,
% generate the possible next moves based on the which of the
% 9 board positions are available
generateNextStates(CurrState, NextStates, 9), !,
% pick the best of the possibiities generated
% (there must be at least one, or the minimax
% base cases would have applied previously)
pickBest(NextStates, TurnLimit, BestMove, MoveValue).
% genNthState(CurrState, NthState, N)
% ===================================
% if possible, generate the state that would be produced
% if the current player took position N on the board
genNthState([Board, XScore, OScore, State, Player, Moves],
[NewBoard, XScore, OScore, State, NewPlayer, NewMoves],
N) :-
% make sure N is appropriate
integer(N), 0 < N, N < 10,
% make sure the spot isn't taken
notTaken(N, Board),
% take the position, producing the new board
setElem(Board, NewBoard, N, Player),
% add the move to the move list
appendElem(Moves, N, NewMoves),
% swap whose turn it will be
otherPlayer(Player, NewPlayer), !.
% if the above fails then the new state is set to an empty list
genNthState(_, [], _).
% generateNextStates(CurrState, NextStates, N)
% ============================================
% consider the remaining N board positions to generate
% a list of potential next states
% if N is 0 there are no next states
generateNextStates(_, [], 0).
% :- write('generate empty state list'), nl.
% otherwise try to move using position N on the board, and,
% if valid, generate the next state that would produce
% and add it to the list
% note that genNthState gives [] as the NewState if
% position N isn't acceptable, but appendElem ignores
% [] if asked to append it to a list
generateNextStates(CurrState, StateList, N) :-
genNthState(CurrState, NewState, N), NewN is N - 1,
generateNextStates(CurrState, OtherStates, NewN),
appendElem(OtherStates, NewState, StateList).
% evaluateState(GameState, Value)
% ==============================
% evaluate the current game state
% (high scores good for X, low scores good for O
%
% the order in which the evaluation rules are listed is critical,
% as it prioritizes the decision making process
% e.g. if it is O's turn and both X and O have two-in-a-row somewhere
% O should prioritize winning rather than blocking
% base cases, the game has been won or drawn
evaluateState([Board, _, _, _, _, _], Value) :-
winner(Board, plyrX), calcTurns(Board, Turns), Value is 300 - Turns.
evaluateState([Board, _, _, _, _, _], Value) :-
winner(Board, plyrO), calcTurns(Board, Turns), Value is Turns - 300.
evaluateState([Board, _, _, _, _, _], 0) :- tieGame(Board).
% if it is X's turn and X can win
% treat it like an X win case 1 turn away, 299-Turns
evaluateState([Board, _, _, _, plyrX, _], Value) :-
winnable(Board, plyrX, Ways), Ways > 0,
calcTurns(Board, Turns), Value is 299 - Turns.
% if it is O's turn and O can win
% treat it like an O win case 1 turn away, Turns-299
evaluateState([Board, _, _, _, plyrO, _], Value) :-
winnable(Board, plyrO, Ways), Ways > 0,
calcTurns(Board, Turns), Value is Turns - 299.
% if it is X's turn and O can win multiple ways
% treat it like an O win case 2 turns away, Turns-298
evaluateState([Board, _, _, _, plyrX, _], Value) :-
winnable(Board, plyrO, Ways), Ways > 1,
calcTurns(Board, Turns), Value is Turns - 298.
% if it is O's turn and X can win multiple ways
% treat it like an X win case 2 turns away, 298-Turns
evaluateState([Board, _, _, _, plyrO, _], Value) :-
winnable(Board, plyrX, Ways), Ways > 1,
calcTurns(Board, Turns), Value is 298 - Turns.
% the default is to treat the current state as indifferent
evaluateState(_, 0).
% winnable(Board, Player, Count)
% =============================
% counts the number of winning moves the player has
% on the current board
winnable([R11, R12, R13, R21, R22, R23, R31, R32, R33], Player, Count) :-
evalTrio(R11, R12, R13, Player, Row1),
evalTrio(R21, R22, R23, Player, Row2),
evalTrio(R31, R32, R33, Player, Row3),
evalTrio(R11, R21, R31, Player, Col1),
evalTrio(R12, R22, R32, Player, Col2),
evalTrio(R13, R23, R33, Player, Col3),
evalTrio(R11, R22, R33, Player, Dia1),
evalTrio(R13, R22, R31, Player, Dia2),
Count is (Row1 + Row2 + Row3 + Col1 + Col2 + Col3 + Dia1 + Dia2).
% evalTrio(A, B, C, Plyr, Count)
% ==============================
% Count is 1 if the player owns two of the three spots and the other is empty
% Count is 0 otherwise
evalTrio(Plyr, Plyr, empty, Plyr, 1).
evalTrio(Plyr, empty, Plyr, Plyr, 1).
evalTrio(empty, Plyr, Plyr, Plyr, 1).
evalTrio(_, _, _, _, 0).
% pickBest(StateList, TurnLimit, BestMove, MoveValue)
% ===================================================
% picks the best of a list of states generated by minimax
% rule 1 applies when there is only one state in the list
% so the turn limit is irrelevant and there is
% only one possible move and value
pickBest([GmState1], _, Move, Value) :-
% for tic tac toe if there is only one next state then it is
% the last move of the game so we could simply evaluate it,
% but for more general games there might be other moves
% enabled afterwards, so we would have to pursue minimax
% further to figure out the end value of this move
% e.g. NewLimit is TurnLimit - 1,
% minimax(GmState1, NewLimit, NextMove, NextValue).
getLastMove(GmState1, Move),
evaluateState(GmState1, Value).
% general case, pick the better of the head state and the best of the rest
pickBest([GmState1 | OtherStates], TurnLimit, BestMove, BestValue) :-
% evaluate the head state now via minimax
NewLimit is TurnLimit - 1,
getLastMove(GmState1, Move1),
minimax(GmState1, NewLimit, _, Value1),
% get the rest of the states evaluated
% (they are at the same turn level as GmState1, so pass the original turn limit)
pickBest(OtherStates, TurnLimit, Move2, Value2),
% choose the better of the head state and the best of the rest
getCurrPlayer(GmState1, CurrPlyr),
pickBetterMove(CurrPlyr, Move1, Value1, Move2, Value2, BestMove, BestValue).
% pickBetterMove(Plyr, Move1, Value1, Move2, Value2, BetterMove, BetterValue)
% =========================================================================
% which of two moves has the better associated value for the current player?
% for X's sake high values are good,
% for O's sake low values are good
% rules 1 and 2 apply when the two moves are equal,
% there is a 50% chance of picking each of the two states
pickBetterMove(_, Move1, Value1, _, Value1, Move1, Value1) :- random(1,3,N), N < 2.
pickBetterMove(_, _, Value2, Move2, Value2, Move2, Value2).
% rule 3 applies when GmState1 has the better value for current player X
% (reversed since have already swapped 'current player' field)
pickBetterMove(plyrX, Move1, Value1, _, Value2, Move1, Value1) :- Value1 < Value2, !.
% rule 4 applies when GmState1 has the better value for current player O
% (reversed since have already swapped 'current player' field)
pickBetterMove(plyrO, Move1, Value1, _, Value2, Move1, Value1) :- Value1 > Value2, !.
% apply rule 5 for any other case, GmState2 must be better
pickBetterMove(_, _, _, Move2, Value2, Move2, Value2).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/exprchk.pl
% simple DCG syntax checker for statements of the form
% Var = Expr
%
% where
% Var can be x, y, or z
% Expr can be a Var
% or Var Op Expr
% Op can be +, -, *, or /
%
% assumes the statement is provided as a list of atoms,
% e.g. x = y * z is checked using
% ok(['x', '=', 'y', '*', 'z']).
ok(L) :- phrase(stmt, L, []).
stmt --> var, ['='], expr.
var --> ['x'] ; ['y'] ; ['z'].
op --> ['+'] ; ['-'] ; ['/'] ; ['*'].
expr --> var.
expr --> var, op, expr.
% --------- test cases ---------
t1 :- L = ['x', '=', 'y', '+', 'z', '*', x],
ok(L), format("~w is ok~n", [L]).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/brackets.pl
% dcg grammar to accept list of matching brackets
ok(L) :- phrase(bracks, L, []).
bracks --> [].
bracks --> ['('], bracks, [')'], bracks.
bracks --> ['['], bracks, [']'], bracks.
bracks --> ['{'], bracks, ['}'], bracks.
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/sentences.pl
% --------------- query format --------------
% examine(S) where S is the sentence as a list of atoms,
% e.g. examine([the, strange, bird, flew, quickly ]).
% Valid sentence: [indefinite,[nature,animate]]
%
examine(S) :- phrase(sentence(Info), S, []),
format("Valid sentence: ~w~n", Info).
% --------- accepted forms of speech ----------------
% nouns will be categorized as living or inanimate
noun(inanimate) --> [plane].
noun(inanimate) --> [rock].
noun(animate) --> [bird].
noun(animate) --> [frog].
% valid verbs
verb(past) --> [flew].
verb(present) --> [flies].
verb(future) --> [will, fly].
% valid articles
article(indefinite) --> [the].
article(indefinite) --> [a].
% valid adverbs
adverb(speed) --> [safely].
adverb(speed) --> [quickly].
adverb(frequency) --> [N, times], { number(N) }.
% valid adjectives
adjective(demonstrative) --> [that].
adjective(colour) --> [red].
adjective(size) --> [big].
adjective(nature) --> [strange].
% valid verb phrases, Info will be instantiated with the verb tense
verbphrase(Info) --> verb(Info).
verbphrase([AInfo, VInfo]) --> verb(VInfo), adverb(AInfo).
verbphrase([qualified, Info]) --> adverb, verb(Info).
% valid nouns and noun phrases, Info will be instantiated with living or inanimate
qualifiednoun(Info) --> noun(Info).
qualifiednoun([AInfo,NInfo]) --> adjective(AInfo), noun(NInfo).
nounphrase(Info) --> qualifiednoun(Info).
nounphrase([AInfo,NInfo]) --> article(AInfo), qualifiednoun(NInfo).
% a sentences is formed by a noun phrase followed by a verb phrase
sentence([NounInfo, VerbInfo]) --> nounphrase(NounInfo), verbphrase(VerbInfo).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/concat.pl
% describe a list of lists using dcgs
list([]) --> [].
list([L|Lists]) --> [L], list(Lists).
% use that to form concatenated lists
concat([]) --> [].
concat([L|Lists]) --> list(L), concat(Lists).
% make a prolog concatenate goal
concatenate(LoL, Result) :- phrase(concat(LoL), Result, []).
% ------------ testing -----------------------------
t1 :- LoL = [[1,2],[3],[4,5,6]],
concatenate(LoL, Result),
format("LoL: ~w~nRes: ~w~n", [LoL,Result]).
t2 :- LoL = [[1,2],[3],[4,5,6]],
Result = [1,2,3,4,5,6],
concatenate(LoL, Result),
format("LoL: ~w~nRes: ~w~n", [LoL,Result]).
t3 :- LoL = [[1,2],X,[4,5,6]],
Result = [Y,2,3,4,5,6],
concatenate(LoL, Result),
format("LoL: ~w~nRes: ~w~nX,Y: ~w,~w~n", [LoL,Result,X,Y]).
% ------------ sample runs -------------------------
% ?- t1.
% LoL: [[1,2],[3],[4,5,6]]
% Res: [1,2,3,4,5,6]
% true.
%
% ?- t2.
% LoL: [[1,2],[3],[4,5,6]]
% Res: [1,2,3,4,5,6]
% true.
%
% ?- t3.
% LoL: [[1,2],[3],[4,5,6]]
% Res: [1,2,3,4,5,6]
% X,Y: [3],1
% true
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/lisp2C.pl
% translate lisp code into C
% --------------------------
%
% e.g. translate a single lisp statement into a single C statement
% or translate a series of lisp statements into a C program
% by embedding them inside a main routine
%
% it currently handles the following styles of lisp statement:
% (defvar V N) where V is a variable name and N is a number or variable
% (F Args) where F is a function name and Args is one or more variables,
% numbers, or function calls
% (setf V N) where V is a variable name and N is a number, variable,
% or function call
%
% at the moment, the lisp code accepted and the C code produced must be in
% the form of lists of atoms - a set of sample routines are provided to
% print them in a more user friendly form (at the bottom of this file).
%
% sample output: (shows the original lisp and the C translation)
% --------------
% lisp:
% ( defvar X 3 ) ( f 3 X ) ( setf X ( g 5.5 ) )
%
% C:
% int main ( ) {
% double X = 3 ;
% f ( 3 , X ) ;
% X = g ( 5.5 ) ;
% }
%
% Underlying grammar decomposition:
% ---------------------------------
% program --> statements
% statements --> statement
% --> statement, statements
% statement --> vardef
% --> proccall
% --> assign
% vardef --> bracket, defvar, identifier, value, bracket
% assign --> bracket, setf, identifier, value, bracket
% proccall --> funcall
% funcall --> bracket, identifier, argslist, bracket
% arguments --> argument
% --> argument, arguments
% argument --> identifier
% --> value
% --> funcall
% identifier --> atom (that isn't reserved)
% value --> number
%
% most rules are presented in the form
% goal(CCode) -->
% subgoal1, subgoal2, etc,
% { prolog to produce the C Code }.
% translate one or more lisp statements into C, and embed that into a C main
program(CCode) -->
statements(P),
{ concatenate([['int', 'main', '(', ')', '{'], P, ['}']], CCode) }.
% statements can be either a single statement or multiple
statements([S]) -->
statement(S).
statements([First|Rest]) -->
statement(First),statements(Rest).
% supported statement types are:
% variable declarations using defvar,
% assignment statements using setf,
% function calls
statement(Info) -->
vardef(Info).
statement(Info) -->
proccall(Info).
statement(Info) -->
assign(Info).
% translate (defvar Var Value) into double Var = Value;
vardef(CCode) -->
openB, vdef, identifier(Var), argument(Val), closeB,
{ CCode = ['double', Var, '=', Val, ';'] }.
% translate (setf Var Value) into Var = Value;
assign(CCode) -->
openB, setf, identifier(Var), argument(Val), closeB,
{ CCode = [Var, '=', Val, ';'] }.
% translate stand-alone function call into a stand-alone C statement
proccall(CCode) -->
funcall(FCode),
{ append(FCode, [';'], CCode) }.
% translate (F A B C ...) into F(A, B, C, ...)
funcall([F, '(' | Rest]) -->
openB, identifier(F), arguments(Vals), closeB,
{ append(Vals, [ ')' ], Rest) }.
% arguments can be a single argument or multiple
arguments(CCode) -->
argument(Val),
{ CCode = [ Val ] }.
arguments(CCode) -->
argument(Val), arguments(Vals),
{ CCode = [ Val, ',' | Vals ] }.
% valid arguments can be variables, numbers, or function calls
argument(Var) -->
identifier(Var).
argument(Val) -->
value(Val).
argument(FCode) -->
funcall(FCode).
% identifiers are any non-keyword
identifier(Id) -->
[ Id ],
{ atom(Id), Id \= 'defvar', Id \= 'setf' }.
% numbers are retained as-is
value(Val) -->
[ Val ],
{ number(Val) }.
% identify core lisp symbols and keywords
setf --> ['setf'].
vdef --> ['defvar'].
openB --> ['('].
closeB --> [')'].
% -------------- Concatenation ------------
% describe a list of lists using dcgs
list([]) --> [].
list([L|Lists]) --> [L], list(Lists).
% use that to form concatenated lists
concat([]) --> [].
concat([L|Lists]) --> list(L), concat(Lists).
% make a regular prolog concatenate rule
concatenate(LoL, Result) :- phrase(concat(LoL), Result, []).
% -------------- Pretty-printer ------------
printCode(Lang, Codelist) :- format("~w:~n", [Lang]),
foreach(member(S,Codelist),
(is_list(S) -> foreach(member(E,S), printSym(Lang, E))
; printSym(Lang, S))), nl.
printSym("C", Sym) :- member(Sym, ['{', '}', ';']), format("~w~n", [Sym]).
printSym(_, Sym) :- format("~w ", [Sym]).
% -------------- Sample tests --------------
checkS(L,S) :- phrase(statement(S), L, []).
checkP(L,P) :- phrase(program(P), L, []).
% t1 translates a defvar statement
% (defvar X 3) ==> double X = 3;
t1 :- L = ['(', 'defvar', 'X', '3', ')'],
checkS(L, S),
printCode("lisp", L),
printCode("C", S).
% t2 translates a function call with two args
% (f 3 Abc) ==> f(3,Abc);
t2 :- L = ['(', 'f', '3', 'Abc', ')'],
checkS(L, S),
printCode("lisp", L),
printCode("C", S).
% t3 translates a setf
% (setf foo -13) ==> foo = -13;
t3 :- L = ['(', 'setf', 'foo', '-13', ')'],
checkS(L, S),
printCode("lisp", L),
printCode("C", S).
% t4 translates a setf with a function call
% (setf X (f 5.5)) ==> X = f(5.5);
t4 :- L = ['(', 'setf', 'X', '(', 'f', '5.5', ')', ')'],
checkS(L, S),
printCode("lisp", L),
printCode("C", S).
% t10 translates a program that contains the statements from t1,t2,t3
t10 :- L = [ '(', 'defvar', 'X', '3', ')',
'(', 'f', '3', 'X', ')',
'(', 'setf', 'X', '3', ')'
],
checkP(L, P),
printCode("lisp", L), nl,
printCode("C", P).
% --------------- Sample runs --------------
%
% ?- t1.
% lisp:
% ( defvar X 3 )
%
% C:
% double X = 3 ;
% true
%
% ?- t2.
% lisp: ( f 3 Abc )
%
% C:
% f ( 3 , Abc ) ;
% true
%
% ?- t3.
% lisp:
% ( setf foo -13 )
%
% C:
% foo = -13 ;
% true
%
% ?- t4.
% lisp:
% ( setf X ( f 5.5 ) )
%
% C:
% X = f ( 5.5 ) ;
% true
%
% ?- t10.
% lisp:
% ( defvar X 3 ) ( f 3 X ) ( setf X 3 )
%
% C:
% int main ( ) {
% double X = 3 ;
% f ( 3 , X ) ;
% X = 3 ;
% }
% true
%
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/gameSkeleton.pl
% %%%%%%%%%%%% USE INSTRUCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%
% fire up prolog, use ['filename']. to load this file,
% then type "start." to begin the game
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% dynamic setup notes:
%
% we will want to change the set of facts during the game,
% for instance if the player takes something from a
% location we want to add a new fact saying the player
% has the item, and remove the fact that says the thing
% is at the location
%
% to enable such dynamic facts we specify the name of the
% fact and the number of parameters it can take,
% then we use asserta(...new fact...) to add new facts or
% retract(...old fact...) to remove them
% for instance, our dynamic facts may focus on what the player
% possesses and which lights are currently turned on
:- dynamic(have/1).
:- dynamic(turned_on/1).
% we will also have the "main routine" make a series of
% assertions to establish the initial location of
% items and the player
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% main routine:
% displays the opening messages and instructions,
% gives the user a look around their starting location,
% and starts the command/execution sequence
start:-
% make a series of initial assertions about item locations etc
init_dynamic_facts,
% give the player an intro to the game
write('The search for better karma...'), nl, nl,
write('You can try using simple English commands such as'),nl,
write('take the whatever, look around, go to the kitchen, etc)'),nl,
write('I''ll let you know if I cannot understand a command.'),nl, nl,
write('Hit any key to begin.'),get0(_),
write('Type ''quit'' to give up.'),nl, nl,
% the majority of the game is controlled through the
% command execution loop
command_loop.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% command_loop - repeats until the game ends,
% gets the next user command, executes it,
% and checks to see if the game should end
% (if the player won or quit)
command_loop:- get_command(X), execute(X), check_for_quit(X).
check_for_quit(quit).
check_for_quit(_) :- victory.
check_for_quit(_) :- command_loop.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% execute - matches the user's input command with the the predicate
% which will actually carry out the command.
%
% The currently supported commands are to go to a location,
% take something, drop something, eat something,
% turn something on/off, look around,
% list your current items, get help, get a hint, or quit
%
% Note: the cuts at the end of each do are there to prevent
% the command_loop from backtracking after one command
% has been successfully processed
%
% We have to identify the set of user actions we can support,
% then create further facts/rules to interpret and support
% those actions.
execute(goto(X)):-goto(X),!.
execute(take(X)):-take(X),!.
execute(eat(X)):-eat(X),!.
execute(look):-look,!.
execute(turn_on(X)):-turn_on(X),!.
execute(look_in(X)):-look_in(X),!.
execute(quit):-quit,!.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The player has won if they've found some karma
victory:-
have(karma),
write('Congratulations, you gained karma.'),nl,
write('Now you can rest secure.'),nl,nl.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The game is over if the user decided to quit
quit:-
write('Giving up? Too bad, it''s a scary world when you have bad karma!'),nl,nl.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%% GENERAL FACTS/RULES %%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Initial facts describing the world. Rooms and doors do not change,
% so their facts do not need to be established dynamically
% available rooms
room(office).
room(kitchen).
room(cellar).
% doors between the rooms
door(kitchen,cellar).
door(kitchen,office).
% rules to specify rooms are connected if there is
% a door (in either direction)
connect(Room1,Room2):- door(Room1,Room2).
connect(Room1,Room2):- door(Room2,Room1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% These facts are all subject to change during the game,
% so we assert them at the start of the game
init_dynamic_facts:-
assertz(location(desk,office)),
assertz(location(apple,kitchen)),
assertz(location(flashlight,desk)),
assertz(location('mini fridge',cellar)),
assertz(location(karma,'mini fridge')),
assertz(location(cabbage,kitchen)),
assertz(here(kitchen)),
assertz(turned_off(flashlight)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Items of furniture cannot be taken, but they can be
% climbed on, looked in, etc (depending on the item)
furniture(desk).
furniture('mini fridge').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Well, folks are likely to stick things in their mouth,
% so we better tell them when it's actually edible
edible(apple).
% Of course, some things are going to taste pretty gross...
tastes_gross(cabbage).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%% COMMANDS %%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% goto attempts to move the player from one room to another
%
% this involves checking if the move is legal,
% updating any special conditions relating to victory,
% adjusting the player's current location,
% and giving them a look around the new room.
goto(Room):-
valid_move(Room),
cellar_puzzle(goto(Room)),
move_to(Room).
goto(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% an attempt to move to a room is legal if there is a
% connection from the player's current room to
% the desired room
%
% (display an error message if they attempt an illegal move)
valid_move(Room):-
here(Here),
connect(Here,Room),!.
valid_move(Room):-
respond(['You can''t get to the ',Room,' from here']),fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% when they actually make the move we have to wipe out their
% old location and assert their new location
move_to(Room):-
retract(here(_)),
asserta(here(Room)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% the look command tells the player what is in their current
% room and which other rooms it's connected to
look:-
here(Here),
respond(['You are in the ',Here]),
write('You can see the following things:'),nl,
list_things(Here),
write('You can go to the following rooms:'),nl,
list_connections(Here).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% list things displays the items in the specified location
list_things(Place):-
location(X,Place),
tab(2),write(X),nl,
fail.
list_things(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% list connections displays the locations adjacent to the
% specified location
list_connections(Place):-
connect(Place,X),
tab(2),write(X),nl,
fail.
list_connections(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% look_in allows the player to look inside anything which might
% contain other things,
%
% It does so by checking to see if the item they specify is
% currently the location of one or more other items,
% otherwise it says there is nothing there
look_in(Thing):-
location(_,Thing),
write('The '),write(Thing),write(' contains:'),nl,
list_things(Thing).
look_in(Thing):-
respond(['There is nothing in the ',Thing]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% take allows the player to take an item as long as it is
% in the current room and is listed as a takeable object
% (even if it is inside something else that is in the room)
take(Thing):-
is_here(Thing),
is_takable(Thing),
move(Thing,have),
respond(['You now have the ',Thing]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% is here checks to see if the specified item is located
% in the current room, even if it's inside something else
% in the room
% (but not including things the player already possesses)
is_here(Thing):-
here(Here),
contains(Thing,Here),!.
is_here(Thing):-
respond(['There is no ',Thing,' here']),
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% contains checks to see if what is in the specified item,
% and also what is inside things inside the item (if anything)
% (and what is inside those items, etc)
contains(Thing,Here):-
location(Thing,Here).
contains(Thing,Here):-
location(Thing,X),
contains(X,Here).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% this check prevents the player from trying to take something
% they can't pick up (just furniture at the moment)
is_takable(Thing):-
furniture(Thing),
respond(['You can''t pick up a ',Thing]),
!,fail.
is_takable(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% move is used to transfer the location of an item,
% right now it's only used/implemented to pick things up,
% so the item goes from its current location to your possession
move(Thing,have):-
retract(location(Thing,_)),
asserta(have(Thing)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% eat allows the player to ATTEMPT to eat something, but only
% REALLY allows the attempt if they currently have the item
%
% it uses edible to check if the thing can actually be eaten,
% tastes_gross to handle eating anything disgusting,
% or assumes it tasted pretty good
eat(Thing):-
have(Thing),
really_eat(Thing).
eat(Thing):-
respond(['You don''t have the ',Thing]).
really_eat(Thing):-
edible(Thing),
retract(have(Thing)),
respond(['That ',Thing,' was good']).
really_eat(Thing):-
tastes_gross(Thing),
respond(['OK, that was pretty gross']).
really_eat(Thing):-
respond(['You can''t eat a ',Thing]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% list_possessions displays all the items you currently have,
% i.e. all the haves that have been asserted
% and not retracted so far
list_possessions:-
have(X),
tab(2),write(X),nl, fail.
list_possessions.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if the player tries to turn on a light
% they're told they can't find a switch
% if they try to turn on an item they don't have
% they'll get an error message
% if they try to turn on something they DO have
% it works if the item was previously turned off
% and it is something that can be turned on
% (otherwise appropriate error messages are generated)
%
% The list of things that are initially on/off
% needs to be established in the init_dynamic_facts,
% so we can use assert and retract to keep
% them up to date
turn_on(light):-
respond(['You can''t find the switch']).
turn_on(Thing):-
have(Thing),
turn_on_item(Thing).
turn_on(Thing):-
respond(['You don''t have the ',Thing]).
turn_on_item(Thing):-
turned_on(Thing),
respond(['The ',Thing,' is already on']).
turn_on_item(Thing):-
turned_off(Thing),
retract(turned_off(Thing)),
asserta(turned_on(Thing)),
respond(['The ',Thing,' is now on']).
turn_on_item(Thing):-
respond(['You can''t turn a ',Thing,' on']).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Each puzzle will need its own set of static rules and
% dynamic facts to keep track of whether it has been solved.
%
% For this one, to get into the cellar you must have a flashlight
% and it must be turned on,
% but if you're trying to get into any other room this part of
% the code ignores it (the anonymous accept case at the end)
cellar_puzzle(goto(cellar)):-
have(flashlight),
turned_on(flashlight),!.
cellar_puzzle(goto(cellar)):-
write('You can''t go to the cellar because it''s dark in the'),nl,
write('cellar, and you''re afraid of the dark.'),nl, !,fail.
cellar_puzzle(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% respond takes a list of text items and variables and displays
% each of them in turn,
% then follows it with a period and a blank line
respond([]):-
write('.'),nl,nl.
respond([H|T]):-
write(H),
respond(T).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%% INTERPRETTER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This is a very simple command interpretter for the few English
% phrases this thing understands.
%
% It's pretty loose on grammar, letting the player get away with
% a lot.
% get_command prompts the user,
% reads in a sentence and stores it as a list of words,
% calls command to work out the grammatical structure,
% and stores it as a structure
get_command(C):-
write('cmd> '),
read_word_list(L),
phrase(command(Grammar),L,[]),
C =.. Grammar,!.
% if we get to this version of get_command it means the parser
% above failed to make sense of the command sentence
get_command(C):-
respond(['Sorry, I did not understand that',C]),fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Right now it will accept as commands:
% - a location name (meaning go to the location)
% - a command with one argument (e.g. eat dirt)
% - a command with no arguments (e.g. look)
% check for verb+item combinations
command([Pred,Arg]) --> verb(Type,Pred), nounphrase(Type,Arg).
% check for solitary verb combinations
command([Pred]) --> verb(intran,Pred).
% check for goto+destination combinations
command([goto,Arg]) --> noun(go_place,Arg).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Right now it recognizes three general forms of verb, but
% it also recognizes some loose phrases as equivalent to single
% word commands for a little more flexibility
verb(go_place,goto) --> go_verb.
verb(thing,V) --> tran_verb(V).
verb(intran,V) --> intran_verb(V).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Here we check to see if the potential verb matches any of
% the go-to phrases, i.e. "go", "go to", or "g"
go_verb --> [go,to].
go_verb --> [go].
go_verb --> [g].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Here we check to see if the potential verb matches any of
% the verb phrases which are supposed to be applied to
% an object (e.g. take, drop, eat, etc)
% verbs to grab an item
tran_verb(take) --> [take].
tran_verb(take) --> [grab].
tran_verb(take) --> [pick,up].
% verbs to eat something
tran_verb(eat) --> [eat].
% verbs to turn things on/off
tran_verb(turn_on) --> [turn,on].
tran_verb(turn_on) --> [switch,on].
% verbs to specifically look in/at things
tran_verb(look_in) --> [look,inside].
tran_verb(look_in) --> [look,in].
tran_verb(look_in) --> [open].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Here we check to see if the potential verb matches any of
% the simple verb phrases which are supposed to represent
% independent commands (e.g. look around, quit, get help)
% verbs to look around
intran_verb(look) --> [look,around].
intran_verb(look) --> [look].
intran_verb(look) --> [l].
% verbs to quit
intran_verb(quit) --> [quit].
intran_verb(quit) --> [q].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% a noun phrase is just a noun with an optional determiner
% in front (e.g. "the book")
nounphrase(Type,Noun) --> det,noun(Type,Noun).
nounphrase(Type,Noun) --> noun(Type,Noun).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% just handles "the" for now
det --> [the].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Nouns might be a single word describing a place or thing
% or a pair of words (e.g. dining room)
% check if the item is a recognized room,
noun(go_place,R) --> [R], {room(R)}.
% check if the item is a valid location
noun(thing,T) --> [T], {location(T,_)}.
% if it's a thing check to make sure we actually have it
noun(thing,T) --> [T], {have(T)}.
% if it's a flashlight treat it specially (see below)
noun(thing,flashlight) --> [flash,light].
% identify any acceptable two-word nouns
noun(thing,'mini fridge') --> [mini,fridge].
% If the player has just typed light, (e.g. to turn it on/off)
% they could mean a room light or a flashlight,
% and we'll default to just a light
noun(thing,light) --> [X,light], {room(X)}.
noun(thing,flashlight) --> [light], {have(flashlight)}.
noun(thing,light) --> [light].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%% PARSER / READER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% The parser reads characters typed by the user,
% building them into words, recognizing where
% one word has ended and a new one has begun,
% and putting the words together into a list.
%
% Certain symbols and punctuation marks will be
% seperated at this point, setting them aside
% as distinct items.
%
% Once the list is complete, the interpretter (above)
% can be used to try and determine the meaning
% of the word as a statement or sentence.
%
% Read the first character of the next word with get0,
% finish composing the word (W) using read_word,
% finish composing the rest of the words in the
% sentence (Ws) using rest_of_sentence
read_word_list([W|Ws]) :-
get0(C),
read_word(C, W, C1),
rest_of_sentence(C1, Ws), !.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Here we grab the rest of the sentence
% end_of_sentence tells us if we're at the end
% (when we've hit a ! . ? or end-of-line)
rest_of_sentence(C,[]) :- end_of_sentence(C), !.
% the general case is that we have to read the next word
% and the rest of the sentence
% (just as with read_word_list)
rest_of_sentence(C,[W1|Ws]) :-
read_word(C,W1,C1),
rest_of_sentence(C1,Ws).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Here we grab the rest of a word, storing it in W,
% assuming the first character was read in in C
% We wind up with C1 being the first character
% AFTER the current word's completion
% if C is a punctuation mark it is treated as a valid
% word all by itself, so set W to contain just that character
read_word(C,W,C1) :-
single_char(C), !,
name(W, [C]),
get0(C1).
% if C is a valid character to appear in a "regular" word
% (i.e. alphanumeric) then continue building the word
% using rest_of_word and glue it together to form W
read_word(C,W,C2) :-
char_in_word(C, NewC),
get0(C1),
rest_of_word(C1,Cs,C2),
name(W, [NewC|Cs]).
% otherwise C must be a seperator (pretty much anything not
% covered above) so it's time to start a new word
read_word(_,W,C2) :-
get0(C1),
read_word(C1,W,C2).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% rest_of_word checks that the latest character is valid for
% the body of a word, tacks it on to our word-in-progress,
% and continues
% We wind up with C2 being the first character
% AFTER the current word's completion
rest_of_word(C, [NewC|Cs], C2) :-
char_in_word(C, NewC),
get0(C1),
rest_of_word(C1, Cs, C2).
% our base/stopping case
rest_of_word(C, [], C).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% here we list all the characters that will be treated
% as if they were words by themselves,
% i.e. punctuation that doesn't appear in the middle of a word
single_char(0',).
single_char(0';).
single_char(0':).
single_char(0'?).
single_char(0'!).
single_char(0'.).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% here we list all the characters that can appear as a valid
% part of a larger word, mostly alpha-numeric
char_in_word(C, C) :- C >= 0'a, C =< 0'z.
char_in_word(C, C) :- C >= 0'0, C =< 0'9.
char_in_word(C, L) :- C >= 0'A, C =< 0'Z, L is C + 32.
char_in_word(0'-,0'-).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% end_of_sentence checks if the character is the valid end of a
% sentence, i.e. a newline, . ! or ?
end_of_sentence(10). % end if new line entered
end_of_sentence(0'.).
end_of_sentence(0'!).
end_of_sentence(0'?).
%% http://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/shapes.pl
% shape(S)
% --------
% succeeds iff S is a valid shape
shape(circle(X,Y,Z)) :- circle(X,Y,Z).
shape(box(L,R,T,B)) :- box(L,R,T,B).
% circle(X,Y,R)
% -------------
% succeeds iff the item represents a valid circle
% x,y represents the centrepoint of a circle on an x,y plane
% r represents the radius of the circle
circle(X,Y,R) :- number(X), number(Y), number(R), R > 0.
% box(Left,Right,Top,Bottom)
% --------------------------
% succeeds iff the item represents a valid box
% where the box edges are parallel to the x/y planes
% left,right represent the x coordinates of the left/right edges
% top,bottom represent the y coordinates of the top/bottom edges
box(Left,Right,Top,Bottom) :-
number(Left), number(Right), Left < Right,
number(Top), number(Bottom), Bottom < Top.
% area(S,A)
% ---------
% succeeds iff A is the area of shape S
area(circle(_,_,R),A) :- Area is 3.14 * R * R, A = Area.
area(box(L,R,T,B),A) :- H is R - L, V is T - B, Area is H * V, A = Area.
% distance(X1,Y1,X2,Y2,D)
% -----------------------
% succeeds iff D can be unified with the distance between the two points
distance(X1,Y1,X2,Y2,D) :- number(X1), number(X2), number(Y1), number(Y2),
Dist is sqrt((X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2)), D = Dist.
% distance(C1, C2, D)
% ---------------------
% succeeds iff D can be unified with the distance between the centres of the two circles
distance(circle(X1,Y1,R1),circle(X2,Y2,R2),D) :-
circle(X1,Y1,R1), circle(X2,Y2,R2), distance(X1,Y1,X2,Y2,D).
% overlap(C1,C2)
% --------------
% succeeds iff the two circles overlap
overlap(C1, C2) :- C1 = circle(_,_,R1), C2 = circle(_,_,R2),
distance(C1,C2,D), D =< (R1+R2).
woman(mia).
woman(yolanda).
legs(mia).
tall(X) :- woman(X), legs(X).
main :- tall(X), format("test ~a", X).
- http://lpn.swi-prolog.org/lpnpage.php?pagetype=html&pageid=lpn-htmlse5https%3A%2F
- http://tau-prolog.org/
- http://www.cs.oswego.edu/~odendahl/coursework/notes/prolog/synopsis/con.html
- http://www.cs.utexas.edu/users/tag/cc/ccalc.html
- http://www.swi-prolog.org/pldoc/man
- https://dev.to/arcanis/introducing-yarn-2-4eh1
- https://github.com/cmungall/prologterms-py
- https://github.com/klauscfhq/awesome-prolog
- https://github.com/stassa/wh40ksim
- https://github.com/yuce/pyswip
- https://www.cs.utexas.edu/users/tag/cc/tutorial/toc.html
- https://www.metalevel.at/prolog
- https://athena.ecs.csus.edu/~mei/logicp/prolog/swi-prolog.html
- https://www.csci.viu.ca/~wesselsd/courses/csci330/code/prolog/