numeric-prelude-0.0.5: An experimental alternative hierarchy of numeric type classesSource codeContentsIndex
NumericPrelude.List
Contents
Slice lists
Use lists as counters
Zip lists
Lists of lists
Various
Synopsis
sieve' :: Int -> [a] -> [a]
sieve'' :: Int -> [a] -> [a]
sieve''' :: Int -> [a] -> [a]
sieve :: Int -> [a] -> [a]
sliceHoriz' :: Int -> [a] -> [[a]]
sliceHoriz :: Int -> [a] -> [[a]]
sliceVert' :: Int -> [a] -> [[a]]
sliceVert :: Int -> [a] -> [[a]]
takeMatch :: [b] -> [a] -> [a]
dropMatch :: [b] -> [a] -> [a]
splitAtMatch :: [b] -> [a] -> ([a], [a])
replicateMatch :: [a] -> b -> [b]
compareLength :: [a] -> [b] -> Ordering
zipWithPad :: a -> (a -> a -> b) -> [a] -> [a] -> [b]
zipWithOverlap :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithMatch :: (a -> b -> c) -> [a] -> [b] -> [c]
zipNeighborsWith :: (a -> a -> a) -> [a] -> [a]
shear :: [[a]] -> [[a]]
shearTranspose :: [[a]] -> [[a]]
outerProduct :: (a -> b -> c) -> [a] -> [b] -> [[c]]
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
splitLast :: [a] -> ([a], a)
propSplitLast :: Eq a => [a] -> Bool
dropWhileRev :: (a -> Bool) -> [a] -> [a]
mapLast :: (a -> a) -> [a] -> [a]
padLeft :: a -> Int -> [a] -> [a]
padRight :: a -> Int -> [a] -> [a]
reduceRepeatedSlow :: (a -> a -> a) -> a -> a -> Integer -> a
reduceRepeated :: (a -> a -> a) -> a -> a -> Integer -> a
iterateLeaky :: (a -> a -> a) -> a -> [a]
iterateAssoc :: (a -> a -> a) -> a -> [a]
Slice lists
sieve' :: Int -> [a] -> [a]Source

keep every k-th value from the list

Since these implementations check for the end of lists, they may fail in fixpoint computations on infinite lists.

sieve'' :: Int -> [a] -> [a]Source
sieve''' :: Int -> [a] -> [a]Source
sieve :: Int -> [a] -> [a]Source
sliceHoriz' :: Int -> [a] -> [[a]]Source
sliceHoriz :: Int -> [a] -> [[a]]Source
sliceVert' :: Int -> [a] -> [[a]]Source
sliceVert :: Int -> [a] -> [[a]]Source
Use lists as counters
takeMatch :: [b] -> [a] -> [a]Source
Make a list as long as another one
dropMatch :: [b] -> [a] -> [a]Source
splitAtMatch :: [b] -> [a] -> ([a], [a])Source
replicateMatch :: [a] -> b -> [b]Source
compareLength :: [a] -> [b] -> OrderingSource
Compare the length of two lists over different types. For finite lists it is equivalent to (compare (length xs) (length ys)) but more efficient.
Zip lists
zipWithPadSource
::
=> afunction applied to corresponding elements of the lists
-> a -> a -> b
-> [a]
-> [a]
-> [b]
zip two lists using an arbitrary function, the shorter list is padded
zipWithOverlap :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]Source
zipWithMatchSource
::
=> a -> b -> c
-> [a]
-> [b]
-> [c]
Zip two lists which must be of the same length. This is checked only lazily, that is unequal lengths are detected only if the list is evaluated completely. But it is more strict than zipWithPad undefined f since the latter one may succeed on unequal length list if f is lazy.
zipNeighborsWith :: (a -> a -> a) -> [a] -> [a]Source
Lists of lists
shear :: [[a]] -> [[a]]Source

Transform

 [[00,01,02,...],          [[00],
  [10,11,12,...],   -->     [10,01],
  [20,21,22,...],           [20,11,02],
  ...]                      ...]

With concat . shear you can perform a Cantor diagonalization, that is an enumeration of all elements of the sub-lists where each element is reachable within a finite number of steps. It is also useful for polynomial multiplication (convolution).

shearTranspose :: [[a]] -> [[a]]Source

Transform

 [[00,01,02,...],          [[00],
  [10,11,12,...],   -->     [01,10],
  [20,21,22,...],           [02,11,20],
  ...]                      ...]

It's like shear but the order of elements in the sub list is reversed. Its implementation seems to be more efficient than that of shear. If the order does not matter, better choose shearTranspose.

outerProduct :: (a -> b -> c) -> [a] -> [b] -> [[c]]Source
Operate on each combination of elements of the first and the second list. In contrast to the list instance of Monad.liftM2 in holds the results in a list of lists. It holds concat (outerProduct f xs ys) == liftM2 f xs ys
Various
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])Source
splitLast :: [a] -> ([a], a)Source
It holds splitLast xs == (init xs, last xs), but splitLast is more efficient if the last element is accessed after the initial ones, because it avoids memoizing list.
propSplitLast :: Eq a => [a] -> BoolSource
dropWhileRev :: (a -> Bool) -> [a] -> [a]Source
Remove the longest suffix of elements satisfying p. In contrast to 'reverse . dropWhile p . reverse' this works for infinite lists, too.
mapLast :: (a -> a) -> [a] -> [a]Source
Apply a function to the last element of a list. If the list is empty, nothing changes.
padLeft :: a -> Int -> [a] -> [a]Source
padRight :: a -> Int -> [a] -> [a]Source
reduceRepeatedSlow :: (a -> a -> a) -> a -> a -> Integer -> aSource

reduceRepeated is an auxiliary function that, for an associative operation op, computes the same value as

reduceRepeated op a0 a n = foldr op a0 (genericReplicate n a)

but applies op O(log n) times and works for large n.

reduceRepeated :: (a -> a -> a) -> a -> a -> Integer -> aSource
iterateLeaky :: (a -> a -> a) -> a -> [a]Source

For an associative operation op this computes iterateAssoc op a = iterate (op a) a but it is even faster than map (reduceRepeated op a a) [0..] since it shares temporary results.

The idea is: From the list map (reduceRepeated op a a) [0,(2*n)..] we compute the list map (reduceRepeated op a a) [0,n..], and iterate that until n==1.

iterateAssoc :: (a -> a -> a) -> a -> [a]Source
Produced by Haddock version 2.6.0