说谎者谜题是sicp4.3.2小节的一道题目,题目本身不难:
五个女生参加一个考试,她们的家长对考试结果过分关注。为此她们约定,在给家里写信谈到考试的时候,每个姑娘都要写一句真话和一句假话。下面是从她们的信里摘抄出来的句子:
Betty : kitty考第二,我只考了第三
Ethel : 你们应该很高兴听到我考了第一,joan第二
joan : 我考第三,可怜的Ethel垫底
kitty: 我第二,marry只考了第四
marry: 我是第四,Betty的成绩最高。
这五个姑娘的实际排名是什么?
Ruby本来就有call/cc,因此也可以实现amb操作符,网上已经有一个实现了:
class Amb
class ExhaustedError < RuntimeError; end
def initialize
@fail = proc { fail ExhaustedError, "amb tree exhausted" }
end
def choose(*choices)
prev_fail = @fail
callcc { |sk|
choices.each { |choice|
callcc { |fk|
@fail = proc {
@fail = prev_fail
fk.call(:fail)
}
if choice.respond_to? :call
sk.call(choice.call)
else
sk.call(choice)
end
}
}
@fail.call
}
end
def failure
choose
end
def assert(cond)
failure unless cond
end
alias :require :assert
end
这一段代码与scheme宏实现amb是完全相同的:
(define amb-fail '*)
(define initialize-amb-fail
(lambda ()
(set! amb-fail
(lambda ()
(error "amb tree exhausted")))))
(initialize-amb-fail)
(define call/cc call-with-current-continuation)
(define-syntax amb
(syntax-rules ()
((amb alt )
(let ((prev-amb-fail amb-fail))
(call/cc
(lambda (sk)
(call/cc
(lambda (fk)
(set! amb-fail
(lambda ()
(set! amb-fail prev-amb-fail)
(fk 'fail)))
(sk alt)))
(prev-amb-fail)))))))
回到谜题,从题意可知每个姑娘的两句话的异或结果为true,并且姑娘的排名肯定不会相同,因此定义两个辅助过程:
require 'amb'
def distinct?(items)
items.uniq==items
end
def xor(exp1,exp2)
(exp1 or exp2) and !(exp1 and exp2)
end
剩下的完全就是将题目翻译成代码即可了,没有多少可以解释的东西:
amb=Amb.new
betty=amb.choose(*[1,2,3,4,5])
ethel=amb.choose(*[1,2,3,4,5])
joan=amb.choose(*[1,2,3,4,5])
kitty=amb.choose(*[1,2,3,4,5])
marry=amb.choose(*[1,2,3,4,5])
amb.require(xor(kitty==2,betty==3))
amb.require(xor(ethel==1,joan==2))
amb.require(xor(joan==3,ethel==5))
amb.require(xor(kitty==2,marry==4))
amb.require(xor(marry==4,betty==1))
amb.require(distinct?([betty,ethel,joan,kitty,marry]))
puts "betty:#{betty} ethel:#{ethel} joan:#{joan} kitty:#{kitty} marry:#{marry}"
答案就是:
betty:3 ethel:5 joan:2 kitty:1 marry:4
最后给出一个Prolog的解答:
notmember(A,[]).
notmember(A,[B|L]):-
A\==B,
notmember(A,L).
distinct([A,B,C,D,E]):-
notmember(A,[B,C,D,E]),
notmember(B,[A,C,D,E]),
notmember(C,[A,B,D,E]),
notmember(D,[A,B,C,E]),
notmember(E,[A,B,C,D]).
xor(Exp1,Exp2):-
(Exp1;Exp2),\+ (Exp1,Exp2).
solve(Betty,Ethel,Joan,Kitty,Marry):-
X=[1,2,3,4,5],
member(Betty,X),
member(Ethel,X),
member(Joan,X),
member(Kitty,X),
member(Marry,X),
distinct([Betty,Ethel,Joan,Kitty,Marry]),
xor(Kitty=:=2,Betty=:=3),
xor(Ethel=:=1,Joan=:=2),
xor(Joan=:=3,Ethel=:=5),
xor(Kitty=:=2,Marry=:=4),
xor(Marry=:=4,Betty=:=1).