946
技術社區[雲棲]
使用Ruby amb解決說謊者謎題
說謊者謎題是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)))
(prev-amb-fail)))))))
回到謎題，從題意可知每個姑娘的兩句話的異或結果為true，並且姑娘的排名肯定不會相同，因此定義兩個輔助過程：(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)))))))
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).
文章轉自莊周夢蝶 ，原文發布時間2008-11-15
最後更新：2017-05-18 11:02:08