module Numeric.NonNegative.ChunkyPrivate
(T, fromChunks, fromNumber, toNumber, normalize, isNull, isPositive,
fromChunksUnsafe, toChunksUnsafe, ) where
import qualified Numeric.NonNegative.Class as NonNeg
import Control.Monad (liftM, liftM2)
import Test.QuickCheck (Arbitrary(..))
newtype T a = Cons {decons :: [a]}
fromChunks :: NonNeg.C a => [a] -> T a
fromChunks = Cons
fromNumber :: NonNeg.C a => a -> T a
fromNumber = fromChunks . (:[])
toNumber :: NonNeg.C a => T a -> a
toNumber = sum . decons
instance (Show a) => Show (T a) where
showsPrec p x =
showParen (p>10)
(showString "Chunky.fromChunks " . showsPrec 10 (decons x))
lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)
lift2 f (Cons x) (Cons y) = Cons $ f x y
normalize :: NonNeg.C a => T a -> T a
normalize = Cons . filter (>0) . decons
isNullList :: NonNeg.C a => [a] -> Bool
isNullList = null . filter (>0)
isNull :: NonNeg.C a => T a -> Bool
isNull = isNullList . decons
isPositive :: NonNeg.C a => T a -> Bool
isPositive = not . isNull
check :: String -> Bool -> a -> a
check funcName b x =
if b
then x
else error ("Numeric.NonNegative.Chunky."++funcName++": negative number")
glue :: (NonNeg.C a) => [a] -> [a] -> ([a], [a], Bool)
glue [] ys = ([], ys, True)
glue xs [] = ([], xs, False)
glue (x:xs) (y:ys) =
let (z,(zs,rs,b)) =
case compare x y of
LT -> (x, glue xs ((yx):ys))
GT -> (y, glue ((xy):xs) ys)
EQ -> (x, glue xs ys)
in (z:zs,rs,b)
equalList :: (NonNeg.C a) => [a] -> [a] -> Bool
equalList x y =
let (_,r,_) = glue x y
in isNullList r
compareList :: (NonNeg.C a) => [a] -> [a] -> Ordering
compareList x y =
let (_,r,b) = glue x y
in if isNullList r
then EQ
else if b then LT else GT
minList :: (NonNeg.C a) => [a] -> [a] -> [a]
minList x y =
let (z,_,_) = glue x y in z
maxList :: (NonNeg.C a) => [a] -> [a] -> [a]
maxList x y =
let (z,r,_) = glue x y in z++r
instance (NonNeg.C a) => Eq (T a) where
(Cons x) == (Cons y) = equalList x y
instance (NonNeg.C a) => Ord (T a) where
compare (Cons x) (Cons y) = compareList x y
min = lift2 minList
max = lift2 maxList
instance (NonNeg.C a) => NonNeg.C (T a) where
(Cons x) -| (Cons w) =
let sub _ [] = []
sub z (y:ys) =
if z<y then (yz):ys else sub (zy) ys
in Cons (foldr sub x w)
instance (NonNeg.C a) => Num (T a) where
(+) = lift2 (++)
(Cons x) (Cons y) =
let (_,d,b) = glue x y
d' = Cons d
in check "-" (not b || isNull d') d'
negate x = check "negate" (isNull x) x
fromInteger = fromNumber . fromInteger
(*) = lift2 (liftM2 (*))
abs = id
signum = fromNumber . (\b -> if b then 1 else 0) . isPositive
instance (NonNeg.C a, Arbitrary a) => Arbitrary (T a) where
arbitrary = liftM Cons arbitrary
coarbitrary = undefined
fromChunksUnsafe :: [a] -> T a
fromChunksUnsafe = Cons
toChunksUnsafe :: T a -> [a]
toChunksUnsafe = decons