Korzystanie z programowania dynamicznego w Haskell? [Ostrzeżenie: rozwiązanie ProjectEuler 31 w środku]

Question

W rozwiązywaniu problemu projecteuler.net # 31 [SPOILERS AHEAD] (licząc liczbę sposobów na 2 £ z brytyjskimi monetami), chciałem użyć programowania dynamicznego. Zacząłem od OCaml i napisałem krótkie i bardzo wydajne następujące programowanie:

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

Wykonuje się w ~ 8ms na moim laptopie. Jeśli zwiększę kwotę z 200 pensów do miliona, program nadal znajdzie odpowiedź w mniej niż dwie sekundy.

Przetłumaczyłem program na Haskell (który z pewnością nie był zabawny sam w sobie), i chociaż kończy się prawidłową odpowiedzią za 200 pensów, jeśli zwiększę tę liczbę do 10000, mój laptop zatrzymuje się w pisku (wiele lanie). Oto kod:

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] 

Chciałbym usłyszeć od kogoś, kto dobrze zna Haskella, dlaczego wydajność tego rozwiązania jest tak zła.

Answer 1

Haskell jest czysty. Czystość oznacza, że ​​wartości są niezmienne, a zatem tworzysz całą nową tablicę dla każdego wpisu, który aktualizujesz, tworząc krok 1. To już jest bardzo kosztowne za niewielką kwotę, np. 2 funty, ale staje się całkowicie nieprzyzwoite za kwotę 100 funtów.

Co więcej, tablice są zapakowane w pudełka, co oznacza, że ​​zawierają wskaźniki do wpisów, co pogarsza lokalność, wykorzystuje więcej pamięci i pozwala na tworzenie sygnałów, które są również wolniejsze do oceny, kiedy są ostatecznie wymuszane.

Zastosowany algorytm zależy od zmienny struktury danych dla jego wydajności, ale zmienność ogranicza się do obliczeń, więc możemy wykorzystać to, co ma na celu umożliwienie bezpiecznego ekranowanych obliczeń z danymi tymczasowo modyfikowalnych The ST stan rodzinny transformator monada, i związane z nimi tablice [unboxed, for efficiency].

Daj mi pół godziny, aby przetłumaczyć algorytm na kod przy użyciu STUArray s, a otrzymasz wersję Haskella, która nie jest zbyt brzydka i powinna być porównywalna do wersji O'Caml (niektóre lub więcej mniejszy stały czynnik jest oczekiwany dla różnicy, czy jest większy, czy mniejszy niż 1, nie wiem).

Oto ona:

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 

przebiega w niezbyt shabby czasie

$ 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 

i wykorzystuje sprawdzone macierz dostępów, używając dostępy niezaznaczone, czas może być nieco zmniejszona.

---

Ach, właśnie dowiedziałem się, że Twój kod O'Caml korzysta z dowolną dokładnością liczby całkowite, więc korzystanie Int w Haskell stawia O'Caml w niekorzystnej sytuacji.Zmiany niezbędne do obliczania wyników z dowolną dokładnością Integer S są 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) 

tylko dwa podpisy typu musiały być dostosowane - tablica koniecznie zostaje zapakowane, więc musimy się upewnić, że nie piszesz łącznikami do tablicy w linii 28 i

$ 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 

obliczenie z dużą wyniku czego przelała do Int s trwa znacznie dłużej, ale jak oczekiwano porównywalne z O'Caml.

---

poświęcić trochę czasu ze zrozumieniem O'Caml mogę zaoferować bliżej, nieco krótsze, a zapewne ładniejszy tłumaczenie:

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 

który działa równie szybko o:

$ time ./mutArrIgrM 1000000 
99341140660285639188927260001 

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

Answer 2

Możesz skorzystać z tego, że Haskell jest leniwy i nie planować wypełniania się, ale zamiast tego polegać na leniwej ocenie, aby zrobić to we właściwej kolejności. (W przypadku dużych nakładów trzeba zwiększyć rozmiar stosu.)

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]