diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs index a2197fc7..1c516ebf 100644 --- a/bench/Bench/Data/Map.purs +++ b/bench/Bench/Data/Map.purs @@ -1,13 +1,15 @@ module Bench.Data.Map where import Prelude + import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) -import Performance.Minibench (bench, benchWith) - -import Data.Tuple (Tuple(..)) +import Data.Foldable (foldl, foldr) +import Data.List (zipWith) import Data.List as L import Data.Map as M +import Data.Tuple (Tuple(..)) +import Performance.Minibench (bench, benchWith) benchMap :: Eff (console :: CONSOLE) Unit benchMap = do @@ -21,15 +23,26 @@ benchMap = do log "------------" benchFromFoldable + log "" + + log "foldl" + log "------------" + benchFoldl + + log "foldr" + log "------------" + benchFoldr + where + nats = L.range 0 999999 + natPairs = zipWith Tuple nats nats + singletonMap = M.singleton 0 0 + smallMap = M.fromFoldable $ L.take 100 natPairs + midMap = M.fromFoldable $ L.take 10000 natPairs + bigMap = M.fromFoldable $ natPairs + benchSize = do - let nats = L.range 0 999999 - natPairs = (flip Tuple) unit <$> nats - singletonMap = M.singleton 0 unit - smallMap = M.fromFoldable $ L.take 100 natPairs - midMap = M.fromFoldable $ L.take 10000 natPairs - bigMap = M.fromFoldable $ natPairs log "size: singleton map" bench \_ -> M.size singletonMap @@ -53,3 +66,33 @@ benchMap = do log $ "fromFoldable (" <> show (L.length natPairs) <> ")" benchWith 10 \_ -> M.fromFoldable natPairs + + benchFoldl = do + let sum = foldl (+) 0 + + log "foldl: singleton map" + bench \_ -> sum singletonMap + + log $ "foldl: small map (" <> show (M.size smallMap) <> ")" + bench \_ -> sum smallMap + + log $ "foldl: midsize map (" <> show (M.size midMap) <> ")" + benchWith 100 \_ -> sum midMap + + log $ "foldl: big map (" <> show (M.size bigMap) <> ")" + benchWith 10 \_ -> sum bigMap + + benchFoldr = do + let sum = foldr (+) 0 + + log "foldr: singleton map" + bench \_ -> sum singletonMap + + log $ "foldr: small map (" <> show (M.size smallMap) <> ")" + bench \_ -> sum smallMap + + log $ "foldr: midsize map (" <> show (M.size midMap) <> ")" + benchWith 100 \_ -> sum midMap + + log $ "foldr: big map (" <> show (M.size bigMap) <> ")" + benchWith 10 \_ -> sum bigMap diff --git a/package.json b/package.json index 0373d0c9..0f1ba832 100644 --- a/package.json +++ b/package.json @@ -6,7 +6,7 @@ "test": "pulp test", "bench:build": "purs compile 'bench/**/*.purs' 'src/**/*.purs' 'bower_components/*/src/**/*.purs'", - "bench:run": "node -e 'require(\"./output/Bench.Main/index.js\").main()'", + "bench:run": "node --expose-gc -e 'require(\"./output/Bench.Main/index.js\").main()'", "bench": "npm run bench:build && npm run bench:run" }, "devDependencies": { diff --git a/src/Data/Map.purs b/src/Data/Map.purs index e764370b..fd69854d 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -43,8 +43,8 @@ module Data.Map import Prelude import Data.Eq (class Eq1) -import Data.Foldable (foldl, foldMap, foldr, class Foldable) -import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Foldable (foldl, foldr, foldMapDefaultL, class Foldable) +import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndexDefaultL) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.List (List(..), (:), length, nub) import Data.List.Lazy as LL @@ -99,14 +99,26 @@ instance functorWithIndexMap :: FunctorWithIndex k (Map k) where mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right) instance foldableMap :: Foldable (Map k) where - foldl f z m = foldl f z (values m) - foldr f z m = foldr f z (values m) - foldMap f m = foldMap f (values m) + foldl f = foldlWithIndex (const f) + foldr f = foldrWithIndex (const f) + foldMap = foldMapDefaultL instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where - foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m + foldlWithIndex f z m = go z (m : Nil) + where + go acc Nil = acc + go acc (hd : tl) = case hd of + Leaf -> go acc tl + Two Leaf k v Leaf -> + go (f k acc v) tl + Two Leaf k v right -> + go (f k acc v) (right : tl) + Two left k v right -> + go acc (left : singleton k v : right : tl) + Three left k1 v1 mid k2 v2 right -> + go acc (left : singleton k1 v1 : mid : singleton k2 v2 : right : tl) foldrWithIndex f z m = foldr (uncurry f) z $ asList $ toUnfoldable m - foldMapWithIndex f m = foldMap (uncurry f) $ asList $ toUnfoldable m + foldMapWithIndex = foldMapWithIndexDefaultL asList :: forall k v. List (Tuple k v) -> List (Tuple k v) asList = id