Utilizzo della programmazione dinamica in Haskell? [Warning: Project Euler 31 soluzione all'interno]

Question

Nel risolvere di projecteuler.net problema # 31 [SPOILER AVANTI] (contando il numero di modi per fare 2 £ con le monete britanniche), ho voluto usare programmazione dinamica. Ho iniziato con OCaml, e ha scritto il corto e molto efficiente seguente programmazione:

open Num 

let make_dyn_table amount coins = 
    let t = Array.make_matrix (Array.length coins) (amount+1) (Int 1) in 
    for i = 1 to (Array.length t) - 1 do 
    for j = 0 to amount do 
     if j < coins.(i) then 
     t.(i).(j) <- t.(i-1).(j) 
     else 
     t.(i).(j) <- t.(i-1).(j) +/ t.(i).(j - coins.(i)) 
    done 
    done; 
    t 

let _ = 
    let t = make_dyn_table 200 [|1;2;5;10;20;50;100;200|] in 
    let last_row = Array.length t - 1 in 
    let last_col = Array.length t.(last_row) - 1 in 
    Printf.printf "%s\n" (string_of_num (t.(last_row).(last_col))) 

Esegue in ~ 8ms sul mio portatile. Se aumento l'importo da 200 pence a un milione, il programma trova ancora una risposta in meno di due secondi.

Ho tradotto il programma per Haskell (che non era sicuramente divertente in sé), e anche se termina con la risposta giusta per 200 pence, se aumentare quel numero a 10000, il mio computer portatile viene a una brusca frenata (un sacco di thrashing). Ecco il codice:

import Data.Array 

createDynTable :: Int -> Array Int Int -> Array (Int, Int) Int 
createDynTable amount coins = 
    let numCoins = (snd . bounds) coins 
     t = array ((0, 0), (numCoins, amount)) 
      [((i, j), 1) | i <- [0 .. numCoins], j <- [0 .. amount]] 
    in t 

populateDynTable :: Array (Int, Int) Int -> Array Int Int -> Array (Int, Int) Int 
populateDynTable t coins = 
    go t 1 0 
     where go t i j 
       | i > maxX = t 
       | j > maxY = go t (i+1) 0 
       | j < coins ! i = go (t // [((i, j), t ! (i-1, j))]) i (j+1) 
       | otherwise = go (t // [((i, j), t!(i-1,j) + t!(i, j - coins!i))]) i (j+1) 
       ((_, _), (maxX, maxY)) = bounds t 

changeCombinations amount coins = 
    let coinsArray = listArray (0, length coins - 1) coins 
     dynTable = createDynTable amount coinsArray 
     dynTable' = populateDynTable dynTable coinsArray 
     ((_, _), (i, j)) = bounds dynTable 
    in 
     dynTable' ! (i, j) 

main = 
    print $ changeCombinations 200 [1,2,5,10,20,50,100,200] 

Mi piacerebbe sentire da qualcuno che conosce Haskell bene perché le prestazioni di questa soluzione è poi così male.

Answer 1

Haskell è puro. La purezza significa che i valori sono immutabili, e quindi nella fase

j < coins ! i = go (t // [((i, j), t ! (i-1, j))]) i (j+1) 

si crea un intero nuovo array per ogni voce si aggiorna. Questo è già molto costoso per una piccola somma come £ 2, ma diventa completamente osceno per un importo di £ 100.

Inoltre, gli array sono in scatola, il che significa che contengono puntatori alle voci, che peggiora la località, utilizza più spazio di archiviazione e consente di creare dei thunks che sono anche più lenti da valutare quando alla fine sono forzati.

L'algoritmo utilizzato dipende da una struttura di dati mutabile per la sua efficienza, ma la mutabilità è limitata al calcolo, quindi è possibile utilizzare ciò che è destinato a consentire calcoli protetti in sicurezza con dati temporaneamente mutabili, la famiglia monad di trasformatori di stato ST, e gli array associati [unboxed, for efficiency].

Datemi mezz'ora per tradurre l'algoritmo in codice usando STUArray s, e otterrete una versione Haskell che non è troppo brutta, e dovrebbe essere comparabile alla versione O'Caml (un po 'di più o per la differenza è previsto un fattore meno costante, che sia maggiore o minore di 1, non lo so).

Eccolo:

module Main (main) where 

import System.Environment (getArgs) 

import Data.Array.ST 
import Control.Monad.ST 
import Data.Array.Unboxed 

standardCoins :: [Int] 
standardCoins = [1,2,5,10,20,50,100,200] 

changeCombinations :: Int -> [Int] -> Int 
changeCombinations amount coins = runST $ do 
    let coinBound = length coins - 1 
     coinsArray :: UArray Int Int 
     coinsArray = listArray (0, coinBound) coins 
    table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STUArray s (Int,Int) Int) 
    let go i j 
      | i > coinBound = readArray table (coinBound,amount) 
      | j > amount = go (i+1) 0 
      | j < coinsArray ! i = do 
       v <- readArray table (i-1,j) 
       writeArray table (i,j) v 
       go i (j+1) 
      | otherwise = do 
       v <- readArray table (i-1,j) 
       w <- readArray table (i, j - coinsArray!i) 
       writeArray table (i,j) (v+w) 
       go i (j+1) 
    go 1 0 

main :: IO() 
main = do 
    args <- getArgs 
    let amount = case args of 
        a:_ -> read a 
        _ -> 200 
    print $ changeCombinations amount standardCoins 

viene eseguito in tempo non troppo malandato,

$ time ./mutArr 
73682 

real 0m0.002s 
user 0m0.000s 
sys  0m0.001s 
$ time ./mutArr 1000000 
986687212143813985 

real 0m0.439s 
user 0m0.128s 
sys  0m0.310s 

e la matrice usa controllato accessi, utilizzando gli accessi non controllati, il tempo potrebbe essere un po 'ridotta.

---

Ah, ho appena appreso che il codice O'Caml utilizza numeri interi precisione arbitraria, in modo da utilizzare Int in Haskell mette O'Caml uno svantaggio sleale.Le modifiche necessarie per calcolare i risultati con precisione arbitraria Integer s sono minmal,

$ diff mutArr.hs mutArrIgr.hs 
12c12 
< changeCombinations :: Int -> [Int] -> Int 
--- 
> changeCombinations :: Int -> [Int] -> Integer 
17c17 
<  table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STUArray s (Int,Int) Int) 
--- 
>  table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STArray s (Int,Int) Integer) 
28c28 
<     writeArray table (i,j) (v+w) 
--- 
>     writeArray table (i,j) $! (v+w) 

