{-# LANGUAGE FlexibleInstances #-}

module Currycarbon.SumCalibration where

import           Currycarbon.Calibration.Calibration
import           Currycarbon.Calibration.Utils
import           Currycarbon.Types
import           Currycarbon.Utils

import           Data.Foldable                       (foldl')
import           Data.List                           (groupBy, sortBy)
import           Data.Ord                            (comparing)
import qualified Data.Vector.Unboxed                 as VU

evalNamedCalExpr :: CalibrateDatesConf -> CalCurveBP -> NamedCalExpr -> Either CurrycarbonException CalPDF
evalNamedCalExpr :: CalibrateDatesConf
-> CalCurveBP -> NamedCalExpr -> Either CurrycarbonException CalPDF
evalNamedCalExpr CalibrateDatesConf
conf CalCurveBP
curve (NamedCalExpr String
exprID CalExpr
expr) =
    case CalibrateDatesConf
-> CalCurveBP -> CalExpr -> Either CurrycarbonException CalPDF
evalCalExpr CalibrateDatesConf
conf CalCurveBP
curve CalExpr
expr of
        Left CurrycarbonException
err     -> forall a b. a -> Either a b
Left CurrycarbonException
err
        Right CalPDF
calPDF -> forall a b. b -> Either a b
Right CalPDF
calPDF { _calPDFid :: String
_calPDFid = String
exprID }

-- | Evaluate a dating expression by calibrating the individual dates and forming the respective
--   sums and products of post-calibration density distributions
evalCalExpr :: CalibrateDatesConf -> CalCurveBP -> CalExpr -> Either CurrycarbonException CalPDF
evalCalExpr :: CalibrateDatesConf
-> CalCurveBP -> CalExpr -> Either CurrycarbonException CalPDF
evalCalExpr CalibrateDatesConf
conf CalCurveBP
curve CalExpr
calExpr = Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
norm forall a b. (a -> b) -> a -> b
$ CalExpr -> Either CurrycarbonException CalPDF
evalE CalExpr
calExpr
    where
        evalE :: CalExpr -> Either CurrycarbonException CalPDF
        -- these are already normalized by their constructors
        evalE :: CalExpr -> Either CurrycarbonException CalPDF
evalE (UnCalDate UncalC14
a)    = CalibrateDatesConf
-> CalCurveBP -> UncalC14 -> Either CurrycarbonException CalPDF
calibrateDate CalibrateDatesConf
conf CalCurveBP
curve UncalC14
a
        evalE (WindowBP TimeWindowBP
a)     = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ TimeWindowBP -> CalPDF
windowBP2CalPDF TimeWindowBP
a
        evalE (WindowBCAD TimeWindowBCAD
a)   = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ TimeWindowBCAD -> CalPDF
windowBCAD2CalPDF TimeWindowBCAD
a
        -- this can theoretically be non-normalized input
        evalE (CalDate CalPDF
a)      = Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
norm forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right CalPDF
a
        -- sums must not be normalized
        evalE (SumCal CalExpr
a CalExpr
b)     = (Float -> Float -> Float)
-> Float
-> Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
eitherCombinePDFs forall a. Num a => a -> a -> a
(+) Float
0 (CalExpr -> Either CurrycarbonException CalPDF
evalE CalExpr
a) (CalExpr -> Either CurrycarbonException CalPDF
evalE CalExpr
b)
        -- products must be normalized (and their input, in case it's a sum)
        evalE (ProductCal CalExpr
a CalExpr
b) = Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
norm forall a b. (a -> b) -> a -> b
$ (Float -> Float -> Float)
-> Float
-> Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
eitherCombinePDFs forall a. Num a => a -> a -> a
(*) Float
1 (Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
norm forall a b. (a -> b) -> a -> b
$ CalExpr -> Either CurrycarbonException CalPDF
evalE CalExpr
a) (Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
norm forall a b. (a -> b) -> a -> b
$ CalExpr -> Either CurrycarbonException CalPDF
evalE CalExpr
b)
        norm :: Either CurrycarbonException CalPDF -> Either CurrycarbonException CalPDF
        norm :: Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
norm = forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapEither forall a. a -> a
id CalPDF -> CalPDF
normalizeCalPDF
        -- https://hackage.haskell.org/package/either-5.0.2/docs/Data-Either-Combinators.html
        mapEither :: (a -> c) -> (b -> d) -> Either a b -> Either c d
        mapEither :: forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapEither a -> c
f b -> d
_ (Left a
x)  = forall a b. a -> Either a b
Left (a -> c
f a
x)
        mapEither a -> c
_ b -> d
f (Right b
x) = forall a b. b -> Either a b
Right (b -> d
f b
x)

eitherCombinePDFs ::
    (Float -> Float -> Float) -> Float ->
    Either CurrycarbonException CalPDF ->
    Either CurrycarbonException CalPDF ->
    Either CurrycarbonException CalPDF
eitherCombinePDFs :: (Float -> Float -> Float)
-> Float
-> Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
-> Either CurrycarbonException CalPDF
eitherCombinePDFs Float -> Float -> Float
_ Float
_ (Left CurrycarbonException
e) Either CurrycarbonException CalPDF
_ = forall a b. a -> Either a b
Left CurrycarbonException
e
eitherCombinePDFs Float -> Float -> Float
_ Float
_ Either CurrycarbonException CalPDF
_ (Left CurrycarbonException
e) = forall a b. a -> Either a b
Left CurrycarbonException
e
eitherCombinePDFs Float -> Float -> Float
f Float
initVal (Right CalPDF
a) (Right CalPDF
b) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (Float -> Float -> Float) -> Float -> CalPDF -> CalPDF -> CalPDF
combinePDFs Float -> Float -> Float
f Float
initVal CalPDF
a CalPDF
b

-- | Add two probability densities
addPDFs :: CalPDF -> CalPDF -> CalPDF
addPDFs :: CalPDF -> CalPDF -> CalPDF
addPDFs = (Float -> Float -> Float) -> Float -> CalPDF -> CalPDF -> CalPDF
combinePDFs forall a. Num a => a -> a -> a
(+) Float
0

-- | Multiply two probability densities
multiplyPDFs :: CalPDF -> CalPDF -> CalPDF
multiplyPDFs :: CalPDF -> CalPDF -> CalPDF
multiplyPDFs = (Float -> Float -> Float) -> Float -> CalPDF -> CalPDF -> CalPDF
combinePDFs forall a. Num a => a -> a -> a
(*) Float
1

-- Combine probability densities
combinePDFs :: (Float -> Float -> Float) -> Float -> CalPDF -> CalPDF -> CalPDF
combinePDFs :: (Float -> Float -> Float) -> Float -> CalPDF -> CalPDF -> CalPDF
combinePDFs Float -> Float -> Float
f Float
initVal (CalPDF String
name1 Vector YearBCAD
cals1 Vector Float
dens1) (CalPDF String
name2 Vector YearBCAD
cals2 Vector Float
dens2) =
        let minC1 :: YearBCAD
minC1 = forall a. (Unbox a, Ord a) => Vector a -> a
VU.minimum Vector YearBCAD
cals1
            minC2 :: YearBCAD
minC2 = forall a. (Unbox a, Ord a) => Vector a -> a
VU.minimum Vector YearBCAD
cals2
            maxC1 :: YearBCAD
maxC1 = forall a. (Unbox a, Ord a) => Vector a -> a
VU.maximum Vector YearBCAD
cals1
            maxC2 :: YearBCAD
maxC2 = forall a. (Unbox a, Ord a) => Vector a -> a
VU.maximum Vector YearBCAD
cals2
            emptyC1 :: [YearBCAD]
emptyC1 = YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [YearBCAD]
getMiss YearBCAD
minC1 YearBCAD
maxC1 YearBCAD
minC2 YearBCAD
maxC2
            emptyC2 :: [YearBCAD]
emptyC2 = YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [YearBCAD]
getMiss YearBCAD
minC2 YearBCAD
maxC2 YearBCAD
minC1 YearBCAD
maxC1
            c1 :: [(YearBCAD, Float)]
c1 = forall a. Unbox a => Vector a -> [a]
VU.toList (forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
VU.zip Vector YearBCAD
cals1 Vector Float
dens1) forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [YearBCAD]
emptyC1 (forall a. a -> [a]
repeat (Float
0 :: Float))
            c2 :: [(YearBCAD, Float)]
c2 = forall a. Unbox a => Vector a -> [a]
VU.toList (forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
VU.zip Vector YearBCAD
cals2 Vector Float
dens2) forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [YearBCAD]
emptyC2 (forall a. a -> [a]
repeat (Float
0 :: Float))
            pdfSorted :: [(YearBCAD, Float)]
pdfSorted = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) ([(YearBCAD, Float)]
c1 forall a. [a] -> [a] -> [a]
++ [(YearBCAD, Float)]
c2)
            pdfGrouped :: [[(YearBCAD, Float)]]
pdfGrouped = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(YearBCAD, Float)
a (YearBCAD, Float)
b -> forall a b. (a, b) -> a
fst (YearBCAD, Float)
a forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (YearBCAD, Float)
b) [(YearBCAD, Float)]
pdfSorted
            pdfRes :: [(YearBCAD, Float)]
pdfRes = forall a b. (a -> b) -> [a] -> [b]
map [(YearBCAD, Float)] -> (YearBCAD, Float)
foldYearGroup [[(YearBCAD, Float)]]
pdfGrouped
        in String -> Vector YearBCAD -> Vector Float -> CalPDF
CalPDF (String
name1 forall a. [a] -> [a] -> [a]
++ String
";" forall a. [a] -> [a] -> [a]
++ String
name2) (forall a. Unbox a => [a] -> Vector a
VU.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(YearBCAD, Float)]
pdfRes) (forall a. Unbox a => [a] -> Vector a
VU.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(YearBCAD, Float)]
pdfRes)
        where
            getMiss :: YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [YearBCAD]
            getMiss :: YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [YearBCAD]
