diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,12 @@ +quantities changelog +==================== + +0.1 (unreleased) +---------------- + +- Full implementation of multiplicative dimensional quantities (no offsets yet + for temperatures). +- Support for conversions and monadic quantity computations. +- Builtin expression parser. +- Simple definitions file format, fully stocked with units. +- Travis CI, HSpec units tests, and HLint check. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2014, John David Reaver +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +2. 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. + +3. Neither the name of the copyright holder nor the names of its +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 +HOLDER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/library/Data/Quantities.hs b/library/Data/Quantities.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities.hs @@ -0,0 +1,92 @@ +-- | This package is used to create and manipulate physical quantities, which +-- are a numerical value associated with a unit of measurement. +-- +-- In this package, values with units are represented with the Quantity type. +-- Included is an expression parser and a huge list of predefined quantities +-- with which to parse strings into a Quantity datatype. Once created, a +-- quantity can be converted to different units or queried for its +-- dimensionality. A user can also operate on quantities arithmetically, and +-- doing so uses automatic unit conversion and simplifcation. + + +module Data.Quantities + ( + -- * Constructors + -- $constructors + fromString + , unitsFromString + , Quantity + , magnitude + , units + , CompositeUnit + , SimpleUnit + -- * Conversion + -- $conversion + , convert + , convertBase + , dimensionality + -- * Quantity arithmetic + -- $arithmetic + , addQuants + , subtractQuants + , multiplyQuants + , divideQuants + , exptQuants + -- * Error type + , QuantityError(..) + , QuantityComputation + , comp + ) where + + +import Data.Quantities.Constructors (fromString, unitsFromString) +import Data.Quantities.Convert (convert, convertBase, addQuants, subtractQuants, + dimensionality) +import Data.Quantities.Data + +-- $constructors +-- +-- Currently, one constructor is supported to create quantities: 'fromString'. +-- There is an included expression parser that can parse values and strings +-- corresponding to builtin units. To view defined unit types, look at the +-- /source code/ for 'Data.Quantities.DefaultUnits.defaultDefString'. + +-- $conversion +-- +-- These functions are used to convert quantities from one unit type to +-- another. + + +-- $arithmetic +-- +-- Once created, quantities can be manipulated using the included arithmetic +-- functions. +-- +-- >>> let (Right x) = fromString "m/s" +-- >>> let (Right y) = fromString "mile/hr" +-- >>> x `multiplyQuants` y +-- 1.0 meter mile / hour / second +-- >>> x `divideQuants` y +-- 1.0 hour meter / mile / second +-- >>> x `addQuants` y +-- Right 1.4470399999999999 meter / second +-- >>> x `subtractQuants` y +-- Right 0.55296 meter / second +-- >>> x `exptQuants` 1.5 +-- 1.0 meter ** 1.5 / second ** 1.5 +-- +-- The functions 'multiplyQuants', 'divideQuants', and 'exptQuants' change +-- units, and the units of the result are reduced to simplest terms. +-- +-- >>> x `divideQuants` x +-- 1.0 +-- >>> fmap (multiplyQuants x) $ fromString "s" +-- Right 1.0 meter +-- >>> x `exptQuants` 0 +-- 1.0 + +comp :: QuantityComputation Quantity +comp = do + x <- fromString "BADUNIT" + y <- unitsFromString "m/s" + convert x y diff --git a/library/Data/Quantities/Constructors.hs b/library/Data/Quantities/Constructors.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/Constructors.hs @@ -0,0 +1,39 @@ +module Data.Quantities.Constructors where + +import Data.Quantities.Data (Definitions, CompositeUnit, Quantity(units), + QuantityError(..)) +import Data.Quantities.DefaultUnits (defaultDefString) +import Data.Quantities.DefinitionParser (readDefinitions) +import Data.Quantities.Definitions (makeDefinitions, preprocessQuantity) +import Data.Quantities.ExprParser (parseExprQuant) + +defaultDefinitions :: Either QuantityError Definitions +defaultDefinitions = makeDefinitions $ readDefinitions defaultDefString + +d :: Definitions +(Right d) = defaultDefinitions + +-- | Create a Quantity by parsing a string. Uses an +-- 'UndefinedUnitError' for undefined units. +-- +-- >>> fromString "25 m/s" +-- Right 25.0 meter / second +-- >>> fromString "fakeunit" +-- Left (UndefinedUnitError "fakeunit") + +fromString :: String -> Either QuantityError Quantity +fromString s = + case rawq of + (Left err) -> Left $ ParserError err + (Right q) -> case preprocessQuantity d q of + (Left err) -> Left err + (Right q') -> Right q' + where rawq = parseExprQuant s + + +-- | Parse units from a string. Equivalent to @fmap units . fromString@ +-- +-- >>> unitsFromString "N * s" +-- Right [newton,second] +unitsFromString :: String -> Either QuantityError CompositeUnit +unitsFromString = fmap units . fromString diff --git a/library/Data/Quantities/Convert.hs b/library/Data/Quantities/Convert.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/Convert.hs @@ -0,0 +1,88 @@ +module Data.Quantities.Convert where + +import Data.List (sort) +import qualified Data.Map as M + +import Data.Quantities.Data (Quantity(..), CompositeUnit, SimpleUnit(..), Definitions(..) + ,multiplyQuants, QuantityError(..)) + +unityQuant :: Definitions -> Quantity +unityQuant = Quantity 1 [] + +-- | Convert quantity to given units. +-- +-- >>> convert <$> fromString "m" <*> unitsFromString "ft" +-- Right (Right 3.280839895013123 foot) +convert :: Quantity -> CompositeUnit -> Either QuantityError Quantity +convert x = convert' (defs x) x + + +-- | Convert a quantity to its base units. +-- +-- >>> convertBase <$> fromString "newton" +-- Right 1000.0 gram meter / second ** 2.0 +convertBase :: Quantity -> Quantity +convertBase x = convertBase' (defs x) x + + +-- | Convert quantity to given units. +convert' :: Definitions -> Quantity -> CompositeUnit -> Either QuantityError Quantity +convert' d q us' + | dimq /= dimus = Left $ DimensionalityError dimq dimus + | otherwise = Right $ Quantity (mb/mb') us' d + where (Quantity mb _ _) = convertBase' d q + (Quantity mb' _ _) = toBase d us' + dimq = dimensionality' d (units q) + dimus = dimensionality' d us' + + +-- | Convert a quantity to its base units. +convertBase' :: Definitions -> Quantity -> Quantity +convertBase' d (Quantity m us _) = Quantity (m*mb) ub d + where (Quantity mb ub _) = toBase d us + + +-- | Converts a composite unit to its base quantity +toBase :: Definitions -> CompositeUnit -> Quantity +toBase d = foldr (multiplyQuants . simpleToBase d) (unityQuant d) + + +-- | Converts a simple unit to its base quantity. +simpleToBase :: Definitions -> SimpleUnit -> Quantity +simpleToBase d (SimpleUnit sym pre pow) = Quantity m us d + where (m', u') = bases d M.! sym + us = map (\(SimpleUnit s p pow') -> SimpleUnit s p (pow*pow')) u' + m = (m' * (prefixValues d M.! pre)) ** pow + + +-- | Computes dimensionality of quantity. +-- +-- >>> dimensionality <$> fromString "newton" +-- Right [length,mass,time ** -2.0] +dimensionality :: Quantity -> CompositeUnit +dimensionality q = dimensionality' (defs q) (units q) + +dimensionality' :: Definitions -> CompositeUnit -> CompositeUnit +dimensionality' d us = sort $ map dim ub + where (Quantity _ ub _) = toBase d us + dim (SimpleUnit sym _ pow) = SimpleUnit (unitTypes d M.! sym) "" pow + + +-- | Adds two quantities. Second quantity is converted to units of +-- first quantity. +addQuants :: Quantity -> Quantity -> Either QuantityError Quantity +addQuants = linearQuants (+) + + +-- | Subtract two quantities. Second quantity is converted to units of +-- first quantity. +subtractQuants :: Quantity -> Quantity -> Either QuantityError Quantity +subtractQuants = linearQuants (-) + + +linearQuants :: (Double -> Double -> Double) -> Quantity -> Quantity + -> Either QuantityError Quantity +linearQuants f (Quantity m1 u1 d) q2 = case q of + (Right q') -> Right $ Quantity (f m1 (magnitude q')) u1 d + (Left err) -> Left err + where q = convert q2 u1 diff --git a/library/Data/Quantities/Data.hs b/library/Data/Quantities/Data.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/Data.hs @@ -0,0 +1,192 @@ +-- | Base module for all data structures. +module Data.Quantities.Data where + +import Data.List (partition, sort) +import qualified Data.Map as M + +-- | String representation of a unit. Examples: "meter", "foot" +type Symbol = String + +-- | Representation of single unit. For example: \"mm^2\" is +-- represented as +-- +-- > SimpleUnit { symbol = "meter", prefix = "milli", power = 2.0 } +data SimpleUnit = SimpleUnit { symbol :: String + , prefix :: String + , power :: Double} deriving (Eq, Ord) + +instance Show SimpleUnit where + show (SimpleUnit s pr p) + | p == 1 = sym + | otherwise = sym ++ " ** " ++ show p + where sym = pr ++ s + + +-- | Collection of SimpleUnits. Represents combination of simple +-- units. +type CompositeUnit = [SimpleUnit] + +-- | Used to show composite units. +showCompUnit :: CompositeUnit -> String +showCompUnit = unwords . map showCompUnit' . showSort + +-- | Show a single unit, but prepend with '/' if negative +showCompUnit' :: SimpleUnit -> String +showCompUnit' (SimpleUnit s pr p) + | p == 1 = sym + | p == -1 = "/ " ++ sym + | p < 0 = "/ " ++ sym ++ " ** " ++ show (-p) + | otherwise = sym ++ " ** " ++ show p + where sym = pr ++ s + + +-- | Combination of magnitude and units. +data Quantity = Quantity { magnitude :: Double + -- ^ Numerical magnitude of quantity. + -- + -- >>> magnitude <$> fromString "100 N * m" + -- Right 100.0 + , units :: CompositeUnit + -- ^ Units associated with quantity. + -- + -- >>> units <$> fromString "3.4 m/s^2" + -- Right [meter,second ** -2.0] + , defs :: Definitions } deriving (Ord) + + +instance Show Quantity where + show (Quantity m us _) = show m ++ " " ++ showCompUnit us + +-- | Sort units but put negative units at end. +showSort :: CompositeUnit -> CompositeUnit +showSort c = pos ++ neg + where (pos, neg) = partition (\q -> power q > 0) c + +instance Eq Quantity where + (Quantity m1 u1 _) == (Quantity m2 u2 _) = m1 == m2 && sort u1 == sort u2 + + +-- | Quantity without definitions. +baseQuant :: Double -> CompositeUnit -> Quantity +baseQuant m u = Quantity m u emptyDefinitions + +fromDefinitions :: Definitions -> Double -> CompositeUnit -> Quantity +fromDefinitions d m u = Quantity m u d + +-- | Custom error type +data QuantityError = UndefinedUnitError String + -- ^ Used when trying to parse an undefined unit. + | DimensionalityError CompositeUnit CompositeUnit + -- ^ Used when converting units that do not have the same + -- dimensionality (example: convert meter to second). + | UnitAlreadyDefinedError String + -- ^ Used internally when defining units and a unit is + -- already defined. + | PrefixAlreadyDefinedError String + -- ^ Used internally when defining units and a prefix is + -- already defined. + | ParserError String + -- ^ Used when a string cannot be parsed. + deriving (Show, Eq) + + +-- | Computation monad that propagates 'QuantityError's. Some examples: +-- +-- > computation :: QuantityComputation Quantity +-- > computation = do +-- > x <- fromString "mile/hr" +-- > y <- unitsFromString "m/s" +-- > convert x y +-- +-- Returns @Right 0.44704 meter / second@ +-- +-- > computation :: QuantityComputation Quantity +-- > computation = do +-- > x <- fromString "BADUNIT" +-- > convertBase x +-- +-- Returns @Left (UndefinedUnitError "BADUNIT")@ + +type QuantityComputation = Either QuantityError + +-- | Combines equivalent units and removes units with powers of zero. +reduceUnits :: Quantity -> Quantity +reduceUnits q = q { units = reduceUnits' (units q) } + +reduceUnits', removeZeros :: CompositeUnit -> CompositeUnit +reduceUnits' = removeZeros . reduceComp . sort + where reduceComp [] = [] + reduceComp (SimpleUnit x pr1 p1 : SimpleUnit y pr2 p2: xs) + | (x,pr1) == (y,pr2) = SimpleUnit x pr1 (p1+p2) : reduceComp xs + | otherwise = SimpleUnit x pr1 p1 : reduceComp (SimpleUnit y pr2 p2 : xs) + reduceComp (x:xs) = x : reduceComp xs + + +removeZeros [] = [] +removeZeros (SimpleUnit _ _ 0.0 : xs) = removeZeros xs +removeZeros (x:xs) = x : removeZeros xs + +invertUnits :: CompositeUnit -> CompositeUnit +invertUnits = map invertSimpleUnit + +-- | Inverts unit by negating the power field. +invertSimpleUnit :: SimpleUnit -> SimpleUnit +invertSimpleUnit (SimpleUnit s pr p) = SimpleUnit s pr (-p) + +-- | Multiplies two quantities. +multiplyQuants :: Quantity -> Quantity -> Quantity +multiplyQuants x y = reduceUnits $ Quantity mag newUnits (defs x) + where mag = magnitude x * magnitude y + newUnits = units x ++ units y + +-- | Divides two quantities. +divideQuants :: Quantity -> Quantity -> Quantity +divideQuants x y = reduceUnits $ Quantity mag newUnits (defs x) + where mag = magnitude x / magnitude y + newUnits = units x ++ invertUnits (units y) + +-- | Exponentiates a quantity with a double. +exptQuants :: Quantity -> Double -> Quantity +exptQuants (Quantity x u d) y = reduceUnits $ Quantity (x**y) (expUnits u) d + where expUnits = map (\(SimpleUnit s pr p) -> SimpleUnit s pr (p*y)) + + +data Definition = PrefixDefinition { defPrefix :: Symbol + , factor :: Double + , defSynonyms :: [Symbol]} + | BaseDefinition { base :: Symbol + , dimBase :: Symbol + , defSynonyms ::[Symbol]} + | UnitDefinition { defSymbol :: Symbol + , quantity :: Quantity + , defSynonyms :: [Symbol]} deriving (Show, Eq, Ord) + + +data Definitions = Definitions { bases :: M.Map String (Double, CompositeUnit) + , synonyms :: M.Map String String + , unitsList :: [String] + , prefixes :: [String] + , prefixValues :: M.Map String Double + , prefixSynonyms :: M.Map String String + , unitTypes :: M.Map String String } deriving (Show, Eq, Ord) + +emptyDefinitions :: Definitions +emptyDefinitions = Definitions { bases = M.empty + , synonyms = M.empty + , unitsList = [] + , prefixes = [] + , prefixValues = M.fromList [("", 1)] + , prefixSynonyms = M.fromList [("", "")] + , unitTypes = M.empty } + + +-- | Combine two Definitions structures +unionDefinitions :: Definitions -> Definitions -> Definitions +unionDefinitions d1 d2 = Definitions { + bases = bases d1 `M.union` bases d2 + , synonyms = synonyms d1 `M.union` synonyms d2 + , unitsList = unitsList d1 ++ unitsList d2 + , prefixes = prefixes d1 ++ prefixes d2 + , prefixValues = prefixValues d1 `M.union` prefixValues d2 + , prefixSynonyms = prefixSynonyms d1 `M.union` prefixSynonyms d2 + , unitTypes = unitTypes d1 `M.union` unitTypes d2 } diff --git a/library/Data/Quantities/DefaultUnits.hs b/library/Data/Quantities/DefaultUnits.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/DefaultUnits.hs @@ -0,0 +1,336 @@ +module Data.Quantities.DefaultUnits (defaultDefString) where + +-- | View the source code for this declaration to see what units and prefixes +-- are defined. +-- +-- This string holds the definitions for units and prefixes. Base units are +-- defined by the name of the unit, the name of the base in brackets, and any +-- aliases for the unit after that, all separated by equal signs: @meter = +-- [length] = m@. Prefixes are defined by placing a dash after all identifiers, +-- and providing a value for the prefix: @milli- = 1e-3 = m-@. Other units are +-- defined by using /previously defined units/ in an expression: @minute = 60 * +-- second = min@. +-- +-- The reason these definitions aren't placed in a text file is so you don't +-- have to operate your whole program in the IO monad. Theoretically, a user of +-- this package can create their own definitions file or modify this one, but a +-- mechanism for doing so hasn't been created yet. +-- +-- These definitions are taken almost verbatim from the Pint unit conversion +-- library for the Python programming language. Check them out on +-- . +defaultDefString :: String +defaultDefString = unlines [ + + -- decimal prefixes + "yocto- = 1e-24 = y-" + ,"zepto- = 1e-21 = z-" + ,"atto- = 1e-18 = a-" + ,"femto- = 1e-15 = f-" + ,"pico- = 1e-12 = p-" + ,"nano- = 1e-9 = n-" + ,"micro- = 1e-6 = u-" + ,"milli- = 1e-3 = m-" + ,"centi- = 1e-2 = c-" + ,"deci- = 1e-1 = d-" + ,"deca- = 1e+1 = da-" + ,"hecto- = 1e2 = h-" + ,"kilo- = 1e3 = k-" + ,"mega- = 1e6 = M-" + ,"giga- = 1e9 = G-" + ,"tera- = 1e12 = T-" + ,"peta- = 1e15 = P-" + ,"exa- = 1e18 = E-" + ,"zetta- = 1e21 = Z-" + ,"yotta- = 1e24 = Y-" + + -- binary_prefixes + ,"kibi- = 2**10 = Ki-" + ,"mebi- = 2**20 = Mi-" + ,"gibi- = 2**30 = Gi-" + ,"tebi- = 2**40 = Ti-" + ,"pebi- = 2**50 = Pi-" + ,"exbi- = 2**60 = Ei-" + ,"zebi- = 2**70 = Zi-" + ,"yobi- = 2**80 = Yi-" + + -- reference + ,"meter = [length] = m = metre" + ,"second = [time] = s = sec" + ,"ampere = [current] = A = amp" + ,"candela = [luminosity] = cd = candle" + ,"gram = [mass] = g" + ,"mole = [substance] = mol" + --,"degK = [temperature]; offset: 0 = K = kelvin" + ,"radian = [] = rad" + ,"bit = []" + ,"count = []" + + ,"pi = 3.14159265359" + ,"gstandard_gravity = 9.806650 * meter / second ** 2 = g_0 = g_n = gravity" + ,"speed_of_light = 299792458 * meter / second = c" + + -- acceleration + -- [acceleration] = [length] / [time] ** 2 + + -- Angle + ,"turn = 2 * pi * radian = revolution = cycle = circle" + ,"degree = pi / 180 * radian = deg = arcdeg = arcdegree = angular_degree" + ,"arcminute = arcdeg / 60 = arcmin = arc_minute = angular_minute" + ,"arcsecond = arcmin / 60 = arcsec = arc_second = angular_second" + ,"steradian = radian ** 2 = sr" + + -- Time + ,"minute = 60 * second = min" + ,"hour = 60 * minute = h = hr" + ,"day = 24 * hour" + ,"week = 7 * day" + ,"fortnight = 2 * week" + ,"year = 31556925.9747 * second" + ,"month = year/12" + ,"shake = 1e-8 * second" + ,"sidereal_day = day / 1.00273790935079524" + ,"sidereal_hour = sidereal_day/24" + ,"sidereal_minute = sidereal_hour/60" + ,"sidereal_second =sidereal_minute/60" + ,"sidereal_year = 366.25636042 * sidereal_day" + ,"sidereal_month = 27.321661 * sidereal_day" + ,"tropical_month = 27.321661 * day" + ,"synodic_month = 29.530589 * day = lunar_month" + ,"common_year = 365 * day" + ,"leap_year = 366 * day" + ,"julian_year = 365.25 * day" + ,"gregorian_year = 365.2425 * day" + ,"millenium = 1000 * year = millenia = milenia = milenium" + ,"eon = 1e9 * year" + ,"work_year = 2056 * hour" + ,"work_month = work_year/12" + + -- Length + ,"angstrom = 1e-10 * meter" + ,"inch = 2.54 * centimeter = international_inch = inches = international_inches = in" + ,"foot = 12 * inch = international_foot = ft = feet = international_foot = international_feet" + ,"mile = 5280 * foot = mi = international_mile" + ,"yard = 3 * feet = yd = international_yard" + ,"mil = inch / 1000 = thou" + ,"parsec = 3.08568025e16 * meter = pc" + ,"light_year = speed_of_light * julian_year = ly = lightyear" + ,"astronomical_unit = 149597870691 * meter = au" + ,"nautical_mile = 1.852e3 * meter = nmi" + ,"printers_point = 127 * millimeter / 360 = point" + ,"printers_pica = 12 * printers_point = pica" + ,"US_survey_foot = 1200 * meter / 3937" + ,"US_survey_yard = 3 * US_survey_foot" + ,"US_survey_mile = 5280 * US_survey_foot = US_statute_mile" + ,"rod = 16.5 * US_survey_foot = pole = perch" + ,"furlong = 660 * US_survey_foot" + ,"fathom = 6 * US_survey_foot" + ,"chain = 66 * US_survey_foot" + ,"barleycorn = inch / 3" + ,"arpentlin = 191.835 * feet" + ,"kayser = 1 / centimeter = wavenumber" + + + -- Mass + ,"ounce = 28.349523125 * gram = oz = avoirdupois_ounce" + ,"dram = oz / 16 = dr = avoirdupois_dram" + ,"pound = 0.45359237 * kilogram = lb = avoirdupois_pound" + ,"stone = 14 * lb = st" + ,"carat = 200 * milligram" + ,"grain = 64.79891 * milligram = gr" + ,"long_hundredweight = 112 * lb" + ,"short_hundredweight = 100 * lb" + ,"metric_ton = 1000 * kilogram = t = tonne" + ,"pennyweight = 24 * gram = dwt" + ,"slug = 14.59390 * kilogram" + ,"troy_ounce = 480 * gram = toz = apounce = apothecary_ounce" + ,"troy_pound = 12 * toz = tlb = appound = apothecary_pound" + ,"drachm = 60 * gram = apdram = apothecary_dram" + ,"atomic_mass_unit = 1.660538782e-27 * kilogram = u = amu = dalton = Da" + ,"scruple = 20 * gram" + ,"bag = 94 * lb" + ,"ton = 2000 * lb = short_ton" + + -- Force + --[force] = [mass] * [acceleration] + ,"newton = kilogram * meter / second ** 2 = N" + ,"dyne = gram * centimeter / second ** 2 = dyn" + ,"force_kilogram = g_0 * kilogram = kgf = kilogram_force = pond" + ,"force_gram = g_0 * gram = gf = gram_force" + ,"force_ounce = g_0 * ounce = ozf = ounce_force" + ,"force_pound = g_0 * lb = lbf = pound_force" + ,"force_ton = 2000 * force_pound = ton_force" + ,"poundal = lb * feet / second ** 2 = pdl" + ,"kip = 1000*lbf" + + -- Area + -- [area] = [length] ** 2 + ,"are = 100 * m**2" + ,"barn = 1e-28 * m ** 2 = b" + ,"cmil = 5.067075e-10 * m ** 2 = circular_mils" + ,"darcy = 9.869233e-13 * m ** 2" + ,"acre = 4046.8564224 * m ** 2 = international_acre" + ,"US_survey_acre = 160 * rod ** 2" + + -- Energy + ,"joule = newton * meter = J" + ,"erg = dyne * centimeter" + ,"btu = 1.05505585262e3 * joule = Btu = BTU = british_thermal_unit" + ,"eV = 1.60217653e-19 * J = electron_volt" + ,"thm = 100000 * BTU = therm = EC_therm" + ,"cal = 4.184 * joule = calorie = thermochemical_calorie" + ,"international_steam_table_calorie = 4.1868 * joule" + ,"ton_TNT = 4.184e9 * joule = tTNT" + ,"US_therm = 1.054804e8 * joule" + ,"E_h = 4.35974394e-18 * joule = hartree = hartree_energy" + + + -- Power + ,"watt = joule / second = W = volt_ampere = VA" + ,"horsepower = 33000 * ft * lbf / min = hp = UK_horsepower = British_horsepower" + ,"boiler_horsepower = 33475 * btu / hour" + ,"metric_horsepower = 75 * force_kilogram * meter / second" + ,"electric_horsepower = 746 * watt" + ,"hydraulic_horsepower = 550 * feet * lbf / second" + ,"refrigeration_ton = 12000 * btu / hour = ton_of_refrigeration" + + -- More Energy + ,"watt_hour = watt * hour = Wh = watthour" + + -- EM + ,"esu = 1 * erg**0.5 * centimeter**0.5 = statcoulombs = statC = franklin = Fr" + ,"esu_per_second = 1 * esu / second = statampere" + ,"ampere_turn = 1 * A" + ,"gilbert = 10 / (4 * pi ) * ampere_turn = G" + ,"coulomb = ampere * second = C" + ,"volt = joule / coulomb = V" + ,"farad = coulomb / volt = F" + ,"ohm = volt / ampere" + ,"siemens = ampere / volt = S = mho" + ,"weber = volt * second = Wb" + ,"tesla = weber / meter ** 2 = T" + ,"henry = weber / ampere = H" + ,"elementary_charge = 1.602176487e-19 * coulomb = e" + ,"chemical_faraday = 9.64957e4 * coulomb" + ,"physical_faraday = 9.65219e4 * coulomb" + ,"faraday = 96485.3399 * coulomb = C12_faraday" + ,"gamma = 1e-9 * tesla" + ,"gauss = 1e-4 * tesla" + ,"maxwell = 1e-8 * weber = mx" + ,"oersted = 1000 / (4 * pi) * A / m = Oe" + ,"statfarad = 1.112650e-12 * farad = statF = stF" + ,"stathenry = 8.987554e11 * henry = statH = stH" + ,"statmho = 1.112650e-12 * siemens = statS = stS" + ,"statohm = 8.987554e11 * ohm" + ,"statvolt = 2.997925e2 * volt = statV = stV" + ,"unit_pole = 1.256637e-7 * weber" + + + -- Frequency + ,"hertz = 1 / second = Hz = rps" + ,"revolutions_per_minute = revolution / minute = rpm" + ,"counts_per_second = count / second = cps" + + -- Information + ,"byte = 8 * bit = Bo = octet" + ,"baud = bit / second = Bd = bps" + + -- Textile + ,"denier = gram / (9000 * meter)" + ,"tex = gram/ (1000 * meter)" + ,"dtex = decitex" + + -- Pressure + -- [pressure] = [force] / [area] + ,"Hg = gravity * 13.59510 * gram / centimeter ** 3 = mercury = conventional_mercury" + ,"mercury_60F = gravity * 13.5568 * gram / centimeter ** 3" + ,"H2O = gravity * 1000 * kilogram / meter ** 3 = h2o = water = conventional_water" + ,"water_4C = gravity * 999.972 * kilogram / meter ** 3 = water_39F" + ,"water_60F = gravity * 999.001 * kilogram / m ** 3" + ,"pascal = newton / meter ** 2 = Pa" + ,"bar = 100000 * pascal" + ,"atmosphere = 101325 * pascal = atm = standard_atmosphere" + ,"technical_atmosphere = kilogram * gravity / centimeter ** 2 = at" + ,"torr = atm / 760" + ,"psi = pound * gravity / inch ** 2 = pound_force_per_square_inch" + ,"ksi = kip / inch ** 2 = kip_per_square_inch" + ,"barye = 0.1 * newton / meter ** 2 = barie = barad = barrie = baryd = Ba" + ,"mmHg = millimeter * Hg = mm_Hg = millimeter_Hg = millimeter_Hg_0C" + ,"cmHg = centimeter * Hg = cm_Hg = centimeter_Hg" + ,"inHg = inch * Hg = in_Hg = inch_Hg = inch_Hg_32F" + ,"inch_Hg_60F = inch * mercury_60F" + ,"inch_H2O_39F = inch * water_39F" + ,"inch_H2O_60F = inch * water_60F" + ,"footH2O = ft * water" + ,"cmH2O = centimeter * water" + ,"foot_H2O = ft * water = ftH2O" + ,"standard_liter_per_minute = 1.68875 * Pa * m ** 3 / s = slpm = slm" + + + -- Radiation + ,"Bq = Hz = becquerel" + ,"curie = 3.7e10 * Bq = Ci" + ,"rutherford = 1e6*Bq = rd = Rd" + ,"Gy = joule / kilogram = gray = Sv = sievert" + ,"rem = 1e-2 * sievert" + ,"rads = 1e-2 * gray" + ,"roentgen = 2.58e-4 * coulomb / kilogram = R" + + -- Velocity + -- [speed] = [length] / [time] + ,"knot = nautical_mile / hour = kt = knot_international = international_knot = nautical_miles_per_hour" + ,"mph = mile / hour = MPH" + ,"kph = kilometer / hour = KPH" + + -- Viscosity + -- [viscosity] = [pressure] * [time] + ,"poise = 1e-1 * Pa * second = P" + ,"stokes = 1e-4 * meter ** 2 / second = St" + ,"rhe = 10 / (Pa * s)" + + -- Volume + -- [volume] = [length] ** 3 + ,"liter = 1e-3 * m ** 3 = l = L = litre" + ,"cc = centimeter ** 3 = cubic_centimeter" + ,"stere = meter ** 3" + ,"gross_register_ton = 100 * foot ** 3 = register_ton = GRT" + ,"acre_foot = acre * foot = acre_feet" + ,"board_foot = foot ** 2 * inch = FBM" + ,"bushel = 2150.42 * inch ** 3 = bu = US_bushel" + ,"dry_gallon = bushel / 8 = US_dry_gallon" + ,"dry_quart = dry_gallon / 4 = US_dry_quart" + ,"dry_pint = dry_quart / 2 = US_dry_pint" + ,"gallon = 231 * inch ** 3 = liquid_gallon = US_liquid_gallon" + ,"quart = gallon / 4 = liquid_quart = US_liquid_quart" + ,"pint = quart / 2 = pt = liquid_pint = US_liquid_pint" + ,"cup = pint / 2 = liquid_cup = US_liquid_cup" + ,"gill = cup / 2 = liquid_gill = US_liquid_gill" + ,"floz = gill / 4 = fluid_ounce = US_fluid_ounce = US_liquid_ounce" + ,"imperial_bushel = 36.36872 * liter = UK_bushel" + ,"imperial_gallon = imperial_bushel / 8 = UK_gallon" + ,"imperial_quart = imperial_gallon / 4 = UK_quart" + ,"imperial_pint = imperial_quart / 2 = UK_pint" + ,"imperial_cup = imperial_pint / 2 = UK_cup" + ,"imperial_gill = imperial_cup / 2 = UK_gill" + ,"imperial_floz = imperial_gill / 5 = UK_fluid_ounce = imperial_fluid_ounce" + ,"barrel = 42 * gallon = bbl" + ,"tablespoon = floz / 2 = tbsp = Tbsp = Tblsp = tblsp = tbs = Tbl" + ,"teaspoon = tablespoon / 3 = tsp" + ,"peck = bushel / 4 = pk" + ,"fluid_dram = floz / 8 = fldr = fluidram" + ,"firkin = barrel / 4" + ] + +-- otherDefinitions :: String +-- otherDefinitions = unlines [ +-- -- Heat +-- "RSI = degK * meter ** 2 / watt" +-- ,"clo = 0.155 * RSI = clos" +-- ,"R_value = foot ** 2 * degF * hour / btu" + +-- -- Temperature +-- ,"degR = 9 / 5 * degK; offset: 0 = rankine" +-- ,"degC = degK; offset: 273.15 = celsius = C" +-- ,"degF = 9 / 5 * degK; offset: 255.372222 = fahrenheit = F" + +-- ] diff --git a/library/Data/Quantities/DefinitionParser.hs b/library/Data/Quantities/DefinitionParser.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/DefinitionParser.hs @@ -0,0 +1,107 @@ +module Data.Quantities.DefinitionParser where + +import Control.Applicative ((<$>), (<*)) +import System.Environment +import Text.ParserCombinators.Parsec + +import Data.Quantities.Data (Definition (..), Symbol, units, magnitude) +import Data.Quantities.ExprParser (parseExpr) + + +main :: IO () +main = do + defs <- readDefinitions <$> head <$> getArgs + print defs + +-- | Parse multiline string of definitions (say, from a file) into a +-- list of definitions. +readDefinitions :: String -> [Definition] +readDefinitions input = case parse readDefinitions' "Input File Parser" input of + Left err -> error (show err) >> [] + Right val -> val + +readDefinitions' :: Parser [Definition] +readDefinitions' = many parseDef <* eof + +-- | Parse any definition line +parseDef :: Parser Definition +parseDef = do + _ <- spaces + -- skipMany comment + optional $ many $ char '\n' + line <- try parseDefLine <|> try parseBaseLine <|> parsePrefixLine + spaces + -- skipMany comment + optional $ many $ char '\n' + return line + +-- comment :: Parser String +-- comment = char '#' >> many (noneOf "\n") + +eol :: Parser Char +eol = char '\n' + +-- | Parse a line containing unit definition +-- Ex: minute = 60 s = min +parseDefLine :: Parser Definition +parseDefLine = do + (UnitDefinition s e []) <- parseUnitDef + syns <- many (try parseSynonym) + return $ UnitDefinition s e syns + +parseUnitDef :: Parser Definition +parseUnitDef = do + sym <- parseSymbol <* spaces <* char '=' + quant <- parseExpr + spaces + -- skipMany comment + return $ UnitDefinition sym quant [] + +parseSynonym :: Parser Symbol +parseSynonym = spaces >> char '=' >> spaces >> parseSymbol <* spaces + + +-- | Parse line containing base definition +-- Ex: meter = [length] = m +parseBaseLine :: Parser Definition +parseBaseLine = do + (sym, f) <- parseBase + syns <- many (try parseSynonym) + return $ BaseDefinition sym f syns + +parseBase :: Parser (Symbol, Symbol) +parseBase = do + sym <- parseSymbol <* spaces <* char '=' + b <- spaces >> char '[' >> option "" parseSymbol <* char ']' + spaces + -- skipMany comment + return (sym, b) + +-- | Parse line containing prefix definition +-- Ex: milli- = 1e-3 = m- +parsePrefixLine :: Parser Definition +parsePrefixLine = do + (p, f) <- parsePrefix + syns <- many (try parsePrefixSynonym) + return $ PrefixDefinition p f syns + +parsePrefix :: Parser (Symbol, Double) +parsePrefix = do + pre <- many1 letter <* char '-' <* spaces <* char '=' + facQuant <- spaces >> parseExpr + spaces + if null (units facQuant) then + return (pre, magnitude facQuant) + else fail "No units allowed in prefix definitions" + + +parsePrefixSynonym :: Parser Symbol +parsePrefixSynonym = spaces >> char '=' >> spaces >> parseSymbol <* char '-' <* spaces + + +-- | Parse a symbol for a unit +parseSymbol :: Parser Symbol +parseSymbol = do + letter' <- letter + rest <- many (alphaNum <|> char '_') + return $ letter' : rest diff --git a/library/Data/Quantities/Definitions.hs b/library/Data/Quantities/Definitions.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/Definitions.hs @@ -0,0 +1,92 @@ +module Data.Quantities.Definitions where + +import Control.Monad.State +import Data.Either (partitionEithers) +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Text.ParserCombinators.Parsec as P + +import Data.Quantities.Convert (convertBase') +import Data.Quantities.Data + +type DefineMonad = StateT Definitions (Either QuantityError) +makeDefinitions :: [Definition] -> Either QuantityError Definitions +makeDefinitions ds = execStateT (mapM addDefinition ds) emptyDefinitions + +addDefinition :: Definition -> DefineMonad () + +addDefinition (PrefixDefinition sym fac syns) = do + d <- get + let newd = emptyDefinitions { + prefixes = sym : syns + , prefixValues = M.singleton sym fac + , prefixSynonyms = M.fromList $ zip (sym : syns) (repeat sym) } + defCheck = checkDefined (sym : syns) (prefixes d) + if null defCheck + then put $ d `unionDefinitions` newd + else lift . Left . PrefixAlreadyDefinedError $ head defCheck ++ "-" + +addDefinition (BaseDefinition sym utype syns) = do + d <- get + let defCheck = checkDefined (sym : syns) (unitsList d) + if null defCheck + then put $ d `unionDefinitions` emptyDefinitions { + bases = M.singleton sym (1, [SimpleUnit sym "" 1]) + , unitsList = sym : syns + , synonyms = M.fromList $ zip (sym : syns) (repeat sym) + , unitTypes = M.singleton sym utype } + else lift . Left $ UnitAlreadyDefinedError (head defCheck) + +addDefinition (UnitDefinition sym q syns) = do + -- First, we preprocess the quantity so all units are base units and + -- prefixes are preprocessed. Then we do the standard Definitions + -- modification like prefix and base definitions. + d <- get + let pq = preprocessQuantity d q + defCheck = checkDefined (sym : syns) (unitsList d) + if null defCheck + then case pq of + (Right pq') -> do + let (Quantity baseFac baseUnits _) = convertBase' d pq' + put $ d `unionDefinitions` emptyDefinitions { + bases = M.singleton sym (baseFac, baseUnits) + , synonyms = M.fromList $ zip (sym : syns) (repeat sym) + , unitsList = sym : syns } + (Left err) -> lift . Left $ err + else lift . Left $ UnitAlreadyDefinedError $ head defCheck + + +-- | Computes intersection of two lists +checkDefined :: [Symbol] -> [Symbol] -> [Symbol] +checkDefined a b = S.toList $ S.intersection (S.fromList a) (S.fromList b) + +-- Convert prefixes and synonyms +preprocessQuantity :: Definitions -> Quantity -> Either QuantityError Quantity +preprocessQuantity d (Quantity x us _) + | null errs = Right $ Quantity x us' d + | otherwise = Left $ head errs + where ppUnits = map (preprocessUnit d) us + (errs, us') = partitionEithers ppUnits + +preprocessUnit :: Definitions -> SimpleUnit -> Either QuantityError SimpleUnit +preprocessUnit d (SimpleUnit s _ p) + | rs `elem` unitsList d = Right $ SimpleUnit ns np p + | otherwise = Left $ UndefinedUnitError s + where (rp, rs) = prefixParser d s + np = prefixSynonyms d M.! rp + ns = synonyms d M.! rs + + +prefixParser :: Definitions -> String -> (String, String) +prefixParser d input = if input `elem` unitsList d + then ("", input) + else case P.parse (prefixParser' d) "arithmetic" input of + Left _ -> ("", input) + Right val -> splitAt (length val) input + + +prefixParser' :: Definitions -> P.Parser String +prefixParser' d = do + pr <- P.choice $ map (P.try . P.string) (prefixes d) + _ <- P.choice $ map (P.try . P.string) (unitsList d) + return pr diff --git a/library/Data/Quantities/ExprParser.hs b/library/Data/Quantities/ExprParser.hs new file mode 100644 --- /dev/null +++ b/library/Data/Quantities/ExprParser.hs @@ -0,0 +1,112 @@ +-- | Parse expressions with numbers and units. +-- +-- This module provides a basic expression grammar that parses numbers +-- and units. +module Data.Quantities.ExprParser where + +import Control.Applicative ((<*>), (<$>), (*>), (<*)) +import Numeric (readFloat) +import System.Environment +import Text.ParserCombinators.Parsec + +import Data.Quantities.Data (SimpleUnit(..), Quantity(..), baseQuant, + multiplyQuants, divideQuants, exptQuants) + +main :: IO () +main = do + args <- getArgs + putStrLn $ readExpr (head args) + +readExpr :: String -> String +readExpr input = case parse parseExpr "arithmetic" input of + Left err -> "No match: " ++ show err + Right val -> show val + +spaces' :: Parser String +spaces' = many $ char ' ' + +parseExprQuant :: String -> Either String Quantity +parseExprQuant input = case parse parseExpr "arithmetic" input of + Left err -> Left $ "No match: " ++ show err + Right val -> Right val + +-- | Converts string to a Quantity using an expression grammar parser. +parseExpr :: Parser Quantity +parseExpr = spaces' >> parseExpr' <* spaces' + +-- parseExpr', parseTerm, parseFactor, parseExp, parseNestedExpr :: Parser Quantity +-- parseExpr' = try parseTermOp <|> parseTerm +-- parseTerm = try parseFactorOp <|> parseFactor +-- parseFactor = try parseExpOp <|> parseExp +-- parseExp = try parseNestedExpr <|> parseSymbolNum +-- parseNestedExpr = spaces' >> char '(' *> spaces' >> parseExpr' <* spaces' <* char ')' <* spaces' "parseNested" + +-- parseExpOp, parseTermOp, parseFactorOp :: Parser Quantity +-- parseExpOp = parseExp `chainl1` expOp +-- parseTermOp = parseTerm `chainl1` addOp +-- parseFactorOp = parseFactor `chainl1` mulOp + +parseExpr', parseFactor, parseExp, parseNestedExpr :: Parser Quantity +parseExpr' = try parseFactorOp <|> parseFactor +parseFactor = try parseExpOp <|> parseExp +parseExp = try parseNestedExpr <|> parseSymbolNum +parseNestedExpr = spaces' >> char '(' *> spaces' >> parseExpr' <* spaces' <* char ')' <* spaces' "parseNested" + +parseExpOp, parseFactorOp :: Parser Quantity +parseExpOp = parseExp `chainl1` expOp +parseFactorOp = parseFactor `chainl1` mulOp + + +expOp, mulOp :: Parser (Quantity -> Quantity -> Quantity) +-- addOp = try parseAdd <|> parseSubtract "addOp" +-- where parseAdd = char '+' >> spaces' >> return (addQuants) +-- parseSubtract = char '-' >> spaces' >> return (subtractQuants) +mulOp = try parseTimes <|> try parseDiv <|> parseImplicitTimes "mulOp" + where parseTimes = char '*' >> spaces' >> return multiplyQuants + parseDiv = char '/' >> spaces' >> return divideQuants + parseImplicitTimes = return multiplyQuants +expOp = try (opChoice >> spaces' >> return exptQuants') "expOp" + where opChoice = string "^" <|> string "**" + + +exptQuants' :: Quantity -> Quantity -> Quantity +exptQuants' q (Quantity y [] _) = exptQuants q y +exptQuants' a b = error $ "Used non-dimensionless exponent in " ++ showq + where showq = unwords ["(", show a, ") ** (", show b, ")"] + +parseSymbolNum :: Parser Quantity +parseSymbolNum = try parseNum <|> parseSymbol' + +parseSymbol' :: Parser Quantity +parseSymbol' = do + neg <- option "" $ string "-" + symf <- letter + rest <- many (alphaNum <|> char '_') + _ <- spaces' + return $ baseQuant (timesSign neg 1) [SimpleUnit (symf : rest) "" 1] + +parseNum :: Parser Quantity +parseNum = do + num <- parseNum' + return $ baseQuant num [] + +parseNum' :: Parser Double +parseNum' = do + neg <- option "" $ string "-" + whole <- many1 digit + decimal <- option "" $ (:) <$> char '.' <*> many1 digit + exponential <- option "" parseExponential + _ <- spaces' + return $ timesSign neg $ fst $ head $ readFloat $ whole ++ decimal ++ exponential + +parseExponential :: Parser String +parseExponential = do + e <- string "e" + neg <- option "" $ string "+" <|> string "-" + pow <- many1 digit + return $ e ++ neg ++ pow + +timesSign :: String -> Double -> Double +timesSign sign x + | sign == "-" = -x + | otherwise = x diff --git a/quantities.cabal b/quantities.cabal new file mode 100644 --- /dev/null +++ b/quantities.cabal @@ -0,0 +1,60 @@ +name: quantities +version: 0.1.0 +author: John David Reaver +maintainer: John David Reaver +build-type: Simple +cabal-version: >= 1.18 +copyright: 2014 John David Reaver +license: BSD3 +license-file: LICENSE +synopsis: Unit conversion and manipulation library. +description: A library for creating and manipulating physical + quantities, which are a numerical value + associated with a unit of measurement. Included + is an expression parser and a huge list of + predefined quantities with which to parse + strings into a Quantity datatype. Once created, + a quantity can be converted to different units + or queried for its dimensionality. A user can + also operate on quantities arithmetically, and + doing so uses automatic unit conversion and + simplifcation. + +category: Data, Math, Physics +homepage: http://github.com/jdreaver/quantities +extra-source-files: CHANGES.md + + +library + default-language: Haskell2010 + exposed-modules: Data.Quantities + , Data.Quantities.DefaultUnits + hs-source-dirs: library + ghc-options: -Wall + build-depends: base >=4 && < 5, containers, mtl, parsec + other-modules: Data.Quantities.Convert + , Data.Quantities.Constructors + , Data.Quantities.Data + + , Data.Quantities.Definitions + , Data.Quantities.DefinitionParser + , Data.Quantities.ExprParser + +test-suite hspec + default-language: Haskell2010 + ghc-options: -Wall + hs-source-dirs: test-suite library + main-is: Spec.hs + type: exitcode-stdio-1.0 + build-depends: base >=4 && < 5, quantities, hspec, containers, mtl, parsec + +test-suite hlint + build-depends: base, hlint + default-language: Haskell2010 + hs-source-dirs: test-suite + main-is: HLint.hs + type: exitcode-stdio-1.0 + +source-repository head + type: git + location: https://github.com/jdreaver/quantities.git diff --git a/test-suite/HLint.hs b/test-suite/HLint.hs new file mode 100644 --- /dev/null +++ b/test-suite/HLint.hs @@ -0,0 +1,15 @@ +module Main (main) where + +import Language.Haskell.HLint (hlint) +import System.Exit (exitFailure, exitSuccess) + +arguments :: [String] +arguments = + [ "library" + , "test-suite" + ] + +main :: IO () +main = do + hints <- hlint arguments + if null hints then exitSuccess else exitFailure diff --git a/test-suite/Spec.hs b/test-suite/Spec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}