Safe Haskell | Trustworthy |
---|---|
Language | Haskell2010 |
A random-access list implementation based on Chris Okasaki's approach on his book "Purely Functional Data Structures", Cambridge University Press, 1998, chapter 9.3.
RAList
is a replacement for ordinary finite lists.
RAList
provides the same complexity as ordinary for most the list operations.
Some operations take O(log n) for RAList
where the list operation is O(n),
notably indexing, (!!)
.
Synopsis
- data RAList a where
- cons :: a -> RAList a -> RAList a
- uncons :: RAList a -> Maybe (a, RAList a)
- (++) :: RAList a -> RAList a -> RAList a
- head :: RAList a -> Maybe a
- last :: RAList a -> a
- tail :: RAList a -> Maybe (RAList a)
- init :: RAList a -> RAList a
- null :: Foldable t => t a -> Bool
- length :: Foldable t => t a -> Int
- (!!) :: RAList a -> Word64 -> a
- lookupWithDefault :: forall t. t -> Word64 -> RAList t -> t
- lookupM :: forall a m. MonadFail m => RAList a -> Word64 -> m a
- lookup :: forall a. RAList a -> Word64 -> Maybe a
- lookupCC :: forall a r. RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
- lookupL :: Eq a => a -> RAList (a, b) -> Maybe b
- map :: (a -> b) -> RAList a -> RAList b
- reverse :: RAList a -> RAList a
- imap :: FunctorWithIndex i f => (i -> a -> b) -> f a -> f b
- itraverse :: (TraversableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f (t b)
- ifoldMap :: (FoldableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m
- ifoldl' :: FoldableWithIndex i f => (i -> b -> a -> b) -> b -> f a -> b
- ifoldr :: FoldableWithIndex i f => (i -> a -> b -> b) -> b -> f a -> b
- foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
- foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b
- foldl1 :: Foldable t => (a -> a -> a) -> t a -> a
- foldl1' :: (a -> a -> a) -> RAList a -> a
- foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
- foldr1 :: Foldable t => (a -> a -> a) -> t a -> a
- concat :: RAList (RAList a) -> RAList a
- concatMap :: (a -> RAList b) -> RAList a -> RAList b
- and :: Foldable t => t Bool -> Bool
- or :: Foldable t => t Bool -> Bool
- any :: Foldable t => (a -> Bool) -> t a -> Bool
- all :: Foldable t => (a -> Bool) -> t a -> Bool
- sum :: (Foldable t, Num a) => t a -> a
- product :: (Foldable t, Num a) => t a -> a
- maximum :: (Foldable t, Ord a) => t a -> a
- minimum :: (Foldable t, Ord a) => t a -> a
- replicate :: Word64 -> a -> RAList a
- unfoldr :: (b -> Maybe (a, b)) -> b -> RAList a
- take :: Word64 -> RAList a -> RAList a
- drop :: Word64 -> RAList a -> RAList a
- simpleDrop :: Word64 -> RAList a -> RAList a
- splitAt :: Word64 -> RAList a -> (RAList a, RAList a)
- elem :: (Foldable t, Eq a) => a -> t a -> Bool
- notElem :: (Foldable t, Eq a) => a -> t a -> Bool
- filter :: forall a. (a -> Bool) -> RAList a -> RAList a
- partition :: (a -> Bool) -> RAList a -> (RAList a, RAList a)
- mapMaybe :: forall a b. (a -> Maybe b) -> RAList a -> RAList b
- catMaybes :: RAList (Maybe a) -> RAList a
- wither :: forall a b f. Applicative f => (a -> f (Maybe b)) -> RAList a -> f (RAList b)
- zip :: RAList a -> RAList b -> RAList (a, b)
- zipWith :: forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
- unzip :: RAList (a, b) -> (RAList a, RAList b)
- genericLength :: Integral w => RAList a -> w
- genericTake :: Integral n => n -> RAList a -> RAList a
- genericDrop :: Integral n => n -> RAList a -> RAList a
- genericSplitAt :: Integral n => n -> RAList a -> (RAList a, RAList a)
- genericIndex :: Integral n => RAList a -> n -> a
- genericReplicate :: Integral n => n -> a -> RAList a
- update :: Word64 -> a -> RAList a -> RAList a
- adjust :: forall a. (a -> a) -> Word64 -> RAList a -> RAList a
- toList :: Foldable t => t a -> [a]
- fromList :: [a] -> RAList a
- build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> RAList a
- augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> RAList a -> RAList a
- wLength :: RAList a -> Word64
Documentation
pattern Nil :: forall a. RAList a | our '[]' by another name |
pattern Cons :: forall a. a -> RAList a -> RAList a infixr 5 | Constructor notation |
pattern (:|) :: forall a. a -> RAList a -> RAList a infixr 5 | like |
Instances
Monad RAList Source # | |
Functor RAList Source # | |
Applicative RAList Source # | |
Foldable RAList Source # | |
Defined in Data.RAList fold :: Monoid m => RAList m -> m # foldMap :: Monoid m => (a -> m) -> RAList a -> m # foldMap' :: Monoid m => (a -> m) -> RAList a -> m # foldr :: (a -> b -> b) -> b -> RAList a -> b # foldr' :: (a -> b -> b) -> b -> RAList a -> b # foldl :: (b -> a -> b) -> b -> RAList a -> b # foldl' :: (b -> a -> b) -> b -> RAList a -> b # foldr1 :: (a -> a -> a) -> RAList a -> a # foldl1 :: (a -> a -> a) -> RAList a -> a # elem :: Eq a => a -> RAList a -> Bool # maximum :: Ord a => RAList a -> a # minimum :: Ord a => RAList a -> a # | |
Traversable RAList Source # | |
MonadZip RAList Source # | |
FoldableWithIndex Word64 RAList Source # | |
Defined in Data.RAList | |
FunctorWithIndex Word64 RAList Source # | |
TraversableWithIndex Word64 RAList Source # | |
Defined in Data.RAList | |
IsList (RAList a) Source # | |
Eq a => Eq (RAList a) Source # | |
Data a => Data (RAList a) Source # | |
Defined in Data.RAList gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> RAList a -> c (RAList a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (RAList a) # toConstr :: RAList a -> Constr # dataTypeOf :: RAList a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (RAList a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RAList a)) # gmapT :: (forall b. Data b => b -> b) -> RAList a -> RAList a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RAList a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RAList a -> r # gmapQ :: (forall d. Data d => d -> u) -> RAList a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> RAList a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> RAList a -> m (RAList a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> RAList a -> m (RAList a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> RAList a -> m (RAList a) # | |
Ord a => Ord (RAList a) Source # | |
Defined in Data.RAList | |
Show a => Show (RAList a) Source # | |
Generic (RAList a) Source # | |
Semigroup (RAList a) Source # | |
Monoid (RAList a) Source # | |
Generic1 RAList Source # | |
type Rep (RAList a) Source # | |
Defined in Data.RAList | |
type Item (RAList a) Source # | |
Defined in Data.RAList | |
type Rep1 RAList Source # | |
Defined in Data.RAList |
Basic functions
null :: Foldable t => t a -> Bool #
Test whether the structure is empty. The default implementation is optimized for structures that are similar to cons-lists, because there is no general way to do better.
Since: base-4.8.0.0
length :: Foldable t => t a -> Int #
Returns the size/length of a finite structure as an Int
. The
default implementation is optimized for structures that are similar to
cons-lists, because there is no general way to do better.
Since: base-4.8.0.0
Indexing lists
These functions treat a list xs
as a indexed collection,
with indices ranging from 0 to
.length
xs - 1
lookupWithDefault :: forall t. t -> Word64 -> RAList t -> t Source #
List transformations
reverse :: RAList a -> RAList a Source #
reverse
xs
returns the elements of xs
in reverse order.
xs
must be finite.
indexed operations
itraverse :: (TraversableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f (t b) #
Reducing lists (folds)
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b #
Left-associative fold of a structure.
In the case of lists, foldl
, when applied to a binary
operator, a starting value (typically the left-identity of the operator),
and a list, reduces the list using the binary operator, from left to
right:
foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
Note that to produce the outermost application of the operator the
entire input list must be traversed. This means that foldl'
will
diverge if given an infinite list.
Also note that if you want an efficient left-fold, you probably want to
use foldl'
instead of foldl
. The reason for this is that latter does
not force the "inner" results (e.g. z `f` x1
in the above example)
before applying them to the operator (e.g. to (`f` x2)
). This results
in a thunk chain \(\mathcal{O}(n)\) elements long, which then must be
evaluated from the outside-in.
For a general Foldable
structure this should be semantically identical
to,
foldl f z =foldl
f z .toList
foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b #
Left-associative fold of a structure but with strict application of the operator.
This ensures that each step of the fold is forced to weak head normal
form before being applied, avoiding the collection of thunks that would
otherwise occur. This is often what you want to strictly reduce a finite
list to a single, monolithic result (e.g. length
).
For a general Foldable
structure this should be semantically identical
to,
foldl' f z =foldl'
f z .toList
Since: base-4.6.0.0
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b #
Right-associative fold of a structure.
In the case of lists, foldr
, when applied to a binary operator, a
starting value (typically the right-identity of the operator), and a
list, reduces the list using the binary operator, from right to left:
foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
Note that, since the head of the resulting expression is produced by
an application of the operator to the first element of the list,
foldr
can produce a terminating expression from an infinite list.
For a general Foldable
structure this should be semantically identical
to,
foldr f z =foldr
f z .toList
Special folds
any :: Foldable t => (a -> Bool) -> t a -> Bool #
Determines whether any element of the structure satisfies the predicate.
all :: Foldable t => (a -> Bool) -> t a -> Bool #
Determines whether all elements of the structure satisfy the predicate.
sum :: (Foldable t, Num a) => t a -> a #
The sum
function computes the sum of the numbers of a structure.
Since: base-4.8.0.0
product :: (Foldable t, Num a) => t a -> a #
The product
function computes the product of the numbers of a
structure.
Since: base-4.8.0.0
maximum :: (Foldable t, Ord a) => t a -> a #
The largest element of a non-empty structure.
Since: base-4.8.0.0
minimum :: (Foldable t, Ord a) => t a -> a #
The least element of a non-empty structure.
Since: base-4.8.0.0
Building lists
Repetition
Unfolding
Sublists
Extracting sublists
drop :: Word64 -> RAList a -> RAList a Source #
where l has length n has worst case complexity Complexity O(log n), Average case
complexity should be O(min(log i, log n)).drop
i l
Searching lists
Searching by equality
elem :: (Foldable t, Eq a) => a -> t a -> Bool infix 4 #
Does the element occur in the structure?
Since: base-4.8.0.0
Zipping and unzipping lists
The "generic
" operations
The prefix `generic
' indicates an overloaded function that
is a generalized version of a Prelude function.
genericLength :: Integral w => RAList a -> w Source #
genericIndex :: Integral n => RAList a -> n -> a Source #
genericReplicate :: Integral n => n -> a -> RAList a Source #
Update
update :: Word64 -> a -> RAList a -> RAList a Source #
Change element at the given index. Complexity O(log n).
adjust :: forall a. (a -> a) -> Word64 -> RAList a -> RAList a Source #
Apply a function to the value at the given index. Complexity O(log n).
List conversion
toList :: Foldable t => t a -> [a] #
List of elements of a structure, from left to right.
Since: base-4.8.0.0
fromList :: [a] -> RAList a Source #
Complexity O(n). toList :: RAList a -> [a] toList = foldr (:) [] toList ra = tops ra [] where flat (Leaf x) a = x : a flat (Node x l r) a = x : flat l (flat r a) tops RNil r = r tops (RCons _tot _ t xs) r = flat t (tops xs r)
Complexity O(n).