mixed-types-num 0.3.1.5 → 0.3.2

raw patch · 10 files changed

+222/−12 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +8/−0
• mixed-types-num.cabal +2/−2
• src/MixedTypesNumPrelude.hs +2/−0
• src/Numeric/MixedTypes/Elementary.hs +8/−4
• src/Numeric/MixedTypes/Eq.hs +5/−0
• src/Numeric/MixedTypes/PreludeHiding.hs +1/−1
• src/Numeric/MixedTypes/Ring.hs +2/−2
• src/Numeric/MixedTypes/Round.hs +129/−3
• src/Utils/Test/EnforceRange.hs +63/−0
• test/Numeric/MixedTypes/RoundSpec.hs +2/−0

@@ -1,3 +1,11 @@+# mixed-types-num change log++* v 0.3.2 2019-01-08+  * added divI and mod+  * added enforceRange+  * used enforceRange in exp tests+* v 0.3.1.5 2018-11-14+  * improved documentation * v 0.3.1.4 2017-12-06   * removed upper bounds for dependencies * v 0.3.1.3 2017-08-22

@@ -1,5 +1,5 @@ name:           mixed-types-num-version:        0.3.1.5+version:        0.3.2 cabal-version:  >= 1.9.2 build-type:     Simple homepage:       https://github.com/michalkonecny/mixed-types-num@@ -10,7 +10,6 @@ license-file:   LICENSE extra-source-files:  changelog.md stability:      experimental-tested-with:    GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.1 category:       Math synopsis:       Alternative Prelude with numeric and logic expressions typed bottom-up Description:@@ -64,6 +63,7 @@     UndecidableInstances   exposed-modules:     Utils.TH.DeclForTypes+    Utils.Test.EnforceRange     Control.CollectErrors     Numeric.CollectErrors     Numeric.MixedTypes.PreludeHiding

@@ -52,6 +52,7 @@   module Numeric.MixedTypes.Complex,   module Numeric.CollectErrors,   module Utils.TH.DeclForTypes,+  module Utils.Test.EnforceRange,   -- * Re-export for convenient Rational literals   (%) )@@ -59,6 +60,7 @@  import Data.Ratio ((%)) import Utils.TH.DeclForTypes+import Utils.Test.EnforceRange import Numeric.CollectErrors import Numeric.MixedTypes.PreludeHiding import Numeric.MixedTypes.Literals

@@ -41,11 +41,14 @@ import Numeric.MixedTypes.Bool import Numeric.MixedTypes.Eq import Numeric.MixedTypes.Ord--- import Numeric.MixedTypes.MinMaxSqrt+-- import Numeric.MixedTypes.MinMaxAbs import Numeric.MixedTypes.AddSub import Numeric.MixedTypes.Ring import Numeric.MixedTypes.Field+-- import Numeric.MixedTypes.Round +import Utils.Test.EnforceRange + {----  sqrt -----}  {-|@@ -155,13 +158,14 @@    HasOrderAsymmetric Integer t, CanAddAsymmetric t t,    CanMulAsymmetric (ExpType t) (ExpType t),    CanDiv Integer (ExpType t), CanExp t, CanExp (AddType t t),-   NegType t ~ t) =>+   NegType t ~ t, +   CanEnforceRange t Integer) =>    T t -> Spec specCanExpReal (T typeName :: T t) =   describe (printf "CanExp %s" typeName) $ do     it "exp(x) >= 0" $ do-      property $ \ (x :: t) ->-        ((-100000) !<! x && x !<! 100000) ==>+      property $ \ (x_ :: t) ->+        let x = enforceRange (Just (-100000), Just 100000) x_ in           exp x ?>=?$ 0     it "exp(-x) == 1/(exp x)" $ do       property $ \ (x :: t) ->

@@ -312,8 +312,13 @@ instance CanTestNaN Double instance CanTestFinite Double +instance CanTestNaN Integer where+  isNaN = const False instance CanTestNaN Rational where   isNaN = const False+instance CanTestFinite Integer where+  isInfinite = const False+  isFinite = const True instance CanTestFinite Rational where   isInfinite = const False   isFinite = const True

