Haskell vs F# リベンジ

昨日のHaskellコードをF#に移植してみた。

type Point =
    {X: int; Y: int;}
    static member ( + ) (p: Point, q: Point) = {X = p.X + q.X; Y = p.Y + q.Y;}
    static member ( - ) (p: Point, q: Point) = {X = p.X - q.X; Y = p.Y - q.Y;}

type Pair =
    {Front: Point; Back: Point;}

type Node = Pair list

let move (p : Pair) (q : Point) : Pair =
    {Front = p.Front + q; Back = p.Back - q;}

let moves (p : Pair) (q : Pair) : Pair list =
    let forward : Point = p.Front - q.Front
    let left : Point = {X = forward.Y; Y = -forward.X;}
    let right : Point = {X = -forward.Y; Y = forward.X;}
    List.map (move p) [forward; left; right;]

let nexts (n: Node) : Node list =
    match n with
    | p1::p0::ps -> [for p2 in moves p1 p0 -> p2::n]
    | _ -> []

let exists (p : Point) (qs : Pair list) =
    List.exists (fun q -> p = q.Front || p = q.Back) qs

let solve (size: int) : Node seq =
    let center : Point = {X = size/2; Y = size/2;}
    let p0 : Pair = {Front = center; Back = center;}
    let p1 : Pair = move p0 {X = 0; Y = 1;}
    let initial : Node = [p1; p0;]

    let atboundary (p : Point) : bool =
        (p.X = 0) || (p.X = size) || (p.Y = 0) || (p.Y = size)

    let rec solutions (n : Node) : Node seq =
        match n with
        | p::ps when atboundary p.Front -> Seq.singleton n
        | p::ps when exists p.Front ps -> Seq.empty
        | p::ps -> seq {for n' in (nexts n) do
                        for n'' in (solutions n') do
                        yield n''}
        | _ -> Seq.empty

    solutions initial

printfn "%d" (Seq.length (solve 8))

で、実行してみると、これが断然Haskellが速い。

$ time solverhs.exe
184525

real    0m1.613s
user    0m0.000s
sys     0m0.015s

$ time solverfs.exe
184525

real    0m4.550s
user    0m0.000s
sys     0m0.015s

というわけで、やはり得手不得手があるのよなあ。