dimensional-1.1: Statically checked physical dimensions, using Type Families and Data Kinds.

CopyrightCopyright (C) 2006-2018 Bjorn Buckwalter
LicenseBSD3
Maintainerbjorn@buckwalter.se
StabilityExperimental
PortabilityGHC only?
Safe HaskellNone
LanguageHaskell2010

Numeric.Units.Dimensional.FixedPoint

Contents

Description

Defines types for manipulation of quantities with fixed point representations.

Synopsis

Types

We provide access to the same Dimensional, Unit, and Quantity types as are exposed by Numeric.Units.Dimensional, but additionally offer the SQuantity type to represent scaled quantities. Fixed-point quantities are quantities backed by integers, it is frequently necessary to scale those integers into a range appropriate for the physical problem at hand.

type Unit (m :: Metricality) = Dimensional (DUnit m) Source #

A unit of measurement.

type Quantity = SQuantity One Source #

A dimensional quantity.

type SQuantity s = Dimensional (DQuantity s) Source #

A dimensional quantity, stored as an ExactPi' multiple of its value in its dimension's SI coherent unit.

The name is an abbreviation for scaled quantity.

data Metricality Source #

Encodes whether a unit is a metric unit, that is, whether it can be combined with a metric prefix to form a related unit.

Constructors

Metric

Capable of receiving a metric prefix.

NonMetric

Incapable of receiving a metric prefix.

Instances

Eq Metricality Source # 
Data Metricality Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Metricality -> c Metricality #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Metricality #

toConstr :: Metricality -> Constr #

dataTypeOf :: Metricality -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Metricality) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Metricality) #

gmapT :: (forall b. Data b => b -> b) -> Metricality -> Metricality #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Metricality -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Metricality -> r #

gmapQ :: (forall d. Data d => d -> u) -> Metricality -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Metricality -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Metricality -> m Metricality #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Metricality -> m Metricality #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Metricality -> m Metricality #

Ord Metricality Source # 
Generic Metricality Source # 

Associated Types

type Rep Metricality :: * -> * #

NFData Metricality Source # 

Methods

rnf :: Metricality -> () #

type Rep Metricality Source # 
type Rep Metricality = D1 * (MetaData "Metricality" "Numeric.Units.Dimensional.Variants" "dimensional-1.1-FrwO52z7cgM7jRCbk3nsMF" False) ((:+:) * (C1 * (MetaCons "Metric" PrefixI False) (U1 *)) (C1 * (MetaCons "NonMetric" PrefixI False) (U1 *)))

Physical Dimensions

data Dimension Source #

Represents a physical dimension in the basis of the 7 SI base dimensions, where the respective dimensions are represented by type variables using the following convention:

  • l: Length
  • m: Mass
  • t: Time
  • i: Electric current
  • th: Thermodynamic temperature
  • n: Amount of substance
  • j: Luminous intensity

For the equivalent term-level representation, see Dimension'

Dimension Arithmetic

type family (a :: Dimension) * (b :: Dimension) where ... infixl 7 Source #

Multiplication of dimensions corresponds to adding of the base dimensions' exponents.

Equations

DOne * d = d 
d * DOne = d 
(Dim l m t i th n j) * (Dim l' m' t' i' th' n' j') = Dim (l + l') (m + m') (t + t') (i + i') (th + th') (n + n') (j + j') 

type family (a :: Dimension) / (d :: Dimension) where ... infixl 7 Source #

Division of dimensions corresponds to subtraction of the base dimensions' exponents.

Equations

d / DOne = d 
d / d = DOne 
(Dim l m t i th n j) / (Dim l' m' t' i' th' n' j') = Dim (l - l') (m - m') (t - t') (i - i') (th - th') (n - n') (j - j') 

type family (d :: Dimension) ^ (x :: TypeInt) where ... infixr 8 Source #

Powers of dimensions corresponds to multiplication of the base dimensions' exponents by the exponent.

We limit ourselves to integer powers of Dimensionals as fractional powers make little physical sense.

Equations

DOne ^ x = DOne 
d ^ Zero = DOne 
d ^ Pos1 = d 
(Dim l m t i th n j) ^ x = Dim (l * x) (m * x) (t * x) (i * x) (th * x) (n * x) (j * x) 

type family NRoot (d :: Dimension) (x :: TypeInt) where ... Source #

Roots of dimensions corresponds to division of the base dimensions' exponents by the order of the root.

Equations

NRoot DOne x = DOne 
NRoot d Pos1 = d 
NRoot (Dim l m t i th n j) x = Dim (l / x) (m / x) (t / x) (i / x) (th / x) (n / x) (j / x) 

