uniquely-represented-sets-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Data.Tree.Braun.Sized

Contents

Description

This module provides a Braun tree which keeps track of its size, and associated functions.

Synopsis

Braun type

data Braun a Source #

A Braun tree which keeps track of its size.

Constructors

Braun 

Fields

Instances

Functor Braun Source # 

Methods

fmap :: (a -> b) -> Braun a -> Braun b #

(<$) :: a -> Braun b -> Braun a #

Foldable Braun Source #

toList is O(n).

fromList (toList xs) === xs

Methods

fold :: Monoid m => Braun m -> m #

foldMap :: Monoid m => (a -> m) -> Braun a -> m #

foldr :: (a -> b -> b) -> b -> Braun a -> b #

foldr' :: (a -> b -> b) -> b -> Braun a -> b #

foldl :: (b -> a -> b) -> b -> Braun a -> b #

foldl' :: (b -> a -> b) -> b -> Braun a -> b #

foldr1 :: (a -> a -> a) -> Braun a -> a #

foldl1 :: (a -> a -> a) -> Braun a -> a #

toList :: Braun a -> [a] #

null :: Braun a -> Bool #

length :: Braun a -> Int #

elem :: Eq a => a -> Braun a -> Bool #

maximum :: Ord a => Braun a -> a #

minimum :: Ord a => Braun a -> a #

sum :: Num a => Braun a -> a #

product :: Num a => Braun a -> a #

Traversable Braun Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Braun a -> f (Braun b) #

sequenceA :: Applicative f => Braun (f a) -> f (Braun a) #

mapM :: Monad m => (a -> m b) -> Braun a -> m (Braun b) #

sequence :: Monad m => Braun (m a) -> m (Braun a) #

Eq a => Eq (Braun a) Source # 

Methods

(==) :: Braun a -> Braun a -> Bool #

(/=) :: Braun a -> Braun a -> Bool #

Data a => Data (Braun a) Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Braun a -> c (Braun a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Braun a) #

toConstr :: Braun a -> Constr #

dataTypeOf :: Braun a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Braun a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Braun a)) #

gmapT :: (forall b. Data b => b -> b) -> Braun a -> Braun a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Braun a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Braun a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Braun a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Braun a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Braun a -> m (Braun a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Braun a -> m (Braun a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Braun a -> m (Braun a) #

Ord a => Ord (Braun a) Source # 

Methods

compare :: Braun a -> Braun a -> Ordering #

(<) :: Braun a -> Braun a -> Bool #

(<=) :: Braun a -> Braun a -> Bool #

(>) :: Braun a -> Braun a -> Bool #

(>=) :: Braun a -> Braun a -> Bool #

max :: Braun a -> Braun a -> Braun a #

min :: Braun a -> Braun a -> Braun a #

Read a => Read (Braun a) Source # 
Show a => Show (Braun a) Source # 

Methods

showsPrec :: Int -> Braun a -> ShowS #

show :: Braun a -> String #

showList :: [Braun a] -> ShowS #

Generic (Braun a) Source # 

Associated Types

type Rep (Braun a) :: * -> * #

Methods

from :: Braun a -> Rep (Braun a) x #

to :: Rep (Braun a) x -> Braun a #

NFData a => NFData (Braun a) Source # 

Methods

rnf :: Braun a -> () #

Generic1 * Braun Source # 

Associated Types

type Rep1 Braun (f :: Braun -> *) :: k -> * #

Methods

from1 :: f a -> Rep1 Braun f a #

to1 :: Rep1 Braun f a -> f a #

type Rep (Braun a) Source # 
type Rep (Braun a) = D1 * (MetaData "Braun" "Data.Tree.Braun.Sized" "uniquely-represented-sets-0.1.0.0-DDrGJFXMqirAsu4tzMTftK" False) (C1 * (MetaCons "Braun" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "size") SourceUnpack SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Just Symbol "tree") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Tree a)))))
type Rep1 * Braun Source # 
type Rep1 * Braun = D1 * (MetaData "Braun" "Data.Tree.Braun.Sized" "uniquely-represented-sets-0.1.0.0-DDrGJFXMqirAsu4tzMTftK" False) (C1 * (MetaCons "Braun" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "size") SourceUnpack SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Just Symbol "tree") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 * Tree))))

Construction

fromList :: [a] -> Braun a Source #

O(n). Create a Braun tree (in order) from a list. The algorithm is similar to that in:

Okasaki, Chris. ‘Three Algorithms on Braun Trees’. Journal of Functional Programming 7, no. 6 (November 1997): 661–666. https://doi.org/10.1017/S0956796897002876.

However, it uses a fold rather than explicit recursion, allowing fusion.

toList (fromList xs) === xs

empty :: Braun a Source #

A Braun tree with no elements.

singleton :: a -> Braun a Source #

A Braun tree with one element.

Building

type Builder a b = Int -> Int -> Int -> (([Tree a] -> [Tree a] -> [Tree a]) -> [Tree a] -> Int -> b) -> b Source #

A type suitable for building a Braun tree by repeated applications of consB.

consB :: a -> Builder a b -> Builder a b Source #

O(1). Push an element to the front of a Builder.

nilB :: Builder a b Source #

An empty Builder.

runB :: Builder a (Braun a) -> Braun a Source #

Convert a Builder to a Braun tree.

Modification

At ends

snoc :: a -> Braun a -> Braun a Source #

O(log n). Append an item to the end of a Braun tree.

x `snoc` fromList xs === fromList (xs ++ [x])

unsnoc :: Braun a -> Maybe (a, Braun a) Source #

O(log n). Returns the last element in the list and the other elements, if present, or Nothing if the tree is empty.

>>> unsnoc empty
Nothing
unsnoc (snoc x xs) === Just (x, xs)
unfoldr unsnoc (fromList xs) === reverse xs

unsnoc' :: HasCallStack => Braun a -> (a, Braun a) Source #

O(log n). Returns the last element in the list and the other elements, if present, or raises an error if the tree is empty.

isBraun (snd (unsnoc' (fromList (1:xs))))
fst (unsnoc' (fromList (1:xs))) == last (1:xs)

cons :: a -> Braun a -> Braun a Source #

O(log n). Append an element to the beginning of the Braun tree.

uncons' (cons x xs) === (x,xs)

uncons :: Braun a -> Maybe (a, Braun a) Source #

O(log n). Returns the first element in the array and the rest the elements, if it is nonempty, or Nothing if it is empty.

>>> uncons empty
Nothing
uncons (cons x xs) === Just (x,xs)
unfoldr uncons (fromList xs) === xs

uncons' :: HasCallStack => Braun a -> (a, Braun a) Source #

O(log n). Returns the first element in the array and the rest the elements, if it is nonempty, failing with an error if it is empty.

uncons' (cons x xs) === (x,xs)

As set

insertBy :: (a -> a -> Ordering) -> a -> Braun a -> Braun a Source #

O(n). Insert an element into the Braun tree, using the comparison function provided.

deleteBy :: (a -> a -> Ordering) -> a -> Braun a -> Braun a Source #

O(n). Delete an element from the Braun tree, using the comparison function provided.

Querying

glb :: (a -> b -> Ordering) -> a -> Braun b -> Maybe b Source #

O(log^2 n). Find the greatest lower bound for an element.

cmpRoot :: (a -> b -> Ordering) -> a -> Braun b -> Ordering Source #

Use a comparison function to compare an element to the root element in a Braun tree, failing if the tree is empty.

ltRoot :: (a -> b -> Ordering) -> a -> Braun b -> Bool Source #

Use a comparison function to see if an element is less than the root element in a Braun tree, failing if the tree is empty.