F#でArrow

F# Haskell

練習中のF#(OCaml)でHaskellのArrow, ArrowChoice, ArrowApply, ArrowLoop を書いてみました。
突っ込みやアドバイス歓迎です。
ちなみにOCamlは空き時間などに携帯でWebサイトを見て勉強した（？）だけなので実はあまり自信が無い。。。（多少はPCでも書いたことあるけど


VS2010β入れてないので、F# CTPでプログラムを書きました。もしかしたら仕様変更の影響を受けてる部分とかあるかも・・・。

Arrow

(* F#特有の"light"の意味を良く分かってない。。。重くなさそうだ！ *)
#light

let first f (x, y) = f x, y
let second f (x, y) = x, f y

let ( *** ) f g = first f >> second g
let (&&&) f g = (fun x -> x, x) >> (f *** g)

(* 出力結果は一番最後 *)
printf "first : %A\n" (first ((+) 1) (9, 5))
printf "second : %A\n" (second ((+) 1) (99, 99))

((+)1 *** (+)2) (9, 18) |> printf "*** : %A\n"
((+)20 &&& (+)30) 40 |> printf "&&& : %A\n\n"

ArrowChoice

（日記に載せる都合上分割してますが、プログラム的にはひと続きのファイルです。）

type 'a Either = Left of 'a | Right of 'a

let left f e =
    match e with
    | Left x -> Left (f x)
    | otherwise -> e
    
let right f e =
    match e with
    | Right x -> Right (f x)
    | otherwise -> e
    
let either f g =
    left f >> right g >> (function Left x | Right x -> x)

let (+++) f g = left f >> right g
let (|||) = either


(either ((+)1) ((+) 10)) (Left 99) |> printf "either : %A\n"

(Left 2.0, Right 2.0)
    |> ((sqrt ||| abs) *** (abs +++ sqrt))
        |> printf "|||, +++ : %A\n\n"

ArrowApply

let app (f, x) = f x

(first (+) >> app) (73, 27) |> printf "app : %A\n\n"

これだけです。。。

ArrowLoop

これめっちゃ苦労した！僕のへたれ脳には難度が高すぎてかなり悩んだ。（食卓にメモ用紙を持って行って、もぐもぐしながらプログラムをデッサンして考えまくった）
本題に入る前に遅延評価の確認。
OCamlとF#は若干この辺が異なる。

(* 岡村 *)
# let john = lazy (print_endline "john!john!john!!") ;;
val john : unit lazy_t = <lazy>
# Lazy.force john;;
john!john!john!!
- : unit = ()


(* F# *)
> let hanako = lazy (printf "i love u \n");;
val hanako : Lazy<unit>

> hanako.Force();;
i love u
val it : unit = ()
> hanako;;
val it : Lazy<unit>
= Microsoft.FSharp.Control.Lazy`1[Microsoft.FSharp.Core.Unit]
    {IsDelayed = false;
     IsException = false;
     IsForced = true;
     Value = null;}
追記(09/08/05)

F# CTPの時点では x.Force();; として評価していたけど、
VS2010βでは x.Value ;; で評価するようになっていた。（一応上のコードも動作するけど推奨されない）


では本題に戻ろう。
ArrowLoopは、Haskellだと以下のようにエレガントに定義できる。

loop f b = let (c,d) = f (b,d) in c

これがF#だと・・・

type 'a recc = In of ('a recc -> 'a)
let out (In x) = x

let loop f b =
    let a = (fun d -> let s:Lazy<'c> = snd <| f(b, (lazy (out d d))) in s.Force())
    in
        let (x:Lazy<'result>, _) = f (b, lazy(a (In a)))
        in x.Force()


(* 利用してみる、、、lazy & Force() のせいで美しくない。。。 *)
let loop_test = loop (fun (b, d) -> (lazy (d.Force() + 1)), lazy (b * 2)) 1
loop_test |> printf "loop1 : %A\n"

(* ArrowLoopを使ったY Combinatorの例 *)
let nList = loop (fun (b, d) ->
                    (lazy(d.Force() b), lazy(fun n -> if n=0 then [] else n::(d.Force() (n-1)))))
nList 10 |> printf "loop2 : %A\n"
追記(09/08/05)

これも先の追記同様で、遅延評価の部分が若干異なる。
書き直すと以下のようになる。

let loop f b =
    let a = (fun d -> let s:Lazy<'c> = snd <| f(b, (lazy (out d d))) in s.Value)
    let (x:Lazy<'result>, _) = f (b, lazy(a (In a)))
    x.Value

let loop_test = loop (fun (b, d) -> (lazy (d.Value + 1)), lazy (b * 2)) 1

let nList = loop (fun (b, d) ->
                    (lazy(d.Value b), lazy(fun n -> if n=0 then [] else n::(d.Value (n-1)))))

もっとエレガントに書ける技法とかあったら教えてください。。
どこで遅延評価を使うべきか、このλ式には何を渡すか、などという判断は先に終わっていたのだけど、最後はずっと型に苦しめられていた。Y Combinatorとかで遊ぶ時は動的型付け言語を使うことが多かったからなぁ。。。良い勉強になりました。



以下が上記のプログラムの出力。

first : (10, 5)

second : (99, 100)

[]*** : (10, 20)[]

&&& : (60, 70)
either : 100

[]|||, +++ : (1.414213562, Right 1.414213562)[]
app : 100
loop1 : 3

loop2 : [10; 9; 8; 7; 6; 5; 4; 3; 2; 1]

続行するには何かキーを押してください . . .


おしまい。