本节开始进入第4章最后一部分——逻辑程序设计。scheme将实现一种查询语言，非常类似prolog。由于解释器的实现在后面，还未读到，前面的习题我都将用prolog做测试，当然也给出scheme版本的解答，待以后测试。
首先给出依照书中所述写出的prolog事实库：
从 习题4.55开始，
1）所有被Ben BitDiddle管理的人：
2）会计部所有的人的名字和工作:
prolog测试：
3)在Slumerville居住所有人的名字和地址：
(address ?name (Slumerville ?where))
prolog测试：
习题4.56，
1）给出Ben Bitdiddle的所有下属的名字，以及他们的地址：
2)所有工资少于Ben Bitdiddle的人，以及他们的工资和Ben Bitdiddle的工资
prolog测试：
3)所有不是由计算机分部的人管理的人，以及他们的上司和工作：
prolog测试：
习题4.57
定义这个规则，用scheme实现是：
用prolog定义此规则：
a)找出能代替Cy D.Fect的人：
(instead (Fect Cy D) ?person)
prolog测试：
b)找出所有能够代替某个工资比自己高的人的人，以及两个人的工资：
prolog测试：
习题4.58，
用prolog实现并测试的结果：
习题4.59，增加4个事实到prolog程序中：
a)查询星期五的会议，scheme实现：
b)scheme实现查询规则：
prolog实现并测试
c)Alyssa周三参加的会议：
习题4.60，会重复是因为person1和person2都是查询所有的address，而lives-near只规定
(not (same person1 person2))
而没有定义两者的顺序，因此解决办法就是强制加入一个固定顺序即可去除重复，通过string>来比较两个字符串。解释器还未实现，具体怎么写留待后面，原理就是这样了。
习题4.62，猜测实现如下,模式匹配，递归实现：
习题4.63,这一题很简单了，按照题意翻译过来就是：
看看prolog怎么解决：
测试一下：
首先给出依照书中所述写出的prolog事实库：
address(
'
BitDiddle Ben
'
,
'
Slumerville
'
,
'
Ridge Road
'
,
10
).
address( ' Hacker Alyssa P ' , ' Cambridge ' , ' Mass Ave ' , 78 ).
address( ' Fect Cy D ' , ' Cambridge ' , ' Ames Street ' , 3 ).
address( ' Tweakit Lem E ' , ' Boston ' , ' Bay State Road ' , 22 ).
address( ' Reasoner Louis ' , ' Slumerville ' , ' Pine Tree Road ' , 80 ).
address( ' Warbucks Oliver ' , ' Swellesley ' , ' Top Heap Road ' ,unknown).
address( ' Scrooge Eben ' , ' Weston ' , ' Shady Lane ' , 10 ).
address( ' Aull DeWitt ' , ' Slumerville ' , ' Onione Square ' , 5 ).
address( ' Cratchet Robert ' , ' Allston ' , ' N Harvard Street ' , 16 ).
job( ' BitDiddle Ben ' ,computer,wizard).
job( ' Hacker Alyssa P ' ,computer,programmer).
job( ' Fect Cy D ' ,computer,programmer).
job( ' Tweakit Lem E ' ,computer,technician).
job( ' Warbucks Oliver ' ,administration, ' big wheel ' ).
job( ' Scrooge Eben ' ,accounting, ' chief accountant ' ).
job( ' Aull DeWitt ' ,administration,secretary).
job( ' Cratchet Robert ' ,accounting,scrivener).
job( ' Reasoner Louis ' ,computer,programmer,trainee).
salary( ' Hacker Alyssa P ' , 40000 ).
salary( ' BitDiddle Ben ' , 60000 ).
salary( ' Fect Cy D ' , 35000 ).
salary( ' Tweakit Lem E ' , 25000 ).
salary( ' Reasoner Louis ' , 30000 ).
salary( ' Warbucks Oliver ' , 150000 ).
salary( ' Scrooge Eben ' , 75000 ).
salary( ' Cratchet Robert ' , 18000 ).
salary( ' Aull DeWitt ' , 25000 ).
supervisor( ' Hacker Alyssa P ' , ' BitDiddle Ben ' ).
supervisor( ' Fect Cy D ' , ' BitDiddle Ben ' ).
supervisor( ' Tweakit Lem E ' , ' BitDiddle Ben ' ).
supervisor( ' Reasoner Louis ' , ' Hacker Alyssa P ' ).
supervisor( ' BitDiddle Ben ' , ' Warbucks Oliver ' ).
supervisor( ' Scrooge Eben ' , ' Warbucks Oliver ' ).
supervisor( ' Cratchet Robert ' , ' Scrooge Eben ' ).
supervisor( ' Aull DeWitt ' , ' Warbucks Oliver ' ).
can_do(computer,wizard,computer,programmer).
can_do(computer,wizard,computer,technician).
can_do(administration,secretary,administration, ' big wheel ' ).
address( ' Hacker Alyssa P ' , ' Cambridge ' , ' Mass Ave ' , 78 ).
address( ' Fect Cy D ' , ' Cambridge ' , ' Ames Street ' , 3 ).
address( ' Tweakit Lem E ' , ' Boston ' , ' Bay State Road ' , 22 ).
address( ' Reasoner Louis ' , ' Slumerville ' , ' Pine Tree Road ' , 80 ).
address( ' Warbucks Oliver ' , ' Swellesley ' , ' Top Heap Road ' ,unknown).
address( ' Scrooge Eben ' , ' Weston ' , ' Shady Lane ' , 10 ).
address( ' Aull DeWitt ' , ' Slumerville ' , ' Onione Square ' , 5 ).
address( ' Cratchet Robert ' , ' Allston ' , ' N Harvard Street ' , 16 ).
job( ' BitDiddle Ben ' ,computer,wizard).
job( ' Hacker Alyssa P ' ,computer,programmer).
job( ' Fect Cy D ' ,computer,programmer).
job( ' Tweakit Lem E ' ,computer,technician).
job( ' Warbucks Oliver ' ,administration, ' big wheel ' ).
job( ' Scrooge Eben ' ,accounting, ' chief accountant ' ).
job( ' Aull DeWitt ' ,administration,secretary).
job( ' Cratchet Robert ' ,accounting,scrivener).
job( ' Reasoner Louis ' ,computer,programmer,trainee).
salary( ' Hacker Alyssa P ' , 40000 ).
salary( ' BitDiddle Ben ' , 60000 ).
salary( ' Fect Cy D ' , 35000 ).
salary( ' Tweakit Lem E ' , 25000 ).
salary( ' Reasoner Louis ' , 30000 ).
salary( ' Warbucks Oliver ' , 150000 ).
salary( ' Scrooge Eben ' , 75000 ).
salary( ' Cratchet Robert ' , 18000 ).
salary( ' Aull DeWitt ' , 25000 ).
supervisor( ' Hacker Alyssa P ' , ' BitDiddle Ben ' ).
supervisor( ' Fect Cy D ' , ' BitDiddle Ben ' ).
supervisor( ' Tweakit Lem E ' , ' BitDiddle Ben ' ).
supervisor( ' Reasoner Louis ' , ' Hacker Alyssa P ' ).
supervisor( ' BitDiddle Ben ' , ' Warbucks Oliver ' ).
supervisor( ' Scrooge Eben ' , ' Warbucks Oliver ' ).
supervisor( ' Cratchet Robert ' , ' Scrooge Eben ' ).
supervisor( ' Aull DeWitt ' , ' Warbucks Oliver ' ).
can_do(computer,wizard,computer,programmer).
can_do(computer,wizard,computer,technician).
can_do(administration,secretary,administration, ' big wheel ' ).
从 习题4.55开始，
1）所有被Ben BitDiddle管理的人：
(supervisor ?x (BitDiddle Ben))
prolog测试：
|
?
-
supervisor(Name,
'
BitDiddle Ben
'
).
Name = ' Hacker Alyssa P ' ? ;
Name = ' Fect Cy D ' ? ;
Name = ' Tweakit Lem E ' ? ;
no
Name = ' Hacker Alyssa P ' ? ;
Name = ' Fect Cy D ' ? ;
Name = ' Tweakit Lem E ' ? ;
no
2）会计部所有的人的名字和工作:
(job ?name (accounting .?type))
prolog测试：
|
?
-
job(Name,accounting,Type).
Name = ' Scrooge Eben '
Type = ' chief accountant ' ? ;
Name = ' Cratchet Robert '
Type = scrivener
yes
Name = ' Scrooge Eben '
Type = ' chief accountant ' ? ;
Name = ' Cratchet Robert '
Type = scrivener
yes
3)在Slumerville居住所有人的名字和地址：
(address ?name (Slumerville ?where))
prolog测试：
|
?
-
address(Name,
'
Slumerville
'
,Road,No).
Name = ' BitDiddle Ben '
No = 10
Road = ' Ridge Road ' ? ;
Name = ' Reasoner Louis '
No = 80
Road = ' Pine Tree Road ' ? ;
Name = ' Aull DeWitt '
No = 5
Road = ' Onione Square ' ? ;
Name = ' BitDiddle Ben '
No = 10
Road = ' Ridge Road ' ? ;
Name = ' Reasoner Louis '
No = 80
Road = ' Pine Tree Road ' ? ;
Name = ' Aull DeWitt '
No = 5
Road = ' Onione Square ' ? ;
习题4.56，
1）给出Ben Bitdiddle的所有下属的名字，以及他们的地址：
(
and
(supervisor ?name (Bitdiddle Ben))
(address ?name ?where))
prolog测试，注意prolog是用,号表示and的关系：
(supervisor ?name (Bitdiddle Ben))
(address ?name ?where))
|
?
-
supervisor(Name,
'
BitDiddle Ben
'
),address(Name,City,Road,No).
City = ' Cambridge '
Name = ' Hacker Alyssa P '
No = 78
Road = ' Mass Ave ' ? ;
City = ' Cambridge '
Name = ' Fect Cy D '
No = 3
Road = ' Ames Street ' ? ;
City = ' Boston '
Name = ' Tweakit Lem E '
No = 22
Road = ' Bay State Road ' ? ;
City = ' Cambridge '
Name = ' Hacker Alyssa P '
No = 78
Road = ' Mass Ave ' ? ;
City = ' Cambridge '
Name = ' Fect Cy D '
No = 3
Road = ' Ames Street ' ? ;
City = ' Boston '
Name = ' Tweakit Lem E '
No = 22
Road = ' Bay State Road ' ? ;
2)所有工资少于Ben Bitdiddle的人，以及他们的工资和Ben Bitdiddle的工资
(
and
(salary (Bitdiddle Ben) ?ben)
(salary ?person ?amount)
(lisp - value < ?amount ?ben)
)
(salary (Bitdiddle Ben) ?ben)
(salary ?person ?amount)
(lisp - value < ?amount ?ben)
)
prolog测试：
?-salary(
'
BitDiddle Ben
'
,Bensalary),salary(Person,Amount),Amount
<
Bensalary.
Amount = 40000
Bensalary = 60000
Person = ' Hacker Alyssa P ' ? ;
Amount = 35000
Bensalary = 60000
Person = ' Fect Cy D ' ? ;
Amount = 25000
Bensalary = 60000
Person = ' Tweakit Lem E ' ? ;
Amount = 30000
Bensalary = 60000
Person = ' Reasoner Louis ' ? ;
Amount = 18000
Bensalary = 60000
Person = ' Cratchet Robert ' ? ;
Amount = 25000
Bensalary = 60000
Person = ' Aull DeWitt '
Amount = 40000
Bensalary = 60000
Person = ' Hacker Alyssa P ' ? ;
Amount = 35000
Bensalary = 60000
Person = ' Fect Cy D ' ? ;
Amount = 25000
Bensalary = 60000
Person = ' Tweakit Lem E ' ? ;
Amount = 30000
Bensalary = 60000
Person = ' Reasoner Louis ' ? ;
Amount = 18000
Bensalary = 60000
Person = ' Cratchet Robert ' ? ;
Amount = 25000
Bensalary = 60000
Person = ' Aull DeWitt '
3)所有不是由计算机分部的人管理的人，以及他们的上司和工作：
(
and
(supervisor ?person ?boss)
( not (job ?boss (computer . ?type)))
(job ?boss?bossjob))
( not (job ?boss (computer . ?type)))
(job ?boss?bossjob))
prolog测试：
|
?
-
supervisor(Person,Boss),\
+
(job(Boss,computer,_)),job(Boss,BossJob1,BossJob2).
Boss = ' Warbucks Oliver '
BossJob1 = administration
BossJob2 = ' bit wheel '
Person = ' Ben BitDiddle ' ? ;
Boss = ' Warbucks Oliver '
BossJob1 = administration
BossJob2 = ' bit wheel '
Person = ' Scrooge Eben ' ? ;
Boss = ' Scrooge Eben '
BossJob1 = accounting
BossJob2 = ' chief accountant '
Person = ' Cratchet Robert ' ? ;
Boss = ' Warbucks Oliver '
BossJob1 = administration
BossJob2 = ' bit wheel '
Person = ' Aull DeWitt '
Boss = ' Warbucks Oliver '
BossJob1 = administration
BossJob2 = ' bit wheel '
Person = ' Ben BitDiddle ' ? ;
Boss = ' Warbucks Oliver '
BossJob1 = administration
BossJob2 = ' bit wheel '
Person = ' Scrooge Eben ' ? ;
Boss = ' Scrooge Eben '
BossJob1 = accounting
BossJob2 = ' chief accountant '
Person = ' Cratchet Robert ' ? ;
Boss = ' Warbucks Oliver '
BossJob1 = administration
BossJob2 = ' bit wheel '
Person = ' Aull DeWitt '
习题4.57
定义这个规则，用scheme实现是：
（rule (instead ?person
?insteadperson
)
( and
(job ?person ?insteadedjob)
(job ?insteadperson ?job)
( not (same ?person ?insteadperson))
( or (can - do - job ?job ? insteadedjob )
(same ?job ? insteadedjob ))))
( and
(job ?person ?insteadedjob)
(job ?insteadperson ?job)
( not (same ?person ?insteadperson))
( or (can - do - job ?job ? insteadedjob )
(same ?job ? insteadedjob ))))
用prolog定义此规则：
instead(Person,InsteadPerson):
-
job(Person,Part,Pos),
job(InsteadPerson,InsteadPart,InsteadPos),
Person\ == InsteadPerson,
(can_do(InsteadPart,InsteadPos,Part,Pos);InsteadPart == Part,InsteadPos == Pos).
job(Person,Part,Pos),
job(InsteadPerson,InsteadPart,InsteadPos),
Person\ == InsteadPerson,
(can_do(InsteadPart,InsteadPos,Part,Pos);InsteadPart == Part,InsteadPos == Pos).
a)找出能代替Cy D.Fect的人：
(instead (Fect Cy D) ?person)
prolog测试：
|
?
-
instead(
'
Fect Cy D
'
,InsteadPerson).
InsteadPerson = ' BitDiddle Ben ' ? ;
InsteadPerson = ' Hacker Alyssa P ' ? ;
InsteadPerson = ' BitDiddle Ben ' ? ;
InsteadPerson = ' Hacker Alyssa P ' ? ;
b)找出所有能够代替某个工资比自己高的人的人，以及两个人的工资：
(
and
(?person1 ?person2)
(salary ?person1 ?salary1)
(salary ?person2 ?salary2)
(lisp - value > ?salary1 ?salary2))
(salary ?person1 ?salary1)
(salary ?person2 ?salary2)
(lisp - value > ?salary1 ?salary2))
prolog测试：
|
?
-
instead(Person1,Person2),salary(Person1,Salary1),salary(Person2,Salary2),Salary1
>
Salary2.
Person1 = ' Hacker Alyssa P '
Person2 = ' Fect Cy D '
Salary1 = 40000
Salary2 = 35000 ? ;
Person1 = ' Warbucks Oliver '
Person2 = ' Aull DeWitt '
Salary1 = 150000
Salary2 = 25000 ? ;
Person1 = ' Hacker Alyssa P '
Person2 = ' Fect Cy D '
Salary1 = 40000
Salary2 = 35000 ? ;
Person1 = ' Warbucks Oliver '
Person2 = ' Aull DeWitt '
Salary1 = 150000
Salary2 = 25000 ? ;
习题4.58，
(rule (vip ?person)
( and
(job ?person (?part .?pos))
( or
( not (supervisor ?person ?boss))
( and
(?boss (?bosspart .?bosspos))
( not (same ?part ?bosspart))))))
( and
(job ?person (?part .?pos))
( or
( not (supervisor ?person ?boss))
( and
(?boss (?bosspart .?bosspos))
( not (same ?part ?bosspart))))))
用prolog实现并测试的结果：
vip(Person):
-
job(Person,Part,Pos),
(\ + (supervisor(Person,Boss));
(supervisor(Person,Boss),
job(Boss,BossPart,_),
Part\ == BossPart)).
| ? - vip(Person).
Person = ' BitDiddle Ben ' ? a
Person = ' Warbucks Oliver '
Person = ' Scrooge Eben '
job(Person,Part,Pos),
(\ + (supervisor(Person,Boss));
(supervisor(Person,Boss),
job(Boss,BossPart,_),
Part\ == BossPart)).
| ? - vip(Person).
Person = ' BitDiddle Ben ' ? a
Person = ' Warbucks Oliver '
Person = ' Scrooge Eben '
习题4.59，增加4个事实到prolog程序中：
meeting(accounting,monday,am9).
meeting(administration,monday,am10).
meeting(computer,wednesday,pm3).
meeting(administration,friday,pm1).
meeting(whole - company,wednesday,pm4).
meeting(administration,monday,am10).
meeting(computer,wednesday,pm3).
meeting(administration,friday,pm1).
meeting(whole - company,wednesday,pm4).
a)查询星期五的会议，scheme实现：
（meeting ?part (Friady ?time))
prolog实现并测试：
|
?
-
meeting(Part,friday,Time).
Part = administration
Time = pm1 ? ;
Part = administration
Time = pm1 ? ;
b)scheme实现查询规则：
(rule (meeting
-
time ?person ?day
-
and
-
time)
( or (meeting whole - company ?day - and - time)
( and
(job ?person (?part . ?r))
(meeting ?part ?day - and - time))))
( or (meeting whole - company ?day - and - time)
( and
(job ?person (?part . ?r))
(meeting ?part ?day - and - time))))
prolog实现并测试
meeting_time(Person,Day,Time):
-
meeting(whole - company,Day,Time);
(job(Person,Part,_),meeting(Part,Day,Time)).
| ? - meeting_time( ' BitDiddle ' ,Day,Time).
Day = wednesday
Time = pm4 ? ;
no
| ? - meeting_time(Person,friday,Time).
Person = ' Warbucks Oliver '
Time = pm1 ? ;
Person = ' Aull DeWitt '
Time = pm1 ? ;
meeting(whole - company,Day,Time);
(job(Person,Part,_),meeting(Part,Day,Time)).
| ? - meeting_time( ' BitDiddle ' ,Day,Time).
Day = wednesday
Time = pm4 ? ;
no
| ? - meeting_time(Person,friday,Time).
Person = ' Warbucks Oliver '
Time = pm1 ? ;
Person = ' Aull DeWitt '
Time = pm1 ? ;
c)Alyssa周三参加的会议：
（meeting
-
time (Hacker Alyssa P) (Wednesday ?time))
prolog测试：
|
?
-
meeting_time(
'
Hacker Alyssa P
'
,wednesday,Time).
Time = pm4 ? ;
Time = pm3
Time = pm4 ? ;
Time = pm3
习题4.60，会重复是因为person1和person2都是查询所有的address，而lives-near只规定
(not (same person1 person2))
而没有定义两者的顺序，因此解决办法就是强制加入一个固定顺序即可去除重复，通过string>来比较两个字符串。解释器还未实现，具体怎么写留待后面，原理就是这样了。
习题4.62，猜测实现如下,模式匹配，递归实现：
(rule (last
-
pair (?x) (?x)))
(rule (last - pair (?v . ?u) (?z))
(last - pair ?u (?z))
(rule (last - pair (?v . ?u) (?z))
(last - pair ?u (?z))
习题4.63,这一题很简单了，按照题意翻译过来就是：
(rule (grandson ?g ?s)
( and
(son ?g ?f)
(son ?f ?s)))
( and
(son ?g ?f)
(son ?f ?s)))
(rule (son ?m ?s)
(and
(wife ?m ?w)
(son ?w ?s)))
看看prolog怎么解决：
son(adam,cain).
son(cain,enoch).
son(enoch,irad).
son(irad,mehujael).
son(mehujael,methushael).
son(methushael,lamech).
son(ada,jabal).
son(ada,jubal).
wife(lamech,ada).
son2(M,S): -
wife(M,W),
son(W,S).
grandson(G,S): -
son(F,S),
son(G,F).
son(cain,enoch).
son(enoch,irad).
son(irad,mehujael).
son(mehujael,methushael).
son(methushael,lamech).
son(ada,jabal).
son(ada,jubal).
wife(lamech,ada).
son2(M,S): -
wife(M,W),
son(W,S).
grandson(G,S): -
son(F,S),
son(G,F).
测试一下：
|
?
-
son2(lamech,jabal).
true ? ;
| ? - son2(lamech,jubal).
yes
| ? - grandson(adam,enoch).
true ? ;
文章转自庄周梦蝶 ，原文发布时间2008-11-22
true ? ;
| ? - son2(lamech,jubal).
yes
| ? - grandson(adam,enoch).
true ? ;