getMiss YearBCAD
a1 YearBCAD
a2 YearBCAD
b1 YearBCAD
b2
                | YearBCAD
a1 forall a. Ord a => a -> a -> Bool
<  YearBCAD
b1 Bool -> Bool -> Bool
&& YearBCAD
a2 forall a. Ord a => a -> a -> Bool
>  YearBCAD
b2 = [YearBCAD
a1..YearBCAD
b1] forall a. [a] -> [a] -> [a]
++ [YearBCAD
b2..YearBCAD
a2]
                | YearBCAD
a1 forall a. Ord a => a -> a -> Bool
<  YearBCAD
b1 Bool -> Bool -> Bool
&& YearBCAD
a2 forall a. Ord a => a -> a -> Bool
<= YearBCAD
b2 = [YearBCAD
a1..YearBCAD
b1]
                | YearBCAD
a1 forall a. Ord a => a -> a -> Bool
>= YearBCAD
b1 Bool -> Bool -> Bool
&& YearBCAD
a2 forall a. Ord a => a -> a -> Bool
>  YearBCAD
b2 = [YearBCAD
b2..YearBCAD
a2]
                | Bool
otherwise = []
            foldYearGroup :: [(YearBCAD, Float)] -> (YearBCAD, Float)
            foldYearGroup :: [(YearBCAD, Float)] -> (YearBCAD, Float)
