Almacenamiento en memoria caché en Haskell y paralelismo explícito

Question

Actualmente estoy tratando de optimizar mi solución a problem 14 en Projet Euler. me gusta mucho Haskell y yo creo que es una muy buena opción para este tipo de problemas, aquí hay tres soluciones diferentes que he probado:

import Data.List (unfoldr, maximumBy) 
import Data.Maybe (fromJust, isNothing) 
import Data.Ord (comparing) 
import Control.Parallel 

next :: Integer -> Maybe (Integer) 
next 1 = Nothing 
next n 
    | even n = Just (div n 2) 
    | odd n = Just (3 * n + 1) 

get_sequence :: Integer -> [Integer] 
get_sequence n = n : unfoldr (pack . next) n 
    where pack n = if isNothing n then Nothing else Just (fromJust n, fromJust n) 

get_sequence_length :: Integer -> Integer 
get_sequence_length n 
    | isNothing (next n) = 1 
    | otherwise = 1 + (get_sequence_length $ fromJust (next n)) 

-- 8 seconds 
main1 = print $ maximumBy (comparing length) $ map get_sequence [1..1000000] 

-- 5 seconds 
main2 = print $ maximum $ map (\n -> (get_sequence_length n, n)) [1..1000000] 

-- Never finishes 
main3 = print solution 
    where 
    s1 = maximumBy (comparing length) $ map get_sequence [1..500000] 
    s2 = maximumBy (comparing length) $ map get_sequence [500001..10000000] 
    solution = (s1 `par` s2) `pseq` max s1 s2 

Ahora bien, si nos fijamos en el problema real que hay un gran potencial para el almacenamiento en caché , ya que la mayoría de las nuevas secuencias contendrán subsecuencias que ya se han calculado anteriormente.

Para la comparación, me escribió una versión en C también:
Tiempo de duración con el almacenamiento en caché: 0,03 segundos
El tiempo en marcha sin almacenamiento en caché: 0,3 segundos

Eso es una locura! Claro, el almacenamiento en caché redujo el tiempo en un factor de 10, pero incluso sin almacenamiento en caché, sigue siendo al menos 17 veces más rápido que mi código Haskell.

¿Qué pasa con mi código? ¿Por qué la memoria caché de Haskell no me llama? Como las funciones son puro caché, ¿no debería el almacenamiento en caché ser trivial, solo una cuestión de memoria disponible?

¿Cuál es el problema con mi tercera versión paralela? ¿Por qué no termina?

En cuanto a Haskell como lenguaje, ¿el compilador paralela automáticamente algún código (pliegues, mapas, etc.), o siempre tiene que hacerse explícitamente usando Control.Parallel?

Edit: Me encontré con this pregunta similar. Mencionaron que su función no era recursiva de la cola. ¿Mi cola get_sequence_length es recursiva? Si no, ¿cómo puedo hacerlo?

Edit2:
Para Daniel:
Muchas gracias por la respuesta, realmente impresionante. He estado jugando con tus mejoras y he encontrado algunos errores realmente malos.

Estoy ejecutando las pruebas en Windws 7 (64 bits), núcleo cuádruple de 3,3 GHZ con 8 GB de RAM.
Lo primero que hice fue como dices reemplazar todos los enteros con Int, pero cada vez que ejecuté alguno de los principales me quedé sin memoria, incluso con + RTS kSize -RTS establecido ridículamente alto.

Finalmente encontré this (stackoverflow es impresionante ...), lo que significa que, dado que todos los programas de Haskell en Windows se ejecutan como de 32 bits, los Entrs rebosaban causar una recursión infinita, guau ...

Ejecuté las pruebas en una máquina virtual Linux (con el ghc de 64 bits) y obtuve resultados similares.

Answer 1

Bien, comencemos desde la parte superior. Lo primero importante es dar la línea de comando exacta que está utilizando para compilar y ejecutar; mi respuesta, voy a utilizar esta línea durante los horarios de todos los programas:

ghc -O2 -threaded -rtsopts test && time ./test +RTS -N 

A continuación: desde los tiempos varían mucho de una máquina a otra, vamos a dar algunos tiempos de referencia para mi máquina y sus programas. Aquí está la salida de uname -a de mi equipo:

Linux sorghum 3.4.4-2-ARCH #1 SMP PREEMPT Sun Jun 24 18:59:47 CEST 2012 x86_64 Intel(R) Core(TM)2 Quad CPU Q6600 @ 2.40GHz GenuineIntel GNU/Linux 

Los aspectos más destacados son: cuatro núcleos, 2,4 GHz, 64 bits.

Usando main1: 30.42s user 2.61s system 149% cpu 22.025 total
Usando main2: 21.42s user 1.18s system 129% cpu 17.416 total
Usando main3: 22.71s user 2.02s system 220% cpu 11.237 total

realidad, modificada main3 de dos maneras: en primer lugar, mediante la eliminación de uno de los ceros desde el extremo de la gama en s2, y segundo, cambiando max s1 s2 a maximumBy (comparing length) [s1, s2], ya que el primero solo computa accidentalmente la respuesta correcta. =)

