b3c8d19 · typerep-map · git.iko.soy

git.iko.soy/typerep-map

Add intersection/intersectionWith (#96)

* Add intersection/intersectionWith * Refactor for code style * More correct O notations

commitb3c8d19563eb5a5f5630c7943c594bba08e069ae authorChris Penner <christopher.penner@gmail.com> dateTue 27 Oct 2020, 11:25 (6 years ago) parent1b739d8

4 files changed+73−2

compare with main

unifiedsplit

src/Data/TMap.hs+20 src/Data/TypeRepMap.hs+2 src/Data/TypeRepMap/Internal.hs+42 test/Test/TypeRep/TypeRepMapProperty.hs+9−2

src/Data/TMap.hs+20

@@ -37,6 +37,8 @@ module Data.TMap

3737 , delete

3838 , unionWith

3939 , union

40+ , intersectionWith

41+ , intersection

4042 , map

4143 , adjust

4244 , alter

@@ -132,6 +134,24 @@ union :: TMap -> TMap -> TMap

132134union = F.union

133135{-# INLINE union #-}

134136

137+-- | The intersection of two 'TMap's using a combining function.

138+--

139+-- @O(n + m)@

140+intersectionWith :: (forall x. Typeable x => x -> x -> x) -> TMap -> TMap -> TMap

141+intersectionWith f = F.intersectionWith fId

142+ where

143+ fId :: forall y . Typeable y => Identity y -> Identity y -> Identity y

144+ fId y1 y2 = f (coerce y1) (coerce y2)

145+{-# INLINE intersectionWith #-}

146+

147+-- | The intersection of two 'TMap's.

148+-- It keeps all values from the first map whose keys are present in the second.

149+--

150+-- @O(n + m)@

151+intersection :: TMap -> TMap -> TMap

152+intersection = F.intersection

153+{-# INLINE intersection #-}

154+

135155{- | Lookup a value of the given type in a 'TMap'.

136156

137157>>> x = lookup $ insert (11 :: Int) empty

src/Data/TypeRepMap.hs+2

@@ -63,6 +63,8 @@ module Data.TypeRepMap

6363 , hoistWithKey

6464 , unionWith

6565 , union

66+ , intersectionWith

67+ , intersection

6668

6769 -- * Query

6870 , lookup

src/Data/TypeRepMap/Internal.hs+42

@@ -350,6 +350,48 @@ union :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f

350350union = unionWith const

351351{-# INLINE union #-}

352352

353+-- | The 'intersection' of two 'TypeRepMap's using a combining function

354+--

355+-- @O(n + m)@

356+intersectionWith :: forall f. (forall x. Typeable x => f x -> f x -> f x) -> TypeRepMap f -> TypeRepMap f -> TypeRepMap f

357+intersectionWith f ma mb =

358+ fromSortedTriples $ mergeMaps (toSortedTriples ma) (toSortedTriples mb)

359+ where

360+ f' :: forall x. TypeRep x -> f x -> f x -> f x

361+ f' tr = withTypeable tr f

362+

363+ combine :: (Fingerprint, Any, Any) -> (Fingerprint, Any, Any) -> (Fingerprint, Any, Any)

364+ combine (fp, av, ak) (_, bv, _) = (fp, toAny $ f' (fromAny ak) (fromAny av) (fromAny bv), ak)

365+

366+ -- Merges two typrepmaps into a sorted, dedup'd list of triples.

367+ mergeMaps :: [(Fingerprint, Any, Any)] -> [(Fingerprint, Any, Any)] -> [(Fingerprint, Any, Any)]

368+ -- If either list is empty, the intersection must be finished.

369+ mergeMaps _ [] = []

370+ mergeMaps [] _ = []

371+ -- Merge the two maps considering one element at a time.

372+ mergeMaps (a@(af, _, _) : as) (b@(bf, _, _) : bs) =

373+ case compare af bf of

374+ -- Fingerprints are equal, union the elements using our function

375+ -- If the incoming maps were de-duped, there shouldn't be any other equivalent

376+ -- fingerprints

377+ EQ -> combine a b : mergeMaps as bs

378+ -- First fingerprint must not be in the second map or we would have seen it by now

379+ -- Skip it an move on

380+ LT -> mergeMaps as (b : bs)

381+ -- Second fingerprint must not be in the first map or we would have seen it by now

382+ -- Skip it an move on

383+ GT -> mergeMaps (a:as) bs

384+{-# INLINE intersectionWith #-}

385+

386+-- | The intersection of two 'TypeRepMap's.

387+-- It keeps all values from the first map whose keys are present in the second.

388+--

389+-- @O(n + m)@

390+intersection :: TypeRepMap f -> TypeRepMap f -> TypeRepMap f

391+intersection = intersectionWith const

392+{-# INLINE intersection #-}

393+

394+

353395{- | Check if a value of the given type is present in a 'TypeRepMap'.

354396

355397>>> member @Char $ one (Identity 'a')

test/Test/TypeRep/TypeRepMapProperty.hs+9−2

@@ -20,8 +20,8 @@ import Test.Hspec (Arg, Expectation, Spec, SpecWith, describe, it)

2020import Test.Hspec.Hedgehog (hedgehog)

2121

2222import Data.TypeRepMap.Internal (TypeRepMap (..), WrapTypeable (..), delete, insert, invariantCheck,

23− lookup, member, generateOrderMapping, fromSortedList, alter,

24− adjust)

23+ lookup, member, union, generateOrderMapping, fromSortedList,

24+ adjust, alter, intersection)

2525

2626import qualified Hedgehog.Gen as Gen

2727import qualified Hedgehog.Range as Range

@@ -39,6 +39,7 @@ typeRepMapPropertySpec = describe "TypeRepMap Property tests" $ do

3939 alterDeleteSpec

4040 alterAdjustSpec

4141 alterModifySpec

42+ intersectionSpec

4243 describe "Internal helpers" $ do

4344 generateOrderMappingInvariantSpec

4445 describe "Instance Laws" $ do

@@ -118,6 +119,12 @@ alterModifySpec = it "lookup k (alter f) == f (lookup k m)" $ hedgehog $ do

118119 | otherwise = Just $ IntProxy p (n * 10)

119120 lookup @n @IntProxy (alter @n f m) === f (lookup @n @IntProxy m)

120121

122+intersectionSpec :: Property

123+intersectionSpec = it "m `intersection` (m `union` n) == m" $ hedgehog $ do

124+ m <- forAll genMap

125+ n <- forAll genMap

126+ m `intersection` (m `union` n) === m

127+

121128----------------------------------------------------------------------------

122129-- Internal helpers

123130----------------------------------------------------------------------------