added uniform age ranges to the set of expressions currycarbo can handle

src/Currycarbon/CLI/RunCalibrate.hs

@@ -110,6 +110,14 @@ replaceEmptyNames = zipWith (replaceName . show) ([1..] :: [Integer])
             if name == "unknownSampleName"
             then UnCalDate $ UncalC14 i x y
             else UnCalDate $ UncalC14 name x y
+        replaceName i (WindowBP (TimeWindowBP name start stop)) =
+            if name == "unknownSampleName"
+            then WindowBP $ TimeWindowBP i start stop
+            else WindowBP $ TimeWindowBP name start stop
+        replaceName i (WindowBCAD (TimeWindowBCAD name start stop)) =
+            if name == "unknownSampleName"
+            then WindowBCAD $ TimeWindowBCAD i start stop
+            else WindowBCAD $ TimeWindowBCAD name start stop
         replaceName i (CalDate (CalPDF name x y)) =
             if name == "unknownSampleName"
             then CalDate $ CalPDF i x y

src/Currycarbon/Calibration/Utils.hs

@@ -63,7 +63,10 @@ makeBCADCalCurve :: CalCurveBP -> CalCurveBCAD
 makeBCADCalCurve (CalCurveBP cals uncals sigmas) = CalCurveBCAD (vectorBPToBCAD cals) (vectorBPToBCAD uncals) sigmas
 
 vectorBPToBCAD :: VU.Vector YearBP -> VU.Vector YearBCAD
-vectorBPToBCAD = VU.map (\x -> -(fromIntegral x) + 1950)
+vectorBPToBCAD = VU.map bp2BCAD
+
+bp2BCAD :: YearBP -> YearBCAD
+bp2BCAD x = -(fromIntegral x) + 1950
 
 interpolateCalCurve :: CalCurveBP -> CalCurveBP
 interpolateCalCurve (CalCurveBP cals uncals sigmas) =

src/Currycarbon/Parsers.hs

@@ -78,14 +78,56 @@ renderCalDatePretty ascii (calExpr, calPDF, calC14) =
 
 renderCalExpr :: CalExpr -> String
 renderCalExpr (UnCalDate a)               = renderUncalC14 a
+renderCalExpr (WindowBP a)                = renderTimeWindowBP a
+renderCalExpr (WindowBCAD a)              = renderTimeWindowBCAD a
 renderCalExpr (CalDate (CalPDF name _ _)) = name
 renderCalExpr (SumCal a b)                = "(" ++ renderCalExpr a ++ " + " ++ renderCalExpr b ++ ")"
 renderCalExpr (ProductCal a b)            = "(" ++ renderCalExpr a ++ " * " ++ renderCalExpr b ++ ")"
 
+renderTimeWindowBP :: TimeWindowBP -> String
+renderTimeWindowBP (TimeWindowBP name start stop) = name ++ ":" ++ show start ++ " - " ++ show stop ++ "BP"
+
+renderTimeWindowBCAD :: TimeWindowBCAD -> String
+renderTimeWindowBCAD (TimeWindowBCAD name start stop) = name ++ ":" ++ show start ++ " - " ++ show stop ++ "BC/AD"
+
 -- https://gist.github.com/abhin4v/017a36477204a1d57745
 spaceChar :: Char -> P.Parser Char
 spaceChar c = P.between P.spaces P.spaces (P.char c)
---spaceChar = P.char
+
+parseInteger :: P.Parser Int
+parseInteger = do
+    P.try parseNegativeInteger P.<|> (fromIntegral <$> parsePositiveInteger)
+
+parseNegativeInteger :: P.Parser Int
+parseNegativeInteger = do
+    _ <- P.oneOf "-"
+    i <- fromIntegral <$> parsePositiveInteger
+    return (-i)
+
+parsePositiveInteger :: P.Parser Word
+parsePositiveInteger = do
+    read <$> parseNumber
+
+parseNumber :: P.Parser [Char]
+parseNumber = P.many1 P.digit
+
+parseTimeWindowBP :: P.Parser TimeWindowBP
+parseTimeWindowBP = do
+    name <- P.many (P.noneOf ",")
+    _ <- spaceChar ','
+    start <- parsePositiveInteger
+    _ <- P.spaces *> P.string "<-|" <* P.spaces
+    stop <- parsePositiveInteger
+    return (TimeWindowBP name start stop)
+
+parseTimeWindowBCAD :: P.Parser TimeWindowBCAD
+parseTimeWindowBCAD = do
+    name <- P.many (P.noneOf ",")
+    _ <- spaceChar ','
+    start <- parseInteger
+    _ <- P.spaces *> P.string "<+>" <* P.spaces
+    stop <- parseInteger
+    return (TimeWindowBCAD name start stop)
 
 add :: P.Parser CalExpr
 add = SumCal <$> term <*> (spaceChar '+' *> expr)
