Life Goes On

まあまあだけど楽しんでる方です

Haskell vs F#

VB .NET で書かれたプログラムを速くしろと言われて、Haskell と F# で書き換えたりしています。僕の目論見ではHaskellの方が速くなるはずで、そしたら『F# もいい言語ですけどね、やはり速度を求めるならネイティブ・アプリケーションでないと。』とか何とか言って、Haskell 化してしまう予定でした。だって僕は F# 初心者だし、HaskellC++ にも負けないわけだし、Haskell が速いに決まってるじゃないですか。
ところが実際に試してみたら、F# の方が速くなってしまいました。それも2倍以上。というわけで、図らずも自分自身の Haskell 力の無さを露呈してしまったわけですが、それはともかく、Haskell が遅いとかいう汚名を着せられてしまうのは、避けなくてはなりません。
でも、ごめんなさい、僕の能力では限界です。
世の Haskeller のみなさま、なんとかこのコードを高速化あるいは、この類のコードが遅くなる理由を教えていただけないでしょうか。STUArray は面倒とか、unsafeなんちゃらは避けたいとか、無いこともないですが、まずは速くなることを確認したい。
それから F#er のみなさま、もっと速くなるよとか、こう書いた方がいいよとかあれば、忌憚なきご意見を承りたく。代入使って速いのはいいとしても、ちょっと書き方変えるだけでこれだけ結果が変わるのは意外です。

実行時間

Haskell、F# それぞれのコードの実行時間はおよそ以下の通りで、F# は何種類か書いてみました。グラフが切れてますが、F# の一番遅いやつは、一番速いやつの240倍くらいの時間がかかります。
あと構造体を使うと、F# のコードはさらに1割くらい速くなったりするのですが、気づかなかったことにしてます。

Haskell のコード

import Data.Array.Unboxed

data Node = Node {
  df :: Double,
  branch :: [(Int, Double)]
  }

induceBackward :: Array Int Node -> UArray Int Double -> UArray Int Double
induceBackward nodes values = accumArray (+) 0 (bounds nodes)
  [(j, p * values ! k * df) | (j, Node df branch) <- assocs nodes, (k, p) <- branch]

iteration = 1000

main :: IO()
main = print (maximum [value i | i <- [0..iteration-1]])
  where
  value i = foldr induceBackward (lastValues i) testTree ! 0
  lastValues i = listArray (-100, 100) (repeat (fromIntegral i))
  testTree = [listArray (-i, i)
    [Node 1.0 [(j-1, 1.0/6.0), (j, 2.0/3.0), (j+1, 1.0/6.0)] | j <- [-i..i]]
    | i <- [0..99]]

F# のコード

type Node = 
  val DF : double
  val Branch : (int * double) []
  
  new (df, branch) = {
    DF = df
    Branch = branch
    }

let induceBackwardVerySlow (nodes : Node []) (values : double []) : double [] =
    let n = values.Length / 2
    [| for node in nodes ->
        Array.sum [| for (k, p) in node.Branch -> p * values.[n + k] * node.DF |] |]

let induceBackwardSlow (nodes : Node []) (values : double []) : double [] =
    let n = values.Length / 2
    [| for node in nodes ->
        Array.sum (Array.map (fun (k, p) -> p * values.[n + k] * node.DF) node.Branch) |]

let induceBackwardMedium (nodes : Node []) (values : double []) : double [] =
    let n = values.Length / 2
    let value (node : Node) =
        Array.sum (Array.map (fun (k, p) -> p * values.[n + k] * node.DF) node.Branch)
    Array.map value nodes

let induceBackwardFast (nodes : Node []) (values : double []) : double [] =
    let n = values.Length / 2
    let arr = Array.zeroCreate nodes.Length
    for j in 0 .. nodes.Length-1 do
        let node = nodes.[j]
        for k in 0 .. 2 do
            let next = node.Branch.[k]
            arr.[j] <- arr.[j] + snd next * values.[n + fst next] * node.DF
    arr

let ITERATION = 1000

let lastValues i = Array.create 201 (double i)
let testTree =
    [| for i in 0..99 ->
        [| for j in -i..i ->
            Node(1.0, [|(j-1, 1.0/6.0); (j, 2.0/3.0); (j+1, 1.0/6.0)|]) |] |]
let value i = (Array.foldBack induceBackwardFast testTree (lastValues i)).[0]
stdout.WriteLine (Array.max (Array.init ITERATION value))