module Data.Quantities.Data where
import Data.List (partition, sort)
import qualified Data.Map as M
type Symbol = String
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
data CompoundUnit = CompoundUnit { defs :: Definitions
, sUnits :: [SimpleUnit]
} deriving (Eq, Ord)
instance Show CompoundUnit where
show (CompoundUnit _ us) = unwords . map showCompUnit' $ showSort us
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
data Quantity = Quantity { magnitude :: Double
, units :: CompoundUnit
} deriving (Ord)
units' :: Quantity -> [SimpleUnit]
units' = sUnits . units
defs' :: Quantity -> Definitions
defs' = defs . units
instance Show Quantity where
show (Quantity m us) = show m ++ " " ++ show us
baseQuant :: Double -> [SimpleUnit] -> Quantity
baseQuant m us = Quantity m (CompoundUnit emptyDefinitions us)
showSort :: [SimpleUnit] -> [SimpleUnit]
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 (sUnits u1) == sort (sUnits u2)
data QuantityError = UndefinedUnitError String
| DimensionalityError CompoundUnit CompoundUnit
| UnitAlreadyDefinedError String
| PrefixAlreadyDefinedError String
| ParserError String
| DifferentDefinitionsError CompoundUnit CompoundUnit
deriving (Show, Eq)
type QuantityComputation = Either QuantityError
reduceUnits :: Quantity -> Quantity
reduceUnits q = q { units = newUnits }
where newUnits = (units q) { sUnits = reduceUnits' (units' q) }
reduceUnits', removeZeros :: [SimpleUnit] -> [SimpleUnit]
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 :: [SimpleUnit] -> [SimpleUnit]
invertUnits = map invertSimpleUnit
invertSimpleUnit :: SimpleUnit -> SimpleUnit
invertSimpleUnit (SimpleUnit s pr p) = SimpleUnit s pr (p)
multiplyQuants :: Quantity -> Quantity -> Quantity
multiplyQuants x y = reduceUnits $ Quantity mag newUnits
where mag = magnitude x * magnitude y
newUnits = (units x) { sUnits = units' x ++ units' y }
divideQuants :: Quantity -> Quantity -> Quantity
divideQuants x y = reduceUnits $ Quantity mag newUnits
where mag = magnitude x / magnitude y
newUnits = (units x) { sUnits = units' x ++ invertUnits (units' y) }
exptQuants :: Quantity -> Double -> Quantity
exptQuants (Quantity x u) y = reduceUnits $ Quantity (x**y) newUnits
where expUnits = map (\(SimpleUnit s pr p) -> SimpleUnit s pr (p*y))
newUnits = u { sUnits = expUnits (sUnits u) }
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, [SimpleUnit])
, synonyms :: M.Map String String
, unitsList :: [String]
, prefixes :: [String]
, prefixValues :: M.Map String Double
, prefixSynonyms :: M.Map String String
, unitTypes :: M.Map String String
, defStringHash :: Int
} deriving (Show, Ord)
instance Eq Definitions where
d1 == d2 = defStringHash d1 == defStringHash d2
emptyDefinitions :: Definitions
emptyDefinitions = Definitions { bases = M.empty
, synonyms = M.empty
, unitsList = []
, prefixes = []
, prefixValues = M.fromList [("", 1)]
, prefixSynonyms = M.fromList [("", "")]
, unitTypes = M.empty
, defStringHash = 1 }
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
, defStringHash = 1 }