{-# LANGUAGE RebindableSyntax #-}
{- |
Copyright    :   (c) Henning Thielemann 2007-2012
Maintainer   :   numericprelude@henning-thielemann.de
Stability    :   provisional
Portability  :   portable

Lazy Peano numbers represent natural numbers inclusive infinity.
Since they are lazily evaluated,
they are optimally for use as number type of 'Data.List.genericLength' et.al.
-}
module Number.Peano where

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Units                as Units
import qualified Algebra.RealIntegral         as RealIntegral
import qualified Algebra.IntegralDomain       as Integral
import qualified Algebra.Absolute             as Absolute
import qualified Algebra.Ring                 as Ring
import qualified Algebra.Additive             as Additive
import qualified Algebra.ZeroTestable         as ZeroTestable
import qualified Algebra.Indexable            as Indexable
import qualified Algebra.Monoid               as Monoid

import qualified Algebra.ToInteger            as ToInteger
import qualified Algebra.ToRational           as ToRational
import qualified Algebra.NonNegative          as NonNeg

import qualified Algebra.EqualityDecision as EqDec
import qualified Algebra.OrderDecision    as OrdDec

import Data.Maybe (catMaybes, )
import Data.Array(Ix(..))

import Data.List.HT (mapAdjacent, shearTranspose, )
import Data.Tuple.HT (mapFst, )

import qualified Prelude as P98
import NumericPrelude.Base
import NumericPrelude.Numeric


data T = Zero
       | Succ T
   deriving (Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show, ReadPrec [T]
ReadPrec T
Int -> ReadS T
ReadS [T]
(Int -> ReadS T)
-> ReadS [T] -> ReadPrec T -> ReadPrec [T] -> Read T
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [T]
$creadListPrec :: ReadPrec [T]
readPrec :: ReadPrec T
$creadPrec :: ReadPrec T
readList :: ReadS [T]
$creadList :: ReadS [T]
readsPrec :: Int -> ReadS T
$creadsPrec :: Int -> ReadS T
Read, T -> T -> Bool
(T -> T -> Bool) -> (T -> T -> Bool) -> Eq T
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq)

infinity :: T
infinity :: T
infinity = T -> T
Succ T
infinity

err :: String -> String -> a
err :: String -> String -> a
err String
func String
msg = String -> a
forall a. HasCallStack => String -> a
error (String
"Number.Peano."String -> ShowS
forall a. [a] -> [a] -> [a]
++String
funcString -> ShowS
forall a. [a] -> [a] -> [a]
++String
": "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg)


instance ZeroTestable.C T where
   isZero :: T -> Bool
isZero T
Zero     = Bool
True
   isZero (Succ T
_) = Bool
False

add :: T -> T -> T
add :: T -> T -> T
add T
Zero T
y = T
y
add (Succ T
x) T
y = T -> T
Succ (T -> T -> T
add T
x T
y)

sub :: T -> T -> T
sub :: T -> T -> T
sub T
x T
y =
   let (Bool
sign,T
z) = T -> T -> (Bool, T)
subNeg T
y T
x
   in  if Bool
sign
         then String -> String -> T
forall a. String -> String -> a
err String
"sub" String
"negative difference"
         else T
z

subNeg :: T -> T -> (Bool, T)
subNeg :: T -> T -> (Bool, T)
subNeg T
Zero T
y = (Bool
False, T
y)
subNeg T
x T
Zero = (Bool
True,  T
x)
subNeg (Succ T
x) (Succ T
y) = T -> T -> (Bool, T)
subNeg T
x T
y


mul :: T -> T -> T
mul :: T -> T -> T
mul T
Zero T
_ = T
Zero
mul T
_ T
Zero = T
Zero
mul (Succ T
x) T
y = T -> T -> T
add T
y (T -> T -> T
mul T
x T
y)

fromPosEnum :: (ZeroTestable.C a, Enum a) => a -> T
fromPosEnum :: a -> T
fromPosEnum a
n =
   if a -> Bool
forall a. C a => a -> Bool
isZero a
n
      then T
Zero
      else T -> T
Succ (a -> T
forall a. (C a, Enum a) => a -> T
fromPosEnum (a -> a
forall a. Enum a => a -> a
pred a
n))

toPosEnum :: (Additive.C a, Enum a) => T -> a
toPosEnum :: T -> a
toPosEnum T
Zero = a
forall a. C a => a
zero
toPosEnum (Succ T
x) = a -> a
forall a. Enum a => a -> a
succ (T -> a
forall a. (C a, Enum a) => T -> a
toPosEnum T
x)

instance Additive.C T where
   zero :: T
zero = T
Zero
   + :: T -> T -> T
(+) = T -> T -> T
add
   (-) = T -> T -> T
sub
   negate :: T -> T
negate T
Zero     = T
Zero
   negate (Succ T
_) = String -> String -> T
forall a. String -> String -> a
err String
"negate" String
"cannot negate positive number"

instance Ring.C T where
   one :: T
one = T -> T
Succ T
Zero
   * :: T -> T -> T
(*) = T -> T -> T
mul
   fromInteger :: Integer -> T
fromInteger Integer
n =
      if Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
0
        then String -> String -> T
forall a. String -> String -> a
err String
"fromInteger" String
"Peano numbers are always non-negative"
        else Integer -> T
forall a. (C a, Enum a) => a -> T
fromPosEnum Integer
n

instance Enum T where
   pred :: T -> T
pred T
Zero = String -> String -> T
forall a. String -> String -> a
err String
"pred" String
"Zero has no predecessor"
   pred (Succ T
x) = T
x
   succ :: T -> T
succ = T -> T
Succ
   toEnum :: Int -> T
toEnum Int
n =
      if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
        then String -> String -> T
forall a. String -> String -> a
err String
"toEnum" String
"Peano numbers are always non-negative"
        else Int -> T
forall a. (C a, Enum a) => a -> T
fromPosEnum Int
n
   fromEnum :: T -> Int
fromEnum = T -> Int
forall a. (C a, Enum a) => T -> a
toPosEnum
   enumFrom :: T -> [T]
enumFrom T
x = (T -> T) -> T -> [T]
forall a. (a -> a) -> a -> [a]
iterate T -> T
Succ T
x
   enumFromThen :: T -> T -> [T]
enumFromThen T
x T
y =
      let (Bool
sign,T
d) = T -> T -> (Bool, T)
subNeg T
x T
y
      in  if Bool
sign
            then (T -> T) -> T -> [T]
forall a. (a -> a) -> a -> [a]
iterate (T -> T -> T
sub T
d) T
x
            else (T -> T) -> T -> [T]
forall a. (a -> a) -> a -> [a]
iterate (T -> T -> T
add T
d) T
x
   {-
   enumFromTo =
   enumFromThenTo =
   -}


{- |
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@.
-}
ifLazy :: Bool -> T -> T -> T
ifLazy :: Bool -> T -> T -> T
ifLazy Bool
b (Succ T
x) (Succ T
y) = T -> T
Succ (Bool -> T -> T -> T
ifLazy Bool
b T
x T
y)
ifLazy Bool
b T
x T
y = if Bool
b then T
x else T
y

instance EqDec.C T where
   ==? :: T -> T -> T -> T -> T
(==?) T
x T
y = Bool -> T -> T -> T
ifLazy (T
xT -> T -> Bool
forall a. Eq a => a -> a -> Bool
==T
y)

instance OrdDec.C T where
   <=? :: T -> T -> T -> T -> T
(<=?) T
x T
y T
le T
gt = Bool -> T -> T -> T
ifLazy (T
xT -> T -> Bool
forall a. Ord a => a -> a -> Bool
<=T
y) T
le T
gt

{-
The default instance is good for compare,
but fails for min and max.
-}
instance Ord T where
   compare :: T -> T -> Ordering
compare (Succ T
x) (Succ T
y) = T -> T -> Ordering
forall a. Ord a => a -> a -> Ordering
compare T
x T
y
   compare T
Zero     (Succ T
_) = Ordering
LT
   compare (Succ T
_) T
Zero     = Ordering
GT
   compare T
Zero     T
Zero     = Ordering
EQ

   min :: T -> T -> T
min (Succ T
x) (Succ T
y) = T -> T
Succ (T -> T -> T
forall a. Ord a => a -> a -> a
min T
x T
y)
   min T
_        T
_        = T
Zero

   max :: T -> T -> T
max (Succ T
x) (Succ T
y) = T -> T
Succ (T -> T -> T
forall a. Ord a => a -> a -> a
max T
x T
y)
   max T
Zero     T
y        = T
y
   max T
x        T
Zero     = T
x

   {-
   This special implementation works also for undefined < Zero.
   Thanks to Peter Divianszky for the hint.
   -}
   T
_      < :: T -> T -> Bool
< T
Zero   = Bool
False
   T
Zero   < T
_      = Bool
True
   Succ T
n < Succ T
m = T
n T -> T -> Bool
forall a. Ord a => a -> a -> Bool
< T
m

   T
x > :: T -> T -> Bool
> T
y  = T
y T -> T -> Bool
forall a. Ord a => a -> a -> Bool
< T
x

   T
x <= :: T -> T -> Bool
<= T
y = Bool -> Bool
not (T
y T -> T -> Bool
forall a. Ord a => a -> a -> Bool
< T
x)

   T
x >= :: T -> T -> Bool
>= T
y = Bool -> Bool
not (T
x T -> T -> Bool
forall a. Ord a => a -> a -> Bool
< T
y)


{- | 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>
-}
argMinFull :: (T,a) -> (T,a) -> (T,a)
argMinFull :: (T, a) -> (T, a) -> (T, a)
argMinFull (T
x0,a
xv) (T
y0,a
yv) =
   let recourse :: T -> T -> (T, a)
recourse (Succ T
x) (Succ T
y) =
          let (T
z,a
zv) = T -> T -> (T, a)
recourse T
x T
y
          in  (T -> T
Succ T
z, a
zv)
       recourse T
Zero T
_ = (T
Zero,a
xv)
       recourse T
_    T
_ = (T
Zero,a
yv)
   in  T -> T -> (T, a)
recourse T
x0 T
y0

{- |
On equality the first operand is returned.
-}
argMin :: (T,a) -> (T,a) -> a
argMin :: (T, a) -> (T, a) -> a
argMin (T, a)
x (T, a)
y = (T, a) -> a
forall a b. (a, b) -> b
snd ((T, a) -> a) -> (T, a) -> a
forall a b. (a -> b) -> a -> b
$ (T, a) -> (T, a) -> (T, a)
forall a. (T, a) -> (T, a) -> (T, a)
argMinFull (T, a)
x (T, a)
y

argMinimum :: [(T,a)] -> a
argMinimum :: [(T, a)] -> a
argMinimum = (T, a) -> a
forall a b. (a, b) -> b
snd ((T, a) -> a) -> ([(T, a)] -> (T, a)) -> [(T, a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((T, a) -> (T, a) -> (T, a)) -> [(T, a)] -> (T, a)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (T, a) -> (T, a) -> (T, a)
forall a. (T, a) -> (T, a) -> (T, a)
argMinFull


argMaxFull :: (T,a) -> (T,a) -> (T,a)
argMaxFull :: (T, a) -> (T, a) -> (T, a)
argMaxFull (T
x0,a
xv) (T
y0,a
yv) =
   let recourse :: T -> T -> (T, a)
recourse (Succ T
x) (Succ T
y) =
          let (T
z,a
zv) = T -> T -> (T, a)
recourse T
x T
y
          in  (T -> T
Succ T
z, a
zv)
       recourse T
x T
Zero = (T
x,a
xv)
       recourse T
_ T
y    = (T
y,a
yv)
   in  T -> T -> (T, a)
recourse T
x0 T
y0

{- |
On equality the first operand is returned.
-}
argMax :: (T,a) -> (T,a) -> a
argMax :: (T, a) -> (T, a) -> a
argMax (T, a)
x (T, a)
y = (T, a) -> a
forall a b. (a, b) -> b
snd ((T, a) -> a) -> (T, a) -> a
forall a b. (a -> b) -> a -> b
$ (T, a) -> (T, a) -> (T, a)
forall a. (T, a) -> (T, a) -> (T, a)
argMaxFull (T, a)
x (T, a)
y

argMaximum :: [(T,a)] -> a
argMaximum :: [(T, a)] -> a
argMaximum = (T, a) -> a
forall a b. (a, b) -> b
snd ((T, a) -> a) -> ([(T, a)] -> (T, a)) -> [(T, a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((T, a) -> (T, a) -> (T, a)) -> [(T, a)] -> (T, a)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (T, a) -> (T, a) -> (T, a)
forall a. (T, a) -> (T, a) -> (T, a)
argMaxFull



-- isAscending - naive implementations

{- |
@x0 <= x1 && x1 <= x2 ... @
for possibly infinite numbers in finite lists.
-}
isAscendingFiniteList :: [T] -> Bool
isAscendingFiniteList :: [T] -> Bool
isAscendingFiniteList [] = Bool
True
isAscendingFiniteList (T
x:[T]
xs) =
   let decrement :: T -> Maybe T
decrement (Succ T
y) = T -> Maybe T
forall a. a -> Maybe a
Just T
y
       decrement T
_ = Maybe T
forall a. Maybe a
Nothing
   in  case T
x of
         T
Zero -> [T] -> Bool
isAscendingFiniteList [T]
xs
         Succ T
xd ->
           case (T -> Maybe T) -> [T] -> Maybe [T]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM T -> Maybe T
decrement [T]
xs of
             Maybe [T]
Nothing -> Bool
False
             Just [T]
xsd -> [T] -> Bool
isAscendingFiniteList (T
xd T -> [T] -> [T]
forall a. a -> [a] -> [a]
: [T]
xsd)

isAscendingFiniteNumbers :: [T] -> Bool
isAscendingFiniteNumbers :: [T] -> Bool
isAscendingFiniteNumbers = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([T] -> [Bool]) -> [T] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T -> T -> Bool) -> [T] -> [Bool]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent T -> T -> Bool
forall a. Ord a => a -> a -> Bool
(<=)


-- isAscending - sophisticated implementations - explicit

toListMaybe :: a -> T -> [Maybe a]
toListMaybe :: a -> T -> [Maybe a]
toListMaybe a
a =
   let recourse :: T -> [Maybe a]
recourse T
Zero     = [a -> Maybe a
forall a. a -> Maybe a
Just a
a]
       recourse (Succ T
x) = Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: T -> [Maybe a]
recourse T
x
   in  T -> [Maybe a]
recourse

{- |
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
-}
glue :: T -> T -> (T, (Bool, T))
glue :: T -> T -> (T, (Bool, T))
glue T
Zero T
ys = (T
Zero, (Bool
True, T
ys))
glue T
xs T
Zero = (T
Zero, (Bool
False, T
xs))
glue (Succ T
xs) (Succ T
ys) =
   (T -> T) -> (T, (Bool, T)) -> (T, (Bool, T))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst T -> T
Succ ((T, (Bool, T)) -> (T, (Bool, T)))
-> (T, (Bool, T)) -> (T, (Bool, T))
forall a b. (a -> b) -> a -> b
$ T -> T -> (T, (Bool, T))
glue T
xs T
ys

{-
Implementation notes:
We check all pairs of adjacent numbers for correct order.
We obtain a set of booleans, which must all be True.
The order of checking these booleans is crucial.
Pairs of numbers that are infinitely big or infinitely far in the list
must be checked \"last\".
Thus we order the booleans according to their computation costs
(list position + magnitude of number)
using 'shearTranspose'.
-}
isAscending :: [T] -> Bool
isAscending :: [T] -> Bool
isAscending =
   [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([T] -> [Bool]) -> [T] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Bool] -> [Bool]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Bool] -> [Bool]) -> ([T] -> [Maybe Bool]) -> [T] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe Bool]] -> [Maybe Bool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe Bool]] -> [Maybe Bool])
