dimensional-1.5/benchmarks/0000755000000000000000000000000014244152645014173 5ustar0000000000000000dimensional-1.5/examples/0000755000000000000000000000000014244152645013674 5ustar0000000000000000dimensional-1.5/src/0000755000000000000000000000000014247420302012634 5ustar0000000000000000dimensional-1.5/src/Numeric/0000755000000000000000000000000014244152645014247 5ustar0000000000000000dimensional-1.5/src/Numeric/Units/0000755000000000000000000000000014247602315015346 5ustar0000000000000000dimensional-1.5/src/Numeric/Units/Dimensional/0000755000000000000000000000000014254541015017605 5ustar0000000000000000dimensional-1.5/src/Numeric/Units/Dimensional/Dimensions/0000755000000000000000000000000014244166633021725 5ustar0000000000000000dimensional-1.5/src/Numeric/Units/Dimensional/UnitNames/0000755000000000000000000000000014246352770021521 5ustar0000000000000000dimensional-1.5/tests/0000755000000000000000000000000014247421066013217 5ustar0000000000000000dimensional-1.5/tests/Numeric/0000755000000000000000000000000014244152645014622 5ustar0000000000000000dimensional-1.5/tests/Numeric/Units/0000755000000000000000000000000014244152645015724 5ustar0000000000000000dimensional-1.5/tests/Numeric/Units/Dimensional/0000755000000000000000000000000014244152645020166 5ustar0000000000000000dimensional-1.5/src/Numeric/Units/Dimensional.hs0000644000000000000000000007127114247602315020154 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary In this module we provide data types for performing arithmetic with physical quantities and units. Information about the physical dimensions of the quantities/units is embedded in their types and the validity of operations is verified by the type checker at compile time. The wrapping and unwrapping of numerical values as quantities is done by multiplication and division of units, of which an incomplete set is provided. We limit ourselves to \"Newtonian\" physics. We do not attempt to accommodate relativistic physics in which e.g. addition of length and time would be valid. As far as possible and/or practical the conventions and guidelines of NIST's "Guide for the Use of the International System of Units (SI)" <#note1 [1]> are followed. Occasionally we will reference specific sections from the guide and deviations will be explained. == Disclaimer Merely an engineer, the author doubtlessly uses a language and notation that makes mathematicians and physicists cringe. He does not mind constructive criticism (or pull requests). The sets of functions and units defined herein are incomplete and reflect only the author's needs to date. Again, patches are welcome. = Usage == Preliminaries This module requires GHC 8 or later. We utilize Data Kinds, TypeNats, Closed Type Families, etc. Clients of the module are generally not required to use these extensions. Clients probably will want to use the @NegativeLiterals@ extension though. == Examples We have defined operators and units that allow us to define and work with physical quantities. A physical quantity is defined by multiplying a number with a unit (the type signature is optional). > v :: Velocity Double > v = 90 *~ (kilo meter / hour) It follows naturally that the numerical value of a quantity is obtained by division by a unit. > numval :: Double > numval = v /~ (meter / second) The notion of a quantity as the product of a numerical value and a unit is supported by 7.1 "Value and numerical value of a quantity" of <#note1 [1]>. While the above syntax is fairly natural, it is unfortunate that it must violate a number of the guidelines in <#note1 [1]>, in particular 9.3 "Spelling unit names with prefixes", 9.4 "Spelling unit names obtained by multiplication", 9.5 "Spelling unit names obtained by division". As a more elaborate example of how to use the module, we define a function for calculating the escape velocity of a celestial body <#note2 [2]>. > escapeVelocity :: (Floating a) => Mass a -> Length a -> Velocity a > escapeVelocity m r = sqrt (two * g * m / r) > where > two = 2 *~ one > g = 6.6720e-11 *~ (newton * meter ^ pos2 / kilo gram ^ pos2) For completeness, we should also show an example of the error messages we will get from GHC when performing invalid arithmetic. In the best case, GHC will be able to use the type synonyms we have defined in its error messages. > let x = 1 *~ meter + 1 *~ second > > Couldn't match type 'Numeric.NumType.DK.Integers.Zero > with 'Numeric.NumType.DK.Integers.Pos1 > Expected type: Unit 'Metric DLength a > Actual type: Unit 'Metric DTime a > In the second argument of `(*~)', namely `second' > In the second argument of `(+)', namely `1 *~ second' In other cases, the error messages aren't very friendly. > let x = 1 *~ meter / (1 *~ second) + 1 *~ kilo gram > > Couldn't match type 'Numeric.NumType.DK.Integers.Zero > with 'Numeric.NumType.DK.Integers.Neg1 > Expected type: Quantity DMass a > Actual type: Dimensional > ('DQuantity V.* 'DQuantity) (DLength / DTime) a > In the first argument of `(+)', namely `1 *~ meter / (1 *~ second)' > In the expression: 1 *~ meter / (1 *~ second) + 1 *~ kilo gram > In an equation for `x': > x = 1 *~ meter / (1 *~ second) + 1 *~ kilo gram It is the author's experience that the usefulness of the compiler error messages is more often than not limited to pinpointing the location of errors. = Notes == Future work While there is an insane amount of units in use around the world it is reasonable to provide those in relatively widespread use. Units outside of SI will most likely be added on an as-needed basis. Additional physics models could be implemented. See <#note3 [3]> for ideas. == Related work Henning Thielemann's numeric prelude has a physical units library, however, checking of dimensions is dynamic rather than static. Aaron Denney has created a toy example of statically checked physical dimensions covering only length and time. HaskellWiki has pointers <#note4 [4]> to these. Also see Samuel Hoffstaetter's blog post <#note5 [5]> which uses techniques similar to this library. Libraries with similar functionality exist for other programming languages and may serve as inspiration. The author has found the Java library JScience <#note6 [6]> and the Fortress programming language <#note7 [7]> particularly noteworthy. == References 1. #note1# https://www.nist.gov/pml/special-publication-811 2. #note2# https://en.wikipedia.org/wiki/Escape_velocity 3. #note3# https://web.archive.org/web/20080905151927/http://jscience.org/api/org/jscience/physics/models/package-summary.html 4. #note4# https://wiki.haskell.org/Physical_units 5. #note5# https://liftm.wordpress.com/2007/06/03/scientificdimension-type-arithmetic-and-physical-units-in-haskell/ 6. #note6# http://jscience.org/ 6. #note6# https://github.com/stokito/fortress-lang -} module Numeric.Units.Dimensional ( -- * Types -- $types Dimensional, Unit, Quantity, Metricality(..), -- * Physical Dimensions -- $dimensions Dimension (Dim), -- ** Dimension Arithmetic -- $dimension-arithmetic type (*), type (/), type (^), NRoot, Sqrt, Cbrt, Recip, -- ** Term Level Representation of Dimensions -- $dimension-terms Dimension' (Dim'), HasDimension(..), KnownDimension, -- * Dimensional Arithmetic (*~), (/~), (^), (^/), (**), (*), (/), (+), (-), negate, abs, signum, recip, nroot, sqrt, cbrt, -- ** Transcendental Functions exp, log, logBase, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh, atan2, log1p, expm1, log1pexp, log1mexp, -- ** Operations on Collections -- $collections (*~~), (/~~), sum, mean, product, dimensionlessLength, nFromTo, -- * Dimension Synonyms -- $dimension-synonyms DOne, DLength, DMass, DTime, DElectricCurrent, DThermodynamicTemperature, DAmountOfSubstance, DLuminousIntensity, -- * Quantity Synonyms -- $quantity-synonyms Dimensionless, Length, Mass, Time, ElectricCurrent, ThermodynamicTemperature, AmountOfSubstance, LuminousIntensity, -- * Constants -- $constants _0, _1, _2, _3, _4, _5, _6, _7, _8, _9, pi, tau, -- * Constructing Units siUnit, one, mkUnitR, mkUnitQ, mkUnitZ, -- * Unit Metadata name, exactValue, weaken, strengthen, exactify, -- * Pretty Printing showIn, -- * On 'Functor', and Conversion Between Number Representations -- $functor KnownVariant(dmap), changeRep, changeRepApproximate, -- * Lenses -- $lenses asLens ) where import Prelude ( Eq(..), Num, Fractional, Floating, Real, RealFloat, Functor, fmap , (.), flip, (++), fromIntegral, fromInteger, fromRational, error, max, succ , Int, Integer, Integral, ($), uncurry, realToFrac, otherwise ) import qualified Prelude import Numeric.NumType.DK.Integers ( pos2, pos3 , KnownTypeInt, toNum ) import Data.Data import Data.ExactPi import Data.Foldable (Foldable(foldr, length)) import Data.Maybe import Data.Ratio import qualified Numeric import Numeric.Units.Dimensional.Dimensions import Numeric.Units.Dimensional.Internal import Numeric.Units.Dimensional.UnitNames hiding ((*), (/), (^), weaken, strengthen, product) import qualified Numeric.Units.Dimensional.UnitNames.Internal as Name import Numeric.Units.Dimensional.Variants hiding (type (*), type (/)) import qualified Numeric.Units.Dimensional.Variants as V -- $setup -- >>> :set -XFlexibleInstances -- >>> :set -XNoImplicitPrelude -- >>> import Test.QuickCheck.Arbitrary -- >>> import Numeric.Units.Dimensional.Prelude -- >>> import Numeric.Units.Dimensional.Float -- >>> import Numeric.Units.Dimensional.NonSI -- >>> instance Arbitrary a => Arbitrary (Quantity d a) where arbitrary = fmap Quantity arbitrary {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^, ^/, ** infixl 7 *, / infixl 6 +, - {- $types Our primary objective is to define a data type that can be used to represent (while still differentiating between) units and quantities. There are two reasons for consolidating units and quantities in one data type. The first being to allow code reuse as they are largely subject to the same operations. The second being that it allows reuse of operators (and functions) between the two without resorting to occasionally cumbersome type classes. The relationship between (the value of) a 'Quantity', its numerical value and its 'Unit' is described in 7.1 "Value and numerical value of a quantity" of <#note1 [1]>. In short a 'Quantity' is the product of a number and a 'Unit'. We define the '*~' operator as a convenient way to declare quantities as such a product. -} -- | Extracts the 'UnitName' of a 'Unit'. name :: Unit m d a -> UnitName m name (Unit n _ _) = n -- | 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. exactValue :: Unit m d a -> ExactPi exactValue (Unit _ e _) = e -- | Discards potentially unwanted type level information about a 'Unit'. weaken :: Unit m d a -> Unit 'NonMetric d a weaken (Unit n e v) = Unit (Name.weaken n) e v -- | Attempts to convert a 'Unit' which may or may not be 'Metric' to one -- which is certainly 'Metric'. strengthen :: Unit m d a -> Maybe (Unit 'Metric d a) strengthen (Unit n e v) | Just n' <- Name.strengthen n = Just $ Unit n' e v | otherwise = Nothing -- | Forms the exact version of a 'Unit'. exactify :: Unit m d a -> Unit m d ExactPi exactify (Unit n e _) = Unit n e e -- | Forms a 'Quantity' by multipliying a number and a unit. (*~) :: (Num a) => a -> Unit m d a -> Quantity d a x *~ (Unit _ _ y) = Quantity (x Prelude.* y) -- | Divides a 'Quantity' by a 'Unit' of the same physical dimension, obtaining the -- numerical value of the quantity expressed in that unit. (/~) :: Fractional a => Quantity d a -> Unit m d a -> a (Quantity x) /~ (Unit _ _ y) = (x Prelude./ y) {- We give '*~' and '/~' the same fixity as '*' and '/' defined below. Note that this necessitates the use of parenthesis when composing units using '*' and '/', e.g. "1 *~ (meter / second)". -} infixl 7 *~, /~ {- $dimensions The phantom type variable @d@ encompasses the physical dimension of a 'Dimensional'. As detailed in <#note5 [5]>, there are seven base dimensions, which can be combined in integer powers to a given physical dimension. We represent physical dimensions as the powers of the seven base dimensions that make up the given dimension. The powers are represented using NumTypes. For convenience, we collect all seven base dimensions in a data kind 'Dimension'. We could have chosen to provide type variables for the seven base dimensions in 'Dimensional' instead of creating a new data kind 'Dimension'. However, that would have made any type signatures involving 'Dimensional' very cumbersome. By encompassing the physical dimension in a single type variable we can "hide" the cumbersome type arithmetic behind convenient type classes as will be seen later. -} {- $dimension-synonyms Using our 'Dimension' data kind we define some type synonyms for convenience. We start with the base dimensions, others can be found in "Numeric.Units.Dimensional.Quantities". -} {- $quantity-synonyms Using the above type synonyms we can define type synonyms for quantities of particular physical dimensions. Again we limit ourselves to the base dimensions, others can be found in "Numeric.Units.Dimensional.Quantities". -} type Dimensionless = Quantity DOne type Length = Quantity DLength type Mass = Quantity DMass type Time = Quantity DTime type ElectricCurrent = Quantity DElectricCurrent type ThermodynamicTemperature = Quantity DThermodynamicTemperature type AmountOfSubstance = Quantity DAmountOfSubstance type LuminousIntensity = Quantity DLuminousIntensity {- $dimension-arithmetic When performing arithmetic on units and quantities, the arithmetics must be applied to both the numerical values of the Dimensionals but also to their physical dimensions. The type level arithmetic on physical dimensions is governed by closed type families expressed as type operators. We could provide the 'Mul' and 'Div' classes with full functional dependencies but that would be of limited utility as there is no limited use for "backwards" type inference. Efforts are underway to develop a type-checker plugin that does enable these scenarios, e.g. for linear algebra. -} {- = Arithmetic on units and quantities = Thanks to the arithmetic on physical dimensions having been sorted out separately a lot of the arithmetic on Dimensionals is straight forward. In particular the type signatures are much simplified. Multiplication, division and powers apply to both units and quantities. -} -- | Multiplies two 'Quantity's or two 'Unit's. -- -- The intimidating type signature captures the similarity between these operations -- and ensures that composite 'Unit's are 'NonMetric'. (*) :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 V.* v2), Num a) => Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 V.* v2) (d1 * d2) a (*) = liftD2 (Prelude.*) (Prelude.*) (Name.*) -- | Divides one 'Quantity' by another or one 'Unit' by another. -- -- The intimidating type signature captures the similarity between these operations -- and ensures that composite 'Unit's are 'NonMetric'. (/) :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 V./ v2), Fractional a) => Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 V./ v2) (d1 / d2) a (/) = liftD2 (Prelude./) (Prelude./) (Name./) -- | Forms the reciprocal of a 'Quantity', which has the reciprocal dimension. -- -- >>> recip $ 47 *~ hertz -- 2.127659574468085e-2 s recip :: (Fractional a) => Quantity d a -> Quantity (Recip d) a recip = liftQ Prelude.recip -- | Raises a 'Quantity' or 'Unit' to an integer power. -- -- Because the power chosen impacts the 'Dimension' of the result, it is necessary to supply a type-level representation -- of the exponent in the form of a 'Proxy' to some 'TypeInt'. Convenience values 'pos1', 'pos2', 'neg1', ... -- are supplied by the "Numeric.NumType.DK.Integers" module. The most commonly used ones are -- also reexported by "Numeric.Units.Dimensional.Prelude". -- -- The intimidating type signature captures the similarity between these operations -- and ensures that composite 'Unit's are 'NonMetric'. (^) :: (Fractional a, KnownTypeInt i, KnownVariant v, KnownVariant (Weaken v)) => Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a x ^ n = let n' = (toNum n) :: Int in liftD (Prelude.^^ n') (Prelude.^^ n') (Name.^ n') x {- A special case is that dimensionless quantities are not restricted to integer exponents. This is accommodated by the '**' operator defined later. = Quantity operations = Some additional operations obviously only make sense for quantities. Of these, negation, addition and subtraction are particularly simple as they are done in a single physical dimension. -} -- | Negates the value of a 'Quantity'. negate :: Num a => Quantity d a -> Quantity d a negate = liftQ Prelude.negate -- | Adds two 'Quantity's. (+) :: Num a => Quantity d a -> Quantity d a -> Quantity d a (+) = liftQ2 (Prelude.+) -- | Subtracts one 'Quantity' from another. (-) :: Num a => Quantity d a -> Quantity d a -> Quantity d a (-) = liftQ2 (Prelude.-) -- | Takes the absolute value of a 'Quantity'. abs :: Num a => Quantity d a -> Quantity d a abs = liftQ Prelude.abs -- | Takes the sign of a 'Quantity'. The functions 'abs' and 'signum' -- satisy the law that: -- -- > abs x * signum x == x -- -- The sign is either @negate _1@ (negative), @_0@ (zero), -- or @_1@ (positive). signum :: Num a => Quantity d a -> Dimensionless a signum = liftQ Prelude.signum {- Roots of arbitrary (integral) degree. Appears to occasionally be useful for units as well as quantities. -} -- | Computes the nth root of a 'Quantity' using 'Prelude.**'. -- -- The 'NRoot' type family will prevent application of this operator where the result would have a fractional dimension or where n is zero. -- -- Because the root chosen impacts the 'Dimension' of the result, it is necessary to supply a type-level representation -- of the root in the form of a 'Proxy' to some 'TypeInt'. Convenience values 'pos1', 'pos2', 'neg1', ... -- are supplied by the "Numeric.NumType.DK.Integers" module. The most commonly used ones are -- also reexported by "Numeric.Units.Dimensional.Prelude". -- -- n must not be zero. Negative roots are defined such that @nroot (Proxy :: Proxy (Negate n)) x == nroot (Proxy :: Proxy n) (recip x)@. -- -- Also available in operator form, see '^/'. nroot :: (KnownTypeInt n, Floating a) => Proxy n -> Quantity d a -> Quantity (NRoot d n) a nroot n = let n' = 1 Prelude./ toNum n in liftQ (Prelude.** n') {- We provide short-hands for the square and cube roots. -} -- | Computes the square root of a 'Quantity' using 'Prelude.**'. -- -- The 'NRoot' type family will prevent application where the supplied quantity does not have a square dimension. -- -- prop> (x :: Area Double) >= _0 ==> sqrt x == nroot pos2 x sqrt :: Floating a => Quantity d a -> Quantity (Sqrt d) a sqrt = nroot pos2 -- | Computes the cube root of a 'Quantity' using 'Prelude.**'. -- -- The 'NRoot' type family will prevent application where the supplied quantity does not have a cubic dimension. -- -- prop> (x :: Volume Double) >= _0 ==> cbrt x == nroot pos3 x cbrt :: Floating a => Quantity d a -> Quantity (Cbrt d) a cbrt = nroot pos3 {- We also provide an operator alternative to nroot for those that prefer such. -} -- | Computes the nth root of a 'Quantity' using 'Prelude.**'. -- -- The 'NRoot' type family will prevent application of this operator where the result would have a fractional dimension or where n is zero. -- -- Because the root chosen impacts the 'Dimension' of the result, it is necessary to supply a type-level representation -- of the root in the form of a 'Proxy' to some 'TypeInt'. Convenience values 'pos1', 'pos2', 'neg1', ... -- are supplied by the "Numeric.NumType.DK.Integers" module. The most commonly used ones are -- also reexported by "Numeric.Units.Dimensional.Prelude". -- -- Also available in prefix form, see 'nroot'. (^/) :: (KnownTypeInt n, Floating a) => Quantity d a -> Proxy n -> Quantity (NRoot d n) a (^/) = flip nroot {- $collections Here we define operators and functions to make working with homogeneous lists of dimensionals more convenient. We define two convenience operators for applying units to all elements of a functor (e.g. a list). -} -- | Applies '*~' to all values in a functor. (*~~) :: (Functor f, Num a) => f a -> Unit m d a -> f (Quantity d a) xs *~~ u = fmap (*~ u) xs -- | Applies '/~' to all values in a functor. (/~~) :: forall f m d a.(Functor f, Fractional a) => f (Quantity d a) -> Unit m d a -> f a xs /~~ u = fmap (/~ u) xs infixl 7 *~~, /~~ -- | The sum of all elements in a foldable structure. -- -- >>> sum ([] :: [Mass Double]) -- 0.0 kg -- -- >>> sum [12.4 *~ meter, 1 *~ foot] -- 12.7048 m sum :: (Num a, Foldable f) => f (Quantity d a) -> Quantity d a sum = foldr (+) _0 -- | The product of all elements in a foldable structure. -- -- >>> product ([] :: [Dimensionless Double]) -- 1.0 -- -- >>> product [pi, _4, 0.36 *~ one] -- 4.523893421169302 product :: (Num a, Foldable f) => f (Dimensionless a) -> Dimensionless a product = foldr (*) _1 -- | The arithmetic mean of all elements in a foldable structure. -- -- >>> mean [pi, _7] -- 5.070796326794897 mean :: (Fractional a, Foldable f) => f (Quantity d a) -> Quantity d a mean = uncurry (/) . foldr accumulate (_0, _0) where accumulate val (accum, count) = (accum + val, count + _1) -- | The length of the foldable data structure as a 'Dimensionless'. -- This can be useful for purposes of e.g. calculating averages. -- -- >>> dimensionlessLength ["foo", "bar"] -- 2 dimensionlessLength :: (Num a, Foldable f) => f b -> Dimensionless a dimensionlessLength x = (fromIntegral $ length x) *~ one -- | Returns a list of quantities between given bounds. -- -- prop> n <= 0 ==> nFromTo (x :: Mass Double) (y :: Mass Double) n == [x, y] -- -- prop> (x :: Length Double) <= (y :: Length Double) ==> all (\z -> x <= z && z <= y) (nFromTo x y n) -- -- >>> nFromTo _0 _3 2 -- [0.0,1.0,2.0,3.0] -- -- >>> nFromTo _1 _0 7 -- [1.0,0.875,0.75,0.625,0.5,0.375,0.25,0.125,0.0] -- -- >>> nFromTo _0 _1 (-5) -- [0.0,1.0] nFromTo :: (Fractional a, Integral b) => Quantity d a -- ^ The initial value. -> Quantity d a -- ^ The final value. -> b -- ^ The number of intermediate values. If less than one, no intermediate values will result. -> [Quantity d a] nFromTo xi xf n = fmap f [0..n'] ++ [xf] where n' = max 0 n f i = xi + realToFrac (i % succ n') *~ one * (xf - xi) {- We continue by defining elementary functions on 'Dimensionless' that may be obviously useful. -} exp, log, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh, log1p, expm1, log1pexp, log1mexp :: Floating a => Dimensionless a -> Dimensionless a exp = fmap Prelude.exp log = fmap Prelude.log sin = fmap Prelude.sin cos = fmap Prelude.cos tan = fmap Prelude.tan asin = fmap Prelude.asin acos = fmap Prelude.acos atan = fmap Prelude.atan sinh = fmap Prelude.sinh cosh = fmap Prelude.cosh tanh = fmap Prelude.tanh asinh = fmap Prelude.asinh acosh = fmap Prelude.acosh atanh = fmap Prelude.atanh log1p = fmap Numeric.log1p expm1 = fmap Numeric.expm1 log1pexp = fmap Numeric.log1pexp log1mexp = fmap Numeric.log1mexp -- | Raises a dimensionless quantity to a dimensionless power. (**) :: Floating a => Dimensionless a -> Dimensionless a -> Dimensionless a (**) = liftQ2 (Prelude.**) -- | Takes the logarithm of the second argument in the base of the first. -- -- >>> logBase _2 _8 -- 3.0 logBase :: Floating a => Dimensionless a -> Dimensionless a -> Dimensionless a logBase = liftQ2 Prelude.logBase -- | The standard two argument arctangent function. -- Since it interprets its two arguments in comparison with one another, the input may have any dimension. -- -- >>> atan2 _0 _1 -- 0.0 -- -- >>> atan2 _1 _0 -- 1.5707963267948966 -- -- >>> atan2 _0 (negate _1) -- 3.141592653589793 -- -- >>> atan2 (negate _1) _0 -- -1.5707963267948966 atan2 :: (RealFloat a) => Quantity d a -> Quantity d a -> Dimensionless a atan2 = liftQ2 Prelude.atan2 {- The only unit we will define in this module is 'one'. -} -- | 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 <#note1 [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 "wrapping" of dimensionless values. one :: Num a => Unit 'NonMetric DOne a one = Unit nOne 1 1 {- $constants For convenience we define some constants for small integer values that often show up in formulae. We also throw in 'pi' and 'tau' for good measure. -} -- | The constant for zero is polymorphic, allowing it to express zero 'Length' or -- 'Numeric.Units.Dimensional.Quantities.Capacitance' or 'Numeric.Units.Dimensional.Quantities.Velocity' etc, -- in addition to the 'Dimensionless' value zero. _0 :: Num a => Quantity d a _0 = Quantity 0 _1, _2, _3, _4, _5, _6, _7, _8, _9 :: (Num a) => Dimensionless a _1 = 1 *~ one _2 = 2 *~ one _3 = 3 *~ one _4 = 4 *~ one _5 = 5 *~ one _6 = 6 *~ one _7 = 7 *~ one _8 = 8 *~ one _9 = 9 *~ one pi :: Floating a => Dimensionless a pi = Prelude.pi *~ one -- | Twice 'pi'. -- -- For background on 'tau' see https://tauday.com/tau-manifesto (but also -- feel free to review https://web.archive.org/web/20200926221249/http://www.thepimanifesto.com/). tau :: Floating a => Dimensionless a tau = _2 * pi {- $functor We intentionally decline to provide a 'Functor' instance for 'Dimensional' because its use breaks the abstraction of physical dimensions. If you feel your work requires this instance, it is provided as an orphan in "Numeric.Units.Dimensional.Functor". -} -- | Convenient conversion between numerical types while retaining dimensional information. -- -- >>> let x = (37 :: Rational) *~ poundMass -- >>> changeRep x :: Mass Double -- 16.78291769 kg changeRep :: (KnownVariant v, Real a, Fractional b) => Dimensional v d a -> Dimensional v d b changeRep = dmap realToFrac -- | Convenient conversion from exactly represented values while retaining dimensional information. changeRepApproximate :: (KnownVariant v, Floating b) => Dimensional v d ExactPi -> Dimensional v d b changeRepApproximate = dmap approximateValue {- $lenses These functions are compatible with the lens library. -} -- | Converts a 'Unit' into a lens from 'Quantity's to values. asLens :: (Fractional a) => Unit m d a -> (forall f.Functor f => (a -> f a) -> Quantity d a -> f (Quantity d a)) asLens u f q = fmap (\v' -> v' *~ u) (f (q /~ u)) {- $dimension-terms To facilitate parsing and pretty-printing functions that may wish to operate on term-level representations of dimension, we provide a means for converting from type-level dimensions to term-level dimensions. -} -- | 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. mkUnitR :: Floating a => UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a mkUnitR n s (Unit _ e _) | isExactZero s = error "Supplying zero as a conversion factor is not valid." | otherwise = Unit n e' x' where e' = s Prelude.* e x' = approximateValue e' -- | 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'. mkUnitQ :: Fractional a => UnitName m -> Rational -> Unit m1 d a -> Unit m d a mkUnitQ n s (Unit _ e x) | s == 0 = error "Supplying zero as a conversion factor is not valid." | Just x'' <- toExactRational e' = Unit n e' (fromRational x'') | otherwise = Unit n e' x' where e' = fromRational s Prelude.* e x' = fromRational s Prelude.* x -- | 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'. mkUnitZ :: Num a => UnitName m -> Integer -> Unit m1 d a -> Unit m d a mkUnitZ n s (Unit _ e x) | s == 0 = error "Supplying zero as a conversion factor is not valid." | Just x'' <- toExactInteger e' = Unit n e' (fromInteger x'') | otherwise = Unit n e' x' where e' = fromInteger s Prelude.* e x' = fromInteger s Prelude.* x dimensional-1.5/src/Numeric/Units/Dimensional/Coercion.hs0000644000000000000000000000245014244152645021711 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Experimental Portability: GHC only? Re-exports the raw 'Quantity' constructor from the Numeric.Units.Dimensional.Internal module, along with 'Data.Coerce.coerce', for convenience in converting between raw representations and dimensional values. Note that use of these constructs requires the user to verify the dimensional safety of the conversion, because the coercion doesn't explicitly mention the unit of the representation. Note also that the 'Quantity' constructor constructs a 'Numeric.Units.Dimensional.SQuantity' which may have a scale factor other than 'Data.ExactPi.TypeLevel.One'. Note that the haddock documentation doesn't mention the 'Quantity' constructor because it is a part of the 'Dimensional' associated data family, but it is exported by this module. -} module Numeric.Units.Dimensional.Coercion ( coerce, Dimensional(Quantity), unQuantity ) where import Data.Coerce (coerce) import Numeric.Units.Dimensional.Internal (SQuantity, Dimensional(Quantity)) -- | Unwraps a possibly-scaled `SQuantity`, yielding its underlying representation. -- -- This is a type-restricted version of `coerce`. unQuantity :: SQuantity s d a -> a unQuantity = coerce dimensional-1.5/src/Numeric/Units/Dimensional/Dimensions.hs0000644000000000000000000000202314244152645022254 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only Provides both term-level and type-level representations for physical dimensions in a single import for convenience. Presuming that users intend to work primarily with type level dimensions, this module hides arithmetic operators over term level dimensions and aliases for the base term-level dimensions to avoid namespace pollution. These features are available directly from "Numeric.Units.Dimensional.Dimensions.TermLevel" if desired. -} module Numeric.Units.Dimensional.Dimensions ( module Numeric.Units.Dimensional.Dimensions.TermLevel, module Numeric.Units.Dimensional.Dimensions.TypeLevel ) where import Numeric.Units.Dimensional.Dimensions.TermLevel hiding ((*), (/), (^), recip, nroot, sqrt, cbrt, dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity) import Numeric.Units.Dimensional.Dimensions.TypeLevel dimensional-1.5/src/Numeric/Units/Dimensional/Dimensions/TermLevel.hs0000644000000000000000000001670614244166633024172 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home, show-extensions #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only This module defines physical dimensions expressed in terms of the SI base dimensions, including arithmetic. -} module Numeric.Units.Dimensional.Dimensions.TermLevel ( -- * Type Dimension'(..), -- * Access to Dimension of Dimensional Values HasDimension(..), HasDynamicDimension(..), DynamicDimension(..), -- * Dimension Arithmetic (*), (/), (^), recip, nroot, sqrt, cbrt, -- * Synonyms for Base Dimensions dOne, dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity, -- * Deconstruction asList, -- * Examining Dynamic Dimensions matchDimensions, isCompatibleWith, hasSomeDimension ) where import Control.DeepSeq import Data.Data import Data.Semigroup (Semigroup(..)) import Data.Monoid (Monoid(..)) import GHC.Generics import Prelude (id, all, fst, snd, fmap, otherwise, divMod, ($), (+), (-), (.), (&&), Int, Show, Eq(..), Ord(..), Maybe(..), Bool(..)) import qualified Prelude as P -- $setup -- >>> import Prelude (negate) -- >>> import Control.Applicative -- >>> import Test.QuickCheck.Arbitrary -- >>> instance Arbitrary Dimension' where arbitrary = Dim' <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- | 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 'Numeric.Units.Dimensional.Dimensions.TypeLevel.Dimension' data kind. data Dimension' = Dim' !Int !Int !Int !Int !Int !Int !Int deriving (Show, Eq, Ord, Data, Generic, Typeable) instance NFData Dimension' where rnf !_ = () -- The Dimension' constructor is already fully strict. instance Semigroup Dimension' where (<>) = (*) -- | The monoid of dimensions under multiplication. instance Monoid Dimension' where mempty = dOne mappend = (<>) -- | The dimension of a dynamic value, which may not have any dimension at all. data DynamicDimension = NoDimension -- ^ The value has no valid dimension. | SomeDimension Dimension' -- ^ The value has the given dimension. | AnyDimension -- ^ The value may be interpreted as having any dimension. deriving (Eq, Ord, Show, Data, Generic, Typeable) instance NFData DynamicDimension where -- | Dimensional values, or those that are only possibly dimensional, inhabit this class, -- which allows access to a term-level representation of their dimension. class HasDynamicDimension a where -- | Gets the 'DynamicDimension' of a dynamic dimensional value, which may be 'NoDimension' if it does not represent -- a dimensional value of any 'Dimension'. -- -- A default implementation is available for types that are also in the `HasDimension` typeclass. dynamicDimension :: a -> DynamicDimension default dynamicDimension :: (HasDimension a) => a -> DynamicDimension dynamicDimension = SomeDimension . dimension -- | Dimensional values inhabit this class, which allows access to a term-level representation of their dimension. class HasDynamicDimension a => HasDimension a where -- | Obtains a term-level representation of a value's dimension. dimension :: a -> Dimension' instance HasDynamicDimension DynamicDimension where dynamicDimension = id instance HasDynamicDimension Dimension' where instance HasDimension Dimension' where dimension = id -- | Combines two 'DynamicDimension's, determining the 'DynamicDimension' of a quantity that must -- match both inputs. -- -- This is the lattice meet operation for 'DynamicDimension'. matchDimensions :: DynamicDimension -> DynamicDimension -> DynamicDimension matchDimensions AnyDimension AnyDimension = AnyDimension matchDimensions d@(SomeDimension _) AnyDimension = d matchDimensions AnyDimension d@(SomeDimension _) = d matchDimensions (SomeDimension d1) (SomeDimension d2) | d1 == d2 = SomeDimension d1 matchDimensions _ _ = NoDimension -- | Determines if a value that has a 'DynamicDimension' is compatible with a specified 'Dimension''. isCompatibleWith :: (HasDynamicDimension a) => a -> Dimension' -> Bool isCompatibleWith = f . dynamicDimension where f AnyDimension _ = True f (SomeDimension d1) d2 | d1 == d2 = True f _ _ = False -- | Determines if a value that has a 'DynamicDimension' in fact has any valid dimension at all. hasSomeDimension :: (HasDynamicDimension a) => a -> Bool hasSomeDimension = (/= NoDimension) . dynamicDimension -- | The dimension of dimensionless values. dOne :: Dimension' dOne = Dim' 0 0 0 0 0 0 0 dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity :: Dimension' dLength = Dim' 1 0 0 0 0 0 0 dMass = Dim' 0 1 0 0 0 0 0 dTime = Dim' 0 0 1 0 0 0 0 dElectricCurrent = Dim' 0 0 0 1 0 0 0 dThermodynamicTemperature = Dim' 0 0 0 0 1 0 0 dAmountOfSubstance = Dim' 0 0 0 0 0 1 0 dLuminousIntensity = Dim' 0 0 0 0 0 0 1 {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^ infixl 7 *, / -- | Forms the product of two dimensions. (*) :: Dimension' -> Dimension' -> Dimension' (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') -- | Forms the quotient of two dimensions. (/) :: Dimension' -> Dimension' -> Dimension' (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') -- | Raises a dimension to an integer power. (^) :: Dimension' -> Int -> Dimension' (Dim' l m t i th n j) ^ x = Dim' (x P.* l) (x P.* m) (x P.* t) (x P.* i) (x P.* th) (x P.* n) (x P.* j) -- | Forms the reciprocal of a dimension. recip :: Dimension' -> Dimension' recip = (dOne /) -- | Takes the nth root of a dimension, if it exists. -- -- n must not be zero. -- -- prop> nroot (negate n) d == nroot n (recip d) nroot :: Int -> Dimension' -> Maybe Dimension' nroot n d | n /= 0 && all ((== 0) . snd) ds = fromList . fmap fst $ ds | otherwise = Nothing where ds = fmap (`divMod` n) . asList $ d -- | Takes the square root of a dimension, if it exists. -- -- prop> sqrt d == nroot 2 d sqrt :: Dimension' -> Maybe Dimension' sqrt = nroot 2 -- | Takes the cube root of a dimension, if it exists. -- -- prop> cbrt d == nroot 3 d cbrt :: Dimension' -> Maybe Dimension' cbrt = nroot 3 -- | Converts a dimension to a list of 7 integers, representing the exponent associated with each -- of the 7 SI base dimensions in the standard order. asList :: Dimension' -> [Int] asList (Dim' l m t i th n j) = [l, m, t, i, th, n, j] -- | Converts a list of integers, representing the exponent associated with each -- of the 7 SI base dimensions in the standard order, to a dimension. -- Returns 'Nothing' if the list doesn't contain exactly 7 elements. fromList :: [Int] -> Maybe Dimension' fromList [l, m, t, i, th, n, j] = Just $ Dim' l m t i th n j fromList _ = Nothing dimensional-1.5/src/Numeric/Units/Dimensional/Dimensions/TypeLevel.hs0000644000000000000000000001324014244166633024172 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home, show-extensions #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only This module defines type-level physical dimensions expressed in terms of the SI base dimensions using 'Numeric.NumType.DK.NumType' for type-level integers. Type-level arithmetic, synonyms for the base dimensions, and conversion to the term-level are included. -} module Numeric.Units.Dimensional.Dimensions.TypeLevel ( -- * Kind of Type-Level Dimensions type Dimension(..), -- * Dimension Arithmetic type (*), type (/), type (^), type Recip, type NRoot, type Sqrt, type Cbrt, -- * Synonyms for Base Dimensions DOne, DLength, DMass, DTime, DElectricCurrent, DThermodynamicTemperature, DAmountOfSubstance, DLuminousIntensity, -- * Conversion to Term Level type KnownDimension ) where import Data.Proxy import Numeric.NumType.DK.Integers ( TypeInt (Zero, Pos1, Pos2, Pos3), type (+), type (-) , KnownTypeInt, toNum ) import qualified Numeric.NumType.DK.Integers as N import Numeric.Units.Dimensional.Dimensions.TermLevel -- | 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'' data Dimension = Dim TypeInt TypeInt TypeInt TypeInt TypeInt TypeInt TypeInt -- | The type-level dimension of dimensionless values. type DOne = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type DLength = 'Dim 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type DMass = 'Dim 'Zero 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type DTime = 'Dim 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero 'Zero type DElectricCurrent = 'Dim 'Zero 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero type DThermodynamicTemperature = 'Dim 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero 'Zero type DAmountOfSubstance = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero type DLuminousIntensity = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^ infixl 7 *, / -- | Multiplication of dimensions corresponds to addition of the base -- dimensions' exponents. type family (a :: Dimension) * (b :: Dimension) where 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') -- | Division of dimensions corresponds to subtraction of the base -- dimensions' exponents. type family (a :: Dimension) / (d :: Dimension) where 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') -- | The reciprocal of a dimension is defined as the result of dividing 'DOne' by it, -- or of negating each of the base dimensions' exponents. type Recip (d :: Dimension) = DOne / d -- | Powers of dimensions correspond 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. type family (d :: Dimension) ^ (x :: TypeInt) where DOne ^ x = DOne d ^ 'Zero = DOne d ^ 'Pos1 = d ('Dim l m t i th n j) ^ x = 'Dim (l N.* x) (m N.* x) (t N.* x) (i N.* x) (th N.* x) (n N.* x) (j N.* x) -- | Roots of dimensions correspond to division of the base dimensions' -- exponents by the order of the root. type family NRoot (d :: Dimension) (x :: TypeInt) where NRoot DOne x = DOne NRoot d 'Pos1 = d NRoot ('Dim l m t i th n j) x = 'Dim (l N./ x) (m N./ x) (t N./ x) (i N./ x) (th N./ x) (n N./ x) (j N./ x) -- | Square root is a special case of 'NRoot' with order 2. type Sqrt d = NRoot d 'Pos2 -- | Cube root is a special case of 'NRoot' with order 3. type Cbrt d = NRoot d 'Pos3 -- | 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''@. type KnownDimension (d :: Dimension) = HasDimension (Proxy d) instance ( KnownTypeInt l , KnownTypeInt m , KnownTypeInt t , KnownTypeInt i , KnownTypeInt th , KnownTypeInt n , KnownTypeInt j ) => HasDynamicDimension (Proxy ('Dim l m t i th n j)) where instance ( KnownTypeInt l , KnownTypeInt m , KnownTypeInt t , KnownTypeInt i , KnownTypeInt th , KnownTypeInt n , KnownTypeInt j ) => HasDimension (Proxy ('Dim l m t i th n j)) where dimension _ = Dim' (toNum (Proxy :: Proxy l)) (toNum (Proxy :: Proxy m)) (toNum (Proxy :: Proxy t)) (toNum (Proxy :: Proxy i)) (toNum (Proxy :: Proxy th)) (toNum (Proxy :: Proxy n)) (toNum (Proxy :: Proxy j)) dimensional-1.5/src/Numeric/Units/Dimensional/Dynamic.hs0000644000000000000000000003667714244166633021560 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only? Defines types for manipulation of units and quantities without phantom types for their dimensions. -} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} module Numeric.Units.Dimensional.Dynamic ( -- * Dynamic Quantities AnyQuantity , DynQuantity , Demotable , Promotable , HasDynamicDimension(..), DynamicDimension(..) , promoteQuantity, demoteQuantity , (*~), (/~), invalidQuantity, polydimensionalZero -- * Dynamic Units , AnyUnit , demoteUnit, promoteUnit, demoteUnit' , siUnit, anyUnitName -- ** Arithmetic on Dynamic Units , (*), (/), (^), recip, applyPrefix ) where import Control.DeepSeq import Control.Monad import Data.Data import Data.ExactPi import Data.Kind import Data.Semigroup (Semigroup(..)) import Data.Monoid (Monoid(..)) import GHC.Generics import Prelude (Eq(..), Num, Fractional, Floating, Show(..), Bool(..), Maybe(..), (.), ($), (++), (&&), id, otherwise, error) import qualified Prelude as P import Numeric.Units.Dimensional hiding ((*~), (/~), (*), (/), (^), recip, nroot, siUnit) import qualified Numeric.Units.Dimensional as Dim import Numeric.Units.Dimensional.Coercion import Numeric.Units.Dimensional.UnitNames (UnitName, baseUnitName) import qualified Numeric.Units.Dimensional.UnitNames.InterchangeNames as I import qualified Numeric.Units.Dimensional.UnitNames as N import Numeric.Units.Dimensional.Dimensions.TermLevel (HasDynamicDimension(..), DynamicDimension(..), matchDimensions, isCompatibleWith) import qualified Numeric.Units.Dimensional.Dimensions.TermLevel as D -- | The class of types that can be used to model 'Quantity's that are certain to have a value with -- some dimension. class Demotable (q :: Type -> Type) where demotableOut :: q a -> AnyQuantity a -- | The class of types that can be used to model 'Quantity's whose 'Dimension's are -- only known dynamically. class Promotable (q :: Type -> Type) where promotableIn :: AnyQuantity a -> q a promotableOut :: q a -> DynQuantity a -- | Forgets information about a 'Quantity' or 'AnyQuantity', yielding an 'AnyQuantity' or a 'DynQuantity'. demoteQuantity :: (Demotable q, Promotable d) => q a -> d a demoteQuantity = promotableIn . demotableOut -- | Converts a dynamic quantity such as an 'AnyQuantity' or a 'DynQuantity' into a -- 'Quantity', or to 'Nothing' if the dynamic quantity cannot be represented in the -- narrower result type. promoteQuantity :: forall a d q.(Promotable q, KnownDimension d) => q a -> Maybe (Quantity d a) promoteQuantity = promoteQ . promotableOut where dim' = dimension (Proxy :: Proxy d) promoteQ (DynQuantity d v) | d `isCompatibleWith` dim' = Just . Quantity $ v | otherwise = Nothing instance (KnownDimension d) => Demotable (Quantity d) where demotableOut q@(Quantity x) = AnyQuantity (dimension q) x -- | A 'Quantity' whose 'Dimension' is only known dynamically. data AnyQuantity a = AnyQuantity !Dimension' !a deriving (Eq, Data, Generic, Generic1, Typeable) instance (Show a) => Show (AnyQuantity a) where show (AnyQuantity d a) | d == D.dOne = show a | otherwise = show a ++ " " ++ (show . baseUnitName $ d) instance HasDynamicDimension (AnyQuantity a) where instance HasDimension (AnyQuantity a) where dimension (AnyQuantity d _) = d instance NFData a => NFData (AnyQuantity a) -- instance is derived from Generic instance instance Promotable AnyQuantity where promotableIn = id promotableOut (AnyQuantity d a) = DynQuantity (SomeDimension d) a instance Demotable AnyQuantity where demotableOut = id -- | 'AnyQuantity's form a 'Semigroup' under multiplication, but not under addition because -- they may not be added together if their dimensions do not match. instance Num a => Semigroup (AnyQuantity a) where (AnyQuantity d1 a1) <> (AnyQuantity d2 a2) = AnyQuantity (d1 D.* d2) (a1 P.* a2) -- | 'AnyQuantity's form a 'Monoid' under multiplication, but not under addition because -- they may not be added together if their dimensions do not match. instance Num a => Monoid (AnyQuantity a) where mempty = demoteQuantity (1 Dim.*~ one) mappend = (<>) -- | Possibly a 'Quantity' whose 'Dimension' is only known dynamically. -- -- By modeling the absence of a value, this type differs from 'AnyQuantity' in that it may -- not be a 'Quantity' of any 'Dimension' whatsoever, but in exchange it gains instances -- for the common numeric classes. It's therefore useful for manipulating, and not merely storing, -- quantities of unknown dimension. -- -- This type also contains a 'polydimensionalZero', representing zero value of any dimension. -- -- Note that the 'Eq' instance for 'DynQuantity' equates all representations of an invalid value, -- and also does not equate polydimensional zero with zero of any specific dimension. data DynQuantity a = DynQuantity !DynamicDimension a -- we can't have strictness annotation on a as it is sometimes undefined deriving (Data, Generic, Generic1, Typeable) instance Eq a => Eq (DynQuantity a) where (DynQuantity NoDimension _) == (DynQuantity NoDimension _) = True -- all invalid quantities are equal (DynQuantity NoDimension _) == _ = False -- invalid quanties are not equal to any other quantity _ == (DynQuantity NoDimension _) = False (DynQuantity d1 v1) == (DynQuantity d2 v2) = d1 == d2 && v1 == v2 instance NFData a => NFData (DynQuantity a) -- instance is derived from Generic instance instance Show a => Show (DynQuantity a) where show (DynQuantity NoDimension _) = "invalidQuantity" show (DynQuantity AnyDimension v) = show v show (DynQuantity (SomeDimension d) v) = show $ AnyQuantity d v instance Promotable DynQuantity where promotableIn (AnyQuantity d a) = DynQuantity (SomeDimension d) a promotableOut = id instance HasDynamicDimension (DynQuantity a) where dynamicDimension (DynQuantity d _) = d instance Num a => Num (DynQuantity a) where x + y = liftDQ2 matchDimensions (P.+) x y x - y = liftDQ2 matchDimensions (P.-) x y x * y = liftDQ2 (valid2 (D.*)) (P.*) x y negate = liftDQ id P.negate abs = liftDQ id P.abs signum = liftDQ (constant D.dOne) P.signum fromInteger = demoteQuantity . (Dim.*~ one) . P.fromInteger instance Fractional a => Fractional (DynQuantity a) where x / y = liftDQ2 (valid2 (D./)) (P./) x y recip = liftDQ (valid D.recip) P.recip fromRational = demoteQuantity . (Dim.*~ one) . P.fromRational instance Floating a => Floating (DynQuantity a) where pi = demoteQuantity pi exp = liftDimensionless P.exp log = liftDimensionless P.log sqrt = liftDQ (whenValid $ D.nroot 2) P.sqrt (**) = liftDQ2 (matchDimensions3 $ SomeDimension D.dOne) (P.**) logBase = liftDQ2 (matchDimensions3 $ SomeDimension D.dOne) P.logBase sin = liftDimensionless P.sin cos = liftDimensionless P.cos tan = liftDimensionless P.tan asin = liftDimensionless P.asin acos = liftDimensionless P.acos atan = liftDimensionless P.atan sinh = liftDimensionless P.sinh cosh = liftDimensionless P.cosh tanh = liftDimensionless P.tanh asinh = liftDimensionless P.asinh acosh = liftDimensionless P.acosh atanh = liftDimensionless P.atanh -- | 'DynQuantity's form a 'Semigroup' under multiplication, but not under addition because -- they may not be added together if their dimensions do not match. instance Num a => Semigroup (DynQuantity a) where (<>) = (P.*) -- | 'DynQuantity's form a 'Monoid' under multiplication, but not under addition because -- they may not be added together if their dimensions do not match. instance Num a => Monoid (DynQuantity a) where mempty = demoteQuantity (1 Dim.*~ one) mappend = (<>) -- | A 'DynQuantity' which does not correspond to a value of any dimension. invalidQuantity :: DynQuantity a invalidQuantity = DynQuantity NoDimension $ error "Attempt to evaluate the value of an invalid quantity." -- | A 'DynQuantity' which corresponds to zero value of any dimension. -- -- When combined through arithmetic with other 'DynQuantity's, inference is performed. For example, -- adding a length to polydimensional zero produces that length. Adding two polydimensional zeros produces another. -- Taking the sine of a polydimensional zero interprets it as a dimensionless zero and produces a dimensionless result. -- -- Note that division by 'polydimensionalZero' produces a polydimensional result, which may be an error or some representation -- of infinity, as determined by the underlying arithmetic type. This behavior was chosen for consistency with the behavior of division -- by zero 'DynQuantity's of a specific dimension. polydimensionalZero :: (Num a) => DynQuantity a polydimensionalZero = DynQuantity AnyDimension 0 -- | Lifts a function which is only valid on dimensionless quantities into a function on 'DynQuantity's. liftDimensionless :: (a -> a) -> DynQuantity a -> DynQuantity a liftDimensionless = liftDQ (matchDimensions $ SomeDimension D.dOne) -- | Lifts a function on values into a function on 'DynQuantity's. liftDQ :: (DynamicDimension -> DynamicDimension) -- ^ How the function operates on dimensions. -> (a -> a) -- ^ How the function operates on values. -> DynQuantity a -> DynQuantity a liftDQ fd fv (DynQuantity d v) = case fd d of NoDimension -> invalidQuantity d' -> DynQuantity d' $ fv v -- | Lifts a function on values into a function on 'DynQuantity's. -- -- This works by treating polydimensional zeros as dimensionless zeros. If that is not the desired behavior, -- handle polydimensional zeros first and then call this function. liftDQ2 :: (DynamicDimension -> DynamicDimension -> DynamicDimension) -> (a -> a -> a) -> DynQuantity a -> DynQuantity a -> DynQuantity a liftDQ2 fd fv (DynQuantity d1 v1) (DynQuantity d2 v2) = case fd d1 d2 of NoDimension -> invalidQuantity d' -> DynQuantity d' $ fv v1 v2 -- | Transforms a dynamic dimension in a way which is always valid. valid :: (Dimension' -> Dimension') -> DynamicDimension -> DynamicDimension valid _ AnyDimension = AnyDimension valid f (SomeDimension d) = SomeDimension (f d) valid _ NoDimension = NoDimension whenValid :: (Dimension' -> Maybe Dimension') -> DynamicDimension -> DynamicDimension whenValid _ AnyDimension = AnyDimension whenValid f (SomeDimension d) | Just d' <- f d = SomeDimension d' whenValid _ _ = NoDimension constant :: Dimension' -> DynamicDimension -> DynamicDimension constant d AnyDimension = SomeDimension d constant d (SomeDimension _) = SomeDimension d constant _ _ = NoDimension -- | Transforms two dynamic dimensions in a way which is always valid. valid2 :: (Dimension' -> Dimension' -> Dimension') -> DynamicDimension -> DynamicDimension -> DynamicDimension valid2 _ AnyDimension (SomeDimension _) = AnyDimension valid2 _ (SomeDimension _) AnyDimension = AnyDimension valid2 _ AnyDimension AnyDimension = AnyDimension valid2 f (SomeDimension d1) (SomeDimension d2) = SomeDimension (f d1 d2) valid2 _ _ _ = NoDimension matchDimensions3 :: DynamicDimension -> DynamicDimension -> DynamicDimension -> DynamicDimension matchDimensions3 x y z = matchDimensions x (matchDimensions y z) -- | A 'Unit' whose 'Dimension' is only known dynamically. data AnyUnit = AnyUnit Dimension' (UnitName 'NonMetric) ExactPi deriving (Generic, Typeable) instance Show AnyUnit where show (AnyUnit _ n e) = show n ++ " =def= " ++ show e ++ " of the SI base unit" instance HasDynamicDimension AnyUnit where instance HasDimension AnyUnit where dimension (AnyUnit d _ _) = d instance I.HasInterchangeName AnyUnit where interchangeName (AnyUnit _ n _) = I.interchangeName n -- | 'AnyUnit's form a 'Semigroup' under multiplication. instance Semigroup AnyUnit where (<>) = (Numeric.Units.Dimensional.Dynamic.*) -- | 'AnyUnit's form a 'Monoid' under multiplication. instance Monoid AnyUnit where mempty = demoteUnit' one mappend = (<>) -- | Extracts the 'UnitName' of an 'AnyUnit'. anyUnitName :: AnyUnit -> UnitName 'NonMetric anyUnitName (AnyUnit _ n _) = n -- | The dynamic SI coherent unit of a given dimension. siUnit :: Dimension' -> AnyUnit siUnit d = AnyUnit d (baseUnitName d) 1 -- | Converts a 'Unit' of statically known 'Dimension' into an 'AnyUnit'. demoteUnit :: forall m d a.(KnownDimension d) => Unit m d a -> AnyUnit demoteUnit u = AnyUnit dim (name $ weaken u) (exactValue u) where dim = dimension (Proxy :: Proxy d) -- | Converts a 'Unit' of statically known 'Dimension' into an 'AnyUnit'. -- -- This is the same as the more general 'demoteUnit' but is useful in certain circumstances to avoid -- needlessly introducing an ambiguous type variable. demoteUnit' :: (KnownDimension d) => Unit m d ExactPi -> AnyUnit demoteUnit' = demoteUnit -- | Converts an 'AnyUnit' into a 'Unit' of statically known 'Dimension', or 'Nothing' if the dimension does not match. -- -- The result is represented in 'ExactPi', conversion to other representations is possible using 'changeRepApproximate'. -- -- The result is always tagged as 'NonMetric', conversion to a 'Metric' unit can be attempted using 'strengthen'. promoteUnit :: forall d.(KnownDimension d) => AnyUnit -> Maybe (Unit 'NonMetric d ExactPi) promoteUnit (AnyUnit dim n e) | dim == dim' = Just $ mkUnitR n e Dim.siUnit | otherwise = Nothing where dim' = dimension (Proxy :: Proxy d) -- | Forms the reciprocal of a dynamic unit. recip :: AnyUnit -> AnyUnit recip (AnyUnit d n e) = AnyUnit (D.recip d) (N.nOne N./ n) (P.recip e) -- | Forms the product of two dynamic units. (*) :: AnyUnit -> AnyUnit -> AnyUnit (AnyUnit d1 n1 e1) * (AnyUnit d2 n2 e2) = AnyUnit (d1 D.* d2) (n1 N.* n2) (e1 P.* e2) -- | Forms the quotient of two dynamic units. (/) :: AnyUnit -> AnyUnit -> AnyUnit (AnyUnit d1 n1 e1) / (AnyUnit d2 n2 e2) = AnyUnit (d1 D./ d2) (n1 N./ n2) (e1 P./ e2) -- | Raises a dynamic unit to an integer power. (^) :: (P.Integral a) => AnyUnit -> a -> AnyUnit (AnyUnit d n e) ^ x = AnyUnit (d D.^ P.fromIntegral x) (n N.^ P.fromIntegral x) (e P.^^ x) -- | Applies a prefix to a dynamic unit. -- Returns 'Nothing' if the 'Unit' was 'NonMetric' and thus could not accept a prefix. applyPrefix :: N.Prefix -> AnyUnit -> Maybe AnyUnit applyPrefix p (AnyUnit d n e) = do n' <- N.strengthen n let n'' = N.applyPrefix p n' let e' = (P.fromRational $ N.scaleFactor p) P.* e return $ AnyUnit d n'' e' -- | Forms a dynamic quantity by multipliying a number and a dynamic unit. (*~) :: (Floating a, Promotable q) => a -> AnyUnit -> q a x *~ (AnyUnit d _ e) = promotableIn $ AnyQuantity d (x P.* approximateValue e) -- | Divides a dynamic quantity by a dynamic unit, obtaining the numerical value of the quantity -- expressed in that unit if they are of the same physical dimension, or 'Nothing' otherwise. (/~) :: (Floating a, Promotable q) => q a -> AnyUnit -> Maybe a x /~ (AnyUnit d _ e) = case promotableOut x of DynQuantity d' x' | d' `isCompatibleWith` d -> Just $ x' P./ approximateValue e | otherwise -> Nothing dimensional-1.5/src/Numeric/Units/Dimensional/FixedPoint.hs0000644000000000000000000004026414244166633022230 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Experimental Portability: GHC only? Defines types for manipulation of quantities with fixed point representations. -} module Numeric.Units.Dimensional.FixedPoint ( -- * Types -- $types Dimensional, Unit, Quantity, SQuantity, Metricality(..), -- * Physical Dimensions Dimension (Dim), -- ** Dimension Arithmetic type (*), type (/), type (^), NRoot, Recip, -- ** Term Level Representation of Dimensions Dimension' (Dim'), HasDimension(..), KnownDimension, -- * Dimensional Arithmetic (*~), (/~), (*), (/), (+), (-), negate, abs, -- ** Transcendental Functions -- *** Via 'Double' expD, logD, sinD, cosD, tanD, asinD, acosD, atanD, sinhD, coshD, tanhD, asinhD, acoshD, atanhD, atan2D, -- *** Via arbitary 'Floating' type expVia, logVia, sinVia, cosVia, tanVia, asinVia, acosVia, atanVia, sinhVia, coshVia, tanhVia, asinhVia, acoshVia, atanhVia, atan2Via, -- ** Operations on Collections (*~~), (/~~), sum, mean, -- dimensionlessLength, nFromTo, -- ** Conversion Between Representations rescale, rescaleFinite, rescaleD, rescaleVia, KnownVariant(dmap), changeRep, changeRepRound, changeRepApproximate, -- * Dimension Synonyms DOne, DLength, DMass, DTime, DElectricCurrent, DThermodynamicTemperature, DAmountOfSubstance, DLuminousIntensity, -- * Quantity Synonyms Dimensionless, Length, Mass, Time, ElectricCurrent, ThermodynamicTemperature, AmountOfSubstance, LuminousIntensity, -- * Constants _0, epsilon, -- $possibly-imprecise-constants _1, _2, _3, _4, _5, _6, _7, _8, _9, pi, tau, -- * Constructing Units siUnit, one, mkUnitR, mkUnitQ, mkUnitZ, -- * Unit Metadata name, exactValue, weaken, strengthen, exactify, -- * Commonly Used Type Synonyms -- $synonyms type Q, type QScale, type Angle8, type Angle16, type Angle32 ) where import Data.Bits import Data.ExactPi import qualified Data.ExactPi.TypeLevel as E import Data.Int import Data.Proxy import qualified Data.Foldable as F import Data.Ratio import qualified GHC.TypeLits as N import Numeric.Units.Dimensional.Coercion import Numeric.Units.Dimensional.Internal import Numeric.Units.Dimensional.Prelude hiding ((*~), (/~), (+), (-), recip, negate, abs, (*~~), (/~~), sum, mean, _0, _1, _2, _3, _4, _5, _6, _7, _8, _9, pi, tau, changeRep) import Numeric.Units.Dimensional.Variants hiding (type (*), type (/)) import qualified Numeric.Units.Dimensional.UnitNames as Name import qualified Prelude as P {- $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. -} {- Arithmetic Operators and Functions We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} --infixr 8 ^, ^/, ** infixl 6 +, - -- | Adds two possibly scaled 'SQuantity's, 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 (+) = liftQ2 (P.+) -- | Subtracts one possibly scaled 'SQuantity' from another, 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 (-) = liftQ2 (P.-) -- | Takes the absolute value of a possibly scaled 'SQuantity', preserving any scale factor. abs :: (Num a) => SQuantity s d a -> SQuantity s d a abs = liftQ (P.abs) -- | Negates the value of a possibly scaled 'SQuantity', preserving any scale factor. negate :: (Num a) => SQuantity s d a -> SQuantity s d a negate = liftQ (P.negate) infixl 7 *~~, /~~ -- | Applies '*~' to all values in a functor. (*~~) :: (Functor f, RealFrac a, Integral b, E.MinCtxt s a) => f a -> Unit m d a -> f (SQuantity s d b) xs *~~ u = fmap (*~ u) xs -- | Applies '/~' to all values in a functor. (/~~) :: (Functor f, Real a, Fractional b, E.MinCtxt s b) => f (SQuantity s d a) -> Unit m d b -> f b xs /~~ u = fmap (/~ u) xs -- | The sum of all elements in a list. sum :: (Num a, F.Foldable f) => f (SQuantity s d a) -> SQuantity s d a sum = F.foldr (+) _0 -- | The arithmetic mean of all elements in a list. mean :: (Fractional a, F.Foldable f) => f (SQuantity s d a) -> SQuantity s d a mean = reduce . F.foldr accumulate (_0, 0 :: Int) where reduce (s, n) = dmap (P./ fromIntegral n) s accumulate val (accum, count) = (accum + val, count P.+ 1) expD, logD, sinD, cosD, tanD, asinD, acosD, atanD, sinhD, coshD, tanhD, asinhD, acoshD, atanhD :: (Integral a, Integral b, E.MinCtxt s1 Double, E.MinCtxt s2 Double) => SQuantity s1 DOne a -> SQuantity s2 DOne b expD = expVia (Proxy :: Proxy P.Double) logD = logVia (Proxy :: Proxy P.Double) sinD = sinVia (Proxy :: Proxy P.Double) cosD = cosVia (Proxy :: Proxy P.Double) tanD = tanVia (Proxy :: Proxy P.Double) asinD = asinVia (Proxy :: Proxy P.Double) acosD = acosVia (Proxy :: Proxy P.Double) atanD = atanVia (Proxy :: Proxy P.Double) sinhD = sinhVia (Proxy :: Proxy P.Double) coshD = coshVia (Proxy :: Proxy P.Double) tanhD = tanhVia (Proxy :: Proxy P.Double) asinhD = asinhVia (Proxy :: Proxy P.Double) acoshD = acoshVia (Proxy :: Proxy P.Double) atanhD = atanhVia (Proxy :: Proxy P.Double) -- | The standard two argument arctangent function. -- Since it interprets its two arguments in comparison with one another, the input may have any dimension. atan2D :: (Integral a, Integral b, E.MinCtxt s1 Double, E.MinCtxt s2 Double, E.MinCtxt s3 Double) => SQuantity s1 DOne a -> SQuantity s2 DOne a -> SQuantity s3 DOne b atan2D = atan2Via (Proxy :: Proxy P.Double) expVia, logVia, sinVia, cosVia, tanVia, asinVia, acosVia, atanVia, sinhVia, coshVia, tanhVia, asinhVia, acoshVia, atanhVia :: (Integral a, RealFrac b, Floating b, Integral c, E.MinCtxt s1 b, E.MinCtxt s2 b) => Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c expVia = liftDimensionlessVia P.exp logVia = liftDimensionlessVia P.log sinVia = liftDimensionlessPeriodicVia (2 P.* P.pi) P.sin cosVia = liftDimensionlessPeriodicVia (2 P.* P.pi) P.cos tanVia = liftDimensionlessPeriodicVia P.pi P.tan asinVia = liftDimensionlessVia P.asin acosVia = liftDimensionlessVia P.acos atanVia = liftDimensionlessVia P.atan sinhVia = liftDimensionlessPeriodicVia (2 P.* P.pi) P.sinh coshVia = liftDimensionlessPeriodicVia (2 P.* P.pi) P.cosh tanhVia = liftDimensionlessPeriodicVia P.pi P.tanh asinhVia = liftDimensionlessVia P.asinh acoshVia = liftDimensionlessVia P.acosh atanhVia = liftDimensionlessVia P.atanh -- | The standard two argument arctangent function. -- Since it interprets its two arguments in comparison with one another, the input may have any dimension. atan2Via :: forall s1 s2 s3 a b c d.(Integral a, RealFloat b, Integral c, E.MinCtxt s1 b, E.MinCtxt s2 b, E.MinCtxt s3 b, KnownDimension d) => Proxy b -> SQuantity s1 d a -> SQuantity s2 d a -> SQuantity s3 DOne c atan2Via _ y x = (*~ siUnit) $ (P.atan2 :: b -> b -> b) (y /~ siUnit) (x /~ siUnit) -- | Lift a function on dimensionless values of a specified intermediate type to operate on possibly scaled dimensionless values. liftDimensionlessVia :: forall s1 s2 a b c.(Real a, RealFrac b, Integral c, E.MinCtxt s1 b, E.MinCtxt s2 b) => (b -> b) -> Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c liftDimensionlessVia f _ = (*~ siUnit) . (f :: b -> b) . (/~ siUnit) -- | Lift a periodic function on dimensionless values of a specified intermediate type to operate on possibly scaled dimensionless values. -- -- If the scale factor of the input type is an exact integer divisor of the function's period, the argument -- will be clamped via an integer `mod` operation prior to applying the function to avoid errors introduced by a floating point modulus. liftDimensionlessPeriodicVia :: forall s1 s2 a b c.(Integral a, RealFrac b, Floating b, Integral c, E.MinCtxt s1 b, E.MinCtxt s2 b) => ExactPi -> (forall d.Floating d => d -> d) -> Proxy b -> SQuantity s1 DOne a -> SQuantity s2 DOne c liftDimensionlessPeriodicVia p f proxy | Just p'' <- p', p'' /= 0 = (liftDimensionlessVia f proxy) . dmap (`mod` p'') | otherwise = liftDimensionlessVia f proxy where p' :: Maybe a p' = fmap fromInteger . toExactInteger . P.recip . (P./ p) . E.exactPiVal $ (Proxy :: Proxy s1) {- We give '*~' and '/~' the same fixity as '*' and '/' defined below. Note that this necessitates the use of parenthesis when composing units using '*' and '/', e.g. "1 *~ (meter / second)". -} infixl 7 *~, /~ -- | Forms a possibly scaled 'SQuantity' by multipliying a number and a unit. (*~) :: forall s m d a b.(RealFrac a, Integral b, E.MinCtxt s a) => a -> Unit m d a -> SQuantity s d b x *~ (Unit _ _ y) = Quantity . round $ (x P.* y P./ s) where s = E.injMin (Proxy :: Proxy s) -- | Divides a possibly scaled 'SQuantity' by a 'Unit' of the same physical dimension, obtaining the -- numerical value of the quantity expressed in that unit. (/~) :: forall s m d a b.(Real a, Fractional b, E.MinCtxt s b) => SQuantity s d a -> Unit m d b -> b (Quantity x) /~ (Unit _ _ y) = ((realToFrac x) P.* s P./ y) where s = E.injMin (Proxy :: Proxy s) {- Rescaling Operations -} -- | 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. rescale :: forall a b d s1 s2.(Integral a, Integral b, E.KnownExactPi s1, E.KnownExactPi s2) => SQuantity s1 d a -> SQuantity s2 d b rescale | Just s' <- toExactInteger s = viaInteger (P.* s') | Just s' <- toExactInteger (P.recip s) = viaInteger (`P.quot` s') | Just q <- toExactRational s = viaInteger $ timesRational q | otherwise = viaInteger $ \x -> fixedPoint (fmap (($ x) . timesRational) (rationalApproximations s)) where s = (s1' P./ s2') s1' = E.exactPiVal (Proxy :: Proxy s1) s2' = E.exactPiVal (Proxy :: Proxy s2) timesRational :: Rational -> Integer -> Integer timesRational q = (`P.quot` denominator q) . (P.* numerator q) -- | 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. rescaleFinite :: (Integral a, FiniteBits a, Integral b, FiniteBits b, E.KnownExactPi s1, E.KnownExactPi s2) => SQuantity s1 d a -> SQuantity s2 d b rescaleFinite = rescale -- It should be possible to do this more quickly, since we have a priori knowledge of how well we need to approximate the result -- | 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. rescaleVia :: forall a b c d s1 s2.(Integral a, RealFrac b, Floating b, Integral c, E.KnownExactPi s1, E.KnownExactPi s2) => Proxy b -> SQuantity s1 d a -> SQuantity s2 d c rescaleVia _ = viaIntermediate (P.* s) where s = approximateValue (s1' P./ s2') :: b s1' = E.exactPiVal $ (Proxy :: Proxy s1) s2' = E.exactPiVal $ (Proxy :: Proxy s2) -- | 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. rescaleD :: (Integral a, Integral b, E.KnownExactPi s1, E.KnownExactPi s2) => SQuantity s1 d a -> SQuantity s2 d b rescaleD = rescaleVia (Proxy :: Proxy Double) -- Note that this does not respect scaling factors at all. viaInteger :: (Integral a, Integral b) => (P.Integer -> P.Integer) -> SQuantity s1 d a -> SQuantity s2 d b viaInteger f = Quantity . fromInteger . f . fromIntegral . unQuantity -- Note that this does not respect scaling factors at all. viaIntermediate :: (Integral a, RealFrac b, Integral c) => (b -> b) -> SQuantity s1 d a -> SQuantity s2 d c viaIntermediate f = Quantity . round . f . fromIntegral . unQuantity fixedPoint :: (Eq a) => [a] -> a fixedPoint [] = error "Fixed point of empty list." fixedPoint [x] = x fixedPoint (x1:x2:xs) | x1 == x2 = x1 | otherwise = fixedPoint (x2:xs) {- Changes of Representation -} -- | Convenient conversion between numerical types while retaining dimensional information. changeRep :: forall v1 v2 d a b. (KnownVariant v1, KnownVariant v2, CompatibleVariants v1 v2, E.MinCtxt (ScaleFactor v1 E./ ScaleFactor v2) b, Real a, Fractional b) => Dimensional v1 d a -> Dimensional v2 d b changeRep = liftD (P.* s) ((P.* s') . realToFrac) Name.weaken where p :: Proxy (ScaleFactor v1 E./ ScaleFactor v2) p = Proxy s = E.exactPiVal p s' = E.injMin p -- | Convenient conversion to types with `Integral` representations using `round`. changeRepRound :: forall v1 v2 d a b. (KnownVariant v1, KnownVariant v2, CompatibleVariants v1 v2, E.MinCtxt (ScaleFactor v1 E./ ScaleFactor v2) a, RealFrac a, Integral b) => Dimensional v1 d a -> Dimensional v2 d b changeRepRound = liftD (P.* s) (round . (P.* s')) Name.weaken where p :: Proxy (ScaleFactor v1 E./ ScaleFactor v2) p = Proxy s = E.exactPiVal p s' = E.injMin p {- Useful Constant Values -} {- $possibly-imprecise-constants Note that, other than '_0' and 'epsilon', these constants may not be exactly representable with certain scale factors. -} -- | The constant for zero is polymorphic, allowing -- it to express zero 'Length' or 'Capacitance' or 'Velocity' etc, in addition -- to the 'Dimensionless' value zero. _0 :: Num a => SQuantity s d a _0 = Quantity 0 _1, _2, _3, _4, _5, _6, _7, _8, _9 :: (Integral a, E.KnownExactPi s) => SQuantity s DOne a _1 = rescale (epsilon :: SQuantity E.One DOne Integer) _2 = rescale (epsilon :: SQuantity (E.ExactNatural 2) DOne Integer) _3 = rescale (epsilon :: SQuantity (E.ExactNatural 3) DOne Integer) _4 = rescale (epsilon :: SQuantity (E.ExactNatural 4) DOne Integer) _5 = rescale (epsilon :: SQuantity (E.ExactNatural 5) DOne Integer) _6 = rescale (epsilon :: SQuantity (E.ExactNatural 6) DOne Integer) _7 = rescale (epsilon :: SQuantity (E.ExactNatural 7) DOne Integer) _8 = rescale (epsilon :: SQuantity (E.ExactNatural 8) DOne Integer) _9 = rescale (epsilon :: SQuantity (E.ExactNatural 9) DOne Integer) pi :: (Integral a, E.KnownExactPi s) => SQuantity s DOne a pi = rescale (epsilon :: SQuantity E.Pi DOne Integer) -- | Twice 'pi'. -- -- For background on 'tau' see https://tauday.com/tau-manifesto (but also -- feel free to review https://web.archive.org/web/20200926221249/http://www.thepimanifesto.com/). tau :: (Integral a, E.KnownExactPi s) => SQuantity s DOne a tau = rescale (epsilon :: SQuantity (E.ExactNatural 2 E.* E.Pi) DOne Integer) -- | The smallest positive representable value in a given fixed-point scaled quantity type. epsilon :: (Integral a) => SQuantity s d a epsilon = Quantity 1 {- $synonyms These type synonyms for commonly used fixed-point types are provided for convenience. -} -- | A binary scale factor. type QScale n = (E.One E./ (E.ExactNatural (2 N.^ n))) -- | A dimensionless number with `n` fractional bits, using a representation of type `a`. type Q n a = SQuantity (QScale n) DOne a -- | A single-turn angle represented as a signed 8-bit integer. type Angle8 = SQuantity (E.Pi E.* (QScale 7)) DPlaneAngle Int8 -- | A single-turn angle represented as a signed 16-bit integer. type Angle16 = SQuantity (E.Pi E.* (QScale 15)) DPlaneAngle Int16 -- | A single-turn angle represented as a signed 32-bit integer. type Angle32 = SQuantity (E.Pi E.* (QScale 31)) DPlaneAngle Int32 dimensional-1.5/src/Numeric/Units/Dimensional/Functor.hs0000644000000000000000000000213614244152645021571 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK show-extensions #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only Provides a 'Functor' instance for 'Dimensional'. Note that this instance is dubious, because it allows you to break the dimensional abstraction. See 'dmap' for more information. Note that, while this instance overlaps with that given for 'Dimensionless', it is confluent with that instance. Note that this is an orphan instance. -} module Numeric.Units.Dimensional.Functor where import Numeric.Units.Dimensional import Prelude -- | A 'Functor' instance for 'Dimensional'. -- -- Note that this instance is dubious, because it allows you to break the dimensional abstraction. See 'dmap' for more information. -- -- Note that, while this instance overlaps with that given for 'Dimensionless', it is confluent with that instance. -- -- Note that this is an orphan instance. instance {-# OVERLAPPING #-} (KnownVariant v) => Functor (Dimensional v d) where fmap = dmap dimensional-1.5/src/Numeric/Units/Dimensional/NonSI.hs0000644000000000000000000007754514254537626021166 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE NumDecimals #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module defines units that are not part of the SI, with the exception of those defined in the "Numeric.Units.Dimensional.SIUnits" module (units outside of the SI accepted for use with the SI). Any chapters, sections or tables referenced are from <#note1 [1]> unless otherwise specified. == Neper, bel, shannon and the like The units of section 5.1.2 are purposefully (but not permanently) omitted. In fact the logarithmic units (see section 8.7) are problematic and it is not clear how to implement them. Perhaps with a conversion function similar to for degrees Celsius. = References 1. #note1# https://www.nist.gov/pml/special-publication-811 2. #note2# https://www.iau.org/publications/proceedings_rules/units/ 3. #note3# https://en.wikipedia.org/wiki/Pressure 4. #note4# https://en.wikipedia.org/wiki/Torr -} module Numeric.Units.Dimensional.NonSI ( -- * Units Defined By Experiment -- $values-obtained-experimentally electronVolt, calorie, unifiedAtomicMassUnit, dalton, -- * Dimensionless Units percent, -- * Standard Gravity gee, -- * Inch-pound Units -- $inch-pound-units poundMass, ounce, poundForce, horsepower, btu, shortTon, nauticalMile, knot, revolution, solid, slug, psi, teaspoon, -- ** International Foot foot, inch, mil, yard, mile, acre, -- ** US Survey Foot usSurveyFoot, usSurveyInch, usSurveyMil, usSurveyYard, usSurveyMile, usSurveyAcre, -- * Years -- $year year, decade, century, millennium, -- * Pressure Units -- $pressure-units bar, atmosphere, technicalAtmosphere, mmHg, inHg, inHg_UCUM, inHg_NIST, torr, -- * Radiation Units rad, -- * Kinematic Viscosity stokes, -- * Temperature -- $temperature degreeFahrenheit, degreeRankine, -- * Imperial Volumes -- $imperial-volumes imperialGallon, imperialQuart, imperialPint, imperialCup, imperialGill, imperialFluidOunce, -- * US Customary Volumes -- $us-customary-volumes usGallon, usQuart, usPint, usCup, usGill, usFluidOunce, -- * Atomic-Scale Units angstrom, -- * Units from the Centimeter-Gram-Second Electrostatic System of Units gauss ) where import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.UnitNames.Internal (ucumMetric, ucum, dimensionalAtom) import qualified Prelude -- $setup -- >>> import Data.ExactPi -- >>> import Data.Function (on) -- >>> import Numeric.Units.Dimensional.Coercion -- >>> default (Double) -- >>> :{ -- >>> let infix 4 === -- >>> (===) = areExactlyEqual `on` unQuantity :: Quantity d ExactPi -> Quantity d ExactPi -> Bool -- >>> :} {- $values-obtained-experimentally From Table 7, units accepted for use with the SI whose values in SI units are obtained experimentally. When <#note1 [1]> was published, the electron volt had a standard combined uncertainity of 0.00000049e-19 J and the unified atomic mass unit had a combined uncertainty of 0.0000010e-27 kg. -} electronVolt :: Floating a => Unit 'Metric DEnergy a electronVolt = mkUnitR (ucumMetric "eV" "eV" "electron volt") 1.60217733e-19 $ joule calorie :: Floating a => Unit 'Metric DEnergy a calorie = mkUnitR (ucumMetric "cal" "cal" "calorie") 4.184 $ joule unifiedAtomicMassUnit :: Floating a => Unit 'Metric DMass a unifiedAtomicMassUnit = mkUnitR (ucumMetric "u" "u" "atomic mass unit") 1.6605402e-27 $ kilo gram dalton :: Floating a => Unit 'Metric DMass a dalton = mkUnitR (ucumMetric "u" "Da" "Dalton") 1 $ unifiedAtomicMassUnit -- | One percent is one hundrendth. -- -- The dimensionless number 0.01, represented by the symbol %, is commonly used as a dimensionless unit. -- -- See section 7.10.2 of the <#note1 [1]> for further information. -- -- >>> 1 *~ percent -- 1.0e-2 percent :: (Fractional a) => Unit 'NonMetric DOne a percent = mkUnitQ (ucum "%" "%" "percent") (1 Prelude./ 100) one -- | One gee is the standard value of the acceleration due to gravity at the -- Earth's surface, as standardized by CIPM. -- -- Note that local values of acceleration due to gravity will differ from the -- standard gravity. -- -- See for further information. -- -- >>> 1 *~ gee -- 9.80665 m s^-2 -- -- >>> 1 *~ gee :: Acceleration Rational -- 196133 % 20000 m s^-2 gee :: Fractional a => Unit 'Metric DAcceleration a gee = mkUnitQ (ucumMetric "[g]" "g" "gee") 9.80665 $ meter / second ^ pos2 {- $inch-pound-units Some US customary (that is, inch-pound) units. -} -- | One international foot is one third of an international 'yard'. -- -- See for further information. -- -- >>> 1 *~ foot -- 0.3048 m -- -- prop> 3 *~ foot === 1 *~ yard -- -- >>> 1 *~ foot :: Length Rational -- 381 % 1250 m foot :: Fractional a => Unit 'NonMetric DLength a foot = mkUnitQ (ucum "[ft_i]" "ft" "foot") (1 Prelude./ 3) $ yard -- | One inch is one twelth of a 'foot'. -- -- This inch is based on the international 'foot'. -- -- See for further information. -- -- >>> 1 *~ inch -- 2.54e-2 m -- -- prop> 12 *~ inch === 1 *~ foot -- -- >>> 1 *~ inch :: Length Rational -- 127 % 5000 m inch :: Fractional a => Unit 'NonMetric DLength a inch = mkUnitQ (ucum "[in_i]" "in" "inch") (1 Prelude./ 12) $ foot -- | One mil is one thousandth of an 'inch'. -- -- This mil is based on the international 'inch'. -- -- See for further information. -- -- >>> 1 *~ mil -- 2.54e-5 m -- -- prop> 1000 *~ mil === 1 *~ inch -- -- >>> 1 *~ mil :: Length Rational -- 127 % 5000000 m mil :: Fractional a => Unit 'NonMetric DLength a mil = mkUnitQ (ucum "[mil_i]" "mil" "mil") 0.001 $ inch -- | One yard, as defined by international agreement in 1959, is precisely -- 0.9144 'meter'. -- -- See for further information. -- -- >>> 1 *~ yard -- 0.9144 m -- -- >>> 1 *~ yard :: Length Rational -- 1143 % 1250 m yard :: (Fractional a) => Unit 'NonMetric DLength a yard = mkUnitQ (ucum "[yd_i]" "yd" "yard") 0.9144 $ meter -- | One mile is 5 280 feet. -- -- This mile is based on the international 'foot'. -- -- See for further information. -- -- >>> 1 *~ mile -- 1609.344 m -- -- prop> 1 *~ mile === 5280 *~ foot -- -- >>> 1 *~ mile :: Length Rational -- 201168 % 125 m mile :: (Fractional a) => Unit 'NonMetric DLength a mile = mkUnitQ (ucum "[mi_i]" "mi" "mile") 5280 $ foot -- | One acre is 43 560 square feet. -- -- This acre is based on the international 'foot'. For the acre based on the US Survey Foot, -- see 'usSurveyAcre'. While both acres are in use, the difference between them is of little consequence -- for most applications in which either is used. -- -- See for further information. -- -- >>> 1 *~ acre -- 4046.8564224 m^2 -- -- prop> 1 *~ acre === 43560 *~ foot ^ pos2 -- -- >>> 1 *~ acre :: Area Rational -- 316160658 % 78125 m^2 acre :: (Fractional a) => Unit 'NonMetric DArea a acre = mkUnitQ (dimensionalAtom "[acr_i]" "ac" "acre") 43560 $ square foot -- | One US survey foot is 1200/3937 'meter'. -- -- For the international foot, see 'foot'. Note that this is not the foot in routine use -- in the United States. -- -- See for further information. -- -- >>> 1 *~ usSurveyFoot -- 0.3048006096012192 m -- -- >>> 1 *~ usSurveyFoot :: Length Rational -- 1200 % 3937 m usSurveyFoot :: Fractional a => Unit 'NonMetric DLength a usSurveyFoot = mkUnitQ (ucum "[ft_us]" "ft" "foot") (1200 Prelude./ 3937) $ meter -- | One inch is one twelth of a foot. -- -- This inch is based on the 'usSurveyFoot'. For the inch based on the international foot, -- see 'inch'. Note that this is not the inch in routine use in the United States. -- -- See for further information. -- -- >>> 1 *~ usSurveyInch -- 2.54000508001016e-2 m -- -- prop> 12 *~ usSurveyInch === 1 *~ usSurveyFoot -- -- >>> 1 *~ usSurveyInch :: Length Rational -- 100 % 3937 m usSurveyInch :: Fractional a => Unit 'NonMetric DLength a usSurveyInch = mkUnitQ (ucum "[in_us]" "in" "inch") (1 Prelude./ 12) $ usSurveyFoot -- | One mil is one thousandth of an inch. -- -- This mil is based on the 'usSurveyInch'. For the mil based on the international inch, -- see 'mil'. Note that this is not the mil in routine use in the United States. -- -- See for further information. -- -- >>> 1 *~ usSurveyMil -- 2.54000508001016e-5 m -- -- prop> 1000 *~ usSurveyMil === 1 *~ usSurveyInch -- -- >>> 1 *~ usSurveyMil :: Length Rational -- 1 % 39370 m usSurveyMil :: Fractional a => Unit 'NonMetric DLength a usSurveyMil = mkUnitQ (ucum "[mil_us]" "mil" "mil") 0.001 $ usSurveyInch -- | One yard is three feet. -- -- This yard is based on the 'usSurveyFoot'. For the international yard, -- see 'yard'. Note that this is not the yard in routine use in the United States. -- -- See for further information. -- -- >>> 1 *~ usSurveyYard -- 0.9144018288036576 m -- -- prop> 1 *~ usSurveyYard === 3 *~ usSurveyFoot -- -- >>> 1 *~ usSurveyYard :: Length Rational -- 3600 % 3937 m usSurveyYard :: (Fractional a) => Unit 'NonMetric DLength a usSurveyYard = mkUnitQ (ucum "[yd_us]" "yd" "yard") 3 $ usSurveyFoot -- | One US survey mile is 5 280 US survey feet. -- -- This mile is based on the 'usSurveyFoot'. For the mile based on the international foot, -- see 'mile'. Note that this is not the mile in routine use in the United States. -- -- See for further information. -- -- >>> 1 *~ usSurveyMile -- 1609.3472186944373 m -- -- prop> 1 *~ usSurveyMile === 5280 *~ usSurveyFoot -- -- >>> 1 *~ usSurveyMile :: Length Rational -- 6336000 % 3937 m usSurveyMile :: (Fractional a) => Unit 'NonMetric DLength a usSurveyMile = mkUnitQ (ucum "[mi_us]" "mi" "mile") 5280 $ usSurveyFoot -- | One acre is 43 560 square feet. -- -- This acre is based on the 'usSurveyFoot'. For the acre based on the international foot, -- see 'acre'. While both acres are in use, the difference between them is of little consequence -- for most applications in which either is used. This is the only acre defined by the UCUM. -- -- See for further information. -- -- >>> 1 *~ usSurveyAcre -- 4046.872609874252 m^2 -- -- prop> 1 *~ usSurveyAcre === 43560 *~ usSurveyFoot ^ pos2 -- -- >>> 1 *~ usSurveyAcre :: Area Rational -- 62726400000 % 15499969 m^2 usSurveyAcre :: (Fractional a) => Unit 'NonMetric DArea a usSurveyAcre = mkUnitQ (ucum "[acr_us]" "ac" "acre") 43560 $ square usSurveyFoot -- | One avoirdupois pound is a mass, exactly defined in terms of the kilogram by the international -- yard and pound agreement of 1959. -- -- See for further information. -- -- >>> 1 *~ poundMass -- 0.45359237 kg -- -- >>> 1 *~ poundMass :: Mass Rational -- 45359237 % 100000000 kg poundMass :: Fractional a => Unit 'NonMetric DMass a poundMass = mkUnitQ (ucum "[lb_av]" "lb" "pound") 0.45359237 $ kilo gram -- | One avoirdupois ounce is one sixteenth of a 'poundMass'. -- -- See for further information. -- -- >>> 1 *~ ounce -- 2.8349523125e-2 kg -- -- prop> 16 *~ ounce === 1 *~ poundMass -- -- >>> 1 *~ ounce :: Mass Rational -- 45359237 % 1600000000 kg ounce :: Fractional a => Unit 'NonMetric DMass a ounce = mkUnitQ (ucum "[oz_av]" "oz" "ounce") (1 Prelude./ 16) $ poundMass -- | One short ton is two thousand 'poundMass'. -- -- See for further information. -- -- >>> 1 *~ shortTon -- 907.18474 kg -- -- >>> 1 *~ shortTon :: Mass Rational -- 45359237 % 50000 kg shortTon :: Fractional a => Unit 'NonMetric DMass a shortTon = mkUnitQ (ucum "[ston_av]" "ton" "short ton") 2000 $ poundMass -- | The pound-force is equal to the gravitational force exerted on a mass -- of one avoirdupois pound on the surface of Earth. -- -- This definition is based on standard gravity (the 'gee') and the -- international avoirdupois 'poundMass'. -- -- See for further information. -- -- >>> 1 *~ poundForce -- 4.4482216152605 m kg s^-2 -- -- prop> 1 *~ poundForce === 1 *~ poundMass * (1 *~ gee) -- -- >>> 1 *~ poundForce :: Force Rational -- 8896443230521 % 2000000000000 m kg s^-2 poundForce :: Fractional a => Unit 'NonMetric DForce a poundForce = mkUnitQ (ucum "[lbf_av]" "lbf" "pound force") 1 $ poundMass * gee -- | One mechanical horsepower is by definition the power necessary -- to apply a force of 550 'poundForce' through a distance of one 'foot' -- per 'second'. -- -- See for further information. -- -- >>> 1 *~ horsepower -- 745.6998715822702 m^2 kg s^-3 -- -- prop> 1 *~ horsepower === 550 *~ poundForce * (1 *~ foot) / (1 *~ second) -- -- >>> 1 *~ horsepower :: Power Rational -- 37284993579113511 % 50000000000000 m^2 kg s^-3 horsepower :: Fractional a => Unit 'NonMetric DPower a horsepower = mkUnitQ (ucum "[HP]" "hp" "horsepower") 550 $ foot * poundForce / second -- | The slug is a unit of mass associated with Imperial units and United States customary units. -- It is a mass that accelerates by 1 foot per second per second when a force of one pound is exerted on it. -- -- This definition is based on standard gravity (the 'gee'), the international 'foot', and the international avoirdupois 'poundMass'. -- -- See for further information. -- -- >>> 1 *~ slug -- 14.593902937206364 kg -- -- >>> 1 *~ slug :: Mass Rational -- 8896443230521 % 609600000000 kg slug :: Fractional a => Unit 'NonMetric DMass a slug = mkUnitQ (dimensionalAtom "slug" "slug" "slug") 1 $ poundForce * (second^pos2) / foot -- | One psi is a pressure of one 'poundForce' per 'square' 'inch' of area. -- -- See for further information. -- -- >>> 1 *~ psi -- 6894.757293168362 m^-1 kg s^-2 -- -- >>> 1 *~ psi :: Pressure Rational -- 8896443230521 % 1290320000 m^-1 kg s^-2 psi :: Fractional a => Unit 'NonMetric DPressure a psi = mkUnitQ (ucum "[psi]" "psi" "pound per square inch") 1 $ poundForce / inch ^ pos2 -- | One nautical mile is a unit of length, set by international agreement as being exactly 1 852 meters. -- -- Historically, it was defined as the distance spanned by one minute of arc along a meridian of the Earth. -- -- See for further information. -- -- >>> 1 *~ nauticalMile -- 1852.0 m -- -- >>> 1 *~ nauticalMile :: Length Rational -- 1852 % 1 m nauticalMile :: (Num a) => Unit 'NonMetric DLength a nauticalMile = mkUnitZ (ucum "[nmi_i]" "NM" "nautical mile") 1852 $ meter -- | One knot is a velocity equal to one 'nauticalMile' per 'hour'. -- -- See for further information. -- -- >>> 1 *~ knot -- 0.5144444444444445 m s^-1 -- -- >>> 1 *~ knot :: Velocity Rational -- 463 % 900 m s^-1 knot :: (Fractional a) => Unit 'NonMetric DVelocity a knot = mkUnitQ (ucum "[kt_i]" "kt" "knot") 1 $ nauticalMile / hour -- | One revolution is an angle equal to 2*pi radians; a full circle. -- -- See for further information. -- -- >>> 1 *~ revolution -- 6.283185307179586 -- -- prop> 1 *~ revolution === _2 * pi * (1 *~ radian) -- -- prop> 1 *~ revolution === 360 *~ degree revolution :: (Floating a) => Unit 'NonMetric DOne a revolution = mkUnitR (dimensionalAtom "rev" "rev" "revolution") (2 Prelude.* Prelude.pi) $ radian solid :: (Floating a) => Unit 'NonMetric DOne a solid = mkUnitR (dimensionalAtom "solid" "solid" "solid") (4 Prelude.* Prelude.pi) $ steradian teaspoon :: (Fractional a) => Unit 'NonMetric DVolume a teaspoon = mkUnitQ (ucum "[tsp_m]" "tsp" "teaspoon") 5 $ milli liter -- | One btu is is the 'QuantityOfHeat' required to raise the temperature -- of 1 avoirdupois 'poundMass' of liquid water by 1 'degreeFahrenheit' at a constant pressure of one 'atmosphere'. -- -- Because this value must be determined experimentally and varies with temperature, several standardized -- values of the btu have arisen. This is the value based on the International Steam Table calorie, -- defined by the Fifth International Conference on the Properties of Steam. -- -- See for further information. -- -- >>> 1 *~ btu -- 1055.05585262 m^2 kg s^-2 -- -- >>> 1 *~ btu :: Energy Rational -- 52752792631 % 50000000 m^2 kg s^-2 btu :: Fractional a => Unit 'NonMetric DEnergy a btu = mkUnitQ (ucum "[Btu_IT]" "btu" "British thermal unit") 1055.05585262 $ joule {- $year The IAU recommends <#note2 [2]> that: Although there are several different kinds of year (as there are several kinds of day), it is best to regard a year as a Julian year of 365.25 days (31557600 s) unless otherwise specified. -} -- | One Julian year is a unit of measurement of time defined as exactly 365.25 days of 86 400 'second's each. -- -- See for further information. -- -- prop> 1 *~ year === 365.25 *~ day -- -- >>> 1 *~ year -- 3.15576e7 s -- -- >>> 1 *~ year :: Time Rational -- 31557600 % 1 s year :: Num a => Unit 'NonMetric DTime a year = mkUnitZ (ucum "a_j" "a" "mean Julian year") 31557600 $ second -- | One Julian decade is ten Julian 'year's. -- -- prop> 1 *~ decade === 10 *~ year -- -- >>> 1 *~ decade -- 3.15576e8 s -- -- >>> 1 *~ decade :: Time Rational -- 315576000 % 1 s decade :: Num a => Unit 'NonMetric DTime a decade = mkUnitZ (dimensionalAtom "d_j" "dec" "mean Julian decade") 10 $ year -- | One Julian century is one hundred Julian 'year's, or 35 525 'day's of 86 400 'second's each. -- -- prop> 1 *~ century === 100 *~ year -- -- prop> 1 *~ century === 36525 *~ day -- -- >>> 1 *~ century -- 3.15576e9 s -- -- >>> 1 *~ century :: Time Rational -- 3155760000 % 1 s century :: Num a => Unit 'NonMetric DTime a century = mkUnitZ (dimensionalAtom "c_j" "cen" "mean Julian century") 100 $ year -- | One Julian millennium is one thousand Julian 'year's. -- -- prop> 1 *~ millennium === 1000 *~ year -- -- >>> 1 *~ millennium -- 3.15576e10 s -- -- >>> 1 *~ millennium :: Time Rational -- 31557600000 % 1 s millennium :: Num a => Unit 'NonMetric DTime a millennium = mkUnitZ (dimensionalAtom "m_j" "mil" "mean Julian millennium") 1000 $ year {- $pressure-units It seems that nearly every area of application has its own customary unit for measuring pressure. We include some of the common ones here. 'psi' was defined earlier. -} -- | The bar is exactly 100 000 'Numeric.Units.Dimensional.SIUnits.pascal'. -- -- From Wikipedia: -- -- It is about equal to the atmospheric pressure on Earth at sea level. -- -- >>> 1 *~ bar -- 100000.0 m^-1 kg s^-2 -- -- >>> 1 *~ bar :: Pressure Rational -- 100000 % 1 m^-1 kg s^-2 bar :: (Num a) => Unit 'Metric DPressure a bar = mkUnitZ (ucumMetric "bar" "bar" "bar") 1e5 $ pascal -- | The "standard atmosphere". -- -- From Wikipedia <#note3 [3]>: -- -- The standard atmosphere (atm) is an established constant. It is -- approximately equal to typical air pressure at earth mean sea -- level. -- -- >>> 1 *~ atmosphere -- 101325.0 m^-1 kg s^-2 -- -- >>> 1 *~ atmosphere :: Pressure Rational -- 101325 % 1 m^-1 kg s^-2 atmosphere :: (Num a) => Unit 'NonMetric DPressure a atmosphere = mkUnitZ (ucum "atm" "atm" "standard atmosphere") 101325 $ pascal -- | The "technical atmosphere" -- -- From Wikipedia: -- -- A technical atmosphere (symbol: at) is a non-SI unit of pressure equal -- to one kilogram-force per square centimeter. -- -- >>> 1 *~ technicalAtmosphere -- 98066.5 m^-1 kg s^-2 -- -- >>> 1 *~ technicalAtmosphere :: Pressure Rational -- 196133 % 2 m^-1 kg s^-2 technicalAtmosphere :: (Fractional a) => Unit 'NonMetric DPressure a technicalAtmosphere = mkUnitQ (ucum "att" "at" "technical atmosphere") 1 $ kilo gram * gee * centi meter ^ neg2 -- | The conventional value for the pressure exerted by a 1 mm high column of mercury. -- -- Per Wikipedia <#note4 [4]>, one mmHg (millimeter of mercury) is defined as: -- -- The pressure exerted at the base of a column of fluid exactly 1 mm high, -- when the density of the fluid is exactly 13.5951 g/cm^3, at a place -- where the acceleration of gravity is exactly 9.80665 m/s^2. -- -- The chosen fluid density approximately corresponds to that of mercury -- at 0 deg. Under most conditions, 1 mmHg is approximately equal to 1 'torr'. -- -- >>> 1 *~ mmHg -- 133.322 m^-1 kg s^-2 -- -- >>> 1 *~ mmHg :: Pressure Rational -- 66661 % 500 m^-1 kg s^-2 mmHg :: (Fractional a) => Unit 'NonMetric DPressure a mmHg = milli mHg mHg :: (Fractional a) => Unit 'Metric DPressure a mHg = mkUnitQ (ucumMetric "m[Hg]" "m Hg" "meter of mercury") 133.3220 $ kilo pascal -- | The conventional value for the pressure exerted by a 1 inch high column of mercury. -- -- Column inches of mercury are also used to measure pressure, especially in -- meteorological or aeronautical contexts in the United States. -- -- This is the value defined by UCUM. For the value defined by NIST, see 'inHg_NIST'. -- -- >>> 1 *~ inHg -- 3386.3788 m^-1 kg s^-2 -- -- >>> 1 *~ inHg :: Pressure Rational -- 8465947 % 2500 m^-1 kg s^-2 inHg :: (Fractional a) => Unit 'NonMetric DPressure a inHg = inHg_UCUM -- | The conventional value for the pressure exerted by a 1 inch high column of mercury. -- -- Column inches of mercury are also used to measure pressure, especially in -- meteorological or aeronautical contexts in the United States. -- -- This is the value defined by UCUM. For the value defined by NIST, see 'inHg_NIST'. -- -- >>> 1 *~ inHg_UCUM -- 3386.3788 m^-1 kg s^-2 -- -- >>> 1 *~ inHg_UCUM :: Pressure Rational -- 8465947 % 2500 m^-1 kg s^-2 inHg_UCUM :: (Fractional a) => Unit 'NonMetric DPressure a inHg_UCUM = mkUnitQ (ucum "[in_i'Hg]" "in Hg" "inch of mercury") 1 $ mHg * inch / meter -- | The conventional value for the pressure exerted by a 1 inch high column of mercury. -- -- Column inches of mercury are also used to measure pressure, especially in -- meteorological or aeronautical contexts in the United States. -- -- This is the value defined by NIST. For the value defined by UCUM, see 'inHg_UCUM'. -- -- >>> 1 *~ inHg_NIST -- 3386.389 m^-1 kg s^-2 -- -- >>> 1 *~ inHg_NIST :: Pressure Rational -- 3386389 % 1000 m^-1 kg s^-2 inHg_NIST :: (Fractional a) => Unit 'NonMetric DPressure a inHg_NIST = mkUnitQ (dimensionalAtom "[in_i'Hg_NIST]" "in Hg" "inch of mercury") 3.386389e3 $ pascal -- | One torr (symbol: Torr) is defined as 1/760 'atmosphere', which is approximately equal to 1 'mmHg'. -- -- See for further information. -- -- >>> 1 *~ torr -- 133.32236842105263 m^-1 kg s^-2 -- -- >>> 1 *~ torr :: Pressure Rational -- 20265 % 152 m^-1 kg s^-2 torr :: (Fractional a) => Unit 'NonMetric DPressure a torr = mkUnitQ (dimensionalAtom "Torr" "Torr" "Torr") (1 Prelude./ 760) $ atmosphere -- | The rad is a deprecated unit of 'AbsorbedDose', defined as -- 0.01 'gray'. -- -- See for further information. -- -- >>> 1 *~ rad -- 1.0e-2 m^2 s^-2 -- -- >>> 1 *~ rad :: AbsorbedDose Rational -- 1 % 100 m^2 s^-2 rad :: (Fractional a) => Unit 'Metric DAbsorbedDose a rad = mkUnitQ (ucumMetric "RAD" "RAD" "RAD") 1 $ centi gray -- | One Stokes is a unit of 'KinematicViscosity' equal to @1 cm^2 / s@. -- -- See for further information. -- -- >>> 1 *~ stokes -- 1.0e-4 m^2 s^-1 -- -- >>> 1 *~ stokes :: KinematicViscosity Rational -- 1 % 10000 m^2 s^-1 stokes :: (Fractional a) => Unit 'Metric DKinematicViscosity a stokes = mkUnitQ (ucumMetric "St" "St" "Stokes") 1 $ centi meter ^ pos2 / second {- $temperature These units of temperature are relative. For absolute temperatures, see 'Numeric.Units.Dimensional.SIUnits.fromDegreeCelsiusAbsolute'. -} -- | One degree Fahrenheit is a unit of relative temperature equal to 5/9 'kelvin'. -- -- Note that although the Fahrenheit scale is an absolute temperature scale, this unit is a unit of difference within -- that scale and measures relative temperature. -- -- See for further information. -- -- >>> 1 *~ degreeFahrenheit -- 0.5555555555555556 K -- -- >>> 1 *~ degreeFahrenheit :: ThermodynamicTemperature Rational -- 5 % 9 K degreeFahrenheit :: (Fractional a) => Unit 'NonMetric DThermodynamicTemperature a degreeFahrenheit = mkUnitQ (ucum "[degF]" "°F" "degree Fahrenheit") (5 Prelude./ 9) $ degreeCelsius -- | One degree Rankine is a unit of relative temperature equal to 5/9 'kelvin'. -- -- Note that although the Rankine scale is an absolute temperature scale, this unit is a unit of difference within -- that scale and measures relative temperature. -- -- See for further information. -- -- >>> 1 *~ degreeRankine -- 0.5555555555555556 K -- -- >>> 1 *~ degreeRankine :: ThermodynamicTemperature Rational -- 5 % 9 K degreeRankine :: (Fractional a) => Unit 'NonMetric DThermodynamicTemperature a degreeRankine = mkUnitQ (ucum "[degR]" "°R" "degree Rankine") 1 $ degreeFahrenheit {- $imperial-volumes Per https://en.wikipedia.org/wiki/Imperial_units and https://en.wikipedia.org/wiki/Cup_(unit)#Imperial_cup. -} -- | One imperial gallon is defined exactly in terms of the 'liter' -- by the Weights and Measures Act 1985. -- -- See for further information. -- -- >>> 1 *~ imperialGallon -- 4.54609e-3 m^3 -- -- >>> 1 *~ imperialGallon :: Volume Rational -- 454609 % 100000000 m^3 imperialGallon :: (Fractional a) => Unit 'NonMetric DVolume a imperialGallon = mkUnitQ (ucum "[gal_br]" "gal" "gallon") 4.54609 $ liter -- | One imperial quart is one quarter of an 'imperialGallon'. -- -- See for further information. -- -- >>> 1 *~ imperialQuart -- 1.1365225e-3 m^3 -- -- >>> 1 *~ imperialQuart :: Volume Rational -- 454609 % 400000000 m^3 imperialQuart :: (Fractional a) => Unit 'NonMetric DVolume a imperialQuart = mkUnitQ (ucum "[qt_br]" "qt" "quart") (1 Prelude./ 4) $ imperialGallon -- | One imperial pint is one half of an 'imperialQuart'. -- -- See for further information. -- -- >>> 1 *~ imperialPint -- 5.6826125e-4 m^3 -- -- >>> 1 *~ imperialPint :: Volume Rational -- 454609 % 800000000 m^3 imperialPint :: (Fractional a) => Unit 'NonMetric DVolume a imperialPint = mkUnitQ (ucum "[pt_br]" "pt" "pint") (1 Prelude./ 8) $ imperialGallon -- | One imperial cup is one half of an 'imperialPint'. -- -- This unit is not in common use and is does not appear in some sources -- describing the imperial fluid volume units. -- -- See for further information. -- -- >>> 1 *~ imperialCup -- 2.84130625e-4 m^3 -- -- >>> 1 *~ imperialCup :: Volume Rational -- 454609 % 1600000000 m^3 imperialCup :: (Fractional a) => Unit 'NonMetric DVolume a imperialCup = mkUnitQ (dimensionalAtom "[cup_br]" "cup" "cup") 0.5 $ imperialPint -- | One imperial gill is one quarter of an 'imperialPint'. -- -- See for further information. -- -- >>> 1 *~ imperialGill -- 1.420653125e-4 m^3 -- -- >>> 1 *~ imperialGill :: Volume Rational -- 454609 % 3200000000 m^3 imperialGill :: (Fractional a) => Unit 'NonMetric DVolume a imperialGill = mkUnitQ (ucum "[gil_br]" "gill" "gill") (1 Prelude./ 4) $ imperialPint -- | One imperial fluid ounce is one twentieth of an 'imperialPint'. -- -- See for further information. -- -- >>> 1 *~ imperialFluidOunce -- 2.84130625e-5 m^3 -- -- >>> 1 *~ imperialFluidOunce :: Volume Rational -- 454609 % 16000000000 m^3 imperialFluidOunce :: (Fractional a) => Unit 'NonMetric DVolume a imperialFluidOunce = mkUnitQ (ucum "[foz_br]" "fl oz" "fluid ounce") (1 Prelude./ 20) $ imperialPint {- $us-customary-volumes Per https://www.nist.gov/system/files/documents/2017/05/09/2012-hb44-final.pdf page 452 and https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume Note that there exist rarely-used "dry" variants of units with overlapping names. -} -- | One US liquid gallon is a volume of 231 cubic inches. -- -- See for further information. -- -- >>> 1 *~ usGallon -- 3.785411784e-3 m^3 -- -- >>> 1 *~ usGallon :: Volume Rational -- 473176473 % 125000000000 m^3 usGallon :: (Fractional a) => Unit 'NonMetric DVolume a usGallon = mkUnitQ (ucum "[gal_us]" "gal" "gallon") 231 $ cubic inch -- | One US liquid quart is one quarter of a 'usGallon'. -- -- See for further information. -- -- >>> 1 *~ usQuart -- 9.46352946e-4 m^3 -- -- >>> 1 *~ usQuart :: Volume Rational -- 473176473 % 500000000000 m^3 usQuart :: (Fractional a) => Unit 'NonMetric DVolume a usQuart = mkUnitQ (ucum "[qt_us]" "qt" "quart") (1 Prelude./ 4) $ usGallon -- | One US liquid pint is one half of a 'usQuart'. -- -- See for further information. -- -- >>> 1 *~ usPint -- 4.73176473e-4 m^3 -- -- >>> 1 *~ usPint :: Volume Rational -- 473176473 % 1000000000000 m^3 usPint :: (Fractional a) => Unit 'NonMetric DVolume a usPint = mkUnitQ (ucum "[pt_us]" "pt" "pint") (1 Prelude./ 8) $ usGallon -- | One US liquid cup is one half of a 'usPint'. -- -- See for further information. -- -- >>> 1 *~ usCup -- 2.365882365e-4 m^3 -- -- >>> 1 *~ usCup :: Volume Rational -- 473176473 % 2000000000000 m^3 usCup :: (Fractional a) => Unit 'NonMetric DVolume a usCup = mkUnitQ (ucum "[cup_us]" "cup" "cup") (1 Prelude./ 2) $ usPint -- | One US liquid gill is one half of a 'usCup'. -- -- See for further information. -- -- >>> 1 *~ usGill -- 1.1829411825e-4 m^3 -- -- >>> 1 *~ usGill :: Volume Rational -- 473176473 % 4000000000000 m^3 usGill :: (Fractional a) => Unit 'NonMetric DVolume a usGill = mkUnitQ (ucum "[gil_us]" "gill" "gill") (1 Prelude./ 4) $ usPint -- | One US fluid ounce is 1/128 'usGallon' or 1/8 'usCup'. -- -- See for further information. -- -- >>> 1 *~ usFluidOunce -- 2.95735295625e-5 m^3 -- -- >>> 1 *~ usFluidOunce :: Volume Rational -- 473176473 % 16000000000000 m^3 usFluidOunce :: (Fractional a) => Unit 'NonMetric DVolume a usFluidOunce = mkUnitQ (ucum "[foz_us]" "fl oz" "fluid ounce") (1 Prelude./ 16) $ usPint -- sic, does not match factor used in imperial system -- | One Ångström is 1/10 'nano' 'meter'. -- -- See for further information. -- -- >>> 1 *~ angstrom -- 1.0e-10 m -- -- >>> 1 *~ angstrom :: Length Rational -- 1 % 10000000000 m angstrom :: (Fractional a) => Unit 'NonMetric DLength a angstrom = mkUnitQ (ucum "Ao" "Å" "Ångström") 0.1 $ nano meter -- | One Gauss is 1/10000 'tesla'. -- -- See for further information. -- -- >>> 1 *~ gauss -- 1.0e-4 kg s^-2 A^-1 -- -- >>> 1 *~ gauss :: MagneticFluxDensity Rational -- 1 % 10000 kg s^-2 A^-1 gauss :: (Fractional a) => Unit 'NonMetric DMagneticFluxDensity a gauss = mkUnitQ (ucum "G" "G" "Gauss") 1e-4 $ tesla dimensional-1.5/src/Numeric/Units/Dimensional/Prelude.hs0000644000000000000000000000302714244152645021551 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module supplies a convenient set of imports for working with the dimensional package, including aliases for common 'Quantity's and 'Dimension's, and a comprehensive set of SI units and units accepted for use with the SI. It re-exports the "Prelude", hiding arithmetic functions whose names collide with the dimensionally-typed versions supplied by this package. -} module Numeric.Units.Dimensional.Prelude ( module Numeric.Units.Dimensional , module Numeric.Units.Dimensional.Quantities , module Numeric.Units.Dimensional.SIUnits , module Numeric.NumType.DK.Integers , module Control.Category , module Data.Foldable , module Prelude ) where import Numeric.Units.Dimensional hiding ( dmap ) import Numeric.Units.Dimensional.Quantities import Numeric.Units.Dimensional.SIUnits import Numeric.NumType.DK.Integers ( neg5, neg4, neg3, neg2, neg1, zero, pos1, pos2, pos3, pos4, pos5 ) -- Used in exponents. import Control.Category ( Category(..) ) import Data.Foldable ( minimum, maximum ) import Prelude hiding ( (+), (-), (*), (/), (^), (**) , abs, signum, negate, recip, pi, exp, log, logBase, sqrt , sin, cos, tan, asin, acos, atan, atan2 , sinh, cosh, tanh, asinh, acosh, atanh , sum, product, minimum, maximum , id, (.) ) -- Hide definitions overridden by 'Numeric.Dimensional'. dimensional-1.5/src/Numeric/Units/Dimensional/Quantities.hs0000644000000000000000000004071614244166633022307 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE DataKinds #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module defines type synonyms for common dimensionalities and the associated quantity types. Additional dimensionalities and quantity types will be added on an as-needed basis. The definitions in this module are grouped so that a type synonym for the dimensionality is defined first in terms of base dimension exponents. Then a type synonym for the corresponding quantity type is defined. If there are several quantity types with the same dimensionality, type synonyms are provided for each quantity type. = References 1. #note1# https://www.nist.gov/pml/special-publication-811 -} module Numeric.Units.Dimensional.Quantities ( -- * Quantities from the NIST Guide -- $nist-guide Area, Volume, Velocity, Acceleration, WaveNumber, MassDensity, Density, SpecificVolume, CurrentDensity, MagneticFieldStrength, AmountOfSubstanceConcentration, Concentration, Luminance, -- $table3 PlaneAngle, SolidAngle, Frequency, Force, Pressure, Stress, Energy, Work, QuantityOfHeat, Power, RadiantFlux, ElectricCharge, QuantityOfElectricity, ElectricPotential, PotentialDifference, ElectromotiveForce, Capacitance, ElectricResistance, ElectricConductance, MagneticFlux, MagneticFluxDensity, Inductance, LuminousFlux, Illuminance, CelsiusTemperature, Activity, AbsorbedDose, SpecificEnergy, Kerma, DoseEquivalent, AmbientDoseEquivalent, DirectionalDoseEquivalent, PersonalDoseEquivalent, EquivalentDose, CatalyticActivity, -- $table4 AngularVelocity, AngularAcceleration, DynamicViscosity, MomentOfForce, SurfaceTension, HeatFluxDensity, Irradiance, RadiantIntensity, Radiance, HeatCapacity, Entropy, SpecificHeatCapacity, SpecificEntropy, ThermalConductivity, EnergyDensity, ElectricFieldStrength, ElectricChargeDensity, ElectricFluxDensity, Permittivity, Permeability, MolarEnergy, MolarEntropy, MolarHeatCapacity, Exposure, AbsorbedDoseRate, -- * Quantities not from the NIST Guide -- $not-nist-guide Impulse, Momentum, MassFlow, VolumeFlow, GravitationalParameter, KinematicViscosity, FirstMassMoment, MomentOfInertia, AngularMomentum, ThermalResistivity, ThermalConductance, ThermalResistance, HeatTransferCoefficient, ThermalAdmittance, ThermalInsulance, Jerk, Angle, Thrust, Torque, EnergyPerUnitMass, -- * Powers of Unit Lengths -- $powers-of-length-units square, cubic, -- * Dimension Aliases -- $dimension-aliases DArea, DVolume, DVelocity, DAcceleration, DWaveNumber, DMassDensity, DDensity, DSpecificVolume, DCurrentDensity, DMagneticFieldStrength, DAmountOfSubstanceConcentration, DConcentration, DLuminance, DPlaneAngle, DSolidAngle, DFrequency, DForce, DPressure, DStress, DEnergy, DWork, DQuantityOfHeat, DPower, DRadiantFlux, DElectricCharge, DQuantityOfElectricity, DElectricPotential, DPotentialDifference, DElectromotiveForce, DCapacitance, DElectricResistance, DElectricConductance, DMagneticFlux, DMagneticFluxDensity, DInductance, DLuminousFlux, DIlluminance, DCelsiusTemperature, DActivity, DAbsorbedDose, DSpecificEnergy, DKerma, DDoseEquivalent, DAmbientDoseEquivalent, DDirectionalDoseEquivalent, DPersonalDoseEquivalent, DEquivalentDose, DCatalyticActivity, DAngularVelocity, DAngularAcceleration, DDynamicViscosity, DMomentOfForce, DSurfaceTension, DHeatFluxDensity, DIrradiance, DRadiantIntensity, DRadiance, DHeatCapacity, DEntropy, DSpecificHeatCapacity, DSpecificEntropy, DThermalConductivity, DEnergyDensity, DElectricFieldStrength, DElectricChargeDensity, DElectricFluxDensity, DPermittivity, DPermeability, DMolarEnergy, DMolarEntropy, DMolarHeatCapacity, DExposure, DAbsorbedDoseRate, DImpulse, DMomentum, DMassFlow, DVolumeFlow, DGravitationalParameter, DKinematicViscosity, DFirstMassMoment, DMomentOfInertia, DAngularMomentum, DThermalResistivity, DThermalConductance, DThermalResistance, DHeatTransferCoefficient, DThermalAdmittance, DThermalInsulance, DJerk, DAngle, DThrust, DTorque, DEnergyPerUnitMass ) where import Numeric.Units.Dimensional ( Dimension (Dim), Quantity, Dimensionless , DOne, DLuminousIntensity, DThermodynamicTemperature , Unit, DLength, (^) -- Used only for 'square' and 'cubic'. , Metricality(..) ) import Numeric.NumType.DK.Integers ( TypeInt (Neg3, Neg2, Neg1, Zero, Pos1, Pos2, Pos3, Pos4) , pos2, pos3 -- Used only for 'square' and 'cubic'. ) import Prelude (Fractional) import Data.Typeable {- $nist-guide The following quantities are all from the NIST publication "Guide for the Use of the International System of Units (SI)" <#note1 [1]>. Any chapters, sections or tables referenced are from <#note1 [1]> unless otherwise specified. For lack of better organization we provide definitions grouped by table in <#note1 [1]>. == Table 2 "Examples of SI derived units expressed in terms of SI base units." -} {- $dimension-aliases For each 'Quantity' alias supplied above, we also supply a corresponding 'Dimension' alias. These dimension aliases may be convenient for supplying type signatures for 'Unit's or for other type-level dimensional programming. -} type DArea = 'Dim 'Pos2 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type Area = Quantity DArea type DVolume = 'Dim 'Pos3 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type Volume = Quantity DVolume type DVelocity = 'Dim 'Pos1 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type Velocity = Quantity DVelocity type DAcceleration = 'Dim 'Pos1 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type Acceleration = Quantity DAcceleration type DWaveNumber = 'Dim 'Neg1 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type WaveNumber = Quantity DWaveNumber type DMassDensity = 'Dim 'Neg3 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type DDensity = DMassDensity type MassDensity = Quantity DMassDensity type Density = MassDensity -- Short name. type DSpecificVolume = 'Dim 'Pos3 'Neg1 'Zero 'Zero 'Zero 'Zero 'Zero type SpecificVolume = Quantity DSpecificVolume type DCurrentDensity = 'Dim 'Neg2 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero type CurrentDensity = Quantity DCurrentDensity type DMagneticFieldStrength = 'Dim 'Neg1 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero type MagneticFieldStrength = Quantity DMagneticFieldStrength type DAmountOfSubstanceConcentration = 'Dim 'Neg3 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero type DConcentration = DAmountOfSubstanceConcentration type AmountOfSubstanceConcentration = Quantity DAmountOfSubstanceConcentration type Concentration = AmountOfSubstanceConcentration -- Short name. type DLuminance = 'Dim 'Neg2 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 type Luminance = Quantity DLuminance {- $table3 == Table 3 SI coherent derived units with special names and symbols. -} type DPlaneAngle = DOne type PlaneAngle = Dimensionless type DSolidAngle = DOne type SolidAngle = Dimensionless type DFrequency = 'Dim 'Zero 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type Frequency = Quantity DFrequency type DForce = 'Dim 'Pos1 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type Force = Quantity DForce type DPressure = 'Dim 'Neg1 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type DStress = DPressure type Pressure = Quantity DPressure type Stress = Quantity DStress type DEnergy = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type DWork = DEnergy type DQuantityOfHeat = DEnergy type Energy = Quantity DEnergy type Work = Quantity DWork type QuantityOfHeat = Quantity DQuantityOfHeat type DPower = 'Dim 'Pos2 'Pos1 'Neg3 'Zero 'Zero 'Zero 'Zero type DRadiantFlux = DPower type Power = Quantity DPower type RadiantFlux = Quantity DRadiantFlux type DElectricCharge = 'Dim 'Zero 'Zero 'Pos1 'Pos1 'Zero 'Zero 'Zero type DQuantityOfElectricity = DElectricCharge type ElectricCharge = Quantity DElectricCharge type QuantityOfElectricity = Quantity DQuantityOfElectricity type DElectricPotential = 'Dim 'Pos2 'Pos1 'Neg3 'Neg1 'Zero 'Zero 'Zero type DPotentialDifference = DElectricPotential type DElectromotiveForce = DElectricPotential type ElectricPotential = Quantity DElectricPotential type PotentialDifference = Quantity DPotentialDifference type ElectromotiveForce = Quantity DElectromotiveForce type DCapacitance = 'Dim 'Neg2 'Neg1 'Pos4 'Pos2 'Zero 'Zero 'Zero type Capacitance = Quantity DCapacitance type DElectricResistance = 'Dim 'Pos2 'Pos1 'Neg3 'Neg2 'Zero 'Zero 'Zero type ElectricResistance = Quantity DElectricResistance type DElectricConductance = 'Dim 'Neg2 'Neg1 'Pos3 'Pos2 'Zero 'Zero 'Zero type ElectricConductance = Quantity DElectricConductance type DMagneticFlux = 'Dim 'Pos2 'Pos1 'Neg2 'Neg1 'Zero 'Zero 'Zero type MagneticFlux = Quantity DMagneticFlux type DMagneticFluxDensity = 'Dim 'Zero 'Pos1 'Neg2 'Neg1 'Zero 'Zero 'Zero type MagneticFluxDensity = Quantity DMagneticFluxDensity type DInductance = 'Dim 'Pos2 'Pos1 'Neg2 'Neg2 'Zero 'Zero 'Zero type Inductance = Quantity DInductance type DLuminousFlux = DLuminousIntensity type LuminousFlux = Quantity DLuminousFlux type DIlluminance = 'Dim 'Neg2 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 type Illuminance = Quantity DIlluminance type DCelsiusTemperature = DThermodynamicTemperature type CelsiusTemperature = Quantity DCelsiusTemperature type DActivity = DFrequency -- Activity of a radionuclide. type Activity = Quantity DActivity type DAbsorbedDose = 'Dim 'Pos2 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type DSpecificEnergy = DAbsorbedDose type DKerma = DAbsorbedDose type AbsorbedDose = Quantity DAbsorbedDose type SpecificEnergy = Quantity DSpecificEnergy -- Specific energy imparted. type Kerma = Quantity DKerma type DDoseEquivalent = DAbsorbedDose type DAmbientDoseEquivalent = DDoseEquivalent type DDirectionalDoseEquivalent = DDoseEquivalent type DPersonalDoseEquivalent = DDoseEquivalent type DEquivalentDose = DDoseEquivalent type DoseEquivalent = Quantity DDoseEquivalent type AmbientDoseEquivalent = DoseEquivalent type DirectionalDoseEquivalent = DoseEquivalent type PersonalDoseEquivalent = DoseEquivalent type EquivalentDose = DoseEquivalent type DCatalyticActivity = 'Dim 'Zero 'Zero 'Neg1 'Zero 'Zero 'Pos1 'Zero type CatalyticActivity = Quantity DCatalyticActivity {- $table4 == Table 4 "Examples of SI coherent derived units expressed with the aid of SI derived units having special names and symbols." We use the same grouping as for table 2. -} type DAngularVelocity = DFrequency type AngularVelocity = Quantity DAngularVelocity type DAngularAcceleration = 'Dim 'Zero 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type AngularAcceleration = Quantity DAngularAcceleration type DDynamicViscosity = 'Dim 'Neg1 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type DynamicViscosity = Quantity DDynamicViscosity type DMomentOfForce = DEnergy type MomentOfForce = Quantity DMomentOfForce type DSurfaceTension = 'Dim 'Zero 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type SurfaceTension = Quantity DSurfaceTension type DHeatFluxDensity = 'Dim 'Zero 'Pos1 'Neg3 'Zero 'Zero 'Zero 'Zero type DIrradiance = DHeatFluxDensity type HeatFluxDensity = Quantity DHeatFluxDensity type Irradiance = Quantity DIrradiance type DRadiantIntensity = DPower type RadiantIntensity = Quantity DRadiantIntensity type DRadiance = DIrradiance type Radiance = Quantity DRadiance type DHeatCapacity = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Neg1 'Zero 'Zero type DEntropy = DHeatCapacity type HeatCapacity = Quantity DHeatCapacity type Entropy = Quantity DEntropy type DSpecificHeatCapacity = 'Dim 'Pos2 'Zero 'Neg2 'Zero 'Neg1 'Zero 'Zero type DSpecificEntropy = DSpecificHeatCapacity type SpecificHeatCapacity = Quantity DSpecificHeatCapacity type SpecificEntropy = Quantity DSpecificEntropy {- Specific energy was already defined in table 3. -} type DThermalConductivity = 'Dim 'Pos1 'Pos1 'Neg3 'Zero 'Neg1 'Zero 'Zero type ThermalConductivity = Quantity DThermalConductivity type DEnergyDensity = DPressure type EnergyDensity = Quantity DEnergyDensity type DElectricFieldStrength = 'Dim 'Pos1 'Pos1 'Neg3 'Neg1 'Zero 'Zero 'Zero type ElectricFieldStrength = Quantity DElectricFieldStrength type DElectricChargeDensity = 'Dim 'Neg3 'Zero 'Pos1 'Pos1 'Zero 'Zero 'Zero type ElectricChargeDensity = Quantity DElectricChargeDensity type DElectricFluxDensity = 'Dim 'Neg2 'Zero 'Pos1 'Pos1 'Zero 'Zero 'Zero type ElectricFluxDensity = Quantity DElectricFluxDensity type DPermittivity = 'Dim 'Neg3 'Neg1 'Pos4 'Pos2 'Zero 'Zero 'Zero type Permittivity = Quantity DPermittivity type DPermeability = 'Dim 'Pos1 'Pos1 'Neg2 'Neg2 'Zero 'Zero 'Zero type Permeability = Quantity DPermeability type DMolarEnergy = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Zero 'Neg1 'Zero type MolarEnergy = Quantity DMolarEnergy type DMolarEntropy = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Neg1 'Neg1 'Zero type DMolarHeatCapacity = DMolarEntropy type MolarEntropy = Quantity DMolarEntropy type MolarHeatCapacity = Quantity DMolarHeatCapacity type DExposure = 'Dim 'Zero 'Neg1 'Pos1 'Pos1 'Zero 'Zero 'Zero type Exposure = Quantity DExposure -- Exposure to x and gamma rays. type DAbsorbedDoseRate = 'Dim 'Pos2 'Zero 'Neg3 'Zero 'Zero 'Zero 'Zero type AbsorbedDoseRate = Quantity DAbsorbedDoseRate {- $not-nist-guide Here we define additional quantities on an as-needed basis. We also provide some synonyms that we anticipate will be useful. -} type DImpulse = 'Dim 'Pos1 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type Impulse = Quantity DImpulse type DMomentum = DImpulse type Momentum = Quantity DMomentum type DMassFlow = 'Dim 'Zero 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type MassFlow = Quantity DMassFlow type DVolumeFlow = 'Dim 'Pos3 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type VolumeFlow = Quantity DVolumeFlow type DGravitationalParameter = 'Dim 'Pos3 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type GravitationalParameter = Quantity DGravitationalParameter type DKinematicViscosity = 'Dim 'Pos2 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type KinematicViscosity = Quantity DKinematicViscosity type DFirstMassMoment = 'Dim 'Pos1 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type FirstMassMoment = Quantity DFirstMassMoment type DMomentOfInertia = 'Dim 'Pos2 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type MomentOfInertia = Quantity DMomentOfInertia type DAngularMomentum = 'Dim 'Pos2 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type AngularMomentum = Quantity DAngularMomentum {- The reciprocal of thermal conductivity. -} type DThermalResistivity = 'Dim 'Neg1 'Neg1 'Pos3 'Zero 'Pos1 'Zero 'Zero type ThermalResistivity = Quantity DThermalResistivity {- Thermal conductance and resistance quantities after https://en.wikipedia.org/wiki/Thermal_conductivity#Definitions. -} type DThermalConductance = 'Dim 'Pos2 'Pos1 'Neg3 'Zero 'Neg1 'Zero 'Zero type ThermalConductance = Quantity DThermalConductance type DThermalResistance = 'Dim 'Neg2 'Neg1 'Pos3 'Zero 'Pos1 'Zero 'Zero type ThermalResistance = Quantity DThermalResistance type DHeatTransferCoefficient = 'Dim 'Zero 'Pos1 'Neg3 'Zero 'Neg1 'Zero 'Zero type HeatTransferCoefficient = Quantity DHeatTransferCoefficient type DThermalAdmittance = DHeatTransferCoefficient type ThermalAdmittance = HeatTransferCoefficient type DThermalInsulance = 'Dim 'Zero 'Neg1 'Pos3 'Zero 'Pos1 'Zero 'Zero type ThermalInsulance = Quantity DThermalInsulance type DJerk = 'Dim 'Pos1 'Zero 'Neg3 'Zero 'Zero 'Zero 'Zero type Jerk = Quantity DJerk type Angle = PlaneAngle -- Abbreviation type DAngle = DPlaneAngle -- Abbreviation type Thrust = Force type DThrust = DForce type Torque = MomentOfForce type DTorque = DMomentOfForce type EnergyPerUnitMass = SpecificEnergy type DEnergyPerUnitMass = DSpecificEnergy {- $powers-of-length-units It is permissible to express powers of length units by prefixing 'square' and 'cubic' (see section 9.6 "Spelling unit names raised to powers" of <#note1 [1]>). These definitions may seem slightly out of place but these is no obvious place where they should be. Here they are at least close to the definitions of 'DArea' and 'DVolume'. -} -- $setup -- >>> import Numeric.Units.Dimensional.Prelude -- | Constructs a unit of area from a unit of length, taking the area of a square whose sides are that length. -- -- >>> 64 *~ square meter == (8 *~ meter) ^ pos2 -- True square :: (Fractional a, Typeable m) => Unit m DLength a -> Unit 'NonMetric DArea a square x = x ^ pos2 -- | Constructs a unit of volume from a unit of length, taking the volume of a cube whose sides are that length. -- -- >>> 64 *~ cubic meter == (4 *~ meter) ^ pos3 -- True cubic :: (Fractional a, Typeable m) => Unit m DLength a -> Unit 'NonMetric DVolume a cubic x = x ^ pos3 dimensional-1.5/src/Numeric/Units/Dimensional/SIUnits.hs0000644000000000000000000003110514254541015021477 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module defines the SI prefixes, the SI base units and the SI derived units. It also defines the units outside of the SI that are accepted for use with the SI. Any chapters, sections or tables referenced are from <#note1 [1]> unless otherwise specified. = References 1. #note1# https://www.nist.gov/pml/special-publication-811 2. #note2# https://en.wikipedia.org/wiki/Minute_of_arc 3. #note3# https://en.wikipedia.org/wiki/Astronomical_unit -} module Numeric.Units.Dimensional.SIUnits ( -- * SI Base Units -- $base-units metre, meter, gram, second, ampere, kelvin, mole, candela, -- * SI Derived Units -- $derived-units radian, steradian, hertz, newton, pascal, joule, watt, coulomb, volt, farad, ohm, siemens, weber, tesla, henry, lumen, lux, -- ** Celsius Temperature -- $celsius degreeCelsius, fromDegreeCelsiusAbsolute, toDegreeCelsiusAbsolute, -- ** Units Admitted for Reasons of Safeguarding Human Health -- $health becquerel, gray, sievert, katal, -- * Units Accepted for Use with the SI -- $accepted-units minute, hour, day, hectare, litre, liter, tonne, metricTon, -- ** Units of Plane Angle -- $arc-units degree, arcminute, arcsecond, -- $arc-units-alternate degreeOfArc, minuteOfArc, secondOfArc, -- ** Units Formerly Defined By Experiment -- $values-obtained-experimentally astronomicalUnit, -- * SI Prefixes -- $multiples deka, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta, -- $submultiples deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto, -- $reified-prefixes Prefix, applyPrefix, siPrefixes ) where import Data.Ratio import Numeric.Units.Dimensional import Numeric.Units.Dimensional.Quantities import Numeric.Units.Dimensional.UnitNames (Prefix, siPrefixes) import qualified Numeric.Units.Dimensional.UnitNames as N import Numeric.Units.Dimensional.UnitNames.Internal (ucum, ucumMetric) import qualified Numeric.Units.Dimensional.UnitNames.Internal as I import Numeric.NumType.DK.Integers ( pos3 ) import Prelude ( Eq(..), ($), Num, Fractional, Floating, otherwise, error) import qualified Prelude {- $multiples Prefixes are used to form decimal multiples and submultiples of SI Units as described in section 4.4. By defining SI prefixes as functions applied to a 'Unit' we satisfy section 6.2.6 "Unacceptability of stand-alone prefixes". We define all SI prefixes from Table 5. Multiples first. -} applyMultiple :: (Num a) => Prefix -> Unit 'Metric d a -> Unit 'NonMetric d a applyMultiple p u | denominator x == 1 = mkUnitZ n' (numerator x) u | otherwise = error "Attempt to apply a submultiple prefix as a multiple." where n' = N.applyPrefix p (name u) x = N.scaleFactor p deca, deka, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta :: Num a => Unit 'Metric d a -> Unit 'NonMetric d a -- | The "deca" prefix, denoting a factor of 10. deca = applyMultiple I.deca -- International English. -- | An alias for 'deca'. deka = deca -- American English. -- | The "hecto" prefix, denoting a factor of 100. hecto = applyMultiple I.hecto -- | The "kilo" prefix, denoting a factor of 1000. kilo = applyMultiple I.kilo -- | The "mega" prefix, denoting a factor of 10^6. mega = applyMultiple I.mega -- | The "giga" prefix, denoting a factor of 10^9. giga = applyMultiple I.giga -- | The "tera" prefix, denoting a factor of 10^12. tera = applyMultiple I.tera -- | The "peta" prefix, denoting a factor of 10^15. peta = applyMultiple I.peta -- | The "exa" prefix, denoting a factor of 10^18. exa = applyMultiple I.exa -- | The "zetta" prefix, denoting a factor of 10^21. zetta = applyMultiple I.zetta -- | The "yotta" prefix, denoting a factor of 10^24. yotta = applyMultiple I.yotta {- $submultiples Then the submultiples. -} -- | Apply a 'Prefix' to a metric 'Unit'. applyPrefix :: (Fractional a) => Prefix -> Unit 'Metric d a -> Unit 'NonMetric d a applyPrefix p u = mkUnitQ n' x u where n' = N.applyPrefix p (name u) x = N.scaleFactor p deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto :: Fractional a => Unit 'Metric d a -> Unit 'NonMetric d a -- | The "deci" prefix, denoting a factor of 0.1. deci = applyPrefix I.deci -- | The "centi" prefix, denoting a factor of 0.01. centi = applyPrefix I.centi -- | The "milli" prefix, denoting a factor of 0.001. milli = applyPrefix I.milli -- | The "micro" prefix, denoting a factor of 10^-6. micro = applyPrefix I.micro -- | The "nano" prefix, denoting a factor of 10^-9. nano = applyPrefix I.nano -- | The "pico" prefix, denoting a factor of 10^-12. pico = applyPrefix I.pico -- | The "femto" prefix, denoting a factor of 10^-15. femto = applyPrefix I.femto -- | The "atto" prefix, denoting a factor of 10^-18. atto = applyPrefix I.atto -- | The "zepto" prefix, denoting a factor of 10^-21. zepto = applyPrefix I.zepto -- | The "yocto" prefix, denoting a factor of 10^-24. yocto = applyPrefix I.yocto {- $reified-prefixes We supply an explicit representation of an SI prefix, along with a function to apply one and a list of all prefixes defined by the SI. -} {- $base-units These are the base units from section 4.1. To avoid a myriad of one-letter functions that would doubtlessly cause clashes and frustration in users' code, we spell out all unit names in full, as we did for prefixes. We also elect to spell the unit names in singular form, as allowed by section 9.7 "Other spelling conventions". We define the SI base units in the order of table 1. -} metre, meter :: Num a => Unit 'Metric DLength a metre = mkUnitZ I.nMeter 1 siUnit -- International English. meter = metre -- American English. {- For mass the SI base unit is kilogram. For sensible prefixes we define gram here (see section 6.2.7 "Prefixes and the kilogram"). The drawback is that we are forced to use 'Fractional'. -} gram :: Fractional a => Unit 'Metric DMass a gram = mkUnitQ I.nGram 1e-3 siUnit second :: Num a => Unit 'Metric DTime a second = mkUnitZ I.nSecond 1 siUnit ampere :: Num a => Unit 'Metric DElectricCurrent a ampere = mkUnitZ I.nAmpere 1 siUnit kelvin :: Num a => Unit 'Metric DThermodynamicTemperature a kelvin = mkUnitZ I.nKelvin 1 siUnit mole :: Num a => Unit 'Metric DAmountOfSubstance a mole = mkUnitZ I.nMole 1 siUnit candela :: Num a => Unit 'Metric DLuminousIntensity a candela = mkUnitZ I.nCandela 1 siUnit {- $derived-units From Table 3, SI derived units with special names and symbols, including the radian and steradian. -} radian :: Num a => Unit 'Metric DPlaneAngle a radian = mkUnitZ (ucumMetric "rad" "rad" "radian") 1 siUnit -- meter * meter ^ neg1 steradian :: Num a => Unit 'Metric DSolidAngle a steradian = mkUnitZ (ucumMetric "sr" "sr" "steradian") 1 siUnit -- meter ^ pos2 * meter ^ neg2 hertz :: Num a => Unit 'Metric DFrequency a hertz = mkUnitZ (ucumMetric "Hz" "Hz" "Hertz") 1 $ siUnit newton :: Num a => Unit 'Metric DForce a newton = mkUnitZ (ucumMetric "N" "N" "Newton") 1 $ siUnit pascal :: Num a => Unit 'Metric DPressure a pascal = mkUnitZ (ucumMetric "Pa" "Pa" "Pascal") 1 $ siUnit joule :: Num a => Unit 'Metric DEnergy a joule = mkUnitZ (ucumMetric "J" "J" "Joule") 1 $ siUnit watt :: Num a => Unit 'Metric DPower a watt = mkUnitZ (ucumMetric "W" "W" "Watt") 1 $ siUnit coulomb :: Num a => Unit 'Metric DElectricCharge a coulomb = mkUnitZ (ucumMetric "C" "C" "Coulomb") 1 $ siUnit volt :: Num a => Unit 'Metric DElectricPotential a volt = mkUnitZ (ucumMetric "V" "V" "Volt") 1 $ siUnit farad :: Num a => Unit 'Metric DCapacitance a farad = mkUnitZ (ucumMetric "F" "F" "Farad") 1 $ siUnit ohm :: Num a => Unit 'Metric DElectricResistance a ohm = mkUnitZ (ucumMetric "Ohm" "Ω" "Ohm") 1 $ siUnit siemens :: Num a => Unit 'Metric DElectricConductance a siemens = mkUnitZ (ucumMetric "S" "S" "Siemens") 1 $ siUnit weber :: Num a => Unit 'Metric DMagneticFlux a weber = mkUnitZ (ucumMetric "Wb" "Wb" "Weber") 1 $ siUnit tesla :: Num a => Unit 'Metric DMagneticFluxDensity a tesla = mkUnitZ (ucumMetric "T" "T" "Tesla") 1 $ siUnit henry :: Num a => Unit 'Metric DInductance a henry = mkUnitZ (ucumMetric "H" "H" "Henry") 1 $ siUnit {- We defer the definition of Celcius temperature to another section (would appear here if we stricly followed table 3). -} lumen :: Num a => Unit 'Metric DLuminousFlux a lumen = mkUnitZ (ucumMetric "lm" "lm" "lumen") 1 $ siUnit lux :: Num a => Unit 'Metric DIlluminance a lux = mkUnitZ (ucumMetric "lx" "lx" "lux") 1 $ siUnit {- $celsius A problematic area is units which increase proportionally to the base SI units but cross zero at a different point. An example would be degrees Celsius (see section 4.2.1.1). The author feels that it is appropriate to define a unit for use with relative quantities (taking only into account the proportionality) and complement the unit with functions for converting absolute values. The function 'fromDegreeCelsiusAbsolute' should be used in lieu of "*~ degreeCelsius" when working with absolute temperatures. Similarily, 'toDegreeCelsiusAbsolute' should be used in lieu of "/~ degreeCelsius" when working with absolute temperatures. -} degreeCelsius :: Num a => Unit 'Metric DCelsiusTemperature a degreeCelsius = kelvin fromDegreeCelsiusAbsolute :: Floating a => a -> ThermodynamicTemperature a fromDegreeCelsiusAbsolute x = x *~ degreeCelsius + 273.15 *~ degreeCelsius toDegreeCelsiusAbsolute :: Floating a => ThermodynamicTemperature a -> a toDegreeCelsiusAbsolute x = (x - 273.15 *~ degreeCelsius) /~ degreeCelsius {- $health The last units from Table 3 are SI derived units with special names and symbols admitted for reasons of safeguarding human health. -} becquerel :: Num a => Unit 'Metric DActivity a becquerel = mkUnitZ (ucumMetric "Bq" "Bq" "Becquerel") 1 $ siUnit gray :: Num a => Unit 'Metric DAbsorbedDose a gray = mkUnitZ (ucumMetric "Gy" "Gy" "Gray") 1 $ siUnit sievert :: Num a => Unit 'Metric DDoseEquivalent a sievert = mkUnitZ (ucumMetric "Sv" "Sv" "Sievert") 1 $ siUnit katal :: Num a => Unit 'Metric DCatalyticActivity a katal = mkUnitZ (ucumMetric "kat" "kat" "katal") 1 $ siUnit {- $accepted-units There are several units that are not strictly part of the SI but are either permanently or temporarily accepted for use with the SI. We define the permanently accepted ones in this module. From Table 6, Units accepted for use with the SI. We start with time which we grant exclusive rights to 'minute' and 'second'. -} minute, hour, day :: Num a => Unit 'NonMetric DTime a minute = mkUnitZ (ucum "min" "min" "minute") 60 $ second hour = mkUnitZ (ucum "h" "h" "hour") 60 $ minute day = mkUnitZ (ucum "d" "d" "day") 24 $ hour -- Mean solar day. {- $arc-units Since 'minute' and 'second' are already in use for time we use 'arcminute' and 'arcsecond' <#note2 [2]> for plane angle instead. -} degree, arcminute, arcsecond :: Floating a => Unit 'NonMetric DPlaneAngle a degree = mkUnitR (ucum "deg" "°" "degree") (Prelude.pi Prelude./ 180) $ radian arcminute = mkUnitR (ucum "'" "'" "arcminute") (Prelude.recip 60) $ degreeOfArc arcsecond = mkUnitR (ucum "''" "''" "arcsecond") (Prelude.recip 60) $ minuteOfArc {- $arc-units-alternate Alternate (longer) forms of the above. In particular 'degreeOfArc' can be used if there is a percieved need to disambiguate from e.g. temperature. -} degreeOfArc, minuteOfArc, secondOfArc :: Floating a => Unit 'NonMetric DPlaneAngle a degreeOfArc = degree secondOfArc = arcsecond minuteOfArc = arcminute hectare :: Fractional a => Unit 'NonMetric DArea a hectare = square (hecto meter) litre, liter :: Fractional a => Unit 'Metric DVolume a litre = mkUnitQ (ucumMetric "L" "L" "litre") 1 $ deci meter ^ pos3 -- International English. liter = litre -- American English. tonne, metricTon :: Num a => Unit 'Metric DMass a tonne = mkUnitZ (ucumMetric "t" "t" "tonne") 1000 $ siUnit -- Name in original SI text. metricTon = tonne -- American name. {- $values-obtained-experimentally We decline to provide here those units - listed in Table 7 - which, while accepted for use with the SI, have values which are determined experimentally. For versioning purposes, those units can be found in "Numeric.Units.Dimensional.NonSI". However, in 2012 the IAU redefined the astronomical unit as a conventional unit of length directly tied to the meter, with a length of exactly 149 597 870 700 m and the official abbreviation of au <#note3 [3]>. We therefore include it here. -} astronomicalUnit :: Num a => Unit 'NonMetric DLength a astronomicalUnit = mkUnitZ (ucum "au" "au" "astronomical unit") 149597870700 $ meter dimensional-1.5/src/Numeric/Units/Dimensional/UnitNames.hs0000644000000000000000000000217214244152645022054 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only This module provides types and functions for manipulating unit names. Please note that the details of the name representation may be less stable than the other APIs provided by this package, as new features using them are still being developed. -} module Numeric.Units.Dimensional.UnitNames ( -- * Data Types UnitName, NameAtom, Prefix, PrefixName, Metricality(..), -- * Construction of Unit Names atom, applyPrefix, (*), (/), (^), product, reduce, grouped, -- * Standard Names baseUnitName, siPrefixes, nOne, -- * Inspecting Prefixes prefixName, scaleFactor, -- * Convenience Type Synonyms for Unit Name Transformations UnitNameTransformer, UnitNameTransformer2, -- * Forgetting Unwanted Phantom Types weaken, strengthen, relax, name_en, abbreviation_en, asAtomic ) where import Numeric.Units.Dimensional.UnitNames.Internal import Numeric.Units.Dimensional.Variants import Prelude hiding ((*), (/), (^), product) dimensional-1.5/src/Numeric/Units/Dimensional/UnitNames/InterchangeNames.hs0000644000000000000000000000322414244152645025266 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Numeric.Units.Dimensional.UnitNames.InterchangeNames ( InterchangeNameAuthority(..), InterchangeName(..), HasInterchangeName(..) ) where import Control.DeepSeq import Data.Data import GHC.Generics import Prelude -- | Represents the authority which issued an interchange name for a unit. data InterchangeNameAuthority = UCUM -- ^ The interchange name originated with the Unified Code for Units of Measure. | DimensionalLibrary -- ^ The interchange name originated with the dimensional library. | Custom -- ^ The interchange name originated with a user of the dimensional library. deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData InterchangeNameAuthority where -- instance is derived from Generic instance data InterchangeName = InterchangeName { name :: String, authority :: InterchangeNameAuthority, isAtomic :: Bool } deriving (Eq, Ord, Data, Typeable, Generic) instance NFData InterchangeName where -- instance is derived from Generic instance instance Show InterchangeName where show n = name n ++ " (Issued by " ++ show (authority n) ++ ")" -- | Determines the authority which issued the interchange name of a unit or unit name. -- For composite units, this is the least-authoritative interchange name of any constituent name. -- -- Note that the least-authoritative authority is the one sorted as greatest by the 'Ord' instance of 'InterchangeNameAuthority'. class HasInterchangeName a where interchangeName :: a -> InterchangeName instance HasInterchangeName InterchangeName where interchangeName = id dimensional-1.5/src/Numeric/Units/Dimensional/Variants.hs0000644000000000000000000000637614244166633021754 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home, show-extensions #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only Provides a type level representation of 'Variant's of dimensional values, which may be quantities or units. -} module Numeric.Units.Dimensional.Variants ( type Variant(..), Metricality(..), type (*), type (/), type Weaken, type CompatibleVariants ) where import Control.DeepSeq import Data.Data import qualified Data.ExactPi.TypeLevel as E import GHC.Generics import Prelude -- | Encodes whether a unit is a metric unit, that is, whether it can be combined -- with a metric prefix to form a related unit. data Metricality = Metric -- ^ Capable of receiving a metric prefix. | NonMetric -- ^ Incapable of receiving a metric prefix. deriving (Eq, Ord, Data, Typeable, Generic) instance NFData Metricality where -- instance is derived from Generic instance {- The variety 'v' of 'Dimensional' The phantom type variable v is used to distinguish between units and quantities. It must be one of the following: -} -- | The kind of variants of dimensional values. data Variant = DQuantity E.ExactPi' -- ^ The value is a quantity, stored as an `ExactPi` multiple of its value in its dimension's SI coherent unit. | DUnit Metricality -- ^ The value is a unit, possibly a 'Metric' unit. deriving (Typeable, Generic) {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixl 7 * -- | Forms the product of two 'Variant's. -- -- The product of units is a non-metric unit. -- -- The product of quantities is a quantity. type family (v1 :: Variant) * (v2 :: Variant) :: Variant where 'DUnit m1 * 'DUnit m2 = 'DUnit 'NonMetric 'DQuantity s1 * 'DQuantity s2 = 'DQuantity (s1 E.* s2) -- | Forms the quotient of two 'Variant's. -- -- The quotient of units is a non-metric unit. -- -- The quotient of quantities is a quantity. type family (v1 :: Variant) / (v2 :: Variant) :: Variant where 'DUnit m1 / 'DUnit m2 = 'DUnit 'NonMetric 'DQuantity s1 / 'DQuantity s2 = 'DQuantity (s1 E./ s2) -- | Weakens a 'Variant' by forgetting possibly uninteresting type-level information. type family Weaken (v :: Variant) :: Variant where Weaken ('DQuantity s) = 'DQuantity s Weaken ('DUnit m) = 'DUnit 'NonMetric -- | Two 'Variant's are compatible when dimensional values of the first may be converted -- into the second merely by changing the representation of their values. type family AreCompatible (v1 :: Variant) (v2 :: Variant) :: Bool where AreCompatible ('DQuantity s1) ('DQuantity s2) = 'True AreCompatible ('DUnit m) ('DUnit 'NonMetric) = 'True AreCompatible s s = 'True AreCompatible s1 s2 = 'False -- | Two 'Variant's are compatible when dimensional values of the first may be converted -- into the second merely by changing the representation of their values. type CompatibleVariants v1 v2 = ('True ~ AreCompatible v1 v2) dimensional-1.5/src/Numeric/Units/Dimensional/Float.hs0000644000000000000000000001427114247602315021216 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2018 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Defines convenience functions for inspecting and manipulating quantities with 'RealFloat' floating-point representations. The dimensionally-typed versions of functions from Patrick Perry's [ieee754](https://hackage.haskell.org/package/ieee754) package copy that packages API as closely as possible, by permission. In turn they are based on the @tango@ math library for the D language. -} {-# LANGUAGE ScopedTypeVariables #-} module Numeric.Units.Dimensional.Float ( -- * Lifted Predicates from 'RealFloat' isDenormalized, isInfinite, isNaN, isNegativeZero -- * Convenience Functions , isFiniteNumber, scaleFloat -- * Lifted Functions from "Numeric.IEEE" -- ** Values , infinity, minNormal, maxFinite, epsilon, nan -- ** Arithmetic , predIEEE, succIEEE, bisectIEEE, copySign -- ** NaN with Payload , nanWithPayload, nanPayload, F.maxNaNPayload -- ** Comparisons , identicalIEEE, minNum, maxNum, minNaN, maxNaN ) where import Control.Applicative import Data.Word (Word64) import Prelude (RealFloat) import qualified Prelude as P import Numeric.IEEE (IEEE) import qualified Numeric.IEEE as F import Numeric.Units.Dimensional.Internal (liftQ, liftQ2) import Numeric.Units.Dimensional.Prelude hiding (RealFloat(..)) import Numeric.Units.Dimensional.Coercion -- $setup -- >>> :set -XExtendedDefaultRules -- >>> :set -XNegativeLiterals -- | 'True' if the representation of the argument is too small to be represented in normalized format. isDenormalized :: RealFloat a => Quantity d a -> Bool isDenormalized = P.isDenormalized . unQuantity -- | 'True' if the representation of the argument is a number and is not infinite. -- -- >>> isFiniteNumber (_1 / _0) -- False -- -- >>> isFiniteNumber (_0 / _0) -- False -- -- >>> isFiniteNumber (_3 / _2) -- True isFiniteNumber :: RealFloat a => Quantity d a -> Bool isFiniteNumber = not . liftA2 (||) isNaN isInfinite -- | 'True' if the representation of the argument is an IEEE infinity or negative infinity. -- -- >>> isInfinite (_1 / _0) -- True -- -- >>> isInfinite (42 *~ micro farad) -- False isInfinite :: RealFloat a => Quantity d a -> Bool isInfinite = P.isInfinite . unQuantity -- | 'True' if the representation of the argument is an IEEE "not-a-number" (NaN) value. -- -- >>> isNaN _3 -- False -- -- >>> isNaN (_1 / _0) -- False -- -- >>> isNaN (asin _4) -- True isNaN :: RealFloat a => Quantity d a -> Bool isNaN = P.isNaN . unQuantity -- | 'True' if the representation of the argument is an IEEE negative zero. -- -- >>> isNegativeZero _0 -- False -- -- >>> isNegativeZero $ (-1e-200 *~ one) * (1e-200 *~ one) -- True isNegativeZero :: RealFloat a => Quantity d a -> Bool isNegativeZero = P.isNegativeZero . unQuantity -- | Multiplies a floating-point quantity by an integer power of the radix of the representation type. -- -- Use 'P.floatRadix' to determine the radix. -- -- >>> let x = 3 *~ meter -- >>> scaleFloat 3 x -- 24.0 m scaleFloat :: RealFloat a => Int -> Quantity d a -> Quantity d a scaleFloat x = Quantity . P.scaleFloat x . unQuantity -- | An infinite floating-point quantity. infinity :: IEEE a => Quantity d a infinity = Quantity F.infinity -- | The smallest representable positive quantity whose representation is normalized. minNormal :: IEEE a => Quantity d a minNormal = Quantity F.minNormal -- | The largest representable finite floating-point quantity. maxFinite :: IEEE a => Quantity d a maxFinite = Quantity F.maxFinite -- | The smallest positive value @x@ such that @_1 + x@ is representable. epsilon :: IEEE a => Dimensionless a epsilon = Quantity F.epsilon -- | @copySign x y@ returns the quantity @x@ with its sign changed to match that of @y@. copySign :: IEEE a => Quantity d a -> Quantity d a -> Quantity d a copySign = liftQ2 F.copySign -- | Return 'True' if two floating-point quantities are /exactly/ (bitwise) equal. identicalIEEE :: IEEE a => Quantity d a -> Quantity d a -> Bool identicalIEEE (Quantity x) (Quantity y) = F.identicalIEEE x y -- | Return the next largest representable floating-point quantity (@Infinity@ and @NaN@ are unchanged). succIEEE :: IEEE a => Quantity d a -> Quantity d a succIEEE = liftQ F.succIEEE -- | Return the next smallest representable floating-point quantity (@Infinity@ and @NaN@ are unchanged). predIEEE :: IEEE a => Quantity d a -> Quantity d a predIEEE = liftQ F.predIEEE -- | Given two floating-point quantities with the same sign, return the quantity whose representation is halfway -- between their representations on the IEEE number line. If the signs of the values differ or either is @NaN@, -- the value is undefined. bisectIEEE :: IEEE a => Quantity d a -> Quantity d a -> Quantity d a bisectIEEE (Quantity x) (Quantity y) = Quantity $ F.bisectIEEE x y -- | Default @NaN@ quantity. nan :: IEEE a => Quantity d a nan = Quantity F.nan -- | Quiet @NaN@ quantity with a positive integer payload. -- Payload must be less than 'maxNaNPayload' of the representation type. -- -- Beware that while some platforms allow using 0 as a payload, this behavior is not portable. nanWithPayload :: IEEE a => Word64 -> Quantity d a nanWithPayload = Quantity . F.nanWithPayload -- | The payload stored in a @NaN@ quantity. Undefined if the argument is not @NaN@. nanPayload :: IEEE a => Quantity d a -> Word64 nanPayload = F.nanPayload . unQuantity -- | Return the minimum of two quantities; if one value is @NaN@, return the other. Prefer the first if both values are @NaN@. minNum :: RealFloat a => Quantity d a -> Quantity d a -> Quantity d a minNum = liftQ2 F.minNum -- | Return the maximum of two quantities; if one value is @NaN@, return the other. Prefer the first if both values are @NaN@. maxNum :: RealFloat a => Quantity d a -> Quantity d a -> Quantity d a maxNum = liftQ2 F.maxNum -- | Return the minimum of two quantities; if one value is @NaN@, return it. Prefer the first if both values are @NaN@. minNaN :: RealFloat a => Quantity d a -> Quantity d a -> Quantity d a minNaN = liftQ2 F.minNaN -- | Return the maximum of two quantities; if one value is @NaN@, return it. Prefer the first if both values are @NaN@. maxNaN :: RealFloat a => Quantity d a -> Quantity d a -> Quantity d a maxNaN = liftQ2 F.maxNaN dimensional-1.5/src/Numeric/Units/Dimensional/Internal.hs0000644000000000000000000002540314244166633021731 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} -- for Vector instances only {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} module Numeric.Units.Dimensional.Internal ( KnownVariant(..), Dimensional(..), type Unit, type Quantity, type SQuantity, siUnit, showIn, liftD, liftD2, liftQ, liftQ2 ) where import Control.Applicative import Control.DeepSeq import Data.AEq (AEq) import Data.Coerce (coerce) import Data.Data import Data.Kind import Data.ExactPi import Data.Functor.Classes (Eq1(..), Ord1(..)) import qualified Data.ExactPi.TypeLevel as E import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable(..)) import GHC.Generics import Numeric.Units.Dimensional.Dimensions import Numeric.Units.Dimensional.Variants import Numeric.Units.Dimensional.UnitNames hiding ((*), (/), (^), weaken, strengthen) import qualified Numeric.Units.Dimensional.UnitNames.Internal as Name import Numeric.Units.Dimensional.UnitNames.InterchangeNames (HasInterchangeName(..)) import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Prelude ( Show, Eq(..), Ord, Bounded(..), Num, Fractional, Functor, Real(..) , String, Maybe(..), Double , (.), ($), (++), (+), (/) , show, otherwise, undefined, error, fmap, realToFrac ) import qualified Prelude as P -- $setup -- >>> :set -XNoImplicitPrelude -- >>> import Numeric.Units.Dimensional.Prelude -- | A unit of measurement. type Unit (m :: Metricality) = Dimensional ('DUnit m) -- | A dimensional quantity. type Quantity = SQuantity E.One -- | 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. type SQuantity s = Dimensional ('DQuantity s) -- | 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. class KnownVariant (v :: Variant) where -- | A dimensional value, either a 'Quantity' or a 'Unit', parameterized by its 'Dimension' and representation. data Dimensional v :: Dimension -> Type -> Type -- | A scale factor by which the numerical value of this dimensional value is implicitly multiplied. type ScaleFactor v :: E.ExactPi' extractValue :: Dimensional v d a -> (a, Maybe ExactPi) extractName :: Dimensional v d a -> Maybe (UnitName 'NonMetric) injectValue :: Maybe (UnitName 'NonMetric) -> (a, Maybe ExactPi) -> Dimensional v d a -- | 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. dmap :: (a1 -> a2) -> Dimensional v d a1 -> Dimensional v d a2 deriving instance Typeable Dimensional instance KnownVariant ('DQuantity s) where newtype Dimensional ('DQuantity s) d a = Quantity a deriving (Eq, Ord, AEq, Data, Generic, Generic1, Typeable) type (ScaleFactor ('DQuantity s)) = s extractValue (Quantity x) = (x, Nothing) extractName _ = Nothing injectValue _ (x, _) = Quantity x dmap = coerce instance (Typeable m) => KnownVariant ('DUnit m) where data Dimensional ('DUnit m) d a = Unit !(UnitName m) !ExactPi !a deriving (Generic, Generic1, Typeable) type (ScaleFactor ('DUnit m)) = E.One extractValue (Unit _ e x) = (x, Just e) extractName (Unit n _ _) = Just . Name.weaken $ n injectValue (Just n) (x, Just e) | Just n' <- relax n = Unit n' e x | otherwise = error "Shouldn't be reachable. Needed a metric name but got a non-metric one." injectValue _ _ = error "Shouldn't be reachable. Needed to name a quantity." dmap f (Unit n e x) = Unit n e (f x) -- GHC is somewhat unclear about why, but it won't derive this instance, so we give it explicitly. instance (Bounded a) => Bounded (SQuantity s d a) where minBound = Quantity minBound maxBound = Quantity maxBound instance Eq1 (SQuantity s d) where liftEq = coerce instance Ord1 (SQuantity s d) where liftCompare = coerce instance HasInterchangeName (Unit m d a) where interchangeName (Unit n _ _) = interchangeName n {- Since quantities form a monoid under addition, but not under multiplication unless they are dimensionless, we will define a monoid instance that adds. -} -- | 'Quantity's of a given 'Dimension' form a 'Semigroup' under addition. instance (Num a) => Semigroup (SQuantity s d a) where (<>) = liftQ2 (+) -- | 'Quantity's of a given 'Dimension' form a 'Monoid' under addition. instance (Num a) => Monoid (SQuantity s d a) where mempty = Quantity 0 mappend = (<>) {- = Dimensionless = For dimensionless quantities pretty much any operation is applicable. We provide this freedom by making 'Dimensionless' an instance of 'Functor'. -} instance Functor (SQuantity s DOne) where fmap = dmap instance (KnownDimension d) => HasDynamicDimension (Dimensional v d a) where instance (KnownDimension d) => HasDimension (Dimensional v d a) where dimension _ = dimension (Proxy :: Proxy d) -- | 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. siUnit :: forall d a.(KnownDimension d, Num a) => Unit 'NonMetric d a siUnit = Unit (baseUnitName $ dimension (Proxy :: Proxy d)) 1 1 instance NFData a => NFData (Quantity d a) -- instance is derived from Generic instance instance Storable a => Storable (SQuantity s d a) where sizeOf _ = sizeOf (undefined :: a) {-# INLINE sizeOf #-} alignment _ = alignment (undefined :: a) {-# INLINE alignment #-} poke ptr = poke (castPtr ptr :: Ptr a) . coerce {-# INLINE poke #-} peek ptr = fmap Quantity (peek (castPtr ptr :: Ptr a)) {-# INLINE peek #-} {- Instances for vectors of quantities. -} newtype instance U.Vector (SQuantity s d a) = V_Quantity {unVQ :: U.Vector a} newtype instance U.MVector v (SQuantity s d a) = MV_Quantity {unMVQ :: U.MVector v a} instance U.Unbox a => U.Unbox (SQuantity s d a) instance (M.MVector U.MVector a) => M.MVector U.MVector (SQuantity s d a) where basicLength = M.basicLength . unMVQ {-# INLINE basicLength #-} basicUnsafeSlice m n = MV_Quantity . M.basicUnsafeSlice m n . unMVQ {-# INLINE basicUnsafeSlice #-} basicOverlaps u v = M.basicOverlaps (unMVQ u) (unMVQ v) {-# INLINE basicOverlaps #-} basicUnsafeNew = fmap MV_Quantity . M.basicUnsafeNew {-# INLINE basicUnsafeNew #-} basicUnsafeRead v = fmap Quantity . M.basicUnsafeRead (unMVQ v) {-# INLINE basicUnsafeRead #-} basicUnsafeWrite v i = M.basicUnsafeWrite (unMVQ v) i . coerce {-# INLINE basicUnsafeWrite #-} #if MIN_VERSION_vector(0,11,0) basicInitialize = M.basicInitialize . unMVQ {-# INLINE basicInitialize #-} #endif instance (G.Vector U.Vector a) => G.Vector U.Vector (SQuantity s d a) where basicUnsafeFreeze = fmap V_Quantity . G.basicUnsafeFreeze . unMVQ {-# INLINE basicUnsafeFreeze #-} basicUnsafeThaw = fmap MV_Quantity . G.basicUnsafeThaw . unVQ {-# INLINE basicUnsafeThaw #-} basicLength = G.basicLength . unVQ {-# INLINE basicLength #-} basicUnsafeSlice m n = V_Quantity . G.basicUnsafeSlice m n . unVQ {-# INLINE basicUnsafeSlice #-} basicUnsafeIndexM v = fmap Quantity . G.basicUnsafeIndexM (unVQ v) {-# INLINE basicUnsafeIndexM #-} {- We will conclude by providing a reasonable 'Show' instance for quantities. The SI unit of the quantity is inferred from its dimension. -} -- | Uses non-breaking spaces between the value and the unit, and within the unit name. instance (KnownDimension d, E.KnownExactPi s, Show a, Real a) => Show (SQuantity s d a) where show (Quantity x) | isExactOne s' = show x ++ showName n | otherwise = "Quantity " ++ show x ++ " {- " ++ show q ++ " -}" where s' = E.exactPiVal (Proxy :: Proxy s) s'' = approximateValue s' :: Double q = Quantity (realToFrac x P.* s'') :: Quantity d Double (Unit n _ _) = siUnit :: Unit 'NonMetric d a -- | Shows the value of a 'Quantity' expressed in a specified 'Unit' of the same 'Dimension'. -- -- Uses non-breaking spaces between the value and the unit, and within the unit name. -- -- >>> putStrLn $ showIn watt $ (37 *~ volt) * (4 *~ ampere) -- 148.0 W showIn :: (Show a, Fractional a) => Unit m d a -> Quantity d a -> String showIn (Unit n _ y) (Quantity x) = show (x / y) ++ (showName . Name.weaken $ n) showName :: UnitName 'NonMetric -> String showName n | n == nOne = "" | otherwise = "\xA0" ++ show n -- | Unit names are shown with non-breaking spaces. instance (Show a) => Show (Unit m d a) where show (Unit n e x) = "The unit " ++ show n ++ ", with value " ++ show e ++ " (or " ++ show x ++ ")" -- Operates on a dimensional value using a unary operation on values, possibly yielding a Unit. liftD :: (KnownVariant v1, KnownVariant v2) => (ExactPi -> ExactPi) -> (a -> b) -> UnitNameTransformer -> Dimensional v1 d1 a -> Dimensional v2 d2 b liftD fe f nt x = let (x', e') = extractValue x n = extractName x n' = fmap nt n in injectValue n' (f x', fmap fe e') -- Operates on a dimensional value using a unary operation on values, yielding a Quantity. liftQ :: (a -> a) -> SQuantity s1 d1 a -> SQuantity s2 d2 a liftQ = coerce -- Combines two dimensional values using a binary operation on values, possibly yielding a Unit. liftD2 :: (KnownVariant v1, KnownVariant v2, KnownVariant v3) => (ExactPi -> ExactPi -> ExactPi) -> (a -> a -> a) -> UnitNameTransformer2 -> Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional v3 d3 a liftD2 fe f nt x1 x2 = let (x1', e1') = extractValue x1 (x2', e2') = extractValue x2 n1 = extractName x1 n2 = extractName x2 n' = liftA2 nt n1 n2 in injectValue n' (f x1' x2', fe <$> e1' <*> e2') -- Combines two dimensional values using a binary operation on values, yielding a Quantity. liftQ2 :: (a -> a -> a) -> SQuantity s1 d1 a -> SQuantity s2 d2 a -> SQuantity s3 d3 a liftQ2 = coerce dimensional-1.5/src/Numeric/Units/Dimensional/UnitNames/Internal.hs0000644000000000000000000003474114246352770023642 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module Numeric.Units.Dimensional.UnitNames.Internal where import Control.DeepSeq import Control.Monad (join) import Data.Coerce import Data.Data hiding (Prefix) import Data.Foldable (toList) import Data.Ord import GHC.Generics hiding (Prefix) import Numeric.Units.Dimensional.Dimensions.TermLevel (Dimension', asList, HasDimension(..)) import Numeric.Units.Dimensional.UnitNames.InterchangeNames hiding (isAtomic) import qualified Numeric.Units.Dimensional.UnitNames.InterchangeNames as I import Numeric.Units.Dimensional.Variants (Metricality(..)) import Prelude hiding ((*), (/), (^), product) import qualified Prelude as P -- | The name of a unit. data UnitName (m :: Metricality) where -- | The name of the unit of dimensionless values. One :: UnitName 'NonMetric -- | A name of an atomic unit to which metric prefixes may be applied. MetricAtomic :: NameAtom ('UnitAtom 'Metric) -> UnitName 'Metric -- | A name of an atomic unit to which metric prefixes may not be applied. Atomic :: NameAtom ('UnitAtom 'NonMetric) -> UnitName 'NonMetric -- | A name of a prefixed unit. Prefixed :: PrefixName -> UnitName 'Metric -> UnitName 'NonMetric -- | A compound name formed from the product of two names. Product :: UnitName 'NonMetric -> UnitName 'NonMetric -> UnitName 'NonMetric -- | A compound name formed from the quotient of two names. Quotient :: UnitName 'NonMetric -> UnitName 'NonMetric -> UnitName 'NonMetric -- | A compound name formed by raising a unit name to an integer power. Power :: UnitName 'NonMetric -> Int -> UnitName 'NonMetric -- | A compound name formed by grouping another name, which is generally compound. Grouped :: UnitName 'NonMetric -> UnitName 'NonMetric -- | A weakened name formed by forgetting that it could accept a metric prefix. -- -- Also available is the smart constructor `weaken` which accepts any `UnitName` as input. Weaken :: UnitName 'Metric -> UnitName 'NonMetric deriving (Typeable) deriving instance Eq (UnitName m) -- As it is for a GADT, this instance cannot be derived or use the generic default implementation instance NFData (UnitName m) where rnf n = case n of One -> () MetricAtomic a -> rnf a Atomic a -> rnf a Prefixed p n' -> rnf p `seq` rnf n' Product n1 n2 -> rnf n1 `seq` rnf n2 Quotient n1 n2 -> rnf n1 `seq` rnf n2 Power n' e -> rnf n' `seq` rnf e Grouped n' -> rnf n' Weaken n' -> rnf n' -- | `UnitName`s are shown with non-breaking spaces. instance Show (UnitName m) where show One = "1" show (MetricAtomic a) = abbreviation_en a show (Atomic a) = abbreviation_en a show (Prefixed a n) = abbreviation_en a ++ show n show (Product n1 n2) = show n1 ++ "\xA0" ++ show n2 show (Quotient n1 n2) = show n1 ++ "\xA0/\xA0" ++ show n2 show (Power x n) = show x ++ "^" ++ show n show (Grouped n) = "(" ++ show n ++ ")" show (Weaken n) = show n -- | Converts a 'UnitName' to a 'NameAtom', if possible. asAtomic :: UnitName m -> Maybe (NameAtom ('UnitAtom m)) asAtomic (MetricAtomic a) = Just a asAtomic (Atomic a) = Just a asAtomic (Weaken n) = coerce <$> asAtomic n asAtomic _ = Nothing -- | Returns 'True' if the 'UnitName' is atomic. isAtomic :: UnitName m -> Bool isAtomic One = True isAtomic (MetricAtomic _) = True isAtomic (Atomic _) = True isAtomic (Prefixed _ _) = True isAtomic (Grouped _) = True isAtomic (Weaken n) = isAtomic n isAtomic _ = False isAtomicOrProduct :: UnitName m -> Bool isAtomicOrProduct (Product _ _) = True isAtomicOrProduct n = isAtomic n -- | Reduce a 'UnitName' by algebraic simplifications. reduce :: UnitName m -> UnitName m reduce One = One reduce n@(MetricAtomic _) = n reduce n@(Atomic _) = n reduce n@(Prefixed _ _) = n reduce (Product n1 n2) = reduce' (reduce n1 * reduce n2) reduce (Quotient n1 n2) = reduce' (reduce n1 * reduce n2) reduce (Power n x) = reduce' (reduce n ^ x) reduce (Grouped n) = reduce' (Grouped (reduce n)) reduce (Weaken n) = reduce' (Weaken (reduce n)) -- reduce, knowing that subterms are already in reduced form reduce' :: UnitName m -> UnitName m reduce' (Product One n) = reduce' n reduce' (Product n One) = reduce' n reduce' (Power (Power n x1) x2) = reduce (n ^ (x1 P.* x2)) reduce' (Power (Grouped (Power n x1)) x2) = reduce (n ^ (x1 P.* x2)) reduce' (Power _ 0) = One reduce' (Power n 1) = reduce' n reduce' (Grouped n) = reduce' n reduce' n@(Weaken (MetricAtomic _)) = n reduce' n = n data NameAtomType = UnitAtom Metricality | PrefixAtom deriving (Eq, Ord, Data, Typeable, Generic) instance NFData NameAtomType where -- instance is derived from Generic instance -- | The name of a metric prefix. type PrefixName = NameAtom 'PrefixAtom -- | A metric prefix. data Prefix = Prefix { -- | The name of a metric prefix. prefixName :: PrefixName, -- | The scale factor denoted by a metric prefix. scaleFactor :: Rational } deriving (Eq, Data, Typeable, Generic) instance Ord Prefix where compare = comparing scaleFactor instance NFData Prefix where -- instance is derived from Generic instance instance HasInterchangeName Prefix where interchangeName = interchangeName . prefixName -- | The name of the unit of dimensionless values. nOne :: UnitName 'NonMetric nOne = One nMeter :: UnitName 'Metric nMeter = ucumMetric "m" "m" "metre" nGram :: UnitName 'Metric nGram = ucumMetric "g" "g" "gram" nKilogram :: UnitName 'NonMetric nKilogram = applyPrefix kilo nGram nSecond :: UnitName 'Metric nSecond = ucumMetric "s" "s" "second" nAmpere :: UnitName 'Metric nAmpere = ucumMetric "A" "A" "Ampere" nKelvin :: UnitName 'Metric nKelvin = ucumMetric "K" "K" "Kelvin" nMole :: UnitName 'Metric nMole = ucumMetric "mol" "mol" "mole" nCandela :: UnitName 'Metric nCandela = ucumMetric "cd" "cd" "candela" -- | The name of the base unit associated with a specified dimension. baseUnitName :: Dimension' -> UnitName 'NonMetric baseUnitName d = let powers = asList $ dimension d in reduce . product $ zipWith (^) baseUnitNames powers baseUnitNames :: [UnitName 'NonMetric] baseUnitNames = [weaken nMeter, nKilogram, weaken nSecond, weaken nAmpere, weaken nKelvin, weaken nMole, weaken nCandela] deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta :: Prefix deca = prefix "da" "da" "deca" 1e1 hecto = prefix "h" "h" "hecto" 1e2 kilo = prefix "k" "k" "kilo" 1e3 mega = prefix "M" "M" "mega" 1e6 giga = prefix "G" "G" "giga" 1e9 tera = prefix "T" "T" "tera" 1e12 peta = prefix "P" "P" "peta" 1e15 exa = prefix "E" "E" "exa" 1e18 zetta = prefix "Z" "Z" "zetta" 1e21 yotta = prefix "Y" "Y" "yotta" 1e24 deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto :: Prefix deci = prefix "d" "d" "deci" 1e-1 centi = prefix "c" "c" "centi" 1e-2 milli = prefix "m" "m" "milli" 1e-3 micro = prefix "u" "μ" "micro" 1e-6 nano = prefix "n" "n" "nano" 1e-9 pico = prefix "p" "p" "pico" 1e-12 femto = prefix "f" "f" "femto" 1e-15 atto = prefix "a" "a" "atto" 1e-18 zepto = prefix "z" "z" "zepto" 1e-21 yocto = prefix "y" "y" "yocto" 1e-24 -- | A list of all 'Prefix'es defined by the SI. siPrefixes :: [Prefix] siPrefixes = [yocto, zepto, atto, femto, pico, nano, micro, milli, centi, deci, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta] -- | Forms a 'UnitName' from a 'Metric' name by applying a metric prefix. applyPrefix :: Prefix -> UnitName 'Metric -> UnitName 'NonMetric applyPrefix = Prefixed . prefixName {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^ infixl 7 *, / -- | Form a 'UnitName' by taking the product of two others. (*) :: UnitName m1 -> UnitName m2 -> UnitName 'NonMetric a * b = Product (weaken a) (weaken b) -- | Form a 'UnitName' by dividing one by another. (/) :: UnitName m1 -> UnitName m2 -> UnitName 'NonMetric n1 / n2 | isAtomicOrProduct n1 = Quotient (weaken n1) (weaken n2) | otherwise = Quotient (grouped n1) (weaken n2) -- | Form a 'UnitName' by raising a name to an integer power. (^) :: UnitName m -> Int -> UnitName 'NonMetric x ^ n | isAtomic x = Power (weaken x) n | otherwise = Power (grouped x) n -- | Convert a 'UnitName' which may or may not be 'Metric' to one -- which is certainly 'NonMetric'. weaken :: UnitName m -> UnitName 'NonMetric weaken n@(MetricAtomic _) = Weaken n -- we really only need this one case and a catchall, but the typechecker can't see it weaken n@One = n weaken n@(Atomic _) = n weaken n@(Prefixed _ _) = n weaken n@(Product _ _) = n weaken n@(Quotient _ _) = n weaken n@(Power _ _) = n weaken n@(Grouped _) = n weaken n@(Weaken _) = n -- | Attempt to convert a 'UnitName' which may or may not be 'Metric' to one -- which is certainly 'Metric'. strengthen :: UnitName m -> Maybe (UnitName 'Metric) strengthen n@(MetricAtomic _) = Just n strengthen (Weaken n) = strengthen n strengthen _ = Nothing -- | Convert a 'UnitName' of one 'Metricality' into a name of another metricality by -- strengthening or weakening if neccessary. Because it may not be possible to strengthen, -- the result is returned in a 'Maybe' wrapper. relax :: forall m1 m2.(Typeable m1, Typeable m2) => UnitName m1 -> Maybe (UnitName m2) relax = go (typeRep (Proxy :: Proxy m1)) (typeRep (Proxy :: Proxy m2)) where metric = typeRep (Proxy :: Proxy 'Metric) nonMetric = typeRep (Proxy :: Proxy 'NonMetric) go :: TypeRep -> TypeRep -> UnitName m1 -> Maybe (UnitName m2) go p1 p2 | p1 == p2 = cast | (p1 == nonMetric) && (p2 == metric) = join . fmap gcast . strengthen | (p1 == metric) && (p2 == nonMetric) = cast . weaken | otherwise = error "Should be unreachable. TypeRep of an unexpected Metricality encountered." -- | Constructs a 'UnitName' by applying a grouping operation to -- another 'UnitName', which may be useful to express precedence. grouped :: UnitName m -> UnitName 'NonMetric grouped = Grouped . weaken -- | Represents the name of an atomic unit or prefix. data NameAtom (m :: NameAtomType) = NameAtom { _interchangeName :: InterchangeName, -- ^ The interchange name of the unit. abbreviation_en :: String, -- ^ The abbreviated name of the unit in international English. name_en :: String -- ^ The full name of the unit in international English. } deriving (Eq, Ord, Data, Typeable, Generic) instance NFData (NameAtom m) where -- instance is derived from Generic instance instance HasInterchangeName (NameAtom m) where interchangeName = _interchangeName instance HasInterchangeName (UnitName m) where interchangeName One = InterchangeName { name = "1", authority = UCUM, I.isAtomic = True } interchangeName (MetricAtomic a) = interchangeName a interchangeName (Atomic a) = interchangeName a interchangeName (Prefixed p n) = let n' = (name . interchangeName $ p) ++ (name . interchangeName $ n) a' = max (authority . interchangeName $ p) (authority . interchangeName $ n) in InterchangeName { name = n', authority = a', I.isAtomic = False } interchangeName (Product n1 n2) = let n' = (name . interchangeName $ n1) ++ "." ++ (name . interchangeName $ n2) a' = max (authority . interchangeName $ n1) (authority . interchangeName $ n2) in InterchangeName { name = n', authority = a', I.isAtomic = False } interchangeName (Quotient n1 n2) = let n' = (name . interchangeName $ n1) ++ "/" ++ (name . interchangeName $ n2) a' = max (authority . interchangeName $ n1) (authority . interchangeName $ n2) in InterchangeName { name = n', authority = a', I.isAtomic = False } -- TODO #109: note in this case that the UCUM is changing their grammar to not accept exponents after -- as a result it will become necessary to distribute the exponentiation over the items in the base name -- prior to generating the interchange name interchangeName (Power n x) = let n' = (name . interchangeName $ n) ++ show x in InterchangeName { name = n', authority = authority . interchangeName $ n, I.isAtomic = False } interchangeName (Grouped n) = let n' = "(" ++ (name . interchangeName $ n) ++ ")" in InterchangeName { name = n', authority = authority . interchangeName $ n, I.isAtomic = False } interchangeName (Weaken n) = interchangeName n prefix :: String -> String -> String -> Rational -> Prefix prefix i a f = Prefix n where n = NameAtom (InterchangeName i UCUM True) a f ucumMetric :: String -> String -> String -> UnitName 'Metric ucumMetric i a f = MetricAtomic $ NameAtom (InterchangeName i UCUM True) a f ucum :: String -> String -> String -> UnitName 'NonMetric ucum i a f = Atomic $ NameAtom (InterchangeName i UCUM True) a f dimensionalAtom :: String -> String -> String -> UnitName 'NonMetric dimensionalAtom i a f = Atomic $ NameAtom (InterchangeName i DimensionalLibrary True) a f -- | Constructs an atomic name for a custom unit. atom :: String -- ^ Interchange name -> String -- ^ Abbreviated name in international English -> String -- ^ Full name in international English -> UnitName 'NonMetric atom i a f = Atomic $ NameAtom (InterchangeName i Custom True) a f -- | The type of a unit name transformation that may be associated with an operation that takes a single unit as input. type UnitNameTransformer = (forall m.UnitName m -> UnitName 'NonMetric) -- | The type of a unit name transformation that may be associated with an operation that takes two units as input. type UnitNameTransformer2 = (forall m1 m2.UnitName m1 -> UnitName m2 -> UnitName 'NonMetric) -- | Forms the product of a list of 'UnitName's. -- -- If you wish to form a heterogenous product of 'Metric' and 'NonMetric' units -- you should apply 'weaken' to the 'Metric' ones. product :: Foldable f => f (UnitName 'NonMetric) -> UnitName 'NonMetric product = go . toList where -- This is not defined using a simple fold so that it does not complicate the product with -- valid but meaningless occurences of nOne. go :: [UnitName 'NonMetric] -> UnitName 'NonMetric go [] = nOne go [n] = n go (n : ns) = n * go ns dimensional-1.5/tests/DocTests.hs0000644000000000000000000000054314247421066015305 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} module Main (main) where import System.FilePath.Glob (glob) import Test.DocTest (doctest) #if MIN_VERSION_base(4,12,0) doctestFlags = ["-XNoStarIsType"] #else doctestFlags = [] #endif main :: IO () main = glob "src/**/*.hs" >>= (doctest . (doctestFlags++)) dimensional-1.5/tests/Spec.hs0000644000000000000000000000027714244166633014456 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} -- This module will automatically pull in all the Spec modules. -- See https://hspec.github.io/hspec-discover.html for a summary of how it works. dimensional-1.5/tests/Numeric/Units/DimensionalSpec.hs0000644000000000000000000000462114244152645021340 0ustar0000000000000000module Numeric.Units.DimensionalSpec where import Numeric.Units.Dimensional.Prelude import Test.Hspec import qualified Prelude as P spec :: Spec spec = do describe "Exponentiation operators" $ do it "correctly exponentiate quantities with integer exponents" $ do ((9::Double) *~ one) `shouldBe` (3 *~ one) ^ pos2 ((1::Double) *~ one) `shouldBe` (12.1231 *~ one) ^ zero ((0.25::Double) *~ one) `shouldBe` (2 *~ one) ^ neg2 it "correctly exponentiate dimensionless quantities with floating point exponents" $ do (3 P.** 2::Double) *~ one `shouldBe` (3 *~ one) ** (2 *~ one) (3 P.** (-2.231)::Double) *~ one `shouldBe` (3 *~ one) ** ((-2.231) *~ one) describe "Show instance" $ do it "properly prints basic quantities" $ do -- note: these comparison literals use non-breaking spaces show ((1.0::Double) *~ one) `shouldBe` "1.0" show ((2.0::Double) *~ meter) `shouldBe` "2.0 m" show ((2.0::Double) *~ (meter / second)) `shouldBe` "2.0 m s^-1" show ((2.0::Double) *~ (meter ^ pos2 / second ^ pos2)) `shouldBe` "2.0 m^2 s^-2" describe "Ord instance" $ do it "properly sorts quantities" $ do compare ((1 :: Integer) *~ one) (3 *~ one) `shouldBe` LT compare ((1 :: Double) *~ (kilo meter)) (1 *~ meter) `shouldBe` GT compare ((0 :: Double) *~ second) (_0) `shouldBe` EQ describe "Enumeration function nFromTo" $ do it "handles zero intermediate values" $ do nFromTo' _1 _6 0 `shouldBe` [_1, _6] it "handles negative number of intermediate values" $ do nFromTo' _1 _6 (-1) `shouldBe` [_1, _6] it "handles straightforward cases" $ do nFromTo' _1 _3 1 `shouldBe` [_1, _2, _3] nFromTo' _1 _6 4 `shouldBe` [_1, _2, _3, _4, _5, _6] nFromTo' _0 _6 2 `shouldBe` [_0, _2, _4, _6] it "handles decreasing intervals" $ do nFromTo' _5 _2 2 `shouldBe` [_5, _4, _3, _2] nFromTo' _6 _0 2 `shouldBe` [_6, _4, _2, _0] it "handles empty intervals" $ do nFromTo' _1 _1 0 `shouldBe` [_1, _1] nFromTo' _0 _0 2 `shouldBe` [_0, _0, _0, _0] nFromTo' :: Dimensionless Double -> Dimensionless Double -> Int -> [Dimensionless Double] nFromTo' = nFromTo dimensional-1.5/tests/Numeric/Units/Dimensional/DynamicSpec.hs0000644000000000000000000002323714244152645022730 0ustar0000000000000000module Numeric.Units.Dimensional.DynamicSpec where import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.Dynamic hiding ((*),(/),(^),(*~),(/~), recip) import Numeric.Units.Dimensional.Dimensions.TermLevel (hasSomeDimension) import qualified Numeric.Units.Dimensional.Dynamic as Dyn import qualified Prelude as P import Test.Hspec import Test.QuickCheck spec :: Spec spec = do describe "Dynamic quantity promotion and demotion" $ do it "round-trips through AnyQuantity" $ property $ \x -> let x' = x *~ kilo newton x'' = demoteQuantity x' :: AnyQuantity Double in Just x' == promoteQuantity x'' it "round-trips through DynQuantity" $ property $ \x -> let x' = x *~ micro watt x'' = demoteQuantity x' :: DynQuantity Rational in Just x' == promoteQuantity x'' it "round-trips through AnyQuantity then DynQuantity" $ property $ \x -> let x' = x *~ gram x'' = demoteQuantity x' :: AnyQuantity Double x''' = demoteQuantity x'' :: DynQuantity Double in Just x' == promoteQuantity x''' it "doesn't promote invalid quantities" $ do (promoteQuantity invalidQuantity :: Maybe (Length Double)) `shouldBe` Nothing it "doesn't promote AnyQuantity to the wrong dimension" $ do let x = 12.3 *~ meter x' = demoteQuantity x :: AnyQuantity Double (promoteQuantity x' :: Maybe (Mass Double)) `shouldBe` Nothing it "doesn't promote DynQuantity to the wrong dimension" $ do let x = 12.3 *~ mole x' = demoteQuantity x :: DynQuantity Double (promoteQuantity x' :: Maybe (Time Double)) `shouldBe` Nothing it "properly combines with dynamic units" $ do let meter' = demoteUnit' meter (promoteQuantity (139.4 Dyn.*~ meter' :: AnyQuantity Double)) `shouldBe` Just (139.4 *~ meter) it "properly eliminates dynamic units" $ do let ampere' = demoteUnit' ampere i = demoteQuantity $ 47 *~ ampere :: AnyQuantity Double i Dyn./~ ampere' `shouldBe` Just 47 it "doesn't eliminate dynamic units of the wrong dimension" $ do let ampere' = demoteUnit' ampere i = demoteQuantity $ 47 *~ joule :: AnyQuantity Double i Dyn./~ ampere' `shouldBe` Nothing describe "DynQuantity arithmetic" $ do -- declare some static quantities and their dynamic counterparts for arithmetic tests let x1 = 12.3 *~ meter x2 = (-7.9) *~ meter a = 93 *~ square (kilo meter) m = 147 *~ kilo gram t = 14.9 *~ second f = 87.2 *~ milli newton phi = 1.61803398875 *~ one x1' = demoteQuantity x1 :: DynQuantity Double x2' = demoteQuantity x2 :: DynQuantity Double a' = demoteQuantity a :: DynQuantity Double m' = demoteQuantity m :: DynQuantity Double t' = demoteQuantity t :: DynQuantity Double f' = demoteQuantity f :: DynQuantity Double phi' = demoteQuantity phi :: DynQuantity Double context "Num instance" $ do it "matches static addition" $ do (x1' P.+ x2') `shouldBe` demoteQuantity (x1 + x2) it "allows addition with polydimensional zero" $ do (t' P.+ polydimensionalZero) `shouldBe` t' (polydimensionalZero P.+ t') `shouldBe` t' (polydimensionalZero P.+ polydimensionalZero) `shouldBe` (polydimensionalZero :: DynQuantity Double) it "propagates witnesses to zero during addition" $ do -- We want to test that the witness for polymorphic zero was actually added to the other addend. -- The reason for this property is that if the other addend is some element of the underlying type -- which can't act as a divisor (such as a propagating nAn), then we want that information to still -- be around when we go to promote the result. let nan = 0 P./ 0 :: Double x = demoteQuantity $ nan *~ meter Just y = promoteQuantity (polydimensionalZero P.+ x) :: Maybe (Length Double) (y /~ meter) `shouldSatisfy` P.isNaN it "matches static subtraction" $ do (x2' P.- x1') `shouldBe` demoteQuantity (x2 - x1) it "allows subtraction with polydimensional zero" $ do (m' P.- polydimensionalZero) `shouldBe` m' (polydimensionalZero P.- m') `shouldBe` (P.negate m') (polydimensionalZero P.- polydimensionalZero) `shouldBe` (polydimensionalZero :: DynQuantity Double) it "matches static multiplication" $ do promoteQuantity (x1' P.* f') `shouldBe` Just (x1 * f) it "allows multiplication with polydimensional zero" $ do (f' P.* polydimensionalZero) `shouldBe` polydimensionalZero (polydimensionalZero P.* m') `shouldBe` polydimensionalZero (polydimensionalZero P.* polydimensionalZero) `shouldBe` (polydimensionalZero :: DynQuantity Double) it "matches static negation" $ do (P.negate m') `shouldBe` demoteQuantity (negate m) it "negates polydimensional zero" $ do (P.negate polydimensionalZero) `shouldBe` (polydimensionalZero :: DynQuantity Double) it "matches static absolute value" $ do (P.abs x2') `shouldBe` demoteQuantity (abs x2) it "takes absolute value of polydimensional zero" $ do (P.abs polydimensionalZero) `shouldBe` (polydimensionalZero :: DynQuantity Double) it "matches static signum" $ do (P.signum x1') `shouldBe` demoteQuantity (signum x1) (P.signum x2') `shouldBe` demoteQuantity (signum x2) it "takes signum of polydimensional zero" $ do (P.signum polydimensionalZero) `shouldBe` demoteQuantity (_0 :: Dimensionless Double) it "implements fromInteger with dimensionless result" $ do (P.fromInteger 7 :: DynQuantity Double) `shouldBe` demoteQuantity _7 context "Fractional instance" $ do it "matches static division" $ do ((f' P.* x1') P./ t') `shouldBe` demoteQuantity ((f * x1) / t) it "matches static reciprocal" $ do (P.recip m') `shouldBe` demoteQuantity (recip m) it "implements fromRational with dimensionless result" $ do let pi' = 22 P./ 7 :: Rational (P.fromRational pi' :: DynQuantity Rational) `shouldBe` demoteQuantity (pi' *~ one) it "permits polydimensional zero as a dividend" $ do (polydimensionalZero P./ m') `shouldBe` polydimensionalZero it "propagates witnesses to zero during division" $ do -- We want to test that the witness for polymorphic zero was actually divided by the divisor. -- The reason for this property is that if the divisor is itself zero (but not polydimensionalZero), -- or some other element of the underlying type which can't act as a divisor (such as a propagating nAn), -- then we want that information to still be around when we go to promote the result. let nan = 0 P./ 0 :: Double x = demoteQuantity $ nan *~ meter y = polydimensionalZero P./ x Just y' = promoteQuantity y :: Maybe (Length Double) (y' /~ meter) `shouldSatisfy` P.isNaN context "Floating instance" $ do it "implements dimensionless pi" $ do (P.pi :: DynQuantity Double) `shouldBe` demoteQuantity pi it "implements dimensionless sin" $ do -- this will serve as a test for all the single-argument dimensionless functions (P.sin phi') `shouldBe` demoteQuantity (sin phi) it "rejects non-dimensionless arguments to sin" $ do (P.sin m') `shouldBe` invalidQuantity it "implements dimensionless sin of polydimensional zero" $ do (P.sin polydimensionalZero) `shouldBe` (0 :: DynQuantity Double) it "matches static square root" $ do (P.sqrt a') `shouldBe` demoteQuantity (sqrt a) it "rejects arguments to square root with non-square dimensions" $ do (P.sqrt f') `shouldNotSatisfy` hasSomeDimension it "takes the square root of polydimensional zero" $ do (P.sqrt polydimensionalZero) `shouldBe` (polydimensionalZero :: DynQuantity Double) it "matches static dimensionless exponentiation" $ do (phi' P.** phi') `shouldBe` demoteQuantity (phi ** phi) it "rejects non-dimensionless arguments to dimensionless exponentiation" $ do (phi' P.** m') `shouldNotSatisfy` hasSomeDimension (x1' P.** phi') `shouldNotSatisfy` hasSomeDimension it "matches static logBase" $ do (P.logBase 10 phi') `shouldBe` demoteQuantity (logBase (10 *~ one) phi) it "rejects non-dimensionless arguments to logBase" $ do (P.logBase 10 x1') `shouldNotSatisfy` hasSomeDimension (P.logBase x1' 10) `shouldNotSatisfy` hasSomeDimension describe "Dynamic units" $ do describe "Promotion and demotion" $ do return () describe "Arithmetic" $ do return () dimensional-1.5/tests/Numeric/Units/Dimensional/QuantitiesSpec.hs0000644000000000000000000000756114244152645023474 0ustar0000000000000000module Numeric.Units.Dimensional.QuantitiesSpec where import Numeric.Units.Dimensional.Prelude import Test.Hspec spec :: Spec spec = do describe "Quantity synonyms" $ do it "compile with correct dimensions" $ do success -- If I compiled I'm OK! success :: IO () success = return () -- These definitions simply verify that the type synonyms are -- consistent with the appropriate units from table 2. If the -- definitions compile the type synonyms are good. x1 :: Area Double x1 = 1 *~ meter ^ pos2 x2 :: Volume Double x2 = 1 *~ meter ^ pos3 x3 :: Velocity Double x3 = 1 *~ (meter / second) x4 :: Acceleration Double x4 = 1 *~ (meter / second ^ pos2) x5 :: WaveNumber Double x5 = 1 *~ meter ^ neg1 x6 :: Density Double x6 = 1 *~ (kilo gram / meter ^ pos3) x7 :: SpecificVolume Double x7 = 1 *~ (meter ^ pos3 / kilo gram) x8 :: CurrentDensity Double x8 = 1 *~ (ampere / meter ^ pos2) x9 :: MagneticFieldStrength Double x9 = 1 *~ (ampere / meter) x10 :: Concentration Double x10 = 1 *~ (mole / meter ^ pos3) x11 :: Luminance Double x11 = 1 *~ (candela / meter ^ pos2) -- These definitions simply verify that the type synonyms are -- consistent with the appropriate units from table 3. If the -- definitions compile the type synonyms are good. y1 :: PlaneAngle Double y1 = 1 *~ (meter / meter) y2 :: SolidAngle Double y2 = 1 *~ (meter ^ pos2 / meter ^ pos2) y3 :: Frequency Double y3 = 1 *~ (one / second) y4 :: Force Double y4 = 1 *~ (meter * kilo gram / second ^ pos2) y5 :: Pressure Double y5 = 1 *~ (newton / meter ^ pos2) y6 :: Energy Double y6 = 1 *~ (newton * meter) y7 :: Power Double y7 = 1 *~ (joule / second) y8 :: ElectricCharge Double y8 = 1 *~ (second * ampere) y9 :: ElectricPotential Double y9 = 1 *~ (watt / ampere) y10 :: Capacitance Double y10 = 1 *~ (coulomb / volt) y11 :: ElectricResistance Double y11 = 1 *~ (volt / ampere) y12 :: ElectricConductance Double y12 = 1 *~ (ampere / volt) y13 :: MagneticFlux Double y13 = 1 *~ (volt * second) y14 :: MagneticFluxDensity Double y14 = 1 *~ (weber / meter ^ pos2) y15 :: Inductance Double y15 = 1 *~ (weber / ampere) y16 :: LuminousFlux Double y16 = 1 *~ (candela * steradian) y17 :: Illuminance Double y17 = 1 *~ (lumen / meter ^ pos2) y18 :: Activity Double y18 = 1 *~ (one / second) y19 :: AbsorbedDose Double y19 = 1 *~ (joule / kilo gram) y20 :: DoseEquivalent Double y20 = 1 *~ (joule / kilo gram) y21 :: CatalyticActivity Double y21 = 1 *~ (mole / second) -- Verification of table 4. If the definitions compile the type -- synonyms are good. z1 :: AngularVelocity Double z1 = 1 *~ (radian / second) z2 :: AngularAcceleration Double z2 = 1 *~ (radian / second ^ pos2) z3 :: DynamicViscosity Double z3 = 1 *~ (pascal * second) z4 :: MomentOfForce Double z4 = 1 *~ (newton * meter) z5 :: SurfaceTension Double z5 = 1 *~ (newton / meter) z6 :: HeatFluxDensity Double z6 = 1 *~ (watt / meter ^ pos2) z7 :: RadiantIntensity Double z7 = 1 *~ (watt / steradian) z8 :: Radiance Double z8 = 1 *~ (watt / (meter ^ pos2 * steradian)) z9 :: HeatCapacity Double z9 = 1 *~ (joule / kelvin) z10 :: SpecificHeatCapacity Double z10 = 1 *~ (joule / (kilo gram * kelvin)) z11 :: ThermalConductivity Double z11 = 1 *~ (watt / (meter * kelvin)) z12 :: EnergyDensity Double z12 = 1 *~ (joule / meter ^ pos3) z13 :: ElectricFieldStrength Double z13 = 1 *~ (volt / meter) z14 :: ElectricChargeDensity Double z14 = 1 *~ (coulomb / meter ^ pos3) z15 :: ElectricFluxDensity Double z15 = 1 *~ (coulomb / meter ^ pos2) z16 :: Permittivity Double z16 = 1 *~ (farad / meter) z17 :: Permeability Double z17 = 1 *~ (henry / meter) z18 :: MolarEnergy Double z18 = 1 *~ (joule / mole) z19 :: MolarEntropy Double z19 = 1 *~ (joule / (mole * kelvin)) z20 :: Exposure Double z20 = 1 *~ (coulomb / kilo gram) z21 :: AbsorbedDoseRate Double z21 = 1 *~ (gray / second) -- Other quantitites. mu :: GravitationalParameter Double mu = 398600.4418 *~ (kilo meter ^ pos3 / second ^ pos2) dimensional-1.5/benchmarks/Main.hs0000644000000000000000000000100214244152645015404 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} module Main where import Criterion.Main import Numeric.Units.Dimensional.Prelude import qualified Prelude as P main :: IO () main = defaultMain [ bench "RawArithmetic" $ nf rawArithmetic 1000 , bench "Arithmetic" $ nf arithmetic 1000 ] rawArithmetic :: Int -> [Double] rawArithmetic n = fmap (P./ 3.7) $ [1.0 .. fromIntegral n] arithmetic :: Int -> [Density Double] arithmetic n = fmap (/ (3.7 *~ cubic meter)) $ [1.0 .. fromIntegral n] *~~ kilo gram dimensional-1.5/README.md0000644000000000000000000000655014244166633013345 0ustar0000000000000000# dimensional This library provides statically-checked dimensional arithmetic for physical quantities, using the 7 SI base dimensions. Data kinds and closed type families provide a flexible, safe, and discoverable implementation that leads to largely self-documenting client code. [![Build Status](https://api.travis-ci.com/bjornbm/dimensional.svg?branch=master)](https://app.travis-ci.com/github/bjornbm/dimensional) [![Hackage Version](https://img.shields.io/hackage/v/dimensional.svg)](https://hackage.haskell.org/package/dimensional) [![Stackage version](https://www.stackage.org/package/dimensional/badge/lts?label=Stackage)](https://www.stackage.org/package/dimensional) ## Usage Simply importing `Numeric.Units.Dimensional.Prelude` provides access to dimensional arithmetic opertors, SI units and other common units accepted for use with the SI, and convenient aliases for quantities with commonly used dimensions. The `Unit d a` type represents a unit with dimension `d`, whose conversion factor to the coherent SI base unit of the corresponding dimension is represented by a value of type `a`. `a` is commonly chosen to be `Double`, but can be any `Floating` type. Where possible, support is also provided for `Fractional` or `Num` values. Similarly, the `Quantity d a` type represents a quantity with dimension `d`, whose numeric value is of type `a`. Aliases allow the use of, e.g., `Length Double` to mean `Quantity DLength Double`. A complete list of available aliases is given in the haddock documentation for the `Numeric.Units.Dimensional.Quantities`. In the example below, we will solve a simple word problem. A car travels at 60 kilometers per hour for one mile, at 50 kph for one mile, at 40 kph for one mile, and at 30 kph for one mile. How many minutes does the journey take? What is the average speed of the car? How many seconds does the journey take, rounded up to the next whole second? ```haskell {-# LANGUAGE NoImplicitPrelude #-} module ReadmeExample where import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.NonSI (mile) leg :: Length Double leg = 1 *~ mile -- *~ combines a raw number and a unit to form a quantity speeds :: [Velocity Double] speeds = [60, 50, 40, 30] *~~ (kilo meter / hour) -- *~~ does the same thing for a whole Functor at once -- Parentheses are required around unit expressions that are comingled with *~, /~, *~~, or /~~ operations timeOfJourney :: Time Double timeOfJourney = sum $ fmap (leg /) speeds -- We can use dimensional versions of ordinary functions like / and sum to combine quantities averageSpeed :: Velocity Double averageSpeed = _4 * leg / timeOfJourney -- _4 is an alias for the dimensionless number 4 wholeSeconds :: Integer wholeSeconds = ceiling $ timeOfJourney /~ second -- /~ lets us recover a raw number from a quantity and a unit in which it should be expressed main :: IO () main = do putStrLn $ "Length of journey is: " ++ showIn minute timeOfJourney putStrLn $ "Average speed is: " ++ showIn (mile / hour) averageSpeed putStrLn $ "If we don't want to be explicit about units, the show instance uses the SI basis: " ++ show averageSpeed putStrLn $ "The journey requires " ++ show wholeSeconds ++ " seconds, rounded up to the nearest second." ``` ## Contributing For project information (issues, updates, wiki, examples) see: https://github.com/bjornbm/dimensional dimensional-1.5/CHANGELOG.md0000644000000000000000000001525014254542321013665 0ustar00000000000000001.5 (2022-06) ------------- * Add Julian `decade`, `century`, and `millennium` to `NonSI`. * Rename `deka` prefix to `deca` in accordance with [international spelling](https://www.bipm.org/documents/20126/41483022/SI-Brochure-9.pdf/fcf090b2-04e6-88cc-1149-c3e029ad8232). * Change `astronomicalUnit` symbol to lowercase (`au`). * Remove `semigroups` dependency. * Significant documentation improvements. Thanks to @konsumlamm for many contributions! 1.4 (2021-05) ------------- * Add `calorie` to `NonSI`. * Remove deprecated `AutoDeriveTypeable` pragmas. This means that `Typable` instances are no provided on GHC prior to 8.2. 1.3 (2018-12) ------------- * Breaking: Changed the `Show` instances for `UnitName`, `Unit`, `SQuantity` to use non-breaking spaces within unit names and between values and their units. * Bumped exact-pi dependency to < 0.6. * Added the dimensionless unit `percent`. * Added dimensionless wrappers for `log1p`, `expm1`, `log1pexp`, and `log1mexp` from the `Floating` class. 1.2 (2018-11) ------------- * Add `NoStarIsType` extension and import `Data.Kind.Type` for [GHC 8.6 compitbility](https://github.com/ghc-proposals/ghc-proposals/blob/05721788de9ab6538def68c3c2c9dec50c9f24a8/proposals/0020-no-type-in-type.rst). Abandon compatibility with GHC < 8. 1.1 (2018-03) ------------- * Added `Semigroup` instances for [GHC 8.4 compatibility](https://ghc.haskell.org/trac/ghc/wiki/Migration/8.4#SemigroupMonoidsuperclasses). * Breaking: Renamed `Root` type family to `NRoot`. Added `Sqrt` and `Cbrt` type synonyms. Added `sqrt` and `cbrt` for term level dimensions. * Breaking: Changed `Numeric.Units.Dimensional.Prelude` to export dimensionally typed `signum`, `recip`, and `logBase` instead of the ones from `Prelude`. * Breaking: Changed `Numeric.Units.Dimensional.Prelude` to export `(.)` and `id` from `Control.Category` instead of from `Prelude`. * Breaking: Created a `product` function which take the product of a foldable structure of `Dimensionless` values. Exported this `product` function from Numeric.Units.Dimensional.Prelude instead of the one from `Prelude`. * Breaking: Changed the `HasDimension` typeclass to require an instance of the new `HasDynamicDimension` typeclass. * Breaking: Added operators for `AnyUnit` to the Numeric.Units.Dimensional.Dynamic module which may cause name collisions. * Breaking: Added dynamic versions of `(*~)`, `(/~)`, and `siUnit` to the Numeric.Units.Dimensional.Dynamic module which may cause name collisions. * Breaking: Removed exports of `nMeter`, `nSecond`, `kilo`, etc from Numeric.Units.Dimensional.UnitNames. Access these instead by inspecting the relevant units or prefixes. * Breaking: Generalized the type of `dimensionlessLength` from `(Num a, Foldable f) => f (Dimensional v d a) -> Dimensionless a)` to `(Num a, Foldable f) => f b -> Dimensionless a`. This provides a weaker constraint on the type `a` and may result in ambiguous types in code that depends on the former less general type. * Fixed a bug in the definition of the `inHg_NIST`. * Fixed a bug in the interchange name of the Dalton. * Added units for the US survey foot, yard, inch, mil, and mile. * Added the short ton as a unit of mass. * Clarified that the UCUM acre is based on the US survey foot. * Added a version of the acre based on the international foot. * Added `Data`, `Generic`, `Typeable` and `NFData` instances for many ancillary types. * Added `unQuantity` to the Coercion module to ease unwrapping without introducing ambiguous type variables. * Created explicit representation of metric `Prefix`es. * Added a multiplicative `Monoid` instance for `AnyQuantity` and for `AnyUnit`. * Added the `DynQuantity` type to represent possibly valid quantities of statically unknown dimension, suitable for performing arithmetic with such quantities. * Added `nroot` function for term-level dimensions. * Added the Numeric.Units.Dimensional.Float module with convenient wrappers around functions from RealFloat and IEEE for inspecting floating point quantities. * Added an `AEq` instance for `Quantity`. * Added `Eq1` and `Ord1` instances for `Quantity`. * Exposed the name of an 'AnyUnit' without promoting it to a 'Unit' first. * Exposed a way to convert atomic 'UnitName's back into 'NameAtom's. * Added the `btu`, a unit of energy. * Added the `gauss`, a unit of magnetic flux density. * Added the `angstrom`, a unit of length. * Relocated git repository to https://github.com/bjornbm/dimensional 1.0.1.3 (2016-09) ----------------- * Fixed an issue with applying metric prefixes to units with non-rational conversion factors. 1.0.1.2 (2016-05) ----------------- * Support for GHC 8.0.1-rc4, avoiding GHC Trac issue 12026. * Added support for stack. 1.0.1.1 (2015-11) ----------------- * Improved example in readme. 1.0.1.0 (2015-11) ----------------- * Added Numeric.Units.Dimensional.Coercion module. * Bumped exact-pi dependency to < 0.5. * Restored changelog. * Addressed issues with documentation. 1.0.0.0 (2015-11) ----------------- * Changed to DataKinds and ClosedTypeFamilies encoding of dimensions. * Added names and exact values to `Unit`s. * Added `AnyUnit` and `AnyQuantity` for quantities whose dimension is statically unknown. * Added Storable and Unbox instances for `Quantity`. * Added dimensionally-polymorphic `siUnit` for the coherent SI base unit of any dimension. * Added some additional units. 0.13.0.2 (2015-04) ------------------ * Corrected definition of lumen. 0.13.0.1 (2014-09) ------------------ * Bumped time dependency to < 1.6. 0.13 (2014-02) -------------- * Bump major version (should have been done in previous version). 0.12.3 (2014-02) ---------------- * Bump numtype dependency to 1.1 (GHC 7.8.1 compatibility fix). * Added `Torque`. * Added D.. for the type synonym quantities (e.g., `Angle`). 0.12.2 (2013-11) ---------------- * Added `FirstMassMoment`, `MomentOfInertia`, `AngularMomentum`. * Improved unit numerics. 0.12.1 (2013-07) ---------------- * Typeable Dimensionals. 0.12 (2013-06) -------------- * Polymorphic `_0` (closes issue 39). * Added `astronomicalUnit`. * Added imperial volume units. * Added 'mil' (=inch/1000). * Added [`tau`][3]. * Added `KinematicViscosity`. [3]: https://tauday.com/tau-manifesto 0.10.1.2 (2011-09) ------------------ * Bumped time dependency to < 1.5. 0.10.1.2 (2011-08) ------------------ * Bumped time dependency to < 1.4. 0.10.1 (2011-08) ---------------- GHC 7.2.1 compatibility fix: * Increased CGS context-stack to 30. 0.10 (2011-05) -------------- See the [announcement][2]. [2]: https://flygdynamikern.blogspot.se/2011/05/announce-dimensional-010.html 0.9 (2011-04) ------------- See the [announcement][1]. [1]: https://flygdynamikern.blogspot.se/2011/04/announce-dimensional-09.html dimensional-1.5/examples/ReadmeExample.hs0000644000000000000000000000253514244152645016746 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} module ReadmeExample where import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.NonSI (mile) leg :: Length Double leg = 1 *~ mile -- *~ combines a raw number and a unit to form a quantity speeds :: [Velocity Double] speeds = [60, 50, 40, 30] *~~ (kilo meter / hour) -- *~~ does the same thing for a whole Functor at once -- Parentheses are required around unit expressions that are comingled with *~, /~, *~~, or /~~ operations timeOfJourney :: Time Double timeOfJourney = sum $ fmap (leg /) speeds -- We can use dimensional versions of ordinary functions like / and sum to combine quantities averageSpeed :: Velocity Double averageSpeed = _4 * leg / timeOfJourney -- _4 is an alias for the dimensionless number 4 wholeSeconds :: Integer wholeSeconds = ceiling $ timeOfJourney /~ second -- /~ lets us recover a raw number from a quantity and a unit in which it should be expressed main :: IO () main = do putStrLn $ "Length of journey is: " ++ showIn minute timeOfJourney putStrLn $ "Average speed is: " ++ showIn (mile / hour) averageSpeed putStrLn $ "If we don't want to be explicit about units, the show instance uses the SI basis: " ++ show averageSpeed putStrLn $ "The journey requires " ++ show wholeSeconds ++ " seconds, rounded up to the nearest second." dimensional-1.5/examples/GM.lhs0000644000000000000000000000537414244152645014720 0ustar0000000000000000 = GM calculation = Several representation can be used to describe a satellite's orbit. Two of the most popular are the cartesian state vector (position and velocity vectors) and the keplerian elements. Conversion between the two representations is fairly straight-forward but requires an assumption to be made about the universal gravitational constant 'G' and the mass 'M' of the body the satellite is orbiting. In practice they are often combined into a parameter "mu = GM" where the magnitude of 'mu' is empirically better known that the magnitudes of 'G' and 'M' individually. *The problem:* Given two representations of the same satellite orbit -- one using the cartesian state vector and using keplerian elements, both at the same epoch -- determine the value of 'mu' used to convert between the two. {{{ > {-# LANGUAGE NegativeLiterals #-} > module GM where > import Numeric.Units.Dimensional.Prelude > import qualified Prelude }}} The state vector describing the orbit at epoch. {{{ > x = 4383.9449203752 *~ kilo meter > y = -41940.917505092 *~ kilo meter > z = 22.790255916589 *~ kilo meter > x_dot = 3.0575666627812 *~ (kilo meter / second) > y_dot = 0.32047068607303 *~ (kilo meter / second) > z_dot = 0.00084729371755294 *~ (kilo meter / second) }}} From the state vector we calculate the distance from the reference frame center at epoch and the velocity squared at epoch. {{{ > r = sqrt (x ^ pos2 + y ^ pos2 + z ^ pos2) > v = sqrt (x_dot ^ pos2 + y_dot ^ pos2 + z_dot ^ pos2) }}} The kinetic energy per unit mass at epoch is a function of the velocity. {{{ > e_kin :: EnergyPerUnitMass Double > e_kin = v ^ pos2 / _2 }}} The only keplerian element we need for this calculation is the semi-major axis. {{{ > semi_major_axis = 42165.221455 *~ kilo meter }}} The expression for 'mu' is obtained by solving the following equation system: e_pot = - mu / r, e_tot = - mu / 2a, e_tot = e_pot + e_kin, which gives: mu = e_kin / (1 / r - 1 / 2a). {{{ > mu = e_kin / (_1 / r - _1 / (_2 * semi_major_axis)) }}} Wrap up with a main function showing the value of 'mu' in desired units. {{{ > main = putStrLn $ "The value used for GM was " ++ show mu }}} Loading this module in 'ghci' and running 'main' produces the following output. {{{ ___ ___ _ / _ \ /\ /\/ __(_) / /_\// /_/ / / | | GHC Interactive, version 6.6.1, for Haskell 98. / /_\\/ __ / /___| | http://www.haskell.org/ghc/ \____/\/ /_/\____/|_| Type :? for help. Loading package base ... linking ... done. [1 of 1] Compiling GM ( GM.lhs, interpreted ) Ok, modules loaded: GM. *GM> main Loading package dimensional-0.5 ... linking ... done. The value used for GM was 3.986004400008003e14 m^3 s^-2 *GM> }}} dimensional-1.5/examples/NewtonianMechanics.hs0000644000000000000000000000246614244152645020015 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} module NewtonianMechanics where import Numeric.Units.Dimensional.Prelude translationalKineticEnergy :: (Fractional a) => Mass a -> Velocity a -> Energy a translationalKineticEnergy m v = m * v ^ pos2 / _2 translationalWork :: (Num a) => Force a -> Length a -> Energy a translationalWork f d = f * d translationalMomentum :: (Num a) => Mass a -> Velocity a -> Momentum a translationalMomentum m v = m * v translationalPower :: (Num a) => Force a -> Velocity a -> Power a translationalPower f v = f * v forceFromChangeInMomentum :: (Fractional a) => Momentum a -> Time a -> Force a forceFromChangeInMomentum dp dt = dp / dt rotationalKineticEnergy :: (Fractional a) => MomentOfInertia a -> AngularVelocity a -> Energy a rotationalKineticEnergy i w = i * w ^ pos2 / _2 rotationalWork :: (Num a) => Torque a -> PlaneAngle a -> Energy a rotationalWork t th = t * th rotationalMomentum :: (Num a) => MomentOfInertia a -> AngularVelocity a -> AngularMomentum a rotationalMomentum i w = i * w rotationalPower :: (Num a) => Torque a -> AngularVelocity a -> Power a rotationalPower t w = t * w torque :: (Num a) => Force a -> Length a -> Torque a torque r f = r * f torqueFromChangeInMomentum :: (Fractional a) => AngularMomentum a -> Time a -> Torque a torqueFromChangeInMomentum dL dt = dL / dt dimensional-1.5/LICENSE0000644000000000000000000000275614244152645013075 0ustar0000000000000000Copyright (c) 2006-2018, Bjorn Buckwalter. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder(s) nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dimensional-1.5/Setup.lhs0000644000000000000000000000011314244152645013661 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMaindimensional-1.5/dimensional.cabal0000644000000000000000000001126714254537122015351 0ustar0000000000000000name: dimensional version: 1.5 license: BSD3 license-file: LICENSE copyright: Bjorn Buckwalter 2006-2022 author: Bjorn Buckwalter maintainer: bjorn@buckwalter.se stability: experimental homepage: https://github.com/bjornbm/dimensional/ bug-reports: https://github.com/bjornbm/dimensional/issues/ category: Math, Physics synopsis: Statically checked physical dimensions cabal-version: >= 1.10 tested-with: GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.1, GHC == 8.8.3, GHC == 8.10.4 build-type: Simple description: Dimensional is a library providing data types for performing arithmetic with physical quantities and units. Information about the physical dimensions of the quantities and units is embedded in their types and the validity of operations is verified by the type checker at compile time. The wrapping and unwrapping of numerical values as quantities is done by multiplication and division with units. The library is designed to, as far as is practical, enforce/encourage best practices of unit usage. Version 1 of the dimensional package differs from earlier version in that the dimension tracking is implemented using Closed Type Families and Data Kinds rather than functional dependencies. This enables a number of features, including improved support for unit names and quantities with statically-unknown dimensions. Requires GHC 8.0 or later. extra-source-files: README.md, CHANGELOG.md, examples/ReadmeExample.hs, examples/GM.lhs, examples/NewtonianMechanics.hs source-repository head type: git location: https://github.com/bjornbm/dimensional/ library build-depends: base >= 4.9 && < 5, deepseq >= 1.3, exact-pi >= 0.4.1 && < 0.6, ieee754 >= 0.7.6, numtype-dk >= 0.5 && < 1.1, vector >= 0.10 hs-source-dirs: src default-language: Haskell2010 default-extensions: NoImplicitPrelude if impl(ghc >= 8.6) default-extensions: NoStarIsType ghc-options: -Wall exposed-modules: Numeric.Units.Dimensional Numeric.Units.Dimensional.Coercion Numeric.Units.Dimensional.Dimensions Numeric.Units.Dimensional.Dimensions.TermLevel Numeric.Units.Dimensional.Dimensions.TypeLevel Numeric.Units.Dimensional.Dynamic Numeric.Units.Dimensional.FixedPoint Numeric.Units.Dimensional.Functor Numeric.Units.Dimensional.NonSI Numeric.Units.Dimensional.Prelude Numeric.Units.Dimensional.Quantities Numeric.Units.Dimensional.SIUnits Numeric.Units.Dimensional.UnitNames Numeric.Units.Dimensional.UnitNames.InterchangeNames Numeric.Units.Dimensional.Variants Numeric.Units.Dimensional.Float other-modules: Numeric.Units.Dimensional.Internal Numeric.Units.Dimensional.UnitNames.Internal test-suite tests type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: tests default-language: Haskell2010 default-extensions: NoImplicitPrelude if impl(ghc >= 8.6) default-extensions: NoStarIsType other-modules: Numeric.Units.DimensionalSpec Numeric.Units.Dimensional.DynamicSpec Numeric.Units.Dimensional.QuantitiesSpec ghc-options: -Wall build-depends: dimensional, hspec, QuickCheck, base build-tool-depends: hspec-discover:hspec-discover == 2.* test-suite doctests type: exitcode-stdio-1.0 ghc-options: -threaded main-is: DocTests.hs hs-source-dirs: tests default-language: Haskell2010 build-depends: dimensional, doctest, Glob, QuickCheck, template-haskell, base benchmark simple type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Main.hs build-depends: base, criterion, deepseq, dimensional default-language: Haskell2010 ghc-options: -O2