このリストベースのコードを可変配列を使って翻訳するには？

Question

EDIT3：私は非常に長い入力リストIntを処理するコードを書いていますが、数百の重複はありません。私はいくつかのアキュムレータ値を計算するために累積部分和を維持するために2つの補助リストを使用しています。私はここですべてのリストを捨てて、それを素晴らしい破壊的なループに変えたいと思います。私は全体のコードを必要としませんちょうどスケルトンコードは偉大な、読み取り/書き込みが2つの補助配列に行われ、いくつかの最終結果が返されます。今私が持っているものは、入力のために0.5時間実行されます。私はこれをC++でコーディングしました。同じ入力に対して90秒で動作します。

---

私はこれを行う方法を全く理解できません。これは私が今持っているリストベースのコードです：^{（但し、下記の地図ベースのコードは明確である）}

ins :: (Num b, Ord a) => a -> b -> [(a, b)] -> ([(a, b)], b) 
ins n x [] = ([(n,x)], 0) 
ins n x l@((v, s):t) = 
    case compare n v of 
    LT -> ((n,s+x) : l , s) 
    EQ -> ((n,s+x) : t , if null t then 0 else snd (head t)) 
    GT -> let (u,z) = ins n x t 
      in ((v,s+x):u,z) 

これは、既知の長さの番号のリストを処理するために、ループ内で使用されています^{これは動作しますが、私はそれをスピードアップする必要が}

scanl g (0,([],[])) ns -- ns :: [Int] 
g :: 
    (Num t, Ord t, Ord a) => 
    (t, ([(a, t)], [(a, t)])) -> a -> (t, ([(a, t)], [(a, t)])) 
g (c,(a, b)) n = 
    let 
     (a2,x) = ins n 1 a 
     (b2,y) = if x>0 then ins n x b else (b,0) 
     c2  = c + y 
    in 
     (c2,(a2, b2)) 

（今foldlのためにそれを変更しました）。 Cでは、私はリストを(a,b)の配列として保持します。バイナリ検索を使用して、n以上のキーを持つ要素を検索します（ここで使用されるシーケンシャル検索ではなく）。インプレース更新を使用して上記のすべてのエントリを変更します。

私は本当に最終価値に興味があります。これはHaskellでどのように変更可能な配列で行われますか？

私は何かしようとしましたが、私がここで何をしているのかわからず、奇妙で非常に長いエラーメッセージ（「コンテキストから推論できません...」）：

goarr top = runSTArray $ do 
    let sz = 10000 
    a <- newArray (1,sz) (0,0) :: ST s (STArray s Int (Integer,Integer)) 
    b <- newArray (1,sz) (0,0) :: ST s (STArray s Int (Integer,Integer)) 
    let p1 = somefunc 2 -- somefunc :: Integer -> [(Integer, Int)] 
    go1 p1 2 0 top a b 

go1 p1 i c top a b = 
    if i >= top 
    then 
     do 
     return c 
    else 
     go2 p1 i c top a b 

go2 p1 i c top a b = 
    do 
    let p2 = somefunc (i+1) -- p2 :: [(Integer, Int)] 
    let n = combine p1 p2 -- n :: Int 
    -- update arrays and calc new c 
    -- like the "g" function is doing: 
    -- (a2,x) = ins n 1 a 
    -- (b2,y) = if x>0 then ins n x b else (b,0) 
    -- c2  = c + y 
    go1 p2 (i+1) c2 top a b -- a2 b2?? 

これはまったく機能しません。私はdo表記法でループをエンコードする方法も知らない。助けてください。

UPD： 3倍遅く走る地図ベースのコード：

ins3 :: (Ord k, Num a) => k -> a -> Map.Map k a -> (Map.Map k a, a) 
ins3 n x a | Map.null a = (Map.insert n x a , 0) 
ins3 n x a = let (p,q,r) = Map.splitLookup n a in 
    case q of 
    Nothing -> (Map.union (Map.map (+x) p) 
       (Map.insert n (x+leftmost r) r) , leftmost r) 
    Just s -> (Map.union (Map.map (+x) p) 
       (Map.insert n (x+s) r) , leftmost r) 

leftmost r | Map.null r = 0 
      | otherwise = snd . head $ Map.toList r 

UPD2：文脈からのエラーメッセージは「推測できませんでした（NUM（STARRAY S1 IE））（） filename.hs：417：11でリテラル「0」から生じる

return cの中のgo1の機能です。おそらくcは配列であると予想されますが、2つの補助配列を使用して構築されたアキュムレータ値を返したいと思います。

---

EDIT3：私はクリスのアドバイスに従ってfoldlとtakeでscanlと(!!)を交換してきた、そして今、それは正気経験的複雑さに一定の間隔で実行され、実際には0.5時間未満で終了すると予測されている - a.o.t. ... 3日間！私はもちろんそのことを知っていましたが、GHCが私のためにその材料を最適化してくれることを確信していました。違いがそれほどありません。、私は思った！そして、変更可能なアレイだけが助けになると感じました...バマー。

でも、C++は90秒で同じことをしますが、これを可変配列でコード化する方法をHaskellで学ぶことには大変感謝しています。

Answer 1

私は少し変わったテクニックを使って2番目の答えを追加しています。 user1308992はFenwickの木について言及して以来、私はそれらを使ってアルゴリズムを実装しました。 2つのSTUArrayは、実行中に割り当てられ、突然変異される。基本的なフェンウィックの木はすべての小さな指標の合計を保持しており、ここでのアルゴリズムはより大きなすべての指標の合計が必要です。この変更は(sz-x)の減算によって処理されます。