-> ([T] -> [[Maybe Bool]]) -> [T] -> [Maybe Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [[Maybe Bool]] -> [[Maybe Bool]]
forall a. [[a]] -> [[a]]
shearTranspose ([[Maybe Bool]] -> [[Maybe Bool]])
-> ([T] -> [[Maybe Bool]]) -> [T] -> [[Maybe Bool]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T -> T -> [Maybe Bool]) -> [T] -> [[Maybe Bool]]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (\T
x T
y ->
      let (T
costs0,(Bool
le,T
_)) = T -> T -> (T, (Bool, T))
glue T
x T
y
      in  Bool -> T -> [Maybe Bool]
forall a. a -> T -> [Maybe a]
toListMaybe Bool
le T
costs0)


-- isAscending - use a cost measuring data type (could generalized to a monad, when considered as Writer monad, see htam and unique-logic packages

-- following an idea of vixy http://moonpatio.com:8080/fastcgi/hpaste.fcgi/view?id=562

data Valuable a = Valuable {Valuable a -> T
costs :: T, Valuable a -> a
value :: a}
   deriving (Int -> Valuable a -> ShowS
[Valuable a] -> ShowS
Valuable a -> String
(Int -> Valuable a -> ShowS)
-> (Valuable a -> String)
-> ([Valuable a] -> ShowS)
-> Show (Valuable a)
forall a. Show a => Int -> Valuable a -> ShowS
forall a. Show a => [Valuable a] -> ShowS
forall a. Show a => Valuable a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Valuable a] -> ShowS
$cshowList :: forall a. Show a => [Valuable a] -> ShowS
show :: Valuable a -> String
$cshow :: forall a. Show a => Valuable a -> String
showsPrec :: Int -> Valuable a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Valuable a -> ShowS
Show, Valuable a -> Valuable a -> Bool
(Valuable a -> Valuable a -> Bool)
-> (Valuable a -> Valuable a -> Bool) -> Eq (Valuable a)
forall a. Eq a => Valuable a -> Valuable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Valuable a -> Valuable a -> Bool
$c/= :: forall a. Eq a => Valuable a -> Valuable a -> Bool
== :: Valuable a -> Valuable a -> Bool
$c== :: forall a. Eq a => Valuable a -> Valuable a -> Bool
Eq, Eq (Valuable a)
Eq (Valuable a)
-> (Valuable a -> Valuable a -> Ordering)
-> (Valuable a -> Valuable a -> Bool)
-> (Valuable a -> Valuable a -> Bool)
-> (Valuable a -> Valuable a -> Bool)
-> (Valuable a -> Valuable a -> Bool)
-> (Valuable a -> Valuable a -> Valuable a)
-> (Valuable a -> Valuable a -> Valuable a)
-> Ord (Valuable a)
Valuable a -> Valuable a -> Bool
Valuable a -> Valuable a -> Ordering
Valuable a -> Valuable a -> Valuable a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Valuable a)
forall a. Ord a => Valuable a -> Valuable a -> Bool
forall a. Ord a => Valuable a -> Valuable a -> Ordering
forall a. Ord a => Valuable a -> Valuable a -> Valuable a
min :: Valuable a -> Valuable a -> Valuable a
$cmin :: forall a. Ord a => Valuable a -> Valuable a -> Valuable a
max :: Valuable a -> Valuable a -> Valuable a
$cmax :: forall a. Ord a => Valuable a -> Valuable a -> Valuable a
>= :: Valuable a -> Valuable a -> Bool
$c>= :: forall a. Ord a => Valuable a -> Valuable a -> Bool
> :: Valuable a -> Valuable a -> Bool
$c> :: forall a. Ord a => Valuable a -> Valuable a -> Bool
<= :: Valuable a -> Valuable a -> Bool
$c<= :: forall a. Ord a => Valuable a -> Valuable a -> Bool
< :: Valuable a -> Valuable a -> Bool
$c< :: forall a. Ord a => Valuable a -> Valuable a -> Bool
compare :: Valuable a -> Valuable a -> Ordering
$ccompare :: forall a. Ord a => Valuable a -> Valuable a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Valuable a)
Ord)


