decimal-arithmetic-0.5.1.0: An implementation of the General Decimal Arithmetic Specification

Copyright© 2016–2017 Robert Leslie
LicenseBSD3
Maintainerrob@mars.org
Stabilityexperimental
Safe HaskellTrustworthy
LanguageHaskell2010

Numeric.Decimal

Contents

Description

This module provides a general-purpose number type supporting decimal arithmetic for both limited precision floating-point (IEEE 754-2008) and for arbitrary precision floating-point (following the same principles as IEEE 754 and IEEE 854-1987) as described in the General Decimal Arithmetic Specification by Mike Cowlishaw. In addition to floating-point arithmetic, integer and unrounded floating-point arithmetic are included as subsets.

Unlike the binary floating-point types Float and Double, decimal number types can perform decimal arithmetic exactly. Internally, decimal numbers are represented with an integral coefficient and base-10 exponent.

>>> 29.99 + 4.71 :: Double
34.699999999999996
>>> 29.99 + 4.71 :: BasicDecimal
34.70
>>> 0.1 + 0.2 == (0.3 :: Double)
False
>>> 0.1 + 0.2 == (0.3 :: BasicDecimal)
True

Decimal numbers support lossless conversion to and from a string representation via Show and Read instances. Note that there may be multiple representations of values that are numerically equal (e.g. 1 and 1.00) which are preserved by this conversion.

Some decimal numbers also support encoding and decoding specific IEEE 754 interchange formats via a Binary instance.

Synopsis

Usage

You should choose a decimal number type with appropriate precision and rounding to use in your application. There are several options:

  • BasicDecimal is a number type with 9 decimal digits of precision that rounds half up.
  • ExtendedDecimal is a number type constructor with selectable precision that rounds half even. For example, ExtendedDecimal P15 is a number type with 15 decimal digits of precision. There is a range of ready-made precisions available, including P1 through P50 on up to P2000.
  • GeneralDecimal is a number type with infinite precision. Note that not all operations support numbers with infinite precision.
  • Decimal32, Decimal64, and Decimal128 are specialized number types with Binary instances that implement the decimal32, decimal64, and decimal128 interchange format encodings described in IEEE 754-2008. These types have precisions of 7, 16, and 34 decimal digits, respectively, and round half even.
  • The most versatile Decimal type constructor is parameterized by both a precision and a rounding algorithm. For example, Decimal P20 RoundDown is a number type with 20 decimal digits of precision that rounds down (truncates). Several Rounding algorithms are available to choose from.

A decimal number type may be used in a default declaration, for example replacing Double:

default (Integer, BasicDecimal)

Advanced usage

Additional operations and control beyond what is provided by the standard type classes are available through the use of Numeric.Decimal.Arithmetic and Numeric.Decimal.Operation. Advanced string conversion is also available through Numeric.Decimal.Conversion.

Arbitrary precisions can be constructed through type application of PPlus1 and/or PTimes2 to any existing precision.

It is possible to create arbitrary width interchange format encodings with the help of Numeric.Decimal.Encoding.

Arbitrary-precision decimal numbers

data Decimal p r Source #

A decimal floating point number with selectable precision and rounding algorithm

Instances
(Precision p, Rounding r) => Enum (Decimal p r) Source #

Unlike the instances for Float and Double, the lists returned by the enumFromTo and enumFromThenTo methods in this instance terminate with the last element strictly less than (greater than in the case of a negative increment) or equal to the given bound.

Instance details

Defined in Numeric.Decimal.Number

Methods

succ :: Decimal p r -> Decimal p r #

pred :: Decimal p r -> Decimal p r #

toEnum :: Int -> Decimal p r #

fromEnum :: Decimal p r -> Int #

enumFrom :: Decimal p r -> [Decimal p r] #

enumFromThen :: Decimal p r -> Decimal p r -> [Decimal p r] #

enumFromTo :: Decimal p r -> Decimal p r -> [Decimal p r] #

enumFromThenTo :: Decimal p r -> Decimal p r -> Decimal p r -> [Decimal p r] #

Eq (Decimal p r) Source #

Note that NaN values are not equal to any value, including other NaNs.

Instance details

Defined in Numeric.Decimal.Number

Methods

(==) :: Decimal p r -> Decimal p r -> Bool #

(/=) :: Decimal p r -> Decimal p r -> Bool #

(FinitePrecision p, Rounding r) => Floating (Decimal p r) Source #

The constant pi is precision-dependent.

Instance details

Defined in Numeric.Decimal.Number

Methods

pi :: Decimal p r #

exp :: Decimal p r -> Decimal p r #

log :: Decimal p r -> Decimal p r #

sqrt :: Decimal p r -> Decimal p r #

(**) :: Decimal p r -> Decimal p r -> Decimal p r #

