Encontrar de manera eficiente múltiples máximos en la lista de listas en Haskell

Question

Estoy escribiendo un algoritmo para encontrar caminos largos en varios puntos de giro dada una lista de coordenadas (que describen una ruta). El algoritmo de programación dinámica funciona bien en O (kn^2), donde k es el número de puntos de giro yn número de puntos. Para abreviar la historia: la parte más lenta es el cálculo de distancia entre 2 coordenadas; el algoritmo requiere que esto sea 'k' multiplicado por el mismo par de puntos. La memorización no es una opción (demasiados puntos). Es posible 'invertir' el algoritmo, pero de alguna manera el algoritmo invertido es muy lento en haskell y come demasiada memoria.

Me parece que el problema sigue; se le da una matriz de matrices de tamaño fijo (más algo de valor de forma dinámica computarizada - por ejemplo, este sería el resultado de comprimir el valor de la lista:

arr = [ (2, [10,5,12]), (1, [2,8, 20]), (4, [3, 2, 10]) ] 

Estoy tratando de encontrar un máximo sobre los elementos de la lista más el valor fijo:

[12, 9, 21] 

lo que estoy haciendo - algo así como:

foldl' getbest (replicate 3 0) arr 
getbest acc (fixval, item) = map comparator $ zip acc item 
comparator orig new 
    | new + fixval > orig = new + fixval 
    | otherwise = orig 

el problema es que un nuevo 'ACC' se construye con cada llamada a 'getbest' - el cual es n^2, que es mucho. La asignación es costosa y este es probablemente el problema. ¿Tienes alguna idea de cómo hacer tal cosa de manera eficiente?

Para que quede claro: este es el código real de la función:

dynamic2FreeFlight :: Int -> [ Coord ] -> [ Coord ] 
dynamic2FreeFlight numpoints points = reverse $ (dsCoord bestPoint) : (snd $ (dsScore bestPoint) !! (numpoints - 2)) 
    where 
     bestPoint :: DSPoint 
     bestPoint = maximumBy (\x y -> (getFinalPointScore x) `compare` (getFinalPointScore y)) compresult 

     getFinalPointScore :: DSPoint -> Double 
     getFinalPointScore sc = fst $ (dsScore sc) !! (numpoints - 2) 

     compresult :: [ DSPoint ] 
     compresult = foldl' onestep [] points 

     onestep :: [ DSPoint ] -> Coord -> [ DSPoint ] 
     onestep lst point = (DSPoint point (genmax lst)) : lst 
      where 
       genmax :: [ DSPoint ] -> [ (Double, [ Coord ]) ] 
       genmax lst = map (maximumBy comparator) $ transpose prepared 
       comparator a b = (fst a) `compare` (fst b) 
       distances :: [ Double ] 
       distances = map (distance point . dsCoord) lst 
       prepared :: [ [ (Double, [ Coord ]) ] ] 
       prepared 
        | length lst == 0 = [ replicate (numpoints - 1) (0, []) ] 
        | otherwise = map prepare $ zip distances lst 
       prepare :: (Double, DSPoint) -> [ (Double, [ Coord ]) ] 
       prepare (dist, item) = (dist, [dsCoord item]) : map addme (take (numpoints - 2) (dsScore item)) 
        where 
         addme (score, coords) = (score + dist, dsCoord item : coords) 

Answer 1

No he comprobado la eficacia aún, pero ¿qué hay de

map maximum $ transpose [ map (a+) bs | (a,bs) <- arr] 

? Dado que el resultado es en términos de la suma de todos modos, el valor y la lista se suman primero. Luego tomamos la transposición de la lista para que ahora sea column-major. Finalmente calculamos el máximo de cada columna. (Tendrá que import Data.List, por cierto.)

Answer 2

Usted podría intentar usar Data.Vector:

import qualified Data.Vector as V 

best :: V.Vector (V.Vector Int) -> V.Vector Int -> V.Vector Int 
best = (V.foldl1' (V.zipWith max) .) . (V.zipWith . flip $ V.map . (+)) 

convert :: [[Int]] -> V.Vector (V.Vector Int) 
convert = V.fromList . map V.fromList 

arr = convert [[10, 5, 12], [2, 8, 20], [3, 2, 10]] 
val = V.fromList [2, 1, 4] :: V.Vector Int 

esto funciona:

*Main> best arr val 
fromList [12,9,21] :: Data.Vector.Vector 

Answer 3

best = foldl' (zipWith max) (repeat 0) . map (\(fv,xs) -> map (+fv) xs) 

Al igual que Kenny, añadimos primero. Al igual que el tuyo, hacemos un recorrido único, excepto al usar zip. Con Max, lo hacemos de manera más general y sucinta. No hay puntos de referencia serios, pero esto debería ser bastante decente.

Answer 4

Benchmarking Travis Browns, SCLV, Kennys, y su respuesta usando:

import Data.List 
import Criterion.Main 
import Criterion.Config 
import qualified Data.Vector as V 

-- Vector based solution (Travis Brown) 
bestVector :: V.Vector (V.Vector Int) -> V.Vector Int -> V.Vector Int 
bestVector = (V.foldl1' (V.zipWith max) .) . (V.zipWith . flip $ V.map . (+)) 

convertVector :: [[Int]] -> V.Vector (V.Vector Int) 
convertVector = V.fromList . map V.fromList 

arrVector = convertVector arr 
valVector = V.fromList val :: V.Vector Int 

-- Shared arr and val 
arr = [map (x*) [1, 2.. 2000] | x <- [1..1000]] 
val = [1..1000] 

-- SCLV solution 
bestSCLV = foldl' (zipWith max) (repeat 0) . map (\(fv,xs) -> map (+fv) xs) 

-- KennyTM Solution 
bestKTM arr = map maximum $ transpose [ map (a+) bs | (a,bs) <- arr] 

-- Original 
getbest :: [Int] -> (Int, [Int]) -> [Int] 
getbest acc (fixval, item) = map (uncurry comparator) $ zip acc item 
where 
    comparator o n = max (n + fixval) o 

someFuncOrig = foldl' getbest acc 
    where acc = replicate 2000 0 

-- top level functions 
someFuncVector :: (V.Vector (V.Vector Int), V.Vector Int) -> V.Vector Int 
someFuncVector = uncurry bestVector 
someFuncSCLV = bestSCLV 
someFuncKTM = bestKTM 

main = do 
    let vec = someFuncVector (arrVector, valVector) :: V.Vector Int 
    print (someFuncOrig (zip val arr) == someFuncKTM (zip val arr) 
     , someFuncKTM (zip val arr) == someFuncSCLV (zip val arr) 
     , someFuncSCLV (zip val arr) == V.toList vec) 
    defaultMain 
     [ bench "someFuncVector" (whnf someFuncVector (arrVector, valVector)) 
     , bench "someFuncSCLV" (nf someFuncSCLV (zip val arr)) 
     , bench "someFuncKTM" (nf someFuncKTM (zip val arr)) 
     , bench "original"  (nf someFuncOrig (zip val arr)) 
     ] 

Tal vez mi punto de referencia está en mal estado de alguna forma, pero los resultados son bastante decepcionantes.

vectorial: (? Densidad pobre demasiado - ¿qué diablos) 379.0164 ms SCLV: 207.5399 ms Kenny: 200.6028 ms original: 138.4270 ms

[tommd@Mavlo Test]$ ./t 
(True,True,True) 
warming up 
estimating clock resolution... 
mean is 13.65277 us (40001 iterations) 
found 3378 outliers among 39999 samples (8.4%) 
    1272 (3.2%) high mild 
    2106 (5.3%) high severe 
estimating cost of a clock call... 
mean is 1.653858 us (58 iterations) 
found 3 outliers among 58 samples (5.2%) 
    2 (3.4%) high mild 
    1 (1.7%) high severe 

benchmarking someFuncVector 
collecting 100 samples, 1 iterations each, in estimated 54.56119 s 
bootstrapping with 100000 resamples 
mean: 379.0164 ms, lb 357.0403 ms, ub 401.0113 ms, ci 0.950 
std dev: 112.6714 ms, lb 101.8206 ms, ub 125.4846 ms, ci 0.950 
variance introduced by outliers: 4.000% 
variance is slightly inflated by outliers 

benchmarking someFuncSCLV 
collecting 100 samples, 1 iterations each, in estimated 20.92559 s 
bootstrapping with 100000 resamples 
mean: 207.5399 ms, lb 207.4099 ms, ub 207.8410 ms, ci 0.950 
std dev: 955.1629 us, lb 507.1857 us, ub 1.937356 ms, ci 0.950 
found 3 outliers among 100 samples (3.0%) 
    2 (2.0%) high severe 
variance introduced by outliers: 0.990% 
variance is unaffected by outliers 

benchmarking someFuncKTM 
collecting 100 samples, 1 iterations each, in estimated 20.14799 s 
bootstrapping with 100000 resamples 
mean: 200.6028 ms, lb 200.5273 ms, ub 200.6994 ms, ci 0.950 
std dev: 434.9564 us, lb 347.5326 us, ub 672.6736 us, ci 0.950 
found 1 outliers among 100 samples (1.0%) 
    1 (1.0%) high severe 
variance introduced by outliers: 0.990% 
variance is unaffected by outliers 

benchmarking original 
collecting 100 samples, 1 iterations each, in estimated 14.05241 s 
bootstrapping with 100000 resamples 
mean: 138.4270 ms, lb 138.2244 ms, ub 138.6568 ms, ci 0.950 
std dev: 1.107366 ms, lb 930.6549 us, ub 1.381234 ms, ci 0.950 
found 15 outliers among 100 samples (15.0%) 
    7 (7.0%) low mild 
    7 (7.0%) high mild 
    1 (1.0%) high severe 
variance introduced by outliers: 0.990% 
variance is unaffected by outliers