increaseCosts :: T -> Valuable a -> Valuable a
increaseCosts :: T -> Valuable a -> Valuable a
increaseCosts T
inc ~(Valuable T
c a
x) = T -> a -> Valuable a
forall a. T -> a -> Valuable a
Valuable (T
incT -> T -> T
forall a. C a => a -> a -> a
+T
c) a
x

{- |
Compute '(&&)' with minimal costs.
-}
infixr 3 &&~
(&&~) :: Valuable Bool -> Valuable Bool -> Valuable Bool
&&~ :: Valuable Bool -> Valuable Bool -> Valuable Bool
(&&~) (Valuable T
xc Bool
xb) (Valuable T
yc Bool
yb) =
   let (T
minc,~(Bool
le,T
difc)) = T -> T -> (T, (Bool, T))
glue T
xc T
yc
       (Bool
bCheap,Bool
bExpensive) =
          if Bool
le
            then (Bool
xb,Bool
yb)
            else (Bool
yb,Bool
xb)
   in  T -> Valuable Bool -> Valuable Bool
forall a. T -> Valuable a -> Valuable a
increaseCosts T
minc (Valuable Bool -> Valuable Bool) -> Valuable Bool -> Valuable Bool
forall a b. (a -> b) -> a -> b
$
       (T -> Bool -> Valuable Bool) -> (T, Bool) -> Valuable Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T -> Bool -> Valuable Bool
