NonNegative.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-
Rationale for -fno-warn-orphans:
 * The orphan instances can't be put into Numeric.NonNegative.Wrapper
   since that's in another package.
 * We had to spread the instance declarations
   over the modules defining the typeclasses instantiated.
   Do we want that?
-}

{- |
Copyright   :  (c) Henning Thielemann 2007

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

A type for non-negative numbers.
It performs a run-time check at construction time (i.e. at run-time)
and is a member of the non-negative number type class
'Numeric.NonNegative.Class.C'.
-}
module Number.NonNegative
   (T, fromNumber, fromNumberMsg, fromNumberClip, fromNumberUnsafe, toNumber,
    NonNegW.Int, NonNegW.Integer, NonNegW.Float, NonNegW.Double,
    Ratio, Rational) where

import Numeric.NonNegative.Wrapper
   (T, fromNumberUnsafe, toNumber, )
import qualified Numeric.NonNegative.Wrapper as NonNegW

import qualified Algebra.NonNegative        as NonNeg
import qualified Algebra.Transcendental     as Trans
import qualified Algebra.Algebraic          as Algebraic
import qualified Algebra.RealRing          as RealRing
import qualified Algebra.Field              as Field
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.Monoid             as Monoid
import qualified Algebra.ZeroTestable       as ZeroTestable

import qualified Algebra.ToInteger          as ToInteger
import qualified Algebra.ToRational         as ToRational
-- import Test.QuickCheck (Arbitrary(arbitrary))

import qualified Number.Ratio as R

import qualified Prelude as P

import NumericPrelude.Base
import Data.Tuple.HT (mapSnd, mapPair, )
import NumericPrelude.Numeric hiding (Int, Integer, Float, Double, Rational, )


{- |
Convert a number to a non-negative number.
If a negative number is given, an error is raised.
-}
fromNumber :: (Ord a, Additive.C a) =>
      a
   -> T a
fromNumber = fromNumberMsg "fromNumber"

fromNumberMsg :: (Ord a, Additive.C a) =>
      String  {- ^ name of the calling function to be used in the error message -}
   -> a
   -> T a
fromNumberMsg funcName x =
   if x>=zero
     then fromNumberUnsafe x
     else error (funcName++": negative number")

fromNumberWrap :: (Ord a, Additive.C a) =>
      String
   -> a
   -> T a
fromNumberWrap funcName =
   fromNumberMsg ("Number.NonNegative."++funcName)

{- |
Convert a number to a non-negative number.
A negative number will be replaced by zero.
Use this function with care since it may hide bugs.
-}
fromNumberClip :: (Ord a, Additive.C a) =>
      a
   -> T a
fromNumberClip = fromNumberUnsafe . max zero



{- |
Results are not checked for positivity.
-}
lift :: (a -> a) -> (T a -> T a)
lift f = fromNumberUnsafe . f . toNumber

liftWrap :: (Ord a, Additive.C a) => String -> (a -> a) -> (T a -> T a)
liftWrap msg f = fromNumberWrap msg . f . toNumber


{- |
Results are not checked for positivity.
-}
lift2 :: (a -> a -> a) -> (T a -> T a -> T a)
lift2 f x y =
   fromNumberUnsafe $ f (toNumber x) (toNumber y)



instance ZeroTestable.C a => ZeroTestable.C (T a) where
   isZero = isZero . toNumber

instance (Additive.C a) => Monoid.C (T a) where
   idt = fromNumberUnsafe Additive.zero
   x <*> y = fromNumberUnsafe (toNumber x + toNumber y)
--   mconcat = fromNumberUnsafe . sum . map toNumber

instance (Ord a, Additive.C a) => NonNeg.C (T a) where
   split = NonNeg.splitDefault toNumber fromNumberUnsafe

instance (Ord a, Additive.C a) => Additive.C (T a) where
   zero   = fromNumberUnsafe zero
   (+)    = lift2 (+)
   (-)    = liftWrap "-" . (-) . toNumber
   negate = liftWrap "negate" negate

instance (Ord a, Ring.C a) => Ring.C (T a) where
   (*)    = lift2 (*)
   fromInteger = fromNumberWrap "fromInteger" . fromInteger

instance (Ord a, ToRational.C a) => ToRational.C (T a) where
   toRational = ToRational.toRational . toNumber

instance ToInteger.C a => ToInteger.C (T a) where
   toInteger = toInteger . toNumber

{- already defined in the imported module
instance (Ord a, Additive.C a, Enum a) => Enum (T a) where
   toEnum   = fromNumberWrap "toEnum" . toEnum
   fromEnum = fromEnum . toNumber

instance (Ord a, Additive.C a, Bounded a) => Bounded (T a) where
   minBound = fromNumberClip minBound
   maxBound = fromNumberWrap "maxBound" maxBound

instance (Additive.C a, Arbitrary a) => Arbitrary (T a) where
   arbitrary = liftM (fromNumberUnsafe . abs) arbitrary
-}

instance RealIntegral.C a => RealIntegral.C (T a) where
   quot = lift2 quot
   rem  = lift2 rem
   quotRem x y =
      mapPair
         (fromNumberUnsafe, fromNumberUnsafe)
         (quotRem (toNumber x) (toNumber y))

instance (Ord a, Integral.C a) => Integral.C (T a) where
   div  = lift2 div
   mod  = lift2 mod
   divMod x y =
      mapPair
         (fromNumberUnsafe, fromNumberUnsafe)
         (divMod (toNumber x) (toNumber y))

instance (Ord a, Field.C a) => Field.C (T a) where
   fromRational' = fromNumberWrap "fromRational" . fromRational'
   (/) = lift2 (/)


instance (ZeroTestable.C a, Ord a, Absolute.C a) => Absolute.C (T a) where
   abs    = lift abs
   signum = lift signum

instance (RealRing.C a) => RealRing.C (T a) where
   splitFraction = mapSnd fromNumberUnsafe . splitFraction . toNumber
   truncate = truncate . toNumber
   round    = round    . toNumber
   ceiling  = ceiling  . toNumber
   floor    = floor    . toNumber

instance (Ord a, Algebraic.C a) => Algebraic.C (T a) where
   sqrt = lift sqrt
   (^/) x r = lift (^/ r) x

instance (Ord a, Trans.C a) => Trans.C (T a) where
   pi = fromNumber pi
   exp  = lift exp
   log  = liftWrap "log" log
   (**) = lift2 (**)
   logBase = liftWrap "logBase" . logBase . toNumber
   sin = liftWrap "sin" sin
   tan = liftWrap "tan" tan
   cos = liftWrap "cos" cos
   asin = liftWrap "asin" asin
   atan = liftWrap "atan" atan
   acos = liftWrap "acos" acos
   sinh = liftWrap "sinh" sinh
   tanh = liftWrap "tanh" tanh
   cosh = liftWrap "cosh" cosh
   asinh = liftWrap "asinh" asinh
   atanh = liftWrap "atanh" atanh
   acosh = liftWrap "acosh" acosh


type Ratio a  = T (R.T a)
type Rational = T R.Rational


{- legacy instances already defined in non-negative package -}