{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
Numeric values combined with abstract Physical Units
-}

module Number.Physical where

import qualified Number.Physical.Unit as Unit

import           Algebra.OccasionallyScalar  as OccScalar
import qualified Algebra.VectorSpace         as VectorSpace
import qualified Algebra.Module              as Module
import qualified Algebra.Vector              as Vector
import qualified Algebra.Transcendental      as Trans
import qualified Algebra.Algebraic           as Algebraic
import qualified Algebra.Field               as Field
import qualified Algebra.Absolute            as Absolute
import qualified Algebra.Ring                as Ring
import qualified Algebra.Additive            as Additive
import qualified Algebra.ZeroTestable        as ZeroTestable

import qualified Algebra.ToInteger      as ToInteger

import qualified Number.Ratio as Ratio

import Control.Monad (guard, liftM, liftM2, ap)
import Control.Applicative (Applicative(pure, (<*>)))

import Data.Maybe.HT(toMaybe)
import Data.Maybe(fromMaybe)

import NumericPrelude.Numeric
import NumericPrelude.Base


-- | A Physics.Quantity.Value.T combines a numeric value with a physical unit.
data T i a = Cons (Unit.T i) a

-- | Construct a physical value from a numeric value and
-- the full vector representation of a unit.
quantity :: (Ord i, Enum i, Ring.C a) => [Int] -> a -> T i a
quantity :: [Int] -> a -> T i a
quantity [Int]
v = T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons ([Int] -> T i
forall i. (Enum i, Ord i) => [Int] -> T i
Unit.fromVector [Int]
v)

fromScalarSingle :: a -> T i a
fromScalarSingle :: a -> T i a
fromScalarSingle = T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons T i
forall i. T i
Unit.scalar

-- | Test for the neutral Unit.T. Also a zero has a unit!
isScalar :: T i a -> Bool
isScalar :: T i a -> Bool
isScalar (Cons T i
u a
_) = T i -> Bool
forall i. T i -> Bool
Unit.isScalar T i
u


{- Using (((join.).).liftM2) you can turn madd and msub
   into operations that map Maybes to Maybes -}

-- | apply a function to the numeric value while preserving the unit
lift :: (a -> b) -> T i a -> T i b
lift :: (a -> b) -> T i a -> T i b
lift a -> b
f (Cons T i
xu a
x) = T i -> b -> T i b
forall i a. T i -> a -> T i a
Cons T i
xu (a -> b
f a
x)

lift2 :: (Eq i) => String -> (a -> b -> c) -> T i a -> T i b -> T i c
lift2 :: String -> (a -> b -> c) -> T i a -> T i b -> T i c
lift2 String
opName a -> b -> c
op T i a
x T i b
y =
   T i c -> Maybe (T i c) -> T i c
forall a. a -> Maybe a -> a
fromMaybe (String -> T i c
forall a. String -> a
errorUnitMismatch String
opName) ((a -> b -> c) -> T i a -> T i b -> Maybe (T i c)
forall i a b c.
Eq i =>
(a -> b -> c) -> T i a -> T i b -> Maybe (T i c)
lift2Maybe a -> b -> c
op T i a
x T i b
y)

lift2Maybe :: (Eq i) => (a -> b -> c) -> T i a -> T i b -> Maybe (T i c)
lift2Maybe :: (a -> b -> c) -> T i a -> T i b -> Maybe (T i c)
lift2Maybe a -> b -> c
op (Cons T i
xu a
x) (Cons T i
yu b
y) =
   Bool -> T i c -> Maybe (T i c)
forall a. Bool -> a -> Maybe a
toMaybe (T i
xuT i -> T i -> Bool
forall a. Eq a => a -> a -> Bool
==T i
yu) (T i -> c -> T i c
forall i a. T i -> a -> T i a
Cons T i
xu (a -> b -> c
op a
x b
y))

lift2Gen :: (Eq i) => String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen :: String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
opName a -> b -> c
op (Cons T i
xu a
x) (Cons T i
yu b
y) =
   if (T i
xuT i -> T i -> Bool
forall a. Eq a => a -> a -> Bool
==T i
yu)
     then a -> b -> c
op a
x b
y
     else String -> c
forall a. String -> a
errorUnitMismatch String
opName

errorUnitMismatch :: String -> a
errorUnitMismatch :: String -> a
errorUnitMismatch String
opName =
   String -> a
forall a. HasCallStack => String -> a
error (String
"Physics.Quantity.Value."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
opNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": units mismatch")



-- | Add two values if the units match, otherwise return Nothing
addMaybe :: (Eq i, Additive.C a) =>
  T i a -> T i a -> Maybe (T i a)
