{- |
Copyright   :  (c) Henning Thielemann 2007-2010

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98

A lazy number type, which is a generalization of lazy Peano numbers.
Comparisons can be made lazy and
thus computations are possible which are impossible with strict number types,
e.g. you can compute @let y = min (1+y) 2 in y@.
You can even work with infinite values.
However, depending on the granularity,
the memory consumption is higher than that for strict number types.
This number type is of interest for the merge operation of event lists,
which allows for co-recursive merges.
-}
module Number.NonNegativeChunky
   (T, fromChunks, toChunks, fromNumber, toNumber, fromChunky98, toChunky98,
    minMaxDiff, normalize, isNull, isPositive,
    divModLazy, divModStrict, ) where

import qualified Numeric.NonNegative.Chunky as Chunky98
import qualified Numeric.NonNegative.Class as NonNeg98

import qualified Algebra.NonNegative  as NonNeg
import qualified Algebra.Absolute     as Absolute
import qualified Algebra.Ring         as Ring
import qualified Algebra.Additive     as Additive
import qualified Algebra.ToInteger    as ToInteger
import qualified Algebra.ToRational   as ToRational
import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.RealIntegral as RealIntegral
import qualified Algebra.ZeroTestable as ZeroTestable

import qualified Algebra.Monoid as Monoid
import qualified Data.Monoid as Mn98
import qualified Data.Semigroup as Sg98

import Control.Monad (liftM, liftM2, )
import Data.Tuple.HT (mapFst, mapSnd, mapPair, )

import Test.QuickCheck (Arbitrary(arbitrary))

import NumericPrelude.Numeric
import NumericPrelude.Base

import qualified Prelude as P98


{- |
A chunky non-negative number is a list of non-negative numbers.
It represents the sum of the list elements.
It is possible to represent a finite number with infinitely many chunks
by using an infinite number of zeros.

Note the following problems:

Addition is commutative only for finite representations.
E.g. @let y = min (1+y) 2 in y@ is defined,
@let y = min (y+1) 2 in y@ is not.

The type is equivalent to 'Numeric.NonNegative.Chunky'.
-}
newtype T a = Cons {T a -> [a]
decons :: [a]}


fromChunks :: NonNeg.C a => [a] -> T a
fromChunks :: [a] -> T a
fromChunks = [a] -> T a
forall a. [a] -> T a
Cons

toChunks :: NonNeg.C a => T a -> [a]
toChunks :: T a -> [a]
toChunks = T a -> [a]
forall a. T a -> [a]
decons

fromChunky98 :: (NonNeg.C a, NonNeg98.C a) => Chunky98.T a -> T a
fromChunky98 :: T a -> T a
fromChunky98 = [a] -> T a
forall a. C a => [a] -> T a
fromChunks ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
Chunky98.toChunks

toChunky98 :: (NonNeg.C a, NonNeg98.C a) => T a -> Chunky98.T a
toChunky98 :: T a -> T a
toChunky98 = [a] -> T a
forall a. C a => [a] -> T a
Chunky98.fromChunks ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
toChunks

fromNumber :: NonNeg.C a => a -> T a
fromNumber :: a -> T a
fromNumber = [a] -> T a
forall a. C a => [a] -> T a
fromChunks ([a] -> T a) -> (a -> [a]) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

toNumber :: NonNeg.C a => T a -> a
toNumber :: T a -> a
toNumber =  [a] -> a
forall a. C a => [a] -> a
Monoid.cumulate ([a] -> a) -> (T a -> [a]) -> T a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
toChunks



lift2 :: NonNeg.C a => ([a] -> [a] -> [a]) -> (T a -> T a -> T a)
lift2 :: ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
f T a
x T a
y =
   [a] -> T a
forall a. C a => [a] -> T a
fromChunks ([a] -> T a) -> [a] -> T a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [a]
f (T a -> [a]
forall a. C a => T a -> [a]
toChunks T a
x) (T a -> [a]
forall a. C a => T a -> [a]
toChunks T a
y)

