¿Por qué este código de Haskell se ejecuta más lentamente con-O?
optimization ghc (1)
Supongo que es hora de que esta pregunta obtenga una respuesta adecuada.
¿Qué pasó con tu código con
-O
Permítame ampliar su función principal y reescribirla ligeramente:
main :: IO ()
main = do
[n, m] <- fmap (map read . words) getLine
line <- getLine
let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words $ line
replicateM_ m $ query n nodes
Claramente, la intención aquí es que el
NodeArray
se cree una vez, y luego se use en cada una de las invocaciones de
query
.
Desafortunadamente, GHC transforma este código para, efectivamente,
main = do
[n, m] <- fmap (map read . words) getLine
line <- getLine
replicateM_ m $ do
let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words $ line
query n nodes
e inmediatamente puedes ver el problema aquí.
¿Qué es el hack de estado y por qué destruye el rendimiento de mis programas?
La razón es el pirateo del estado, que dice (aproximadamente): "Cuando algo es de tipo
IO a
, suponga que se llama solo una vez".
La
documentación oficial
no es mucho más elaborada:
-fno-state-hackDesactive el "hack de estado" por el cual cualquier lambda con un token de estado # como argumento se considera una entrada única, por lo tanto, se considera correcto insertar cosas dentro de él. Esto puede mejorar el rendimiento del código de mónada IO y ST, pero corre el riesgo de reducir el uso compartido.
A grandes rasgos, la idea es la siguiente: si define una función con un tipo
IO
y una cláusula where, p. Ej.
foo x = do
putStrLn y
putStrLn y
where y = ...x...
Algo del tipo
IO a
puede verse como algo del tipo
RealWord -> (a, RealWorld)
.
En esa vista, lo anterior se convierte (aproximadamente)
foo x =
let y = ...x... in
/world1 ->
let (world2, ()) = putStrLn y world1
let (world3, ()) = putStrLn y world2
in (world3, ())
Una llamada a
foo
vería (típicamente) como este
foo argument world
.
¡Pero la definición de
foo
solo toma un argumento, y el otro solo se consume más tarde por una expresión lambda local!
Será una llamada muy lenta para
foo
.
Sería mucho más rápido si el código se viera así:
foo x world1 =
let y = ...x... in
let (world2, ()) = putStrLn y world1
let (world3, ()) = putStrLn y world2
in (world3, ())
Esto se llama eta-expansión y se realiza por diversos motivos (por ejemplo, analizando la definición de la función , comprobando cómo se llama y, en este caso, la heurística dirigida por tipo).
Desafortunadamente, esto degrada el rendimiento si la llamada a
foo
es en realidad de la forma
let fooArgument = foo argument
, es decir, con un argumento, pero no pasó ningún
world
(todavía).
En el código original, si
fooArgument
se usa varias veces,
y
todavía se calculará solo una vez y se compartirá.
En el código modificado,
y
se volverá a calcular cada vez, precisamente lo que ha sucedido con sus
nodes
.
¿Se pueden arreglar las cosas?
Posiblemente. Ver #9388 para un intento de hacerlo. El problema con solucionarlo es que costará rendimiento en muchos casos en los que la transformación pasa a estar bien, aunque el compilador no puede saberlo con certeza. Y probablemente haya casos en los que técnicamente no está bien, es decir, se pierde el uso compartido, pero sigue siendo beneficioso porque las aceleraciones de las llamadas más rápidas superan el costo adicional del recálculo. Por lo tanto, no está claro a dónde ir desde aquí.
Este fragmento de código Haskell funciona
mucho
más lento con
-O
, pero
-O
debería ser
non-dangerous
.
¿Alguien puede decirme qué pasó?
Si es importante, es un intento de resolver
este problema
y utiliza la búsqueda binaria y el árbol de segmentos persistentes:
import Control.Monad
import Data.Array
data Node =
Leaf Int -- value
| Branch Int Node Node -- sum, left child, right child
type NodeArray = Array Int Node
-- create an empty node with range [l, r)
create :: Int -> Int -> Node
create l r
| l + 1 == r = Leaf 0
| otherwise = Branch 0 (create l m) (create m r)
where m = (l + r) `div` 2
-- Get the sum in range [0, r). The range of the node is [nl, nr)
sumof :: Node -> Int -> Int -> Int -> Int
sumof (Leaf val) r nl nr
| nr <= r = val
| otherwise = 0
sumof (Branch sum lc rc) r nl nr
| nr <= r = sum
| r > nl = (sumof lc r nl m) + (sumof rc r m nr)
| otherwise = 0
where m = (nl + nr) `div` 2
-- Increase the value at x by 1. The range of the node is [nl, nr)
increase :: Node -> Int -> Int -> Int -> Node
increase (Leaf val) x nl nr = Leaf (val + 1)
increase (Branch sum lc rc) x nl nr
| x < m = Branch (sum + 1) (increase lc x nl m) rc
| otherwise = Branch (sum + 1) lc (increase rc x m nr)
where m = (nl + nr) `div` 2
-- signature said it all
tonodes :: Int -> [Int] -> [Node]
tonodes n = reverse . tonodes'' . reverse
where
tonodes'' :: [Int] -> [Node]
tonodes'' (h:t) = increase h'' h 0 n : s'' where s''@(h'':_) = tonodes'' t
tonodes'' _ = [create 0 n]
-- find the minimum m in [l, r] such that (predicate m) is True
binarysearch :: (Int -> Bool) -> Int -> Int -> Int
binarysearch predicate l r
| l == r = r
| predicate m = binarysearch predicate l m
| otherwise = binarysearch predicate (m+1) r
where m = (l + r) `div` 2
-- main, literally
main :: IO ()
main = do
[n, m] <- fmap (map read . words) getLine
nodes <- fmap (listArray (0, n) . tonodes n . map (subtract 1) . map read . words) getLine
replicateM_ m $ query n nodes
where
query :: Int -> NodeArray -> IO ()
query n nodes = do
[p, k] <- fmap (map read . words) getLine
print $ binarysearch (ok nodes n p k) 0 n
where
ok :: NodeArray -> Int -> Int -> Int -> Int -> Bool
ok nodes n p k s = (sumof (nodes ! min (p + s + 1) n) s 0 n) - (sumof (nodes ! max (p - s) 0) s 0 n) >= k
(Este es exactamente el mismo código con la revisión de código, pero esta pregunta aborda otro problema).
Este es mi generador de entrada en C ++:
#include <cstdio>
#include <cstdlib>
using namespace std;
int main (int argc, char * argv[]) {
srand(1827);
int n = 100000;
if(argc > 1)
sscanf(argv[1], "%d", &n);
printf("%d %d/n", n, n);
for(int i = 0; i < n; i++)
printf("%d%c", rand() % n + 1, i == n - 1 ? ''/n'' : '' '');
for(int i = 0; i < n; i++) {
int p = rand() % n;
int k = rand() % n + 1;
printf("%d %d/n", p, k);
}
}
En caso de que no tenga un compilador de C ++ disponible,
este es el resultado de
./gen.exe 1000
.
Este es el resultado de la ejecución en mi computadora:
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.8.3
$ ghc -fforce-recomp 1827.hs
[1 of 1] Compiling Main ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real 0m0.088s
user 0m0.015s
sys 0m0.015s
$ ghc -fforce-recomp -O 1827.hs
[1 of 1] Compiling Main ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real 0m2.969s
user 0m0.000s
sys 0m0.045s
Y este es el resumen del perfil del montón:
$ ghc -fforce-recomp -rtsopts ./1827.hs
[1 of 1] Compiling Main ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
70,207,096 bytes allocated in the heap
2,112,416 bytes copied during GC
613,368 bytes maximum residency (3 sample(s))
28,816 bytes maximum slop
3 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 132 colls, 0 par 0.00s 0.00s 0.0000s 0.0004s
Gen 1 3 colls, 0 par 0.00s 0.00s 0.0006s 0.0010s
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.03s ( 0.03s elapsed)
GC time 0.00s ( 0.01s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.03s ( 0.04s elapsed)
%GC time 0.0% (14.7% elapsed)
Alloc rate 2,250,213,011 bytes per MUT second
Productivity 100.0% of total user, 83.1% of total elapsed
$ ghc -fforce-recomp -O -rtsopts ./1827.hs
[1 of 1] Compiling Main ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
6,009,233,608 bytes allocated in the heap
622,682,200 bytes copied during GC
443,240 bytes maximum residency (505 sample(s))
48,256 bytes maximum slop
3 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 10945 colls, 0 par 0.72s 0.63s 0.0001s 0.0004s
Gen 1 505 colls, 0 par 0.16s 0.13s 0.0003s 0.0005s
INIT time 0.00s ( 0.00s elapsed)
MUT time 2.00s ( 2.13s elapsed)
GC time 0.87s ( 0.76s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 2.89s ( 2.90s elapsed)
%GC time 30.3% (26.4% elapsed)
Alloc rate 3,009,412,603 bytes per MUT second
Productivity 69.7% of total user, 69.4% of total elapsed