module Data.EngineeringUnits
( Value
, value
, m
, cm
, mm
, km
, in'
, ft
, mi
, cm2
, in2
, cm3
, ml
, l
, in3
, gal
, kg
, g
, mg
, n
, lbs
, rev
, mph
, kph
, rpm
, s
, ns
, us
, ms
, min'
, h
, j
, btu
, hp
, w
, kw
, psi
, bar
, gpm
, lpm
, s2
, radsPerRev
) where
import Data.List
data Unit = M | S | Kg | Rev deriving (Eq, Ord, Show)
data Value = Value Double [Unit] [Unit] deriving (Show, Eq, Ord)
instance Num Value where
a@(Value aV _ _) + b@(Value bV _ _) = same a b $ aV + bV
a@(Value aV _ _) b@(Value bV _ _) = same a b $ aV bV
Value aV aN aD * Value bV bN bD = normalize $ Value (aV * bV) (aN ++ bN) (aD ++ bD)
fromInteger a = Value (fromIntegral a) [] []
negate (Value v n d) = Value (negate v) n d
abs (Value v n d) = Value (abs v) n d
signum (Value v n d) = Value (signum v) n d
instance Fractional Value where
Value aV aN aD / Value bV bN bD = normalize $ Value (aV / bV) (aN ++ bD) (aD ++ bN)
recip (Value v n d) = Value (recip v) d n
fromRational a = Value (fromRational a) [] []
instance Floating Value where
pi = Value pi [] []
(Value a n d) ** b = case b of
Value 2 [] [] -> normalize $ Value (a ** 2) (n ++ n) (d ++ d)
_ -> error "Not supported (**) where power is not a unitless value of 2."
sqrt v@(Value a n d) = Value (sqrt a) (sqrt' n) (sqrt' d)
where
sqrt' a = case a of
[] -> []
[_] -> error $ "Sqrt failed on unit reduction: " ++ show v
a : b : c
| a == b -> a : sqrt' c
| otherwise -> error $ "Sqrt failed on unit reduction: " ++ show v
exp = error "Not supported yet for Value: exp "
log = error "Not supported yet for Value: log "
sin = unitless "sin" sin
cos = unitless "cos" cos
tan = unitless "tan" tan
asin = unitless "asin" asin
acos = unitless "acos" acos
atan = unitless "atan" atan
sinh = error "Not supported yet for Value: sinh "
cosh = error "Not supported yet for Value: cosh "
asinh = error "Not supported yet for Value: asinh"
acosh = error "Not supported yet for Value: acosh"
atanh = error "Not supported yet for Value: atanh"
unitless :: String -> (Double -> Double) -> Value -> Value
unitless msg f (Value a n d)
| null n && null d = Value (f a) [] []
| otherwise = error $ msg ++ " requires unitless value."
normalize :: Value -> Value
normalize a@(Value _ n d) = order $ reduce (n ++ d) a
where
reduce :: [Unit] -> Value -> Value
reduce [] a = a
reduce (a : rest) (Value v n d)
| elem a n && elem a d = reduce rest $ Value v (delete a n) (delete a d)
| otherwise = reduce rest $ Value v n d
order :: Value -> Value
order (Value v n d) = Value v (sort n) (sort d)
same :: Value -> Value -> Double -> Value
same (Value _ aN aD) (Value _ bN bD) v
| aN == bN && aD == bD = Value v aN aD
| otherwise = error $ "Incompatible units: " ++ show aN ++ "/" ++ show aD ++ " /= " ++ show bN ++ "/" ++ show bD
value :: Value -> Value -> Double
value val@(Value v _ _) units@(Value k _ _) = result
where
Value result _ _ = same val units $ v / k
m = Value 1 [M] []
s = Value 1 [S] []
kg = Value 1 [Kg] []
rev = Value 1 [Rev] []
s2 = s * s
cm = 0.01 * m
cm2 = cm * cm
cm3 = cm * cm * cm
mm = 0.1 * cm
km = 1000 * m
ml = cm3
l = 1000 * ml
g = 0.001 * kg
mg = 0.001 * g
in' = 2.54 * cm
in2 = in' * in'
in3 = in' * in' * in'
ft = 12 * in'
ns = 0.000000001 *s
us = 0.000001 *s
ms = 0.001 * s
min' = 60 * s
h = 60 * min'
n = kg * m / s2
lbs = 4.4482216152605 * n
mi = 5280 * ft
gal = 231 * in3
hp = 33000 * ft * lbs / min'
kw = 1.3410220888 * hp
w = 0.001 * kw
psi = lbs / in2
bar = 14.5037738 * psi
mph = mi / h
kph = km / h
rpm = rev / min'
gpm = gal / min'
lpm = l / min'
radsPerRev = 2 * pi / rev
j = n * m
btu = 1055.05585 * j