{-# LANGUAGE OverloadedStrings #-}
module Currycarbon.Parsers where
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 :: String -> Either String CalibrationMethod
readCalibrationMethod String
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser CalibrationMethod
parseCalibrationMethod () String
"" String
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show 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 forall {u}. ParsecT String u Identity 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 String u Identity CalibrationMethod
matrixMultiplication
where
bchron :: ParsecT String u Identity CalibrationMethod
bchron = do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"Bchron,"
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall {u}. ParsecT String u Identity 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 String u Identity CalibrationMethod
normal
studentT :: ParsecT String u Identity CalibrationMethod
studentT = do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"StudentT,"
Double
dof <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
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 String u Identity CalibrationMethod
normal = do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"Normal"
forall (m :: * -> *) a. Monad m => a -> m a
return (CalibrationDistribution -> CalibrationMethod
Bchron CalibrationDistribution
NormalDist)
matrixMultiplication :: ParsecT String u Identity CalibrationMethod
matrixMultiplication = do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"MatrixMult"
forall (m :: * -> *) a. Monad m => a -> m a
return CalibrationMethod
MatrixMultiplication
renderCalDatePretty ::
Bool
-> (CalExpr, CalPDF, CalC14)
-> String
renderCalDatePretty :: Bool -> (CalExpr, CalPDF, CalC14) -> String
renderCalDatePretty Bool
ascii (CalExpr
calExpr, CalPDF
calPDF, CalC14
calC14) =
String
"DATE: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [
CalExpr -> String
renderCalExpr CalExpr
calExpr
, CalC14 -> String
renderCalC14 CalC14
calC14
, Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF Bool
ascii Int
6 Int
50 CalPDF
calPDF CalC14
calC14
]
renderCalExpr :: CalExpr -> String
renderCalExpr :: CalExpr -> String
renderCalExpr (UnCalDate UncalC14
a) = UncalC14 -> String
renderUncalC14 UncalC14
a
renderCalExpr (CalDate (CalPDF String
name Vector Int
_ Vector Float
_)) = String
name
renderCalExpr (SumCal CalExpr
a CalExpr
b) = String
"(" forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
a forall a. [a] -> [a] -> [a]
++ String
" + " forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
b forall a. [a] -> [a] -> [a]
++ String
")"
renderCalExpr (ProductCal CalExpr
a CalExpr
b) = String
"(" forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
a forall a. [a] -> [a] -> [a]
++ String
" * " forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
b forall a. [a] -> [a] -> [a]
++ String
")"
spaceChar :: Char -> P.Parser Char
spaceChar :: Char -> Parser Char
spaceChar Char
c = 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 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
c)
add :: P.Parser CalExpr
add :: Parser CalExpr
add = 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
spaceChar Char
'+' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CalExpr
expr)
mul :: P.Parser CalExpr
mul :: Parser CalExpr
mul = 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
spaceChar 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
spaceChar Char
'(') (Char -> Parser Char
spaceChar Char
')') Parser CalExpr
expr
factor :: P.Parser CalExpr
factor :: Parser CalExpr
factor = Parser CalExpr
parens 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
mul 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
add forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser CalExpr
term
readCalExpr :: String -> Either String [CalExpr]
readCalExpr :: String -> Either String [CalExpr]
readCalExpr String
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser [CalExpr]
parseCalExprSepBySemicolon () String
"" String
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
err
Right [CalExpr]
x -> forall a b. b -> Either a b
Right [CalExpr]
x
where
parseCalExprSepBySemicolon :: P.Parser [CalExpr]
parseCalExprSepBySemicolon :: Parser [CalExpr]
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 CalExpr
expr (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
readCalExprFromFile :: FilePath -> IO [CalExpr]
readCalExprFromFile :: String -> IO [CalExpr]
readCalExprFromFile String
uncalFile = do
String
s <- String -> IO String
readFile String
uncalFile
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser [CalExpr]
parseCalExprSepByNewline () String
"" String
s of
Left ParseError
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
err
Right [CalExpr]
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [CalExpr]
x
where
parseCalExprSepByNewline :: P.Parser [CalExpr]
parseCalExprSepByNewline :: Parser [CalExpr]
parseCalExprSepByNewline = 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 CalExpr
expr (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
writeCalC14s :: FilePath -> [CalC14] -> IO ()
writeCalC14s :: String -> [CalC14] -> IO ()
writeCalC14s String
path [CalC14]
calC14s = String -> String -> IO ()
writeFile String
path forall a b. (a -> b) -> a -> b
$
String
"sample,hdrSigma,hdrStartBCAD,hdrStopBCAD\n"
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map CalC14 -> String
renderCalC14ForFile [CalC14]
calC14s)
writeCalC14 :: FilePath -> CalC14 -> IO ()
writeCalC14 :: String -> CalC14 -> IO ()
writeCalC14 String
path CalC14
calC14 = String -> String -> IO ()
writeFile String
path forall a b. (a -> b) -> a -> b
$
String
"sample,hdrSigma,hdrStartBCAD,hdrStopBCAD\n"
forall a. [a] -> [a] -> [a]
++ CalC14 -> String
renderCalC14ForFile CalC14
calC14
appendCalC14 :: FilePath -> CalC14 -> IO ()
appendCalC14 :: String -> CalC14 -> IO ()
appendCalC14 String
path CalC14
calC14 =
String -> String -> IO ()
appendFile String
path forall a b. (a -> b) -> a -> b
$ String
"\n" forall a. [a] -> [a] -> [a]
++ CalC14 -> String
renderCalC14ForFile CalC14
calC14
renderCalC14ForFile :: CalC14 -> String
renderCalC14ForFile :: CalC14 -> String
renderCalC14ForFile (CalC14 String
name CalRangeSummary
_ [HDR]
hdrs68 [HDR]
hdrs95) =
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (String, String, (String, String)) -> String
renderRow forall a b. (a -> b) -> a -> b
$
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (forall a. a -> [a]
repeat String
name) (forall a. a -> [a]
repeat String
"1") ([HDR] -> [(String, String)]
renderHDRsForFile [HDR]
hdrs68) forall a. [a] -> [a] -> [a]
++
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (forall a. a -> [a]
repeat String
name) (forall a. a -> [a]
repeat String
"2") ([HDR] -> [(String, String)]
renderHDRsForFile [HDR]
hdrs95)
where
renderRow :: (String, String, (String, String)) -> String
renderRow :: (String, String, (String, String)) -> String
renderRow (String
a, String
b, (String
c, String
d)) = forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String
a,String
b,String
c,String
d]
renderCalC14s :: [CalC14] -> String
renderCalC14s :: [CalC14] -> String
renderCalC14s [CalC14]
xs =
String
"Calibrated high density ranges (HDR):\n"
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map CalC14 -> String
renderCalC14 [CalC14]
xs)
renderCalC14 :: CalC14 -> String
renderCalC14 :: CalC14 -> String
renderCalC14 (CalC14 String
_ CalRangeSummary
rangeSummary [HDR]
hdrs68 [HDR]
hdrs95) =
String
"Calibrated: " forall a. [a] -> [a] -> [a]
++ CalRangeSummary -> String
renderCalRangeSummary CalRangeSummary
rangeSummary forall a. [a] -> [a] -> [a]
++ String
"\n"
forall a. [a] -> [a] -> [a]
++ String
"1-sigma: " forall a. [a] -> [a] -> [a]
++ [HDR] -> String
renderHDRs [HDR]
hdrs68 forall a. [a] -> [a] -> [a]
++ String
"\n"
forall a. [a] -> [a] -> [a]
++ String
"2-sigma: " forall a. [a] -> [a] -> [a]
++ [HDR] -> String
renderHDRs [HDR]
hdrs95
renderCalRangeSummary :: CalRangeSummary -> String
renderCalRangeSummary :: CalRangeSummary -> String
renderCalRangeSummary CalRangeSummary
s =
Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStartTwoSigma CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ String
" >> "
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStartOneSigma CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ String
" > "
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeMedian CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ String
" < "
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStopOneSigma CalRangeSummary
s) forall a. [a] -> [a] -> [a]
++ String
" << "
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStopTwoSigma CalRangeSummary
s)
renderYearBCAD :: YearBCAD -> String
renderYearBCAD :: Int -> String
renderYearBCAD Int
x
| Int
x forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Show a => a -> String
show (-Int
x) forall a. [a] -> [a] -> [a]
++ String
"BC"
| Int
x forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. Show a => a -> String
show Int
x forall a. [a] -> [a] -> [a]
++ String
"AD"
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"This should never happen: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x
renderHDRsForFile :: [HDR] -> [(String, String)]
renderHDRsForFile :: [HDR] -> [(String, String)]
renderHDRsForFile = forall a b. (a -> b) -> [a] -> [b]
map HDR -> (String, String)
renderHDRForFile
renderHDRForFile :: HDR -> (String, String)
renderHDRForFile :: HDR -> (String, String)
renderHDRForFile (HDR Int
start Int
stop) = (forall a. Show a => a -> String
show Int
start, forall a. Show a => a -> String
show Int
stop)
renderHDRs :: [HDR] -> String
renderHDRs :: [HDR] -> String
renderHDRs [HDR]
xs = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map HDR -> String
renderHDR [HDR]
xs)
renderHDR :: HDR -> String
renderHDR :: HDR -> String
renderHDR (HDR Int
start Int
stop)
| Int
start forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
stop forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Show a => a -> String
show (-Int
start) forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (-Int
stop) forall a. [a] -> [a] -> [a]
++ String
"BC"
| Int
start forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
stop forall a. Ord a => a -> a -> Bool
> Int
0 = forall a. Show a => a -> String
show (-Int
start) forall a. [a] -> [a] -> [a]
++ String
"BC-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
stop forall a. [a] -> [a] -> [a]
++ String
"AD"
| Int
start forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
stop forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. Show a => a -> String
show Int
start forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
stop forall a. [a] -> [a] -> [a]
++ String
"AD"
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"This should never happen: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
start forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
stop
writeCalCurveMatrix :: FilePath -> CalCurveMatrix -> IO ()
writeCalCurveMatrix :: String -> CalCurveMatrix -> IO ()
writeCalCurveMatrix String
path CalCurveMatrix
calCurveMatrix =
String -> String -> IO ()
writeFile String
path forall a b. (a -> b) -> a -> b
$ CalCurveMatrix -> String
renderCalCurveMatrix CalCurveMatrix
calCurveMatrix
renderCalCurveMatrix :: CalCurveMatrix -> String
renderCalCurveMatrix :: CalCurveMatrix -> String
renderCalCurveMatrix (CalCurveMatrix Vector Int
uncals Vector Int
cals Vector (Vector Float)
curveDensities) =
let header :: String
header = String
"," forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => Vector a -> [a]
VU.toList Vector Int
cals) forall a. [a] -> [a] -> [a]
++ String
"\n"
body :: [String]
body = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. (Show a, Show a) => a -> [a] -> String
makeRow (forall a. Unbox a => Vector a -> [a]
VU.toList Vector Int
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 String
header forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
body
where
makeRow :: a -> [a] -> String
makeRow a
uncal [a]
dens = forall a. Show a => a -> String
show a
uncal forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [a]
dens)
writeCalPDFs :: FilePath -> [CalPDF] -> IO ()
writeCalPDFs :: String -> [CalPDF] -> IO ()
writeCalPDFs String
path [CalPDF]
calPDFs =
String -> String -> IO ()
writeFile String
path forall a b. (a -> b) -> a -> b
$
String
"sample,calBCAD,density\n"
forall a. [a] -> [a] -> [a]
++ [CalPDF] -> String
renderCalPDFs [CalPDF]
calPDFs
writeCalPDF :: FilePath -> CalPDF -> IO ()
writeCalPDF :: String -> CalPDF -> IO ()
writeCalPDF String
path CalPDF
calPDF =
String -> String -> IO ()
writeFile String
path forall a b. (a -> b) -> a -> b
$
String
"sample,calBCAD,density\n"
forall a. [a] -> [a] -> [a]
++ CalPDF -> String
renderCalPDF CalPDF
calPDF
appendCalPDF :: FilePath -> CalPDF -> IO ()
appendCalPDF :: String -> CalPDF -> IO ()
appendCalPDF String
path CalPDF
calPDF =
String -> String -> IO ()
appendFile String
path forall a b. (a -> b) -> a -> b
$ CalPDF -> String
renderCalPDF CalPDF
calPDF
renderCalPDFs :: [CalPDF] -> String
renderCalPDFs :: [CalPDF] -> String
renderCalPDFs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CalPDF -> String
renderCalPDF
renderCalPDF :: CalPDF -> String
renderCalPDF :: CalPDF -> String
renderCalPDF (CalPDF String
name Vector Int
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) -> String
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 Int
cals Vector Float
dens
where
makeRow :: (a, a) -> String
makeRow (a
x,a
y) = forall a. Show a => a -> String
show String
name forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y forall a. [a] -> [a] -> [a]
++ String
"\n"
data PlotSymbol = HistFill | HistTop | AxisEnd | AxisLine | AxisTick | HDRLine
renderCLIPlotCalPDF :: Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF :: Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF Bool
ascii Int
rows Int
cols (CalPDF String
_ Vector Int
cals Vector Float
dens) CalC14
c14 =
let startYear :: Int
startYear = forall a. Unbox a => Vector a -> a
VU.head Vector Int
cals
stopYear :: Int
stopYear = forall a. Unbox a => Vector a -> a
VU.last Vector Int
cals
yearsPerCol :: Int
yearsPerCol = case forall a. Integral a => a -> a -> a
quot (forall a. Unbox a => Vector a -> Int
VU.length Vector Int
cals) Int
cols of
Int
0 -> Int
1
Int
1 -> Int
2
Int
q -> Int
q
meanDensPerCol :: [Int]
meanDensPerCol = Int -> Vector Float -> [Int]
calculateMeanDens Int
yearsPerCol Vector Float
dens
effectiveCols :: Int
effectiveCols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
meanDensPerCol
plotRows :: [String]
plotRows = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Char
getHistSymbol Int
x) [Int]
meanDensPerCol) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int
0..Int
rows]
xAxis :: String
xAxis = Int -> Int -> Int -> Int -> String
constructXAxis Int
startYear Int
stopYear Int
effectiveCols Int
yearsPerCol
in forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
plotRows forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
xAxis
where
calculateMeanDens :: Int -> VU.Vector Float -> [Int]
calculateMeanDens :: Int -> Vector Float -> [Int]
calculateMeanDens Int
yearsPerCol Vector Float
dens_ =
let scaling :: Float
scaling = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 -> Int
length [Float]
x)) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [[a]]
splitEvery Int
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. Int -> [a] -> [[a]]
splitEvery Int
_ [] = []
splitEvery Int
n [a]
list = [a]
first forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [[a]]
splitEvery Int
n [a]
rest
where ([a]
first,[a]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
list
padString :: Int -> String -> String
padString :: Int -> String -> String
padString Int
l String
x = forall a. Int -> a -> [a]
replicate (Int
l forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) Char
' ' forall a. [a] -> [a] -> [a]
++ String
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 :: Int -> Int -> Char
getHistSymbol Int
x Int
y
| Int
x forall a. Eq a => a -> a -> Bool
== Int
y = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HistTop
| Int
x forall a. Ord a => a -> a -> Bool
< Int
y = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HistFill
| Bool
otherwise = Char
' '
constructXAxis :: Int -> Int -> Int -> Int -> String
constructXAxis :: Int -> Int -> Int -> Int -> String
constructXAxis Int
startYear Int
stopYear Int
effCols Int
yearsPerCol =
let startS :: String
startS = Int -> String -> String
padString Int
6 (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int -> Int
roundTo10 Int
startYear)
stopS :: String
stopS = forall a. Show a => a -> String
show (Int -> Int
roundTo10 Int
stopYear)
tickFreq :: Int
tickFreq = if forall a. Num a => a -> a
abs (Int
startYear forall a. Num a => a -> a -> a
- Int
stopYear) forall a. Ord a => a -> a -> Bool
< Int
1500 then Int
100 else Int
1000
colStartYears :: [Int]
colStartYears = forall a b. (a -> b) -> [a] -> [b]
map (\Int
a -> Int
startYear forall a. Num a => a -> a -> a
+ Int
yearsPerCol forall a. Num a => a -> a -> a
* Int
a) [Int
0..(Int
effCols forall a. Num a => a -> a -> a
- Int
1)]
colStopYears :: [Int]
colStopYears = forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> Int
startYear forall a. Num a => a -> a -> a
+ Int
yearsPerCol forall a. Num a => a -> a -> a
* Int
b forall a. Num a => a -> a -> a
- Int
1) [Int
1..Int
effCols]
axis :: String
axis = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> Int -> Char
getAxisSymbol Int
tickFreq) [Int]
colStartYears [Int]
colStopYears
simpleRange :: String
simpleRange = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (CalRangeSummary -> Int -> Int -> Char
getRangeSymbol (CalC14 -> CalRangeSummary
_calC14RangeSummary CalC14
c14)) [Int]
colStartYears [Int]
colStopYears
hdrOne :: String
hdrOne = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([HDR] -> Int -> Int -> Char
getHDRSymbol (CalC14 -> [HDR]
_calC14HDROneSigma CalC14
c14)) [Int]
colStartYears [Int]
colStopYears
hdrTwo :: String
hdrTwo = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([HDR] -> Int -> Int -> Char
getHDRSymbol (CalC14 -> [HDR]
_calC14HDRTwoSigma CalC14
c14)) [Int]
colStartYears [Int]
colStopYears
in String
startS forall a. [a] -> [a] -> [a]
++ (String
" " forall a. [a] -> [a] -> [a]
++ [Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisEnd]) forall a. [a] -> [a] -> [a]
++ String
axis forall a. [a] -> [a] -> [a]
++ ([Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisEnd] forall a. [a] -> [a] -> [a]
++ String
" ") forall a. [a] -> [a] -> [a]
++ String
stopS forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++ String
simpleRange forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++ String
hdrOne forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++ String
hdrTwo
where
roundTo10 :: Int -> Int
roundTo10 :: Int -> Int
roundTo10 Int
x =
let (Int
dec,Int
rest) = forall a. Integral a => a -> a -> (a, a)
quotRem (forall a. Num a => a -> a
abs Int
x) Int
10
roundedDec :: Int
roundedDec = if Int
rest forall a. Ord a => a -> a -> Bool
>= Int
5 then Int
dec forall a. Num a => a -> a -> a
+ Int
1 else Int
dec
in Int
roundedDec forall a. Num a => a -> a -> a
* Int
10 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
signum Int
x
getAxisSymbol :: Int -> Int -> Int -> Char
getAxisSymbol :: Int -> Int -> Int -> Char
getAxisSymbol Int
tickFreq Int
colStartYear Int
colStopYear
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Int
x -> forall a. Integral a => a -> a -> a
rem Int
x Int
tickFreq forall a. Eq a => a -> a -> Bool
== Int
0) [Int
colStartYear..Int
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 -> Int -> Int -> Char
getRangeSymbol CalRangeSummary
range Int
colStartYear Int
colStopYear
| Int
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeMedian CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeMedian CalRangeSummary
range = Char
'^'
| Int
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStartOneSigma CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStartOneSigma CalRangeSummary
range = Char
'>'
| Int
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStopOneSigma CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStopOneSigma CalRangeSummary
range = Char
'<'
| Int
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStartTwoSigma CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStartTwoSigma CalRangeSummary
range = Char
'>'
| Int
colStartYear forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStopTwoSigma CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStopTwoSigma CalRangeSummary
range = Char
'<'
| Bool
otherwise = Char
' '
getHDRSymbol :: [HDR] -> Int -> Int -> Char
getHDRSymbol :: [HDR] -> Int -> Int -> Char
getHDRSymbol [HDR]
hdr Int
colStartYear Int
colStopYear
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> HDR -> Bool
doesOverlap Int
colStartYear Int
colStopYear) [HDR]
hdr = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HDRLine
| Bool
otherwise = Char
' '
where
doesOverlap :: Int -> Int -> HDR -> Bool
doesOverlap :: Int -> Int -> HDR -> Bool
doesOverlap Int
a Int
b HDR
h =
let ha :: Int
ha = HDR -> Int
_hdrstart HDR
h; hb :: Int
hb = HDR -> Int
_hdrstop HDR
h
in (Int
a forall a. Ord a => a -> a -> Bool
>= Int
ha Bool -> Bool -> Bool
&& Int
a forall a. Ord a => a -> a -> Bool
<= Int
hb) Bool -> Bool -> Bool
|| (Int
b forall a. Ord a => a -> a -> Bool
>= Int
ha Bool -> Bool -> Bool
&& Int
b forall a. Ord a => a -> a -> Bool
<= Int
hb) Bool -> Bool -> Bool
|| (Int
a forall a. Ord a => a -> a -> Bool
<= Int
ha Bool -> Bool -> Bool
&& Int
b forall a. Ord a => a -> a -> Bool
>= Int
hb)
renderUncalC14WithoutName :: UncalC14 -> String
renderUncalC14WithoutName :: UncalC14 -> String
renderUncalC14WithoutName (UncalC14 String
_ YearBP
bp YearBP
sigma) = forall a. Show a => a -> String
show YearBP
bp forall a. [a] -> [a] -> [a]
++ String
"±" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show YearBP
sigma forall a. [a] -> [a] -> [a]
++ String
"BP"
renderUncalC14 :: UncalC14 -> String
renderUncalC14 :: UncalC14 -> String
renderUncalC14 (UncalC14 String
name YearBP
bp YearBP
sigma) = String
name forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show YearBP
bp forall a. [a] -> [a] -> [a]
++ String
"±" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show YearBP
sigma forall a. [a] -> [a] -> [a]
++ String
"BP"
readUncalC14FromFile :: FilePath -> IO [UncalC14]
readUncalC14FromFile :: String -> IO [UncalC14]
readUncalC14FromFile String
uncalFile = do
String
s <- String -> IO String
readFile String
uncalFile
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser [UncalC14]
uncalC14SepByNewline () String
"" String
s of
Left ParseError
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show 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 :: String -> Either String [UncalC14]
readUncalC14 String
s =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser [UncalC14]
uncalC14SepBySemicolon () String
"" String
s of
Left ParseError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show 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 = do
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall {u}. ParsecT String u Identity UncalC14
long forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall {u}. ParsecT String u Identity UncalC14
short
where
long :: ParsecT String u Identity UncalC14
long = do
String
name <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
",")
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
YearBP
mean <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
YearBP
std <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> YearBP -> YearBP -> UncalC14
UncalC14 String
name YearBP
mean YearBP
std)
short :: ParsecT String u Identity UncalC14
short = do
YearBP
mean <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
YearBP
std <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> YearBP -> YearBP -> UncalC14
UncalC14 String
"unknownSampleName" YearBP
mean YearBP
std)
writeCalCurve :: FilePath -> CalCurveBCAD -> IO ()
writeCalCurve :: String -> CalCurveBCAD -> IO ()
writeCalCurve String
path CalCurveBCAD
calCurve =
String -> String -> IO ()
writeFile String
path forall a b. (a -> b) -> a -> b
$ CalCurveBCAD -> String
renderCalCurve CalCurveBCAD
calCurve
renderCalCurve :: CalCurveBCAD -> String
renderCalCurve :: CalCurveBCAD -> String
renderCalCurve (CalCurveBCAD Vector Int
cals Vector Int
uncals Vector YearBP
sigmas) =
let header :: String
header = String
"calBCAD,uncalBCAD,Sigma\n"
body :: [String]
body = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a}. (Show a, Show a, Show a) => (a, a, a) -> String
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 Int
cals Vector Int
uncals Vector YearBP
sigmas
in String
header forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
body
where
makeRow :: (a, a, a) -> String
makeRow (a
x,a
y,a
z) = forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
z
readCalCurveFromFile :: FilePath -> IO CalCurveBP
readCalCurveFromFile :: String -> IO CalCurveBP
readCalCurveFromFile String
calCurveFile = do
String
calCurve <- String -> IO String
readFile String
calCurveFile
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CalCurveBP
readCalCurve String
calCurve
readCalCurve :: String -> CalCurveBP
readCalCurve :: String -> CalCurveBP
readCalCurve String
calCurveString = do
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parser [(YearBP, YearBP, YearBP)]
parseCalCurve () String
"" String
calCurveString of
Left ParseError
p -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"This should never happen." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
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 String
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 <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
YearBP
bp <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
YearBP
sigma <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
forall (m :: * -> *) a. Monad m => a -> m a
return (YearBP
calBP, YearBP
bp, YearBP
sigma)
comments :: P.Parser String
= do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"#"
String
_ <- 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 String
""