haskell-jp / beginners #26 at 2024-12-04 08:47:19 +0900

Array についての質問です。
10×10の行列が与えられ、(1,1)成分から右か下に向かって成分を足しながら進んでいくとき、(i,j)成分へ至る道のうち最も和が小さいものを求めるという問題があります。
この問題に対して以下のようなコードを書きました。

import Data.Array

main :: IO ()
main = do
    let m = listArray ((1,1),(10,10)) [i+j |i<-[1..10], j<-[1..10]]
    print $ minPath m ! (8,8)

minPath :: Array (Int,Int) Int -> Array (Int,Int) Int
minPath mat = listArray ((1,1),(10,10)) $ [ f i j | i<-[1..10], j<-[1..10]]
    where   f 1 1 = mat ! (1,1)
            f 1 j = mat ! (1,j) + minPath mat ! (1,j-1)
            f i 1 = mat ! (i,1) + minPath mat ! (i-1,1)
            f i j = if minPath mat ! (i-1,j) > minPath mat ! (i,j-1) 
                        then minPath mat ! (i,j-1) + mat ! (i,j) 
                        else minPath mat ! (i-1,j) + mat ! (i,j)

これをrunghcで実行すると私の環境 (CPU: Ryzen 5 3600, RAM: 16GB) では40秒程度かかります。
Arrayは要素へのアクセスがO(1)なので、リストのリストよりも要素へのアクセスが速いはずです。
この理解が正しければボトルネックとなっているのは要素へのアクセスではないと思うのですが、それではどこにこんなに時間がかかるのかわかりません。
1. なぜこんなに時間がかかるのでしょうか？
2. どのように改善すればよいのでしょうか？

1.なぜこんなに時間がかかるのでしょうか？
minPath関数の挙動が、「全てのマスに対して最小の和を求める」となっているようです、「必要なマスに対して最小の和を求める」でOKなら改善できます
2.どのように改善すればよいのでしょうか？
自分が「必要なマスに対して最小の和を求める」で修正するなら以下のようになります

import Data.Array

main :: IO ()
main = do
    let m = listArray ((1,1),(10,10)) [i+j |i<-[1..10], j<-[1..10]]
    print $ minPath m (8,8)

minPath :: Array (Int,Int) Int -> (Int,Int) -> Int
minPath mat (1,1) = mat ! (1,1)
minPath mat (1,j) = mat ! (1,j) + minPath mat (1,j-1)
minPath mat (i,1) = mat ! (i,1) + minPath mat (i-1,1)
minPath mat (i,j) = min (minPath mat (i,j-1)) (minPath mat (i-1,j)) + mat ! (i,j)

(最近はHaskellを書いていないのでなまっている自覚はありますがとりあえず拙速として)

ご回答ありがとうございます。
私のminPath関数の挙動が「全てのマスに対して最小の和を求める」となっているのは、minPath m の型が Array (Int,Int) Int となっており、(1,1)から(10,10)まで計算しているからですか？ かりんとうさんのminPath m (i,j)が速いのは返り値の型がIntでArray (Int,Int) Intではないので、すべての要素を計算しなくてもよいからでしょうか？

とりあえず推測するより計測するべきかなあと思って、stack newして、それをコピペしてstack runしたら、40秒もかからないですね…
0.4秒で終わります。

135
stack run  0.30s user 0.06s system 78% cpu 0.462 total

こちらの環境はRyzen 9 7950Xでメモリ96GBなので、そちらよりハードウェアが強力とは言え、0.4秒と40秒では違いすぎますね。
そちらの環境に何か変なことが起きているような気がします。

ちなみに角田さんの実装でも今回はそんなに変わらないらしい?
遅延評価マジックですかね。
競技プログラミング的なことはあんまり分からない。

135
stack run  0.27s user 0.08s system 74% cpu 0.478 total

ちょっと逸れますが、私なら「どうせ全体構築するなら添字アクセスなくせるし標準のリストで良くねえ?」ってArrayではなくリストを使ってしまいますね。

module Lib
    ( someFunc
    ) where

someFunc :: IO ()
someFunc = do
    let m = [[i + j | j <- [1..10]] | i <- [1..10]]
    print $ minPath m !! 7 !! 7

