「カロタンパズル」のその後

 その後、schemeからHaskellへとハシゴしているうちに、(メインのハードディスクが前触れもなく飛んだりもしたが、それは兎も角、)結局のところ、pythonが手頃で良いと思うようになった。pythonprologインタープリターを実装している事例を参照したことも見直した理由の一つだ。
 つい先日、generatorの機能を押さえようと、「python amb」で検索していて、目当てのpythonのものは見当たらなかったが、rubyでambを実装したごく短いコードを見付けた。
.
「McCarthy's Ambiguous Operator」
http://www.randomhacks.net/articles/2005/10/11/amb-operator
("ambiguous":【形】両義に取れる、多義の、あいまいな)
.
 引用元のコードをそのままコピーし、「独習scheme三週間」にある「1.4.4.1 カロタンパズル」の条件部分を加工しつつ打ち込んでみるとすんなり動いた(ruby-1.84)。(9/30 引用元のコードからコメント部分を除いている。)

>>
#quoting without comments
$backtrack_points = []

def backtrack
  if $backtrack_points.empty?
    raise "Can't backtrack"
  else
    $backtrack_points.pop.call
  end
end

def amb *choices
  backtrack if choices.empty?
  callcc{|cc| $backtrack_points.push cc
              return choices[0]}
  amb *choices[1...choices.length]
end
<<
#kalotan_puzzle by ruby
parent1 = amb 'm','f'
parent2 = amb 'm','f'
kibi = amb 'm','f'
kibi_self_desc = amb 'm','f'
kibi_liedQ = amb true,false

amb if parent1 == parent2
amb if (kibi == 'm') and (kibi_liedQ == true)
amb if (kibi_liedQ == true ) and (kibi_self_desc == kibi)
amb if (kibi_liedQ == false) and (kibi_self_desc != kibi)
amb if (parent1 == 'm') and (kibi_self_desc == 'f')
amb if (parent2 == 'm') and (kibi == 'm')
amb if (parent2 == 'm') and (kibi_liedQ == false)
amb if (parent2 == 'f') and (kibi == 'f') and (kibi_liedQ == true)
amb if (parent2 == 'f') and (kibi == 'm') and (kibi_liedQ == false)

p [parent1,parent2,kibi,kibi_self_desc,kibi_liedQ]

 ちなみに、Haskell(WinHugs May 2006)だと同等の機能が以下のコードで動いた。(リストモナドと称するそうだが、コピって加工しただけで、モナド関連の理屈はまだほとんど理解できていない。)

--kalotan puzzle by Haskell
import Control.Monad.List

solve_kalotan_puzzle = do
  parent1  <- ['m','f']
  parent2  <- ['m','f']
  kibi     <- ['m','f']
  kibi_self_desc <- ['m','f']
  kibi_liedQ <- ['y','n']

  guard $ distinct [parent1,parent2]
  guard $ not (kibi == 'm' && kibi_liedQ == 'y')
  guard $ not (kibi_liedQ  == 'y' && kibi_self_desc == kibi)
  guard $ not (kibi_liedQ  == 'n' && kibi_self_desc /= kibi)
  guard $ not (parent1 == 'm' && kibi_self_desc == 'f')
  guard $ not (parent2 == 'm' && kibi == 'm')
  guard $ not (parent2 == 'm' && kibi_liedQ == 'n')
  guard $ not (parent2 == 'f' && kibi == 'f' && kibi_liedQ == 'y')
  guard $ not (parent2 == 'f' && kibi == 'm' && kibi_liedQ == 'n')
  [parent1,parent2,kibi,kibi_self_desc,kibi_liedQ,' ']

distinct :: Eq a => [a] -> Bool
distinct [] = True
distinct (x:xs) = all (/=x) xs && distinct xs

main :: IO()
main = print solve_kalotan_puzzle

 pythonだとambの実装をどうするのか。今後の課題。
追記
 10/6 条件列挙部分を修正した。