forall a. T -> a -> Valuable a
Valuable ((T, Bool) -> Valuable Bool) -> (T, Bool) -> Valuable Bool
forall a b. (a -> b) -> a -> b
$
       if Bool
bCheap
         then (T
difc, Bool
bExpensive)
         else (T
Zero, Bool
False)

andW :: [Valuable Bool] -> Valuable Bool
andW :: [Valuable Bool] -> Valuable Bool
andW =
   (Valuable Bool -> Valuable Bool -> Valuable Bool)
-> Valuable Bool -> [Valuable Bool] -> Valuable Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\Valuable Bool
b Valuable Bool
acc -> Valuable Bool
b Valuable Bool -> Valuable Bool -> Valuable Bool
&&~ T -> Valuable Bool -> Valuable Bool
forall a. T -> Valuable a -> Valuable a
increaseCosts T
forall a. C a => a
one Valuable Bool
acc)
      (T -> Bool -> Valuable Bool
forall a. T -> a -> Valuable a
Valuable T
Zero Bool
True)

leW :: T -> T -> Valuable Bool
leW :: T -> T -> Valuable Bool
leW T
x T
y =
   let (T
minc,~(Bool
le,T
_difc)) = T -> T -> (T, (Bool, T))
glue T
x T
y
   in  T -> Bool -> Valuable Bool
