special considerations for uniform age distribution in the search for…

… HDRs
nevrome · Nov 20, 2023 · 7f7e0a0 · 7f7e0a0
1 parent a495386
commit 7f7e0a0
Showing 1 changed file with 25 additions and 6 deletions.
diff --git 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