{-# LANGUAGE RebindableSyntax #-}
{- |
Abstract Physical Units
-}

module Number.Physical.Unit where

import MathObj.DiscreteMap (strip)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe(fromJust,fromMaybe)

import qualified Number.Ratio as Ratio

import Data.Maybe.HT(toMaybe)

import NumericPrelude.Base
import NumericPrelude.Numeric

{- | A Unit.T is a sparse vector with integer entries
   Each map n->m means that the unit of the n-th dimension
   is given m times.

   Example: Let the quantity of length (meter, m) be the zeroth dimension
   and let the quantity of time (second, s) be the first dimension,
   then the composed unit @m/s^2@ corresponds to the Map
   @[(0,1),(1,-2)]@.

   In future I want to have more abstraction here,
   e.g. a type class from the Edison project
   that abstracts from the underlying implementation.
   Then one can easily switch between
   Arrays, Binary trees (like Map) and what know I.
-}
type T i = Map i Int

-- | The neutral Unit.T
scalar :: T i
scalar :: T i
scalar = T i
forall k a. Map k a
Map.empty

-- | Test for the neutral Unit.T
isScalar ::  T i -> Bool
isScalar :: T i -> Bool
isScalar = T i -> Bool
forall k a. Map k a -> Bool
Map.null

-- | Convert a List to sparse Map representation
-- Example: [-1,0,-2] -> [(0,-1),(2,-2)]
fromVector :: (Enum i, Ord i) => [Int] -> T i
fromVector :: [Int] -> T i
fromVector [Int]
x = T i -> T i
forall i v. (Ord i, Eq v, C v) => Map i v -> Map i v
strip ([(i, Int)] -> T i
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([i] -> [Int] -> [(i, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> i
forall a. Enum a => Int -> a
toEnum Int
0 .. Int -> i
forall a. Enum a => Int -> a
toEnum (([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
x)Int -> Int -> Int
forall a. C a => a -> a -> a
-Int
1)] [Int]
x))

-- | Convert Map to a List
toVector :: (Enum i, Ord i) => T i -> [Int]
toVector :: T i -> [Int]
toVector T i
x = (i -> Int) -> [i] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((i -> T i -> Int) -> T i -> i -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> i -> T i -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0) T i
x)
                     [(Int -> i
forall a. Enum a => Int -> a
toEnum Int
0)..([i] -> i
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (T i -> [i]
forall k a. Map k a -> [k]
Map.keys T i
x))]


ratScale :: Ratio.T Int -> T i -> T i
ratScale :: T Int -> T i -> T i
ratScale T Int
expo =
   (Maybe Int -> Int) -> Map i (Maybe Int) -> T i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Physics.Quantity.Unit.ratScale: fractional result")) (Map i (Maybe Int) -> T i)
-> (T i -> Map i (Maybe Int)) -> T i -> T i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T Int -> T i -> Map i (Maybe Int)
forall i. T Int -> T i -> Map i (Maybe Int)
ratScaleMaybe2 T Int
expo

ratScaleMaybe :: Ratio.T Int -> T i -> Maybe (T i)
ratScaleMaybe :: T Int -> T i -> Maybe (T i)
ratScaleMaybe T Int
expo T i
u =
   let fmMaybe :: Map i (Maybe Int)
fmMaybe = T Int -> T i -> Map i (Maybe Int)
forall i. T Int -> T i -> Map i (Maybe Int)
ratScaleMaybe2 T Int
expo T i
u
   in  Bool -> T i -> Maybe (T i)
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (Maybe Int
forall a. Maybe a
Nothing Maybe Int -> [Maybe Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map i (Maybe Int) -> [Maybe Int]
forall k a. Map k a -> [a]
Map.elems Map i (Maybe Int)
fmMaybe))
               ((Maybe Int -> Int) -> Map i (Maybe Int) -> T i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Map i (Maybe Int)
fmMaybe)

-- helper function for ratScale and ratScaleMaybe
ratScaleMaybe2 :: Ratio.T Int -> T i -> Map i (Maybe Int)
ratScaleMaybe2 :: T Int -> T i -> Map i (Maybe Int)
ratScaleMaybe2 T Int
expo =
   (Int -> Maybe Int) -> T i -> Map i (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
c -> let y :: T Int
y = Int -> T Int -> T Int
forall a. C a => a -> T a -> T a
Ratio.scale Int
c T Int
expo
               in  Bool -> Int -> Maybe Int
forall a. Bool -> a -> Maybe a
toMaybe (T Int -> Int
forall a. T a -> a
denominator T Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (T Int -> Int
forall a. T a -> a
numerator T Int
y))


{- impossible because Unit.T is a type synonym but not a data type
instance Show (Unit.T i) where
  show = show.toVector
-}