foldYearGroup [(YearBCAD, Float)]
oneYear = (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(YearBCAD, Float)]
oneYear, forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Float -> Float -> Float
f Float
initVal forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(YearBCAD, Float)]
oneYear)

-- | Create pseudo-CalPDF from RangeBCAD
windowBCAD2CalPDF :: TimeWindowBCAD -> CalPDF
windowBCAD2CalPDF :: TimeWindowBCAD -> CalPDF
windowBCAD2CalPDF (TimeWindowBCAD String
name YearBCAD
start YearBCAD
stop) =
    let years :: Vector YearBCAD
years = forall a. Unbox a => [a] -> Vector a
VU.fromList forall a b. (a -> b) -> a -> b
$ [YearBCAD
start..YearBCAD
stop]
        dens :: Vector Float
dens = forall a. Unbox a => YearBCAD -> a -> Vector a
VU.replicate (forall a. Unbox a => Vector a -> YearBCAD
VU.length Vector YearBCAD
years) Float
1
    in CalPDF -> CalPDF
normalizeCalPDF forall a b. (a -> b) -> a -> b
$ String -> Vector YearBCAD -> Vector Float -> CalPDF
CalPDF String
name Vector YearBCAD
years Vector Float
dens

windowBP2CalPDF :: TimeWindowBP -> CalPDF
windowBP2CalPDF :: TimeWindowBP -> CalPDF
windowBP2CalPDF (TimeWindowBP String
name YearBP
start YearBP
stop) =
    TimeWindowBCAD -> CalPDF
windowBCAD2CalPDF (String -> YearBCAD -> YearBCAD -> TimeWindowBCAD
TimeWindowBCAD String
name (YearBP -> YearBCAD
bp2BCAD YearBP
start) (YearBP -> YearBCAD
bp2BCAD YearBP
stop))