forall a. T -> a -> Valuable a
Valuable T
minc Bool
le

isAscendingW :: [T] -> Valuable Bool
isAscendingW :: [T] -> Valuable Bool
isAscendingW =
   [Valuable Bool] -> Valuable Bool
andW ([Valuable Bool] -> Valuable Bool)
-> ([T] -> [Valuable Bool]) -> [T] -> Valuable Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T -> T -> Valuable Bool) -> [T] -> [Valuable Bool]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent T -> T -> Valuable Bool
leW

{-
test with

*Number.Peano> isAscendingW [0,infinity,infinity,5]
False
-}


-- instances

instance Absolute.C T where
   signum :: T -> T
signum T
Zero     = T
forall a. C a => a
zero
   signum (Succ T
_) = T
forall a. C a => a
one
   abs :: T -> T
abs             = T -> T
forall a. a -> a
id

instance ToInteger.C T where
   toInteger :: T -> Integer
toInteger = T -> Integer
forall a. (C a, Enum a) => T -> a
toPosEnum

instance ToRational.C T where
   toRational :: T -> Rational
toRational = Integer -> Rational
forall a. C a => a -> Rational
toRational (Integer -> Rational) -> (T -> Integer) -> T -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Integer
forall a. C a => a -> Integer
toInteger