type Recip (d :: Dimension) = DOne / d Source #

The reciprocal of a dimension is defined as the result of dividing DOne by it, or of negating each of the base dimensions' exponents.

Term Level Representation of Dimensions

data Dimension' Source #

A physical dimension, encoded as 7 integers, representing a factorization of the dimension into the 7 SI base dimensions. By convention they are stored in the same order as in the Dimension data kind.

Constructors

Dim' !Int !Int !Int !Int !Int !Int !Int 

Instances

Eq Dimension' Source # 
Data Dimension' Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Dimension' -> c Dimension' #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Dimension' #

toConstr :: Dimension' -> Constr #

dataTypeOf :: Dimension' -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Dimension') #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dimension') #

gmapT :: (forall b. Data b => b -> b) -> Dimension' -> Dimension' #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Dimension' -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Dimension' -> r #

gmapQ :: (forall d. Data d => d -> u) -> Dimension' -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Dimension' -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Dimension' -> m Dimension' #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Dimension' -> m Dimension' #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Dimension' -> m Dimension' #

Ord Dimension' Source # 
Show Dimension' Source # 
Generic Dimension' Source # 

Associated Types

type Rep Dimension' :: * -> * #

Semigroup Dimension' Source # 
Monoid Dimension' Source #

The monoid of dimensions under multiplication.

NFData Dimension' Source # 

Methods

rnf :: Dimension' -> () #

HasDimension Dimension' Source # 
HasDynamicDimension Dimension' Source # 
type Rep Dimension' Source # 

class HasDynamicDimension a => HasDimension a where Source #

Dimensional values inhabit this class, which allows access to a term-level representation of their dimension.

Minimal complete definition

dimension

Methods

dimension :: a -> Dimension' Source #

Obtains a term-level representation of a value's dimension.

type KnownDimension (d :: Dimension) = HasDimension (Proxy d) Source #

A KnownDimension is one for which we can construct a term-level representation. Each validly constructed type of kind Dimension has a KnownDimension instance.

While KnownDimension is a constraint synonym, the presence of KnownDimension d in a context allows use of dimension :: Proxy d -> Dimension'.

Dimensional Arithmetic

(*~) :: forall s m d a b. (RealFrac a, Integral b, MinCtxt s a) => a -> Unit m d a -> SQuantity s d b infixl 7 Source #

Forms a possibly scaled SQuantity by multipliying a number and a unit.

(/~) :: forall s m d a b. (Real a, Fractional b, MinCtxt s b) => SQuantity s d a -> Unit m d b -> b infixl 7 Source #

Divides a possibly scaled SQuantity by a Unit of the same physical dimension, obtaining the numerical value of the quantity expressed in that unit.

(*) :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2), Num a) => Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a infixl 7 Source #

Multiplies two Quantitys or two Units.

The intimidating type signature captures the similarity between these operations and ensures that composite Units are NonMetric.

(/) :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2), Fractional a) => Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a infixl 7 Source #

Divides one Quantity by another or one Unit by another.

The intimidating type signature captures the similarity between these operations and ensures that composite Units are NotPrefixable.

(+) :: Num a => SQuantity s d a -> SQuantity s d a -> SQuantity s d a infixl 6 Source #

Adds two possibly scaled SQuantitys, preserving any scale factor.

Use in conjunction with changeRepRound to combine quantities with differing scale factors.

(-) :: Num a => SQuantity s d a -> SQuantity s d a -> SQuantity s d a infixl 6 Source #

Subtracts one possibly scaled SQuantity from another, preserving any scale factor.

Use in conjunction with changeRepRound to combine quantities with differing scale factors.

negate :: Num a => SQuantity s d a -> SQuantity s d a Source #

Negates the value of a possibly scaled SQuantity, preserving any scale factor.

abs :: Num a => SQuantity s d a -> SQuantity s d a Source #

Takes the absolute value of a possibly scaled SQuantity, preserving any scale factor.

Transcendental Functions

Via Double

atan2D :: (Integral a, Integral b, MinCtxt s1 Double, MinCtxt s2 Double, MinCtxt s3 Double) => SQuantity s1 DOne a -> SQuantity s2 DOne a -> SQuantity s3 DOne b Source #

The standard two argument arctangent function. Since it interprets its two arguments in comparison with one another, the input may have any dimension.

Via arbitary Floating type

expVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

logVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

sinVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

cosVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

tanVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

asinVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

acosVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

atanVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

sinhVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

coshVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

tanhVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

asinhVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

acoshVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

atanhVia :: (Integral a, RealFrac b, Floating b, Integral c, MinCtxt s1 b, MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c Source #

atan2Via :: forall s1 s2 s3 a b c d. (Integral a, RealFloat b, Integral c, MinCtxt s1 b, MinCtxt s2 b, MinCtxt s3 b, KnownDimension d) => Proxy b -> SQuantity s1 d a -> SQuantity s2 d a -> SQuantity s3 DOne c Source #

The standard two argument arctangent function. Since it interprets its two arguments in comparison with one another, the input may have any dimension.

Operations on Collections

(*~~) :: (Functor f, RealFrac a, Integral b, MinCtxt s a) => f a -> Unit m d a -> f (SQuantity s d b) infixl 7 Source #

Applies *~ to all values in a functor.

(/~~) :: (Functor f, Real a, Fractional b, MinCtxt s b) => f (SQuantity s d a) -> Unit m d b -> f b infixl 7 Source #

Applies /~ to all values in a functor.

sum :: (Num a, Foldable f) => f (SQuantity s d a) -> SQuantity s d a Source #

The sum of all elements in a list.

mean :: (Fractional a, Foldable f) => f (SQuantity s d a) -> SQuantity s d a Source #

The arithmetic mean of all elements in a list.

Conversion Between Representations

rescale :: forall a b d s1 s2. (Integral a, Integral b, KnownExactPi s1, KnownExactPi s2) => SQuantity s1 d a -> SQuantity s2 d b Source #

Rescales a fixed point quantity, accomodating changes both in its scale factor and its representation type.

Note that this uses an arbitrary precision representation of pi, which may be quite slow.

rescaleFinite :: (Integral a, FiniteBits a, Integral b, FiniteBits b, KnownExactPi s1, KnownExactPi s2) => SQuantity s1 d a -> SQuantity s2 d b Source #

Rescales a fixed point quantity, accomodating changes both in its scale factor and its representation type.

Expected to outperform rescale when a FiniteBits context is available for the source and destination representation types.

rescaleD :: (Integral a, Integral b, KnownExactPi s1, KnownExactPi s2) => SQuantity s1 d a -> SQuantity s2 d b Source #

Approximately rescales a fixed point quantity, accomodating changes both in its scale factor and its representation type.

Uses approximate arithmetic by way of an intermediate Double representation.

rescaleVia :: forall a b c d s1 s2. (Integral a, RealFrac b, Floating b, Integral c, KnownExactPi s1, KnownExactPi s2) => Proxy b -> SQuantity s1 d a -> SQuantity s2 d c Source #

Approximately rescales a fixed point quantity, accomodating changes both in its scale factor and its representation type.

Uses approximate arithmetic by way of an intermediate Floating type, to which a proxy must be supplied.

class KnownVariant (v :: Variant) where Source #

A KnownVariant is one whose term-level Dimensional values we can represent with an associated data family instance and manipulate with certain functions, not all of which are exported from the package.

Each validly constructed type of kind Variant has a KnownVariant instance.

Minimal complete definition

extractValue, extractName, injectValue, dmap

Associated Types

data Dimensional v :: Dimension -> * -> * Source #

A dimensional value, either a Quantity or a Unit, parameterized by its Dimension and representation.

Methods

dmap :: (a1 -> a2) -> Dimensional v d a1 -> Dimensional v d a2 Source #

Maps over the underlying representation of a dimensional value. The caller is responsible for ensuring that the supplied function respects the dimensional abstraction. This means that the function must preserve numerical values, or linearly scale them while preserving the origin.

Instances

KnownVariant (DQuantity s) Source # 

Associated Types

data Dimensional (DQuantity s :: Variant) (a :: Dimension) b :: * Source #

type ScaleFactor (DQuantity s :: Variant) :: ExactPi'

Typeable Metricality m => KnownVariant (DUnit m) Source # 

Associated Types

data Dimensional (DUnit m :: Variant) (a :: Dimension) b :: * Source #

type ScaleFactor (DUnit m :: Variant) :: ExactPi'

changeRep :: forall v1 v2 d a b. (KnownVariant v1, KnownVariant v2, CompatibleVariants v1 v2, MinCtxt (ScaleFactor v1 / ScaleFactor v2) b, Real a, Fractional b) => Dimensional v1 d a -> Dimensional v2 d b Source #

Convenient conversion between numerical types while retaining dimensional information.

changeRepRound :: forall v1 v2 d a b. (KnownVariant v1, KnownVariant v2, CompatibleVariants v1 v2, MinCtxt (ScaleFactor v1 / ScaleFactor v2) a, RealFrac a, Integral b) => Dimensional v1 d a -> Dimensional v2 d b Source #

Convenient conversion to types with Integral representations using round.

changeRepApproximate :: (KnownVariant v, Floating b) => Dimensional v d ExactPi -> Dimensional v d b Source #

Convenient conversion from exactly represented values while retaining dimensional information.

Dimension Synonyms

type DOne = Dim Zero Zero Zero Zero Zero Zero Zero Source #

The type-level dimension of dimensionless values.

Quantity Synonyms

Constants

_0 :: Num a => SQuantity s d a Source #

The constant for zero is polymorphic, allowing it to express zero Length or Capacitance or Velocity etc, in addition to the Dimensionless value zero.

epsilon :: Integral a => SQuantity s d a Source #

The least positive representable value in a given fixed-point scaled quantity type.

Note that, other than _0 and epsilon, these constants may not be exactly representable with certain scale factors.

tau :: (Integral a, KnownExactPi s) => SQuantity s DOne a Source #

Twice pi.

For background on tau see http://tauday.com/tau-manifesto (but also feel free to review http://www.thepimanifesto.com).

Constructing Units

siUnit :: forall d a. (KnownDimension d, Num a) => Unit NonMetric d a Source #

A polymorphic Unit which can be used in place of the coherent SI base unit of any dimension. This allows polymorphic quantity creation and destruction without exposing the Dimensional constructor.

one :: Num a => Unit NonMetric DOne a Source #

The unit one has dimension DOne and is the base unit of dimensionless values.

As detailed in 7.10 "Values of quantities expressed simply as numbers: the unit one, symbol 1" of [1] the unit one generally does not appear in expressions. However, for us it is necessary to use one as we would any other unit to perform the "boxing" of dimensionless values.

mkUnitR :: Floating a => UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a Source #

Forms a new atomic Unit by specifying its UnitName and its definition as a multiple of another Unit.

Use this variant when the scale factor of the resulting unit is irrational or Approximate. See mkUnitQ for when it is rational and mkUnitZ for when it is an integer.

Note that supplying zero as a definining quantity is invalid, as the library relies upon units forming a group under multiplication.

Supplying negative defining quantities is allowed and handled gracefully, but is discouraged on the grounds that it may be unexpected by other readers.

mkUnitQ :: Fractional a => UnitName m -> Rational -> Unit m1 d a -> Unit m d a Source #

Forms a new atomic Unit by specifying its UnitName and its definition as a multiple of another Unit.

Use this variant when the scale factor of the resulting unit is rational. See mkUnitZ for when it is an integer and mkUnitR for the general case.

For more information see mkUnitR.

mkUnitZ :: Num a => UnitName m -> Integer -> Unit m1 d a -> Unit m d a Source #

Forms a new atomic Unit by specifying its UnitName and its definition as a multiple of another Unit.

Use this variant when the scale factor of the resulting unit is an integer. See mkUnitQ for when it is rational and mkUnitR for the general case.

For more information see mkUnitR.

Unit Metadata

name :: Unit m d a -> UnitName m Source #

Extracts the UnitName of a Unit.

exactValue :: Unit m d a -> ExactPi Source #

Extracts the exact value of a Unit, expressed in terms of the SI coherent derived unit (see siUnit) of the same Dimension.

Note that the actual value may in some cases be approximate, for example if the unit is defined by experiment.

weaken :: Unit m d a -> Unit NonMetric d a Source #

Discards potentially unwanted type level information about a Unit.

strengthen :: Unit m d a -> Maybe (Unit Metric d a) Source #

Attempts to convert a Unit which may or may not be Metric to one which is certainly Metric.

exactify :: Unit m d a -> Unit m d ExactPi Source #

Forms the exact version of a Unit.

Commonly Used Type Synonyms

These type synonyms for commonly used fixed-point types are provided for convenience.

type Q n a = SQuantity (QScale n) DOne a Source #

A dimensionless number with n fractional bits, using a representation of type a.

type QScale n = One / ExactNatural (2 ^ n) Source #

A binary scale factor.

type Angle8 = SQuantity (Pi * QScale 7) DPlaneAngle Int8 Source #

A single-turn angle represented as a signed 8-bit integer.

type Angle16 = SQuantity (Pi * QScale 15) DPlaneAngle Int16 Source #

A single-turn angle represented as a signed 16-bit integer.

type Angle32 = SQuantity (Pi * QScale 31) DPlaneAngle Int32 Source #

A single-turn angle represented as a signed 32-bit integer.