From 7f7e0a0773d86363ccf81d0ec9cec9179a21e0bb Mon Sep 17 00:00:00 2001
From: Clemens Schmid <clemens@nevrome.de>
Date: Mon, 20 Nov 2023 12:51:04 +0100
Subject: [PATCH] special considerations for uniform age distribution in the
 search for HDRs

---
 src/Currycarbon/Calibration/Calibration.hs | 31 +++++++++++++++++-----
 1 file changed, 25 insertions(+), 6 deletions(-)

diff --git a/src/Currycarbon/Calibration/Calibration.hs b/src/Currycarbon/Calibration/Calibration.hs
index bab6afa..485b8a1 100644
--- a/src/Currycarbon/Calibration/Calibration.hs
+++ b/src/Currycarbon/Calibration/Calibration.hs
@@ -85,25 +85,44 @@ refineCalDates :: [CalPDF] -> [Maybe CalC14]
 refineCalDates = map refineCalDate
 
 refineCalDate :: CalPDF -> Maybe CalC14
-refineCalDate (CalPDF name cals dens) =
-    if VU.sum dens == 0 || VU.length (VU.filter (>= 1.0) dens) == 1 -- don't calculate CalC14, if it's not meaningful
-    then Nothing
-    else Just $ CalC14 {
+refineCalDate (CalPDF name cals dens)
+    -- don't calculate CalC14, if it's not meaningful
+    | VU.sum dens == 0 || VU.length (VU.filter (>= 1.0) dens) == 1 = Nothing
+    -- for simple uniform age ranges
+    | VU.length (VU.uniq dens) == 1 =
+        let start = VU.head cals
+            stop  = VU.last cals
+        in Just $ CalC14 {
+          _calC14id           = name
+        , _calC14RangeSummary = CalRangeSummary {
+              _calRangeStartTwoSigma = start
+            , _calRangeStartOneSigma = start
+            , _calRangeMedian        = median
+            , _calRangeStopOneSigma  = stop
+            , _calRangeStopTwoSigma  = stop
+            }
+        , _calC14HDROneSigma  = [HDR start stop]
+        , _calC14HDRTwoSigma  = [HDR start stop]
+        }
+    -- for normal post-calibration probability distributions
+    | otherwise =
+        Just $ CalC14 {
           _calC14id           = name
         , _calC14RangeSummary = CalRangeSummary {
               _calRangeStartTwoSigma = _hdrstart $ head hdrs95
             , _calRangeStartOneSigma = _hdrstart $ head hdrs68
-            , _calRangeMedian        = fromJust $ cals `indexVU` elemIndex (minimum distanceTo05) distanceTo05
+            , _calRangeMedian        = median
             , _calRangeStopOneSigma  = _hdrstop  $ last hdrs68
             , _calRangeStopTwoSigma  = _hdrstop  $ last hdrs95
             }
         , _calC14HDROneSigma  = hdrs68
         , _calC14HDRTwoSigma  = hdrs95
-    }
+        }
     where
         -- simple density cumsum for median age
         cumsumDensities = cumsumDens (VU.toList $ VU.zip cals dens)
         distanceTo05 = map (\x -> abs $ (x - 0.5)) cumsumDensities
+        median = fromJust $ cals `indexVU` elemIndex (minimum distanceTo05) distanceTo05
         -- sorted density cumsum for hdrs
         sortedDensities = sortBy (flip (\ (_, dens1) (_, dens2) -> compare dens1 dens2)) (VU.toList $ VU.zip cals dens)
         cumsumSortedDensities = cumsumDens sortedDensities