monoidmap-internal 0.1.1.0 → 0.1.2.0

raw patch · 5 files changed

+190/−19 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• components/monoidmap-benchmark/Main.hs +125/−16
• components/monoidmap-internal/Data/MonoidMap/Internal.hs +44/−2
• components/monoidmap-test/Data/MonoidMap/Internal/ValiditySpec.hs +11/−0
• monoidmap-internal.cabal +4/−1

@@ -1,3 +1,9 @@+# 0.1.2.0++- Improved the performance of `fromMap`, particularly for maps that+  contain no `mempty` values. This also benefits `fromList`, `fromListWith`+  and `fromSet`, which are defined in terms of `fromMap`.+ # 0.1.1.0  - Added functions `nullifyKeysIn` and `nullifyKeysNotIn` to `MonoidMap`.

@@ -2,40 +2,51 @@ -- Copyright: © 2022–2026 Jonathan Knowles -- License: Apache-2.0 ----- Benchmark for the `MonoidMap` type.+-- Benchmark for the 'MonoidMap' type and its functions. ----- Instead of benchmarking functions for the `MonoidMap` type directly, we--- benchmark functions for the `RecoveredMap` type, a newtype wrapper around--- the `MonoidMap` type designed to provide the same semantics as `Map`.+-- When a 'MonoidMap' function has a direct counterpart in 'Map' (such as the+-- 'fromList' function), we benchmark 'Map' against 'RecoveredMap': a newtype+-- wrapper around 'MonoidMap' with functions that have the same semantics as+-- those of 'Map', so that both sides of each comparison behave identically. --+-- When a 'MonoidMap' function has no direct counterpart in 'Map' (such as the+-- 'fromMap' function), we benchmark the 'MonoidMap' function directly.+-- module Main where  import Control.DeepSeq-    ( rnf )+    ( NFData, rnf ) import Control.Exception     ( evaluate )+import Data.Bool+    ( Bool (False, True) ) import Data.Eq-    ( Eq )+    ( Eq ((==)) ) import Data.Function-    ( flip, ($) )+    ( const, flip, ($) ) import Data.Int     ( Int ) import Data.List-    ( foldl', zip )+    ( filter, foldl', zip ) import Data.Maybe     ( Maybe, fromMaybe )+import Data.Monoid+    ( Monoid (mempty), Sum (Sum) ) import Data.Ord     ( Ord ) import Data.Semigroup     ( Semigroup ((<>)), stimes )+import Data.String+    ( String ) import Prelude-    ( Integer, Num, (^), (+) )+    ( Integer, Num, even, odd, (^), (+) ) import System.IO     ( IO ) import Test.Tasty.Bench-    ( bench, bgroup, defaultMain, nf )+    ( Benchmark, bcompare, bench, bgroup, defaultMain, nf )  import qualified Data.Map.Strict as OMap+import qualified Data.MonoidMap.Internal as MMap import qualified Data.MonoidMap.Internal.RecoveredMap as RMap  main :: IO ()@@ -49,11 +60,60 @@         rm_even    = fromList elems_even    :: RMap.Map Int Int         rm_odd     = fromList elems_odd     :: RMap.Map Int Int +        -- Maps in which different subsets of keys have 'null' values:+        om_null_none = mapWithNullIf (const False)   :: OMap.Map Int (Sum Int)+        om_null_min  = mapWithNullIf (== minNatural) :: OMap.Map Int (Sum Int)+        om_null_max  = mapWithNullIf (== maxNatural) :: OMap.Map Int (Sum Int)+        om_null_even = mapWithNullIf even            :: OMap.Map Int (Sum Int)+        om_null_odd  = mapWithNullIf odd             :: OMap.Map Int (Sum Int)+        om_null_all  = mapWithNullIf (const True)    :: OMap.Map Int (Sum Int)+     evaluate $ rnf [om_natural, om_even, om_odd]     evaluate $ rnf [rm_natural, rm_even, rm_odd]+    evaluate $ rnf+        [ om_null_none+        , om_null_min+        , om_null_max+        , om_null_even+        , om_null_odd+        , om_null_all+        ] +    let fromMapCases =+            [ ("no nulls",           om_null_none)+            , ("one null (min key)", om_null_min)+            , ("one null (max key)", om_null_max)+            , ("even nulls",         om_null_even)+            , ("odd nulls",          om_null_odd)+            , ("all nulls",          om_null_all)+            ]+     defaultMain-        [ bgroup "delete"+        [ compareImplementations+            ("fromMap", MMap.fromMap) fromMapCases+            [ ( "fromMap_filter"+              , MMap.fromMap_filter+              )+            , ( "fromMap_filter_if_any_null"+              , MMap.fromMap_filter_if_any_null+              )+            , ( "fromMap_mapMaybe"+              , MMap.fromMap_mapMaybe+              )+            ]+        , compareImplementations+            ("fromMapWith", MMap.fromMapWith double) fromMapCases+            [ ( "fromMapWith_mapMaybe"+              , MMap.fromMapWith_mapMaybe double+              )+            , ( "fromMapWith_map_filter"+              , MMap.fromMapWith_map_filter double+              )+            , ( "fromMapWith_map_filter_if_any_null"+              , MMap.fromMapWith_map_filter_if_any_null double+              )+            ]+        , bgroup "delete"             [ bgroup "absent"                 [ bench "Data.Map.Strict" $                     nf (deleteMany evens) om_odd@@ -141,9 +201,12 @@             ]         ]   where-    bound :: Int-    bound = 2 ^ (16 :: Int)+    minNatural :: Int+    minNatural = 1 +    maxNatural :: Int+    maxNatural = 2 ^ (16 :: Int)+     elems_natural :: [(Int, Int)]     elems_natural = zip naturals naturals @@ -154,16 +217,62 @@     elems_odd = zip odds odds      naturals :: [Int]-    naturals = [1 .. bound]+    naturals = [minNatural .. maxNatural]      evens :: [Int]-    evens = [2, 4 .. bound]+    evens = filter even naturals      odds :: [Int]-    odds = [1, 3 .. bound]+    odds = filter odd naturals      ten_power_24 :: Integer     ten_power_24 = 1_000_000_000_000_000_000_000_000++    -- A map from keys [minNatural .. maxNatural], with a null value for each+    -- key that satisfies the given predicate, and a non-null value otherwise.+    mapWithNullIf :: (Int -> Bool) -> OMap.Map Int (Sum Int)+    mapWithNullIf hasNullValue = OMap.fromList+        [ (k, if hasNullValue k then mempty else Sum 1)+        | k <- [minNatural .. maxNatural]+        ]++    -- A simple function that replaces every value with a new value, while:+    -- - preserving existing null values; and+    -- - not introducing any new null values.+    double :: Semigroup m => m -> m+    double m = m <> m++-- | Compares implementations of a public function with the public function+--   itself, for each of the given cases.+--+-- For each case, the time taken by each implementation is reported relative+-- to the time taken by the public function.+--+compareImplementations+    :: NFData r+    => (String, i -> r)+    -- ^ The public function, with its name (also used as the group name).+    -> [(String, i)]+    -- ^ Cases (inputs) to benchmark, each with a label.+    -> [(String, i -> r)]+    -- ^ Implementations of the public function, each with a name.+    -> Benchmark+compareImplementations (publicName, public) cases implementations =+    bgroup publicName+        [ bgroup label $+            bench publicName (nf public input) :+            [ bcompare (relativeToPublic label) $ bench name $ nf f input+            | (name, f) <- implementations+            ]+        | (label, input) <- cases+        ]+  where+    -- Matches the benchmark of the public function for the given case (and+    -- nothing else):+    relativeToPublic label =+        "$NF == \"" <> publicName <> "\""+        <> " && $(NF-1) == \"" <> label <> "\""+        <> " && $(NF-2) == \"" <> publicName <> "\""  class Ord k => Map m k v where     fromList :: [(k, v)] -> m k v

@@ -4,6 +4,7 @@ {- HLINT ignore "Avoid lambda" -} {- HLINT ignore "Avoid lambda using `infix`" -} {- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Use camelCase" -}  -- | -- Copyright: © 2022–2026 Jonathan Knowles@@ -28,6 +29,14 @@     , fromSet     , singleton +    -- ** Construction (Internal)+    , fromMap_filter+    , fromMap_filter_if_any_null+    , fromMap_mapMaybe+    , fromMapWith_mapMaybe+    , fromMapWith_map_filter+    , fromMapWith_map_filter_if_any_null+     -- ** Deconstruction     , toList     , toMap@@ -518,8 +527,25 @@ -- complexity that is linear in the size of the map. -- fromMap :: MonoidNull v => Map k v -> MonoidMap k v-fromMap = MonoidMap . Map.mapMaybe maybeNonNull+fromMap = fromMap_filter_if_any_null+{-# INLINABLE fromMap #-} +fromMap_filter :: MonoidNull v => Map k v -> MonoidMap k v+fromMap_filter = coerce . Map.filter (\(!v) -> not (C.null v))+{-# INLINABLE fromMap_filter #-}++fromMap_filter_if_any_null :: MonoidNull v => Map k v -> MonoidMap k v+fromMap_filter_if_any_null m+    | F.any (\(!v) -> C.null v) m =+        coerce $ Map.filter (\(!v) -> not (C.null v)) m+    | otherwise =+        coerce m+{-# INLINABLE fromMap_filter_if_any_null #-}++fromMap_mapMaybe :: MonoidNull v => Map k v -> MonoidMap k v+fromMap_mapMaybe = MonoidMap . Map.mapMaybe maybeNonNull+{-# INLINABLE fromMap_mapMaybe #-}+ -- | \(O(n)\). Constructs a 'MonoidMap' from an ordinary 'Map', applying --   the given function to all values. --@@ -535,7 +561,23 @@ -- @since 0.0.4.0 -- fromMapWith :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> MonoidMap k v2-fromMapWith f = MonoidMap . Map.mapMaybe (maybeNonNull . f)+fromMapWith = fromMapWith_mapMaybe+{-# INLINABLE fromMapWith #-}++fromMapWith_mapMaybe+    :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> MonoidMap k v2+fromMapWith_mapMaybe f = MonoidMap . Map.mapMaybe (maybeNonNull . f)+{-# INLINABLE fromMapWith_mapMaybe #-}++fromMapWith_map_filter+    :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> MonoidMap k v2+fromMapWith_map_filter f = fromMap_filter . Map.map f+{-# INLINABLE fromMapWith_map_filter #-}++fromMapWith_map_filter_if_any_null+    :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> MonoidMap k v2+fromMapWith_map_filter_if_any_null f = fromMap_filter_if_any_null . Map.map f+{-# INLINABLE fromMapWith_map_filter_if_any_null #-}  -- | \(O(n)\). Constructs a 'MonoidMap' from a 'Set' and a function from --   keys to values.

@@ -141,6 +141,9 @@     it "propValid_fromMap" $         propValid_fromMap             @k @v & property+    it "propValid_fromMapWith" $+        propValid_fromMapWith+            @k @v & property     it "propValid_fromSet" $         propValid_fromSet             @k @v & property@@ -386,6 +389,14 @@     & cover 2         (Map.filter Null.null m /= mempty)         "Map.filter Null.null m /= mempty"++propValid_fromMapWith+    :: Test k v => Fun v v -> Map k v -> Property+propValid_fromMapWith (applyFun -> f) m =+    propValid (MonoidMap.fromMapWith f m)+    & cover 2+        (Map.filter Null.null (Map.map f m) /= mempty)+        "Map.filter Null.null (Map.map f m) /= mempty"  propValid_fromSet     :: Test k v => Fun k v -> Set k -> Property

@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           monoidmap-internal-version:        0.1.1.0+version:        0.1.2.0 homepage:       https://github.com/jonathanknowles/monoidmap/tree/HEAD/packages/monoidmap-internal bug-reports:    https://github.com/jonathanknowles/monoidmap/issues license:        Apache-2.0@@ -112,6 +112,9 @@         components/monoidmap-benchmark     main-is:         Main.hs+    -- Report allocation and memory statistics for each benchmark:+    ghc-options:+        "-with-rtsopts=-T"  test-suite monoidmap-test     import: