Copyright | (c) Henning Thielemann 2007-2012 |
---|---|
Maintainer | numericprelude@henning-thielemann.de |
Stability | provisional |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
Lazy Peano numbers represent natural numbers inclusive infinity.
Since they are lazily evaluated,
they are optimally for use as number type of genericLength
et.al.
Synopsis
- data T
- infinity :: T
- err :: String -> String -> a
- add :: T -> T -> T
- sub :: T -> T -> T
- subNeg :: T -> T -> (Bool, T)
- mul :: T -> T -> T
- fromPosEnum :: (C a, Enum a) => a -> T
- toPosEnum :: (C a, Enum a) => T -> a
- ifLazy :: Bool -> T -> T -> T
- argMinFull :: (T, a) -> (T, a) -> (T, a)
- argMin :: (T, a) -> (T, a) -> a
- argMinimum :: [(T, a)] -> a
- argMaxFull :: (T, a) -> (T, a) -> (T, a)
- argMax :: (T, a) -> (T, a) -> a
- argMaximum :: [(T, a)] -> a
- isAscendingFiniteList :: [T] -> Bool
- isAscendingFiniteNumbers :: [T] -> Bool
- toListMaybe :: a -> T -> [Maybe a]
- glue :: T -> T -> (T, (Bool, T))
- isAscending :: [T] -> Bool
- data Valuable a = Valuable {}
- increaseCosts :: T -> Valuable a -> Valuable a
- (&&~) :: Valuable Bool -> Valuable Bool -> Valuable Bool
- andW :: [Valuable Bool] -> Valuable Bool
- leW :: T -> T -> Valuable Bool
- isAscendingW :: [T] -> Valuable Bool
- notImplemented :: String -> a
Documentation
Instances
Bounded T Source # | |
Enum T Source # | |
Eq T Source # | |
Integral T Source # | |
Num T Source # | |
Ord T Source # | |
Read T Source # | |
Real T Source # | |
Defined in Number.Peano toRational :: T -> Rational # | |
Show T Source # | |
Ix T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
C T Source # | |
Defined in Number.Peano toRational :: T -> Rational Source # | |
C T Source # | |
C T Source # | |
ifLazy :: Bool -> T -> T -> T Source #
If all values are completely defined, then it holds
if b then x else y == ifLazy b x y
However if b
is undefined,
then it is at least known that the result is larger than min x y
.
argMinFull :: (T, a) -> (T, a) -> (T, a) Source #
cf. To how to find the shortest list in a list of lists efficiently, this means, also in the presence of infinite lists. http://www.haskell.org/pipermail/haskell-cafe/2006-October/018753.html
argMinimum :: [(T, a)] -> a Source #
argMaximum :: [(T, a)] -> a Source #
isAscendingFiniteList :: [T] -> Bool Source #
x0 <= x1 && x1 <= x2 ...
for possibly infinite numbers in finite lists.
isAscendingFiniteNumbers :: [T] -> Bool Source #
toListMaybe :: a -> T -> [Maybe a] Source #
glue :: T -> T -> (T, (Bool, T)) Source #
In glue x y == (z,(b,r))
z
represents min x y
,
r
represents max x y - min x y
,
and x<=y == b
.
Cf. Numeric.NonNegative.Chunky
isAscending :: [T] -> Bool Source #
Instances
Eq a => Eq (Valuable a) Source # | |
Ord a => Ord (Valuable a) Source # | |
Show a => Show (Valuable a) Source # | |
(&&~) :: Valuable Bool -> Valuable Bool -> Valuable Bool infixr 3 Source #
Compute (&&)
with minimal costs.
notImplemented :: String -> a Source #