haskell - ¿Por qué la versión pointfree de mi función utiliza mucha más memoria?
(1)
Estaba trabajando en un problema de Project Euler y terminé con un archivo de Haskell que incluía una función que se parecía a esto:
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr (/(cs'', n) a -> fromBool (f cs cs'') * n + a) 0
Con fromBool importado de Foreign.Marshal.Utils solo para convertir rápidamente True a 1 y False a 0 .
Estaba tratando de sacar un poco más de velocidad de mi solución, así que intenté cambiar de foldr a foldl'' (cambiando los argumentos en el proceso), ya que asumí que foldr no tenía mucho sentido usarlos en los números.
El cambio de foldr a foldl'' hizo que asignara más del doble de memoria de acuerdo con el generador de perfiles de GHC.
Por diversión, también decidí reemplazar la lambda con una versión libre de la función:
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr ((+) . uncurry ((*) . fromBool . f cs)) 0
Esto hizo que mi asignación de memoria aumentara 20x desde la versión foldr .
Ahora bien, esto no es un gran problema, ya que incluso en el caso de 20x, la asignación de memoria total fue de solo 135Mb y el tiempo de ejecución del programa no se vio afectado, en todo caso, las versiones de asignación de memoria más altas se ejecutaron un poco más rápido.
Pero tengo mucha curiosidad por saber cómo podrían ser posibles estos resultados, para que en el futuro pueda elegir la función "correcta" cuando no tenga tanto margen de maniobra.
EDITAR:
GHC versión 7.10.2, compilada con -O2 -prof -fprof-auto . Ejecutado con +RTS -p .
EDIT 2:
Bien, parece que esto es demasiado difícil de reproducir para omitir el resto del código, bueno, aquí está el programa completo:
SPOILERS ABAJO:
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad
import Data.List
import Foreign.Marshal.Utils
data Color = Red | Green | Blue deriving (Eq, Enum, Bounded, Show)
colors :: [Color]
colors = [Red ..]
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f x = foldr ((+) . uncurry ((*) . fromBool . f x)) 0
-- matches f x = foldr (/(y, n) a -> fromBool (f x y) * n + a) 0
-- matches f x = foldl'' (/a (y, n) -> fromBool (f x y) * n + a) 0
invert :: [([Color], Int)] -> [([Color], Int)]
invert rs = (/cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM len colors
valid (x : xs) (y : ys) = x /= y && valid xs ys
valid _ _ = True
expand :: [([Color], Int)] -> [([Color], Int)]
expand rs = (/cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM (len + 1) colors
valid (x1 : x2 : xs) (y : ys) = x1 /= y && x2 /= y && valid (x2 : xs) ys
valid _ _ = True
getRow :: Int -> [([Color], Int)]
getRow 1 = flip (,) 1 . pure <$> colors
getRow n = expand . invert $ getRow (n - 1)
result :: Int -> Int
result n = sum $ snd <$> getRow n
main :: IO ()
main = print $ result 8
Nota: Esta publicación está escrita en Haskell. Cópielo en un archivo, guárdelo como * .lhs y compile / cargue con GHC (i). Además, comencé a escribir esta respuesta antes de que hayas editado tu código, pero la lección sigue siendo la misma.
TL; DR
La función Prelude uncurry es demasiado perezosa, mientras que la coincidencia del patrón es lo suficientemente estricta.
Una advertencia y un descargo de responsabilidad.
Estamos entrando en un lugar mágico, extraño. Tener cuidado. Además, mis habilidades CORE son rudimentarias. Ahora que he perdido toda mi credibilidad, empecemos.
El codigo probado
Para saber dónde obtenemos los requisitos de memoria adicionales, es útil tener más de dos funciones.
> import Control.Monad (forM_)
Esta es su variante original, sin puntos:
> matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matches f cs = foldr (/(cs'', n) a -> fromEnum (f cs cs'') * n + a) 0
Esta es una variante que solo está ligeramente libre de puntos, el parámetro a es eta-reducido.
> matchesPF'' :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF'' f cs = foldr (/(cs'', n) -> (+) (fromEnum (f cs cs'') * n)) 0
Esta es una variante que en línea se uncurry a mano.
> matchesPFI :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFI f cs = foldr ((+) . (/(cs'', n) -> fromEnum (f cs cs'') * n)) 0
Esta es tu versión pointfree.
> matchesPF :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF f cs = foldr ((+) . uncurry ((*) . fromEnum . f cs)) 0
Esta es una variante que utiliza un uncurry personalizado, ver más abajo.
> matchesPFU :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFU f cs = foldr ((+) . uncurryI ((*) . fromEnum . f cs)) 0
Esta es una variante que utiliza un uncurry perezoso personalizado, ver más abajo.
> matchesPFL :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFL f cs = foldr ((+) . uncurryL ((*) . fromEnum . f cs)) 0
Para probar las funciones fácilmente, usamos una lista:
> funcs = [matches, matchesPF'', matchesPF, matchesPFL, matchesPFU, matchesPFI]
Nuestro auto-escrito es uncurry :
> uncurryI :: (a -> b -> c) -> (a, b) -> c
> uncurryI f (a,b) = f a b
Un lazier sin uncurry .
> uncurryL :: (a -> b -> c) -> (a, b) -> c
> uncurryL f p = f (fst p) (snd p)
La variante perezosa uncurryL tiene la misma semántica que la variante en Prelude , por ejemplo
uncurry (/_ _ -> 0) undefined == 0 == uncurryL (/_ _ -> 0) undefined
mientras que uncurryI es estricto en la columna vertebral de la pareja.
> main = do
> let f a b = a < b
> forM_ [1..10] $ /i ->
> forM_ funcs $ /m ->
> print $ m f i (zip (cycle [1..10]) [1..i*100000])
La lista [1..i*100000] depende de i deliberadamente, por lo que no introducimos un CAF y sesgamos nuestro perfil de asignación.
El código desugared
Antes de profundizar en el perfil, echemos un vistazo al código deshecho de cada función:
==================== Desugar (after optimization) ====================
Result size of Desugar (after optimization)
= {terms: 221, types: 419, coercions: 0}
uncurryL
uncurryL = / @ a @ b @ c f p -> f (fst p) (snd p)
uncurryI
uncurryI = / @ a @ b @ c f ds -> case ds of _ { (a, b) -> f a b }
-- uncurried inlined by hand
matchesPFI =
/ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(/ ds ->
case ds of _ { (cs'', n) ->
* $fNumInt (fromEnum $fEnumBool (f cs cs'')) n
}))
(I# 0)
-- lazy uncurry
matchesPFL =
/ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryL (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- stricter uncurry
matchesPFU =
/ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryI (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- normal uncurry
matchesPF =
/ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurry (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- eta-reduced a
matchesPF'' =
/ @ a f cs ->
foldr
$fFoldable[]
(/ ds ->
case ds of _ { (cs'', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs'')) n)
})
(I# 0)
-- non-point-free
matches =
/ @ a f cs ->
foldr
$fFoldable[]
(/ ds a ->
case ds of _ { (cs'', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs'')) n) a
})
(I# 0)
Hasta ahora, todo parece estar bien. No hay nada sorprendente en marcha. Las funciones de Typeclass se reemplazan con sus variantes de diccionario, por ejemplo, foldr convierte en foldr $ fFoldable [] `, ya que lo llamamos en una lista.
El perfil
Mon Jul 18 15:47 2016 Time and Allocation Profiling Report (Final) Prof +RTS -s -p -RTS total time = 1.45 secs (1446 ticks @ 1000 us, 1 processor) total alloc = 1,144,197,200 bytes (excludes profiling overheads) COST CENTRE MODULE %time %alloc matchesPF'' Main 13.6 0.0 matchesPF Main 13.3 11.5 main././ Main 11.8 76.9 main.f Main 10.9 0.0 uncurryL Main 9.5 11.5 matchesPFU Main 8.9 0.0 matchesPFI Main 7.3 0.0 matches Main 6.9 0.0 matchesPFL Main 6.3 0.0 uncurryI Main 5.3 0.0 matchesPF''./ Main 2.6 0.0 matchesPFI./ Main 2.0 0.0 matches./ Main 1.5 0.0 individual inherited COST CENTRE MODULE no. entries %time %alloc %time %alloc MAIN MAIN 44 0 0.0 0.0 100.0 100.0 main Main 89 0 0.0 0.0 100.0 100.0 main./ Main 90 10 0.0 0.0 100.0 100.0 main././ Main 92 60 11.8 76.9 100.0 100.0 funcs Main 93 0 0.0 0.0 88.2 23.1 matchesPFI Main 110 10 7.3 0.0 11.7 0.0 matchesPFI./ Main 111 5500000 2.0 0.0 4.4 0.0 main.f Main 112 5500000 2.4 0.0 2.4 0.0 matchesPFU Main 107 10 8.9 0.0 15.3 0.0 uncurryI Main 108 5500000 5.3 0.0 6.4 0.0 main.f Main 109 5500000 1.1 0.0 1.1 0.0 matchesPFL Main 104 10 6.3 0.0 17.7 11.5 uncurryL Main 105 5500000 9.5 11.5 11.4 11.5 main.f Main 106 5500000 1.9 0.0 1.9 0.0 matchesPF Main 102 10 13.3 11.5 15.4 11.5 main.f Main 103 5500000 2.1 0.0 2.1 0.0 matchesPF'' Main 99 10 13.6 0.0 17.2 0.0 matchesPF''./ Main 100 5500000 2.6 0.0 3.6 0.0 main.f Main 101 5500000 1.0 0.0 1.0 0.0 matches Main 94 10 6.9 0.0 10.9 0.0 matches./ Main 97 5500000 1.5 0.0 4.0 0.0 main.f Main 98 5500000 2.5 0.0 2.5 0.0 CAF Main 87 0 0.0 0.0 0.0 0.0 funcs Main 91 1 0.0 0.0 0.0 0.0 main Main 88 1 0.0 0.0 0.0 0.0 main./ Main 95 0 0.0 0.0 0.0 0.0 main././ Main 96 0 0.0 0.0 0.0 0.0 CAF GHC.IO.Handle.FD 84 0 0.0 0.0 0.0 0.0 CAF GHC.Conc.Signal 78 0 0.0 0.0 0.0 0.0 CAF GHC.IO.Encoding 76 0 0.0 0.0 0.0 0.0 CAF GHC.IO.Handle.Text 75 0 0.0 0.0 0.0 0.0 CAF GHC.IO.Encoding.Iconv 59 0 0.0 0.0 0.0 0.0
Ignora los main/./. ruido, es sólo la lista. Sin embargo, hay un punto que uno debería notar inmediatamente: matchesPF y uncurryL usan el mismo alloc% :
matchesPF Main 13.3 11.5
uncurryL Main 9.5 11.5
Llegando al CORE
Ahora es el momento de inspeccionar el CORE resultante ( ghc -ddump-simpl ). Notaremos que la mayoría de las funciones se han transformado en envolturas de trabajo, y se ven más o menos iguales ( -dsuppress-all -dsuppress-uniques ):
$wa5
$wa5 =
/ @ a1 w w1 w2 ->
letrec {
$wgo
$wgo =
/ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case y of _ { (cs'', n) ->
case $wgo ys of ww { __DEFAULT ->
case w w1 cs'' of _ {
False -> case n of _ { I# y1 -> ww };
True -> case n of _ { I# y1 -> +# y1 ww }
}
}
}
}; } in
$wgo w2
Esta es su envoltura habitual de los trabajadores. $wgo toma una lista, verifica si está vacía, es estricta en la cabecera ( case y of _ { (cs'', n) ->… ) y perezosa en el resultado recursivo $wgo ys of ww .
Todas las funciones tienen el mismo aspecto. Bueno, todos excepto matchesPF (su variante)
-- matchesPF
$wa3 =
/ @ a1 w w1 w2 ->
letrec {
$wgo =
/ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case let {
x = case y of _ { (x1, ds) -> x1 } } in
case w w1 x of _ {
False ->
case y of _ { (ds, y1) -> case y1 of _ { I# y2 -> main13 } };
-- main13 is just #I 0
True -> case y of _ { (ds, y1) -> y1 }
}
of _ { I# x ->
+# x ww
}
}
}; } in
$wgo w2
y matchesPFL (la variante que utiliza el uncurryL lento perezoso)
-- matchesPFL
$wa2
$wa2 =
/ @ a1 w w1 w2 ->
letrec {
$wgo =
/ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case snd y of ww1 { I# ww2 ->
case let {
x = fst y } in
case w w1 x of _ {
False -> main13;
True -> ww1
}
of _ { I# x ->
+# x ww
}
}
}
}; } in
$wgo w2
Son virtualmente los mismos. Y ambos contienen encuadernaciones . Esto creará un thunk y generalmente llevará a requisitos de espacio peores.
La solución
Creo que el culpable en este punto es claro. Es uncurry GHC quiere imponer la semántica correcta de
uncurry (const (const 0)) undefined
Sin embargo, esto agrega la pereza y thunk adicionales. Su variante no puntual no presenta ese comportamiento, ya que hace un patrón de coincidencia en el par:
foldr (/(cs'', n) a -> …)
¿Todavía no confías en mí? Usa una combinación de patrones perezosos
foldr (/ ~(cs'', n) a -> …)
y te darás cuenta de que las matches se comportarán igual que las matchesPF . Por lo tanto, utilice una variante ligeramente más estricta de la uncurry . uncurryI es suficiente para dar una pista al analizador de rigor.
Tenga en cuenta que los pares son conocidos por este comportamiento. RWH dedica un capítulo entero a tratar de optimizar el comportamiento de una sola función donde los pares intermedios conducen a problemas.