addMaybe :: T i a -> T i a -> Maybe (T i a)
addMaybe = (a -> a -> a) -> T i a -> T i a -> Maybe (T i a)
forall i a b c.
Eq i =>
(a -> b -> c) -> T i a -> T i b -> Maybe (T i c)
lift2Maybe a -> a -> a
forall a. C a => a -> a -> a
(+)

-- | Subtract two values if the units match, otherwise return Nothing
subMaybe :: (Eq i, Additive.C a) =>
  T i a -> T i a -> Maybe (T i a)
subMaybe :: T i a -> T i a -> Maybe (T i a)
subMaybe = (a -> a -> a) -> T i a -> T i a -> Maybe (T i a)
forall i a b c.
Eq i =>
(a -> b -> c) -> T i a -> T i b -> Maybe (T i c)
lift2Maybe (-)


scale :: (Ord i, Ring.C a) => a -> T i a -> T i a
scale :: a -> T i a -> T i a
scale a
x = (a -> a) -> T i a -> T i a
forall a b i. (a -> b) -> T i a -> T i b
lift (a
xa -> a -> a
forall a. C a => a -> a -> a
*)

ratPow :: Trans.C a => Ratio.T Int -> T i a -> T i a
ratPow :: T Int -> T i a -> T i a
ratPow T Int
expo (Cons T i
xu a
x) =
  T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons (T Int -> T i -> T i
forall i. T Int -> T i -> T i
Unit.ratScale T Int
expo T i
xu) (a
x a -> a -> a
forall a. C a => a -> a -> a
** T Int -> a
forall b a. (C b, C a) => T a -> b
fromRatio T Int
expo)

ratPowMaybe :: (Trans.C a) =>
    Ratio.T Int -> T i a -> Maybe (T i a)
ratPowMaybe :: T Int -> T i a -> Maybe (T i a)
ratPowMaybe T Int
expo (Cons T i
xu a
x) =
  (T i -> T i a) -> Maybe (T i) -> Maybe (T i a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T i -> a -> T i a) -> a -> T i -> T i a
forall a b c. (a -> b -> c) -> b -> a -> c
flip T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons (a
x a -> a -> a
forall a. C a => a -> a -> a
** T Int -> a
forall b a. (C b, C a) => T a -> b
fromRatio T Int
expo)) (T Int -> T i -> Maybe (T i)
forall i. T Int -> T i -> Maybe (T i)
Unit.ratScaleMaybe T Int
expo T i
xu)

fromRatio :: (Field.C b, ToInteger.C a) => Ratio.T a -> b
fromRatio :: T a -> b
fromRatio T a
expo = a -> b
forall a b. (C a, C b) => a -> b
fromIntegral (T a -> a
forall a. T a -> a
numerator T a
expo) b -> b -> b
forall a. C a => a -> a -> a
/
                 a -> b
forall a b. (C a, C b) => a -> b
fromIntegral (T a -> a
forall a. T a -> a
denominator T a
expo)



instance (ZeroTestable.C v) => ZeroTestable.C (T a v) where
  isZero :: T a v -> Bool
isZero (Cons T a
_ v
x) = v -> Bool
forall a. C a => a -> Bool
isZero v
x

instance (Eq i, Eq a) => Eq (T i a) where
  == :: T i a -> T i a -> Bool
(==) = String -> (a -> a -> Bool) -> T i a -> T i a -> Bool
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
"(==)" a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance (Ord i, Enum i, Show a) => Show (T i a) where
  --show (Cons xu x) = show x ++ " !* " ++ show (Unit.toVector xu)
  show :: T i a -> String
show (Cons T i
xu a
x) = String
"quantity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (T i -> [Int]
forall i. (Enum i, Ord i) => T i -> [Int]
Unit.toVector T i
xu) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x

instance (Ord i, Additive.C a) => Additive.C (T i a) where
  zero :: T i a
zero   = a -> T i a
forall a i. a -> T i a
fromScalarSingle a
forall a. C a => a
zero
  -- Add two values if the units match, otherwise raise an error
  + :: T i a -> T i a -> T i a
(+)    = String -> (a -> a -> a) -> T i a -> T i a -> T i a
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> T i c
lift2 String
"(+)" a -> a -> a
forall a. C a => a -> a -> a
(+)
  -- Subtract two values if the units match, otherwise raise an error
  (-)    = String -> (a -> a -> a) -> T i a -> T i a -> T i a
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> T i c
lift2 String
"(-)" (-)
  negate :: T i a -> T i a
