discrimination-0.3: Fast generic linear-time sorting, joins and container construction.

Safe HaskellSafe
LanguageHaskell2010

Data.Discrimination

Contents

Synopsis

Discrimination

class Decidable f => Discriminating f where Source #

Minimal complete definition

disc

Methods

disc :: f a -> [(a, b)] -> [[b]] Source #

Instances

Discriminating Group Source # 

Methods

disc :: Group a -> [(a, b)] -> [[b]] Source #

Discriminating Sort Source # 

Methods

disc :: Sort a -> [(a, b)] -> [[b]] Source #

Unordered

newtype Group a Source #

Productive Stable Unordered Discriminator

Constructors

Group 

Fields

Instances

Divisible Group Source # 

Methods

divide :: (a -> (b, c)) -> Group b -> Group c -> Group a #

conquer :: Group a #

Decidable Group Source # 

Methods

lose :: (a -> Void) -> Group a #

choose :: (a -> Either b c) -> Group b -> Group c -> Group a #

Contravariant Group Source # 

Methods

contramap :: (a -> b) -> Group b -> Group a #

(>$) :: b -> Group b -> Group a #

Discriminating Group Source # 

Methods

disc :: Group a -> [(a, b)] -> [[b]] Source #

Semigroup (Group a) Source # 

Methods

(<>) :: Group a -> Group a -> Group a #

sconcat :: NonEmpty (Group a) -> Group a #

stimes :: Integral b => b -> Group a -> Group a #

Monoid (Group a) Source # 

Methods

mempty :: Group a #

mappend :: Group a -> Group a -> Group a #

mconcat :: [Group a] -> Group a #

class Grouping a where Source #

Eq equipped with a compatible stable unordered discriminator.

Methods

grouping :: Group a Source #

For every surjection f,

contramap f groupinggrouping

grouping :: Deciding Grouping a => Group a Source #

For every surjection f,

contramap f groupinggrouping

Instances

Grouping Bool Source # 
Grouping Char Source # 
Grouping Int Source # 
Grouping Int8 Source # 
Grouping Int16 Source # 
Grouping Int32 Source # 
Grouping Int64 Source # 
Grouping Word Source # 
Grouping Word8 Source # 
Grouping Word16 Source # 
Grouping Word32 Source # 
Grouping Word64 Source # 
Grouping Void Source # 
Grouping a => Grouping [a] Source # 

Methods

grouping :: Group [a] Source #

Grouping a => Grouping (Maybe a) Source # 

Methods

grouping :: Group (Maybe a) Source #

Grouping a => Grouping (Ratio a) Source # 

Methods

grouping :: Group (Ratio a) Source #

Grouping a => Grouping (Complex a) Source # 

Methods

grouping :: Group (Complex a) Source #

(Grouping a, Grouping b) => Grouping (Either a b) Source # 

Methods

grouping :: Group (Either a b) Source #

(Grouping a, Grouping b) => Grouping (a, b) Source # 

Methods

grouping :: Group (a, b) Source #

(Grouping a, Grouping b, Grouping c) => Grouping (a, b, c) Source # 

Methods

grouping :: Group (a, b, c) Source #

(Grouping a, Grouping b, Grouping c, Grouping d) => Grouping (a, b, c, d) Source # 

Methods

grouping :: Group (a, b, c, d) Source #

(Grouping1 f, Grouping1 g, Grouping a) => Grouping (Compose * * f g a) Source # 

Methods

grouping :: Group (Compose * * f g a) Source #

class Grouping1 f where Source #

Methods

grouping1 :: Group a -> Group (f a) Source #

grouping1 :: Deciding1 Grouping f => Group a -> Group (f a) Source #

Instances

Grouping1 [] Source # 

Methods

grouping1 :: Group a -> Group [a] Source #

Grouping1 Maybe Source # 

Methods

grouping1 :: Group a -> Group (Maybe a) Source #

Grouping1 Complex Source # 

Methods

grouping1 :: Group a -> Group (Complex a) Source #