{- |
Remove zero chunks.
-}
normalize :: NonNeg.C a => T a -> T a
normalize :: T a -> T a
normalize = [a] -> T a
forall a. C a => [a] -> T a
fromChunks ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. C a => a
NonNeg.zero) ([a] -> [a]) -> (T a -> [a]) -> T a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
toChunks

isNullList :: NonNeg.C a => [a] -> Bool
isNullList :: [a] -> Bool
isNullList = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. C a => a
NonNeg.zero)

isNull :: NonNeg.C a => T a -> Bool
isNull :: T a -> Bool
isNull = [a] -> Bool
forall a. C a => [a] -> Bool
isNullList ([a] -> Bool) -> (T a -> [a]) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
toChunks
  -- null . toChunks . normalize

isPositive :: NonNeg.C a => T a -> Bool
isPositive :: T a -> Bool
isPositive = Bool -> Bool
not (Bool -> Bool) -> (T a -> Bool) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Bool
forall a. C a => T a -> Bool
isNull



{-
normalizeZT :: ZeroTestable.C a => T a -> T a
normalizeZT = fromChunks . filter (not . isZero) . toChunks
-}

isNullListZT :: ZeroTestable.C a => [a] -> Bool
isNullListZT :: [a] -> Bool
isNullListZT = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
forall a. C a => a -> Bool
isZero)

isNullZT :: ZeroTestable.C a => T a -> Bool
isNullZT :: T a -> Bool
isNullZT = [a] -> Bool
forall a. C a => [a] -> Bool
isNullListZT ([a] -> Bool) -> (T a -> [a]) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
decons
  -- null . toChunks . normalize
{-
isPositiveZT :: ZeroTestable.C a => T a -> Bool
isPositiveZT = not . isNull
-}


check :: String -> Bool -> a -> a
check :: String -> Bool -> a -> a
check String
funcName Bool
b a
x =
   if Bool
b
     then a
x
     else String -> a
forall a. HasCallStack => String -> a
error (String
"Numeric.NonNegative.Chunky."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
funcNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": negative number")


glue :: (NonNeg.C a) => [a] -> [a] -> ([a], (Bool, [a]))
glue :: [a] -> [a] -> ([a], (Bool, [a]))
glue [] [a]
ys = ([], (Bool
True,  [a]
ys))
glue [a]
xs [] = ([], (Bool
False, [a]
xs))
glue (a
x:[a]
xs) (a
y:[a]
ys) =
   let (a
z,~([a]
zs,(Bool, [a])
brs)) =
          (((Bool, a) -> ([a], (Bool, [a])))
 -> (a, (Bool, a)) -> (a, ([a], (Bool, [a]))))
-> (a, (Bool, a))
-> ((Bool, a) -> ([a], (Bool, [a])))
-> (a, ([a], (Bool, [a])))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Bool, a) -> ([a], (Bool, [a])))
-> (a, (Bool, a)) -> (a, ([a], (Bool, [a])))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (a -> a -> (a, (Bool, a))
forall a. C a => a -> a -> (a, (Bool, a))
NonNeg.split a
x a
y) (((Bool, a) -> ([a], (Bool, [a]))) -> (a, ([a], (Bool, [a]))))
-> ((Bool, a) -> ([a], (Bool, [a]))) -> (a, ([a], (Bool, [a])))
forall a b. (a -> b) -> a -> b
$
          \(Bool
b,a
d) ->
             if Bool