instance RealIntegral.C T where
   quot :: T -> T -> T
quot = T -> T -> T
forall a. C a => a -> a -> a
div
   rem :: T -> T -> T
rem  = T -> T -> T
forall a. C a => a -> a -> a
mod
   quotRem :: T -> T -> (T, T)
quotRem = T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod

instance Integral.C T where
   div :: T -> T -> T
div T
x T
y = (T, T) -> T
forall a b. (a, b) -> a
fst (T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod T
x T
y)
   mod :: T -> T -> T
mod T
x T
y = (T, T) -> T
forall a b. (a, b) -> b
snd (T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod T
x T
y)
   divMod :: T -> T -> (T, T)
divMod T
x T
y =
      let (Bool
isNeg,T
d) = T -> T -> (Bool, T)
subNeg T
y T
x
      in  if Bool
isNeg
            then (T
forall a. C a => a
zero,T
x)
            else let (T
q,T
r) = T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod T
d T
y in (T -> T
forall a. Enum a => a -> a
succ T
q,T
r)

instance Monoid.C T where
   idt :: T
idt = T
forall a. C a => a
zero
   <*> :: T -> T -> T
(<*>) = T -> T -> T
add
   cumulate :: [T] -> T
cumulate = (T -> T -> T) -> T -> [T] -> T
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr T -> T -> T
add T
Zero

instance NonNeg.C T where
   split :: T -> T -> (T, (Bool, T))
split = T -> T -> (T, (Bool, T))
glue

instance Ix T where
   range :: (T, T) -> [T]
range = (T -> T -> [T]) -> (T, T) -> [T]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T -> T -> [T]
forall a. Enum a => a -> a -> [a]
enumFromTo
   index :: (T, T) -> T -> Int
index (T
lower,T
_) T
i =
      let (Bool
sign,T
offset) = T -> T -> (Bool, T)
subNeg T
lower T
i
      in  if Bool