Grouping a => Grouping1 (Either a) Source # 

Methods

grouping1 :: Group a -> Group (Either a a) Source #

Grouping a => Grouping1 ((,) a) Source # 

Methods

grouping1 :: Group a -> Group (a, a) Source #

(Grouping a, Grouping b) => Grouping1 ((,,) a b) Source # 

Methods

grouping1 :: Group a -> Group (a, b, a) Source #

(Grouping a, Grouping b, Grouping c) => Grouping1 ((,,,) a b c) Source # 

Methods

grouping1 :: Group a -> Group (a, b, c, a) Source #

(Grouping1 f, Grouping1 g) => Grouping1 (Compose * * f g) Source # 

Methods

grouping1 :: Group a -> Group (Compose * * f g a) Source #

nub :: Grouping a => [a] -> [a] Source #

O(n). This upgrades nub from Data.List from O(n^2) to O(n) by using productive unordered discrimination.

nub = nubWith id
nub as = head <$> group as

nubWith :: Grouping b => (a -> b) -> [a] -> [a] Source #

O(n). Online nub with a Schwartzian transform.

nubWith f as = head <$> groupWith f as

group :: Grouping a => [a] -> [[a]] Source #

O(n). Similar to group, except we do not require groups to be clustered.

This combinator still operates in linear time, at the expense of storing history.

The result equivalence classes are not sorted, but the grouping is stable.

group = groupWith id

groupWith :: Grouping b => (a -> b) -> [a] -> [[a]] Source #

O(n). This is a replacement for groupWith using discrimination.

The result equivalence classes are not sorted, but the grouping is stable.

runGroup :: Group a -> [(a, b)] -> [[b]] Source #

groupingEq :: Grouping a => a -> a -> Bool Source #

Valid definition for (==) in terms of Grouping.

Ordered

newtype Sort a Source #

Stable Ordered Discriminator

Constructors

Sort 

Fields

  • runSort :: forall b. [(a, b)] -> [[b]]
     

Instances

Divisible Sort Source # 

Methods

divide :: (a -> (b, c)) -> Sort b -> Sort c -> Sort a #

conquer :: Sort a #

Decidable Sort Source # 

Methods

lose :: (a -> Void) -> Sort a #

choose :: (a -> Either b c) -> Sort b -> Sort c -> Sort a #

Contravariant Sort Source # 

Methods

contramap :: (a -> b) -> Sort b -> Sort a #

(>$) :: b -> Sort b -> Sort a #

Discriminating Sort Source # 

Methods

disc :: Sort a -> [(a, b)] -> [[b]] Source #

Semigroup (Sort a) Source # 

Methods

(<>) :: Sort a -> Sort a -> Sort a #

sconcat :: NonEmpty (Sort a) -> Sort a #

stimes :: Integral b => b -> Sort a -> Sort a #

Monoid (Sort a) Source # 

Methods

mempty :: Sort a #

mappend :: Sort a -> Sort a -> Sort a #

mconcat :: [Sort a] -> Sort a #

class Grouping a => Sorting a where Source #

Ord equipped with a compatible stable, ordered discriminator.

Methods

sorting :: Sort a Source #

For every strictly monotone-increasing function f:

contramap f sortingsorting

sorting :: Deciding Sorting a => Sort a Source #

For every strictly monotone-increasing function f:

contramap f sortingsorting

Instances

Sorting Bool Source # 
Sorting Char Source # 
Sorting Int Source # 

Methods

sorting :: Sort Int Source #

Sorting Int8 Source # 
Sorting Int16 Source # 
Sorting Int32 Source # 
Sorting Int64 Source # 
Sorting Word Source # 
Sorting Word8 Source # 
Sorting Word16 Source # 
Sorting Word32 Source # 
Sorting Word64 Source # 
Sorting Void Source # 
Sorting a => Sorting [a] Source # 

Methods

sorting :: Sort [a] Source #

Sorting a => Sorting (Maybe a) Source # 