solo due firme di tipo necessari per essere adattato - la matrice necessariamente diventa inscatolato, quindi abbiamo bisogno di assicurarsi che non stiamo scrivendo thunk alla matrice nella linea 28, e

$ time ./mutArrIgr 
73682 

real 0m0.002s 
user 0m0.000s 
sys  0m0.002s 
$ time ./mutArrIgr 1000000 
99341140660285639188927260001 

real 0m1.314s 
user 0m1.157s 
sys  0m0.156s 

il calcolo con il grande risultato che traboccato per Int s richiede notevolmente più lunga, ma come previsto paragonabile al O'Caml.

---

Trascorrere un po 'di tempo capire l'O'Caml, posso offrire una più stretta, un po' più breve, e la traduzione senza dubbio più bello:

module Main (main) where 

import System.Environment (getArgs) 

import Data.Array.ST 
import Control.Monad.ST 
import Data.Array.Unboxed 
import Control.Monad (forM_) 

standardCoins :: [Int] 
standardCoins = [1,2,5,10,20,50,100,200] 

changeCombinations :: Int -> [Int] -> Integer 
changeCombinations amount coins = runST $ do 
    let coinBound = length coins - 1 
     coinsArray :: UArray Int Int 
     coinsArray = listArray (0, coinBound) coins 
    table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STArray s (Int,Int) Integer) 
    forM_ [1 .. coinBound] $ \i -> 
     forM_ [0 .. amount] $ \j -> 
      if j < coinsArray!i 
       then do 
        v <- readArray table (i-1,j) 
        writeArray table (i,j) v 
       else do 
       v <- readArray table (i-1,j) 
       w <- readArray table (i, j - coinsArray!i) 
       writeArray table (i,j) $! (v+w) 
    readArray table (coinBound,amount) 

main :: IO() 
main = do 
    args <- getArgs 
    let amount = case args of 
        a:_ -> read a 
        _ -> 200 
    print $ changeCombinations amount standardCoins 

che gestisce circa altrettanto veloce:

$ time ./mutArrIgrM 1000000 
99341140660285639188927260001 

real 0m1.440s 
user 0m1.273s 
sys  0m0.164s 

Answer 2

Potresti approfittare di Haskell essere pigro e non pianificare la compilazione dell'array, ma affidarti alla valutazione pigra per farlo nel giusto ordine. (Per i grandi ingressi è necessario aumentare la dimensione dello stack.)

import Data.Array 

createDynTable :: Integer -> Array Int Integer -> Array (Int, Integer) Integer 
createDynTable amount coins = 
    let numCoins = (snd . bounds) coins 
     t = array ((0, 0), (numCoins, amount)) 
      [((i, j), go i j) | i <- [0 .. numCoins], j <- [0 .. amount]] 
     go i j | i == 0  = 1 
       | j < coins ! i = t ! (i-1, j) 
       | otherwise  = t ! (i-1, j) + t ! (i, j - coins!i) 
    in t 


changeCombinations amount coins = 
    let coinsArray = listArray (0, length coins - 1) coins 
     dynTable = createDynTable amount coinsArray 
     ((_, _), (i, j)) = bounds dynTable 
    in 
     dynTable ! (i, j) 

main = 
    print $ changeCombinations 200 [1,2,5,10,20,50,100,200]