Effectively detecting multiple highs in a list of lists in Haskell

Question

I am writing an algorithm for finding a long path over several turning points, given the list of coordinates (describing the path). The dynamic programming algorithm works well in O (kn ^ 2), where k is the number of turning points and n is the number of points. Shorten the story: the slowest part is calculating the distance between 2 coordinates; the algorithm requires that it be "k'-times, recounted for the same pair of points. Remembering is not an option (too many points). You can" invert "the algorithm, but somehow the inverted algorithm is very slow in haskell and eats too a lot of memory.

It seems to me that the problem is the following; you are given an array of arrays of a fixed size (plus some dynamically calculated value), for example, this will be the result of listing the value:

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

I am trying to find the maximum by list items plus a fixed value:

 [12, 9, 21] 

What I'm doing is something like:

 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 

The problem is that a new "acc" is created with every call to "getbest" - which is n ^ 2, which is a lot. Distribution is expensive, and this is probably the problem. Do you have any idea how to do this effectively?

To be clear: this is the actual function code:

 dynamic2FreeFlight :: Int -> [ Coord ] -> [ Coord ] dynamic2FreeFlight numpoints points = reverse $ (dsCoord bestPoint) : (snd $ (dsScore bestPoint) !! (numpoints - 2)) where bestPoint :: DSPoint bestPoint = maximumBy (\xy -> (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 ab = (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

Benchmarking Travis Browns, SCLV, Kenny and your answer using:

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

Maybe my benchmark is somehow messed up, but the results are pretty disappointing.

Vector: 379.0164 ms (poor density too - what the hell?) 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 

Answer 2

I have not tested the effectiveness yet, but what about

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

? Since the result is in any case equal to the sum, the values ​​and list are added first. Then we take the transpose of the list so that it is now a column. Finally, we calculate the maximum of each column. (You need import Data.List , BTW.)

Answer 3

You can try using 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 

It works:

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

Answer 4

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

Like Kenny, add it first. Like yours, we do a single workaround, except for using zipWith max, we do it in a more general and concise way. There are no serious tests, but this should be pretty decent.