Utils.hs 1.71 KB
Newer Older
1 2 3
module Gargantext.Data.HashMap.Strict.Utils where

import Data.HashMap.Strict (HashMap)
4
import Data.Hashable (Hashable)
5
import Gargantext.Prelude
6
import qualified Data.HashMap.Strict as HashMap
7

8
------------------------------------------------------------------------
9
unionsWith :: (Foldable f, Eq k, Hashable k) => (a->a->a) -> f (HashMap k a) -> HashMap k a
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
unionsWith f = foldl' (HashMap.unionWith f) HashMap.empty

------------------------------------------------------------------------
-- | Partition the map according to some predicate. The first map contains all
-- elements that satisfy the predicate, the second all elements that fail the
-- predicate.
partition :: (Ord k, Hashable k) => (a -> Bool) -> HashMap k a -> (HashMap k a, HashMap k a) 
partition p m = (HashMap.filter p m, HashMap.filter (not . p) m)

-- | Partition the map according to some predicate. The first map contains all
-- elements that satisfy the predicate, the second all elements that fail the
-- predicate.
partitionWithKey :: (Ord a, Hashable k) => (k -> a -> Bool) -> HashMap k a -> (HashMap k a, HashMap k a)
partitionWithKey p m = (HashMap.filterWithKey p m, HashMap.filterWithKey (\k -> not . p k) m)

25

26
------------------------------------------------------------------------
27
-- getKeyWithMaxValue :: Hashable k => HashMap k a -> Maybe k
28 29 30 31 32 33 34 35 36
getKeysOrderedByValueMaxFirst :: (Ord k, Hashable k, Ord a) => HashMap k a -> [k]
getKeysOrderedByValueMaxFirst m = go [] Nothing (HashMap.toList m)
  where
    go ks _        []           = ks 
    go ks Nothing  ((k,v):rest) = go (k:ks) (Just v) rest
    go ks (Just u) ((k,v):rest)
        | v < u     = go ks     (Just u) rest
        | v > u     = go [k]    (Just v) rest
        | otherwise = go (k:ks) (Just v) rest
37