OCaml で非決定計算っぽいことをやる

OCaml で非決定計算っぽいことをやってみることに。最初は Python でやってたんだけど、if が文なことにがびーんとなって OCaml で書き直しました。amb な部分はこんな感じに。id:mzp に、これってただの継続渡しじゃんと言われたが、継続渡し・継続(call/cc)・amb とかの関係がいまいち理解できていない感じの僕にはよくわかりません。

exception AMBFAIL;;
let ambfail () = raise AMBFAIL;;
let rec amb l f = match l with
    [] -> ambfail ()
  | x::xs ->
      try f x
      with AMBFAIL -> amb xs f

こんなふうに使う。お題はラグランジュの四平方定理(http://d.hatena.ne.jp/zyxwv/20070615)のやつ。なんか OCaml のコードがうまく書けないな〜。とりあえず function を連発してみたけど…。

let rec range f t = if f=t then [f] else f::range (f+1) t;;
let even n = n mod 2 = 0;;
let rec power n m =
  let rec power' = function
      0 -> 1
    | m -> let t = power' (m/2) in
	if even m then t*t else t*t*n
  in power' m;;
let rec takeWhile f = function
    []    -> []
  | x::xs -> if f x then x :: takeWhile f xs else [];;
let rec dropWhile f = function
    []    -> []
  | x::xs -> if f x then dropWhile f xs else xs;;

let lagrange n =
  let seed = List.map (fun x -> power x 2)
    (range 0 (int_of_float (floor (sqrt (float_of_int n)))))
  and result = ref []
  in try amb seed
      (fun x -> amb (takeWhile (fun a -> a<=x) seed)
	 (fun y -> if x+y > n
	  then ambfail ()
	  else amb (takeWhile (fun a -> a<=y) seed)
	    (fun z -> if x+y+z > n
	     then ambfail ()
	     else amb (takeWhile (fun a -> a<=z) seed)
	       (fun w -> if x+y+z+w = n
		then (fun _ -> result := (x,y,z,w) :: !result; ambfail ()) ()
		else ambfail ()
	       ))))
    with AMBFAIL -> !result;;

副作用っていいね。動作速度も問題無し。で、http://d.hatena.ne.jp/zyxwv/20070615 の部分和の問題もやり直してみる。Python 版のときは、lambda の中で if が使えないせいでいろいろと大変な目にあった。OCaml ならもちろん問題ないし、なにより型推論最高。

let rec delete e = function
    []    -> []
  | x::xs -> if e=x then xs else x :: delete e xs;;

let partialsum l n =
  let rec partialsum' n = function
      [] -> false
    | l  -> amb l
	(fun x -> if n-x > 0
	 then partialsum' (n-x) (delete x l)
	 else if n-x < 0 then ambfail() else true)
  in try partialsum' n l
    with AMBFAIL -> false;;