Haskell code optimization

Question

I am writing the following Haskell code that takes a triplet (x, y, z) and a list of triplets [(Int, Int, Int)] and look to see if there is a triplet (a, b, c) in which x == a and y = = b, if this is the case, I just need to update c = c + z, if there is no such triple list in the list, I just add the triplet to the list.

-- insertEdge :: (Int,Int,Int) -> [(Int, Int, Int)] -> [(Int, Int, Int)]

insertEdge (x,y,z) cs = 

if (length [(a,b,c) | (a,b,c) <- cs, a /= x || b /= y]) == (length cs) 

 then ((x,y,z):cs)) 

   else [if (a == x && b == y) then (a,b,c+1) else (a,b,c) | (a,b,c) <- cs]

After profiling my code, it appears that this fuction takes 65% of the execution time.

How can I rewrite my code to be more efficient?

Answer 1

, , - : length , ( ) : , cs , .

, , , , . , , , , ? , .

, Data.Map, 2- , - . , / .

, Haskell , , , - ( , ) / (.., ). , , , , , .

---

, :

import qualified Data.Map as M

incEdge :: M.Map (Int, Int) Int -> ((Int, Int), Int) -> M.Map (Int, Int) Int
incEdge cs (k,v) = M.alter f k cs
    where f (Just n) = Just $ n + v
          f Nothing  = Just v

alter - // , . , , , . , - foldl incEdge M.empty edgeList. , , Data.Map .

Answer 2

, , : Data.Map(Int, Int) Int?

insertWith (+) (a,b) c mymap

Answer 3

( Criterion ). (insertEdgeO), Geoff foldr (insertEdgeF) Data.Map (insertEdgeM):

benchmarking insertEdgeO...
mean: 380.5062 ms, lb 379.5357 ms, ub 381.1074 ms, ci 0.950

benchmarking insertEdgeF...
mean: 74.54564 ms, lb 74.40043 ms, ub 74.71190 ms, ci 0.950

benchmarking insertEdgeM...
mean: 18.12264 ms, lb 18.03029 ms, ub 18.21342 ms, ci 0.950

( -O2):

module Main where
import Criterion.Main
import Data.List (foldl')
import qualified Data.Map as M

insertEdgeO :: (Int, Int, Int) -> [(Int, Int, Int)] -> [(Int, Int, Int)]
insertEdgeO (x, y, z) cs =
  if length [(a, b, c) | (a, b, c) <- cs, a /= x || b /= y] == length cs
    then (x, y, z) : cs
    else [if (a == x && b == y) then (a, b, c + z) else (a, b, c) | (a, b, c) <- cs]

insertEdgeF :: (Int, Int, Int) -> [(Int, Int, Int)] -> [(Int, Int, Int)]
insertEdgeF (x,y,z) cs =
  case foldr f (False, []) cs of
    (False, cs') -> (x, y, z) : cs'
    (True, cs')  -> cs'
  where
    f (a, b, c) (e, cs')
      | (a, b) == (x, y) = (True, (a, b, c + z) : cs')
      | otherwise        = (e, (a, b, c) : cs')

insertEdgeM :: (Int, Int, Int) -> M.Map (Int, Int) Int -> M.Map (Int, Int) Int
insertEdgeM (a, b, c) = M.insertWith (+) (a, b) c

testSet n = [(a, b, c) | a <- [1..n], b <- [1..n], c <- [1..n]]

testO = foldl' (flip insertEdgeO) [] . testSet
testF = foldl' (flip insertEdgeF) [] . testSet
testM = triplify . M.toDescList . foldl' (flip insertEdgeM) M.empty . testSet
  where
    triplify = map (\((a, b), c) -> (a, b, c))

main = let n = 25 in defaultMain
  [ bench "insertEdgeO" $ nf testO n
  , bench "insertEdgeF" $ nf testF n
  , bench "insertEdgeM" $ nf testM n
  ]

insertEdgeF, foldl' (55.88634 ), Data.Map .

Answer 4

, , , , , . , . (Bool, [(Int, Int, Int)]), Bool , , -

insertEdge (x,y,z) cs = case foldr f (False,[]) cs of
                          (False,cs') -> (x,y,z):cs'
                          (True,cs')  -> cs' 
  where f (a,b,c) (e,cs') = if (a,b) == (x,y) then (True,(a,b,c+z):cs') else (e,(a,b,c):cs')

foldr,

foldr :: (a -> b -> b) -> b -> [a] -> b

foldr . foldr f b xs g

g [] = b
g (x:xs) = f x (g xs)

Answer 5

,

type Edge = (Int,Int,Int)

insertEdge :: Edge -> [Edge] -> [Edge]
insertEdge t@(x,y,z) es =
  case break (abx t) es of
    (_, []) -> t : es
    (l, ((_,_,zold):r)) -> l ++ (x,y,z+zold) : r
  where abx (a1,b1,_) (a2,b2,_) = a1 == a2 && b1 == b2

, , . (: , ..). Haskell Data.Map -

import Data.Map

type Edge = (Int,Int,Int)

type EdgeMap = Map (Int,Int) Int
insertEdge :: Edge -> EdgeMap -> EdgeMap
insertEdge (x,y,z) es = alter accumz (x,y) es
  where accumz Nothing = Just z
        accumz (Just zold) = Just (z + zold)

, alter:

alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a

O (log n). (alter f k map) x k . alter , Map. : lookup k (alter f k m) = f (lookup k m).

let f _ = Nothing
alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
alter f 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"

let f _ = Just "c"
alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")]
alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]

ADEpt , .

Answer 6

insertEdgeM :: (Int, Int, Int) -> M.Map (Int, Int) Int -> M.Map (Int, Int) Int
insertEdgeM (a, b, c) = M.insertWith (+) (a, b) c

insertWith, insertWith'.

Answer 7

: as-pattern, . :

insertEdge xyz@(x,y,z) cs =
  if (length [abc | abc@(a,b,c) <- cs, a /= x || b /= y]) == (length cs) 
    then (xyz:cs)) 
    else [if (a == x && b == y) then (a,b,c+1) else abc' | abc'@(a,b,c) <- cs]

You must apply other hionts optimizations first, but this can save very little time since the tuple does not need to be restored again and again. At least in the last at-pattern (the first two patterns are not important, since the tuple is never evaluated in the first case, and as-pattern is used only once in the second case).