Comment traduire ce code basé sur une liste en utilisant des tableaux mutables?

Question

EDIT3: J'écris un code pour traiter une liste d'entrée très longue de Int s avec seulement quelques centaines de non-doublons. J'utilise deux listes auxiliaires pour maintenir des sommes partielles cumulatives pour calculer une valeur d'accumulateur, le comment et le pourquoi sont sans importance. Je veux abandonner toutes les listes ici et en faire une belle boucle destructrice, et je ne sais pas comment. Je n'ai pas besoin du code entier, juste un code de squelette serait grand, étaient en lecture/écriture est fait à deux tableaux auxiliaires et un certain résultat final est retourné. Ce que j'ai en ce moment tournerait 0,5 heure pour l'entrée. J'ai codé ceci maintenant en C++, et il fonctionne en 90 secondes pour la même entrée.

---

Je ne comprends pas du tout comment faire. Voici le code basé sur une liste que j'ai en ce moment: ^{(mais le code basé sur une carte ci-dessous est plus clair)}

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) 

Ceci est utilisé dans une boucle, pour traiter une liste de numéros de longueur connue, ^{(changé à foldl maintenant)}

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)) 

Cela fonctionne, mais je dois accélérer. En C, je garderais les listes (a,b) sous forme de tableaux; utilisez la recherche binaire pour trouver l'élément avec la clé juste au-dessus ou égale à n (au lieu de la recherche séquentielle utilisée ici); et utilisez la mise à jour sur place pour modifier toutes les entrées précédentes.

Je ne suis vraiment intéressé par la valeur finale. Comment cela se fait-il chez Haskell, avec des tableaux mutables?

J'ai essayé quelque chose, mais je ne sais vraiment pas ce que je fais ici, et je reçois des messages d'erreur étranges et très longs (comme "impossible de déduire ... du contexte ..."):

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?? 

Cela ne fonctionne pas du tout. Je ne sais même pas comment encoder des boucles en notation. S'il vous plaît aider.

UPD: le code basée sur une carte qui fonctionne 3 fois plus lent:

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: Le message d'erreur est "Impossible de déduire (Num (starray s1 ie)) du contexte() provenant du littéral `0 'à filename.hs: 417: 11"

c'est où il est dit return c dans go1 fonction. Peut-être c devrait être un tableau, mais je veux retourner la valeur de l'accumulateur qui est construit en utilisant les deux tableaux auxiliaires.

---

EDIT3: Je l'ai remplacé scanl et (!!) avec foldl et take selon les conseils de Chris, et il fonctionne maintenant dans l'espace constant avec la complexité empirique saine et est en fait devrait se terminer en moins de 0,5 heure - a.o.t. ... 3 jours! Je le savais bien sûr, mais j'étais si sûr que GHC optimise les choses, sûrement ça ne ferait pas tellement de différence, je pensais! Et donc senti que seuls les tableaux mutables pourraient aider ... Bummer.

Pourtant, C++ fait la même chose en 90 sec, et j'apprécierais beaucoup d'apprendre à coder ceci avec des tableaux mutables, dans Haskell.

Answer 1

légèrement peu orthodoxe, je suis une seconde réponse ajoutant en utilisant une technique mutable. Depuis l'utilisateur1308992 mentionné Fenwick arbres, je les ai utilisés pour implémenter l'algorithme. Deux STUArray sont alloués et mutés pendant l'exécution. L'arbre de base de Fenwick conserve les totaux pour tous les plus petits indices et l'algorithme a besoin de totaux pour tous les plus grands indices. Cette modification est gérée par la soustraction (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

Les valeurs d'entrée sont-elles toujours EQ? Si elles ne sont pas EQ, la façon dont scanl g (0,([],[])) ns est utilisé signifie que le premier tableau [(,)], appelez-le a a toujours map snd a == reverse [1..length a] à chaque étape de g. Par exemple, dans une liste de longueur 10, la valeur de snd (a !! 4) va être 10-4. Garder ces valeurs d'index inversées en faisant muter la deuxième valeur de chaque entrée précédente en a est tout à fait inutile. Si vous avez besoin de vitesse, alors c'est un endroit pour faire un meilleur algorithme.

Rien de tout cela ne s'applique à la deuxième [(,)] dont le but est encore mystérieux pour moi. Il enregistre toutes les insertions qui n'ont pas été faites à la fin de a, donc peut-être cela permet de reconstruire la séquence initiale de valeurs.

Vous avez dit "Je ne m'intéresse vraiment qu'à la valeur finale." Voulez-vous dire que vous vous souciez uniquement de la dernière valeur de la sortie de la liste par la ligne scanl ..? Si oui, vous avez besoin d'un foldl au lieu de scanl. Editer: J'ajoute une solution non mutable en utilisant un arbre à doigts personnalisé. Il passe mon test ad hoc (en bas du code):

{-# 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