@@ -97,7 +139,10 @@ parens :: P.Parser CalExpr
 parens = P.between (spaceChar '(') (spaceChar ')') expr
 
 factor :: P.Parser CalExpr
-factor = parens P.<|> (UnCalDate <$> parseUncalC14)
+factor =      P.try parens
+        P.<|> P.try (WindowBP <$> parseTimeWindowBP)
+        P.<|> P.try (WindowBCAD <$> parseTimeWindowBCAD)
+        P.<|> (UnCalDate <$> parseUncalC14)
 
 term :: P.Parser CalExpr
 term = P.try mul P.<|> factor

src/Currycarbon/SumCalibration.hs

@@ -19,6 +19,8 @@ evalCalExpr conf curve calExpr = mapEither id normalizeCalPDF $ evalE calExpr
     where
         evalE :: CalExpr -> Either CurrycarbonException CalPDF
         evalE (UnCalDate a)    = calibrateDate conf curve a
+        evalE (WindowBP a)     = Right $ windowBP2CalPDF a
+        evalE (WindowBCAD a)   = Right $ windowBCAD2CalPDF a
         evalE (CalDate a)      = Right a
         evalE (SumCal a b)     = eitherCombinePDFs (+) 0 (evalE a) (evalE b)
         evalE (ProductCal a b) = mapEither id normalizeCalPDF $ eitherCombinePDFs (*) 1
@@ -69,3 +71,14 @@ combinePDFs f initVal (CalPDF name1 cals1 dens1) (CalPDF name2 cals2 dens2) =
                 | otherwise = []
             foldYearGroup :: [(YearBCAD, Float)] -> (YearBCAD, Float)
             foldYearGroup oneYear = (fst $ head oneYear, foldl' f initVal $ map snd oneYear)
+
+-- | Create pseudo-CalPDF from RangeBCAD
+windowBCAD2CalPDF :: TimeWindowBCAD -> CalPDF
+windowBCAD2CalPDF (TimeWindowBCAD name start stop) =
+    let years = VU.fromList $ [start..stop]
+        dens = VU.replicate (VU.length years) 1
+    in CalPDF name years dens
+
+windowBP2CalPDF :: TimeWindowBP -> CalPDF
+windowBP2CalPDF (TimeWindowBP name start stop) =
+    windowBCAD2CalPDF (TimeWindowBCAD name (bp2BCAD start) (bp2BCAD stop))

src/Currycarbon/Types.hs

@@ -113,12 +113,20 @@ data CalPDF = CalPDF {
 -- | A data type to represent an expression for sum- or product calibration
 data CalExpr =
       UnCalDate UncalC14
+    | WindowBP TimeWindowBP
+    | WindowBCAD TimeWindowBCAD
     | CalDate CalPDF
     | SumCal CalExpr CalExpr
     | ProductCal CalExpr CalExpr
     deriving Show
 -- http://www.cse.chalmers.se/edu/year/2018/course/TDA452/lectures/RecursiveDataTypes.html
 
+data TimeWindowBP = TimeWindowBP String YearBP YearBP
+    deriving Show
+
+data TimeWindowBCAD = TimeWindowBCAD String YearBCAD YearBCAD
+    deriving Show
+
 -- | A data type to represent a human readable summary of a calibrated radiocarbon date
 data CalC14 = CalC14 {
     -- | Identifier, e.g. a lab number