negate = (a -> a) -> T i a -> T i a
forall a b i. (a -> b) -> T i a -> T i b
lift a -> a
forall a. C a => a -> a
negate

instance (Ord i, Ring.C a) => Ring.C (T i a) where
  (Cons T i
xu a
x) * :: T i a -> T i a -> T i a
* (Cons T i
yu a
y) = T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons (T i
xuT i -> T i -> T i
forall a. C a => a -> a -> a
+T i
yu) (a
xa -> a -> a
forall a. C a => a -> a -> a
*a
y)
  fromInteger :: Integer -> T i a
fromInteger = a -> T i a
forall a i. a -> T i a
fromScalarSingle (a -> T i a) -> (Integer -> a) -> Integer -> T i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. C a => Integer -> a
fromInteger

instance (Ord i, Ord a) => Ord (T i a) where
  max :: T i a -> T i a -> T i a
max     = String -> (a -> a -> a) -> T i a -> T i a -> T i a
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> T i c
lift2    String
"max"     a -> a -> a
forall a. Ord a => a -> a -> a
max
  min :: T i a -> T i a -> T i a
min     = String -> (a -> a -> a) -> T i a -> T i a -> T i a
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> T i c
lift2    String
"min"     a -> a -> a
forall a. Ord a => a -> a -> a
min
  compare :: T i a -> T i a -> Ordering
compare = String -> (a -> a -> Ordering) -> T i a -> T i a -> Ordering
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
"compare" a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
  < :: T i a -> T i a -> Bool
(<)     = String -> (a -> a -> Bool) -> T i a -> T i a -> Bool
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
"(<)"     a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
  > :: T i a -> T i a -> Bool
(>)     = String -> (a -> a -> Bool) -> T i a -> T i a -> Bool
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
"(>)"     a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
  <= :: T i a -> T i a -> Bool
(<=)    = String -> (a -> a -> Bool) -> T i a -> T i a -> Bool
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
"(<=)"    a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
  >= :: T i a -> T i a -> Bool
(>=)    = String -> (a -> a -> Bool) -> T i a -> T i a -> Bool
forall i a b c.
Eq i =>
String -> (a -> b -> c) -> T i a -> T i b -> c
lift2Gen String
"(>=)"    a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

{-
  Are absolute value and signum sensible for unit values?
  What is the sign, what is the absolute value?
  We could see it this way:
  The absolute value has no unit and
  the signum contains the unit and the scalar's sign.
  However the units contain also information of magnitude.
  E.g. if the base unit would be gramm instead kilogramm
  then the scalars would grow to a factor thousand.

  So is it better to give
  the absolute value unit and the absolute value of the scalar and
  the signum has no unit and the signum of the scalar?
  But the unit may also carry a kind of 'negativity' inside,
  e.g. the electric charge.

  It seems that there is no clear answer.
  However in my synthesizer application
  I need absolute values for sample rates and amplitudes.
  There the second interpretation is needed.
-}
instance (Ord i, Absolute.C a) => Absolute.C (T i a) where
  abs :: T i a -> T i a
abs               = (a -> a) -> T i a -> T i a
forall a b i. (a -> b) -> T i a -> T i b
lift a -> a
forall a. C a => a -> a
abs
  signum :: T i a -> T i a
signum (Cons T i
_ a
x) = a -> T i a
forall a i. a -> T i a
fromScalarSingle (a -> a
forall a. C a => a -> a
signum a
x)


instance (Ord i, Field.C a) => Field.C (T i a) where
  (Cons T i
xu a
x) / :: T i a -> T i a -> T i a
/ (Cons T i
yu a
y) = T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons (T i
xuT i -> T i -> T i
forall a. C a => a -> a -> a
-T i
yu) (a
xa -> a -> a
forall a. C a => a -> a -> a
/a
y)
  fromRational' :: Rational -> T i a
fromRational' = a -> T i a
forall a i. a -> T i a
fromScalarSingle (a -> T i a) -> (Rational -> a) -> Rational -> T i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. C a => Rational -> a
fromRational'

instance (Ord i, Algebraic.C a) => Algebraic.C (T i a) where
  sqrt :: T i a -> T i a
sqrt (Cons T i
xu a
x) = T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons (T Int -> T i -> T i
forall i. T Int -> T i -> T i
Unit.ratScale T Int
0.5 T i
xu) (a -> a
forall a. C a => a -> a
sqrt a
x)
  Cons T i
xu a
x ^/ :: T i a -> Rational -> T i a
^/ Rational
y =
     T i -> a -> T i a
