说谎者谜题是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
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)))![](https://i-blog.csdnimg.cn/blog_migrate/9b8a8a44dd1c74ae49c20a7cd451974e.gif)
(prev - 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
![](https://i-blog.csdnimg.cn/blog_migrate/9b8a8a44dd1c74ae49c20a7cd451974e.gif)
(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)))
![](https://i-blog.csdnimg.cn/blog_migrate/9b8a8a44dd1c74ae49c20a7cd451974e.gif)
(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
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 = 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 ).
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 ).