Methods

sorting :: Sort (Maybe a) Source #

(Sorting a, Sorting b) => Sorting (Either a b) Source # 

Methods

sorting :: Sort (Either a b) Source #

(Sorting a, Sorting b) => Sorting (a, b) Source # 

Methods

sorting :: Sort (a, b) Source #

(Sorting a, Sorting b, Sorting c) => Sorting (a, b, c) Source # 

Methods

sorting :: Sort (a, b, c) Source #

(Sorting a, Sorting b, Sorting c, Sorting d) => Sorting (a, b, c, d) Source # 

Methods

sorting :: Sort (a, b, c, d) Source #

(Sorting1 f, Sorting1 g, Sorting a) => Sorting (Compose * * f g a) Source # 

Methods

sorting :: Sort (Compose * * f g a) Source #

class Grouping1 f => Sorting1 f where Source #

Methods

sorting1 :: Sort a -> Sort (f a) Source #

sorting1 :: Deciding1 Sorting f => Sort a -> Sort (f a) Source #

Instances

Sorting1 [] Source # 

Methods

sorting1 :: Sort a -> Sort [a] Source #

Sorting1 Maybe Source # 

Methods

sorting1 :: Sort a -> Sort (Maybe a) Source #

Sorting a => Sorting1 (Either a) Source # 

Methods

sorting1 :: Sort a -> Sort (Either a a) Source #

(Sorting1 f, Sorting1 g) => Sorting1 (Compose * * f g) Source # 

Methods

sorting1 :: Sort a -> Sort (Compose * * f g a) Source #

desc :: Sort a -> Sort a Source #

sort :: Sorting a => [a] -> [a] Source #

O(n). Sort a list using discrimination.

sort = sortWith id

sortWith :: Sorting b => (a -> b) -> [a] -> [a] Source #

O(n). Sort a list with a Schwartzian transformation by using discrimination.

This linear time replacement for sortWith and sortOn uses discrimination.

sortingBag :: Foldable f => Sort k -> Sort (f k) Source #

Construct a stable ordered discriminator that sorts a list as multisets of elements from another stable ordered discriminator.

The resulting discriminator only cares about the set of keys and their multiplicity, and is sorted as if we'd sorted each key in turn before comparing.

sortingSet :: Foldable f => Sort k -> Sort (f k) Source #

Construct a stable ordered discriminator that sorts a list as sets of elements from another stable ordered discriminator.

The resulting discriminator only cares about the set of keys, and is sorted as if we'd sorted each key in turn before comparing.

sortingCompare :: Sorting a => a -> a -> Ordering Source #

Valid definition for compare in terms of Sorting.

Container Construction

toMap :: Sorting k => [(k, v)] -> Map k v Source #

O(n). Construct a Map.

This is an asymptotically faster version of fromList, which exploits ordered discrimination.

>>> toMap [] == empty
True
>>> toMap [(5,"a"), (3 :: Int,"b"), (5, "c")]
fromList [(5,"c"), (3,"b")]
>>> toMap [(5,"c"), (3,"b"), (5 :: Int, "a")]
fromList [(5,"a"), (3,"b")]

toMapWith :: Sorting k => (v -> v -> v) -> [(k, v)] -> Map k v Source #

O(n). Construct a Map, combining values.

This is an asymptotically faster version of fromListWith, which exploits ordered discrimination.

(Note: values combine in anti-stable order for compatibility with fromListWith)

>>> toMapWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5 :: Int,"c")]
fromList [(3, "ab"), (5, "cba")]
>>> toMapWith (++) [] == empty
True

toMapWithKey :: Sorting k => (k -> v -> v -> v) -> [(k, v)] -> Map k v Source #

O(n). Construct a Map, combining values with access to the key.

This is an asymptotically faster version of fromListWithKey, which exploits ordered discrimination.

(Note: the values combine in anti-stable order for compatibility with fromListWithKey)

>>> let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value
>>> toMapWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5 :: Int,"c")]
fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]
>>> toMapWithKey f [] == empty
True

