Copyright | (c) Ross Paterson 2019 |
---|---|
License | BSD-style |
Maintainer | R.Paterson@city.ac.uk |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
A rational list (a special kind of rational tree) is a list that is
either finite or of the form xs ++ cycle ys
where xs
and ys
are finite lists and ys
is non-empty. (Another name is rho-lists,
after the Greek letter ρ whose shape suggests cyclic repetition
after some prefix.) Such lists have a useful finite representation.
Many functions in this module have the same names as functions in the Prelude, Data.Foldable and Data.List. On finite lists, these functions have the same behaviour as their list counterparts. Due to the finite representation, they are also total, even on infinite lists. Many operations on infinite lists are also substantially faster than using lists, because they exploit the repetition. For example:
>>>
num_list = iterate (\n -> (n*n + 1) `mod` 100) 19
>>>
num_list
fromList [19,62,45] <> cycle [26,77,30,1,2,5]>>>
toList num_list
[19,62,45,26,77,30,1,2,5,26,77,30,1,2,5,26,77,30,1,2,5,26,77,30,...>>>
maximum num_list
77>>>
elementAt 2000000000000000000 num_list
Just 5
Synopsis
- data RationalList a
- fromList :: [a] -> RationalList a
- repeat :: a -> RationalList a
- cycle :: Eq a => [a] -> RationalList a
- iterate :: Eq a => (a -> a) -> a -> RationalList a
- unfoldr :: (Eq a, Eq b) => (b -> Maybe (a, b)) -> b -> RationalList a
- prefix :: RationalList a -> [a]
- repetend :: RationalList a -> [a]
- map :: Eq b => (a -> b) -> RationalList a -> RationalList b
- concat :: Eq a => RationalList (RationalList a) -> RationalList a
- concatMap :: Eq b => (a -> RationalList b) -> RationalList a -> RationalList b
- zip :: RationalList a -> RationalList b -> RationalList (a, b)
- zipWith :: Eq c => (a -> b -> c) -> RationalList a -> RationalList b -> RationalList c
- unzip :: (Eq a, Eq b) => RationalList (a, b) -> (RationalList a, RationalList b)
- filter :: Eq a => (a -> Bool) -> RationalList a -> RationalList a
- partition :: Eq a => (a -> Bool) -> RationalList a -> (RationalList a, RationalList a)
- takeWhile :: Eq a => (a -> Bool) -> RationalList a -> RationalList a
- dropWhile :: Eq a => (a -> Bool) -> RationalList a -> RationalList a
- span :: Eq a => (a -> Bool) -> RationalList a -> (RationalList a, RationalList a)
- take :: Integral i => i -> RationalList a -> [a]
- drop :: (Integral i, Eq a) => i -> RationalList a -> RationalList a
- splitAt :: (Integral i, Eq a) => i -> RationalList a -> ([a], RationalList a)
- tails :: RationalList a -> RationalList (RationalList a)
- finite :: RationalList a -> Bool
- elementAt :: Integral i => i -> RationalList a -> Maybe a
- elemIndex :: Eq a => a -> RationalList a -> Maybe Int
- find :: (a -> Bool) -> RationalList a -> Maybe a
- findIndex :: (a -> Bool) -> RationalList a -> Maybe Int
- any :: (a -> Bool) -> RationalList a -> Bool
- all :: (a -> Bool) -> RationalList a -> Bool
- maximumBy :: (a -> a -> Ordering) -> RationalList a -> a
- minimumBy :: (a -> a -> Ordering) -> RationalList a -> a
- foldMapTake :: (Integral i, Monoid m) => (a -> m) -> i -> RationalList a -> m
Documentation
data RationalList a Source #
Instances
Construction
fromList :: [a] -> RationalList a Source #
is a representation of the list fromList
xsxs
, which must
be finite.
repeat :: a -> RationalList a Source #
is the infinite repetition of a single value.repeat
x
cycle :: Eq a => [a] -> RationalList a Source #
is the infinite repetition of the list cycle
xsxs
, which
must be finite.
iterate :: Eq a => (a -> a) -> a -> RationalList a Source #
is an infinite list of repeated applications of iterate
f xf
to x
, provided an earlier value is repeated at some point.
If no repetition occurs, the computation does not terminate.
unfoldr :: (Eq a, Eq b) => (b -> Maybe (a, b)) -> b -> RationalList a Source #
is a list built from a seed value unfoldr
f zz
. The function
f
takes a seed value and returns Nothing
if it is done producing
the list or returns
, in which case, Just
(a,b)a
is a prepended
to the list and b
is used as the next seed value in a recursive call.
This will not terminate unless one of these evaluations of f
returns
Nothing
or
where Just
(a,b)b
is a previously seen value.
Components
Any rational list xs
satisfies
fromList (prefix xs) <> cycle (repetend xs) = xs
prefix :: RationalList a -> [a] Source #
is the minimal non-repeating part at the front of prefix
xsxs
.
repetend :: RationalList a -> [a] Source #
is the minimal repeating part of repetend
xsxs
, or []
if xs
is finite.
Modification
map :: Eq b => (a -> b) -> RationalList a -> RationalList b Source #
is the list obtained by applying map
f xsf
to each element of xs
.
concat :: Eq a => RationalList (RationalList a) -> RationalList a Source #
is the concatenation of all the lists in concat
xssxss
.
concatMap :: Eq b => (a -> RationalList b) -> RationalList a -> RationalList b Source #
is the concatenation of mapping concatMap
f xsf
over the
elements of xs
.
concatMap f xs = concat (map f xs)
zip :: RationalList a -> RationalList b -> RationalList (a, b) Source #
is a list of corresponding pairs in zip
xs ysxs
and ys
.
If one input list is shorter, unmatched elements of the longer list
are not included.
zipWith :: Eq c => (a -> b -> c) -> RationalList a -> RationalList b -> RationalList c Source #
is a list of zipWith
f xs ysf
applied to corresponding
elements from xs
and ys
.
If one input list is shorter, unmatched elements of the longer list
are not included.
unzip :: (Eq a, Eq b) => RationalList (a, b) -> (RationalList a, RationalList b) Source #
in a pair of the list of first components of unzip
xysxys
and the list of second components.
Sublists
filter :: Eq a => (a -> Bool) -> RationalList a -> RationalList a Source #
partition :: Eq a => (a -> Bool) -> RationalList a -> (RationalList a, RationalList a) Source #
takeWhile :: Eq a => (a -> Bool) -> RationalList a -> RationalList a Source #
is the longest prefix (possibly empty) of takeWhile
p xsxs
of elements that satisfy p
.
dropWhile :: Eq a => (a -> Bool) -> RationalList a -> RationalList a Source #
is the remainder of the list after the longest
prefix (possibly empty) of dropWhile
p xsxs
of elements that satisfy p
.
If no element satisfies p
, the result is an empty list.
span :: Eq a => (a -> Bool) -> RationalList a -> (RationalList a, RationalList a) Source #
is a pair whose first element is the longest prefix
(possibly empty) of span
p xsxs
of elements that satisfy p
and whose second
element is the remainder of the list.
If no element satisfies p
, the first list is xs
and the second
is empty.
take :: Integral i => i -> RationalList a -> [a] Source #
drop :: (Integral i, Eq a) => i -> RationalList a -> RationalList a Source #
splitAt :: (Integral i, Eq a) => i -> RationalList a -> ([a], RationalList a) Source #
is a pair whose first element is the prefix of splitAt
n xsxs
of length n
and whose second element is the remainder of the list.
tails :: RationalList a -> RationalList (RationalList a) Source #
is the list of final segments of tails
xsxs
, longest first.
Queries
These are similar to list functions, but take advantage of
repetition for efficiency and to work even with infinite lists.
Several more are provided by the Foldable
instance.
maximumBy :: (a -> a -> Ordering) -> RationalList a -> a Source #
is the greatest element of maximumBy
cmp xsxs
(which must
be non-empty) with respect to the comparison function cmp
.
minimumBy :: (a -> a -> Ordering) -> RationalList a -> a Source #
is the least element of minimumBy
cmp xsxs
(which must be
non-empty) with respect to the comparison function cmp
.
foldMapTake :: (Integral i, Monoid m) => (a -> m) -> i -> RationalList a -> m Source #
applies foldMapTake
f n xsf
to the first n
elements of xs
and combines the results:
foldMapTake f n = foldMap f . take n
but may be significantly faster for some monoids.
Examples
Decimal fractions
The following function takes a number 0 <= x < 1
and returns the leading
digit of its decimal representation, as well as the residue:
digit :: Rational -> Maybe (Int, Rational) digit x | x == 0 = Nothing | otherwise = Just (properFraction (x * 10))
Unfolding with this function gives decimal representations of fractions:
>>>
Data.List.unfoldr digit (3/8)
[3,7,5]
>>>
Data.List.unfoldr digit (3/28)
[1,0,7,1,4,2,8,5,7,1,4,2,8,5,7,1,4,2,8,5,7,1,4,2,8,5,7,1,4,2,...
The latter infinite list repeats the subsequence 7,1,4,2,8,5
indefinitely.
The rational list version of unfoldr
detects the repetition and yields a
finite representation:
>>>
unfoldr digit (3/8)
fromList [3,7,5]
>>>
unfoldr digit (3/28)
fromList [1,0] <> cycle [7,1,4,2,8,5]
With this representation, several list functions can be implemented more efficiently, e.g.
>>>
elementAt 1000000000 $ unfoldr digit (3/28)
Just 4
while others terminate even for infinite lists:
>>>
elem 3 $ unfoldr digit (3/28)
False
Fibonacci numbers
Puzzle: what is the last digit of the 1000000000th Fibonacci number? (where the first and second Fibonacci numbers are both 1.)
The infinite list of Fibonacci numbers can be defined as
>>>
Data.List.map fst $ Data.List.iterate (\ (a,b) -> (b,(a+b))) (0,1)
[0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,...
However, we only need the last digit of each number, so we can replace
a+b
with (a+b) `mod` 10
. Then the list of pairs must repeat, since
there are a finite number of possible combinations, so it can be represented
as a rational list, and the solution is
>>>
elementAt 1000000000 $ map fst $ iterate (\ (a,b) -> (b, (a+b) `mod` 10)) (0,1)
Just 5
Here elementAt
calculates the appropriate position in the repeating part
of the list and returns that, without calculating lots of numbers.