sign
            then String -> String -> Int
forall a. String -> String -> a
err String
"index" String
"index out of range"
            else T -> Int
forall a. (C a, Enum a) => T -> a
toPosEnum T
offset
   inRange :: (T, T) -> T -> Bool
inRange (T
lower,T
upper) T
i =
      [T] -> Bool
isAscending [T
lower, T
i, T
upper]
   rangeSize :: (T, T) -> Int
rangeSize (T
lower,T
upper) =
      T -> Int
forall a. (C a, Enum a) => T -> a
toPosEnum (T -> T -> T
sub T
lower (T -> T
forall a. Enum a => a -> a
succ T
upper))

instance Indexable.C T where
   compare :: T -> T -> Ordering
compare = T -> T -> Ordering
forall a. Ord a => a -> a -> Ordering
Indexable.ordCompare

instance Units.C T where
   isUnit :: T -> Bool
isUnit T
x  =  T
x T -> T -> Bool
forall a. Eq a => a -> a -> Bool
== T
forall a. C a => a
one
   stdAssociate :: T -> T
stdAssociate  =  T -> T
forall a. a -> a
id
   stdUnit :: T -> T
stdUnit    T
_ = T
forall a. C a => a
one
   stdUnitInv :: T -> T
stdUnitInv T
_ = T
forall a. C a => a
one

instance PID.C T where
   gcd :: T -> T -> T
gcd = (T -> T -> T) -> T -> T -> T
forall a. (C a, C a) => (a -> a -> a) -> a -> a -> a
PID.euclid T -> T -> T
forall a. C a => a -> a -> a
mod
   extendedGCD :: T -> T -> (T, (T, T))
extendedGCD = (T -> T -> (T, T)) -> T -> T -> (T, (T, T))
forall a. (C a, C a) => (a -> a -> (a, a)) -> a -> a -> (a, (a, a))
PID.extendedEuclid T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod

instance Bounded T where
   minBound :: T
minBound = T
Zero
   maxBound :: T
maxBound = T
infinity



{-# INLINE notImplemented #-}
notImplemented :: String -> a
notImplemented :: String -> a
notImplemented String
name =
   String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Number.Peano: method " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot be implemented"

instance P98.Num T where
   fromInteger :: Integer -> T
fromInteger = Integer -> T
forall a. C a => Integer -> a
Ring.fromInteger
   negate :: T -> T
negate = T -> T
forall a. C a => a -> a
Additive.negate -- for unary minus
   + :: T -> T -> T
(+) = T -> T -> T
add
   (-) = T -> T -> T
sub
   * :: T -> T -> T
(*) = T -> T -> T
mul
   abs :: T -> T
abs    = String -> T -> T
forall a. String -> a
notImplemented String
"abs"
   signum :: T -> T
signum = String -> T -> T
forall a. String -> a
notImplemented String
"signum"

-- for use with genericLength et.al.
instance P98.Real T where
   toRational :: T -> Rational
toRational = Integer -> Rational
forall a. Real a => a -> Rational
P98.toRational (Integer -> Rational) -> (T -> Integer) -> T -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Integer
forall a. C a => a -> Integer
toInteger

instance P98.Integral T where
   rem :: T -> T -> T
rem  = T -> T -> T
forall a. C a => a -> a -> a
div
   quot :: T -> T -> T
quot = T -> T -> T
forall a. C a => a -> a -> a
mod
   quotRem :: T -> T -> (T, T)
quotRem = T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod
   div :: T -> T -> T
div T
x T
y = (T, T) -> T
forall a b. (a, b) -> a
fst (T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod T
x T
y)
   mod :: T -> T -> T
mod T
x T
y = (T, T) -> T
forall a b. (a, b) -> b
snd (T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod T
x T
y)
   divMod :: T -> T -> (T, T)
divMod T
x T
y =
      let (Bool
sign,T
d) = T -> T -> (Bool, T)
subNeg T
y T
x
      in  if Bool
sign
            then (T
0,T
x)
            else let (T
q,T
r) = T -> T -> (T, T)
forall a. C a => a -> a -> (a, a)
divMod T
d T
y in (T -> T
forall a. Enum a => a -> a
succ T
q,T
r)
   toInteger :: T -> Integer
toInteger = T -> Integer
forall a. (C a, Enum a) => T -> a
toPosEnum