logBase :: Decimal p r -> Decimal p r -> Decimal p r #

sin :: Decimal p r -> Decimal p r #

cos :: Decimal p r -> Decimal p r #

tan :: Decimal p r -> Decimal p r #

asin :: Decimal p r -> Decimal p r #

acos :: Decimal p r -> Decimal p r #

atan :: Decimal p r -> Decimal p r #

sinh :: Decimal p r -> Decimal p r #

cosh :: Decimal p r -> Decimal p r #

tanh :: Decimal p r -> Decimal p r #

asinh :: Decimal p r -> Decimal p r #

acosh :: Decimal p r -> Decimal p r #

atanh :: Decimal p r -> Decimal p r #

log1p :: Decimal p r -> Decimal p r #

expm1 :: Decimal p r -> Decimal p r #

log1pexp :: Decimal p r -> Decimal p r #

log1mexp :: Decimal p r -> Decimal p r #

(FinitePrecision p, Rounding r) => Fractional (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

(/) :: Decimal p r -> Decimal p r -> Decimal p r #

recip :: Decimal p r -> Decimal p r #

fromRational :: Rational -> Decimal p r #

(Precision p, Rounding r) => Num (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

(+) :: Decimal p r -> Decimal p r -> Decimal p r #

(-) :: Decimal p r -> Decimal p r -> Decimal p r #

(*) :: Decimal p r -> Decimal p r -> Decimal p r #

negate :: Decimal p r -> Decimal p r #

abs :: Decimal p r -> Decimal p r #

signum :: Decimal p r -> Decimal p r #

fromInteger :: Integer -> Decimal p r #

Ord (Decimal p r) Source #

Unlike the instances for Float and Double, the compare method in this instance uses a total ordering over all possible values. Note that compare x y == EQ does not imply x == y (and similarly for LT and GT) in the cases where x or y are NaN values.

Instance details

Defined in Numeric.Decimal.Number

Methods

compare :: Decimal p r -> Decimal p r -> Ordering #

(<) :: Decimal p r -> Decimal p r -> Bool #

(<=) :: Decimal p r -> Decimal p r -> Bool #

(>) :: Decimal p r -> Decimal p r -> Bool #

(>=) :: Decimal p r -> Decimal p r -> Bool #

max :: Decimal p r -> Decimal p r -> Decimal p r #

min :: Decimal p r -> Decimal p r -> Decimal p r #

(Precision p, Rounding r) => Read (Decimal p r) Source #

The Read instance uses the toNumber operation from Numeric.Decimal.Conversion and rounds the result to the required precision.

Instance details

Defined in Numeric.Decimal.Number

(Precision p, Rounding r) => Real (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

toRational :: Decimal p r -> Rational #

(FinitePrecision p, Rounding r) => RealFloat (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

(FinitePrecision p, Rounding r) => RealFrac (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

properFraction :: Integral b => Decimal p r -> (b, Decimal p r) #

truncate :: Integral b => Decimal p r -> b #

round :: Integral b => Decimal p r -> b #

ceiling :: Integral b => Decimal p r -> b #

floor :: Integral b => Decimal p r -> b #

Show (Decimal p r) Source #

The Show instance uses the toScientificString operation from Numeric.Decimal.Conversion.

Instance details

Defined in Numeric.Decimal.Number

Methods

showsPrec :: Int -> Decimal p r -> ShowS #

show :: Decimal p r -> String #

showList :: [Decimal p r] -> ShowS #

FinitePrecision p => Bits (Decimal p r) Source #

The Bits instance makes use of the logical operations from the General Decimal Arithmetic Specification using a digit-wise representation of bits where the sign is non-negative, the exponent is 0, and each decimal digit of the coefficient must be either 0 or 1.

Instance details

Defined in Numeric.Decimal.Number

Methods

(.&.) :: Decimal p r -> Decimal p r -> Decimal p r #

(.|.) :: Decimal p r -> Decimal p r -> Decimal p r #

xor :: Decimal p r -> Decimal p r -> Decimal p r #

complement :: Decimal p r -> Decimal p r #

shift :: Decimal p r -> Int -> Decimal p r #

rotate :: Decimal p r -> Int -> Decimal p r #

zeroBits :: Decimal p r #

bit :: Int -> Decimal p r #

setBit :: Decimal p r -> Int -> Decimal p r #

clearBit :: Decimal p r -> Int -> Decimal p r #

complementBit :: Decimal p r -> Int -> Decimal p r #

testBit :: Decimal p r -> Int -> Bool #

bitSizeMaybe :: Decimal p r -> Maybe Int #

bitSize :: Decimal p r -> Int #

isSigned :: Decimal p r -> Bool #

shiftL :: Decimal p r -> Int -> Decimal p r #

unsafeShiftL :: Decimal p r -> Int -> Decimal p r #

shiftR :: Decimal p r -> Int -> Decimal p r #

unsafeShiftR :: Decimal p r -> Int -> Decimal p r #

rotateL :: Decimal p r -> Int -> Decimal p r #

rotateR :: Decimal p r -> Int -> Decimal p r #

popCount :: Decimal p r -> Int #

FinitePrecision p => FiniteBits (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Parameters k => Binary (Decimal (Format k DecimalCoefficient) r) #

A Binary instance is defined for interchange formats for which a Parameters instance exists, and covers particularly the Decimal32, Decimal64, and Decimal128 types.

Instance details

Defined in Numeric.Decimal.Encoding

NFData (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

rnf :: Decimal p r -> () #

Precision p => Precision (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

precision :: Decimal p r -> Maybe Int

eMax :: Decimal p r -> Maybe Exponent

eMin :: Decimal p r -> Maybe Exponent

type BasicDecimal = Decimal P9 RoundHalfUp Source #

A decimal floating point number with 9 digits of precision, rounding half up

type ExtendedDecimal p = Decimal p RoundHalfEven Source #

A decimal floating point number with selectable precision, rounding half even

type GeneralDecimal = ExtendedDecimal PInfinite Source #

A decimal floating point number with infinite precision

Number types with defined encodings

These decimal number types have a Binary instance that implements a specific interchange format encoding described in IEEE 754-2008. See Numeric.Decimal.Encoding for further details, including the ability to create additional formats of arbitrary width.

Alternative rounding algorithms can be used through the more general Decimal type constructor and the special precision types Pdecimal32, Pdecimal64, or Pdecimal128, e.g. Decimal Pdecimal64 RoundCeiling.

type Decimal32 = ExtendedDecimal Pdecimal32 Source #

A decimal floating point number with 7 digits of precision, rounding half even, and a 32-bit encoded representation using the decimal32 interchange format (with a decimal encoding for the coefficient)

type Decimal64 = ExtendedDecimal Pdecimal64 Source #

A decimal floating point number with 16 digits of precision, rounding half even, and a 64-bit encoded representation using the decimal64 interchange format (with a decimal encoding for the coefficient)

type Decimal128 = ExtendedDecimal Pdecimal128 Source #

A decimal floating point number with 34 digits of precision, rounding half even, and a 128-bit encoded representation using the decimal128 interchange format (with a decimal encoding for the coefficient)

Precision types

class Precision p Source #

Precision indicates the maximum number of significant decimal digits a number may have.

Minimal complete definition

precision

Instances
Precision P1 Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: P1 -> Maybe Int

eMax :: P1 -> Maybe Exponent

eMin :: P1 -> Maybe Exponent

Precision PInfinite Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: PInfinite -> Maybe Int

eMax :: PInfinite -> Maybe Exponent

eMin :: PInfinite -> Maybe Exponent

Precision p => Precision (PTimes2 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: PTimes2 p -> Maybe Int

eMax :: PTimes2 p -> Maybe Exponent

eMin :: PTimes2 p -> Maybe Exponent

Precision p => Precision (PPlus1 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: PPlus1 p -> Maybe Int

eMax :: PPlus1 p -> Maybe Exponent

eMin :: PPlus1 p -> Maybe Exponent

Precision p => Precision (Decimal p r) Source # 
Instance details

Defined in Numeric.Decimal.Number

Methods

precision :: Decimal p r -> Maybe Int

eMax :: Decimal p r -> Maybe Exponent

eMin :: Decimal p r -> Maybe Exponent

Parameters k => Precision (Format k c) Source #

This Precision instance automatically computes the precision and Emax of decimal numbers that use this format.

Instance details

Defined in Numeric.Decimal.Encoding

Methods

precision :: Format k c -> Maybe Int

eMax :: Format k c -> Maybe Exponent

eMin :: Format k c -> Maybe Exponent

class Precision p => FinitePrecision p Source #

A subclass of precisions that are finite

Instances
FinitePrecision P1 Source # 
Instance details

Defined in Numeric.Decimal.Precision

FinitePrecision p => FinitePrecision (PTimes2 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

FinitePrecision p => FinitePrecision (PPlus1 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Parameters k => FinitePrecision (Format k c) Source # 
Instance details

Defined in Numeric.Decimal.Encoding

data P1 Source #

A precision of 1 significant digit

Instances
FinitePrecision P1 Source # 
Instance details

Defined in Numeric.Decimal.Precision

Precision P1 Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: P1 -> Maybe Int

eMax :: P1 -> Maybe Exponent

eMin :: P1 -> Maybe Exponent

type P2 = PTimes2 P1 Source #

A precision of 2 significant digits

type P3 = PPlus1 P2 Source #

A precision of 3 significant digits

type P4 = PTimes2 P2 Source #

Et cetera

type P75 = PPlus1 P74 Source #

type P250 = PTimes2 P125 Source #

data PPlus1 p Source #

A precision of (p + 1) significant digits

Instances
FinitePrecision p => FinitePrecision (PPlus1 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Precision p => Precision (PPlus1 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: PPlus1 p -> Maybe Int

eMax :: PPlus1 p -> Maybe Exponent

eMin :: PPlus1 p -> Maybe Exponent

data PTimes2 p Source #

A precision of (p × 2) significant digits

Instances
FinitePrecision p => FinitePrecision (PTimes2 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Precision p => Precision (PTimes2 p) Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: PTimes2 p -> Maybe Int

eMax :: PTimes2 p -> Maybe Exponent

eMin :: PTimes2 p -> Maybe Exponent

data PInfinite Source #

A precision of unlimited significant digits

Instances
Precision PInfinite Source # 
Instance details

Defined in Numeric.Decimal.Precision

Methods

precision :: PInfinite -> Maybe Int

eMax :: PInfinite -> Maybe Exponent

eMin :: PInfinite -> Maybe Exponent

type Pdecimal32 = Format K32 DecimalCoefficient Source #

A type with Precision instance specifying decimal32 interchange format parameters (using a decimal encoding for the coefficient) having an effective precision of 7 decimal digits

type Pdecimal64 = Format K64 DecimalCoefficient Source #

A type with Precision instance specifying decimal64 interchange format parameters (using a decimal encoding for the coefficient) having an effective precision of 16 decimal digits

type Pdecimal128 = Format K128 DecimalCoefficient Source #

A type with Precision instance specifying decimal128 interchange format parameters (using a decimal encoding for the coefficient) having an effective precision of 34 decimal digits

Rounding types

class Rounding r Source #

A rounding algorithm to use when the result of an arithmetic operation exceeds the precision of the result type

Minimal complete definition

rounding, roundCoefficient

data RoundHalfUp Source #

If the discarded digits represent greater than or equal to half (0.5) of the value of a one in the next left position then the result coefficient should be incremented by 1 (rounded up). Otherwise the discarded digits are ignored.

data RoundHalfEven Source #

If the discarded digits represent greater than half (0.5) the value of a one in the next left position then the result coefficient should be incremented by 1 (rounded up). If they represent less than half, then the result coefficient is not adjusted (that is, the discarded digits are ignored).

Otherwise (they represent exactly half) the result coefficient is unaltered if its rightmost digit is even, or incremented by 1 (rounded up) if its rightmost digit is odd (to make an even digit).

data RoundHalfDown Source #

If the discarded digits represent greater than half (0.5) of the value of a one in the next left position then the result coefficient should be incremented by 1 (rounded up). Otherwise (the discarded digits are 0.5 or less) the discarded digits are ignored.

data RoundCeiling Source #

(Round toward +∞.) If all of the discarded digits are zero or if the sign is 1 the result is unchanged. Otherwise, the result coefficient should be incremented by 1 (rounded up).

data RoundFloor Source #

(Round toward −∞.) If all of the discarded digits are zero or if the sign is 0 the result is unchanged. Otherwise, the sign is 1 and the result coefficient should be incremented by 1.

data RoundUp Source #

(Round away from 0.) If all of the discarded digits are zero the result is unchanged. Otherwise, the result coefficient should be incremented by 1 (rounded up).

Instances
Rounding RoundUp Source # 
Instance details

Defined in Numeric.Decimal.Rounding

data Round05Up Source #

(Round zero or five away from 0.) The same as RoundUp, except that rounding up only occurs if the digit to be rounded up is 0 or 5, and after overflow the result is the same as for RoundDown.

Instances
Rounding Round05Up Source # 
Instance details

Defined in Numeric.Decimal.Rounding

data RoundDown Source #

(Round toward 0; truncate.) The discarded digits are ignored; the result is unchanged.

Instances
Rounding RoundDown Source # 
Instance details

Defined in Numeric.Decimal.Rounding

Functions

cast :: (Precision p, Rounding r) => Decimal a b -> Decimal p r Source #

Cast a Decimal to another precision and/or rounding algorithm, immediately rounding if necessary to the new precision using the new algorithm.

fromBool :: Bool -> Decimal p r Source #

Return 0 or 1 if the argument is False or True, respectively. This is basically an optimized toEnum . fromEnum and allows an all-decimal usage of the operations from Numeric.Decimal.Operation that return a Bool.

fromOrdering :: Ordering -> Decimal p r Source #

Return -1, 0, or 1 if the argument is LT, EQ, or GT, respectively. This allows an all-decimal usage of the operations from Numeric.Decimal.Operation that return an Ordering.