b
               then [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
xs ([a] -> ([a], (Bool, [a]))) -> [a] -> ([a], (Bool, [a]))
forall a b. (a -> b) -> a -> b
$
                    if a
forall a. C a => a
NonNeg.zero a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d
                      then [a]
ys else a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys
               else [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue (a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
   in  (a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs,(Bool, [a])
brs)

minMaxDiff :: (NonNeg.C a) => T a -> T a -> (T a, (Bool, T a))
minMaxDiff :: T a -> T a -> (T a, (Bool, T a))
minMaxDiff (Cons [a]
xs) (Cons [a]
ys) =
   let ([a]
zs, (Bool
b, [a]
rs)) = [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
xs [a]
ys
   in  ([a] -> T a
forall a. [a] -> T a
Cons [a]
zs, (Bool
b, [a] -> T a
forall a. [a] -> T a
Cons [a]
rs))

equalList :: (NonNeg.C a) => [a] -> [a] -> Bool
equalList :: [a] -> [a] -> Bool
equalList [a]
x [a]
y =
   [a] -> Bool
forall a. C a => [a] -> Bool
isNullList ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ (Bool, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Bool, [a]) -> [a]) -> (Bool, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ ([a], (Bool, [a])) -> (Bool, [a])
forall a b. (a, b) -> b
snd (([a], (Bool, [a])) -> (Bool, [a]))
-> ([a], (Bool, [a])) -> (Bool, [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
x [a]
y

compareList :: (NonNeg.C a) => [a] -> [a] -> Ordering
compareList :: [a] -> [a] -> Ordering
compareList [a]
x [a]
y =
   let (Bool
b,[a]
r) = ([a], (Bool, [a])) -> (Bool, [a])
forall a b. (a, b) -> b
snd (([a], (Bool, [a])) -> (Bool, [a]))
-> ([a], (Bool, [a])) -> (Bool, [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
x [a]
y
   in  if [a] -> Bool
forall a. C a => [a] -> Bool
isNullList [a]
r
         then Ordering
EQ
         else if Bool
b then Ordering
LT else Ordering
GT

minList :: (NonNeg.C a) => [a] -> [a] -> [a]
minList :: [a] -> [a] -> [a]
minList [a]
x [a]
y =
   ([a], (Bool, [a])) -> [a]
forall a b. (a, b) -> a
fst (([a], (Bool, [a])) -> [a]) -> ([a], (Bool, [a])) -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
x [a]
y

maxList :: (NonNeg.C a) => [a] -> [a] -> [a]
maxList :: [a] -> [a] -> [a]
maxList [a]
x [a]
y =
   -- matching the inner pair lazily is important
   let ([a]
z,~(Bool
_,[a]
r)) = [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
x [a]
y in [a]
z[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
r


instance (NonNeg.C a) => Eq (T a) where
   (Cons [a]
x) == :: T a -> T a -> Bool
== (Cons [a]
y) = [a] -> [a] -> Bool
forall a. C a => [a] -> [a] -> Bool
equalList [a]
x [a]
y

instance (NonNeg.C a) => Ord (T a) where
   compare :: T a -> T a -> Ordering
compare (Cons [a]
x) (Cons [a]
y) = [a] -> [a] -> Ordering
forall a. C a => [a] -> [a] -> Ordering
compareList [a]
x [a]
y
   min :: T a -> T a -> T a
min = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. C a => ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
minList
   max :: T a -> T a -> T a
max = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. C a => ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
maxList


instance (NonNeg.C a) => NonNeg.C (T a) where
   split :: T a -> T a -> (T a, (Bool, T a))
split (Cons [a]
xs) (Cons [a]
ys) =
      let ([a]
zs, ~(Bool
b, [a]
rs)) = [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
xs [a]
ys
      in  ([a] -> T a
forall a. [a] -> T a
Cons [a]
zs, (Bool
b, [a] -> T a
forall a. [a] -> T a
Cons [a]
rs))

instance (ZeroTestable.C a) => ZeroTestable.C (T a) where
   isZero :: T a -> Bool
isZero = T a -> Bool
forall a. C a => T a -> Bool
isNullZT

instance (NonNeg.C a) => Additive.C (T a) where
   zero :: T a
zero  = T a
forall a. C a => a
Monoid.idt
   + :: T a -> T a -> T a
(+)   = T a -> T a -> T a
forall a. C a => a -> a -> a
(Monoid.<*>)
   (Cons [a]
x) - :: T a -> T a -> T a
- (Cons [a]
y) =
      let (Bool
b,[a]
d) = ([a], (Bool, [a])) -> (Bool, [a])
forall a b. (a, b) -> b
snd (([a], (Bool, [a])) -> (Bool, [a]))
-> ([a], (Bool, [a])) -> (Bool, [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
x [a]
y
          d' :: T a
d' = [a] -> T a
forall a. [a] -> T a
Cons [a]
d
      in String -> Bool -> T a -> T a
forall a. String -> Bool -> a -> a
check String
"-" (Bool -> Bool
not Bool
b Bool -> Bool -> Bool
|| T a -> Bool
forall a. C a => T a -> Bool
isNull T a
d') T a
d'
   negate :: T a -> T a
negate T a
x = String -> Bool -> T a -> T a
forall a. String -> Bool -> a -> a
check String
"negate" (T a -> Bool
forall a. C a => T a -> Bool
isNull T a
x) T a
x
{-
   x0 - y0 =
      let d' = lift2 (\x y -> let (_,d,b) = glue x y in  d) x0 y0
      in  check "-" (not b || isNull d') d'
-}

instance (Ring.C a, NonNeg.C a) => Ring.C (T a) where
   one :: T a
one   = a -> T a
forall a. C a => a -> T a
fromNumber a
forall a. C a => a
one
   * :: T a -> T a -> T a
(*)   = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. C a => ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 ((a -> a -> a) -> [a] -> [a] -> [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. C a => a -> a -> a
(*))
   fromInteger :: Integer -> T a
fromInteger = a -> T a
forall a. C a => a -> T a
fromNumber (a -> T a) -> (Integer -> a) -> Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. C a => Integer -> a
fromInteger

instance (Ring.C a, ZeroTestable.C a, NonNeg.C a) => Absolute.C (T a) where
   abs :: T a -> T a
abs    = T a -> T a
forall a. a -> a
id
   signum :: T a -> T a
signum = a -> T a
forall a. C a => a -> T a
fromNumber (a -> T a) -> (T a -> a) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Bool
b -> if Bool
b then a
forall a. C a => a
one else a
forall a. C a => a
zero) (Bool -> a) -> (T a -> Bool) -> T a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Bool
forall a. C a => T a -> Bool
isPositive

instance (ToInteger.C a, NonNeg.C a) => ToInteger.C (T a) where
   toInteger :: T a -> Integer
toInteger = [Integer] -> Integer
forall a. C a => [a] -> a
sum ([Integer] -> Integer) -> (T a -> [Integer]) -> T a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Integer) -> [a] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map a -> Integer
forall a. C a => a -> Integer
toInteger ([a] -> [Integer]) -> (T a -> [a]) -> T a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
toChunks

instance (ToRational.C a, NonNeg.C a) => ToRational.C (T a) where
   toRational :: T a -> Rational
toRational = [Rational] -> Rational
forall a. C a => [a] -> a
sum ([Rational] -> Rational) -> (T a -> [Rational]) -> T a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Rational) -> [a] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map a -> Rational
forall a. C a => a -> Rational
toRational ([a] -> [Rational]) -> (T a -> [a]) -> T a -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. C a => T a -> [a]
toChunks


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

{- |
'divMod' is implemented in terms of 'divModStrict'.
If it is needed we could also provide a function
that accesses the divisor first in a lazy way
and then uses a strict divisor for subsequent rounds of the subtraction loop.
This way we can handle the cases \"dividend smaller than divisor\"
and \"dividend greater than divisor\" in a lazy and efficient way.
However changing the way of operation within one number is also not nice.
-}
instance (Ord a, Integral.C a, NonNeg.C a) => Integral.C (T a) where
   divMod :: T a -> T a -> (T a, T a)
divMod T a
x T a
y =
      (a -> T a) -> (T a, a) -> (T a, T a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd a -> T a
forall a. C a => a -> T a
fromNumber ((T a, a) -> (T a, T a)) -> (T a, a) -> (T a, T a)
forall a b. (a -> b) -> a -> b
$
      T a -> a -> (T a, a)
forall a. (C a, C a) => T a -> a -> (T a, a)
divModStrict T a
x (T a -> a
forall a. C a => T a -> a
toNumber T a
y)

{- |
divModLazy accesses the divisor in a lazy way.
However this is only relevant if the dividend is smaller than the divisor.
For large dividends the divisor will be accessed multiple times
but since it is already fully evaluated it could also be strict.
-}
divModLazy ::
   (Ring.C a, NonNeg.C a) =>
   T a -> T a -> (T a, T a)
divModLazy :: T a -> T a -> (T a, T a)
divModLazy T a
x0 T a
y0 =
   let y :: [a]
y = T a -> [a]
forall a. C a => T a -> [a]
toChunks T a
y0
       recourse :: [a] -> ([a], [a])
recourse [a]
x =
          let ([a]
r,~(Bool
b,[a]
d)) = [a] -> [a] -> ([a], (Bool, [a]))
forall a. C a => [a] -> [a] -> ([a], (Bool, [a]))
glue [a]
y [a]
x
          in  if Bool -> Bool
not Bool
b
                then ([], [a]
r)
                else ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
forall a. C a => a
onea -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> ([a], [a])
recourse [a]
d)
   in  ([a] -> T a, [a] -> T a) -> ([a], [a]) -> (T a, T a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair
          ([a] -> T a
forall a. C a => [a] -> T a
fromChunks, [a] -> T a
forall a. C a => [a] -> T a
fromChunks)
          ([a] -> ([a], [a])
forall a. C a => [a] -> ([a], [a])
recourse (T a -> [a]
forall a. C a => T a -> [a]
toChunks T a
x0))

{- |
This function has a strict divisor
and maintains the chunk structure of the dividend at a smaller scale.
-}
divModStrict ::
   (Integral.C a, NonNeg.C a) =>
   T a -> a -> (T a, a)
divModStrict :: T a -> a -> (T a, a)
divModStrict T a
x0 a
y =
   let recourse :: [a] -> a -> ([a], a)
recourse [] a
r = ([], a
r)
       recourse (a
x:[a]
xs) a
r0 =
          case a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod (a
xa -> a -> a
forall a. C a => a -> a -> a
+a
r0) a
y of
             (a
q,a
r1) -> ([a] -> [a]) -> ([a], a) -> ([a], a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
qa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], a) -> ([a], a)) -> ([a], a) -> ([a], a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> ([a], a)
recourse [a]
xs a
r1
   in  ([a] -> T a) -> ([a], a) -> (T a, a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst [a] -> T a
forall a. C a => [a] -> T a
fromChunks (([a], a) -> (T a, a)) -> ([a], a) -> (T a, a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> ([a], a)
recourse (T a -> [a]
forall a. C a => T a -> [a]
toChunks T a
x0) a
forall a. C a => a
zero



instance (Show a) => Show (T a) where
   showsPrec :: Int -> T a -> String -> String
showsPrec Int
p T a
x =
      Bool -> (String -> String) -> String -> String
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
10)
         (String -> String -> String
showString String
"Chunky.fromChunks " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
10 (T a -> [a]
forall a. T a -> [a]
decons T a
x))


instance (NonNeg.C a, Arbitrary a) => Arbitrary (T a) where
   arbitrary :: Gen (T a)
arbitrary = ([a] -> T a) -> Gen [a] -> Gen (T a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [a] -> T a
forall a. [a] -> T a
Cons Gen [a]
forall a. Arbitrary a => Gen a
arbitrary



-- * Haskell 98 legacy instances

fromChunky98_ :: (NonNeg98.C a) => Chunky98.T a -> T a
fromChunky98_ :: T a -> T a
fromChunky98_ = [a] -> T a
forall a. [a] -> T a
Cons ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
Chunky98.toChunks

toChunky98_ :: (NonNeg98.C a) => T a -> Chunky98.T a
toChunky98_ :: T a -> T a
toChunky98_ = [a] -> T a
forall a. C a => [a] -> T a
Chunky98.fromChunks ([a] -> T a) -> (T a -> [a]) -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [a]
forall a. T a -> [a]
decons

fromNumber_ :: a -> T a
fromNumber_ :: a -> T a
fromNumber_ = [a] -> T a
forall a. [a] -> T a
Cons ([a] -> T a) -> (a -> [a]) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

{-# INLINE lift98_1 #-}
lift98_1 ::
   (NonNeg98.C a, NonNeg98.C b) =>
   (Chunky98.T a -> Chunky98.T b) -> T a -> T b
lift98_1 :: (T a -> T b) -> T a -> T b
lift98_1 T a -> T b
f T a
a = T b -> T b
forall a. C a => T a -> T a
fromChunky98_ (T a -> T b
f (T a -> T a
forall a. C a => T a -> T a
toChunky98_ T a
a))

{-# INLINE lift98_2 #-}
lift98_2 ::
   (NonNeg98.C a, NonNeg98.C b, NonNeg98.C c) =>
   (Chunky98.T a -> Chunky98.T b -> Chunky98.T c) -> T a -> T b -> T c
lift98_2 :: (T a -> T b -> T c) -> T a -> T b -> T c
lift98_2 T a -> T b -> T c
f T a
a T b
b = T c -> T c
forall a. C a => T a -> T a
fromChunky98_ (T a -> T b -> T c
f (T a -> T a
forall a. C a => T a -> T a
toChunky98_ T a
a) (T b -> T b
forall a. C a => T a -> T a
toChunky98_ T b
b))


{-# 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.NonNegativeChunky: method " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be implemented"

instance (NonNeg98.C a, P98.Num a) => P98.Num (T a) where
   fromInteger :: Integer -> T a
fromInteger = a -> T a
forall a. a -> T a
fromNumber_ (a -> T a) -> (Integer -> a) -> Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
P98.fromInteger
   negate :: T a -> T a
negate = (T a -> T a) -> T a -> T a
forall a b. (C a, C b) => (T a -> T b) -> T a -> T b
lift98_1 T a -> T a
forall a. Num a => a -> a
P98.negate
   + :: T a -> T a -> T a
(+)    = (T a -> T a -> T a) -> T a -> T a -> T a
forall a b c.
(C a, C b, C c) =>
(T a -> T b -> T c) -> T a -> T b -> T c
lift98_2 T a -> T a -> T a
forall a. Num a => a -> a -> a
(P98.+)
   * :: T a -> T a -> T a
(*)    = (T a -> T a -> T a) -> T a -> T a -> T a
forall a b c.
(C a, C b, C c) =>
(T a -> T b -> T c) -> T a -> T b -> T c
lift98_2 T a -> T a -> T a
forall a. Num a => a -> a -> a
(P98.*)
   abs :: T a -> T a
abs    = (T a -> T a) -> T a -> T a
forall a b. (C a, C b) => (T a -> T b) -> T a -> T b
lift98_1 T a -> T a
forall a. Num a => a -> a
P98.abs
   signum :: T a -> T a
signum = (T a -> T a) -> T a -> T a
forall a b. (C a, C b) => (T a -> T b) -> T a -> T b
lift98_1 T a -> T a
forall a. Num a => a -> a
P98.signum

instance (NonNeg98.C a, P98.Fractional a) => P98.Fractional (T a) where
   fromRational :: Rational -> T a
fromRational = a -> T a
forall a. a -> T a
fromNumber_ (a -> T a) -> (Rational -> a) -> Rational -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
P98.fromRational
   / :: T a -> T a -> T a
(/) = String -> T a -> T a -> T a
forall a. String -> a
notImplemented String
"(/)"

instance (NonNeg.C a) => Sg98.Semigroup (T a) where
   <> :: T a -> T a -> T a
(<>) = T a -> T a -> T a
forall a. C a => a -> a -> a
(Monoid.<*>)

instance (NonNeg.C a) => Mn98.Monoid (T a) where
   mempty :: T a
mempty  = T a
forall a. C a => a
Monoid.idt
   mappend :: T a -> T a -> T a
mappend = T a -> T a -> T a
forall a. Semigroup a => a -> a -> a
(Sg98.<>)

instance (NonNeg.C a) => Monoid.C (T a) where
   idt :: T a
idt   = [a] -> T a
forall a. [a] -> T a
Cons []
   <*> :: T a -> T a -> T a
(<*>) = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. C a => ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)