{-# LANGUAGE OverloadedStrings #-}
module Currycarbon.Parsers where
import Currycarbon.ParserHelpers
import Currycarbon.Types
import Currycarbon.Utils
import Control.Exception (throwIO)
import Data.List (intercalate, transpose)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Text.Parsec as P
import qualified Text.Parsec.String as P
readCalibrationMethod :: String -> Either String CalibrationMethod
readCalibrationMethod :: [Char] -> Either [Char] CalibrationMethod
readCalibrationMethod [Char]
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parser CalibrationMethod
parseCalibrationMethod () [Char]
"" [Char]
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
showParsecErr ParseError
err
Right CalibrationMethod
x -> forall a b. b -> Either a b
Right CalibrationMethod
x
parseCalibrationMethod :: P.Parser CalibrationMethod
parseCalibrationMethod :: Parser CalibrationMethod
parseCalibrationMethod = do
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalibrationMethod
bchron forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall {u}. ParsecT [Char] u Identity CalibrationMethod
matrixMultiplication
where
bchron :: Parser CalibrationMethod
bchron = do
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string [Char]
"Bchron,"
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalibrationMethod
studentT forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall {u}. ParsecT [Char] u Identity CalibrationMethod
normal
studentT :: Parser CalibrationMethod
studentT = do
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string [Char]
"StudentT,"
Double
dof <- Parser Double
parsePositiveDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CalibrationDistribution -> CalibrationMethod
Bchron forall a b. (a -> b) -> a -> b
$ Double -> CalibrationDistribution
StudentTDist Double
dof)
normal :: ParsecT [Char] u Identity CalibrationMethod
normal = do
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string [Char]
"Normal"
forall (m :: * -> *) a. Monad m => a -> m a
return (CalibrationDistribution -> CalibrationMethod
Bchron CalibrationDistribution
NormalDist)
matrixMultiplication :: ParsecT [Char] u Identity CalibrationMethod
matrixMultiplication = do
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string [Char]
"MatrixMult"
forall (m :: * -> *) a. Monad m => a -> m a
return CalibrationMethod
MatrixMultiplication
renderCalDatePretty ::
Bool
-> (NamedCalExpr, CalPDF, CalC14)
-> String
renderCalDatePretty :: Bool -> (NamedCalExpr, CalPDF, CalC14) -> [Char]
renderCalDatePretty Bool
ascii (NamedCalExpr
calExpr, CalPDF
calPDF, CalC14
calC14) =
[Char]
"CalEXPR: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [
NamedCalExpr -> [Char]
renderNamedCalExpr NamedCalExpr
calExpr
, CalC14 -> [Char]
renderCalC14 CalC14
calC14
, Bool -> YearBCAD -> YearBCAD -> CalPDF -> CalC14 -> [Char]
renderCLIPlotCalPDF Bool
ascii YearBCAD
6 YearBCAD
50 CalPDF
calPDF CalC14
calC14
]
renderNamedCalExpr :: NamedCalExpr -> String
renderNamedCalExpr :: NamedCalExpr -> [Char]
renderNamedCalExpr (NamedCalExpr [Char]
exprID CalExpr
calExpr) = [Char] -> [Char]
renderExprID [Char]
exprID forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ CalExpr -> [Char]
renderCalExpr CalExpr
calExpr
renderExprID :: String -> String
renderExprID :: [Char] -> [Char]
renderExprID [Char]
s = [Char]
"[" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"]"
renderCalExpr :: CalExpr -> String
renderCalExpr :: CalExpr -> [Char]
renderCalExpr (UnCalDate UncalC14
a) = UncalC14 -> [Char]
renderUncalC14 UncalC14
a
renderCalExpr (WindowBP TimeWindowBP
a) = TimeWindowBP -> [Char]
renderTimeWindowBP TimeWindowBP
a
renderCalExpr (WindowBCAD TimeWindowBCAD
a) = TimeWindowBCAD -> [Char]
renderTimeWindowBCAD TimeWindowBCAD
a
renderCalExpr (CalDate (CalPDF [Char]
name Vector YearBCAD
_ Vector Float
_)) = [Char]
name
renderCalExpr (SumCal CalExpr
a CalExpr
b) = [Char]
"(" forall a. [a] -> [a] -> [a]
++ CalExpr -> [Char]
renderCalExpr CalExpr
a forall a. [a] -> [a] -> [a]
++ [Char]
" + " forall a. [a] -> [a] -> [a]
++ CalExpr -> [Char]
renderCalExpr CalExpr
b forall a. [a] -> [a] -> [a]
++ [Char]
")"
renderCalExpr (ProductCal CalExpr
a CalExpr
b) = [Char]
"(" forall a. [a] -> [a] -> [a]
++ CalExpr -> [Char]
renderCalExpr CalExpr
a forall a. [a] -> [a] -> [a]
++ [Char]
" * " forall a. [a] -> [a] -> [a]
++ CalExpr -> [Char]
renderCalExpr CalExpr
b forall a. [a] -> [a] -> [a]
++ [Char]
")"
renderTimeWindowBP :: TimeWindowBP -> String
renderTimeWindowBP :: TimeWindowBP -> [Char]
renderTimeWindowBP (TimeWindowBP [Char]
name YearBP
start YearBP
stop) =
[Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ YearBP -> [Char]
renderYearBP YearBP
start forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ YearBP -> [Char]
renderYearBP YearBP
stop
renderTimeWindowBCAD :: TimeWindowBCAD -> String
renderTimeWindowBCAD :: TimeWindowBCAD -> [Char]
renderTimeWindowBCAD (TimeWindowBCAD [Char]
name YearBCAD
start YearBCAD
stop) =
[Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ YearBCAD -> [Char]
renderYearBCAD YearBCAD
start forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ YearBCAD -> [Char]
renderYearBCAD YearBCAD
stop
parseTimeWindowBP :: P.Parser TimeWindowBP
parseTimeWindowBP :: Parser TimeWindowBP
parseTimeWindowBP = forall a. [Char] -> Parser a -> Parser a
parseRecordType [Char]
"rangeBP" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser TimeWindowBP
long forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser TimeWindowBP
short
where
long :: Parser TimeWindowBP
long = do
[Char]
name <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"id" Parser [Char]
parseAnyString
YearBP
start <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"start" Parser YearBP
parseWord
YearBP
stop <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"stop" Parser YearBP
parseWord
forall {m :: * -> *}.
MonadFail m =>
[Char] -> YearBP -> YearBP -> m TimeWindowBP
construct [Char]
name YearBP
start YearBP
stop
short :: Parser TimeWindowBP
short = do
YearBP
start <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"start" Parser YearBP
parseWord
YearBP
stop <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"stop" Parser YearBP
parseWord
forall {m :: * -> *}.
MonadFail m =>
[Char] -> YearBP -> YearBP -> m TimeWindowBP
construct [Char]
"" YearBP
start YearBP
stop
construct :: [Char] -> YearBP -> YearBP -> m TimeWindowBP
construct [Char]
name YearBP
start YearBP
stop = do
if YearBP
start forall a. Ord a => a -> a -> Bool
>= YearBP
stop
then forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> YearBP -> YearBP -> TimeWindowBP
TimeWindowBP [Char]
name YearBP
start YearBP
stop)
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"the BP stop date can not be larger than the start date"
parseTimeWindowBCAD :: P.Parser TimeWindowBCAD
parseTimeWindowBCAD :: Parser TimeWindowBCAD
parseTimeWindowBCAD = forall a. [Char] -> Parser a -> Parser a
parseRecordType [Char]
"rangeBCAD" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser TimeWindowBCAD
long forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser TimeWindowBCAD
short
where
long :: Parser TimeWindowBCAD
long = do
[Char]
name <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"id" Parser [Char]
parseAnyString
YearBCAD
start <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"start" Parser YearBCAD
parseInt
YearBCAD
stop <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"stop" Parser YearBCAD
parseInt
forall {m :: * -> *}.
MonadFail m =>
[Char] -> YearBCAD -> YearBCAD -> m TimeWindowBCAD
construct [Char]
name YearBCAD
start YearBCAD
stop
short :: Parser TimeWindowBCAD
short = do
YearBCAD
start <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"start" Parser YearBCAD
parseInt
YearBCAD
stop <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"stop" Parser YearBCAD
parseInt
forall {m :: * -> *}.
MonadFail m =>
[Char] -> YearBCAD -> YearBCAD -> m TimeWindowBCAD
construct [Char]
"" YearBCAD
start YearBCAD
stop
construct :: [Char] -> YearBCAD -> YearBCAD -> m TimeWindowBCAD
construct [Char]
name YearBCAD
start YearBCAD
stop = do
if YearBCAD
start forall a. Ord a => a -> a -> Bool
<= YearBCAD
stop
then forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> YearBCAD -> YearBCAD -> TimeWindowBCAD
TimeWindowBCAD [Char]
name YearBCAD
start YearBCAD
stop)
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"the BC/AD stop date can not be smaller than the start date"
addFun :: P.Parser CalExpr
addFun :: Parser CalExpr
addFun = forall a. [Char] -> Parser a -> Parser a
parseRecordType [Char]
"sum" forall a b. (a -> b) -> a -> b
$ do
CalExpr
a <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"a" Parser CalExpr
term
CalExpr
b <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"b" Parser CalExpr
expr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CalExpr -> CalExpr -> CalExpr
SumCal CalExpr
a CalExpr
b
addOperator :: P.Parser CalExpr
addOperator :: Parser CalExpr
addOperator = CalExpr -> CalExpr -> CalExpr
SumCal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CalExpr
term forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
parseCharInSpace Char
'+' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CalExpr
expr)
mulFun :: P.Parser CalExpr
mulFun :: Parser CalExpr
mulFun = forall a. [Char] -> Parser a -> Parser a
parseRecordType [Char]
"product" forall a b. (a -> b) -> a -> b
$ do
CalExpr
a <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"a" Parser CalExpr
factor
CalExpr
b <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"b" Parser CalExpr
term
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CalExpr -> CalExpr -> CalExpr
ProductCal CalExpr
a CalExpr
b
mulOperator :: P.Parser CalExpr
mulOperator :: Parser CalExpr
mulOperator = CalExpr -> CalExpr -> CalExpr
ProductCal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CalExpr
factor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
parseCharInSpace Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CalExpr
term)
parens :: P.Parser CalExpr
parens :: Parser CalExpr
parens = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (Char -> Parser Char
parseCharInSpace Char
'(') (Char -> Parser Char
parseCharInSpace Char
')') Parser CalExpr
expr
factor :: P.Parser CalExpr
factor :: Parser CalExpr
factor = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
parens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
addFun
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
mulFun
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (TimeWindowBP -> CalExpr
WindowBP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeWindowBP
parseTimeWindowBP)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (TimeWindowBCAD -> CalExpr
WindowBCAD forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeWindowBCAD
parseTimeWindowBCAD)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> (UncalC14 -> CalExpr
UnCalDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UncalC14
parseUncalC14)
term :: P.Parser CalExpr
term :: Parser CalExpr
term = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
mulOperator forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser CalExpr
factor
expr :: P.Parser CalExpr
expr :: Parser CalExpr
expr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
addOperator forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser CalExpr
term
namedExpr :: P.Parser NamedCalExpr
namedExpr :: Parser NamedCalExpr
namedExpr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser NamedCalExpr
nameBeforeColon forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser NamedCalExpr
record forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser NamedCalExpr
onlyExpr
where
nameBeforeColon :: Parser NamedCalExpr
nameBeforeColon = do
[Char]
name <- Parser [Char]
parseAnyString
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
':'
()
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
CalExpr
ex <- Parser CalExpr
expr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> CalExpr -> NamedCalExpr
NamedCalExpr [Char]
name CalExpr
ex)
record :: Parser NamedCalExpr
record = forall a. [Char] -> Parser a -> Parser a
parseRecordType [Char]
"calExpr" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser NamedCalExpr
long forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser NamedCalExpr
short
long :: Parser NamedCalExpr
long = do
[Char]
name <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"id" Parser [Char]
parseAnyString
CalExpr
ex <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"expr" Parser CalExpr
expr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> CalExpr -> NamedCalExpr
NamedCalExpr [Char]
name CalExpr
ex)
short :: Parser NamedCalExpr
short = do
CalExpr
ex <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"expr" Parser CalExpr
expr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> CalExpr -> NamedCalExpr
NamedCalExpr [Char]
"" CalExpr
ex)
onlyExpr :: Parser NamedCalExpr
onlyExpr = [Char] -> CalExpr -> NamedCalExpr
NamedCalExpr [Char]
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CalExpr
expr
readNamedCalExprs :: String -> Either String [NamedCalExpr]
readNamedCalExprs :: [Char] -> Either [Char] [NamedCalExpr]
readNamedCalExprs [Char]
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parser [NamedCalExpr]
parseCalExprSepBySemicolon () [Char]
"" [Char]
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
showParsecErr ParseError
err
Right [NamedCalExpr]
x -> forall a b. b -> Either a b
Right [NamedCalExpr]
x
where
parseCalExprSepBySemicolon :: P.Parser [NamedCalExpr]
parseCalExprSepBySemicolon :: Parser [NamedCalExpr]
parseCalExprSepBySemicolon = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy Parser NamedCalExpr
namedExpr (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof
readOneNamedCalExpr :: String -> Either String NamedCalExpr
readOneNamedCalExpr :: [Char] -> Either [Char] NamedCalExpr
readOneNamedCalExpr [Char]
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parser NamedCalExpr
namedExpr () [Char]
"" [Char]
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
showParsecErr ParseError
err
Right NamedCalExpr
x -> forall a b. b -> Either a b
Right NamedCalExpr
x
readNamedCalExprsFromFile :: FilePath -> IO [NamedCalExpr]
readNamedCalExprsFromFile :: [Char] -> IO [NamedCalExpr]
readNamedCalExprsFromFile [Char]
uncalFile = do
[[Char]]
ss <- [Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
uncalFile
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO NamedCalExpr
readOneLine [[Char]]
ss
where
readOneLine :: String -> IO NamedCalExpr
readOneLine :: [Char] -> IO NamedCalExpr
readOneLine [Char]
s = case [Char] -> Either [Char] NamedCalExpr
readOneNamedCalExpr [Char]
s of
Left [Char]
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ [Char]
err forall a. [a] -> [a] -> [a]
++ [Char]
"\nin \"" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"\""
Right NamedCalExpr
x -> forall (m :: * -> *) a. Monad m => a -> m a
return NamedCalExpr
x
renderUncalC14WithoutName :: UncalC14 -> String
renderUncalC14WithoutName :: UncalC14 -> [Char]
renderUncalC14WithoutName (UncalC14 [Char]
_ YearBP
bp YearBP
sigma) = forall a. Show a => a -> [Char]
show YearBP
bp forall a. [a] -> [a] -> [a]
++ [Char]
"±" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBP
sigma forall a. [a] -> [a] -> [a]
++ [Char]
"BP"
renderUncalC14 :: UncalC14 -> String
renderUncalC14 :: UncalC14 -> [Char]
renderUncalC14 (UncalC14 [Char]
name YearBP
bp YearBP
sigma) = [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBP
bp forall a. [a] -> [a] -> [a]
++ [Char]
"±" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBP
sigma forall a. [a] -> [a] -> [a]
++ [Char]
"BP"
readUncalC14FromFile :: FilePath -> IO [UncalC14]
readUncalC14FromFile :: [Char] -> IO [UncalC14]
readUncalC14FromFile [Char]
uncalFile = do
[Char]
s <- [Char] -> IO [Char]
readFile [Char]
uncalFile
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parser [UncalC14]
uncalC14SepByNewline () [Char]
"" [Char]
s of
Left ParseError
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
showParsecErr ParseError
err
Right [UncalC14]
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [UncalC14]
x
where
uncalC14SepByNewline :: P.Parser [UncalC14]
uncalC14SepByNewline :: Parser [UncalC14]
uncalC14SepByNewline = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.endBy Parser UncalC14
parseUncalC14 (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof
readUncalC14 :: String -> Either String [UncalC14]
readUncalC14 :: [Char] -> Either [Char] [UncalC14]
readUncalC14 [Char]
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parser [UncalC14]
uncalC14SepBySemicolon () [Char]
"" [Char]
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
showParsecErr ParseError
err
Right [UncalC14]
x -> forall a b. b -> Either a b
Right [UncalC14]
x
where
uncalC14SepBySemicolon :: P.Parser [UncalC14]
uncalC14SepBySemicolon :: Parser [UncalC14]
uncalC14SepBySemicolon = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy Parser UncalC14
parseUncalC14 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof
parseUncalC14 :: P.Parser UncalC14
parseUncalC14 :: Parser UncalC14
parseUncalC14 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser UncalC14
record forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser UncalC14
long forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser UncalC14
short
where
record :: Parser UncalC14
record = forall a. [Char] -> Parser a -> Parser a
parseRecordType [Char]
"uncalC14" forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser UncalC14
long forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser UncalC14
short
long :: Parser UncalC14
long = do
[Char]
name <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"id" Parser [Char]
parseAnyString
YearBP
age <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"yearBP" Parser YearBP
parseWord
YearBP
sigma <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"sigma" Parser YearBP
parseWord
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> YearBP -> YearBP -> UncalC14
UncalC14 [Char]
name YearBP
age YearBP
sigma)
short :: Parser UncalC14
short = do
YearBP
age <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"yearBP" Parser YearBP
parseWord
YearBP
sigma <- forall a. [Char] -> Parser a -> Parser a
parseArgument [Char]
"sigma" Parser YearBP
parseWord
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> YearBP -> YearBP -> UncalC14
UncalC14 [Char]
"" YearBP
age YearBP
sigma)
writeCalC14s :: FilePath -> [CalC14] -> IO ()
writeCalC14s :: [Char] -> [CalC14] -> IO ()
writeCalC14s [Char]
path [CalC14]
calC14s = [Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$
[Char]
"id\thdrSigmaLevel\thdrStartYearBCAD\thdrStopYearBCAD\n"
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" (forall a b. (a -> b) -> [a] -> [b]
map CalC14 -> [Char]
renderCalC14ForFile [CalC14]
calC14s)
writeCalC14 :: FilePath -> CalC14 -> IO ()
writeCalC14 :: [Char] -> CalC14 -> IO ()
writeCalC14 [Char]
path CalC14
calC14 = [Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$
[Char]
"id\thdrSigmaLevel\thdrStartYearBCAD\thdrStopYearBCAD\n"
forall a. [a] -> [a] -> [a]
++ CalC14 -> [Char]
renderCalC14ForFile CalC14
calC14
appendCalC14 :: FilePath -> CalC14 -> IO ()
appendCalC14 :: [Char] -> CalC14 -> IO ()
appendCalC14 [Char]
path CalC14
calC14 =
[Char] -> [Char] -> IO ()
appendFile [Char]
path forall a b. (a -> b) -> a -> b
$ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ CalC14 -> [Char]
renderCalC14ForFile CalC14
calC14
renderCalC14ForFile :: CalC14 -> String
renderCalC14ForFile :: CalC14 -> [Char]
renderCalC14ForFile (CalC14 [Char]
name CalRangeSummary
_ [HDR]
hdrs68 [HDR]
hdrs95) =
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char], ([Char], [Char])) -> [Char]
renderRow forall a b. (a -> b) -> a -> b
$
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (forall a. a -> [a]
repeat [Char]
name) (forall a. a -> [a]
repeat [Char]
"1") ([HDR] -> [([Char], [Char])]
renderHDRsForFile [HDR]
hdrs68) forall a. [a] -> [a] -> [a]
++
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (forall a. a -> [a]
repeat [Char]
name) (forall a. a -> [a]
repeat [Char]
"2") ([HDR] -> [([Char], [Char])]
renderHDRsForFile [HDR]
hdrs95)
where
renderRow :: (String, String, (String, String)) -> String
renderRow :: ([Char], [Char], ([Char], [Char])) -> [Char]
renderRow ([Char]
a, [Char]
b, ([Char]
c, [Char]
d)) = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" [[Char]
a,[Char]
b,[Char]
c,[Char]
d]
renderCalC14s :: [CalC14] -> String
renderCalC14s :: [CalC14] -> [Char]
renderCalC14s [CalC14]
xs =
[Char]
"Calibrated high density ranges (HDR):\n"
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" (forall a b. (a -> b) -> [a] -> [b]
map CalC14 -> [Char]
renderCalC14 [CalC14]
xs)
renderCalC14 :: CalC14 -> String
renderCalC14 :: CalC14 -> [Char]
renderCalC14 (CalC14 [Char]
_ CalRangeSummary
rangeSummary [HDR]
hdrs68 [HDR]
hdrs95) =
[Char]
"Calibrated: " forall a. [a] -> [a] -> [a]
++ CalRangeSummary -> [Char]
renderCalRangeSummary CalRangeSummary
rangeSummary forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
forall a. [a] -> [a] -> [a]
++ [Char]
"1-sigma: " forall a. [a] -> [a] -> [a]
++ [HDR] -> [Char]
renderHDRs [HDR]
hdrs68 forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
forall a. [a] -> [a] -> [a]
++ [Char]
"2-sigma: " forall a. [a] -> [a] -> [a]
++ [HDR] -> [Char]
renderHDRs [HDR]
hdrs95
renderCalRangeSummary :: CalRangeSummary -> String
renderCalRangeSummary :: CalRangeSummary -> [Char]
renderCalRangeSummary CalRangeSummary
s =
YearBCAD -> [Char]
renderYearBCAD (CalRangeSummary -> YearBCAD
_calRangeStartTwoSigma CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ [Char]
" >> "
forall a. [a] -> [a] -> [a]
++ YearBCAD -> [Char]
renderYearBCAD (CalRangeSummary -> YearBCAD
_calRangeStartOneSigma CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ [Char]
" > "
forall a. [a] -> [a] -> [a]
++ YearBCAD -> [Char]
renderYearBCAD (CalRangeSummary -> YearBCAD
_calRangeMedian CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ [Char]
" < "
forall a. [a] -> [a] -> [a]
++ YearBCAD -> [Char]
renderYearBCAD (CalRangeSummary -> YearBCAD
_calRangeStopOneSigma CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ [Char]
" << "
forall a. [a] -> [a] -> [a]
++ YearBCAD -> [Char]
renderYearBCAD (CalRangeSummary -> YearBCAD
_calRangeStopTwoSigma CalRangeSummary
s)
renderYearBP :: YearBP -> String
renderYearBP :: YearBP -> [Char]
renderYearBP YearBP
x =
forall a. Show a => a -> [Char]
show YearBP
x forall a. [a] -> [a] -> [a]
++ [Char]
"BP"
renderYearBCAD :: YearBCAD -> String
renderYearBCAD :: YearBCAD -> [Char]
renderYearBCAD YearBCAD
x
| YearBCAD
x forall a. Ord a => a -> a -> Bool
< YearBCAD
0 = forall a. Show a => a -> [Char]
show (-YearBCAD
x) forall a. [a] -> [a] -> [a]
++ [Char]
"BC"
| YearBCAD
x forall a. Ord a => a -> a -> Bool
>= YearBCAD
0 = forall a. Show a => a -> [Char]
show YearBCAD
x forall a. [a] -> [a] -> [a]
++ [Char]
"AD"
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"This should never happen: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBCAD
x
renderHDRsForFile :: [HDR] -> [(String, String)]
renderHDRsForFile :: [HDR] -> [([Char], [Char])]
renderHDRsForFile = forall a b. (a -> b) -> [a] -> [b]
map HDR -> ([Char], [Char])
renderHDRForFile
renderHDRForFile :: HDR -> (String, String)
renderHDRForFile :: HDR -> ([Char], [Char])
renderHDRForFile (HDR YearBCAD
start YearBCAD
stop) = (forall a. Show a => a -> [Char]
show YearBCAD
start, forall a. Show a => a -> [Char]
show YearBCAD
stop)
renderHDRs :: [HDR] -> String
renderHDRs :: [HDR] -> [Char]
renderHDRs [HDR]
xs = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map HDR -> [Char]
renderHDR [HDR]
xs)
renderHDR :: HDR -> String
renderHDR :: HDR -> [Char]
renderHDR (HDR YearBCAD
start YearBCAD
stop)
| YearBCAD
start forall a. Ord a => a -> a -> Bool
< YearBCAD
0 Bool -> Bool -> Bool
&& YearBCAD
stop forall a. Ord a => a -> a -> Bool
<= YearBCAD
0 = forall a. Show a => a -> [Char]
show (-YearBCAD
start) forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (-YearBCAD
stop) forall a. [a] -> [a] -> [a]
++ [Char]
"BC"
| YearBCAD
start forall a. Ord a => a -> a -> Bool
< YearBCAD
0 Bool -> Bool -> Bool
&& YearBCAD
stop forall a. Ord a => a -> a -> Bool
> YearBCAD
0 = forall a. Show a => a -> [Char]
show (-YearBCAD
start) forall a. [a] -> [a] -> [a]
++ [Char]
"BC-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBCAD
stop forall a. [a] -> [a] -> [a]
++ [Char]
"AD"
| YearBCAD
start forall a. Ord a => a -> a -> Bool
>= YearBCAD
0 Bool -> Bool -> Bool
&& YearBCAD
stop forall a. Ord a => a -> a -> Bool
>= YearBCAD
0 = forall a. Show a => a -> [Char]
show YearBCAD
start forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBCAD
stop forall a. [a] -> [a] -> [a]
++ [Char]
"AD"
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"This should never happen: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBCAD
start forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show YearBCAD
stop
writeCalCurveMatrix :: FilePath -> CalCurveMatrix -> IO ()
writeCalCurveMatrix :: [Char] -> CalCurveMatrix -> IO ()
writeCalCurveMatrix [Char]
path CalCurveMatrix
calCurveMatrix =
[Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$ CalCurveMatrix -> [Char]
renderCalCurveMatrix CalCurveMatrix
calCurveMatrix
renderCalCurveMatrix :: CalCurveMatrix -> String
renderCalCurveMatrix :: CalCurveMatrix -> [Char]
renderCalCurveMatrix (CalCurveMatrix Vector YearBCAD
uncals Vector YearBCAD
cals Vector (Vector Float)
curveDensities) =
let header :: [Char]
header = [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> [a]
VU.toList Vector YearBCAD
cals) forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
body :: [[Char]]
body = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. (Show a, Show a) => a -> [a] -> [Char]
makeRow (forall a. Unbox a => Vector a -> [a]
VU.toList Vector YearBCAD
uncals) (forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList (forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. Unbox a => Vector a -> [a]
VU.toList Vector (Vector Float)
curveDensities))
in [Char]
header forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
body
where
makeRow :: a -> [a] -> [Char]
makeRow a
uncal [a]
dens = forall a. Show a => a -> [Char]
show a
uncal forall a. [a] -> [a] -> [a]
++ [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [a]
dens)
writeCalPDFs :: FilePath -> [CalPDF] -> IO ()
writeCalPDFs :: [Char] -> [CalPDF] -> IO ()
writeCalPDFs [Char]
path [CalPDF]
calPDFs =
[Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$
[Char]
"id\tyearBCAD\tdensity\n"
forall a. [a] -> [a] -> [a]
++ [CalPDF] -> [Char]
renderCalPDFs [CalPDF]
calPDFs
writeCalPDF :: FilePath -> CalPDF -> IO ()
writeCalPDF :: [Char] -> CalPDF -> IO ()
writeCalPDF [Char]
path CalPDF
calPDF =
[Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$
[Char]
"id\tyearBCAD\tdensity\n"
forall a. [a] -> [a] -> [a]
++ CalPDF -> [Char]
renderCalPDF CalPDF
calPDF
appendCalPDF :: FilePath -> CalPDF -> IO ()
appendCalPDF :: [Char] -> CalPDF -> IO ()
appendCalPDF [Char]
path CalPDF
calPDF =
[Char] -> [Char] -> IO ()
appendFile [Char]
path forall a b. (a -> b) -> a -> b
$ CalPDF -> [Char]
renderCalPDF CalPDF
calPDF
renderCalPDFs :: [CalPDF] -> String
renderCalPDFs :: [CalPDF] -> [Char]
renderCalPDFs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CalPDF -> [Char]
renderCalPDF
renderCalPDF :: CalPDF -> String
renderCalPDF :: CalPDF -> [Char]
renderCalPDF (CalPDF [Char]
name Vector YearBCAD
cals Vector Float
dens) =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {a}. (Show a, Show a) => (a, a) -> [Char]
makeRow forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> [a]
VU.toList forall a b. (a -> b) -> a -> b
$ forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
VU.zip Vector YearBCAD
cals Vector Float
dens
where
makeRow :: (a, a) -> [Char]
makeRow (a
x,a
y) = [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
x forall a. [a] -> [a] -> [a]
++ [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
y forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
data PlotSymbol = HistFill | HistTop | AxisEnd | AxisLine | AxisTick | HDRLine
renderCLIPlotCalPDF :: Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF :: Bool -> YearBCAD -> YearBCAD -> CalPDF -> CalC14 -> [Char]
renderCLIPlotCalPDF Bool
ascii YearBCAD
rows YearBCAD
cols (CalPDF [Char]
_ Vector YearBCAD
cals Vector Float
dens) CalC14
c14 =
let startYear :: YearBCAD
startYear = forall a. Unbox a => Vector a -> a
VU.head Vector YearBCAD
cals
stopYear :: YearBCAD
stopYear = forall a. Unbox a => Vector a -> a
VU.last Vector YearBCAD
cals
yearsPerCol :: YearBCAD
yearsPerCol = case forall a. Integral a => a -> a -> a
quot (forall a. Unbox a => Vector a -> YearBCAD
VU.length Vector YearBCAD
cals) YearBCAD
cols of
YearBCAD
0 -> YearBCAD
1
YearBCAD
1 -> YearBCAD
2
YearBCAD
q -> YearBCAD
q
meanDensPerCol :: [YearBCAD]
meanDensPerCol = YearBCAD -> Vector Float -> [YearBCAD]
calculateMeanDens YearBCAD
yearsPerCol Vector Float
dens
effectiveCols :: YearBCAD
effectiveCols = forall (t :: * -> *) a. Foldable t => t a -> YearBCAD
length [YearBCAD]
meanDensPerCol
plotRows :: [[Char]]
plotRows = forall a b. (a -> b) -> [a] -> [b]
map (forall a. YearBCAD -> a -> [a]
replicate YearBCAD
8 Char
' ' forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\YearBCAD
x -> forall a b. (a -> b) -> [a] -> [b]
map (YearBCAD -> YearBCAD -> Char
getHistSymbol YearBCAD
x) [YearBCAD]
meanDensPerCol) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [YearBCAD
0..YearBCAD
rows]
xAxis :: [Char]
xAxis = YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [Char]
constructXAxis YearBCAD
startYear YearBCAD
stopYear YearBCAD
effectiveCols YearBCAD
yearsPerCol
in forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
plotRows forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [Char]
xAxis
where
calculateMeanDens :: Int -> VU.Vector Float -> [Int]
calculateMeanDens :: YearBCAD -> Vector Float -> [YearBCAD]
calculateMeanDens YearBCAD
yearsPerCol Vector Float
dens_ =
let scaling :: Float
scaling = forall a b. (Integral a, Num b) => a -> b
fromIntegral YearBCAD
rows
meanDens :: [Float]
meanDens = forall a b. (a -> b) -> [a] -> [b]
map (\[Float]
x -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
x forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> YearBCAD
length [Float]
x)) forall a b. (a -> b) -> a -> b
$ forall a. YearBCAD -> [a] -> [[a]]
splitEvery YearBCAD
yearsPerCol forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> [a]
VU.toList Vector Float
dens_
maxDens :: Float
maxDens = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
meanDens
in forall a b. (a -> b) -> [a] -> [b]
map (\Float
x -> forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ (Float
x forall a. Fractional a => a -> a -> a
/ Float
maxDens) forall a. Num a => a -> a -> a
* Float
scaling) [Float]
meanDens
splitEvery :: Int -> [a] -> [[a]]
splitEvery :: forall a. YearBCAD -> [a] -> [[a]]
splitEvery YearBCAD
_ [] = []
splitEvery YearBCAD
n [a]
list = [a]
first forall a. a -> [a] -> [a]
: forall a. YearBCAD -> [a] -> [[a]]
splitEvery YearBCAD
n [a]
rest
where ([a]
first,[a]
rest) = forall a. YearBCAD -> [a] -> ([a], [a])
splitAt YearBCAD
n [a]
list
padString :: Int -> String -> String
padString :: YearBCAD -> [Char] -> [Char]
padString YearBCAD
l [Char]
x = forall a. YearBCAD -> a -> [a]
replicate (YearBCAD
l forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> YearBCAD
length [Char]
x) Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
x
getSymbol :: Bool -> PlotSymbol -> Char
getSymbol :: Bool -> PlotSymbol -> Char
getSymbol Bool
True PlotSymbol
HistFill = Char
'*'
getSymbol Bool
False PlotSymbol
HistFill = Char
'▒'
getSymbol Bool
True PlotSymbol
HistTop = Char
'_'
getSymbol Bool
False PlotSymbol
HistTop = Char
'▁'
getSymbol Bool
True PlotSymbol
AxisEnd = Char
'+'
getSymbol Bool
False PlotSymbol
AxisEnd = Char
'┄'
getSymbol Bool
True PlotSymbol
AxisLine = Char
'-'
getSymbol Bool
False PlotSymbol
AxisLine = Char
'─'
getSymbol Bool
True PlotSymbol
AxisTick = Char
'|'
getSymbol Bool
False PlotSymbol
AxisTick = Char
'┬'
getSymbol Bool
True PlotSymbol
HDRLine = Char
'-'
getSymbol Bool
False PlotSymbol
HDRLine = Char
'─'
getHistSymbol :: Int -> Int -> Char
getHistSymbol :: YearBCAD -> YearBCAD -> Char
getHistSymbol YearBCAD
x YearBCAD
y
| YearBCAD
x forall a. Eq a => a -> a -> Bool
== YearBCAD
y = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HistTop
| YearBCAD
x forall a. Ord a => a -> a -> Bool
< YearBCAD
y = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HistFill
| Bool
otherwise = Char
' '
constructXAxis :: Int -> Int -> Int -> Int -> String
constructXAxis :: YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [Char]
constructXAxis YearBCAD
startYear YearBCAD
stopYear YearBCAD
effCols YearBCAD
yearsPerCol =
let startS :: [Char]
startS = YearBCAD -> [Char] -> [Char]
padString YearBCAD
6 (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ YearBCAD -> YearBCAD
roundTo10 YearBCAD
startYear)
stopS :: [Char]
stopS = forall a. Show a => a -> [Char]
show (YearBCAD -> YearBCAD
roundTo10 YearBCAD
stopYear)
tickFreq :: YearBCAD
tickFreq = if forall a. Num a => a -> a
abs (YearBCAD
startYear forall a. Num a => a -> a -> a
- YearBCAD
stopYear) forall a. Ord a => a -> a -> Bool
< YearBCAD
1500 then YearBCAD
100 else YearBCAD
1000
colStartYears :: [YearBCAD]
colStartYears = forall a b. (a -> b) -> [a] -> [b]
map (\YearBCAD
a -> YearBCAD
startYear forall a. Num a => a -> a -> a
+ YearBCAD
yearsPerCol forall a. Num a => a -> a -> a
* YearBCAD
a) [YearBCAD
0..(YearBCAD
effCols forall a. Num a => a -> a -> a
- YearBCAD
1)]
colStopYears :: [YearBCAD]
colStopYears = forall a b. (a -> b) -> [a] -> [b]
map (\YearBCAD
b -> YearBCAD
startYear forall a. Num a => a -> a -> a
+ YearBCAD
yearsPerCol forall a. Num a => a -> a -> a
* YearBCAD
b forall a. Num a => a -> a -> a
- YearBCAD
1) [YearBCAD
1..YearBCAD
effCols]
axis :: [Char]
axis = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (YearBCAD -> YearBCAD -> YearBCAD -> Char
getAxisSymbol YearBCAD
tickFreq) [YearBCAD]
colStartYears [YearBCAD]
colStopYears
simpleRange :: [Char]
simpleRange = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (CalRangeSummary -> YearBCAD -> YearBCAD -> Char
getRangeSymbol (CalC14 -> CalRangeSummary
_calC14RangeSummary CalC14
c14)) [YearBCAD]
colStartYears [YearBCAD]
colStopYears
hdrOne :: [Char]
hdrOne = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([HDR] -> YearBCAD -> YearBCAD -> Char
getHDRSymbol (CalC14 -> [HDR]
_calC14HDROneSigma CalC14
c14)) [YearBCAD]
colStartYears [YearBCAD]
colStopYears
hdrTwo :: [Char]
hdrTwo = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([HDR] -> YearBCAD -> YearBCAD -> Char
getHDRSymbol (CalC14 -> [HDR]
_calC14HDRTwoSigma CalC14
c14)) [YearBCAD]
colStartYears [YearBCAD]
colStopYears
in [Char]
startS forall a. [a] -> [a] -> [a]
++ ([Char]
" " forall a. [a] -> [a] -> [a]
++ [Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisEnd]) forall a. [a] -> [a] -> [a]
++ [Char]
axis forall a. [a] -> [a] -> [a]
++ ([Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisEnd] forall a. [a] -> [a] -> [a]
++ [Char]
" ") forall a. [a] -> [a] -> [a]
++ [Char]
stopS forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
forall a. YearBCAD -> a -> [a]
replicate YearBCAD
8 Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
simpleRange forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
forall a. YearBCAD -> a -> [a]
replicate YearBCAD
8 Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
hdrOne forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
forall a. YearBCAD -> a -> [a]
replicate YearBCAD
8 Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
hdrTwo
where
roundTo10 :: Int -> Int
roundTo10 :: YearBCAD -> YearBCAD
roundTo10 YearBCAD
x =
let (YearBCAD
dec,YearBCAD
rest) = forall a. Integral a => a -> a -> (a, a)
quotRem (forall a. Num a => a -> a
abs YearBCAD
x) YearBCAD
10
roundedDec :: YearBCAD
roundedDec = if YearBCAD
rest forall a. Ord a => a -> a -> Bool
>= YearBCAD
5 then YearBCAD
dec forall a. Num a => a -> a -> a
+ YearBCAD
1 else YearBCAD
dec
in YearBCAD
roundedDec forall a. Num a => a -> a -> a
* YearBCAD
10 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
signum YearBCAD
x
getAxisSymbol :: Int -> Int -> Int -> Char
getAxisSymbol :: YearBCAD -> YearBCAD -> YearBCAD -> Char
getAxisSymbol YearBCAD
tickFreq YearBCAD
colStartYear YearBCAD
colStopYear
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\YearBCAD
x -> forall a. Integral a => a -> a -> a
rem YearBCAD
x YearBCAD
tickFreq forall a. Eq a => a -> a -> Bool
== YearBCAD
0) [YearBCAD
colStartYear..YearBCAD
colStopYear] = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisTick
| Bool
otherwise = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisLine
getRangeSymbol :: CalRangeSummary -> Int -> Int -> Char
getRangeSymbol :: CalRangeSummary -> YearBCAD -> YearBCAD -> Char
getRangeSymbol CalRangeSummary
range YearBCAD
colStartYear YearBCAD
colStopYear
| YearBCAD
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> YearBCAD
_calRangeMedian CalRangeSummary
range Bool -> Bool -> Bool
&& YearBCAD
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> YearBCAD
_calRangeMedian CalRangeSummary
range = Char
'^'
| YearBCAD
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> YearBCAD
_calRangeStartOneSigma CalRangeSummary
range Bool -> Bool -> Bool
&& YearBCAD
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> YearBCAD
_calRangeStartOneSigma CalRangeSummary
range = Char
'>'
| YearBCAD
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> YearBCAD
_calRangeStopOneSigma CalRangeSummary
range Bool -> Bool -> Bool
&& YearBCAD
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> YearBCAD
_calRangeStopOneSigma CalRangeSummary
range = Char
'<'
| YearBCAD
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> YearBCAD
_calRangeStartTwoSigma CalRangeSummary
range Bool -> Bool -> Bool
&& YearBCAD
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> YearBCAD
_calRangeStartTwoSigma CalRangeSummary
range = Char
'>'
| YearBCAD
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> YearBCAD
_calRangeStopTwoSigma CalRangeSummary
range Bool -> Bool -> Bool
&& YearBCAD
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> YearBCAD
_calRangeStopTwoSigma CalRangeSummary
range = Char
'<'
| Bool
otherwise = Char
' '
getHDRSymbol :: [HDR] -> Int -> Int -> Char
getHDRSymbol :: [HDR] -> YearBCAD -> YearBCAD -> Char
getHDRSymbol [HDR]
hdr YearBCAD
colStartYear YearBCAD
colStopYear
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (YearBCAD -> YearBCAD -> HDR -> Bool
doesOverlap YearBCAD
colStartYear YearBCAD
colStopYear) [HDR]
hdr = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HDRLine
| Bool
otherwise = Char
' '
where
doesOverlap :: Int -> Int -> HDR -> Bool
doesOverlap :: YearBCAD -> YearBCAD -> HDR -> Bool
doesOverlap YearBCAD
a YearBCAD
b HDR
h =
let ha :: YearBCAD
ha = HDR -> YearBCAD
_hdrstart HDR
h; hb :: YearBCAD
hb = HDR -> YearBCAD
_hdrstop HDR
h
in (YearBCAD
a forall a. Ord a => a -> a -> Bool
>= YearBCAD
ha Bool -> Bool -> Bool
&& YearBCAD
a forall a. Ord a => a -> a -> Bool
<= YearBCAD
hb) Bool -> Bool -> Bool
|| (YearBCAD
b forall a. Ord a => a -> a -> Bool
>= YearBCAD
ha Bool -> Bool -> Bool
&& YearBCAD
b forall a. Ord a => a -> a -> Bool
<= YearBCAD
hb) Bool -> Bool -> Bool
|| (YearBCAD
a forall a. Ord a => a -> a -> Bool
<= YearBCAD
ha Bool -> Bool -> Bool
&& YearBCAD
b forall a. Ord a => a -> a -> Bool
>= YearBCAD
hb)
writeCalCurve :: FilePath -> CalCurveBCAD -> IO ()
writeCalCurve :: [Char] -> CalCurveBCAD -> IO ()
writeCalCurve [Char]
path CalCurveBCAD
calCurve =
[Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$ CalCurveBCAD -> [Char]
renderCalCurve CalCurveBCAD
calCurve
renderCalCurve :: CalCurveBCAD -> String
renderCalCurve :: CalCurveBCAD -> [Char]
renderCalCurve (CalCurveBCAD Vector YearBCAD
cals Vector YearBCAD
uncals Vector YearBP
sigmas) =
let header :: [Char]
header = [Char]
"calYearBCAD\tuncalYearBCAD\tsigma\n"
body :: [[Char]]
body = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a}. (Show a, Show a, Show a) => (a, a, a) -> [Char]
makeRow forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> [a]
VU.toList forall a b. (a -> b) -> a -> b
$ forall a b c.
(Unbox a, Unbox b, Unbox c) =>
Vector a -> Vector b -> Vector c -> Vector (a, b, c)
VU.zip3 Vector YearBCAD
cals Vector YearBCAD
uncals Vector YearBP
sigmas
in [Char]
header forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
body
where
makeRow :: (a, a, a) -> [Char]
makeRow (a
x,a
y,a
z) = forall a. Show a => a -> [Char]
show a
x forall a. [a] -> [a] -> [a]
++ [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
y forall a. [a] -> [a] -> [a]
++ [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
z
readCalCurveFromFile :: FilePath -> IO CalCurveBP
readCalCurveFromFile :: [Char] -> IO CalCurveBP
readCalCurveFromFile [Char]
calCurveFile = do
[Char]
calCurve <- [Char] -> IO [Char]
readFile [Char]
calCurveFile
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> CalCurveBP
readCalCurve [Char]
calCurve
readCalCurve :: String -> CalCurveBP
readCalCurve :: [Char] -> CalCurveBP
readCalCurve [Char]
calCurveString = do
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parser [(YearBP, YearBP, YearBP)]
parseCalCurve () [Char]
"" [Char]
calCurveString of
Left ParseError
p -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"This should never happen." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ParseError
p
Right [(YearBP, YearBP, YearBP)]
x -> Vector YearBP -> Vector YearBP -> Vector YearBP -> CalCurveBP
CalCurveBP
(forall a. Unbox a => [a] -> Vector a
VU.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(YearBP
a,YearBP
_,YearBP
_) -> YearBP
a) [(YearBP, YearBP, YearBP)]
x)
(forall a. Unbox a => [a] -> Vector a
VU.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(YearBP
_,YearBP
b,YearBP
_) -> YearBP
b) [(YearBP, YearBP, YearBP)]
x)
(forall a. Unbox a => [a] -> Vector a
VU.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(YearBP
_,YearBP
_,YearBP
c) -> YearBP
c) [(YearBP, YearBP, YearBP)]
x)
parseCalCurve :: P.Parser [(YearBP, YearBP, YearRange)]
parseCalCurve :: Parser [(YearBP, YearBP, YearBP)]
parseCalCurve = do
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany Parser [Char]
comments
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepEndBy Parser (YearBP, YearBP, YearBP)
parseCalCurveLine (forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.manyTill forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
P.anyToken (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline))
parseCalCurveLine :: P.Parser (YearBP, YearBP, YearRange)
parseCalCurveLine :: Parser (YearBP, YearBP, YearBP)
parseCalCurveLine = do
YearBP
calBP <- Parser YearBP
parseWord
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
P.oneOf [Char]
","
YearBP
bp <- Parser YearBP
parseWord
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
P.oneOf [Char]
","
YearBP
sigma <- Parser YearBP
parseWord
forall (m :: * -> *) a. Monad m => a -> m a
return (YearBP
calBP, YearBP
bp, YearBP
sigma)
comments :: P.Parser String
= do
[Char]
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string [Char]
"#"
[Char]
_ <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
writeRandomAgeSamples :: FilePath -> [RandomAgeSample] -> IO ()
writeRandomAgeSamples :: [Char] -> [RandomAgeSample] -> IO ()
writeRandomAgeSamples [Char]
path [RandomAgeSample]
calPDFs =
[Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$
[Char]
"id\tyearBCAD\n"
forall a. [a] -> [a] -> [a]
++ [RandomAgeSample] -> [Char]
renderRandomAgeSamples [RandomAgeSample]
calPDFs
writeRandomAgeSample :: FilePath -> RandomAgeSample -> IO ()
writeRandomAgeSample :: [Char] -> RandomAgeSample -> IO ()
writeRandomAgeSample [Char]
path RandomAgeSample
calPDF =
[Char] -> [Char] -> IO ()
writeFile [Char]
path forall a b. (a -> b) -> a -> b
$
[Char]
"id\tyearBCAD\n"
forall a. [a] -> [a] -> [a]
++ RandomAgeSample -> [Char]
renderRandomAgeSample RandomAgeSample
calPDF
appendRandomAgeSample :: FilePath -> RandomAgeSample -> IO ()
appendRandomAgeSample :: [Char] -> RandomAgeSample -> IO ()
appendRandomAgeSample [Char]
path RandomAgeSample
calPDF =
[Char] -> [Char] -> IO ()
appendFile [Char]
path forall a b. (a -> b) -> a -> b
$ RandomAgeSample -> [Char]
renderRandomAgeSample RandomAgeSample
calPDF
renderRandomAgeSamples :: [RandomAgeSample] -> String
renderRandomAgeSamples :: [RandomAgeSample] -> [Char]
renderRandomAgeSamples = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RandomAgeSample -> [Char]
renderRandomAgeSample
renderRandomAgeSample :: RandomAgeSample -> String
renderRandomAgeSample :: RandomAgeSample -> [Char]
renderRandomAgeSample (RandomAgeSample [Char]
name Vector YearBCAD
samples) =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Show a => a -> [Char]
makeRow forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> [a]
VU.toList Vector YearBCAD
samples
where
makeRow :: a -> [Char]
makeRow a
x = [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
x forall a. [a] -> [a] -> [a]
++ [Char]
"\n"