minPath :: [[Int]] -> [[Int]]
minPath mat = dp
  where
    rows = length mat
    cols = length (head mat)
    dp = [[f i j | j <- [0..cols-1]] | i <- [0..rows-1]]

    f 0 0 = mat !! 0 !! 0
    f 0 j = mat !! 0 !! j + dp !! 0 !! (j-1)
    f i 0 = mat !! i !! 0 + dp !! (i-1) !! 0
    f i j = min (dp !! (i-1) !! j) (dp !! i !! (j-1)) + mat !! i !! j

引数添字アクセスしてるけど、GHCのマジックかそんなに遅くないですね。

135
stack run  0.32s user 0.05s system 82% cpu 0.441 total

スケールするかを一応考えてHashMapに変えても全く速度変わらないですね。

module Lib
    ( someFunc
    ) where

import qualified Data.HashMap.Strict as HM

someFunc :: IO ()
someFunc = do
    let m = HM.fromList [((i, j), (j + 1 + i + 1)) | j <- [0..9], i <- [0..9]]
    print $ (minPath m HM.! (7, 7))

minPath :: HM.HashMap (Int, Int) Int -> HM.HashMap (Int, Int) Int
minPath mat = dp
  where
    rows = 9
    dp = foldl updateCell HM.empty [(i, j) | i <- [0..rows-1], j <- [0..rows-1]]

    updateCell :: HM.HashMap (Int, Int) Int -> (Int, Int) -> HM.HashMap (Int, Int) Int
    updateCell acc (i, j) = HM.insert (i, j) (f i j) acc
      where
        f 0 0 = mat HM.! (0, 0)
        f 0 j = mat HM.! (0, j) + acc HM.! (0, j-1)
        f i 0 = mat HM.! (i, 0) + acc HM.! (i-1, 0)
        f i j = min (acc HM.! (i-1, j)) (acc HM.! (i, j-1)) + mat HM.! (i, j)

Array を UArray にすればちょっと速くなると思います。アルゴリズムとしては、 minPath をメモ化するなどして、部分問題を 2 回解かないようにすると良さそうです (例: minPath (7, 7) が 2 回計算されないようにすると良さそうです)

ncaq さんの実行時間 0.4 秒は、スクリプト実行 (`runghc`) とコンパイル実行 (`stack run`) の違いでしょうか？　僕は 12 秒でした

time stack runghc app/Main.hs で
動かしても0.2秒なんですよね(stack runでプロジェクト全体をconfするより早いのかな)

あ、stack runghcは一回ビルドされてるのを使うのか、普段そういうことせずにrunするばかりだからわかっていなかッた

確かに stack runghc ではなく、runghcコマンドを直接使って、 time runghc app/Main.hs したら16秒かかりました
ちょっとでも最適化するとある程度メモ化されるのかな
確かかなり前からwhereで定義した関数を順番に回しまくると勝手にメモ化されたような気がします

さすが GHC!

手続き的にやると runghc が 0.166 秒でした

vector だったら constructN を使うと (見た目上) immutable に解けます。 array でいい感じにやる解法は、今は思いつかないですねー

別の計算をしていたので、コードは修正します ( )
編集 (2): 直しました。

実運用を考えるならmassivあたりを使って並列化してCPUパワーで押しきれないか考えたくなりますね
これぐらいのサイズなら不要ですけど

massiv 憧れますねー。 API もデカくて触れてません >_<

私は競技プログラミング的な話は苦手なんですが、元同僚がmassivを使ってアルゴリズムを並列に実行するように書き換えてましたね

ncaq さんは競プロとか関係なく強いw
Haskell をやる職場は最高ですね

元の質問の答えとしては、
1. minPath を呼ぶ度に i * j サイズの Array を作るため遅いです。
2. 手続き的にやる (上記 a.hs) か、メモ化する (ncaq さんの解法など) か、畳み込みで 1 行ずつ計算する などになります

たくさんの反応をいただけてうれしいです。とても勉強になります。
自分でもいろいろと計ってみました。計測は、`runghc --ghc-arg=-Rghc-timing Main.hs`で実行時間を表示しました。
まず、私の解法を別環境 (CPU: Ryzen 7 5700G, RAM: 32GB) で試したところ21.844 MUTとなりました。Ryzen 5 3600, 16GB では40.141 MUTだったことを考えると性能による差が思っていたよりも大きいので驚きました。
次に、私のminPathを以下のように変更しました。

