-
Notifications
You must be signed in to change notification settings - Fork 0
/
amzi2.com-prolog-demo
1211 lines (1008 loc) · 33 KB
/
amzi2.com-prolog-demo
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
% NANI SEARCH - A sample adventure game
% Nani Search is designed to illustrate Prolog programming. It
% is an implementation of the principle example used in
% this tutorial.
main:- nani_search. % main entry point
nani_search:-
init_dynamic_facts, % predicates which are not compiled
write('NANI SEARCH - A Sample Adventure Game'),nl,
write('Copyright (C) Amzi! inc. 1990-2010'),nl,
write('No rights reserved, use it as you wish'),nl,
nl,
write('Nani Search is designed to illustrate Prolog programming.'),nl,
write('As such, it might be the simplest adventure game. The game'),nl,
write('is the primary example used in this tutorial.'),nl,
write('Full source is included as well.'),nl,
nl,
write('Your persona as the adventurer is that of a three year'),nl,
write('old. The Nani is your security blanket. It is getting'),nl,
write('late and you''re tired, but you can''t go to sleep'),nl,
write('without your Nani. Your mission is to find the Nani.'),nl,
nl,
write('You control the game by using simple English commands'),nl,
write('expressing the action you wish to take. You can go to'),nl,
write('other rooms, look at your surroundings, look in things'),nl,
write('take things, drop things, eat things, inventory the'),nl,
write('things you have, and turn things on and off.'),nl,
nl,
write('Hit any key to continue.'),get0(_),
write('Type "help" if you need more help on mechanics.'),nl,
write('Type "hint" if you want a big hint.'),nl,
write('Type "quit" if you give up.'),nl,
nl,
write('Enjoy the hunt.'),nl,
look, % give a look before starting the game
command_loop.
% command_loop - repeats until either the nani is found or the
% player types quit
command_loop:-
repeat,
get_command(X),
do(X),
(nanifound; X == quit).
% do - matches the input command with the predicate which carries out
% the command. More general approaches which might work in the
% listener are not supported in the compiler. This approach
% also gives tighter control over the allowable commands.
% The cuts prevent the forced failure at the end of "command_loop"
% from backtracking into the command predicates.
do(goto(X)):-goto(X),!.
do(nshelp):-nshelp,!.
do(hint):-hint,!.
do(inventory):-inventory,!.
do(take(X)):-take(X),!.
do(drop(X)):-drop(X),!.
do(eat(X)):-eat(X),!.
do(look):-look,!.
do(turn_on(X)):-turn_on(X),!.
do(turn_off(X)):-turn_off(X),!.
do(look_in(X)):-look_in(X),!.
do(quit):-quit,!.
% These are the predicates which control exit from the game. If
% the player has taken the nani, then the call to "have(nani)" will
% succeed and the command_loop will complete. Otherwise it fails
% and command_loop will repeat.
nanifound:-
have(nani),
write('Congratulations, you saved the Nani.'),nl,
write('Now you can rest secure.'),nl,nl.
quit:-
write('Giving up? It''s going to be a scary night'),nl,
write('and when you get the Nani it''s not going'),nl,
write('to smell right.'),nl,nl.
% The help command
nshelp:-
write('Use simple English sentences to enter commands.'),nl,
write('The commands can cause you to:'),nl,
nl,
write(' go to a room (ex. go to the office)'),nl,
write(' look around (ex. look)'),nl,
write(' look in something (ex. look in the desk)'),nl,
write(' take something (ex. take the apple)'),nl,
write(' drop something (ex. drop the apple)'),nl,
write(' eat something (ex. eat the apple)'),nl,
write(' turn something on (ex. turn on the light)'),nl,
write(' inventory your things (ex. inventory)'),nl,
nl,
write('The examples are verbose, terser commands and synonyms'),nl,
write('are usually accepted.'),nl,nl,
write('Hit any key to continue.'),nl,
get0(_),
look.
hint:-
write('You need to get to the cellar, and you can''t unless'),nl,
write('you get some light. You can''t turn on the cellar'),nl,
write('light, but there is a flash light in the desk in the'),nl,
write('office you might use.'),nl,nl,
look.
% Initial facts describing the world. Rooms and doors do not change,
% so they are compiled.
room(office).
room(kitchen).
room('dining room').
room(hall).
room(cellar).
door(office,hall).
door(hall,'dining room').
door('dining room',kitchen).
door(kitchen,cellar).
door(kitchen,office).
connect(X,Y):-
door(X,Y).
connect(X,Y):-
door(Y,X).
% These facts are all subject to change during the game, so rather
% than being compiled, they are "asserted" to the listener at
% run time. This predicate is called when "nanisrch" starts up.
init_dynamic_facts:-
assertz(location(desk,office)),
assertz(location(apple,kitchen)),
assertz(location(flashlight,desk)),
assertz(location('washing machine',cellar)),
assertz(location(nani,'washing machine')),
assertz(location(table,kitchen)),
assertz(location(crackers,desk)),
assertz(location(broccoli,kitchen)),
assertz(here(kitchen)),
assertz(turned_off(flashlight)).
furniture(desk).
furniture('washing machine').
furniture(table).
edible(apple).
edible(crackers).
tastes_yuchy(broccoli).
%%%%%%%% COMMANDS %%%%%%%%%%%%%%%%%%%%%%%%%%
% goto moves the player from room to room.
goto(Room):-
can_go(Room), % check for legal move
puzzle(goto(Room)), % check for special conditions
moveto(Room), % go there and tell the player
look.
goto(_):- look.
can_go(Room):- % if there is a connection it
here(Here), % is a legal move.
connect(Here,Room),!.
can_go(Room):-
respond(['You can''t get to ',Room,' from here']),fail.
moveto(Room):- % update the logicbase with the
retract(here(_)), % new room
asserta(here(Room)).
% look lists the things in a room, and the connections
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(Place):-
location(X,Place),
tab(2),write(X),nl,
fail.
list_things(_).
list_connections(Place):-
connect(Place,X),
tab(2),write(X),nl,
fail.
list_connections(_).
% look_in allows the player to look inside a thing which might
% contain other things
look_in(Thing):-
location(_,Thing), % make sure there's at least one
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 something. As long as the thing is
% contained in the room it can be taken, even if the adventurer hasn't
% looked in the the container which contains it. Also the thing
% must not be furniture.
take(Thing):-
is_here(Thing),
is_takable(Thing),
move(Thing,have),
respond(['You now have the ',Thing]).
is_here(Thing):-
here(Here),
contains(Thing,Here),!. % don't backtrack
is_here(Thing):-
respond(['There is no ',Thing,' here']),
fail.
contains(Thing,Here):- % recursive definition to find
location(Thing,Here). % things contained in things etc.
contains(Thing,Here):-
location(Thing,X),
contains(X,Here).
is_takable(Thing):- % you can't take the furniture
furniture(Thing),
respond(['You can''t pick up a ',Thing]),
!,fail.
is_takable(_). % not furniture, ok to take
move(Thing,have):-
retract(location(Thing,_)), % take it from its old place
asserta(have(Thing)). % and add to your possessions
% drop - allows the player to transfer a possession to a room
drop(Thing):-
have(Thing), % you must have the thing to drop it
here(Here), % where are we
retract(have(Thing)),
asserta(location(Thing,Here)).
drop(Thing):-
respond(['You don''t have the ',Thing]).
% eat, because every adventure game lets you eat stuff.
eat(Thing):-
have(Thing),
eat2(Thing).
eat(Thing):-
respond(['You don''t have the ',Thing]).
eat2(Thing):-
edible(Thing),
retract(have(Thing)),
respond(['That ',Thing,' was good']).
eat2(Thing):-
tastes_yuchy(Thing),
respond(['Three year olds don''t eat ',Thing]).
eat2(Thing):-
respond(['You can''t eat a ',Thing]).
% inventory list your possesions
inventory:-
have(X), % make sure you have at least one thing
write('You have: '),nl,
list_possessions.
inventory:-
write('You have nothing'),nl.
list_possessions:-
have(X),
tab(2),write(X),nl,
fail.
list_possessions.
% turn_on recognizes two cases. If the player tries to simply turn
% on the light, it is assumed this is the room light, and the
% appropriate error message is issued. Otherwise turn_on has to
% refer to an object which is turned_off.
turn_on(light):-
respond(['You can''t reach the switch and there''s nothing to stand on']).
turn_on(Thing):-
have(Thing),
turn_on2(Thing).
turn_on(Thing):-
respond(['You don''t have the ',Thing]).
turn_on2(Thing):-
turned_on(Thing),
respond([Thing,' is already on']).
turn_on2(Thing):-
turned_off(Thing),
retract(turned_off(Thing)),
asserta(turned_on(Thing)),
respond([Thing,' turned on']).
turn_on2(Thing):-
respond(['You can''t turn a ',Thing,' on']).
% turn_off - I didn't feel like implementing turn_off
turn_off(Thing):-
respond(['I lied about being able to turn things off']).
% The only special puzzle in Nani Search has to do with going to the
% cellar. Puzzle is only called from goto for this reason. Other
% puzzles pertaining to other commands could easily be added.
puzzle(goto(cellar)):-
have(flashlight),
turned_on(flashlight),!.
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.
puzzle(_).
% respond simplifies writing a mixture of literals and variables
respond([]):-
write('.'),nl,nl.
respond([H|T]):-
write(H),
respond(T).
% Simple English command listener. It does some semantic checking
% and allows for various synonyms. Within a restricted subset of
% English, a command can be phrased many ways. Also non grammatical
% constructs are understood, for example just giving a room name
% is interpreted as the command to goto that room.
% Some interpretation is based on the situation. Notice that when
% the player says turn on the light it is ambiguous. It could mean
% the room light (which can't be turned on in the game) or the
% flash light. If the player has the flash light it is interpreted
% as flash light, otherwise it is interpreted as room light.
get_command(C):-
readlist(L), % reads a sentence and puts [it,in,list,form]
command(X,L,[]), % call the grammar for command
C =.. X,!. % make the command list a structure
get_command(_):-
respond(['I don''t understand, try again or type help']),fail.
% The grammar doesn't have to be real English. There are two
% types of commands in Nani Search, those with and without a
% single argument. A special case is also made for the command
% goto which can be activated by simply giving a room name.
command([Pred,Arg]) --> verb(Type,Pred),nounphrase(Type,Arg).
command([Pred]) --> verb(intran,Pred).
command([goto,Arg]) --> noun(go_place,Arg).
% Recognize three types of verbs. Each verb corresponds to a command,
% but there are many synonyms allowed. For example the command
% turn_on will be triggered by either "turn on" or "switch on".
verb(go_place,goto) --> go_verb.
verb(thing,V) --> tran_verb(V).
verb(intran,V) --> intran_verb(V).
go_verb --> [go].
go_verb --> [go,to].
go_verb --> [g].
tran_verb(take) --> [take].
tran_verb(take) --> [pick,up].
tran_verb(drop) --> [drop].
tran_verb(drop) --> [put].
tran_verb(drop) --> [put,down].
tran_verb(eat) --> [eat].
tran_verb(turn_on) --> [turn,on].
tran_verb(turn_on) --> [switch,on].
tran_verb(turn_off) --> [turn,off].
tran_verb(look_in) --> [look,in].
tran_verb(look_in) --> [look].
tran_verb(look_in) --> [open].
intran_verb(inventory) --> [inventory].
intran_verb(inventory) --> [i].
intran_verb(look) --> [look].
intran_verb(look) --> [look,around].
intran_verb(look) --> [l].
intran_verb(quit) --> [quit].
intran_verb(quit) --> [exit].
intran_verb(quit) --> [end].
intran_verb(quit) --> [bye].
intran_verb(nshelp) --> [help].
intran_verb(hint) --> [hint].
% a noun phrase is just a noun with an optional determiner in front.
nounphrase(Type,Noun) --> det,noun(Type,Noun).
nounphrase(Type,Noun) --> noun(Type,Noun).
det --> [the].
det --> [a].
% Nouns are defined as rooms, or things located somewhere. We define
% special cases for those things represented in Nani Search by two
% words. We can't expect the user to type the name in quotes.
noun(go_place,R) --> [R], {room(R)}.
noun(go_place,'dining room') --> [dining,room].
noun(thing,T) --> [T], {location(T,_)}.
noun(thing,T) --> [T], {have(T)}.
noun(thing,flashlight) --> [flash,light].
noun(thing,'washing machine') --> [washing,machine].
noun(thing,'dirty clothes') --> [dirty,clothes].
% If the player has just typed light, it can be interpreted three ways.
% If a room name is before it, it must be a room light. If the
% player has the flash light, assume it means the flash light. Otherwise
% assume it is the room light.
noun(thing,light) --> [X,light], {room(X)}.
noun(thing,flashlight) --> [light], {have(flashlight)}.
noun(thing,light) --> [light].
% readlist - read a list of words, based on a Clocksin & Mellish
% example.
readlist(L):-
write('> '),
read_word_list(L).
read_word_list([W|Ws]) :-
get0(C),
readword(C, W, C1), % Read word starting with C, C1 is first new
restsent(C1, Ws), !. % character - use it to get rest of sentence
restsent(C,[]) :- lastword(C), !. % Nothing left if hit last-word marker
restsent(C,[W1|Ws]) :-
readword(C,W1,C1), % Else read next word and rest of sentence
restsent(C1,Ws).
readword(C,W,C1) :- % Some words are single characters
single_char(C), % i.e. punctuation
!,
name(W, [C]), % get as an atom
get0(C1).
readword(C, W, C1) :-
is_num(C), % if we have a number --
!,
number_word(C, W, C1, _). % convert it to a genuine number
readword(C,W,C2) :- % otherwise if character does not
in_word(C, NewC), % delineate end of word - keep
get0(C1), % accumulating them until
restword(C1,Cs,C2), % we have all the word
name(W, [NewC|Cs]). % then make it an atom
readword(C,W,C2) :- % otherwise
get0(C1),
readword(C1,W,C2). % start a new word
restword(C, [NewC|Cs], C2) :-
in_word(C, NewC),
get0(C1),
restword(C1, Cs, C2).
restword(C, [], C).
single_char(0',).
single_char(0';).
single_char(0':).
single_char(0'?).
single_char(0'!).
single_char(0'.).
in_word(C, C) :- C >= 0'a, C =< 0'z.
in_word(C, L) :- C >= 0'A, C =< 0'Z, L is C + 32.
in_word(0'',0'').
in_word(0'-,0'-).
% Have character C (known integer) - keep reading integers and build
% up the number until we hit a non-integer. Return this in C1,
% and return the computed number in W.
number_word(C, W, C1, Pow10) :-
is_num(C),
!,
get0(C2),
number_word(C2, W1, C1, P10),
Pow10 is P10 * 10,
W is integer(((C - 0'0) * Pow10) + W1).
number_word(C, 0, C, 0.1).
is_num(C) :-
C =< 0'9,
C >= 0'0.
% These symbols delineate end of sentence
lastword(10). % end if new line entered
lastword(0'.).
lastword(0'!).
lastword(0'?).
Family
% GENE.PRO - genealogical relationships
%
% A Prolog database of relations derived from basic information about
% individuals. The relations ships can all be read as 'relationship
% of', so for example, parent(P,C) means P is parent of C.
%
% When there is a performance trade-of in the implementation of a rule,
% it is assumed that in general the second argument of a relation will
% most likely be bound. See for example full_sibling/2, which will
% have a smaller search for full_sibling(X,joe), than full_sibling(joe,X).
%
% This code is used as an example of an embedded Prolog application.
% One is a C++ application and the other Visual Basic.
%
% To use this code from Prolog, consult it in the listener and use the
% following predicates:
%
% open(F) - opens a file of family relationships, ex. open('england.fam').
% open/1 just does a consult, so you can use consult instead.
% close - retracts all the persons currently defined
% save(F) - saves the persons in the named file
% add_person(Name, Mother, Father, Gender, Spouse) - adds a person
% fact with the specified attributes, checking semantics as it does
% Relationship(P1, P2) - any relationship query, such as child(X,Y).
% relation(R, P1, P2) - can be used to find the relationship between
% individuals as well as pose relationship queries.
parent(P,C) :-
(mother(P,C) ; father(P,C)).
child(C,P) :- parent(P,C).
son(C,P) :- parent(P,C), male(C).
daughter(C,P) :- parent(P,C), female(C).
wife(W,P) :-
spouse(W,P),
female(W).
husband(H,P) :-
spouse(H,P),
male(H).
ancestor(A,P) :-
parent(A,P).
ancestor(A,P) :-
parent(X,P),
ancestor(A,X).
descendent(D,P) :-
parent(P,D).
descendent(D,P) :-
parent(P,X),
descendent(D,X).
full_sibling(S1, S2) :-
mother(M,S2),
mother(M,S1),
S1 \= S2,
father(F,S1),
father(F,S2).
half_sibling(S1, S2) :-
mother(M,S2),
mother(M,S1),
S1 \= S2,
father(F1,S1),
father(F2,S2),
F1 \= F2.
half_sibling(S1, S2) :-
father(F,S2),
father(F,S1),
S1 \= S2,
mother(M1,S1),
mother(M2,S2),
M1 \= M2.
sibling(S1, S2) :-
full_sibling(S1,S2).
sibling(S1, S2) :-
half_sibling(S1,S2).
sister(S,P) :-
sibling(S,P),
female(S).
brother(B,P) :-
sibling(B,P),
male(B).
step_sibling(S1, S2) :-
parent(P2, S2),
spouse(M2, P2),
parent(M2, S1),
not(parent(M2,S2)),
not(half_sibling(S1,S2)).
uncle(U,X) :-
parent(P,X),
brother(U,P).
aunt(A,X) :-
parent(P,X),
sister(A,P).
step_parent(P2,C) :-
parent(P,C),
spouse(P2,P),
not(parent(P2,C)).
step_mother(M,C) :- step_parent(M,C), female(M).
step_father(F,C) :- step_parent(F,C), male(F).
step_child(C2,P) :- step_parent(P,C2).
step_daughter(D,P) :- step_child(D,P), female(D).
step_son(S,P) :- step_child(S,P), male(S).
nephew(N,X) :-
sibling(S,X),
parent(S,N),
male(N).
niece(N,X) :-
sibling(S,X),
parent(S,N),
female(N).
cousin(X,Y) :-
parent(P,Y),
sibling(S,P),
parent(S,X).
grandmother(GM,X) :-
parent(P,X),
mother(GM,P).
grandfather(GF,X) :-
parent(P,X),
father(GF,P).
grandparent(GP,X) :-
parent(P,X), parent(GP,P).
grandson(GS,X) :-
grandchild(GS,X),
male(GS).
granddaughter(GD,X) :-
grandchild(GD,X),
female(GD).
grandchild(GC,X) :-
parent(X,C),
parent(C,GC).
%----------------------------------------------------------------------
% relation/3 - used to find relationships between individuals
%
relations([parent, wife, husband, ancestor, descendent, full_sibling,
half_sibling, sibling, sister, brother, step_sibling, uncle,
aunt, mother, father, child, son, daughter, step_parent,
step_child, step_mother, step_father, step_son, step_daughter,
nephew, niece, cousin, grandmother, grandfather, grandparent,
grandson, granddaughter, grandchild]).
relation(R, X, Y) :-
relations(Rs),
member(R,Rs),
Q =.. [R,X,Y],
call(Q).
%----------------------------------------------------------------------
% person object
%
% These predicates define the interface to a person. All of the
% genealogical rules are based on these predicates, which are
% based on the basic representation of a person. These are the
% only rules which need to be changed if the representation of
% a person is changed.
%
% The current representation is flat database relations of the form:
% person(Name, Gender, Mother, Father, Spouse).
%
add(Name,Gender,Mother,Father,Spouse) :-
assert(person(Name,Gender,Mother,Father,Spouse)).
add(Name,_,_,_,_) :-
delete(Name),
fail.
open(FileName) :-
consult(FileName).
close :-
retractall(person(_,_,_,_,_)).
save(FileName) :-
tell(FileName),
listing(person),
told.
delete(X) :-
retract(person(X,_,_,_,_)).
person(X) :-
person(X,_,_,_,_).
male(X) :-
person(X,male,_,_,_).
female(Y) :-
person(Y,female,_,_,_).
mother(M,C) :-
person(C,_,M,_,_).
father(F,C) :-
person(C,_,_,F,_).
spouse(S,P) :-
person(P,_,_,_,S),
S \= single.
%----------------------------------------------------------------------
% Semantic Integrity Checks on Update
%
add_person(Name,Gender,Mother,Father,Spouse) :-
retractall(message(_)),
dup_check(Name),
add(Name,Gender,Mother,Father,Spouse),
ancestor_check(Name),
mother_check(Name, Gender, Mother),
father_check(Name, Gender, Father),
spouse_check(Name, Spouse).
dup_check(Name) :-
person(Name),
assert(message($Person is already in database$)),
!, fail.
dup_check(_).
ancestor_check(Name) :-
ancestor(Name,Name),
assert(message($Person is their own ancestor/descendent$)),
!, fail.
ancestor_check(_).
mother_check(_, _, Mother) :- not(person(Mother)), !.
mother_check(_, _, Mother) :-
male(Mother),
assert(message($Person's mother is a man$)),
!, fail.
mother_check(Name, male, _) :-
mother(Name, X),
assert(message($Person, a male, is someone's mother$)),
!, fail.
mother_check(_,_,_).
father_check(_, _, Father) :- not(person(Father)), !.
father_check(_, _, Father) :-
female(Father),
assert(message($Person's father is a man$)),
!, fail.
father_check(Name, female, _) :-
father(Name, X),
assert(message($Person, a female, is someone's father$)),
!, fail.
father_check(_,_,_).
spouse_check(Name, Spouse) :-
spouse(Name, X),
X \= Spouse,
assert(message($Person is already someone else's spouse$)),
!, fail.
spouse_check(Name, Spouse) :-
blood_relative(Name, Spouse),
assert(message($Person is a blood relative of spouse$)),
!, fail.
spouse_check(_,_).
blood_relative(X,Y) :- (ancestor(X,Y); ancestor(Y,X)).
blood_relative(X,Y) :- sibling(X,Y).
blood_relative(X,Y) :- cousin(X,Y).
blood_relative(X,Y) :- (uncle(X,Y); uncle(Y,X)).
blood_relative(X,Y) :- (aunt(X,Y); aunt(Y,X)).
Custord
% CUSTORD
% This is a sample Prolog program which implements a portion
% of a customer order inventory application. It is not intended to
% be complete, and only illustrates the concept of writing a database
% application in Prolog.
% This example extends the concept of an intelligent database to include
% a full database application. It is really a rule based approach to
% transaction processing. In fact a large percentage of the procedural
% code normally written in database applications has to do with
% enforcing semantic integrity rules involving multiple records.
% The distinction between data and process is thoroughly blurred. Both
% reside together in the same logicbase.
% There is pure data as it might be defined in a relational database
% (customer, item, inventory, order); there are rules which really
% represent data views (item_quant); there are rules which add
% intelligence to the logicbase (good_customer, valid_order); and there
% are rules which are processes (order, report_inventory).
main :- order.
% customer(Name, Town, Credit-rating).
customer(dennis, winchester, xxx).
customer(dave, lexington, aaa).
customer(ron, lexington, bbb).
customer(julie, winchester, aaa).
customer(jawaid, cambridge, aaa).
customer(tom, newton, ccc).
% item(Number, Name, Reorder-quantity).
item(p1,thing,10).
item(p2,stuff,10).
item(p3,article,10).
item(p4,object,10).
item(p5,substance,10).
item(p6,piece,10).
item(p7,matter,10).
% inventory(Number, Quantity).
inventory(p1,10).
inventory(p2,10).
inventory(p3,10).
inventory(p4,78).
inventory(p5,23).
inventory(p6,14).
inventory(p7,8).
% item-inv view or join
item_quant(Item, Quantity):-
item(Partno, Item, _),
inventory(Partno, Quantity).
% reorder if inventory below reorder point
reorder(Item):-
item(Partno, Item, Reorder_point),
inventory(Partno, Quantity),
Quantity < Reorder_point,
write('Time to reorder '),
write(Item), nl.
reorder(Item):-
write('Inventory level ok for '),
write(Item), nl.
% a good customer has a credit rating of aaa
% or lives in winchester
% or has ordered something
good_customer(Cust):-
customer(Cust, _, aaa).
good_customer(Cust):-
customer(Cust, winchester, _).
good_customer(Cust):-
order(Cust, _, _).
% process order
order:-
write('Customer: '),
read(Customer),
write('Item: '),
read(Item),
write('Quantity: '),
read(Quantity),
valid_order(Customer,Item,Quantity),
asserta(order(Customer,Item,Quantity)),
update_inventory(Item,Quantity),
reorder(Item).
% an order is valid if
% it doesn't go below zero inventory and
% the customer is a good customer
valid_order(C, I, Q):-
item(Partno, I, _),
inventory(Partno, Onhand),
Q =< Onhand,
good_customer(C).
valid_order(C, I, Q):-
write('Bad order'),
nl,
fail.
% update the inventory
update_inventory(I,Q):-
item(Pn, I, _),
inventory(Pn, Amount),
NewQ is Amount - Q,
retract(inventory(Pn, Amount)),
asserta(inventory(Pn, NewQ)).
% inventory report
report_inventory:-
item_quant(I, Q),
write(I), tab(1),
write(Q), nl,
fail.
report_inventory:-true.
Birds
% BIRDS
% This is a sample of a classification expert system for identification
% of certain kinds of birds. The rules are rough excerpts from "Birds of
% North America" by Robbins, Bruum, Zim, and Singer.
% This type of expert system can easily use Prolog's built in inferencing
% system. While trying to satisfy the goal "bird" it tries to satisfy
% various subgoals, some of which will ask for information from the
% user.
% The information is all stored as attribute-value pairs. The attribute
% is represented as a predicate, and the value as the argument to the
% predicate. For example, the attribute-value pair "color-brown" is
% stored "color(brown)".
% "identify" is the high level goal that starts the program. The
% predicate "known/3" is used to remember answers to questions, so it
% is cleared at the beginning of the run.
% The rules of identification are the bulk of the code. They break up
% the problem into identifying orders and families before identifying
% the actual birds.
% The end of the code lists those attribute-value pairs which need
% to be asked for, and defines the predicate "ask" and "menuask"
% which are used to get information from the user, and remember it.
main :- identify.
identify:-
retractall(known(_,_,_)), % clear stored information
bird(X),
write('The bird is a '),write(X),nl.
identify:-
write('I can''t identify that bird'),nl.
order(tubenose):-
nostrils(external_tubular),
live(at_sea),
bill(hooked).
order(waterfowl):-
feet(webbed),
bill(flat).
order(falconiforms):-
eats(meat),
feet(curved_talons),
bill(sharp_hooked).
order(passerformes):-
feet(one_long_backward_toe).
family(albatross):-
order(tubenose),
size(large),
wings(long_narrow).
family(swan):-
order(waterfowl),
neck(long),
color(white),
flight(ponderous).
family(goose):-
order(waterfowl),
size(plump),
flight(powerful).