dimensional-0.13.0.2/0000755000000000000000000000000012515414060012421 5ustar0000000000000000dimensional-0.13.0.2/changelog.md0000644000000000000000000000256712515414060014704 0ustar00000000000000000.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]: http://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]: http://flygdynamikern.blogspot.se/2011/05/announce-dimensional-010.html 0.9 (2011-04) ------------- See the [announcement][1]. [1]: http://flygdynamikern.blogspot.se/2011/04/announce-dimensional-09.html dimensional-0.13.0.2/dimensional.cabal0000644000000000000000000000340012515414060015704 0ustar0000000000000000Name: dimensional Version: 0.13.0.2 License: BSD3 License-File: LICENSE Copyright: Bjorn Buckwalter 2006-2015 Author: Bjorn Buckwalter Maintainer: bjorn@buckwalter.se Stability: mostly stable Homepage: http://dimensional.googlecode.com/ Synopsis: Statically checked physical dimensions. 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 boxing and unboxing 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. Category: Math, Physics Build-Type: Simple Build-Depends: base < 5, time < 1.6, numtype < 1.2 Exposed-Modules: Numeric.Units.Dimensional, Numeric.Units.Dimensional.Prelude, Numeric.Units.Dimensional.Quantities, Numeric.Units.Dimensional.SIUnits, Numeric.Units.Dimensional.NonSI, Numeric.Units.Dimensional.Extensible, Numeric.Units.Dimensional.CGS Extra-source-files: README, changelog.md, Test.hs Numeric/Units/Dimensional/Test.hs, Numeric/Units/Dimensional/QuantitiesTest.hs, Numeric/Units/Dimensional/ExtensibleTest.lhs, examples/README, examples/GM.lhs dimensional-0.13.0.2/LICENSE0000644000000000000000000000275612515414060013440 0ustar0000000000000000Copyright (c) 2006-2014, 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-0.13.0.2/README0000644000000000000000000000045712515414060013307 0ustar0000000000000000For documentation see the literate haskell source code. For project information (issues, updates, wiki, examples) see: http://code.google.com/p/dimensional/ To install (requires GHC 6.6 or later): runhaskell Setup.lhs configure runhaskell Setup.lhs build runhaskell Setup.lhs install dimensional-0.13.0.2/Setup.lhs0000644000000000000000000000011312515414060014224 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMaindimensional-0.13.0.2/Test.hs0000644000000000000000000000046512515414060013701 0ustar0000000000000000import qualified Numeric.Units.Dimensional.Test import qualified Numeric.Units.Dimensional.QuantitiesTest import qualified Numeric.Units.Dimensional.ExtensibleTest main = do Numeric.Units.Dimensional.Test.main Numeric.Units.Dimensional.QuantitiesTest.main Numeric.Units.Dimensional.ExtensibleTest.main dimensional-0.13.0.2/examples/0000755000000000000000000000000012515414060014237 5ustar0000000000000000dimensional-0.13.0.2/examples/GM.lhs0000644000000000000000000000533212515414060015255 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. {{{ > 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-0.13.0.2/examples/README0000644000000000000000000000011612515414060015115 0ustar0000000000000000See the project wiki at http://dimensional.googlecode.com for more examples. dimensional-0.13.0.2/Numeric/0000755000000000000000000000000012515414060014023 5ustar0000000000000000dimensional-0.13.0.2/Numeric/Units/0000755000000000000000000000000012515414060015125 5ustar0000000000000000dimensional-0.13.0.2/Numeric/Units/Dimensional.lhs0000644000000000000000000005663412515414060020115 0ustar0000000000000000Numeric.Dimensional -- Statically checked physical dimensions Bjorn Buckwalter, bjorn.buckwalter@gmail.com License: BSD3 = 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 boxing and unboxing 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)" [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 physicist cringe. He does not mind constructive criticism (or darcs patches). The sets of functions and units defined herein are incomplete and reflect only the author's needs to date. Again, patches are welcome. The author has elected to keep the module detached from the standard(?) Haskell library hierarchy. In part because the module name space layout seems to be an open issue and in part because he is unsure where to fit it in. = Preliminaries = This module requires GHC 6.6 or later. We utilize multi-parameter type classes, phantom types, functional dependencies and undecidable instances (and possibly additional unidentified GHC extensions). Clients of the module are generally not required to use these extensions. > {-# LANGUAGE UndecidableInstances > , ScopedTypeVariables > , EmptyDataDecls > , MultiParamTypeClasses > , FunctionalDependencies > , FlexibleInstances > , TypeSynonymInstances > , FlexibleContexts > , GeneralizedNewtypeDeriving > , DeriveDataTypeable > #-} > {- | > Copyright : Copyright (C) 2006-2013 Bjorn Buckwalter > License : BSD3 > > Maintainer : bjorn.buckwalter@gmail.com > Stability : Stable > Portability: GHC only? > > Please refer to the literate Haskell code for documentation of both API > and implementation. > -} > module Numeric.Units.Dimensional > -- TODO discriminate exports, in particular Variants and Dims. > where > import Prelude > ( Show, Eq, Ord, Enum, Num, Fractional, Floating, RealFloat, Functor, fmap > , (.), flip, show, (++), undefined, otherwise, (==), String, unwords > , map, foldr, null, Integer > ) > import qualified Prelude > import Data.List (genericLength) > import Data.Maybe (Maybe (Just, Nothing), catMaybes) > import Data.Typeable (Typeable) > import Numeric.NumType > ( NumType, NonZero, PosType, Zero, toNum, Sum > , Pos1, Pos2, pos2, Pos3, pos3 > ) > import qualified Numeric.NumType as N (Mul, Div) 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 +, - = Dimensional = 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. We call this data type 'Dimensional' to capture the notion that the units and quantities it represents have physical dimensions. > newtype Dimensional v d a = Dimensional a deriving (Eq, Ord, Enum, Typeable) The type variable 'a' is the only non-phantom type variable and represents the numerical value of a quantity or the scale (w.r.t. SI units) of a unit. For SI units the scale will always be 1. For non-SI units the scale is the ratio of the unit to the SI unit with the same physical dimension. Since 'a' is the only non-phantom type we were able to define 'Dimensional' as a newtype, avoiding boxing at runtime. = The variety 'v' of 'Dimensional' = The phantom type variable v is used to distinguish between units and quantities. It should be one of the following: > data DUnit deriving Typeable > data DQuantity deriving Typeable For convenience we define type synonyms for units and quantities. > type Unit = Dimensional DUnit > type Quantity = Dimensional DQuantity 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 [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. > (*~) :: Num a => a -> Unit d a -> Quantity d a > x *~ Dimensional y = Dimensional (x Prelude.* y) Conversely, the numerical value of a 'Quantity' is obtained by dividing the 'Quantity' by its 'Unit' (any unit with the same physical dimension). The '(/~)' operator provides a convenient way of obtaining the numerical value of a quantity. > (/~) :: Fractional a => Quantity d a -> Unit d a -> a > Dimensional x /~ Dimensional 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 *~, /~ = The dimension 'd' of 'Dimensional' = The phantom type variable d encompasses the physical dimension of the 'Dimensional'. As detailed in [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 type 'Dim'. > data Dim l m t i th n j deriving Typeable 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 We could have chosen to provide type variables for the seven base dimensions in 'Dimensional' instead of creating a new data type 'Dim'. 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. Using our 'Dim' data type we define some type synonyms for convenience and illustrative purposes. We start with the base dimensions. > 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 Using the above type synonyms we can define type synonyms for quantities of particular physical dimensions. Quantities with the base dimensions. > 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 = Arithmetic on physical dimensions = 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 multi-parameter type classes and functional dependences. Multiplication of dimensions corresponds to adding of the base dimensions' exponents. > class Mul d d' d'' | d d' -> d'' > instance (Sum l l' l'', > Sum m m' m'', > Sum t t' t'', > Sum i i' i'', > Sum th th' th'', > Sum n n' n'', > Sum j j' j'') => Mul (Dim l m t i th n j) > (Dim l' m' t' i' th' n' j') > (Dim l'' m'' t'' i'' th'' n'' j'') Division of dimensions corresponds to subtraction of the base dimensions' exponents. > class Div d d' d'' | d d' -> d'' > instance (Sum l l' l'', > Sum m m' m'', > Sum t t' t'', > Sum i i' i'', > Sum th th' th'', > Sum n n' n'', > Sum j j' j'') => Div (Dim l'' m'' t'' i'' th'' n'' j'') > (Dim l' m' t' i' th' n' j') > (Dim l m t i th n j) We could provide the 'Mul' and 'Div' classes with full functional dependencies but that would be of limited utility as there is no obvious use for "backwards" type inference and would also limit what we can achieve overlapping instances. (In particular, it breaks the 'Extensible' module.) We limit ourselves to integer powers of Dimensionals as fractional powers make little physical sense. Since the value of the exponent affects the type of the result the value of the exponent must be visible to the type system, therefore we will generally represent the exponent with a 'NumType'. Powers of dimensions corresponds to multiplication of the base dimensions' exponents by the exponent. > class (NumType x) => Pow d x d' | d x -> d' > instance (N.Mul l x l', > N.Mul m x m', > N.Mul t x t', > N.Mul i x i', > N.Mul th x th', > N.Mul n x n', > N.Mul j x j') => Pow (Dim l m t i th n j) x > (Dim l' m' t' i' th' n' j') Roots of dimensions corresponds to division of the base dimensions' exponents by order(?) of the root. > class (NonZero x) => Root d x d' | d x -> d' > instance (N.Div l x l', > N.Div m x m', > N.Div t x t', > N.Div i x i', > N.Div th x th', > N.Div n x n', > N.Div j x j') => Root (Dim l m t i th n j) x > (Dim l' m' t' i' th' n' j') = 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. > (*) :: (Num a, Mul d d' d'') > => Dimensional v d a -> Dimensional v d' a -> Dimensional v d'' a > Dimensional x * Dimensional y = Dimensional (x Prelude.* y) > (/) :: (Fractional a, Div d d' d'') > => Dimensional v d a -> Dimensional v d' a -> Dimensional v d'' a > Dimensional x / Dimensional y = Dimensional (x Prelude./ y) > (^) :: (Fractional a, Pow d n d') > => Dimensional v d a -> n -> Dimensional v d' a > Dimensional x ^ n = Dimensional (x Prelude.^^ (toNum n :: Integer)) In the unlikely case someone needs to use this library with non-fractional numbers we provide the alternative power operator '^+' that is restricted to positive exponents. > (^+) :: (Num a, PosType n, Pow d n d') > => Dimensional v d a -> n -> Dimensional v d' a > Dimensional x ^+ n = Dimensional (x Prelude.^ (toNum n :: Integer)) 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. > negate :: (Num a) => Quantity d a -> Quantity d a > negate (Dimensional x) = Dimensional (Prelude.negate x) > (+) :: (Num a) => Quantity d a -> Quantity d a -> Quantity d a > Dimensional x + Dimensional y = Dimensional (x Prelude.+ y) > (-) :: (Num a) => Quantity d a -> Quantity d a -> Quantity d a > x - y = x + negate y Absolute value. > abs :: (Num a) => Quantity d a -> Quantity d a > abs (Dimensional x) = Dimensional (Prelude.abs x) Roots of arbitrary (integral) degree. Appears to occasionally be useful for units as well as quantities. > nroot :: (Floating a, Root d n d') => n -> Dimensional v d a -> Dimensional v d' a > nroot n (Dimensional x) = Dimensional (x Prelude.** (1 Prelude./ toNum n)) We provide short-hands for the square and cubic roots. > sqrt :: (Floating a, Root d Pos2 d') => Dimensional v d a -> Dimensional v d' a > sqrt = nroot pos2 > cbrt :: (Floating a, Root d Pos3 d') => Dimensional v d a -> Dimensional v d' a > cbrt = nroot pos3 We also provide an operator alternative to nroot for those that prefer such. > (^/) :: (Floating a, Root d n d') => Dimensional v d a -> n -> Dimensional v d' a > (^/) = flip nroot = List functions = Here we define operators and functions to make working with homogenuous lists of dimensionals more convenient. We define two convenience operators for applying units to all elements of a functor (e.g. a list). > (*~~) :: (Functor f, Num a) => f a -> Unit d a -> f (Quantity d a) > xs *~~ u = fmap (*~ u) xs > (/~~) :: (Functor f, Fractional a) => f (Quantity d a) -> Unit d a -> f a > xs /~~ u = fmap (/~ u) xs > infixl 7 *~~, /~~ The sum of all elements in a list. > sum :: forall d a . Num a => [Quantity d a] -> Quantity d a > sum = foldr (+) _0 The length of the list as a 'Dimensionless'. This can be useful for purposes of e.g. calculating averages. > dimensionlessLength :: Num a => [Dimensional v d a] -> Dimensionless a > dimensionlessLength = Dimensional . genericLength = Dimensionless = For dimensionless quantities pretty much any operation is applicable. We provide this freedom by making 'Dimensionless' an instance of 'Functor'. > instance Functor Dimensionless where > fmap f (Dimensional x) = Dimensional (f x) 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 > :: (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 > (**) :: (Floating a) > => Dimensionless a -> Dimensionless a -> Dimensionless a > Dimensional x ** Dimensional y = Dimensional (x Prelude.** y) For 'atan2' the operands need not be dimensionless but they must be of the same type. The result will of course always be dimensionless. > atan2 :: (RealFloat a) > => Quantity d a -> Quantity d a -> Dimensionless a > atan2 (Dimensional y) (Dimensional x) = Dimensional (Prelude.atan2 y x) The only unit we will define in this module is 'one'. The unit one has dimension one and is the base unit of dimensionless values. As detailed in 7.10 "Values of quantities expressed simply as numbers: the unit one, symbol 1" of [1] the unit one generally does not appear in expressions. However, for us it is necessary to use 'one' as we would any other unit to perform the "boxing" of dimensionless values. > one :: Num a => Unit DOne a > one = Dimensional 1 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 as proposed by Douglas McClean (http://code.google.com/p/dimensional/issues/detail?id=39) allowing it to express zero Length or Capacitance or Velocity etc, in addition to the dimensionless value zero. > _0 :: (Num a) => Quantity d a > _0 = Dimensional 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 For background on 'tau' see http://tauday.com/tau-manifesto (but also feel free to review http://www.thepimanifesto.com). > pi, tau :: (Floating a) => Dimensionless a > pi = Prelude.pi *~ one > tau = _2 * pi = Instances of 'Show' = We will conclude by providing a reasonable 'Show' instance for quantities. We neglect units since it is unclear how to represent them in a way that distinguishes them from quantities, or whether that is even a requirement. > instance forall d a. (Show d, Show a) => Show (Quantity d a) where > show (Dimensional x) = show x ++ if (null unit) then "" else " " ++ unit > where unit = show (undefined :: d) The above implementation of 'show' relies on the dimension 'd' being an instance of 'Show'. The "normalized" unit of the quantity can be inferred from its dimension. > instance forall l m t i th n j. > ( NumType l > , NumType m > , NumType t > , NumType i > , NumType th > , NumType n > , NumType j > ) => Show (Dim l m t i th n j) where > show _ = (unwords . catMaybes) > [ dimUnit "m" (undefined :: l) > , dimUnit "kg" (undefined :: m) > , dimUnit "s" (undefined :: t) > , dimUnit "A" (undefined :: i) > , dimUnit "K" (undefined :: th) > , dimUnit "mol" (undefined :: n) > , dimUnit "cd" (undefined :: j) > ] The helper function 'dimUnit' defined next conditions a 'String' (unit) with an exponent, if appropriate. The reason we define 'dimUnit' at the top-level rather than in the where-clause is that it may be useful for users of the 'Extensible' module. > dimUnit :: (NumType n) => String -> n -> Maybe String > dimUnit u n > | x == 0 = Nothing > | x == 1 = Just u > | otherwise = Just (u ++ "^" ++ show x) > where x = toNum n :: Integer = The 'prefix' function = We will define a 'prefix' function which applies a scale factor to a unit. The 'prefix' function will be used by other modules to define the SI prefixes and non-SI units. > prefix :: (Num a) => a -> Unit d a -> Unit d a > prefix x (Dimensional y) = Dimensional (x Prelude.* y) = Conclusion and usage = 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 Prelude.Double ] v = 90 *~ (kilo meter / hour) It follows naturally that the numerical value of a quantity is obtained by division by a unit. ] numval :: Prelude.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 [1]. While the above syntax is fairly natural it is unfortunate that it must violate a number of the guidelines in [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 [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) The following is an example GHC session where the above function is used to calculate the escape velocity of Earth in kilometer per second. *Numeric.Dimensional> :set +t *Numeric.Dimensional> let me = 5.9742e24 *~ kilo gram -- Mass of Earth. me :: Quantity DMass GHC.Float.Double *Numeric.Dimensional> let re = 6372.792 *~ kilo meter -- Mean radius of Earth. re :: Quantity DLength GHC.Float.Double *Numeric.Dimensional> let ve = escapeVelocity me re -- Escape velocity of Earth. ve :: Velocity GHC.Float.Double *Numeric.Dimensional> ve /~ (kilo meter / second) 11.184537332296259 it :: GHC.Float.Double 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. ] x = 1 *~ meter + 1 *~ second Couldn't match expected type `Pos1' against inferred type `Zero' Expected type: Unit DLength t Inferred type: Unit 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. ] x = 1 *~ meter / (1 *~ second) + 1 *~ kilo gram Couldn't match expected type `Zero' against inferred type `Neg Zero' When using functional dependencies to combine Sub Zero (Pos Zero) (Neg Zero), arising from use of `/' at Numeric/Dimensional.lhs:425:9-20 Sub Zero (Pos Zero) Zero, arising from use of `/' at Numeric/Dimensional.lhs:532:5-30 It is the author's experience that the usefullness of the compiler error messages is more often than not limited to pinpointing the location of errors. = Future work = While there is an insane amount of units in use around the world it is reasonable to provide at least all SI units. Units outside of SI will most likely be added on an as-needed basis. There are also plenty of elementary functions to add. The 'Floating' class can be used as reference. Another useful addition would be decent 'Show' and 'Read' instances. The 'show' implementation could output the numerical value and the unit expressed in (base?) SI units, along the lines of: ] instance (Fractional a, Show a) => Show (Length a) ] where show x = show (x /~ meter) ++ " m" Additional functions could be provided for "showing" with any unit and prefix. The 'read' implementation should be able to read values with any unit and prefix. It is not clear to the author how to best implement these. Additional physics models could be implemented. See [3] for ideas. = Related work = Henning Thielemann 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 [4] to these. Also see Samuel Hoffstaetter's blog post [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 [6] and the Fortress programming language [7] particularly noteworthy. = References = [1] http://physics.nist.gov/Pubs/SP811/ [2] http://en.wikipedia.org/wiki/Escape_velocity [3] http://jscience.org/api/org/jscience/physics/models/package-summary.html [4] http://www.haskell.org/haskellwiki/Physical_units [5] http://liftm.wordpress.com/2007/06/03/scientificdimension-type-arithmetic-and-physical-units-in-haskell/ [6] http://jscience.org/ [7] http://research.sun.com/projects/plrg/fortress.pdf dimensional-0.13.0.2/Numeric/Units/Dimensional/0000755000000000000000000000000012515414060017367 5ustar0000000000000000dimensional-0.13.0.2/Numeric/Units/Dimensional/CGS.lhs0000644000000000000000000002673612515414060020531 0ustar0000000000000000Numeric.Dimensional.CGS -- CGS system of units Bjorn Buckwalter, bjorn.buckwalter@gmail.com License: BSD3 !!! EXPERIMENTAL !!! = Introduction = This module was prompted by an email from Chuck Blake[1]. He asked if the Dimensional library could support other systems of units than SI, in particular systems such as the centimeter-gram-second (CGS) system where fractional exponents of dimensions occur. He also wondered whether it was possible to convert quantities between different systems while statically ensuring that a given conversion was valid. In this module we show that we can in a straight forward manner support systems with rational exponents, provided that the rationals that may be encountered are known a priori. As an example we provide a rudimentary implementation of the CGS system. We also show that we can indeed statically prohibit invalid conversions between different systems. = Caveats = I'm ignorantly assuming that when working with the CGS (or MKS) system you will only (meaningfully?) encounter half-exponents and only of the length and mass dimensions. Of course, in other systems other rational exponents may be encountered. I am also assuming that the CGS system would not be employed when working with temperature, amount or luminosity. This is evident in the below type signatures where I have assumed zero extent in the temperature, amount and luminosity dimensions. If this is incorrect I would appreciate pointers to the CGS representation of these dimensions. Please correct and inform me if my assumptions are wrong! = Preliminaries = > {-# LANGUAGE UndecidableInstances > , ScopedTypeVariables > , EmptyDataDecls > , MultiParamTypeClasses > , FlexibleInstances > , FlexibleContexts > #-} > {-# OPTIONS_GHC -fcontext-stack=30 #-} > {- | > Copyright : Copyright (C) 2006-2013 Bjorn Buckwalter > License : BSD3 > > Maintainer : bjorn.buckwalter@gmail.com > Stability : Experimental > Portability: GHC only? > > Please refer to the literate Haskell code for documentation of both API > and implementation. > -} > module Numeric.Units.Dimensional.CGS where > import Prelude > ( undefined, Num, Fractional, Floating, Show, recip, Double, unwords, (.) ) > import qualified Prelude > import Numeric.Units.Dimensional hiding ( DLength, DMass, DTime, DElectricCurrent ) > import Numeric.Units.Dimensional.Quantities as SIQ > import qualified Numeric.Units.Dimensional.SIUnits as SI > import qualified Numeric.NumType as N > import Numeric.NumType ( Neg2, Neg1, Zero, Pos1, Pos2, Pos3, NumType ) > import Numeric.NumType ( neg2, pos2, pos3 ) > import Data.Maybe (catMaybes) = Dimensions = Analogously with the SI we collect the base dimensions of the CGS system in the data type 'CGSDim'. > data CGSDim lh mh t In the above 'lh' and 'mh' represent the number of half-exponents of length and mass respectively while 't' represents the number of whole-exponents. The base dimensions illustrate this. > type DLength = CGSDim Pos2 Zero Zero > type DMass = CGSDim Zero Pos2 Zero > type DTime = CGSDim Zero Zero Pos1 We add a few non-base dimensions for the sake of example. Charge is particularly interesting as it illustrates the need for half-exponents as described in [2]. > type DElectricCurrent = CGSDim Pos3 Pos1 Neg2 > type DCharge = CGSDim Pos3 Pos1 Neg1 = 'Mul', 'Div', 'Pow' and 'Root' instances = The 'Mul', 'Div', 'Pow' and 'Root' instances are strictly analogous with the SI. > instance ( N.Sum lh lh' lh'' > , N.Sum mh mh' mh'' > , N.Sum t t' t'' ) => Mul (CGSDim lh mh t) > (CGSDim lh' mh' t') > (CGSDim lh'' mh'' t'') > instance ( N.Sum lh lh' lh'' > , N.Sum mh mh' mh'' > , N.Sum t t' t'' ) => Div (CGSDim lh'' mh'' t'') > (CGSDim lh' mh' t') > (CGSDim lh mh t) > instance ( N.Mul lh x lh' > , N.Mul mh x mh' > , N.Mul t x t' ) => Pow (CGSDim lh mh t) x > (CGSDim lh' mh' t') > instance ( N.Div lh x lh' > , N.Div mh x mh' > , N.Div t x t' ) => Root (CGSDim lh mh t) x > (CGSDim lh' mh' t') = Units = We define the base units of the system. By defining 'meter' with a "scale" of 100 we get a scale of one for 'centi meter'. > meter :: Num a => Unit DLength a > meter = Dimensional 100 > gram :: Num a => Unit DMass a > gram = Dimensional 1 > second :: Num a => Unit DTime a > second = Dimensional 1 We continue by defining the CGS equivalents of the other base SI units. Actually we limit ourselves to 'ampere' since I am not sure if or how the SI base dimensions other than current are expressed in CGS. > ampere :: Floating a => Unit DElectricCurrent a > ampere = prefix (recip 3.33564e-10) ((SI.centi meter ^ pos3) ^/ pos2 * gram ^/ pos2 * second ^ neg2) We also define the preferred CGS unit for charge. > franklin :: Floating a => Unit DCharge a -- Also known as "esu". > franklin = gram ^/ pos2 * (SI.centi meter ^ pos3) ^/ pos2 / second = Conversion from SI = At some point we may wish to convert an SI quantity to a CGS quantity or vice versa. In order to convert a 'Quantity' from the SI system to the CGS system we use the strategy of dividing the quantity by the SI base unit and multiplying the resulting number (sans dimension) by the equivalent CGS unit. To realize this strategy we must be able to obtain the SI base unit and the equivalent CGS unit for a given quantity. We start with the SI unit since it is trivial. > unit_SI :: Num a => Quantity (Dim l m t i th n j) a -> Unit (Dim l m t i th n j) a > unit_SI _ = Dimensional 1 (Perhaps the above function would be better defined in another module.) Obtaining the CGS unit corresponding to the SI base unit of a Quantity isn't quite as trivial. The function body itself is straight-forward enough, the hairy part is the type signature. > unit_CGS :: forall a l m t i l2 m2 il it l' m' t'. > ( Floating a > , N.Mul Zero l Zero, N.Mul Pos2 l l2 > , N.Mul Zero m Zero, N.Mul Pos2 m m2 > , N.Mul Zero t Zero, N.Mul Pos1 t t > , N.Sum l2 Zero l2 > , N.Sum Zero m2 m2, N.Sum m2 Zero m2 > , N.Sum Zero t t > , N.Mul Pos3 i il > , N.Mul Pos1 i i > , N.Mul Neg2 i it > , N.Sum l2 il l' > , N.Sum m2 i m' > , N.Sum t it t' > ) => Quantity (Dim l m t i Zero Zero Zero) a -> Unit (CGSDim l' m' t') a > unit_CGS _ = meter ^ (undefined :: l) > * SI.kilo gram ^ (undefined :: m) > * second ^ (undefined :: t) > * ampere ^ (undefined :: i) Note that since the base dimensions of the CGS are a subset of those of the SI the mapping of types from SI to CGS is unambiguous. Also note that complex as the type signature may be producing it is a mostly mechanical process. With the above two functions we can define the function that converts a unit from the SI. We omit the type signature since it is hairy but can be readily inferred. > fromSI x = x /~ unit_SI x *~ unit_CGS x = Conversion to SI = We use the same strategy to convert from CGS to SI. However, when converting from CGS to SI there may be several valid SI dimensionalities for any given CGS dimensionality. We will handle this ambiguity by requiring the user to specify the desired type (except when it is inferable) of the resulting quantity. For example: ] toSI (3.2 *~ centi meter) :: Length Double In order to do this we must employ lexically scoped type variables and provide the hairy type signature for the 'toSI' function. > toSI :: forall a l m t i l2 m2 il it l' m' t'. > ( Floating a > , N.Mul Zero l Zero, N.Mul Pos2 l l2 > , N.Mul Zero m Zero, N.Mul Pos2 m m2 > , N.Mul Zero t Zero, N.Mul Pos1 t t > , N.Sum l2 Zero l2 > , N.Sum Zero m2 m2, N.Sum m2 Zero m2 > , N.Sum Zero t t > , N.Mul Pos3 i il > , N.Mul Pos1 i i > , N.Mul Neg2 i it > , N.Sum l2 il l' > , N.Sum m2 i m' > , N.Sum t it t' > ) => Quantity (CGSDim l' m' t') a -> Quantity (Dim l m t i Zero Zero Zero) a > toSI x = x /~ unit_CGS (undefined :: Quantity (Dim l m t i Zero Zero Zero) a) > *~ unit_SI (undefined :: Quantity (Dim l m t i Zero Zero Zero) a) Again, the type signature is complex but deriving it is a mechanical process. = 'Show' instance = We round off by writing 'Show' instance for 'CGSDim' analogous to that of 'Dim'. Out of laziness we use the notation "sqrt(cm)" to represent halves of integral dimensions. Nothing is technically keeping us from doing a better job here. > instance forall lh mh t. > ( NumType lh > , NumType mh > , NumType t > ) => Show (CGSDim lh mh t) where > show _ = (unwords . catMaybes) > [ dimUnit "sqrt(cm)" (undefined :: lh) > , dimUnit "sqrt(g)" (undefined :: mh) > , dimUnit "s" (undefined :: t) > ] = Examples = Let us try the Coulomb attraction example from [2]. We start by performing the calculation in the SI. > q_si = 1.6021773e-19 *~ SI.coulomb -- Elementary charge in SI. > r_si = 0.1 *~ SI.nano SI.meter -- Distance in SI > f_si = q_si ^ pos2 / (_4 * pi * e0 * r_si ^ pos2) > where > e0 = 8.8541878e-12 *~ (SI.ampere * SI.second / (SI.volt * SI.meter)) The same calculation in the CGS system. > q_cgs = fromSI q_si -- Elementary charge in CGS. > r_cgs = fromSI r_si -- Distance in CGS > f_cgs = q_cgs ^ pos2 / r_cgs ^ pos2 Inspecting the values in GHCi shows us that the results are consistent (within reasonable accuracy) with [2]. *Numeric.Dimensional.CGS> f_si 2.3070794737101255e-8 m kg s^-2 *Numeric.Dimensional.CGS> f_cgs 2.30708078598602e-3 sqrt(cm)^2 sqrt(g)^2 s^-2 To convert from CGS to SI we must specify the type of the SI 'Quantity'. > f_si' = toSI f_cgs :: SIQ.Force Double *Numeric.Dimensional.CGS> f_si' 2.3070807859860202e-8 m kg s^-2 We follow up with another conversion example demonstrating the ambiguity in the conversion from CGS to SI. > c = 1 *~ SI.farad -- A SI capacitance. > c_cgs = fromSI c -- Capacitance has dimensionality L in CGS. > c' = toSI c_cgs :: SIQ.Capacitance Double > c'' = toSI c_cgs :: Length Double *Numeric.Dimensional.CGS> c 1.0 m^-2 kg^-1 s^4 A^2 *Numeric.Dimensional.CGS> c_cgs 8.98755691740885e11 sqrt(cm)^2 *Numeric.Dimensional.CGS> c' 1.0 m^-2 kg^-1 s^4 A^2 *Numeric.Dimensional.CGS> c'' 8.98755691740885e9 m = Future work = This is a very rudimentary implementation. To make it more practical a significant number of quantities and units, in particularly those commonly used with the CGS, would need to be added. In the mean time all units defined for the SI can be used with the CGS by applying 'fromSI' to quantities defined from the SI units. If anyone is willing to add quantities/units (or other enhancements) I will happily to accept patches. Personally I do not expect to use this module and therefore do not intend to invest much more time in it. If the module has other users I might reconsider. And of course, another direction of future work is to define additional systems (e.g. natural, relativistic) using this module as a template. I imagine this should be fairly straight forward. = References = [1] http://code.google.com/p/dimensional/wiki/ChuckBlake20070611 [2] http://www.tf.uni-kiel.de/matwis/amat/mw1_ge/kap_2/basics/b2_1_14.html dimensional-0.13.0.2/Numeric/Units/Dimensional/Extensible.lhs0000644000000000000000000001470712515414060022212 0ustar0000000000000000Numeric.Dimensional.Extensible -- Extensible physical dimensions Bjorn Buckwalter, bjorn.buckwalter@gmail.com License: BSD3 = Summary = On January 3 Mike Gunter asked[1]: The very nice Buckwalter and Denney dimensional-numbers packages both work on a fixed set of base dimensions. This is a significant restriction for me--I want to avoid adding apples to oranges as well as avoiding adding meters to grams. Is it possible to have an extensible set of base dimensions? If so, how usable can such a system be made? Is it very much worse than a system with a fixed set of base dimensions? In this module we facilitate the addition an arbitrary number of "extra" dimensions to the seven base dimensions defined in 'Numeric.Dimensional'. A quantity or unit with one or more extra dimensions will be referred to as an "extended Dimensional". = Preliminaries = Similarly with 'Numeric.Dimensional' this module requires GHC 6.6 or later. > {-# LANGUAGE UndecidableInstances > , ScopedTypeVariables > , EmptyDataDecls > , MultiParamTypeClasses > , FunctionalDependencies > , FlexibleInstances > #-} > {- | > Copyright : Copyright (C) 2006-2013 Bjorn Buckwalter > License : BSD3 > > Maintainer : bjorn.buckwalter@gmail.com > Stability : Experimental > Portability: GHC only? > > Please refer to the literate Haskell code for documentation of both API > and implementation. > -} > module Numeric.Units.Dimensional.Extensible ( DExt, showDExt ) where > import Numeric.Units.Dimensional ( Dim, Mul, Div, Pow, Root, dimUnit ) > import Numeric.NumType ( NumType, Sum, Negate, Zero, Pos, Neg ) > import qualified Numeric.NumType as N ( Div, Mul ) = 'DExt', 'Apples' and 'Oranges' = We define the datatype 'DExt' which we will use to increase the number of dimensions from the seven SI base dimensions to an arbitrary number of dimensions. > data DExt a n d The type variable 'a' is used to tag the extended dimensions with an identity, thus preventing inadvertent mixing of extended dimensions. Using 'DExt' we can define type synonyms for extended dimensions applicable to our problem domain. For example, Mike Gunter could define the 'Apples' and 'Oranges' dimensions and the corresponding quantities. ] data TApples -- Type tag. ] type DApples = DExt TApples Pos1 DOne ] type Apples = Quantity DApples ] data TOrange -- Type tag. ] type DOranges = DExt TApples Zero (DExt TOranges Pos1 DOne) ] type Oranges = Quantity DOranges And while he was at it he could define corresponding units. ] apple :: Num a => Unit DApples a ] apple = Dimensional 1 ] orange :: Num a => Unit DOranges a ] orange = Dimensional 1 When extending dimensions we adopt the convention that the first (outermost) dimension is the reference for aligning dimensions, as shown in the above example. This is important when performing operations on two Dimensionals with a differing number of extended dimensions. = 'Show' helper function = We provide a helper function to ease defining 'Show' instances. > showDExt :: forall a n d. (NumType n, Show d) => String -> DExt a n d -> String > showDExt u _ = showHelp (dimUnit u (undefined :: n)) (show (undefined :: d)) > where > showHelp Nothing s = s > showHelp (Just u') "" = u' > showHelp (Just u') s = u' ++ " " ++ s Using this helper function defining 'Show' instances for the dimensions with extent in apples and oranges is simple. ] instance (NumType n, Show d) => Show (DExt TApples n d) where ] show = showDExt "apple" ] instance (NumType n, Show d) => Show (DExt TOranges n d) where ] show = showDExt "orange" = The 'DropZero' class = The choice of convention may seem backwards considering the opposite convention is used for NumTypes (though for NumTypes the distinction is arguably irrelevant). However, this choice facilitates relatively simple interoperability with base dimensions. In particular it lets us drop any dimensions with zero extent adjacent to the terminating 'Dim'. To capture this property we define the 'DropZero' class. > class DropZero d d' | d -> d' The following 'DropZero' instances say that when an extended dimension with zero extent is next to a 'Dim' the extended dimension can be dropped. In all other cases the dimensions are retained as is. > instance DropZero (DExt a Zero (Dim l m t i th n j)) (Dim l m t i th j j) > instance DropZero (DExt a Zero (DExt a' n d)) (DExt a Zero (DExt a' n d)) > instance DropZero (DExt a (Pos n) d) (DExt a (Pos n) d) > instance DropZero (DExt a (Neg n) d) (DExt a (Neg n) d) = Classes from 'Numeric.Dimensional' = We get negation, addition and subtraction for free with extended Dimensionals. However, we will need instances of the 'Mul', 'Div', 'Pow' and 'Root' classes for the corresponding operations to work. Multiplication and division can cause dimensions to be eliminated. We use the 'DropZero' type class to guarantee that the result of a multiplication or division has a minimal representation. When only one of the 'Mul' factors is an extended dimensional there is no need to minimize. > instance (Mul d (Dim l m t i th n j) d') > => Mul (DExt a x d) (Dim l m t i th n j) (DExt a x d') > instance (Mul (Dim l m t i th n j) d d') > => Mul (Dim l m t i th n j) (DExt a x d) (DExt a x d') If both of the factors are extended the product must be minimized. > instance (Sum n n' n'', Mul d d' d'', DropZero (DExt a n'' d'') d''') > => Mul (DExt a n d) (DExt a n' d') d''' Analogously for 'Div'. > instance (Div d (Dim l m t i th n j) d') > => Div (DExt a x d) (Dim l m t i th n j) (DExt a x d') > instance (Div (Dim l m t i th n j) d d', Negate x x') > => Div (Dim l m t i th n j) (DExt a x d) (DExt a x' d') > instance (Sum n'' n' n, Div d d' d'', DropZero (DExt a n'' d'') d''') > => Div (DExt a n d) (DExt a n' d') d''' The instances for 'Pow' and 'Root' are simpler since they can not change any previously non-zero to be eliminated. > instance (N.Mul n x n', Pow d x d') => Pow (DExt a n d) x (DExt a n' d') > instance (N.Div n x n', Root d x d') => Root (DExt a n d) x (DExt a n' d') = Note = The use of 'DExt' is not particularily modular. Exrended dimensions must adhere to a strict ordering in order to be compatible in terms of e.g. multiplication. This makes it difficult to add extra dimensions without full knowledge of all extra dimension one will be interacting with. = References = [1] http://www.haskell.org/pipermail/haskell-cafe/2007-January/021069.html dimensional-0.13.0.2/Numeric/Units/Dimensional/ExtensibleTest.lhs0000644000000000000000000000451612515414060023047 0ustar0000000000000000> {-# LANGUAGE EmptyDataDecls, FlexibleInstances #-} > module Numeric.Units.Dimensional.ExtensibleTest where > import Numeric.Units.Dimensional.Prelude > import Numeric.Units.Dimensional.Extensible > import Numeric.Units.Dimensional ( Dimensional (Dimensional), dimUnit ) > import Numeric.NumType ( NumType, Zero, Pos1, Neg1 ) > import Test.HUnit > import qualified Prelude = Setting up the problem domain = For testing we will use apples, oranges and peaches. We define the type tags and show instances for each. > data TApples -- Type tag. > type DApples = DExt TApples Pos1 DOne > type Apples = Quantity DApples > data TOranges -- Type tag. > type DOranges = DExt TApples Zero (DExt TOranges Pos1 DOne) > type Oranges = Quantity DOranges > data TPeaches -- Type tag. > type DPeaches = DExt TApples Zero (DExt TOranges Zero (DExt TPeaches Pos1 DOne)) > type Peaches = Quantity DPeaches Define show instances. > instance (NumType n, Show d) => Show (DExt TApples n d) where > show = showDExt "apple" > instance (NumType n, Show d) => Show (DExt TOranges n d) where > show = showDExt "orange" > instance (NumType n, Show d) => Show (DExt TPeaches n d) where > show = showDExt "peaches" Finally the base units. > apple :: Num a => Unit DApples a > apple = Dimensional 1 > orange :: Num a => Unit DOranges a > orange = Dimensional 1 > peach :: Num a => Unit DPeaches a > peach = Dimensional 1 = Test values = > a = 1 *~ apple > o = 2 *~ orange > m = 3 *~ meter > p = 4 *~ peach = Stuff we expect to compile = > f = a / o * p > f' = a * o > f'' = m / a > foo1 :: Quantity (DExt TApples Pos1 (DExt TOranges Neg1 (DLength))) Double > foo1 = a / o * m > foo2 :: Double > foo2 = a * m / a /~ meter > foo3 :: Length Double > foo3 = a * m / a + m Finally a HUnit test case. > testShow = TestLabel "Test 'Show' instance" $ TestList > [ TestCase $ show (1 *~ apple) @?= "1 apple" > , TestCase $ show (2 *~ orange) @?= "2 orange" > , TestCase $ show (2.0 *~ (apple / second)) @?= "2.0 apple s^-1" > , TestCase $ show (2.0 *~ (meter ^ pos2 / peach ^ pos2)) @?= "2.0 peaches^-2 m^2" > , TestCase $ show (2.0 *~ (apple ^ pos2 / peach ^ pos2)) @?= "2.0 apple^2 peaches^-2" > , TestCase $ show (undefined :: DApples) @?= "apple" > ] Main function. > main = do > putStrLn "If I compiled I'm mostly OK!" > runTestTT $ TestList [testShow] dimensional-0.13.0.2/Numeric/Units/Dimensional/NonSI.lhs0000644000000000000000000001334712515414060021075 0ustar0000000000000000Numeric.Dimensional.NonSI Bjorn Buckwalter, bjorn.buckwalter@gmail.com License: BSD3 = Summary = This module defines units that are not part of the SI, with the exception of those defined in the 'SIUnits' module (units outside of the SI accepted for use with the SI). Any chapters, sections or tables referenced are from [1] unless otherwise specified. > {- | > Copyright : Copyright (C) 2006-2013 Bjorn Buckwalter > License : BSD3 > > Maintainer : bjorn.buckwalter@gmail.com > Stability : Stable > Portability: GHC only? > > Please refer to the literate Haskell code for documentation of both API > and implementation. > -} > module Numeric.Units.Dimensional.NonSI where > import Numeric.Units.Dimensional.Prelude > import qualified Prelude = 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. = Table 7 = "Units accepted for use with the SI whose values in SI units are obtained experimentally." When [1] was published The electronvolt 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 :: Fractional a => Unit DEnergy a > electronVolt = prefix 1.60217733e-19 joule > unifiedAtomicMassUnit :: Fractional a => Unit DMass a > unifiedAtomicMassUnit = prefix 1.6605402e-27 (kilo gram) = Standard gravity = In order to relate e.g. pounds mass to pounds force we define the unit 'gee' equal to the standard gravity g_0: the nominal acceleration of a body in free fall in a vacuum near the surface of the earth (note that local values of acceleration due to gravity will differ from the standard gravity). I.e. g_0 = 1 gee. > gee :: Fractional a => Unit DAcceleration a > gee = prefix 9.80665 meter / second ^ pos2 = Inch-pound units = Some US customary (that is, inch-pound) units. > inch, foot, mil :: Fractional a => Unit DLength a > inch = prefix 2.54 (centi meter) > foot = prefix 12 inch -- 0.3048 m > mil = prefix 0.001 inch > poundMass, ounce :: Fractional a => Unit DMass a > poundMass = prefix 0.45359237 (kilo gram) > ounce = prefix (1 Prelude./ 16) poundMass > poundForce :: Fractional a => Unit DForce a > poundForce = poundMass * gee -- 4.4482 N Pounds of force per square inch. > psi :: Fractional a => Unit DPressure a > psi = poundForce / inch ^ pos2 = Various other (non inch-pound) units = > yard, mile, nauticalMile :: (Fractional a) => Unit DLength a > yard = prefix 3 foot > mile = prefix 1760 yard > nauticalMile = prefix 1852 meter > revolution :: (Floating a) => Unit DOne a > revolution = prefix (2 Prelude.* Prelude.pi) radian > solid :: (Floating a) => Unit DOne a > solid = prefix (4 Prelude.* Prelude.pi) steradian > teaspoon :: (Fractional a) => Unit DVolume a > teaspoon = prefix 5 (milli liter) The IAU recommends[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 (31.5576 Ms) unless otherwise specified. This aligns well with my needs so I'm happy to oblige. We define the year in terms of seconds in order to avoid a 'Fractional' constraint, and also provide a Julian century. > year, century :: Num a => Unit DTime a > year = prefix 31557600 second > century = prefix 100 year = Pressure units = Psi was defined earlier. > bar :: (Fractional a) => Unit DPressure a > bar = prefix 1.0e5 pascal From Wikipedia[3]: The standard atmosphere (atm) is an established constant. It is approximately equal to typical air pressure at earth mean sea level. > atmosphere :: (Fractional a) => Unit DPressure a > atmosphere = prefix 101325 pascal From Wikipedia: A technical atmosphere (symbol: at) is a non-SI unit of pressure equal to one kilogram-force per square centimeter. > technicalAtmosphere :: (Fractional a) => Unit DPressure a > technicalAtmosphere = kilo gram * gee * centi meter ^ neg2 Manometric pressure units: Per Wikipedia[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. > mmHg :: (Fractional a) => Unit DPressure a > mmHg = prefix 13.5951 gram * centi meter ^ neg3 * milli meter * gee One torr (symbol: Torr) is defined as 1/760 atm, which is approximately equal to 1 mmHg. > torr :: (Fractional a) => Unit DPressure a > torr = prefix (1 Prelude./ 760) atmosphere = Radiation = > rad :: (Fractional a) => Unit DAbsorbedDose a > rad = centi gray = Kinematic Viscosity = > stokes :: (Fractional a) => Unit DKinematicViscosity a > stokes = centi meter ^ pos2 / second = Imperial Volumes = Per http://en.wikipedia.org/wiki/Imperial_units. > imperialGallon, imperialQuart, imperialPint, imperialCup, > imperialGill, imperialFluidOunce > :: (Fractional a) => Unit DVolume a > imperialGallon = prefix 4.54609 liter > imperialQuart = prefix (1 Prelude./ 4) imperialGallon > imperialPint = prefix (1 Prelude./ 8) imperialGallon > imperialCup = prefix 0.5 imperialPint > imperialGill = prefix (1 Prelude./ 4) imperialPint > imperialFluidOunce = prefix (1 Prelude./ 20) imperialPint = References = [1] http://physics.nist.gov/Pubs/SP811/ [2] http://www.iau.org/science/publications/proceedings_rules/units/ [3] http://en.m.wikipedia.org/wiki/Pressure [4] http://en.m.wikipedia.org/wiki/Torr dimensional-0.13.0.2/Numeric/Units/Dimensional/Prelude.hs0000644000000000000000000000142512515414060021325 0ustar0000000000000000module Numeric.Units.Dimensional.Prelude ( module Numeric.Units.Dimensional , module Numeric.Units.Dimensional.Quantities , module Numeric.Units.Dimensional.SIUnits , module Numeric.NumType , module Prelude ) where import Numeric.Units.Dimensional hiding ( Dimensional (Dimensional) ) import Numeric.Units.Dimensional.Quantities import Numeric.Units.Dimensional.SIUnits import Numeric.NumType ( neg5, neg4, neg3, neg2, neg1, zero, pos1, pos2, pos3, pos4, pos5 ) -- Used in exponents. import Prelude hiding ( (+), (-), (*), (/), (^), (**) , abs, negate, pi, exp, log, sqrt , sin, cos, tan, asin, acos, atan, atan2 , sinh, cosh, tanh, asinh, acosh, atanh , sum ) -- Hide definitions overridden by 'Numeric.Dimensional'. dimensional-0.13.0.2/Numeric/Units/Dimensional/Quantities.lhs0000644000000000000000000002636012515414060022234 0ustar0000000000000000Numeric.Dimensional.Quantities Bjorn Buckwalter, bjorn@buckwalter.se License: BSD3 = 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. > {- | > Copyright : Copyright (C) 2006-2014 Bjorn Buckwalter > License : BSD3 > > Maintainer : bjorn@buckwalter.se > Stability : Stable > Portability: GHC only? > > Please refer to the literate Haskell code for documentation of both API > and implementation. > -} > module Numeric.Units.Dimensional.Quantities where > import Numeric.Units.Dimensional > ( Dim, Quantity, Dimensionless > , DOne, DLuminousIntensity, DThermodynamicTemperature > , Unit, DLength, (^+) -- Used only for 'square' and 'cubic'. > ) > import Numeric.NumType > ( Neg3, Neg2, Neg1, Zero, Pos1, Pos2, Pos3, Pos4 > , pos2, pos3 -- Used only for 'square' and 'cubic'. > ) = Quantities from [1] = The following quantities are all from the NIST publication "Guide for the Use of the International System of Units (SI)" [1]. Any chapters, sections or tables referenced are from [1] unless otherwise specified. For lack of better organization we provide definitions grouped by table in [1]. == Table 2 == "Examples of SI derived units expressed in terms of SI base units." > 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 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 AmountOfSubstanceConcentration = Quantity DAmountOfSubstanceConcentration > type Concentration = AmountOfSubstanceConcentration -- Short name. > type DLuminance = Dim Neg2 Zero Zero Zero Zero Zero Pos1 > type Luminance = Quantity DLuminance === 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 [1]). > square :: (Num a) => Unit DLength a -> Unit DArea a > square x = x ^+ pos2 > cubic :: (Num a) => Unit DLength a -> Unit DVolume a > cubic x = x ^+ pos3 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 'DLength' and 'DVolume'. == Table 3a == "SI derived units with special names and symbols, including the radian and steradian." > 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 == Table 3b == "SI derived units with special names and symbols admitted for reasons of safeguarding human health" > 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 == Table 4 == "Examples of SI 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 3b. > 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 = Quantities not defined in [1] = 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 DMassFlow = Dim Zero Pos1 Neg1 Zero Zero Zero Zero > type MassFlow = Quantity DMassFlow > 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 > 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 = References = [1] http://physics.nist.gov/Pubs/SP811/ dimensional-0.13.0.2/Numeric/Units/Dimensional/QuantitiesTest.hs0000644000000000000000000000477212515414060022723 0ustar0000000000000000module Numeric.Units.Dimensional.QuantitiesTest where import Numeric.Units.Dimensional.Prelude import qualified Prelude -- 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) -- Tables 3a and 3b are implicitely tested by the corresponding -- unit definitions. -- Verification of table 4. If the definitions compile the type -- synonyms are good. y1 :: AngularVelocity Double y1 = 1 *~ (radian / second) y2 :: AngularAcceleration Double y2 = 1 *~ (radian / second ^ pos2) y3 :: DynamicViscosity Double y3 = 1 *~ (pascal * second) y4 :: MomentOfForce Double y4 = 1 *~ (newton * meter) y5 :: SurfaceTension Double y5 = 1 *~ (newton / meter) y6 :: HeatFluxDensity Double y6 = 1 *~ (watt / meter ^ pos2) y7 :: RadiantIntensity Double y7 = 1 *~ (watt / steradian) y8 :: Radiance Double y8 = 1 *~ (watt / (meter ^ pos2 * steradian)) y9 :: HeatCapacity Double y9 = 1 *~ (joule / kelvin) y10 :: SpecificHeatCapacity Double y10 = 1 *~ (joule / (kilo gram * kelvin)) y11 :: ThermalConductivity Double y11 = 1 *~ (watt / (meter * kelvin)) y12 :: EnergyDensity Double y12 = 1 *~ (joule / meter ^ pos3) y13 :: ElectricFieldStrength Double y13 = 1 *~ (volt / meter) y14 :: ElectricChargeDensity Double y14 = 1 *~ (coulomb / meter ^ pos3) y15 :: ElectricFluxDensity Double y15 = 1 *~ (coulomb / meter ^ pos2) y16 :: Permittivity Double y16 = 1 *~ (farad / meter) y17 :: Permeability Double y17 = 1 *~ (henry / meter) y18 :: MolarEnergy Double y18 = 1 *~ (joule / mole) y19 :: MolarEntropy Double y19 = 1 *~ (joule / (mole * kelvin)) y20 :: Exposure Double y20 = 1 *~ (coulomb / kilo gram) y21 :: AbsorbedDoseRate Double y21 = 1 *~ (gray / second) -- Other quantitites. mu :: GravitationalParameter Double mu = 398600.4418 *~ (kilo meter ^ pos3 / second ^ pos2) -- Dummy main function. main = Prelude.putStrLn "If I compiled I'm OK!" dimensional-0.13.0.2/Numeric/Units/Dimensional/SIUnits.lhs0000644000000000000000000002243112515414060021437 0ustar0000000000000000Numeric.Dimensional.SIUnits Bjorn Buckwalter, bjorn.buckwalter@gmail.com License: BSD3 = 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 [1] unless otherwise specified. > {- | > Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter > License : BSD3 > > Maintainer : bjorn.buckwalter@gmail.com > Stability : Stable > Portability: GHC only? > > Please refer to the literate Haskell code for documentation of both API > and implementation. > -} > module Numeric.Units.Dimensional.SIUnits where > import Numeric.Units.Dimensional > import Numeric.Units.Dimensional.Quantities > import Numeric.NumType ( neg1, neg2, pos2, pos3 ) > import Data.Time.Clock (DiffTime) > import Prelude ( (.), Num, Real (toRational), Fractional (fromRational), Floating, recip ) > import qualified Prelude = SI prefixes (section 4.4) = Prefixes are used to form decimal multiples and submultiples of SI Units as described in section 4.4. We will define the SI prefixes in terms of the 'prefix' function which applies a scale factor to a unit. We define all SI prefixes from Table 5. Multiples first. > deka, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta > :: Num a => Unit d a -> Unit d a > deka = prefix 10 -- International English. > deca = deka -- American English. > hecto = prefix 100 > kilo = prefix 1000 > mega = kilo . kilo > giga = kilo . mega > tera = kilo . giga > peta = kilo . tera > exa = kilo . peta > zetta = kilo . exa > yotta = kilo . zetta Then the submultiples. > deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto > :: Fractional a => Unit d a -> Unit d a > deci = prefix 0.1 > centi = prefix 0.01 > milli = prefix 1e-3 > micro = prefix 1e-6 > nano = prefix 1e-9 > pico = prefix 1e-12 > femto = prefix 1e-15 > atto = prefix 1e-18 > zepto = prefix 1e-21 > yocto = prefix 1e-24 By defining SI prefixes as functions applied to a 'Unit' we satisfy section 6.2.6 "Unacceptability of stand-alone prefixes". = SI base units (section 4.1) = Now we will define the SI base unitsi 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 DLength a > metre = Dimensional 1 -- 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 DMass a > gram = Dimensional 1e-3 > second :: Num a => Unit DTime a > second = Dimensional 1 > ampere :: Num a => Unit DElectricCurrent a > ampere = Dimensional 1 > kelvin :: Num a => Unit DThermodynamicTemperature a > kelvin = Dimensional 1 > mole :: Num a => Unit DAmountOfSubstance a > mole = Dimensional 1 > candela :: Num a => Unit DLuminousIntensity a > candela = Dimensional 1 = DiffTime conversion = It is not within the scope of this library to handle the complex task of date and time arithmetic. It is recommended to use the 'Data.Time' library for handling dates and using 'Time' quantities only when time differences are involved in calculations with other quantities. In order to convert between the 'DiffTime' data type in the 'Data.Time' library and 'Time' quantities we provide the functions 'fromDiffTime' and 'toDiffTime'. > fromDiffTime :: (Fractional a) => DiffTime -> Time a > fromDiffTime = (*~ second) . fromRational . toRational > toDiffTime :: (Real a, Fractional a) => Time a -> DiffTime > toDiffTime = fromRational . toRational . (/~ second) = SI derived units (section 4.2) = Before defining the derived units themselves we provide type synonyms for derived quantities and their dimensionalities. For lack of better organization we provide definitions grouped by table in [1]. == Table 3a == "SI derived units with special names and symbols, including the radian and steradian." > radian :: Fractional a => Unit DPlaneAngle a > radian = one -- meter * meter ^ neg1 > steradian :: Fractional a => Unit DSolidAngle a > steradian = one -- meter ^ pos2 * meter ^ neg2 > hertz :: Fractional a => Unit DFrequency a > hertz = second ^ neg1 > newton :: Fractional a => Unit DForce a > newton = kilo gram * meter * second ^ neg2 > pascal :: Fractional a => Unit DPressure a > pascal = newton / meter ^ pos2 > joule :: Fractional a => Unit DEnergy a > joule = newton * meter > watt :: Fractional a => Unit DPower a > watt = joule / second > coulomb :: Fractional a => Unit DElectricCharge a > coulomb = second * ampere > volt :: Fractional a => Unit DElectricPotential a > volt = watt / ampere > farad :: Fractional a => Unit DCapacitance a > farad = coulomb / volt > ohm :: Fractional a => Unit DElectricResistance a > ohm = volt / ampere > siemens :: Fractional a => Unit DElectricConductance a > siemens = ampere / volt > weber :: Fractional a => Unit DMagneticFlux a > weber = volt * second > tesla :: Fractional a => Unit DMagneticFluxDensity a > tesla = weber / meter ^ pos2 > henry :: Fractional a => Unit DInductance a > henry = weber / ampere We defer the definition of Celcius temperature to the end (would appear here if we stricly followed table 3a). > lumen :: Fractional a => Unit DLuminousFlux a > lumen = candela * steradian > lux :: Fractional a => Unit DIlluminance a > lux = lumen / meter ^ pos2 === Degree 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. > degreeCelsius :: Num a => Unit DCelsiusTemperature a > degreeCelsius = kelvin 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. > fromDegreeCelsiusAbsolute :: Fractional a => a -> ThermodynamicTemperature a > fromDegreeCelsiusAbsolute x = x *~ degreeCelsius + 273.15 *~ degreeCelsius > toDegreeCelsiusAbsolute :: Fractional a => ThermodynamicTemperature a -> a > toDegreeCelsiusAbsolute x = (x - 273.15 *~ degreeCelsius) /~ degreeCelsius == Table 3b == "SI derived units with special names and symbols admitted for reasons of safeguarding human health" We use the same grouping as for table 3a. > becquerel :: Fractional a => Unit DActivity a > becquerel = second ^ neg1 Above we gave a new name to the dimensionality instead of reusing 'Frequency' in the quantity type definition. This will allow GHCi be more specific when queried for the type of 'becquerel'. For quantity types without a specific unit we don't bother doing this (though perhaps we should in case there is a non-SI unit for the quantity type?). > gray :: Fractional a => Unit DAbsorbedDose a > gray = joule / kilo gram > sievert :: Fractional a => Unit DDoseEquivalent a > sievert = joule / kilo gram = Units outside the SI = 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. == 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 DTime a > minute = prefix 60 second > hour = prefix 60 minute > day = prefix 24 hour -- Mean solar day. Since 'minute' and 'second' are already in use for time we use 'arcminute' and 'arcsecond' [2] for plane angle instead. > degree, arcminute, arcsecond :: Floating a => Unit DPlaneAngle a > degree = prefix (Prelude.pi Prelude./ 180) radian > arcminute = prefix (recip 60) degreeOfArc > arcsecond = prefix (recip 60) minuteOfArc 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 DPlaneAngle a > degreeOfArc = degree > secondOfArc = arcsecond > minuteOfArc = arcminute > litre, liter :: Fractional a => Unit DVolume a > litre = deci meter ^ pos3 -- International English. > liter = litre -- American English. > tonne, metricTon :: Fractional a => Unit DMass a > tonne = prefix 1000 (kilo gram) -- Name in original SI text. > metricTon = tonne -- American name. 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[3]. > astronomicalUnit :: Num a => Unit DLength a > astronomicalUnit = prefix 149597870700 meter = References = [1] http://physics.nist.gov/Pubs/SP811/ [2] http://en.wikipedia.org/wiki/Minute_of_arc [3] http://en.wikipedia.org/wiki/Astronomical_unit dimensional-0.13.0.2/Numeric/Units/Dimensional/Test.hs0000644000000000000000000000176112515414060020647 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction #-} module Numeric.Units.Dimensional.Test where import Numeric.Units.Dimensional.Prelude import qualified Prelude import Test.HUnit testPower = TestLabel "Power test" $ TestList [ TestCase $ (9 *~ one) @=? (3 *~ one) ^ pos2 , TestCase $ (1 *~ one) @=? (12.1231 *~ one) ^ zero , TestCase $ (0.25 *~ one) @=? (2 *~ one) ^ neg2 ] testDimensionless = TestLabel "Dimensionless test" $ TestList [ TestCase $ (3 Prelude.** 2) *~ one @=? (3 *~ one) ** (2 *~ one) ] testShow = TestLabel "Test 'Show' instance" $ TestList [ TestCase $ show (1 *~ one) @?= "1" , TestCase $ show (2 *~ meter) @?= "2 m" , TestCase $ show (2.0 *~ (meter / second)) @?= "2.0 m s^-1" , TestCase $ show (2.0 *~ (meter ^ pos2 / second ^ pos2)) @?= "2.0 m^2 s^-2" , TestCase $ show (undefined :: DVelocity) @?= "m s^-1" ] -- Collect the test cases. tests = TestList [ testPower , testDimensionless , testShow ] main = runTestTT tests