toIntMap :: [(Int, v)] -> IntMap v Source #

O(n). Construct an IntMap.

>>> toIntMap [] == empty
True
>>> toIntMap [(5,"a"), (3,"b"), (5, "c")]
fromList [(5,"c"), (3,"b")]
>>> toIntMap [(5,"c"), (3,"b"), (5, "a")]
fromList [(5,"a"), (3,"b")]

toIntMapWith :: (v -> v -> v) -> [(Int, v)] -> IntMap v Source #

O(n). Construct an IntMap, combining values.

This is an asymptotically faster version of fromListWith, which exploits ordered discrimination.

(Note: values combine in anti-stable order for compatibility with fromListWith)

>>> toIntMapWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")]
fromList [(3, "ab"), (5, "cba")]
>>> toIntMapWith (++) [] == empty
True

toIntMapWithKey :: (Int -> v -> v -> v) -> [(Int, v)] -> IntMap v Source #

O(n). Construct a Map, combining values with access to the key.

This is an asymptotically faster version of fromListWithKey, which exploits ordered discrimination.

(Note: the values combine in anti-stable order for compatibility with fromListWithKey)

>>> let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value
>>> toIntMapWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")]
fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]
>>> toIntMapWithKey f [] == empty
True

toSet :: Sorting k => [k] -> Set k Source #

O(n). Construct a Set in linear time.

This is an asymptotically faster version of fromList, which exploits ordered discrimination.

toIntSet :: [Int] -> IntSet Source #

O(n). Construct an IntSet in linear time.

This is an asymptotically faster version of fromList, which exploits ordered discrimination.

Joins

joining Source #

Arguments

:: Discriminating f 
=> f d

the discriminator to use

-> ([a] -> [b] -> c)

how to join two tables

-> (a -> d)

selector for the left table

-> (b -> d)

selector for the right table

-> [a]

left table

-> [b]

right table

-> [c] 

O(n). Perform a full outer join while explicit merging of the two result tables a table at a time.

The results are grouped by the discriminator.

inner Source #

Arguments

:: Discriminating f 
=> f d

the discriminator to use

-> (a -> b -> c)

how to join two rows

-> (a -> d)

selector for the left table

-> (b -> d)

selector for the right table

-> [a]

left table

-> [b]

right table

-> [[c]] 

O(n). Perform an inner join, with operations defined one row at a time.

The results are grouped by the discriminator.

This takes operation time linear in both the input and result sets.

outer Source #

Arguments

:: Discriminating f 
=> f d

the discriminator to use

-> (a -> b -> c)

how to join two rows

-> (a -> c)

row present on the left, missing on the right

-> (b -> c)

row present on the right, missing on the left

-> (a -> d)

selector for the left table

-> (b -> d)

selector for the right table

-> [a]

left table

-> [b]

right table

-> [[c]] 

O(n). Perform a full outer join with operations defined one row at a time.

The results are grouped by the discriminator.

This takes operation time linear in both the input and result sets.

leftOuter Source #

Arguments

:: Discriminating f 
=> f d

the discriminator to use

-> (a -> b -> c)

how to join two rows

-> (a -> c)

row present on the left, missing on the right

-> (a -> d)

selector for the left table

-> (b -> d)

selector for the right table

-> [a]

left table

-> [b]

right table

-> [[c]] 

O(n). Perform a left outer join with operations defined one row at a time.

The results are grouped by the discriminator.

This takes operation time linear in both the input and result sets.

rightOuter Source #

Arguments

:: Discriminating f 
=> f d

the discriminator to use

-> (a -> b -> c)

how to join two rows

-> (b -> c)

row present on the right, missing on the left

-> (a -> d)

selector for the left table

-> (b -> d)

selector for the right table

-> [a]

left table

-> [b]

right table

-> [[c]] 

O(n). Perform a right outer join with operations defined one row at a time.

The results are grouped by the discriminator.

This takes operation time linear in both the input and result sets.