@@ -20,7 +20,7 @@   (     fromInteger, fromRational     , (!!), length, replicate, take, drop, splitAt-    , Eq(..), Ord(..), Num(..), Fractional(..), RealFrac(..), Floating(..)+    , Eq(..), Ord(..), Num(..), Fractional(..), RealFrac(..), Floating(..), Integral(..)     , not, (&&), (||), and, or     , (^), (^^)     , minimum, maximum, sum, product

@@ -402,9 +402,9 @@     aux m       | m == 1 = x       | even m =-        let s = aux (m `div` 2) in s * s+        let s = aux (m `P.div` 2) in s * s       | otherwise =-        let s = aux ((m-1) `div` 2) in x * s * s+        let s = aux ((m-1) `P.div` 2) in x * s * s  type CanPowBy t1 t2 =   (CanPow t1 t2, PowType t1 t2 ~ t1, PowTypeNoCN t1 t2 ~ t1)

@@ -12,28 +12,154 @@  module Numeric.MixedTypes.Round (-  -- * Rounding operations-  CanRound(..), HasIntegerBounds(..)+  -- * Rounded division + modulus+  CanDivIMod(..), CanDivIModIntegerSameType, modNoCN, divINoCN, divIModNoCN+  -- * Rounding+  , CanRound(..), HasIntegerBounds(..)   -- ** Tests-  , specCanRound, specHasIntegerBounds+  , specCanDivIMod, specCanRound, specHasIntegerBounds ) where  import Numeric.MixedTypes.PreludeHiding import qualified Prelude as P import Text.Printf+import Data.Fixed (divMod')  -- import qualified Data.List as List  import Test.Hspec import Test.QuickCheck as QC +import Numeric.CollectErrors+-- import Control.CollectErrors+ import Numeric.MixedTypes.Literals import Numeric.MixedTypes.Bool import Numeric.MixedTypes.Eq import Numeric.MixedTypes.Ord -- import Numeric.MixedTypes.MinMaxAbs import Numeric.MixedTypes.AddSub+import Numeric.MixedTypes.Ring++{----  rounded division + modulo -----}++class CanDivIMod t1 t2 where+  type DivIType t1 t2+  type DivIType t1 t2 = CN Integer+  type ModType t1 t2+  type ModType t1 t2 = EnsureCN t1+  divIMod :: t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)+  mod :: t1 -> t2 -> ModType t1 t2+  mod a b = snd $ divIMod a b+  divI :: t1 -> t2 -> DivIType t1 t2+  divI a b = fst $ divIMod a b++type CanDivIModIntegerSameType t =+  (CanDivIMod t t, CanEnsureCN t, DivIType t t ~ CN Integer, ModType t t ~ EnsureCN t)++modNoCN :: +  (CanDivIMod t1 t2+  , ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1)+  => +  t1 -> t2 -> t1+modNoCN x m = +  case deEnsureCN $ x `mod` m of+    Left err -> error $ show err+    Right xm -> xm++divINoCN :: +  (CanDivIMod t1 t2, DivIType t1 t2 ~ CN Integer)+  => +  t1 -> t2 -> Integer+divINoCN x m = (~!) $ x `divI` m++divIModNoCN :: +  (CanDivIMod t1 t2+  , ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1+  , DivIType t1 t2 ~ CN Integer)+  => +  t1 -> t2 -> (Integer, t1)+divIModNoCN x m = +  case deEnsureCN xm of+    Left err -> error $ show err+    Right xm2 -> ((~!) d, xm2)+  where+  (d,xm) = divIMod x m++instance CanDivIMod Integer Integer where+  divIMod x m +    | m > 0 = (cn d, cn xm)+    | otherwise = (err, err)+    where+    (d,xm) = P.divMod x m+    err = noValueNumErrorCertainECN sample_v $ OutOfRange $ "modulus not positive: " ++ show m+    sample_v = Just x++instance CanDivIMod Rational Rational where+  divIMod x m +    | m > 0 = (cn d, cn xm)+    | otherwise = (err (d :: Integer), err xm)+    where+    (d,xm) = divMod' x m+    err :: (CanEnsureCN t) => t -> EnsureCN t+    err s = noValueNumErrorCertainECN (Just s) $ OutOfRange $ "modulus not positive: " ++ show m++instance CanDivIMod Rational Integer where+  divIMod x m = divIMod x (rational m)++instance CanDivIMod Double Double where+  divIMod x m +    | m > 0 = (cn d, cn xm)+    | otherwise = (err (d :: Integer), err xm)+    where+    (d,xm) = divMod' x m+    err :: (CanEnsureCN t) => t -> EnsureCN t+    err s = noValueNumErrorCertainECN (Just s) $ OutOfRange $ "modulus not positive: " ++ show m++instance CanDivIMod Double Integer where+  divIMod x m = divIMod x (double m)++type CanDivIModX t =+  (CanDivIMod t t,+   ModType t t ~ EnsureCN t,+   DivIType t t ~ CN Integer,+   EnsureNoCN t ~ t,+   CanEnsureCN t,+   CanMulBy t Integer,+   CanAddSameType t,+   HasOrderCertainly t Integer,+   HasOrderCertainly t t,+   HasEqCertainly t t,+   CanTestFinite t,+   Show t, Arbitrary t)++{-|+  HSpec properties that each implementation of CanRound should satisfy.+ -}+specCanDivIMod ::+  (CanDivIModX t, HasIntegers t)+  =>+  T t -> Spec+specCanDivIMod (T typeName :: T t) =+  describe (printf "CanDivMod %s %s" typeName typeName) $ do+    it "holds 0 <= x `mod` m < m" $ do+      property $ \ (x :: t)  (m :: t) ->+        isFinite x && m !>! 0 ==>+          let xm = x `modNoCN` m in+          (0 ?<=?$ xm) .&&. (xm ?<?$ m)+    it "holds x == (x `div'` m)*m + (x `mod` m)" $ do+      property $ \ (x :: t)  (m :: t) ->+        isFinite x && m !>! 0 ==>+          let (d,xm) = divIModNoCN x m in+          (x ?==?$ (d*m + xm))+  where+  (?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property+  (?<=?$) = printArgsIfFails2 "?<=?" (?<=?)+  (?<?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property+  (?<?$) = printArgsIfFails2 "?<?" (?<?)+  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property+  (?==?$) = printArgsIfFails2 "?==?" (?==?)  {----  rounding -----} 

@@ -0,0 +1,63 @@+{-|+    Module      :  Utils.Test.EnforceRange+    Description :  squash generated numbers to a given range+    Copyright   :  (c) Michal Konecny+    License     :  BSD3++    Maintainer  :  mikkonecny@gmail.com+    Stability   :  experimental+    Portability :  portable++    Utility for squashing randomly generated numbers to a given range.+-}+module Utils.Test.EnforceRange +    (enforceRange, CanEnforceRange)+where++import Numeric.MixedTypes.PreludeHiding+-- import qualified Prelude as P++-- import Numeric.CollectErrors++import Numeric.MixedTypes.Literals+import Numeric.MixedTypes.Bool+-- import Numeric.MixedTypes.Eq+import Numeric.MixedTypes.Ord+import Numeric.MixedTypes.MinMaxAbs+import Numeric.MixedTypes.AddSub+import Numeric.MixedTypes.Ring+import Numeric.MixedTypes.Round++type CanEnforceRange t b =+    (CanAddSubMulBy t Integer+    , CanAddSameType t, CanSubSameType t, CanAbsSameType t+    , CanDivIModIntegerSameType t+    , ConvertibleExactly b t+    , HasOrderCertainly t t)++{-| +    @enforceRange (Just l, Just u) a@ where @l < u@ returns an arbitrary value @b@ with @u < b < l@.+    Moreover, the returned values are distributed roughly evenly if the input values @a@ are distributed +    roughly evenly in a large neighbourhood of the interval @[l,r]@.+    In most cases, when @l<a<u@, then @b=a@.+-}+enforceRange ::+    (CanEnforceRange t b) => (Maybe b, Maybe b) -> t -> t+enforceRange (Just l_, Just u_) (a::t) +    | not (l + 1 !<! u) = error "enforceRange: inconsistent range"+    | l !<! a && a !<! u = a+    | otherwise = l + 1 + ((abs a) `modNoCN` (u-l-1))+    where+    l = convertExactly l_ :: t+    u = convertExactly u_ :: t+enforceRange (Just l_, _) (a::t)+    | l !<! a = a+    | otherwise = (2*l-a+1)+    where+    l = convertExactly l_ :: t+enforceRange (_, Just u_) (a::t)+    | a !<! u = a+    | otherwise = (2*u-a-1)+    where+    u = convertExactly u_ :: t+enforceRange _ a = a

@@ -17,5 +17,7 @@  spec :: Spec spec = do+  specCanDivIMod tInteger+  specCanDivIMod tRational   specCanRound tRational   -- specCanRound tDouble