Ahora me centraré en la velocidad de serie. (Para responder a una de sus preguntas directas: no, GHC no paralela ni memoriza automáticamente sus programas. Ambas cosas tienen gastos generales que son muy difíciles de estimar y, por consiguiente, es muy difícil decidir cuándo hacerlo será beneficioso. ni idea de por qué incluso las soluciones seriales en esta respuesta obtienen> 100% de utilización de CPU, tal vez se está produciendo una recolección de basura en otro hilo o algo similar). Empezaremos desde main2, ya que fue la más rápida de las dos implementaciones en serie . La manera más barata de conseguir un poco de impulso es cambiar todas las firmas de tipos de Integer a Int:

Usando Int: 11.17s user 0.50s system 129% cpu 8.986 total (alrededor de dos veces más rápido)

El siguiente impulso proviene de la reducción de la asignación en el bucle interior (eliminando los valores intermedios Maybe).

import Data.List 
import Data.Ord 

get_sequence_length :: Int -> Int 
get_sequence_length 1 = 1 
get_sequence_length n 
    | even n = 1 + get_sequence_length (n `div` 2) 
    | odd n = 1 + get_sequence_length (3 * n + 1) 

lengths :: [(Int,Int)] 
lengths = map (\n -> (get_sequence_length n, n)) [1..1000000] 

main = print (maximumBy (comparing fst) lengths) 

El uso de este: 4.84s user 0.03s system 101% cpu 4.777 total

El siguiente impulso proviene del uso de las operaciones más rápido que even y div:

import Data.Bits 
import Data.List 
import Data.Ord 

even' n = n .&. 1 == 0 

get_sequence_length :: Int -> Int 
get_sequence_length 1 = 1 
get_sequence_length n = 1 + get_sequence_length next where 
    next = if even' n then n `quot` 2 else 3 * n + 1 

lengths :: [(Int,Int)] 
lengths = map (\n -> (get_sequence_length n, n)) [1..1000000] 

main = print (maximumBy (comparing fst) lengths) 

El uso de este: 1.27s user 0.03s system 105% cpu 1.232 total

Para aquellos siguiendo a lo largo en casa, esto es aproximadamente 17 veces más rápido que el main2 que establecemos d con - una mejora competitiva con el cambio a C.

Para la memorización, hay algunas opciones. Lo más simple es usar un paquete preexistente como data-memocombinators para crear una matriz inmutable y leer de ella. Los tiempos son bastante sensibles a elegir un buen tamaño para este conjunto; para este problema, encontré que 50000 es un límite superior bastante bueno.

import Data.Bits 
import Data.MemoCombinators 
import Data.List 
import Data.Ord 

even' n = n .&. 1 == 0 

pre_length :: (Int -> Int) -> (Int -> Int) 
pre_length f 1 = 1 
pre_length f n = 1 + f next where 
    next = if even' n then n `quot` 2 else 3 * n + 1 

get_sequence_length :: Int -> Int 
get_sequence_length = arrayRange (1,50000) (pre_length get_sequence_length) 

lengths :: [(Int,Int)] 
lengths = map (\n -> (get_sequence_length n, n)) [1..1000000] 

main = print (maximumBy (comparing fst) lengths) 

Con esta: 0.53s user 0.10s system 149% cpu 0.421 total

El más rápido de todos es el uso de una matriz mutable, sin embalaje para el bit memoization. Es mucho menos idiomático, pero es la velocidad del metal puro. La velocidad es mucho menos sensible en el tamaño de esta matriz, siempre y cuando la matriz sea tan grande como la más grande para la que desee la respuesta.

import Control.Monad 
import Control.Monad.ST 
import Data.Array.Base 
import Data.Array.ST 
import Data.Bits 
import Data.List 
import Data.Ord 

even' n = n .&. 1 == 0 
next n = if even' n then n `quot` 2 else 3 * n + 1 

get_sequence_length :: STUArray s Int Int -> Int -> ST s Int 
get_sequence_length arr n = do 
    bounds@(lo,hi) <- getBounds arr 
    if not (inRange bounds n) then (+1) `fmap` get_sequence_length arr (next n) else do 
     let ix = n-lo 
     v <- unsafeRead arr ix 
     if v > 0 then return v else do 
      v' <- get_sequence_length arr (next n) 
      unsafeWrite arr ix (v'+1) 
      return (v'+1) 

maxLength :: (Int,Int) 
maxLength = runST $ do 
    arr <- newArray (1,1000000) 0 
    writeArray arr 1 1 
    loop arr 1 1 1000000 
    where 
    loop arr n len 1 = return (n,len) 
    loop arr n len n' = do 
     len' <- get_sequence_length arr n' 
     if len' > len then loop arr n' len' (n'-1) else loop arr n len (n'-1) 

main = print maxLength 

Con esta: 0.16s user 0.02s system 138% cpu 0.130 total (que es competitivo con la versión C memoized)

Answer 2

GHC no hará paralelo nada automáticamente para usted. Y como supones, get_sequence_length no es recursivo de cola. Ver here. Y considere cómo el compilador (a menos que esté haciendo algunas buenas optimizaciones para usted) no puede evaluar todas esas adiciones recursivas hasta que llegue al final; estás "construyendo thunks", que generalmente no es algo bueno.

En su lugar, intente llamar a una función auxiliar recursiva y pasar un acumulador, o intente definirlo en términos de foldr.