import Control.Monad.ST(runST,ST) 
import Data.Array.ST(STUArray,newArray) 
import Data.Array.Base(unsafeRead, unsafeWrite) 
import Data.Bits((.&.)) 
import Debug.Trace(trace) 
import Data.List(group,sort) 

{-# INLINE lsb #-} 
lsb :: Int -> Int 
lsb i = (negate i) .&. i 

go :: [Int] -> Int 
go xs = compute (maximum xs) xs 

-- Require "top == maximum xs" and "all (>=0) xs" 
compute :: Int -> [Int] -> Int 
compute top xs = runST mutating where 
    -- Have (sz - (top+1)) > 0 to keep algorithm simple 
    sz = top + 2 

    -- Reversed Fenwick tree (no bounds checking) 
    insert :: STUArray s Int Int -> Int -> Int -> ST s() 
    insert arr x v = loop (sz-x) where 
    loop i | i > sz = return() 
      | i <= 0 = error "wtf" 
      | otherwise = do 
     oldVal <- unsafeRead arr i 
     unsafeWrite arr i (oldVal + v) 
     loop (i + lsb i) 

    getSum :: STUArray s Int Int -> Int -> ST s Int 
    getSum arr x = loop (sz - x) 0 where 
    loop i acc | i <= 0 = return acc 
       | otherwise = do 
     val <- unsafeRead arr i 
     loop (i - lsb i) $! acc + val 

    ins n x arr = do 
    insert arr n x 
    getSum arr (succ n) 

    mutating :: ST s Int 
    mutating = do 
    -- Start index from 0 to make unsafeRead, unsafeWrite easy 
    a <- newArray (0,sz) 0 :: ST s (STUArray s Int Int) 
    b <- newArray (0,sz) 0 :: ST s (STUArray s Int Int) 
    let loop [] c = return c 
     loop (n:ns) c = do 
      x <- ins n 1 a 
      y <- if x > 0 
       then 
       ins n x b 
       else 
       return 0 
      loop ns $! c + y 
    -- Without debugging use the next line 
    -- loop xs 0 
    -- With debugging use the next five lines 
    c <- loop xs 0 
    a' <- see a 
    b' <- see b 
    trace (show (c,(a',b'))) $ do 
    return c 

    -- see is only used in debugging 
    see arr = do 
    let zs = map head . group . sort $ xs 
    vs <- sequence [ getSum arr z | z <- zs ] 
    let ans = filter (\(a,v) -> v>0) (zip zs vs) 
    return ans 

up = [1..6] 
down = [5,4..1] 
see'tests = map go [ up, down, up ++ down, down ++ up ] 

main = putStrLn . unlines . map show $ see'tests 

Answer 2

入力値はこれまでEQですか？それらがEQでない場合、scanl g (0,([],[])) nsの方法は、最初の[(,)]アレイを意味し、aはgの各段階で常にmap snd a == reverse [1..length a]となります。たとえば、長さ10のリストでは、snd (a !! 4)の値は10-4になります。前の各エントリの2番目の値をaに変更して、これらの逆インデックス値を維持することはかなり無駄です。スピードが必要な場合は、これはより良いアルゴリズムを作るための1つの場所です。

これは第2の[(,)]には当てはまりませんが、その目的はまだ私にとって不思議です。これは、aの最後に行われなかったすべての挿入を記録します。したがって、おそらく最初の値のシーケンスを再構成することができます。

あなたは「私は最終価値にのみ関心がある」と言いました。 scanl ..行でリスト出力の最後の値だけを気にかけているということですか？その場合はscanlの代わりにfoldlが必要です。

編集：カスタムFinger Treeを使用して、変更不可能なソリューションを追加しています。コードの最後にある特別なテストに合格します：

{-# LANGUAGE MultiParamTypeClasses #-} 
import Data.Monoid 
import Data.FingerTree 

data Entry a v = E !a !v deriving Show 

data ME a v = NoF | F !(Entry a v) deriving Show 

instance Num v => Monoid (ME a v) where 
    mempty = NoF 
    NoF `mappend` k = k 
    k `mappend` NoF = k 
    (F (E _a1 v1)) `mappend` (F (E a2 v2)) = F (E a2 (v1 + v2)) 

instance Num v => Measured (ME a v) (Entry a v) where 
    measure = F 

type M a v = FingerTree (ME a v) (Entry a v) 

getV NoF = 0 
getV (F (E _a v)) = v 

expand :: Num v => M a v -> [(a, v)] 
expand m = case viewl m of 
      EmptyL -> [] 
      (E a _v) :< m' -> (a, getV (measure m)) : expand m' 

ins :: (Ord a, Num v) => a -> v -> M a v -> (M a v, v) 
ins n x m = 
    let comp (F (E a _)) = n <= a 
     comp NoF = False 
     (lo, hi) = split comp m 
    in case viewl hi of 
     EmptyL -> (lo |> E n x, 0) 
     (E v s) :< higher | n < v -> 
     (lo >< (E n x <| hi), getV (measure hi)) 
         | otherwise -> 
     (lo >< (E n (s+x) <| higher), getV (measure higher)) 

g :: (Num t, Ord t, Ord a) => 
    (t, (M a t, M a t)) -> a -> (t, (M a t, M a t)) 
g (c, (a, b)) n = 
    let (a2, x) = ins n 1 a 
     (b2, y) = if x>0 then ins n x b else (b, 0) 
    in (c+y, (a2, b2)) 

go :: (Ord a, Num v, Ord v) => [a] -> (v, ([(a, v)], [(a, v)])) 
go ns = let (t, (a, b)) = foldl g (0, (mempty, mempty)) ns 
     in (t, (expand a, expand b)) 

up = [1..6] 
down = [5,4..1] 
see'tests = map go [ up, down, up ++ down, down ++ up ] 

main = putStrLn . unlines . map show $ see'test