minPath :: Array (Int,Int) Int -> Array (Int,Int) Int
minPath mat = listArray ((1,1),(10,10)) $ [ f i j | i<-[1..10], j<-[1..10]]
    where   f 1 1 = mat ! (1,1)
            f 1 j = mat ! (1,j) + minPath mat ! (1,j-1)
            f i 1 = mat ! (i,1) + minPath mat ! (i-1,1)
            f i j = min (minPath mat ! (i,j-1)) (minPath mat ! (i-1,j)) + mat ! (i, j)
            -- f i j = if minPath mat ! (i-1,j) > minPath mat ! (i,j-1) 
            --             then minPath mat ! (i,j-1) + mat ! (i,j) 
            --             else minPath mat ! (i-1,j) + mat ! (i,j)

すると、2.531 MUTで計算が終わりました。なぜif式のときとこんなに違いが出たのでしょうか？

minPath mat の定義の中で minPath mat を呼んでいると素朴には再帰呼び出しのたびに新しい Array が作られるので、遅いのが普通ですね。GHCの最適化が効けば効率的なコードになるかもしれませんが。

minPath :: Array (Int,Int) Int -> Array (Int,Int) Int
minPath mat = result
    where
        result = listArray ((1,1),(10,10)) $ [ f i j | i<-[1..10], j<-[1..10]]
        f 1 1 = mat ! (1,1)
        f 1 j = mat ! (1,j) + result ! (1,j-1)
        f i 1 = mat ! (i,1) + result ! (i-1,1)
        f i j = if result ! (i-1,j) > result ! (i,j-1) 
                    then result ! (i,j-1) + mat ! (i,j) 
                    else result ! (i-1,j) + mat ! (i,j)

に変えればインタープリターでも一瞬で終わると思います。

話の流れをちゃんと追っていないので的を外した発言になっていたらごめんなさい。

差分での時間の違いは、minPathのf i jのパターンを一回適用するごとにminPathを3回適用しているのを2回に抑制したためだと思います
再帰で雪だるま式に増えているので大きな差になります
runghcでの実行だと自動的なメモ化が働いていないようなので(多分)、ダイレクトに差が出ます
ちなみに今回の内容はメモ化による効率化の影響が大きいので、同じ内容でもコンパイルしてからだと勝手にメモ化をしてくれて速度が上がるはず
(どういうときにどう自動的にメモ化してくれるのかはよく分かってない)
※修正しました

たぬきうどん [12:35]
ご回答ありがとうございます。
私のminPath関数の挙動が「全てのマスに対して最小の和を求める」となっているのは、minPath m の型が Array (Int,Int) Int となっており、(1,1)から(10,10)まで計算しているからですか？ かりんとうさんのminPath m (i,j)が速いのは返り値の型がIntでArray (Int,Int) Intではないので、すべての要素を計算しなくてもよいからでしょうか？

型もそうですが、内容としてもですが、そうです
(1,1)から(10,10)まで計算、を再帰的にしておりメモ化が働かないと計算量が多いので、再帰的にする内容を省いています

「メモ化が働いていない状況で」「再帰的に」「全ての要素について」計算しているのが時間がかかる根本の原因と思われます、どれかを改善すると大幅に改善するはずです
それとは別に、(7,7)を2回など再帰の中で同じ適用も多い、ifで3回再帰をminで2回再帰に、といった改善点もあります
「メモ化が働いていない状況で」を改善するには、
コンパイルしてから実行するか、自前でメモのための変数を用意する
「再帰的に」を変えるには、
手続き的な処理で１回で済ます
「全ての要素について」を改善するには、
必要な要素だけ計算するようにする
が解決策になると思います

問題から素朴に実装すればできるような

main :: IO ()
main = print $ minPath $ sample 10

sample :: Int -> Array (Int,Int) Int
sample d = listArray ((1,1),(d,d)) [ i + j | i <- [1 .. d], j <- [1 .. d]]

minPath :: Array (Int,Int) Int -> Array (Int,Int) Int
minPath sa = ta
    where
        ta = listArray (bounds sa) (phi <$> assocs sa)
        phi = \ case
            ((1,1),s) -> s
            ((i,1),s) -> ta ! (pred i,1) + s
            ((1,j),s) -> ta ! (1,pred j) + s
            ((i,j),s) -> min (ta ! (pred i, j)) (ta ! (i, pred j)) + s

あらら、<@UGM9F7XQS> さんのコード見落していた。おなじことしてます。:sweat_smile:

個人的に`minPath`問題は面白いお題だとおもいましたので、Haskell Advent Calendar 2024のネタに使わせていただきました。 https://zenn.dev/nobsun/articles/scan-for-2d-array 御笑覧ください。