Effizient mehrere Maxima in der Liste der Listen in Haskell zu finden

Question

Ich schreibe einen Algorithmus zum Finden von Longs Pfad über mehrere Wendepunkte mit einer Liste von Koordinaten (die einen Pfad beschreiben). Der dynamische Programmieralgorithmus funktioniert gut in O (kn^2), wobei k die Anzahl der Wendepunkte und n Anzahl der Punkte ist. Um die Geschichte kurz zu machen: Der langsamste Teil ist die Abstandsberechnung zwischen 2 Koordinaten; der Algorithmus erfordert, dass er für das gleiche Punktepaar "k" -mal neu berechnet wird. Memoisierung ist keine Option (zu viele Punkte). Es ist möglich, den Algorithmus zu invertieren - aber irgendwie ist der invertierte Algorithmus in Haskell sehr langsam und isst zu viel Speicher.

Es scheint mir, dass das Problem folgt; Sie sind ein Array von Arrays mit fester Größe (plus einige dynamisch berechneten Wert gegeben - zum Beispiel würde dies das Ergebnis von zippen den Wert mit der Liste:

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

Ich versuche, ein Maximum über die Elemente der finden Liste und der feste Wert:

[12, 9, 21] 

Was ich tue - so etwas wie:

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 

das Problem ist, dass ein neu ‚acc‘ mit jedem Aufruf von ‚getbest‘ gebaut wird - das ist n^2 was viel ist. Die Zuordnung ist teuer und das ist wahrscheinlich das Problem. Hast du eine Idee, wie man so etwas effizient macht?

Um es klar zu machen: Das ist der eigentliche Code der Funktion:

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

ich nicht die Effizienz noch geprüft haben, aber wie wäre es

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

? Da das Ergebnis trotzdem in der Summe liegt, werden zuerst der Wert und die Liste addiert. Dann nehmen wir die Transponierung der Liste, so dass es jetzt Spalte-Major ist. Schließlich berechnen wir das Maximum jeder Spalte. (Sie werden BTW import Data.List müssen.)

Answer 2

Sie könnten versuchen, Data.Vector mit:

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 

Dies funktioniert:

*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) 

wie Kennys fügen wir zuerst. Wie Ihre machen wir eine einzelne Traversierung, außer mit zipWith max, wir machen es allgemeiner und prägnanter. Keine ernsthaften Benchmarks, aber das sollte ziemlich anständig sein.

Answer 4

Benchmarking Travis Browns, SCLV, Kennys, und Ihre Antwort mit:

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)) 
     ] 

Vielleicht ist meine Benchmark ist irgendwie vermasselt, aber die Ergebnisse sind eher enttäuschend.

Vektor: (? Schlechte Dichte auch - was zum Teufel) 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