{- | Copyright : (c) Henning Thielemann 2008-2010 Maintainer : haskell@henning-thielemann.de Stability : stable Portability : Haskell 98 This module contains internal functions (*Unsafe) that I had liked to re-use in the NumericPrelude type hierarchy. However since the Eq and Ord instance already require the Num class, we cannot use that in the NumericPrelude. -} module Numeric.NonNegative.ChunkyPrivate (T, fromChunks, fromNumber, toChunks, toNumber, zero, normalize, isNull, isPositive, divModStrict, fromChunksUnsafe, toChunksUnsafe, ) where import qualified Numeric.NonNegative.Class as NonNeg import Control.Monad (liftM, liftM2) import Data.Tuple.HT (mapSnd, ) import qualified Data.Monoid as Mn import Test.QuickCheck (Arbitrary(arbitrary)) {- | 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. -} newtype T a = Cons {decons :: [a]} fromChunks :: NonNeg.C a => [a] -> T a fromChunks = Cons fromNumber :: NonNeg.C a => a -> T a fromNumber = fromChunks . (:[]) {- | This routine exposes the inner structure of the lazy number. -} toChunks :: T a -> [a] toChunks = decons toNumber :: NonNeg.C a => T a -> a toNumber = NonNeg.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 zero :: T a zero = Cons [] {- | Remove zero chunks. -} normalize :: NonNeg.C a => T a -> T a normalize = Cons . filter (> NonNeg.zero) . decons isNullList :: NonNeg.C a => [a] -> Bool isNullList = null . filter (> NonNeg.zero) isNull :: NonNeg.C a => T a -> Bool isNull = isNullList . decons -- null . decons . normalize 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], (Bool, [a])) glue [] ys = ([], (True, ys)) glue xs [] = ([], (False, xs)) glue (x:xs) (y:ys) = let (z,~(zs,brs)) = flip mapSnd (NonNeg.split x y) $ \(b,d) -> if b then glue xs $ if NonNeg.zero == d then ys else d:ys else glue (d:xs) ys in (z:zs,brs) equalList :: (NonNeg.C a) => [a] -> [a] -> Bool equalList x y = isNullList $ snd $ snd $ glue x y compareList :: (NonNeg.C a) => [a] -> [a] -> Ordering compareList x y = let (b,r) = snd $ 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 = fst $ glue x y maxList :: (NonNeg.C a) => [a] -> [a] -> [a] maxList x y = -- matching the inner pair lazily is important 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 {- | This instance is not correct with respect to the equality check if the involved numbers contain zero chunks. -} instance (NonNeg.C a) => NonNeg.C (T a) where split (Cons xs) (Cons ys) = let (zs, ~(b, rs)) = glue xs ys in (Cons zs, (b, Cons rs)) {- (Cons x) -| (Cons w) = let sub _ [] = [] sub z (y:ys) = if z<y then (y-|z):ys else sub (z-|y) ys in Cons (foldr sub x w) -} instance (NonNeg.C a, Num a) => Num (T a) where (+) = Mn.mappend (Cons x) - (Cons y) = let (b,d) = snd $ 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 (Real a, NonNeg.C a) => Real (T a) where toRational = toRational . toNumber {- required for Integral instance -} instance (Enum a, NonNeg.C a) => Enum (T a) where toEnum = fromNumber . toEnum fromEnum = fromEnum . toNumber instance (Integral a, NonNeg.C a) => Integral (T a) where toInteger = toInteger . toNumber quot = div rem = mod quotRem = divMod divMod x y = mapSnd fromNumber $ divModStrict x (toNumber y) divModStrict :: (Integral a, NonNeg.C a) => T a -> a -> (T a, a) divModStrict x0 y = let recourse [] r = ([], r) recourse (x:xs) r0 = let (q1,r1) = divMod (x+r0) y (q2,r2) = recourse xs r1 in (q1:q2,r2) (cs,rm) = recourse (toChunks x0) 0 in (fromChunks cs, rm) instance Mn.Monoid (T a) where mempty = zero mappend = lift2 (++) instance (NonNeg.C a, Arbitrary a) => Arbitrary (T a) where arbitrary = liftM Cons arbitrary {- * Functions that may break invariants -} fromChunksUnsafe :: [a] -> T a fromChunksUnsafe = Cons {- | This routine exposes the inner structure of the lazy number and is actually the same as 'toChunks'. It was considered dangerous, but you can observe the lazy structure in tying-the-knot applications anyway. So the explicit revelation of the chunks seems not to be worse. -} toChunksUnsafe :: T a -> [a] toChunksUnsafe = decons