packages feed

non-negative 0.0.6 → 0.1.2.1

raw patch · 8 files changed

Files

Test/Numeric/NonNegative/Chunky.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -36,55 +36,95 @@   -add :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+add :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool add x y  =  x+y  ==~  (+) $~ x $~ y -sub :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+sub :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool sub x y  =    if x>y      then x-y  ==~  (-) $~ x $~ y      else y-x  ==~  (-) $~ y $~ x -mul :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+mul :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool mul x y  =  x*y  ==~  (*) $~ x $~ y -min :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+min :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool min x y  =  P.min x y  ==~  P.min $~ x $~ y -max :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+max :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool max x y  =  P.max x y  ==~  P.max $~ x $~ y -abs :: NonNeg.C a => Chunky.T a -> Bool+abs :: (NonNeg.C a, Num a) => Chunky.T a -> Bool abs x  =  P.abs x  ==~  P.abs $~ x -signum :: NonNeg.C a => Chunky.T a -> Bool+signum :: (NonNeg.C a, Num a) => Chunky.T a -> Bool signum x  =  P.signum x  ==~  P.signum $~ x -equal :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+equal :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool equal x y  =  (x == y)  ==  (==) $~ x $~ y -compare :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Bool+compare :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Bool compare x y  =  P.compare x y  ==  P.compare $~ x $~ y +splitSpaceLeak0, splitSpaceLeak1, splitSpaceLeak2,+ splitSpaceLeak3, splitSpaceLeak4, splitSpaceLeak5 :: Bool+splitSpaceLeak0 =+   (\t -> t==t) $ take 300 $+   show $ fst $ NonNeg.split 1000000 $+   Chunky.fromChunks $ repeat (1::Card)+splitSpaceLeak1 =+   (\t -> t==t) $ take 300 $+   show $ fst $ snd $ NonNeg.split 1000000 $+   Chunky.fromChunks $ repeat (1::Card)+splitSpaceLeak2 =+   (\t -> t==t) $ take 300 $+   show $ snd $ snd $ NonNeg.split 1000000 $+   Chunky.fromChunks $ repeat (1::Card)+splitSpaceLeak3 =+   (\t -> t==t) $ take 300 $+   show $ snd $ NonNeg.split 1000000 $+   Chunky.fromChunks $ repeat (1::Card)+splitSpaceLeak4 =+   (\t -> t==t) $ take 300 $+   show $ (\ ~(_mt,bdt) -> bdt) $ NonNeg.split 1000000 $+   Chunky.fromChunks $ repeat (1::Card)+splitSpaceLeak5 =+   (\t -> t==t) $ take 300 $+   show $ (\(b,dt) -> if b then dt else 0) $ snd $ NonNeg.split 1000000 $+   Chunky.fromChunks $ repeat (1::Card) -infinity :: NonNeg.C a => a -> Chunky.T a+infinity :: (NonNeg.C a, Num a) => a -> Chunky.T a infinity = Chunky.fromChunks . repeat . (1+) -checkInfinity :: NonNeg.C a => a -> Chunky.T a -> Bool+checkInfinity :: (NonNeg.C a, Num a) => a -> Chunky.T a -> Bool checkInfinity limit x =    let y = Chunky.fromNumber limit    in  P.min x y == y -addInfiniteL :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+showInfinite0 :: Int -> Bool+showInfinite0 =+   (\t -> t==t) . take 1000000 . show .+   const (Chunky.fromChunks $ iterate (2-) (1::NonNegW.Integer))++showInfinite1 :: (NonNeg.C a, Num a, Show a) => a -> Bool+showInfinite1 =+   (\t -> t==t) . take 10000 . show .+   (\n -> Chunky.fromChunks $ iterate (2-) (1+0*n))++showInfinite2 :: (NonNeg.C a, Num a, Show a) => a -> Bool+showInfinite2 =+   (\t -> t==t) . take 10000 . show . infinity++addInfiniteL :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool addInfiniteL limit x y =    checkInfinity limit (infinity x + y) -addInfiniteR :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+addInfiniteR :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool addInfiniteR limit x y =    checkInfinity limit (y + infinity x)  -mulInfiniteL :: NonNeg.C a => a -> a -> Chunky.T a -> Property+mulInfiniteL :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Property mulInfiniteL limit x y =    Chunky.isPositive y ==>       checkInfinity limit (infinity x * y)@@ -93,67 +133,67 @@ Without normalization the test would fail for @y = Chunky.fromChunks [0,1]@ -}-mulInfiniteR :: NonNeg.C a => a -> a -> Chunky.T a -> Property+mulInfiniteR :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Property mulInfiniteR limit x y =    Chunky.isPositive y ==>       checkInfinity limit (Chunky.normalize y * infinity x)  {--mulInfiniteL :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+mulInfiniteL :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool mulInfiniteL limit x y =    if Chunky.isNull y      then Chunky.isNull (infinity x * y)      else checkInfinity limit (infinity x * y) -mulInfiniteR :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+mulInfiniteR :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool mulInfiniteR limit x y =    if Chunky.isNull y      then Chunky.isNull (y * infinity x)      else checkInfinity limit (y * infinity x) -} -minRecursiveL :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Property+minRecursiveL :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Property minRecursiveL x y =    Chunky.isPositive x ==>       let z = P.min (x+z) y       in  z == y -minRecursiveR :: NonNeg.C a => Chunky.T a -> Chunky.T a -> Property+minRecursiveR :: (NonNeg.C a, Num a) => Chunky.T a -> Chunky.T a -> Property minRecursiveR x y =    Chunky.isPositive x ==>       let z = P.min y (x+z)       in  z == y -minInfiniteL :: NonNeg.C a => a -> Chunky.T a -> Bool+minInfiniteL :: (NonNeg.C a, Num a) => a -> Chunky.T a -> Bool minInfiniteL x y =    P.min (infinity x) y  ==  y -minInfiniteR :: NonNeg.C a => a -> Chunky.T a -> Bool+minInfiniteR :: (NonNeg.C a, Num a) => a -> Chunky.T a -> Bool minInfiniteR x y =    P.min y (infinity x)  ==  y -maxInfiniteL :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+maxInfiniteL :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool maxInfiniteL limit x y =    checkInfinity limit (P.max (infinity x) y) -maxInfiniteR :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+maxInfiniteR :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool maxInfiniteR limit x y =    checkInfinity limit (P.max y (infinity x)) -minInfiniteAssociative :: NonNeg.C a => a -> a -> Chunky.T a -> Bool+minInfiniteAssociative :: (NonNeg.C a, Num a) => a -> a -> Chunky.T a -> Bool minInfiniteAssociative x y z =    P.min (P.min (infinity x) (infinity y)) z  ==  z -maxInfiniteAssociative :: NonNeg.C a => a -> a -> a -> Chunky.T a -> Bool+maxInfiniteAssociative :: (NonNeg.C a, Num a) => a -> a -> a -> Chunky.T a -> Bool maxInfiniteAssociative limit x y z =    checkInfinity limit       (P.max (P.max (infinity x) (infinity y)) z) -compareInfiniteL :: NonNeg.C a => a -> Chunky.T a -> Bool+compareInfiniteL :: (NonNeg.C a, Num a) => a -> Chunky.T a -> Bool compareInfiniteL x y =    P.compare (infinity x) y == GT -compareInfiniteR :: NonNeg.C a => a -> Chunky.T a -> Bool+compareInfiniteR :: (NonNeg.C a, Num a) => a -> Chunky.T a -> Bool compareInfiniteR x y =    P.compare y (infinity x) == LT @@ -183,6 +223,26 @@      quickCheck (equal :: Chunky.T Card -> Chunky.T Card -> Bool)) :    ("compare",      quickCheck (compare :: Chunky.T Card -> Chunky.T Card -> Bool)) :++   ("splitSpaceLeak0",+     quickCheck splitSpaceLeak0) :+   ("splitSpaceLeak1",+     quickCheck splitSpaceLeak1) :+   ("splitSpaceLeak2",+     quickCheck splitSpaceLeak2) :+   ("splitSpaceLeak3",+     quickCheck splitSpaceLeak3) :+   ("splitSpaceLeak4",+     quickCheck splitSpaceLeak4) :+   ("splitSpaceLeak5",+     quickCheck splitSpaceLeak5) :++   ("showInfinite0",+     quickCheck (showInfinite0 :: Int -> Bool)) :+   ("showInfinite1",+     quickCheck (showInfinite1 :: NonNegW.Int -> Bool)) :+   ("showInfinite2",+     quickCheck (showInfinite2 :: NonNegW.Int -> Bool)) :     ("addInfiniteL",      quickCheck (addInfiniteL :: Card -> Card -> Chunky.T Card -> Bool)) :
Test/Utility.hs view
@@ -1,10 +1,6 @@ module Test.Utility where -import Test.QuickCheck (Arbitrary(..))- import qualified Numeric.NonNegative.Wrapper as NonNeg-import Control.Monad (liftM)-import Data.Char (chr)   type TimeDiff = NonNeg.Int@@ -15,14 +11,3 @@ makeFracTime :: (TimeDiff, TimeDiff) -> NonNeg.Double makeFracTime (n,d) =    timeToDouble n / (timeToDouble d + 1)---instance Arbitrary Char where-   arbitrary = liftM (chr . (32+) . flip mod 96) arbitrary-   coarbitrary = undefined--instance Arbitrary a => Arbitrary (Maybe a) where-   arbitrary =-      arbitrary >>=-         \b -> if b then fmap Just arbitrary else return Nothing-   coarbitrary = undefined
non-negative.cabal view
@@ -1,5 +1,5 @@ Name:             non-negative-Version:          0.0.6+Version:          0.1.2.1 License:          GPL License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -12,41 +12,47 @@    a wrapper which can turn any ordered numeric type into a member of that class,    and a lazy number type for non-negative numbers    (a generalization of Peano numbers).-   This library is used by the 'event-list' package.-Tested-With:      GHC==6.4.1, GHC==6.8.2-Cabal-Version:    >=1.2+   This library is used by the @event-list@ package.+Tested-With:      GHC==6.4.1, GHC==6.8.2, GHC==7.8.3+Cabal-Version:    >=1.10 Build-Type:       Simple -Flag splitBase-  description: Choose the new smaller, split-up base package.+Source-Repository this+  Tag:         0.1.2.1+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/non-negative/ -Flag buildTests-  description: Build test executables-  default:     False+Source-Repository head+  Type:        darcs+  Location:    http://code.haskell.org/~thielema/non-negative/  Library-  Build-Depends: QuickCheck >= 1.0 && <3-  If flag(splitBase)-    Build-Depends: base >= 2 && < 5-  Else-    Build-Depends: base >= 1.0 && < 2+  Build-Depends:+    semigroups >=0.1 && <1,+    utility-ht >=0.0.1 && <0.1,+    QuickCheck >=2.1 && <3,+    base >=2 && <5 +  Default-Language: Haskell98   GHC-Options:      -Wall   Hs-Source-Dirs:   src   Exposed-Modules:     Numeric.NonNegative.Class     Numeric.NonNegative.Wrapper     Numeric.NonNegative.Chunky-    Numeric.NonNegative.ChunkyPrivate   Other-Modules:-    Numeric.NonNegative.Utility--Executable test-  If !flag(buildTests)-    Buildable:      False+    Numeric.NonNegative.ChunkyPrivate -  Hs-source-dirs:   src, .+Test-Suite test+  Type: exitcode-stdio-1.0+  Default-Language: Haskell98+  Build-Depends:    non-negative   GHC-Options:      -Wall+  Build-Depends:+    QuickCheck,+    semigroups,+    utility-ht,+    base >=2 && <5   Main-Is:          Test/Main.hs   Other-Modules:     Test.Utility
src/Numeric/NonNegative/Chunky.hs view
@@ -18,7 +18,6 @@ module Numeric.NonNegative.Chunky    (T, fromChunks, fromNumber, toChunks, toNumber,     zero, normalize, isNull, isPositive,-    minMaxDiff,     divModStrict,    ) where
src/Numeric/NonNegative/ChunkyPrivate.hs view
@@ -13,16 +13,16 @@ module Numeric.NonNegative.ChunkyPrivate    (T, fromChunks, fromNumber, toChunks, toNumber,     zero, normalize, isNull, isPositive,-    minMaxDiff,     divModStrict,     fromChunksUnsafe, toChunksUnsafe, ) where  import qualified Numeric.NonNegative.Class as NonNeg-import Numeric.NonNegative.Class ((-|), ) import Control.Monad (liftM, liftM2)+import Data.Monoid (Monoid(mempty, mappend), )+import Data.Semigroup (Semigroup((<>)), )+import Data.Tuple.HT (mapSnd, ) -import qualified Data.Monoid as Mn-import Test.QuickCheck (Arbitrary(arbitrary))+import Test.QuickCheck (Arbitrary(arbitrary, shrink))  {- | A chunky non-negative number is a list of non-negative numbers.@@ -53,7 +53,7 @@ toChunks = decons  toNumber :: NonNeg.C a => T a -> a-toNumber =  sum . decons+toNumber =  NonNeg.sum . decons   instance (Show a) => Show (T a) where@@ -72,10 +72,10 @@ Remove zero chunks. -} normalize :: NonNeg.C a => T a -> T a-normalize = Cons . filter (>0) . decons+normalize = Cons . filter (> NonNeg.zero) . decons  isNullList :: NonNeg.C a => [a] -> Bool-isNullList = null . filter (>0)+isNullList = null . filter (> NonNeg.zero)  isNull :: NonNeg.C a => T a -> Bool isNull = isNullList . decons@@ -91,48 +91,39 @@      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 :: (NonNeg.C a) => [a] -> [a] -> ([a], (Bool, [a]))+glue [] ys = ([], (True,  ys))+glue xs [] = ([], (False, xs)) glue (x:xs) (y:ys) =-   let (z,(zs,rs,b)) =-           case compare x y of-              LT -> (x, glue xs ((y-|x):ys))-              GT -> (y, glue ((x-|y):xs) ys)-              EQ -> (x, glue xs ys)-   in  (z:zs,rs,b)--{- |-In @minMaxDiff x y == (z,r,b)@-@z@ represents @min x y@,-@r@ represents @max x y - min x y@,-and @x<y  ==>  b@ or @x>y  ==>  not b@,- for @x==y@ the value of b is arbitrary.--}-minMaxDiff :: (NonNeg.C a) => T a -> T a -> (T a, T a, Bool)-minMaxDiff (Cons xs) (Cons ys) =-   let (zs, rs, b) = glue xs ys-   in  (Cons zs, Cons rs, b)+   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 =-   let (_,r,_) = glue x y-   in  isNullList r+   isNullList $ snd $ snd $ glue x y  compareList :: (NonNeg.C a) => [a] -> [a] -> Ordering compareList x y =-   let (_,r,b) = glue 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 =-   let (z,_,_) = glue x y in z+   fst $ glue x y  maxList :: (NonNeg.C a) => [a] -> [a] -> [a] maxList x y =-   let (z,r,_) = glue x y in z++r+   -- matching the inner pair lazily is important+   let (z,~(_,r)) = glue x y in z++r   instance (NonNeg.C a) => Eq (T a) where@@ -144,17 +135,26 @@    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 (T a) where-   (+)    = Mn.mappend+instance (NonNeg.C a, Num a) => Num (T a) where+   (+) = mappend    (Cons x) - (Cons y) =-      let (_,d,b) = glue x 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@@ -178,8 +178,8 @@    rem  = mod    quotRem = divMod    divMod x y =-      case divModStrict x (toNumber y) of-         (q,r) -> (q, fromNumber r)+      mapSnd fromNumber $+      divModStrict x (toNumber y)  divModStrict ::    (Integral a, NonNeg.C a) =>@@ -194,12 +194,16 @@    in  (fromChunks cs, rm)  -instance Mn.Monoid (T a) where+instance Semigroup (T a) where+   (<>) = lift2 (++)++instance Monoid (T a) where    mempty = zero    mappend = lift2 (++)  instance (NonNeg.C a, Arbitrary a) => Arbitrary (T a) where    arbitrary = liftM Cons arbitrary+   shrink (Cons xs) = map Cons $ shrink xs   {- * Functions that may break invariants -}
src/Numeric/NonNegative/Class.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -7,29 +7,157 @@  A type class for non-negative numbers. Prominent instances are 'Numeric.NonNegative.Wrapper.T' and peano numbers.+Types from "Data.Word" would also be candidates.+However, there is no 'Monoid' instance for 'Word' types+and they have wrap-around semantics. This class cannot do any checks, but it let you show to the user what arguments your function expects.+Thus you must define class instances with care. In fact many standard functions ('take', '(!!)', ...) should have this type class constraint.-Thus you must define class instances with care. -}-module Numeric.NonNegative.Class (C(..)) where+module Numeric.NonNegative.Class (+   C(..),+   splitDefault, +   (-|),+   zero,+   add,+   sum,+   maximum, +   switchDifferenceNegative,+   switchDifferenceOrdering,+   ) where++import Data.Monoid (Monoid, )+import qualified Data.Monoid as Monoid++import Prelude hiding (sum, maximum, )++ {- | Instances of this class must ensure non-negative values. We cannot enforce this by types, but the type class constraint @NonNegative.C@ avoids accidental usage of types which allow for negative numbers.++The Monoid superclass contributes a zero and an addition. -}-class (Ord a, Num a) => C a where+class (Ord a, Monoid a) => C a where    {- |-   @x -| y == max 0 (x-y)@+   @split x y == (m,(b,d))@ means that+   @b == (x<=y)@,+   @m == min x y@,+   @d == max x y - min x y@, that is @d == abs(x-y)@. -   The default implementation is not efficient,-   because it compares the values and then subtracts, again, if safe.-   @max 0 (x-y)@ is more elegant and efficient-   but not possible in the general case,-   since @x-y@ may already yield a negative number.+   We have chosen this function as base function,+   since it provides comparison and subtraction in one go,+   which is important for replacing common structures like++   > if x<=y+   >   then f(x-y)+   >   else g(y-x)++   that lead to a memory leak for peano numbers.+   We have choosen the simple check @x<=y@+   instead of a full-blown @compare@,+   since we want @Zero <= undefined@ for peano numbers.+   Because of undefined values 'split' is in general+   not commutative in the sense++   > let (m0,(b0,d0)) = split x y+   >     (m1,(b1,d1)) = split y x+   > in  m0==m1 && d0==d1++   The result values are in the order+   in which they are generated for Peano numbers.+   We have chosen the nested pair instead of a triple+   in order to prevent a memory leak+   that occurs if you only use @b@ and @d@ and ignore @m@.+   This is demonstrated by test cases+   Chunky.splitSpaceLeak3 and Chunky.splitSpaceLeak4.    -}-   (-|) :: a -> a -> a-   x -| y  =  if x >= y then x-y else 0+   split :: a -> a -> (a, (Bool, a))+++{- |+Default implementation for wrapped types of 'Ord' and 'Num' class.+-}+{-# INLINE splitDefault #-}+splitDefault ::+   (Ord b, Num b) =>+   (a -> b) -> (b -> a) -> a -> a -> (a, (Bool, a))+splitDefault unpack pack px py =+   let x = unpack px+       y = unpack py+   in  if x<=y+         then (pack x, (True,  pack (y-x)))+         else (pack y, (False, pack (x-y)))+++zero :: C a => a+zero = Monoid.mempty++-- like (+)+infixl 6 `add`++add :: C a => a -> a -> a+add = Monoid.mappend++sum :: C a => [a] -> a+sum = Monoid.mconcat++{- |+Left biased maximum of a list of numbers that can also be empty.+It holds++> maximum [] == zero+-}+maximum :: C a => [a] -> a+maximum = foldl max zero++{- |+In @switchDifferenceNegative x y branchXminusY branchYminusX@+the function @branchXminusY@ is applied to @x-y@+if this difference is non-negative,+otherwise @branchYminusX@ is applied to @y-x@.+-}+switchDifferenceNegative ::+   C a =>+   a -> a -> (a -> b) -> (a -> b) -> b+switchDifferenceNegative x y branchXminusY branchYminusX =+   let (b,d) = snd $ split y x+   in  if b+         then branchXminusY d+         else branchYminusX d+++{- |+In @switchDifferenceOrdering x y branchZero branchXminusY branchYminusX@+-}+switchDifferenceOrdering ::+   C a =>+   a -> a -> b -> (a -> b) -> (a -> b) -> b+switchDifferenceOrdering x y branchZero branchXminusY branchYminusX =+   let (b,d) = snd $ split y x+   in  if b+         then+           if d==zero+             then branchZero+             else branchXminusY d+         else branchYminusX d+++{- |+@x -| y == max 0 (x-y)@++The default implementation is not efficient,+because it compares the values and then subtracts, again, if safe.+@max 0 (x-y)@ is more elegant and efficient+but not possible in the general case,+since @x-y@ may already yield a negative number.+-}+(-|) :: C a => a -> a -> a+x -| y  =+   let (b,d) = snd $ split y x+   in  if b then d else zero
− src/Numeric/NonNegative/Utility.hs 
@@ -1,11 +0,0 @@-module Numeric.NonNegative.Utility where---mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)-mapPair ~(f,g) ~(x,y) = (f x, g y)--mapFst :: (a -> c) -> (a,b) -> (c,b)-mapFst f ~(x,y) = (f x, y)--mapSnd :: (b -> d) -> (a,b) -> (a,d)-mapSnd g ~(x,y) = (x, g y)
src/Numeric/NonNegative/Wrapper.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2007+Copyright   :  (c) Henning Thielemann 2007-2010  Maintainer  :  haskell@henning-thielemann.de Stability   :  stable@@ -15,9 +15,12 @@     Int, Integer, Float, Double, Ratio, Rational) where  import qualified Numeric.NonNegative.Class as NonNeg+import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Semigroup (Semigroup(sconcat, (<>)))+import Data.List.NonEmpty (NonEmpty((:|))) -import Test.QuickCheck (Arbitrary(arbitrary))-import Numeric.NonNegative.Utility(mapPair, mapSnd)+import Test.QuickCheck (Arbitrary(arbitrary, shrink))+import Data.Tuple.HT (mapPair, mapSnd, ) import Control.Monad (liftM)  import qualified Data.Ratio as R@@ -103,9 +106,17 @@ lift2 f (Cons x) (Cons y) = Cons $ f x y  +instance (Num a) => Semigroup (T a) where+   Cons x <> Cons y = Cons (x+y)+   sconcat (x :| xs) = Cons $ toNumber x + sum (map toNumber xs) +instance (Num a) => Monoid (T a) where+   mempty = Cons 0+   mappend (Cons x) (Cons y) = Cons (x+y)+   mconcat = Cons . sum . map toNumber+ instance (Ord a, Num a) => NonNeg.C (T a) where-   (Cons x) -| (Cons y) = fromNumberClip (x-y)+   split = NonNeg.splitDefault toNumber Cons  instance (Ord a, Num a) => Num (T a) where    (+)    = lift2 (+)@@ -174,6 +185,7 @@  instance (Num a, Arbitrary a) => Arbitrary (T a) where    arbitrary = liftM (Cons . abs) arbitrary+   shrink (Cons xs) = map (Cons . abs) $ shrink xs   type Int      = T P.Int