forall i a. T i -> a -> T i a
Cons (T Int -> T i -> T i
forall i. T Int -> T i -> T i
Unit.ratScale (Rational -> T Int
forall a. C a => Rational -> a
fromRational' Rational
y) T i
xu) (a
x a -> Rational -> a
forall a. C a => a -> Rational -> a
^/ Rational
y)

instance (Ord i, Trans.C a) => Trans.C (T i a) where
  pi :: T i a
pi      = a -> T i a
forall a i. a -> T i a
fromScalarSingle a
forall a. C a => a
pi
  log :: T i a -> T i a
log     = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
log
  exp :: T i a -> T i a
exp     = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
exp
  logBase :: T i a -> T i a -> T i a
logBase = (a -> a -> a) -> T i a -> T i a -> T i a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. C a => a -> a -> a
logBase
  ** :: T i a -> T i a -> T i a
(**)    = (a -> a -> a) -> T i a -> T i a -> T i a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. C a => a -> a -> a
(**)
  cos :: T i a -> T i a
cos     = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
cos
  tan :: T i a -> T i a
tan     = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
tan
  sin :: T i a -> T i a
sin     = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
sin
  acos :: T i a -> T i a
acos    = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
acos
  atan :: T i a -> T i a
atan    = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
atan
  asin :: T i a -> T i a
asin    = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
asin
  cosh :: T i a -> T i a
cosh    = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
cosh
  tanh :: T i a -> T i a
tanh    = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
tanh
  sinh :: T i a -> T i a
sinh    = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
sinh
  acosh :: T i a -> T i a
acosh   = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
acosh
  atanh :: T i a -> T i a
atanh   = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
atanh
  asinh :: T i a -> T i a
asinh   = (a -> a) -> T i a -> T i a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  a -> a
forall a. C a => a -> a
asinh

instance Ord i => Vector.C (T i) where
  zero :: T i a
zero  = T i a
forall a. C a => a
zero
  <+> :: T i a -> T i a -> T i a
(<+>) = T i a -> T i a -> T i a
forall a. C a => a -> a -> a
(+)
  *> :: a -> T i a -> T i a
(*>)  = a -> T i a -> T i a
forall i a. (Ord i, C a) => a -> T i a -> T i a
scale

instance (Ord i, Module.C a v) => Module.C a (T i v) where
  a
x *> :: a -> T i v -> T i v
*> (Cons T i
yu v
y) = T i -> v -> T i v
forall i a. T i -> a -> T i a
Cons T i
yu (a
x a -> v -> v
forall a v. C a v => a -> v -> v
Module.*> v
y)

instance (Ord i, VectorSpace.C a v) => VectorSpace.C a (T i v)


instance (OccScalar.C a v)
      => OccScalar.C a (T i v) where
   toScalar :: T i v -> a
toScalar = T i v -> a
forall a v. C a v => v -> a
toScalarDefault
   toMaybeScalar :: T i v -> Maybe a
toMaybeScalar (Cons T i
xu v
x)
            = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (T i -> Bool
forall i. T i -> Bool
Unit.isScalar T i
xu) Maybe () -> Maybe a -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v -> Maybe a
forall a v. C a v => v -> Maybe a
toMaybeScalar v
x
   fromScalar :: a -> T i v
fromScalar = v -> T i v
forall a i. a -> T i a
fromScalarSingle (v -> T i v) -> (a -> v) -> a -> T i v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> v
forall a v. C a v => a -> v
fromScalar



{- Operators for lifting scalar operations to
   operations on physical values -}
instance Functor (T i) where
  fmap :: (a -> b) -> T i a -> T i b
fmap a -> b
f (Cons T i
xu a
x) =
    if T i -> Bool
forall i. T i -> Bool
Unit.isScalar T i
xu
    then b -> T i b
forall a i. a -> T i a
fromScalarSingle (a -> b
f a
x)
    else String -> T i b
forall a. HasCallStack => String -> a
error String
"Physics.Quantity.Value.fmap: function for scalars, only"

instance Applicative (T a) where
   <*> :: T a (a -> b) -> T a a -> T a b
(<*>) = T a (a -> b) -> T a a -> T a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
   pure :: a -> T a a
pure = a -> T a a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance Monad (T i) where
  >>= :: T i a -> (a -> T i b) -> T i b
(>>=) (Cons T i
xu a
x) a -> T i b
f =
    if T i -> Bool
forall i. T i -> Bool
Unit.isScalar T i
xu
    then a -> T i b
f a
x
    else String -> T i b
forall a. HasCallStack => String -> a
error String
"Physics.Quantity.Value.(>>=): function for scalars, only"
  return :: a -> T i a
return = a -> T i a
forall a i. a -> T i a
fromScalarSingle