Hoje irei exagerar um pouco e verificar o quão grátis é o almoço de paralelismo servido pelo ecossistema Haskell.
Para fins de estudo, irei criar um algoritmo bastante simples e ideal para utilizar paralelismo: duas funções distintas com cargas de trabalho parecidas que não possuem dependência entre si.
Uma destas funções calculará qual é o menor valor de uma lista e a outra calculará o maior valor. Sendo assim, as duas precisarão consultar todos os elementos da lista e fazer a mesma quantidade de comparações. Os dois valores serão somados e impressos ao usuário:
module Main where
import Data.List (foldl1')
main = print result
where result = a + b
a = foldl1' min list
b = foldl1' max list
list = [1..19999999]
Compilei o código com ghc -rtsopts e executei ele com +RTS -s para verificar como ele se comportou:
20000000
803,172,764 bytes allocated in the heap
860,135,516 bytes copied during GC
233,464,876 bytes maximum residency (9 sample(s))
30,086,296 bytes maximum slop
483 MB total memory in use (0 MB lost due to fragmentation)
Generation 0: 1523 collections, 0 parallel, 0.80s, 0.97s elapsed
Generation 1: 9 collections, 0 parallel, 0.92s, 1.30s elapsed
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.90s ( 0.98s elapsed)
GC time 1.72s ( 2.27s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 2.62s ( 3.25s elapsed)
%GC time 65.5% (69.8% elapsed)
Alloc rate 887,674,003 bytes per MUT second
Productivity 34.5% of total user, 27.8% of total elapsed
Esta saída significa que o programa levou 3,25 segundos para executar e ocupou 483 MB de memória. Um valor um tanto absurdo para algo que deveria ser simples e rápido em Haskell. O problema do algoritmo é que durante o cálculo do valor mínimo, o coletor de lixo não coleta os itens já passados pois o cálculo do valor máximo possui referência para o inicio da lista.
Para resolver o problema é possível gerar listas diferentes, uma para cada cálculo na forma de uma função constante:
module Main where
import Data.List (foldl1')
main = print result
where result = a + b
a = foldl1' min $ list ()
b = foldl1' max $ list ()
list _ = [1..19999999]
Esta versão termina em 1,6 segundos e consome apenas 1 MB de memória. Atenção: se o programa for compilado com -O2, o GHC irá otimizar a declaração de função deixando a referencia para a lista no lugar e o programa continuará a usar os 483 MB de memória.
Este é o momento de refatorar o algoritmo para evitar duplicidade de código. Para um programa deste tamanho, acredito que normalmente não é feito, porém para que a transição para a utilização de paralelismo fique mais suave, é um passo necessário:
module Main where
import Data.List (foldl1')
import Control.Arrow ((&&&))
main = print result
where result = (+) `uncurry` constMinMax list
list _ = [1..19999999]
(.:) f g a b = f a (g b)
constApp = ($ ())
constMinMax = constMinList &&& constMaxList
constFold = foldl1' .: constApp
constMinList = constFold min
constMaxList = constFold max
O resultado e o tempo do algoritmo continuam os mesmos. Agora como tornamos este algoritmo preparado para rodar em paralelo? Simples: trocamos a utilização da função uncurry por parUncurry:
module Main where
import Data.List (foldl1')
import Control.Arrow ((&&&))
import Control.Parallel (par, pseq)
main = print result
where result = (+) `parUncurry` constMinMax list
list _ = [1..19999999]
(.:) f g a b = f a (g b)
constApp = ($ ())
constMinMax = constMinList &&& constMaxList
constFold = foldl1' .: constApp
constMinList = constFold min
constMaxList = constFold max
parUncurry f (a, b) = a `par` b `pseq` f a b
Adicionamos à compilação do programa o argumento -threaded e para executar utilizamos +RTS -s -N2 para que o programa utilize duas threads do sistema operacional. O resultado:
20000000
1,606,300,044 bytes allocated in the heap
74,364 bytes copied during GC
28,352 bytes maximum residency (1 sample(s))
24,896 bytes maximum slop
2 MB total memory in use (0 MB lost due to fragmentation)
Generation 0: 1566 collections, 1565 parallel, 0.06s, 0.02s elapsed
Generation 1: 1 collections, 1 parallel, 0.00s, 0.00s elapsed
Parallel GC work balance: 1.79 (15355 / 8588, ideal 2)
MUT time (elapsed) GC time (elapsed)
Task 0 (worker) : 0.00s ( 0.81s) 0.00s ( 0.00s)
Task 1 (worker) : 0.75s ( 0.81s) 0.06s ( 0.01s)
Task 2 (bound) : 0.83s ( 0.81s) 0.00s ( 0.00s)
Task 3 (worker) : 0.00s ( 0.00s) 0.00s ( 0.00s)
SPARKS: 1 (1 converted, 0 pruned)
INIT time 0.00s ( 0.00s elapsed)
MUT time 1.58s ( 0.81s elapsed)
GC time 0.06s ( 0.02s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 1.64s ( 0.83s elapsed)
%GC time 3.8% (1.9% elapsed)
Alloc rate 1,019,478,198 bytes per MUT second
Productivity 96.2% of total user, 189.6% of total elapsed
gc_alloc_block_sync: 78
whitehole_spin: 0
gen[0].sync_large_objects: 0
gen[1].sync_large_objects: 0
Conseguimos reduzir o tempo de execução para 0,83 segundos: a metade do tempo da versão sequencial. Tudo isto com a mudança de uma chamada (partindo do principio de que o programa está bem escrito).
Qual seria o tamanho da mudança necessária na linguagem que você utiliza hoje para ter este mesmo ganho de desempenho?
Apesar do exemplo deste post ser levemente exagerado, este tipo de ganho com apenas uma mudança é algo real em Haskell. A apresentação The Future is Parallel, and the Future of Parallel is Declarative feita por Simon Peyton Jones dá exemplos de aplicações que se beneficiaram deste paralelismo grátis.
