From 76ac5bebca33537ab09166a9e1b40fd4a700fa67 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 17 Jan 2018 11:02:43 -0500 Subject: [PATCH 1/6] implement foldl without materializing value list use a foldl-based foldMap --- src/Data/Map.purs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index e764370b..f2b79a57 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -43,7 +43,7 @@ module Data.Map import Prelude import Data.Eq (class Eq1) -import Data.Foldable (foldl, foldMap, foldr, class Foldable) +import Data.Foldable (foldl, foldMap, foldr, foldMapDefaultL, class Foldable) import Data.FoldableWithIndex (class FoldableWithIndex) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.List (List(..), (:), length, nub) @@ -99,9 +99,21 @@ 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 z m = go z (m : Nil) + where + go acc Nil = acc + go acc (hd : tl) = case hd of + Leaf -> go acc tl + Two Leaf _ v Leaf -> + go (f acc v) tl + Two Leaf _ v right -> + go (f 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) + foldr f z m = foldr f z (values m) + foldMap = foldMapDefaultL instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m From 4c2e6e4b7e1eca1c234c182cd2a4b407af4b52ec Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 17 Jan 2018 15:55:29 -0500 Subject: [PATCH 2/6] benchmark foldl --- bench/Bench/Data/Map.purs | 43 +++++++++++++++++++++++++++++++-------- package.json | 2 +- 2 files changed, 35 insertions(+), 10 deletions(-) diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs index a2197fc7..784b42ce 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) +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,22 @@ benchMap = do log "------------" benchFromFoldable + log "" + + log "foldl" + log "------------" + benchFoldl + 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 +62,19 @@ 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 + 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": { From 8090ce485dfe2673d5f73cdc6451a71cce2ad805 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 17 Jan 2018 17:14:14 -0500 Subject: [PATCH 3/6] apply optimizations to foldlWithIndex implement foldl in terms of foldlWithIndex. Effect on benchmarks is negligible. --- src/Data/Map.purs | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index f2b79a57..b3795469 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, foldMapDefaultL, class Foldable) -import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Foldable (foldl, foldr, foldMapDefaultL, class Foldable) +import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldMapWithIndexDefaultL) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.List (List(..), (:), length, nub) import Data.List.Lazy as LL @@ -99,26 +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 = go z (m : Nil) + foldl f = foldlWithIndex (const f) + foldr f z m = foldr f z (values m) + foldMap = foldMapDefaultL + +instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where + 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 _ v Leaf -> - go (f acc v) tl - Two Leaf _ v right -> - go (f acc v) (right : 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) - foldr f z m = foldr f z (values m) - foldMap = foldMapDefaultL - -instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where - foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m 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 From 269c0a5b19d511356293dda618e9d9baca50b5b5 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 17 Jan 2018 17:53:12 -0500 Subject: [PATCH 4/6] right folds without materializing intermediate list --- src/Data/Map.purs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index b3795469..82520821 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, foldr, foldMapDefaultL, class Foldable) -import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldMapWithIndexDefaultL) +import Data.Foldable (foldl, 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 @@ -100,7 +100,7 @@ instance functorWithIndexMap :: FunctorWithIndex k (Map k) where instance foldableMap :: Foldable (Map k) where foldl f = foldlWithIndex (const f) - foldr f z m = foldr f z (values m) + foldr f = foldrWithIndex (const f) foldMap = foldMapDefaultL instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where @@ -117,7 +117,19 @@ instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where 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 + foldrWithIndex f z m = go (m : Nil) + where + go Nil = z + go (hd : tl) = case hd of + Leaf -> go tl + Two Leaf k v Leaf -> + f k v $ go tl + Two Leaf k v right -> + f k v $ go $ right : tl + Two left k v right -> + go $ left : singleton k v : right : tl + Three left k1 v1 mid k2 v2 right -> + go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl foldMapWithIndex = foldMapWithIndexDefaultL asList :: forall k v. List (Tuple k v) -> List (Tuple k v) From ab7285911a9749fd82058adc38f7b68eb03d4793 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 17 Jan 2018 17:56:40 -0500 Subject: [PATCH 5/6] benchmark foldr Reveals that it is very, very un-stack-safe --- bench/Bench/Data/Map.purs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs index 784b42ce..1c516ebf 100644 --- a/bench/Bench/Data/Map.purs +++ b/bench/Bench/Data/Map.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) -import Data.Foldable (foldl) +import Data.Foldable (foldl, foldr) import Data.List (zipWith) import Data.List as L import Data.Map as M @@ -29,6 +29,10 @@ benchMap = do log "------------" benchFoldl + log "foldr" + log "------------" + benchFoldr + where nats = L.range 0 999999 @@ -78,3 +82,17 @@ benchMap = do 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 From 7047e62dd5525a416b6a0154a61f62befbd88927 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 17 Jan 2018 18:05:25 -0500 Subject: [PATCH 6/6] restore old foldrWithIndex any attempt at directly folding is not stack safe --- src/Data/Map.purs | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 82520821..fd69854d 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -43,7 +43,7 @@ module Data.Map import Prelude import Data.Eq (class Eq1) -import Data.Foldable (foldl, foldMapDefaultL, class Foldable) +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) @@ -117,19 +117,7 @@ instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where 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 = go (m : Nil) - where - go Nil = z - go (hd : tl) = case hd of - Leaf -> go tl - Two Leaf k v Leaf -> - f k v $ go tl - Two Leaf k v right -> - f k v $ go $ right : tl - Two left k v right -> - go $ left : singleton k v : right : tl - Three left k1 v1 mid k2 v2 right -> - go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl + foldrWithIndex f z m = foldr (uncurry f) z $ asList $ toUnfoldable m foldMapWithIndex = foldMapWithIndexDefaultL asList :: forall k v. List (Tuple k v) -> List (Tuple k v)