├── presentations ├── .gitignore ├── README.md └── CAA2022_LittleMinions.md ├── cabal.project ├── test ├── golden │ ├── single_radiocarbon_date.sh │ ├── hdr_file.sh │ ├── actual_data │ │ ├── samples_file.tsv │ │ ├── hdr_file.tsv │ │ ├── cal_curve_seg_file.tsv │ │ └── density_file.tsv │ ├── density_file.sh │ ├── expected_data │ │ ├── samples_file.tsv │ │ ├── hdr_file.tsv │ │ ├── tricky_expressions.out │ │ ├── single_radiocarbon_date.out │ │ ├── cal_curve_seg_file.tsv │ │ └── density_file.tsv │ ├── cal_curve_seg_file.sh │ ├── samples_file.sh │ └── tricky_expressions.sh ├── Spec.hs ├── Main.hs ├── GoldenSpec.hs └── ParserSpec.hs ├── stack.yaml ├── .gitignore ├── .github ├── dependabot.yml └── workflows │ ├── normalCheck.yml │ └── release.yml ├── playground ├── playground.Rproj ├── normalization_test.R ├── test.R └── oxcal_comparison.R ├── data └── README.md ├── stack.yaml.lock ├── LICENSE ├── src ├── Currycarbon │ ├── Utils.hs │ ├── Calibration │ │ ├── Bchron.hs │ │ ├── MatrixMult.hs │ │ ├── Utils.hs │ │ └── Calibration.hs │ ├── CalCurves.hs │ ├── SumCalibration.hs │ ├── ParserHelpers.hs │ ├── Types.hs │ ├── CLI │ │ └── RunCalibrate.hs │ └── Parsers.hs └── Currycarbon.hs ├── currycarbon.cabal ├── CHANGELOG.md ├── src-executables └── Main-currycarbon.hs └── README.md /presentations/.gitignore: -------------------------------------------------------------------------------- 1 | currycarbon-Linux 2 | results.txt -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./*.cabal 2 | with-compiler: ghc-9.6.6 -------------------------------------------------------------------------------- /test/golden/single_radiocarbon_date.sh: -------------------------------------------------------------------------------- 1 | currycarbon "3000,30" -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-22.43 2 | 3 | packages: 4 | - . 5 | extra-deps: -------------------------------------------------------------------------------- /test/golden/hdr_file.sh: -------------------------------------------------------------------------------- 1 | currycarbon "3000,30" --hdrFile actual_data/hdr_file.tsv -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} 2 | -------------------------------------------------------------------------------- /test/golden/actual_data/samples_file.tsv: -------------------------------------------------------------------------------- 1 | id yearBCAD 2 | 1 -1262 3 | 1 -1362 4 | 1 -1235 5 | -------------------------------------------------------------------------------- /test/golden/density_file.sh: -------------------------------------------------------------------------------- 1 | currycarbon "3000,30" --densityFile actual_data/density_file.tsv -------------------------------------------------------------------------------- /test/golden/expected_data/samples_file.tsv: -------------------------------------------------------------------------------- 1 | id yearBCAD 2 | 1 -1262 3 | 1 -1362 4 | 1 -1235 5 | -------------------------------------------------------------------------------- /test/golden/cal_curve_seg_file.sh: -------------------------------------------------------------------------------- 1 | currycarbon "3000,30" --calCurveSegFile actual_data/cal_curve_seg_file.tsv -------------------------------------------------------------------------------- /test/golden/samples_file.sh: -------------------------------------------------------------------------------- 1 | currycarbon "3000,30" --samplesFile actual_data/samples_file.tsv -n 3 --seed 123 -------------------------------------------------------------------------------- /test/golden/tricky_expressions.sh: -------------------------------------------------------------------------------- 1 | # tricky expressions 2 | ## barely overlapping product 3 | currycarbon "uncalC14(3200,30) * rangeBP(3000,2800)" 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | docs/_build/ 2 | .stack-work/ 3 | .ipynb_checkpoints/ 4 | playground/data/ 5 | *.prof 6 | .Rproj.user 7 | .Rhistory 8 | dist-newstyle/ 9 | *.tar.gz -------------------------------------------------------------------------------- /test/golden/actual_data/hdr_file.tsv: -------------------------------------------------------------------------------- 1 | id hdrSigmaLevel hdrStartYearBCAD hdrStopYearBCAD 2 | 1 1 -1364 -1360 3 | 1 1 -1282 -1197 4 | 1 1 -1169 -1163 5 | 1 1 -1140 -1131 6 | 1 2 -1379 -1344 7 | 1 2 -1304 -1124 -------------------------------------------------------------------------------- /test/golden/expected_data/hdr_file.tsv: -------------------------------------------------------------------------------- 1 | id hdrSigmaLevel hdrStartYearBCAD hdrStopYearBCAD 2 | 1 1 -1364 -1360 3 | 1 1 -1282 -1197 4 | 1 1 -1169 -1163 5 | 1 1 -1140 -1131 6 | 1 2 -1379 -1344 7 | 1 2 -1304 -1124 -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # Set update schedule for GitHub Actions 2 | 3 | version: 2 4 | updates: 5 | 6 | - package-ecosystem: "github-actions" 7 | directory: "/" 8 | schedule: 9 | # Check for updates to GitHub Actions every week 10 | interval: "weekly" 11 | -------------------------------------------------------------------------------- /playground/playground.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /data/README.md: -------------------------------------------------------------------------------- 1 | # Calibration curves 2 | 3 | - intcal20: Northern Hemisphere Atmospheric, Reimer et al. 2020, doi: [10.1017/RDC.2020.41](https://doi.org/10.1017/RDC.2020.41) 4 | - shcal20: Southern Hemisphere Atmospheric, Hogg et al. 2020, doi: [10.1017/RDC.2020.59](https://doi.org/10.1017/RDC.2020.59) 5 | - marine20: Marine, Heaton et al. 2020, doi: [10.1017/RDC.2020.68](https://doi.org/10.1017/RDC.2020.68) 6 | -------------------------------------------------------------------------------- /presentations/README.md: -------------------------------------------------------------------------------- 1 | Presentations about currycarbon 2 | 3 | - `CAA2022_LittleMinions.ms`: A lightning talk about currycarbon at the CAA2022 conference in a session about small useful software tools. This presentation lives in a simple markdown file and can be presented/executed with the terminal based presentation tool [`slides`](https://github.com/maaslalani/slides). Code blocks can be executed with `CTRL+e` when the presentation is loaded with `slides CAA2022_LittleMinions.ms`. -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/topics/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146 10 | size: 720271 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml 12 | original: lts-22.43 13 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Spec 4 | import System.Environment (lookupEnv) 5 | import Test.Hspec.Core.Util 6 | import Test.Hspec.Runner 7 | 8 | main :: IO () 9 | main = do 10 | goldenFlag <- maybe False (const True) <$> lookupEnv "CURRY_RUN_GOLDEN" 11 | let config = if goldenFlag 12 | then defaultConfig 13 | else defaultConfig {configSkipPredicate = Just $ filterPredicate "Golden"} 14 | hspecWith config Spec.spec 15 | -------------------------------------------------------------------------------- /.github/workflows/normalCheck.yml: -------------------------------------------------------------------------------- 1 | name: normalCheck 2 | 3 | # trigger the workflow on push or pull request, but only for the master branch 4 | on: 5 | pull_request: 6 | push: 7 | branches: [master] 8 | 9 | jobs: 10 | test: 11 | runs-on: ubuntu-latest 12 | env: 13 | CURRY_RUN_GOLDEN: true # run golden tests, see the README for more info 14 | steps: 15 | - uses: actions/checkout@v5 16 | - uses: freckle/stack-action@v5 17 | with: 18 | stack-arguments: --coverage 19 | # prepare and upload test coverage report 20 | - uses: 8c6794b6/hpc-codecov-action@v4 21 | with: 22 | target: stack:spec 23 | - uses: codecov/codecov-action@v5 24 | with: 25 | token: ${{ secrets.CODECOV_TOKEN }} # set in organization settings -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Clemens Schmid 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /test/golden/expected_data/tricky_expressions.out: -------------------------------------------------------------------------------- 1 | currycarbon v0.5.0.0 (UTF-8) 2 | Method: Bchron {distribution = StudentTDist {ndf = 100.0}} 3 | Curve: IntCal20 4 | Calibrating... 5 | Done. 6 | CalEXPR: [1] (1p:3200±30BP * 1P:3000BP-2800BP) 7 | Calibrated: 1049BC >> 1049BC > 1025BC < 1019BC << 1017BC 8 | 1-sigma: 1049-1048BC, 1026-1019BC 9 | 2-sigma: 1049-1036BC, 1033-1033BC, 1029-1017BC 10 | 11 | 12 | ▁ 13 | ▒▁ 14 | ▁▒▒ 15 | ▁ ▒▒▒▁ 16 | ▒ ▁▒▒▒▒ 17 | ▒▁▁▁▁▁▁ ▁▁▒▒▒▒▒▁ 18 | ▒▒▒▒▒▒▒▁▁▒▒▒▒▒▒▒▒▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁ 19 | -1050 ┄────────────────────────┬───────────────────────────────┄ -940 20 | BC > ^ << BC 21 | ─ ───── 22 | ─────── ─ ─────── 23 | -------------------------------------------------------------------------------- /src/Currycarbon/Utils.hs: -------------------------------------------------------------------------------- 1 | module Currycarbon.Utils ( 2 | CurrycarbonException (..), 3 | renderCurrycarbonException 4 | ) where 5 | 6 | import Control.Exception (Exception) 7 | 8 | -- | Different exceptions for currycarbon 9 | data CurrycarbonException = 10 | -- | An exception to describe an issue in the currycarbon CLI input parsing 11 | CurrycarbonCLIParsingException String 12 | -- | An exception to describe the case that a date is not in the range of 13 | -- the supplied calibration curve 14 | | CurrycarbonCalibrationRangeException String 15 | -- | An exception for CalPDFs that are unsuitable for certain purposes 16 | | CurrycarbonInvalidCalPDFException String 17 | -- | An exception for any issues with the CLI 18 | | CurrycarbonCLIException String 19 | deriving (Show) 20 | 21 | instance Exception CurrycarbonException 22 | 23 | renderCurrycarbonException :: CurrycarbonException -> String 24 | renderCurrycarbonException (CurrycarbonCLIParsingException s) = 25 | " Error: Input can not be parsed\n" ++ s 26 | renderCurrycarbonException (CurrycarbonCalibrationRangeException i) = 27 | " Error: Date outside of calibration range. Date ID: " ++ i 28 | renderCurrycarbonException (CurrycarbonInvalidCalPDFException o) = 29 | " Error: Invalid CalPDF for " ++ o ++ 30 | ", either because all densities are 0 or one density is > 1" 31 | renderCurrycarbonException (CurrycarbonCLIException s) = 32 | " Error: " ++ s 33 | 34 | -------------------------------------------------------------------------------- /test/golden/expected_data/single_radiocarbon_date.out: -------------------------------------------------------------------------------- 1 | currycarbon v0.5.0.0 (UTF-8) 2 | Method: Bchron {distribution = StudentTDist {ndf = 100.0}} 3 | Curve: IntCal20 4 | Calibrating... 5 | Done. 6 | CalEXPR: [1] 1:3000±30BP 7 | Calibrated: 1379BC >> 1364BC > 1238BC < 1131BC << 1124BC 8 | 1-sigma: 1364-1360BC, 1282-1197BC, 1169-1163BC, 1140-1131BC 9 | 2-sigma: 1379-1344BC, 1304-1124BC 10 | 11 | BP 12 | 3130 ┤ ┆┆ 13 | │ ┆┆┆ ┆┆┆┆ 14 | │ ┆┆┆┆┆┆ ┆┆┆┆ 15 | │ ┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┆┆┆┄┄┄┆┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄ 16 | 3000 ┤ ┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┆┆┆┅┆┆┆┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅ 17 | │ ┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┆┆┆┄┄┆┆┆┄┄┆┆┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄ 18 | │ ┆┆ ┆┆ ┆┆ 19 | │ ┆┆┆┆┆┆┆┆┆ 20 | 2870 ┤ ┆┆┆┆┆ 21 | ▁▁▁▁▁▁ 22 | ▁▒▒▒▒▒▒▁ 23 | ▁▒▒▒▒▒▒▒▒▁ 24 | ▁ ▁▁▒▒▒▒▒▒▒▒▒▒▁ ▁ ▁▁ 25 | ▁▒▁ ▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▁▁▒▁ ▒▒ 26 | ▁▁▒▒▒▁▁ ▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▒▒▁ 27 | ▁▁▁▁▒▒▒▒▒▒▒▁▁▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁ 28 | -1410 ┄──┬─────────────┬─────────────┬─────────────┬────────────┄ -1020 29 | BC > > ^ << BC 30 | ─ ────────────── ─ ── 31 | ────── ─────────────────────────── 32 | -------------------------------------------------------------------------------- /src/Currycarbon/Calibration/Bchron.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Strict #-} 2 | 3 | module Currycarbon.Calibration.Bchron (calibrateDateBchron) where 4 | 5 | import Currycarbon.Calibration.Utils 6 | import Currycarbon.Parsers 7 | import Currycarbon.Types 8 | import Currycarbon.Utils 9 | 10 | import qualified Data.Vector.Unboxed as VU 11 | 12 | -- | Intercept calibration as implemented in the Bchron R package (see 'Bchron') 13 | calibrateDateBchron :: CalibrationDistribution -> CalibrateDatesConf -> CalCurveBP -> UncalC14 -> Either CurrycarbonException CalPDF 14 | calibrateDateBchron distr (CalibrateDatesConf allowOutside interpolate trimCurve trimDens) calCurve uncalC14@(UncalC14 name age ageSd) = 15 | if not allowOutside && isOutsideRangeOfCalCurve calCurve uncalC14 16 | then Left $ CurrycarbonCalibrationRangeException $ renderUncalC14 uncalC14 17 | else 18 | let rawCalCurveSegment = if trimCurve 19 | then getRelevantCalCurveSegment uncalC14 calCurve 20 | else calCurve 21 | CalCurveBCAD cals mus tau1s = prepareCalCurveSegment interpolate rawCalCurveSegment 22 | ageDouble = -(fromIntegral age)+1950 23 | ageSd2Double = fromIntegral $ ageSd*ageSd 24 | musDouble = VU.map fromIntegral mus 25 | tau1sDouble = VU.map fromIntegral tau1s 26 | dens = case distr of 27 | NormalDist -> 28 | VU.zipWith (\mu tau1 -> dnorm 0 1 ((ageDouble - mu) / sqrt (ageSd2Double + tau1 * tau1))) musDouble tau1sDouble 29 | StudentTDist degreesOfFreedom -> 30 | VU.zipWith (\mu tau1 -> dt degreesOfFreedom ((ageDouble - mu) / sqrt (ageSd2Double + tau1 * tau1))) musDouble tau1sDouble 31 | calPDF = CalPDF name cals dens 32 | res = if trimDens 33 | then trimLowDensityEdgesCalPDF $ normalizeCalPDF calPDF 34 | else normalizeCalPDF calPDF 35 | in Right res 36 | -------------------------------------------------------------------------------- /test/GoldenSpec.hs: -------------------------------------------------------------------------------- 1 | module GoldenSpec (spec) where 2 | 3 | import Control.Monad 4 | import System.IO 5 | import System.Process 6 | import Test.Hspec (Spec, describe, it, shouldBe) 7 | 8 | spec :: Spec 9 | spec = goldenTest 10 | 11 | goldenTest :: Spec 12 | goldenTest = 13 | 14 | describe "currycarbon cli test" $ do 15 | 16 | let stdout_stderr_tests = [ 17 | "single_radiocarbon_date" 18 | , "tricky_expressions" 19 | ] 20 | 21 | runStdoutStderrTests stdout_stderr_tests 22 | 23 | let file_output_tests = [ 24 | "density_file" 25 | , "hdr_file" 26 | , "samples_file" 27 | , "cal_curve_seg_file" 28 | ] 29 | 30 | runFileOutputTests file_output_tests 31 | 32 | runStdoutStderrTests :: [String] -> Spec 33 | runStdoutStderrTests tests = do 34 | forM_ tests $ \test -> do 35 | it (test ++ " should yield the correct stdout stderr output") $ do 36 | let cp = (shell ("bash " ++ test ++ ".sh")) { 37 | cwd = Just "test/golden", 38 | std_out = CreatePipe, 39 | std_err = CreatePipe 40 | } 41 | (_, Just out, Just err, _) <- createProcess cp 42 | hSetBuffering out NoBuffering 43 | hSetBuffering err NoBuffering 44 | outActually <- liftA2 (++) (hGetContents err) (hGetContents out) 45 | outExpected <- readFile $ "test/golden/expected_data/" ++ test ++ ".out" 46 | outActually `shouldBe` outExpected 47 | 48 | runFileOutputTests :: [String] -> Spec 49 | runFileOutputTests tests = do 50 | forM_ tests $ \(test) -> do 51 | it (test ++ " should produce the correct output file") $ do 52 | let cp = (shell ("bash " ++ test ++ ".sh")) { 53 | cwd = Just "test/golden", 54 | std_out = CreatePipe, 55 | std_err = CreatePipe 56 | } 57 | (_, _, _, exitCode) <- createProcess cp 58 | _ <- waitForProcess exitCode 59 | outActually <- readFile ("test/golden/actual_data/" ++ test ++ ".tsv") 60 | outExpected <- readFile ("test/golden/expected_data/" ++ test ++ ".tsv") 61 | outActually `shouldBe` outExpected 62 | -------------------------------------------------------------------------------- /currycarbon.cabal: -------------------------------------------------------------------------------- 1 | name: currycarbon 2 | version: 0.5.0.0 3 | synopsis: A package for simple, fast radiocarbon calibration 4 | description: Radiocarbon calibration library and command line tool. 5 | homepage: https://github.com/nevrome/currycarbon 6 | category: Archaeoinformatics 7 | author: Clemens Schmid 8 | maintainer: clemens@nevrome.de 9 | license: MIT 10 | license-file: LICENSE 11 | build-type: Simple 12 | cabal-version: >=1.10 13 | extra-source-files: README.md, 14 | CHANGELOG.md 15 | data-files: data/*.14c 16 | 17 | source-repository head 18 | type: git 19 | location: https://github.com/nevrome/currycarbon.git 20 | 21 | library 22 | exposed-modules: 23 | Currycarbon 24 | Currycarbon.CalCurves 25 | Currycarbon.Calibration.Utils 26 | Currycarbon.Calibration.MatrixMult 27 | Currycarbon.Calibration.Bchron 28 | Currycarbon.Calibration.Calibration 29 | Currycarbon.CLI.RunCalibrate 30 | Currycarbon.ParserHelpers 31 | Currycarbon.Parsers 32 | Currycarbon.SumCalibration 33 | Currycarbon.Types 34 | Currycarbon.Utils 35 | hs-source-dirs: 36 | src 37 | build-depends: 38 | base >= 4.14 && < 5 39 | , filepath >= 1.4 && < 1.6 40 | , parsec >= 3.1 && < 3.2 41 | , vector >= 0.12 && < 0.14 42 | , math-functions >= 0.3 && < 0.4 43 | , MonadRandom >= 0.6 && < 1 44 | , random > 1.2 && < 1.4 45 | , file-embed > 0.0.11.1 && < 0.1.0.0 46 | default-language: 47 | Haskell2010 48 | 49 | executable currycarbon 50 | main-is: 51 | Main-currycarbon.hs 52 | hs-source-dirs: 53 | src-executables 54 | build-depends: 55 | currycarbon 56 | , base >= 4.14 && < 5 57 | , optparse-applicative >= 0.16 && < 0.21 58 | , filepath >= 1.4 && < 1.6 59 | other-modules: 60 | Paths_currycarbon 61 | default-language: 62 | Haskell2010 63 | ghc-options: 64 | -threaded -O2 -with-rtsopts=-N -optP-Wno-nonportable-include-path 65 | 66 | test-suite spec 67 | hs-source-dirs: 68 | test 69 | main-is: 70 | Main.hs 71 | type: 72 | exitcode-stdio-1.0 73 | build-depends: 74 | base >= 4.9 && < 5 75 | , currycarbon 76 | , hspec >= 2 && < 3 77 | , hspec-core >= 2.10 && < 3 78 | , process >= 1.6 && < 1.7 79 | other-modules: 80 | ParserSpec, 81 | GoldenSpec, 82 | Spec 83 | default-language: 84 | Haskell2010 -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Release 2 | 3 | on: 4 | # Trigger the workflow on the new 'v*' tag created 5 | push: 6 | tags: 7 | - "v*" 8 | 9 | jobs: 10 | create_release: 11 | name: Create Github Release 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: Check out code 15 | uses: actions/checkout@v5 16 | 17 | - name: Create Release 18 | id: create_release 19 | uses: ncipollo/release-action@v1 20 | with: 21 | name: Release ${{ github.ref_name }} 22 | draft: true 23 | 24 | build_normal_artifacts: 25 | needs: [create_release] 26 | name: ${{ matrix.os }}/${{ github.ref }} 27 | runs-on: ${{ matrix.os }} 28 | strategy: 29 | matrix: 30 | os: [ubuntu-22.04, macOS-13, macOS-14, windows-latest] 31 | 32 | steps: 33 | - name: Check out code 34 | uses: actions/checkout@v5 35 | 36 | - name: Set tag name 37 | uses: olegtarasov/get-tag@v2.1 38 | id: tagName 39 | with: 40 | tagRegex: "v(.*)" 41 | tagRegexGroup: 1 42 | 43 | - name: Install stack on macOS, where it is not present (https://github.com/freckle/stack-action/issues/80) 44 | if: ${{ runner.os == 'macOS' }} 45 | run: curl -sSL https://get.haskellstack.org/ | sh 46 | 47 | - name: Build executable 48 | uses: freckle/stack-action@v5 49 | id: stack 50 | with: 51 | test: false 52 | stack-build-arguments: --copy-bins --ghc-options="-O2" 53 | 54 | - name: Set binary path name 55 | id: binarypath 56 | run: | 57 | if [ "$RUNNER_OS" == "Windows" ]; then 58 | newEXE="currycarbon-$RUNNER_OS.exe" 59 | elif [ "$RUNNER_OS" == "macOS" ]; then 60 | newEXE="currycarbon-$RUNNER_OS-$RUNNER_ARCH" 61 | else 62 | newEXE="currycarbon-$RUNNER_OS" 63 | fi 64 | currentEXE="${{ steps.stack.outputs.local-bin }}/currycarbon" 65 | mv $currentEXE $newEXE 66 | echo "BINARY_PATH=$newEXE" >> $GITHUB_OUTPUT 67 | shell: bash 68 | 69 | - name: Compress binary 70 | if: ${{ runner.os != 'macOS' }} # upx is crashing for macOS Ventura or above! 71 | uses: svenstaro/upx-action@v2 72 | with: 73 | files: ${{ steps.binarypath.outputs.BINARY_PATH }} 74 | 75 | - name: Upload Release Asset 76 | id: upload-release-asset 77 | uses: ncipollo/release-action@v1 78 | with: 79 | name: Release ${{ github.ref_name }} 80 | draft: true 81 | allowUpdates: true 82 | artifactErrorsFailBuild: true 83 | artifacts: ${{ steps.binarypath.outputs.BINARY_PATH }} 84 | artifactContentType: application/octet-stream 85 | -------------------------------------------------------------------------------- /playground/normalization_test.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | library(magrittr) 3 | 4 | #### normalization experiments #### 5 | 6 | # normalization function 7 | nor <- function(x) { x/sum(x) } 8 | 9 | # test density vectors, all normalized 10 | a <- c(0.1,0.7,0.2) 11 | b <- c(0.3,0.4,0.3) 12 | c <- c(0.1,0.1,0.8) 13 | 14 | # sum -> all of these differ 15 | nor(a+b+c) 16 | nor(nor(a+b)+c) 17 | nor(a+nor(b+c)) 18 | 19 | # product -> all are the same 20 | nor(a*b*c) 21 | nor(nor(a*b)*c) 22 | nor(a*nor(b*c)) 23 | 24 | #### test simple sum #### 25 | 26 | system("currycarbon \"rangeBP(3000,2800)\" --densityFile /tmp/currycarbonOutput.tsv -q") 27 | calPDFRange <- readr::read_tsv("/tmp/currycarbonOutput.tsv", col_types = readr::cols()) 28 | system("currycarbon \"3000,30\" --densityFile /tmp/currycarbonOutput.tsv -q") 29 | calPDFC14a <- readr::read_tsv("/tmp/currycarbonOutput.tsv", col_types = readr::cols()) 30 | 31 | ggplot() + 32 | geom_line( 33 | data = calPDFRange, 34 | mapping = aes(x = yearBCAD, y = density), 35 | linewidth = 1, alpha = 0.5, color = "blue" 36 | ) + 37 | geom_line( 38 | data = calPDFC14a, 39 | mapping = aes(x = yearBCAD, y = density), 40 | linewidth = 1, alpha = 0.5, color = "red" 41 | ) 42 | 43 | system("currycarbon \"(3000,30) + rangeBP(3000,2800)\" --densityFile /tmp/currycarbonOutput.tsv -q") 44 | calPDFSum <- readr::read_tsv("/tmp/currycarbonOutput.tsv", col_types = readr::cols()) 45 | 46 | ggplot() + 47 | geom_line( 48 | data = calPDFSum, 49 | mapping = aes(x = yearBCAD, y = density), 50 | linewidth = 1, alpha = 0.5, color = "purple" 51 | ) 52 | 53 | #### test two sums #### 54 | 55 | # this must not the same as the previous test 56 | system("currycarbon \"((3000,30) + (3000,30)) + rangeBP(3000,2800)\" --densityFile /tmp/currycarbonOutput.tsv -q") 57 | calPDFSum <- readr::read_tsv("/tmp/currycarbonOutput.tsv", col_types = readr::cols()) 58 | 59 | ggplot() + 60 | geom_line( 61 | data = calPDFSum, 62 | mapping = aes(x = yearBCAD, y = density), 63 | linewidth = 1, alpha = 0.5, color = "orange" 64 | ) 65 | 66 | #### test more complex arrangements #### 67 | 68 | system("currycarbon \"2900,100\" --densityFile /tmp/currycarbonOutput.tsv -q") 69 | calPDFC14b <- readr::read_tsv("/tmp/currycarbonOutput.tsv", col_types = readr::cols()) 70 | 71 | ggplot() + 72 | geom_line( 73 | data = calPDFSum, 74 | mapping = aes(x = yearBCAD, y = density), 75 | linewidth = 1, alpha = 0.5, color = "purple" 76 | ) + 77 | geom_line( 78 | data = calPDFC14b, 79 | mapping = aes(x = yearBCAD, y = density), 80 | linewidth = 1, alpha = 0.5, color = "darkred" 81 | ) 82 | 83 | system("currycarbon \"(((3000,30) + (3000,30)) + rangeBP(3000,2800)) * (2900,100)\" --densityFile /tmp/currycarbonOutput.tsv -q") 84 | calPDFProd <- readr::read_tsv("/tmp/currycarbonOutput.tsv", col_types = readr::cols()) 85 | 86 | ggplot() + 87 | geom_line( 88 | data = calPDFProd, 89 | mapping = aes(x = yearBCAD, y = density), 90 | linewidth = 1, alpha = 0.5, color = "darkgreen" 91 | ) 92 | 93 | 94 | -------------------------------------------------------------------------------- /src/Currycarbon/Calibration/MatrixMult.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Strict #-} 2 | 3 | module Currycarbon.Calibration.MatrixMult 4 | ( calibrateDateMatrixMult 5 | , makeCalCurveMatrix 6 | , uncalToPDF 7 | ) where 8 | 9 | import Currycarbon.Calibration.Utils 10 | import Currycarbon.Parsers 11 | import Currycarbon.Types 12 | import Currycarbon.Utils 13 | 14 | import qualified Data.Vector as V 15 | import Data.Vector.Generic (convert) 16 | import qualified Data.Vector.Unboxed as VU 17 | 18 | -- | Intercept calibration implemented with matrix multiplication (see 'MatrixMultiplication') 19 | calibrateDateMatrixMult :: CalibrateDatesConf -> CalCurveBP -> UncalC14 -> Either CurrycarbonException CalPDF 20 | calibrateDateMatrixMult (CalibrateDatesConf allowOutside interpolate trimCurve trimDens) calCurve uncalC14 = 21 | if not allowOutside && isOutsideRangeOfCalCurve calCurve uncalC14 22 | then Left $ CurrycarbonCalibrationRangeException $ renderUncalC14 uncalC14 23 | else 24 | let rawCalCurveSegment = if trimCurve 25 | then getRelevantCalCurveSegment uncalC14 calCurve 26 | else calCurve 27 | calCurveSegment = prepareCalCurveSegment interpolate rawCalCurveSegment 28 | uncalPDF = uncalToPDF uncalC14 29 | calCurveMatrix = makeCalCurveMatrix uncalPDF calCurveSegment 30 | calPDF = projectUncalOverCalCurve uncalPDF calCurveMatrix 31 | res = if trimDens 32 | then trimLowDensityEdgesCalPDF $ normalizeCalPDF calPDF 33 | else normalizeCalPDF calPDF 34 | in Right res 35 | 36 | -- | Construct a matrix representation of a calibration curve for a given date 37 | makeCalCurveMatrix :: UncalPDF -> CalCurveBCAD -> CalCurveMatrix 38 | makeCalCurveMatrix (UncalPDF _ uncals' _) (CalCurveBCAD cals uncals sigmas) = 39 | let curveUnCalBCADsDouble = VU.map fromIntegral uncals 40 | sigmasDouble = VU.map fromIntegral sigmas 41 | uncalBCADs = vectorBPToBCAD uncals' 42 | uncalBCADsDouble = VU.map fromIntegral uncalBCADs 43 | matrix = buildMatrix curveUnCalBCADsDouble sigmasDouble uncalBCADsDouble 44 | in CalCurveMatrix uncalBCADs cals matrix 45 | where 46 | buildMatrix :: VU.Vector Double -> VU.Vector Double -> VU.Vector Double -> V.Vector (VU.Vector Double) 47 | buildMatrix curveuncal_ sigmas_ uncal_ = 48 | V.map (\x -> VU.map (fillCell x) uncal_) $ 49 | V.zip (convert curveuncal_) (convert sigmas_) 50 | fillCell :: (Double, Double) -> Double -> Double 51 | fillCell (mean, sigma) matrixPosBP = 52 | if abs (mean - matrixPosBP) < 6*sigma 53 | then dnorm mean sigma matrixPosBP 54 | else 0 55 | 56 | -- | Transform an uncalibrated date to an uncalibrated 57 | -- probability density table 58 | uncalToPDF :: UncalC14 -> UncalPDF 59 | uncalToPDF (UncalC14 name mean std) = 60 | let meanDouble = fromIntegral mean 61 | stdDouble = fromIntegral std 62 | years = VU.reverse $ VU.fromList [(mean-5*std) .. (mean+5*std)] 63 | yearsDouble = VU.map fromIntegral years 64 | probabilities = VU.map (dnorm meanDouble stdDouble) yearsDouble 65 | in UncalPDF name years probabilities 66 | 67 | projectUncalOverCalCurve :: UncalPDF -> CalCurveMatrix -> CalPDF 68 | projectUncalOverCalCurve (UncalPDF name _ dens) (CalCurveMatrix _ cals matrix) = 69 | CalPDF name cals $ vectorMatrixMultSum dens matrix 70 | where 71 | vectorMatrixMultSum :: VU.Vector Double -> V.Vector (VU.Vector Double) -> VU.Vector Double 72 | vectorMatrixMultSum vec mat = 73 | convert $ V.map (\x -> VU.sum $ VU.zipWith (*) x vec) mat 74 | -------------------------------------------------------------------------------- /playground/test.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | 3 | # an arbitrary test date 4 | testdate <- c(5000,190) 5 | 6 | run_currycarbon <- function(additional_commands = "") { 7 | system( 8 | paste0( 9 | "currycarbon \"", 10 | testdate[1], ",", testdate[2], 11 | "\" ", 12 | additional_commands 13 | ) 14 | ) 15 | } 16 | 17 | run_currycarbon_calPDF <- function(additional_commands = "") { 18 | run_currycarbon(paste( 19 | "--densityFile /tmp/currycarbonOutput.tsv -q", 20 | additional_commands 21 | )) 22 | readr::read_tsv( 23 | "/tmp/currycarbonOutput.tsv", 24 | col_types = readr::cols() 25 | ) 26 | } 27 | 28 | #### comparison with the Bchron R package for the calibarion of single dates #### 29 | 30 | curry_bchron_studentT100 <- run_currycarbon_calPDF() |> 31 | dplyr::rename(density_curry_bchron_studentT100 = density) 32 | curry_matrixmult <- run_currycarbon_calPDF("--method MatrixMultiplication") |> 33 | dplyr::rename(density_curry_matrixmult = density) 34 | curry_bchron_normal <- run_currycarbon_calPDF("--method \"Bchron,Normal\"") |> 35 | dplyr::rename(density_curry_bchron_normal = density) 36 | 37 | bchronRaw <- Bchron::BchronCalibrate( 38 | testdate[1], testdate[2], 39 | calCurves = 'intcal20' 40 | ) 41 | bchron <- tibble::tibble( 42 | yearBCAD = -bchronRaw$Date1$ageGrid + 1950, 43 | density_bchron = bchronRaw$Date1$densities 44 | ) 45 | 46 | bchron |> 47 | dplyr::full_join(curry_bchron_studentT100, by = "yearBCAD") |> 48 | dplyr::full_join(curry_bchron_normal, by = "yearBCAD") |> 49 | dplyr::full_join(curry_matrixmult, by = "yearBCAD") |> 50 | tidyr::pivot_longer( 51 | tidyselect::starts_with("dens"), 52 | names_to = "method" 53 | ) |> 54 | ggplot() + 55 | geom_line( 56 | aes(x = yearBCAD, y = value, colour = method), 57 | linewidth = 1, alpha = 0.5 58 | ) 59 | 60 | #### confirm the reliability of the random age sampling #### 61 | 62 | # Test 1 63 | 64 | run_currycarbon("--samplesFile /tmp/currySamples.tsv -n 100000") 65 | 66 | age_samples <- readr::read_tsv("/tmp/currySamples.tsv") 67 | 68 | year_count <- age_samples |> 69 | dplyr::mutate(yearBCAD = round(yearBCAD, -1)) |> 70 | dplyr::group_by(yearBCAD) |> 71 | dplyr::summarise(n = dplyr::n()) 72 | 73 | year_count |> 74 | ggplot() + 75 | geom_path(aes(x = yearBCAD, y = n)) 76 | 77 | # Test 2 78 | 79 | system('currycarbon "A,3000,30+B,3200,40*C,3300,30" --samplesFile /tmp/currySamples.tsv -n 10000') 80 | 81 | age_samples <- readr::read_tsv("/tmp/currySamples.tsv") 82 | 83 | year_count <- age_samples |> 84 | dplyr::mutate(yearBCAD = plyr::round_any(yearBCAD, 10, floor)) |> 85 | dplyr::group_by(yearBCAD) |> 86 | dplyr::summarise(n = dplyr::n()) 87 | 88 | year_count |> 89 | ggplot() + 90 | geom_bar(aes(x = yearBCAD, y = n), stat = "identity") 91 | 92 | #### large test (for memory leaks) #### 93 | 94 | calpal <- c14bazAAR::get_calpal() 95 | calpal |> dplyr::select(c14age, c14std) |> dplyr::slice_head(n = 5000) |> readr::write_csv("/tmp/currycarbon_large_input_test.csv", col_names = F) 96 | 97 | system("currycarbon --inputFile /tmp/currycarbon_large_input_test.csv -q") 98 | 99 | #### cal curve output #### 100 | 101 | run_currycarbon(paste( 102 | "--calCurveMatFile /tmp/curryMatrix.tsv", 103 | "--calCurveSegFile /tmp/currySegment.tsv" 104 | )) 105 | 106 | cal_matrix <- readr::read_tsv("/tmp/curryMatrix.tsv") |> 107 | tidyr::gather(vars, count, -...1) |> 108 | dplyr::transmute( 109 | uncal = ...1, 110 | cal = as.numeric(vars), 111 | val = count 112 | ) 113 | 114 | cal_segment <- readr::read_tsv("/tmp/currySegment.tsv") 115 | 116 | ggplot() + 117 | geom_raster( 118 | data = cal_matrix, 119 | mapping = aes(x = cal, y = uncal, fill = val) 120 | ) + 121 | geom_path( 122 | data = cal_segment, 123 | mapping = aes(x = calYearBCAD, y = uncalYearBCAD), 124 | color = "red", linewidth = 0.5 125 | ) + 126 | scale_y_reverse() + 127 | coord_fixed() 128 | -------------------------------------------------------------------------------- /src/Currycarbon/CalCurves.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Currycarbon.CalCurves where 4 | 5 | import Currycarbon.ParserHelpers 6 | import Currycarbon.Types 7 | import Currycarbon.Utils 8 | 9 | import Control.Exception (throwIO) 10 | import qualified Data.FileEmbed as FE 11 | import qualified Data.Vector.Unboxed as VU 12 | import qualified Text.Parsec as P 13 | import qualified Text.Parsec.String as P 14 | 15 | data CalCurveSelection = 16 | IntCal20 | SHCal20 | Marine20 17 | | CalCurveFromFile FilePath 18 | 19 | instance Show CalCurveSelection where 20 | show IntCal20 = "IntCal20" 21 | show SHCal20 = "SHCal20" 22 | show Marine20 = "Marine20" 23 | show (CalCurveFromFile path) = path 24 | 25 | readCalCurveSelection :: String -> Either String CalCurveSelection 26 | readCalCurveSelection s = 27 | case P.runParser parseCalCurveSelection () s s of 28 | Left err -> Left $ showParsecErrOneLine err 29 | Right x -> Right x 30 | 31 | parseCalCurveSelection :: P.Parser CalCurveSelection 32 | parseCalCurveSelection = do 33 | x <- P.many P.anyChar 34 | case x of 35 | "IntCal20" -> pure IntCal20 36 | "SHCal20" -> pure SHCal20 37 | "Marine20" -> pure Marine20 38 | p -> return $ CalCurveFromFile p 39 | 40 | getCalCurve :: CalCurveSelection -> IO CalCurveBP 41 | getCalCurve IntCal20 = pure intcal20 42 | getCalCurve SHCal20 = pure shcal20 43 | getCalCurve Marine20 = pure marine20 44 | getCalCurve (CalCurveFromFile path) = readCalCurveFromFile path 45 | 46 | -- | Read a calibration curve file. The file must adhere to the .14c file format. 47 | readCalCurveFromFile :: FilePath -> IO CalCurveBP 48 | readCalCurveFromFile calCurveFile = do 49 | calCurveString <- readFile calCurveFile 50 | case readCalCurve calCurveString of 51 | Left err -> throwIO $ CurrycarbonCLIParsingException err 52 | Right x -> return x 53 | 54 | readCalCurve :: String -> Either String CalCurveBP 55 | readCalCurve calCurveString = do 56 | case P.runParser parseCalCurve () "calCurve" calCurveString of 57 | Left err -> Left $ showParsecErr err 58 | Right x -> Right $ CalCurveBP 59 | (VU.fromList $ map (\(a,_,_) -> a) x) 60 | (VU.fromList $ map (\(_,b,_) -> b) x) 61 | (VU.fromList $ map (\(_,_,c) -> c) x) 62 | 63 | readCalCurveUnsafe :: String -> CalCurveBP 64 | readCalCurveUnsafe calCurveString = do 65 | case P.runParser parseCalCurve () "calCurve" calCurveString of 66 | Left err -> error $ "Error when reading calCurve " ++ show err 67 | Right x -> CalCurveBP 68 | (VU.fromList $ map (\(a,_,_) -> a) x) 69 | (VU.fromList $ map (\(_,b,_) -> b) x) 70 | (VU.fromList $ map (\(_,_,c) -> c) x) 71 | 72 | parseCalCurve :: P.Parser [(YearBP, YearBP, YearRange)] 73 | parseCalCurve = do 74 | P.skipMany comments 75 | P.sepEndBy parseCalCurveLine (P.manyTill P.anyToken (P.try P.newline)) 76 | 77 | parseCalCurveLine :: P.Parser (YearBP, YearBP, YearRange) 78 | parseCalCurveLine = do 79 | calBP <- parseWord 80 | _ <- P.oneOf "," 81 | bp <- parseWord 82 | _ <- P.oneOf "," 83 | sigma <- parseWord 84 | return (calBP, bp, sigma) 85 | 86 | comments :: P.Parser String 87 | comments = do 88 | _ <- P.string "#" 89 | _ <- P.manyTill P.anyChar P.newline 90 | return "" 91 | 92 | -- | The intcal20 calibration curve 93 | -- (Reimer et al. 2020, doi: [10.1017/RDC.2020.41](https://doi.org/10.1017/RDC.2020.41)) 94 | intcal20 :: CalCurveBP 95 | intcal20 = readCalCurveUnsafe intcal20String 96 | intcal20String :: String 97 | intcal20String = $(FE.makeRelativeToProject "data/intcal20.14c" >>= FE.embedStringFile) 98 | 99 | -- | The shcal20 calibration curve 100 | -- (Hogg et al. 2020, doi: [10.1017/RDC.2020.59](https://doi.org/10.1017/RDC.2020.59)) 101 | shcal20 :: CalCurveBP 102 | shcal20 = readCalCurveUnsafe shcal20String 103 | shcal20String :: String 104 | shcal20String = $(FE.makeRelativeToProject "data/shcal20.14c" >>= FE.embedStringFile) 105 | 106 | -- | The shcal20 calibration curve 107 | -- (Heaton et al. 2020, doi: [10.1017/RDC.2020.68](https://doi.org/10.1017/RDC.2020.68)) 108 | marine20 :: CalCurveBP 109 | marine20 = readCalCurveUnsafe marine20String 110 | marine20String :: String 111 | marine20String = $(FE.makeRelativeToProject "data/marine20.14c" >>= FE.embedStringFile) 112 | -------------------------------------------------------------------------------- /playground/oxcal_comparison.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | library(ggplot2) 3 | oxcAAR::quickSetupOxcal() 4 | 5 | #### oxcal vs currycarbon for sums and products #### 6 | 7 | run_oxcal <- function(code) { 8 | oxcalRawRes <- oxcAAR::executeOxcalScript(code) |> 9 | oxcAAR::readOxcalOutput() |> 10 | oxcAAR::parseFullOxcalOutput() 11 | tibble::tibble( 12 | density = oxcalRawRes$`ocd[1]`$likelihood$prob, 13 | yearBCAD = seq( 14 | oxcalRawRes$`ocd[1]`$likelihood$start, 15 | by = oxcalRawRes$`ocd[1]`$likelihood$resolution, 16 | length.out = length(density) 17 | ) 18 | ) 19 | } 20 | 21 | run_currycarbon <- function(code) { 22 | system( 23 | paste0( 24 | "currycarbon \"", 25 | code, 26 | "\" --densityFile /tmp/currycarbonOutput.tsv -q" 27 | ) 28 | ) 29 | readr::read_tsv( 30 | "/tmp/currycarbonOutput.tsv", 31 | col_types = readr::cols() 32 | ) %>% 33 | dplyr::mutate( 34 | density = density/max(density) 35 | ) 36 | } 37 | 38 | # Test 0 39 | 40 | oxcal_test0 <- run_oxcal( 41 | 'R_Date("A",3000,30);' 42 | ) 43 | 44 | currycarbon_test0 <- run_currycarbon( 45 | "A,3000,30" 46 | ) 47 | 48 | ggplot(mapping = aes(x = yearBCAD, y = density)) + 49 | geom_line(data = oxcal_test0) + 50 | geom_line(data = currycarbon_test0, color = "red") 51 | 52 | # Test 1 53 | 54 | oxcal_test1 <- run_oxcal( 55 | ' 56 | Sum("A+B+C)") 57 | { 58 | R_Date("A",3000,20); 59 | R_Date("B",2500,200); 60 | R_Date("C",2800,70); 61 | }; 62 | ' 63 | ) 64 | 65 | currycarbon_test1 <- run_currycarbon( 66 | "A,3000,20+B,2500,200+C,2800,70" 67 | ) 68 | 69 | ggplot(mapping = aes(x = yearBCAD, y = density)) + 70 | geom_line(data = oxcal_test1) + 71 | geom_line(data = currycarbon_test1, color = "red") 72 | 73 | # Test 2 74 | 75 | oxcal_test2 <- run_oxcal( 76 | ' 77 | Sum("A+(B*C)") 78 | { 79 | R_Date("A",3000,30); 80 | Combine("B*C") 81 | { 82 | R_Date("B",3200,40); 83 | R_Date("C",3300,30); 84 | }; 85 | }; 86 | ' 87 | ) 88 | 89 | currycarbon_test2 <- run_currycarbon( 90 | "A,3000,30+(B,3200,40*C,3300,30)" 91 | ) 92 | 93 | ggplot(mapping = aes(x = yearBCAD, y = density)) + 94 | geom_line(data = oxcal_test2) + 95 | geom_line(data = currycarbon_test2, color = "red") 96 | 97 | # Test 3 98 | 99 | oxcal_test3a <- run_oxcal( 100 | ' 101 | Sum("(A+B+C)+((D*E)+F)") 102 | { 103 | R_Date("A",3000,20); 104 | R_Date("B",2900,200); 105 | R_Date("C",2800,70); 106 | R_Date("D",3500,60); 107 | R_Date("E",3400,60); 108 | R_Date("F",3300,30); 109 | }; 110 | ' 111 | ) 112 | 113 | oxcal_test3b <- run_oxcal( 114 | ' 115 | Sum("(A+B+C)+((D*E)+F)") 116 | { 117 | Sum("A+B+C") 118 | { 119 | R_Date("A",3000,20); 120 | R_Date("B",2900,200); 121 | R_Date("C",2800,70); 122 | }; 123 | Sum("(D*E)+F") 124 | { 125 | Sum("D*E") 126 | { 127 | R_Date("D",3500,60); 128 | R_Date("E",3400,60); 129 | }; 130 | R_Date("F",3300,30); 131 | }; 132 | }; 133 | ' 134 | ) 135 | 136 | currycarbon_test3a <- run_currycarbon( 137 | "(A,3000,20)+(B,2900,200)+(C,2800,70)+(D,3500,60)+(E,3400,60)+(F,3300,30)" 138 | ) 139 | 140 | currycarbon_test3b <- run_currycarbon( 141 | "((A,3000,20)+(B,2900,200)+(C,2800,70))+(((D,3500,60)+(E,3400,60))+(F,3300,30))" 142 | ) 143 | 144 | # currycarbon behaves consistently like a simple sum model 145 | ggplot(mapping = aes(x = yearBCAD, y = density)) + 146 | geom_line( 147 | data = oxcal_test3a, 148 | ) + 149 | geom_line( 150 | data = currycarbon_test3a, 151 | color = "red" 152 | ) + 153 | geom_point( 154 | data = currycarbon_test3b, 155 | color = "green", 156 | size = 0.1 157 | ) 158 | 159 | # oxcal behaves differently with a nested expression describing the same model 160 | # maybe because of intermediate normalization 161 | ggplot(mapping = aes(x = yearBCAD, y = density)) + 162 | geom_line( 163 | data = oxcal_test3b, 164 | ) + 165 | geom_point( 166 | data = currycarbon_test3b, 167 | color = "green", 168 | size = 0.1 169 | ) 170 | 171 | # Test 4 172 | 173 | oxcal_test4 <- run_oxcal( 174 | ' 175 | Combine("A*(B*C)") 176 | { 177 | R_Date("A",1700,30); 178 | Combine("B*C") 179 | { 180 | R_Date("B",2000,30); 181 | R_Date("C",2300,30); 182 | }; 183 | }; 184 | ' 185 | ) 186 | 187 | currycarbon_test4 <- run_currycarbon( 188 | "A,1700,30*(B,2000,30*C,2300,30)" 189 | ) 190 | 191 | # here oxcal behaves really odd 192 | ggplot(mapping = aes(x = yearBCAD, y = density)) + 193 | geom_line(data = oxcal_test4) + 194 | geom_line(data = currycarbon_test4, color = "red") 195 | -------------------------------------------------------------------------------- /src/Currycarbon/SumCalibration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | 3 | module Currycarbon.SumCalibration where 4 | 5 | import Currycarbon.Calibration.Calibration 6 | import Currycarbon.Calibration.Utils 7 | import Currycarbon.Types 8 | import Currycarbon.Utils 9 | 10 | import Data.Foldable (foldl') 11 | import Data.List (groupBy, sortBy) 12 | import Data.Ord (comparing) 13 | import qualified Data.Vector.Unboxed as VU 14 | 15 | evalNamedCalExpr :: CalibrationMethod -> CalibrateDatesConf -> CalCurveBP -> NamedCalExpr -> Either CurrycarbonException CalPDF 16 | evalNamedCalExpr method conf curve (NamedCalExpr exprID expr) = 17 | case evalCalExpr method conf curve expr of 18 | Left err -> Left err 19 | Right calPDF -> Right calPDF { _calPDFid = exprID } 20 | 21 | -- | Evaluate a dating expression by calibrating the individual dates and forming the respective 22 | -- sums and products of post-calibration density distributions. 23 | -- Note that expressions are evaluated top-to-bottom. That renders it possible to perform trimming 24 | -- and normalization selectively in the right order 25 | evalCalExpr :: CalibrationMethod -> CalibrateDatesConf -> CalCurveBP -> CalExpr -> Either CurrycarbonException CalPDF 26 | evalCalExpr method conf curve calExpr = norm $ evalE conf calExpr 27 | where 28 | evalE :: CalibrateDatesConf -> CalExpr -> Either CurrycarbonException CalPDF 29 | -- these are already normalized by their constructors 30 | evalE c (UnCalDate a) = calibrateDate method c curve a 31 | evalE _ (WindowBP a) = Right $ windowBP2CalPDF a 32 | evalE _ (WindowBCAD a) = Right $ windowBCAD2CalPDF a 33 | -- this can theoretically be non-normalized input 34 | evalE _ (CalDate a) = norm $ Right a 35 | -- sums must not be normalized 36 | evalE c (SumCal a b) = eitherCombinePDFs (+) 0 (evalE c a) (evalE c b) 37 | -- products must be normalized (and their input, in case it's a sum) 38 | evalE c (ProductCal a b) = norm $ eitherCombinePDFs (*) 1 (productOne c a) (productOne c b) 39 | -- products between expressions can only be computed if the PDFs are not trimmed 40 | productOne c x = norm $ evalE ( 41 | c {_calConfTrimCalCurveBeforeCalibration = False, _calConfTrimCalPDFAfterCalibration = False} 42 | ) x 43 | -- helper functions 44 | norm :: Either CurrycarbonException CalPDF -> Either CurrycarbonException CalPDF 45 | norm = mapEither id normalizeCalPDF 46 | 47 | eitherCombinePDFs :: 48 | (Double -> Double -> Double) -> Double -> 49 | Either CurrycarbonException CalPDF -> 50 | Either CurrycarbonException CalPDF -> 51 | Either CurrycarbonException CalPDF 52 | eitherCombinePDFs _ _ (Left e) _ = Left e 53 | eitherCombinePDFs _ _ _ (Left e) = Left e 54 | eitherCombinePDFs f initVal (Right a) (Right b) = Right $ combinePDFs f initVal a b 55 | 56 | -- | Add two probability densities 57 | addPDFs :: CalPDF -> CalPDF -> CalPDF 58 | addPDFs = combinePDFs (+) 0 59 | 60 | -- | Multiply two probability densities 61 | multiplyPDFs :: CalPDF -> CalPDF -> CalPDF 62 | multiplyPDFs = combinePDFs (*) 1 63 | 64 | -- Combine probability densities 65 | combinePDFs :: (Double -> Double -> Double) -> Double -> CalPDF -> CalPDF -> CalPDF 66 | combinePDFs f initVal (CalPDF name1 cals1 dens1) (CalPDF name2 cals2 dens2) = do 67 | let minC1 = VU.minimum cals1 68 | minC2 = VU.minimum cals2 69 | maxC1 = VU.maximum cals1 70 | maxC2 = VU.maximum cals2 71 | if minC1 == minC2 && maxC1 == maxC2 72 | -- no aligning necessary 73 | then CalPDF (name1 ++ ";" ++ name2) cals1 (VU.zipWith f dens1 dens2) 74 | -- the PDFs have to be aligned to each other 75 | else 76 | let emptyC1 = getMiss minC1 maxC1 minC2 maxC2 77 | emptyC2 = getMiss minC2 maxC2 minC1 maxC1 78 | c1 = VU.toList (VU.zip cals1 dens1) ++ zip emptyC1 (repeat (0 :: Double)) 79 | c2 = VU.toList (VU.zip cals2 dens2) ++ zip emptyC2 (repeat (0 :: Double)) 80 | pdfSorted = sortBy (comparing fst) (c1 ++ c2) 81 | pdfGrouped = groupBy (\a b -> fst a == fst b) pdfSorted 82 | pdfRes = map foldYearGroup pdfGrouped 83 | in CalPDF (name1 ++ ";" ++ name2) (VU.fromList $ map fst pdfRes) (VU.fromList $ map snd pdfRes) 84 | where 85 | getMiss :: YearBCAD -> YearBCAD -> YearBCAD -> YearBCAD -> [YearBCAD] 86 | getMiss a1 a2 b1 b2 87 | | a1 < b1 && a2 > b2 = [a1..b1] ++ [b2..a2] 88 | | a1 < b1 && a2 <= b2 = [a1..b1] 89 | | a1 >= b1 && a2 > b2 = [b2..a2] 90 | | otherwise = [] 91 | foldYearGroup :: [(YearBCAD, Double)] -> (YearBCAD, Double) 92 | foldYearGroup oneYear = (fst $ head oneYear, foldl' f initVal $ map snd oneYear) 93 | 94 | -- | Create pseudo-CalPDF from RangeBCAD 95 | windowBCAD2CalPDF :: TimeWindowBCAD -> CalPDF 96 | windowBCAD2CalPDF (TimeWindowBCAD name start stop) = 97 | let years = VU.fromList [start..stop] 98 | dens = VU.replicate (VU.length years) 1 99 | in normalizeCalPDF $ CalPDF name years dens 100 | 101 | windowBP2CalPDF :: TimeWindowBP -> CalPDF 102 | windowBP2CalPDF (TimeWindowBP name start stop) = 103 | windowBCAD2CalPDF (TimeWindowBCAD name (bp2BCAD start) (bp2BCAD stop)) 104 | -------------------------------------------------------------------------------- /src/Currycarbon.hs: -------------------------------------------------------------------------------- 1 | -- | This module implements an algorithm for the calibration of 2 | -- [radiocarbon dates](https://en.wikipedia.org/wiki/Radiocarbon_dating). 3 | -- This is a standard procedure in Archaeology and other fields working 4 | -- with radiocarbon dating. 5 | 6 | module Currycarbon ( 7 | 8 | -- * Calibration 9 | -- $calibration 10 | calibrateDates, 11 | -- ** Configuration 12 | CalibrationMethod (..), 13 | CalibrateDatesConf (..), 14 | defaultCalConf, 15 | -- ** Input 16 | UncalC14 (..), 17 | readUncalC14FromFile, 18 | -- ** Output 19 | CalPDF (..), 20 | writeCalPDFs, 21 | 22 | -- * Year data types 23 | -- $yearDataTypes 24 | YearBP, 25 | YearBCAD, 26 | YearRange, 27 | 28 | -- * Calibration curves 29 | -- $calCurves 30 | CalCurveBP (..), 31 | CalCurveBCAD (..), 32 | intcal20, 33 | shcal20, 34 | marine20, 35 | readCalCurveFromFile, 36 | 37 | -- * Derived output 38 | -- $derivedOutput 39 | refineCalDates, 40 | CalC14 (..), 41 | writeCalC14CalRangeSummaries, 42 | writeCalC14HDRs, 43 | renderCalDatePretty, 44 | 45 | -- * Sum (and product) calibration 46 | -- $sumcal 47 | evalCalExpr, 48 | CalExpr (..), 49 | addPDFs, 50 | multiplyPDFs, 51 | normalizeCalPDF, 52 | trimLowDensityEdgesCalPDF, 53 | 54 | -- * Drawing random samples from CalPDFs 55 | -- $randsamp 56 | AgeSamplingConf (..), 57 | sampleAgesFromCalPDF, 58 | RandomAgeSample (..) 59 | ) where 60 | 61 | import Currycarbon.CalCurves 62 | import Currycarbon.Calibration.Calibration 63 | import Currycarbon.Calibration.Utils (normalizeCalPDF, 64 | trimLowDensityEdgesCalPDF) 65 | import Currycarbon.Parsers 66 | import Currycarbon.SumCalibration 67 | import Currycarbon.Types 68 | 69 | {- $calibration 70 | 71 | The main function in this module 'calibrateDates' calibrates 72 | radiocarbon dates, given the uncalibrated input dates, a calibration 73 | curve and some configuration options. 74 | 75 | * For the input dates there is a dedicated data type 'UncalC14'. 76 | These can be read from a .csv file with 'readUncalC14FromFile'. 77 | 78 | * Calibration curves are covered with the data type 'CalCurveBP'. 79 | Various curves are embedded in the package (e.g. 'intcal20'), others 80 | can be read at runtime with 'readCalCurveFromFile'. 81 | 82 | * The configuration options for the calibration are managed in 83 | 'CalibrateDatesConf', within which 'CalibrationMethod' is most 84 | important. For a solid default I suggest to use 'defaultCalConf'. 85 | 86 | 'calibrateDates' returns a list of calibrated dates in the 'CalPDF' 87 | type, which can be written to a file with 'writeCalPDFs'. 88 | See the Derived output section below for more pretty 89 | output formats. 90 | -} 91 | 92 | {- $yearDataTypes 93 | 94 | A number of types were introcuded to distinguish clearly between 95 | ages in years BP, years BC/AD and year ranges (e.g. for standard 96 | deviations). Generally currycarbon handles input ('UncalC14', 97 | 'UncalPDF') with 'YearBP', and output ('CalPDF', 'CalC14') with 98 | 'YearBCAD'. The switch happens as part of the the calibration 99 | process, so that calibration curves have to be adjusted as well. 100 | That is why the two types 'CalCurveBP' and 'CalCurveBCAD' are 101 | distinguished. 102 | -} 103 | 104 | {- $calCurves 105 | 106 | Currycarbon features two separate data types for calibration curves: 107 | 'CalCurveBP' and 'CalCurveBCAD' to distinguish between versions with 108 | 'YearBP' and 'YearBCAD'. 109 | 110 | The library has various relevant curves already embedded. 111 | At runtime curves can be read and used with 'readCalCurveFromFile'. 112 | -} 113 | 114 | {- $derivedOutput 115 | 116 | The main calibration function 'calibrateDates' returns a list of 117 | 'CalPDF's. This is very useful output for further computational 118 | analysis, but it is not optimised for human reading and understanding. 119 | 'refineCalDates' therefore takes these probability distributions and 120 | turns them into the derived data type 'CalC14', which features high 121 | density regions ('HDR's). HDRs are the age ranges a sample most likely 122 | dates to according to the post calibration probability distribution. 123 | 124 | These can also be written to a file with 'writeCalC14s'. 125 | 126 | 'renderCalDatesPretty' finally combines 'UncalC14', 'CalPDF' and 127 | 'CalC14' to produce nice command line output summarising the calibration 128 | result for a given sample. 129 | -} 130 | 131 | {- $sumcal 132 | 133 | Calculating the sum or product of two calibration curves is a common 134 | application, which currycarbon supports with a custom algebraic data type 135 | 'CalExpr'. It encodes a language to describe (very simple) chronological 136 | models, to be evaluated to a single 'CalPDF' with 'evalCalExpr'. 137 | 138 | A more basic interface is available with 'addPDFs' and 'multiplyPDFs', 139 | which allow to combine two 'CalPDF's with the respective operation. 140 | Depending on the application, you will probably want to call 'normalizeCalPDF' 141 | and 'trimLowDensityEdgesCalPDF' on the result. 142 | 143 | -} 144 | 145 | {- $randsamp 146 | 147 | Another common requirement for archaeological data analysis is temporal resampling, 148 | where random age samples are drawn from 'CalPDF's according to the probability 149 | density distribution. 150 | 151 | currycarbon supports this with 'sampleAgesFromCalPDF', which takes a configuration 152 | data type 'AgeSamplingConf' including a random number generator and the number of 153 | requested age samples, and an arbitrary 'CalPDF'. It returns an object of type 154 | 'RandomAgeSample' with a vector of sampled 'YearBCAD's. 155 | -} 156 | -------------------------------------------------------------------------------- /src/Currycarbon/ParserHelpers.hs: -------------------------------------------------------------------------------- 1 | module Currycarbon.ParserHelpers where 2 | 3 | import qualified Text.Parsec as P 4 | import qualified Text.Parsec.Error as P 5 | import qualified Text.Parsec.String as P 6 | 7 | -- * High level building blocks 8 | 9 | parseRecordType :: String -> P.Parser a -> P.Parser a 10 | parseRecordType typeName parser = do 11 | _ <- P.string typeName 12 | parseInParens parser 13 | 14 | parseNamedVector :: P.Parser a -> P.Parser b -> P.Parser [(a,b)] 15 | parseNamedVector parseKey parseValue = 16 | parseVector $ parseKeyValuePair parseKey parseValue 17 | 18 | parseVector :: P.Parser a -> P.Parser [a] 19 | parseVector parser = do 20 | _ <- P.char 'c' 21 | parseInParens (P.sepBy parser consumeCommaSep) 22 | 23 | parseArgumentWithDefault :: String -> P.Parser b -> b -> P.Parser b 24 | parseArgumentWithDefault argumentName parseValue defaultValue = 25 | P.option defaultValue (parseArgument argumentName parseValue) 26 | 27 | parseArgumentOptional :: String -> P.Parser b -> P.Parser (Maybe b) 28 | parseArgumentOptional argumentName parseValue = 29 | P.optionMaybe $ P.try (parseArgument argumentName parseValue) 30 | 31 | parseArgument :: String -> P.Parser b -> P.Parser b 32 | parseArgument argumentName parseValue = do 33 | res <- parseArgumentWithoutComma argumentName parseValue 34 | P.optional consumeCommaSep 35 | return res 36 | 37 | parseNamedArgumentOptional :: String -> P.Parser b -> P.Parser (Maybe b) 38 | parseNamedArgumentOptional argumentName parseValue = 39 | P.optionMaybe $ P.try (parseNamedArgument argumentName parseValue) 40 | 41 | -- * Low level blocks 42 | 43 | parseArgumentWithoutComma :: String -> P.Parser b -> P.Parser b 44 | parseArgumentWithoutComma argumentName parseValue = 45 | P.try (parseNamedArgument argumentName parseValue) P.<|> parseUnnamedArgument parseValue 46 | 47 | parseNamedArgument :: String -> P.Parser b -> P.Parser b 48 | parseNamedArgument argumentName parseValue = do 49 | (_,b) <- parseKeyValuePair (P.string argumentName) parseValue 50 | return b 51 | 52 | parseUnnamedArgument :: P.Parser b -> P.Parser b 53 | parseUnnamedArgument parseValue = parseValue 54 | 55 | parseKeyValuePair :: P.Parser a -> P.Parser b -> P.Parser (a,b) 56 | parseKeyValuePair parseKey parseValue = do 57 | key <- parseKey 58 | consumeEqualSep 59 | value <- parseValue 60 | return (key, value) 61 | 62 | parseInParens :: P.Parser b -> P.Parser b 63 | parseInParens parser = do 64 | _ <- P.char '(' 65 | _ <- P.spaces 66 | res <- parser 67 | _ <- P.spaces 68 | _ <- P.char ')' 69 | return res 70 | 71 | consumeEqualSep :: P.Parser () 72 | consumeEqualSep = do 73 | _ <- P.spaces *> P.char '=' <* P.spaces 74 | return () 75 | consumeCommaSep :: P.Parser () 76 | consumeCommaSep = do 77 | _ <- P.spaces *> P.char ',' <* P.spaces 78 | return () 79 | 80 | parseCharInSpace :: Char -> P.Parser Char 81 | parseCharInSpace c = P.between P.spaces P.spaces (P.char c) 82 | 83 | parseAnyString :: P.Parser String 84 | parseAnyString = 85 | P.try inDoubleQuotes P.<|> P.try inSingleQuotes P.<|> inNoQuotes 86 | where 87 | inDoubleQuotes = P.between (P.char '"') (P.char '"') (P.many P.anyChar) 88 | inSingleQuotes = P.between (P.char '\'') (P.char '\'') (P.many P.anyChar) 89 | inNoQuotes = P.many (P.noneOf ",):") 90 | 91 | -- * Sequence parsers 92 | 93 | parseDoubleSequence :: P.Parser [Double] 94 | parseDoubleSequence = do 95 | start <- parseDouble 96 | _ <- P.oneOf ":" 97 | stop <- parseDouble 98 | _ <- P.oneOf ":" 99 | by <- parsePositiveDouble 100 | return [start,(start+by)..stop] 101 | 102 | -- * Number parsers 103 | 104 | parseDouble :: P.Parser Double 105 | parseDouble = do 106 | P.try parseNegativeDouble P.<|> parsePositiveDouble 107 | 108 | parseNegativeDouble :: P.Parser Double 109 | parseNegativeDouble = do 110 | _ <- P.oneOf "-" 111 | i <- parsePositiveDouble 112 | return (-i) 113 | 114 | parseFraction :: P.Parser Double 115 | parseFraction = do 116 | num <- parsePositiveDouble 117 | if num > 1 118 | then fail "must be between zero and one" 119 | else return num 120 | 121 | parsePositiveDouble :: P.Parser Double 122 | parsePositiveDouble = do 123 | num <- parseNumber 124 | optionalMore <- P.option "" $ (:) <$> P.char '.' <*> parseNumber 125 | return $ read $ num ++ optionalMore 126 | 127 | parseIntegerSequence :: P.Parser [Int] 128 | parseIntegerSequence = do 129 | start <- parseInt 130 | _ <- P.oneOf ":" 131 | stop <- parseInt 132 | _ <- P.oneOf ":" 133 | by <- fromIntegral <$> parsePositiveInt 134 | return [start,(start+by)..stop] 135 | 136 | parseInt :: P.Parser Int 137 | parseInt = do 138 | P.try parseNegativeInt P.<|> parsePositiveInt 139 | 140 | parseNegativeInt :: P.Parser Int 141 | parseNegativeInt = do 142 | _ <- P.oneOf "-" 143 | i <- parsePositiveInt 144 | return (-i) 145 | 146 | parsePositiveInt :: P.Parser Int 147 | parsePositiveInt = fromIntegral <$> parseWord 148 | 149 | -- https://hackage.haskell.org/package/base-4.19.0.0/docs/Data-Word.html 150 | parseWord :: P.Parser Word 151 | parseWord = do 152 | read <$> parseNumber 153 | 154 | parseNumber :: P.Parser [Char] 155 | parseNumber = P.many1 P.digit 156 | 157 | -- * Error helpers 158 | 159 | showParsecErr :: P.ParseError -> String 160 | showParsecErr err = 161 | let pos = P.errorPos err 162 | posStr = P.sourceName pos ++ 163 | " (issue in line " ++ show (P.sourceLine pos) ++ 164 | ", column " ++ show (P.sourceColumn pos) ++ 165 | ")" 166 | in posStr ++ ": " ++ cleanParsecErr err 167 | 168 | showParsecErrOneLine :: P.ParseError -> String 169 | showParsecErrOneLine err = 170 | let pos = P.errorPos err 171 | posStr = P.sourceName pos ++ 172 | " (issue in column " ++ show (P.sourceColumn pos) ++ ")" 173 | in posStr ++ ": " ++ cleanParsecErr err 174 | 175 | cleanParsecErr :: P.ParseError -> String 176 | cleanParsecErr err = 177 | P.showErrorMessages 178 | "or" "unknown parse error" 179 | "expecting" "unexpected" "end of input" 180 | (P.errorMessages err) 181 | -------------------------------------------------------------------------------- /test/ParserSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserSpec (spec) where 2 | 3 | import Currycarbon.Parsers 4 | import Currycarbon.Types 5 | 6 | import Test.Hspec (Spec, describe, it, shouldBe) 7 | 8 | spec :: Spec 9 | spec = do 10 | testReadNamedExpression 11 | 12 | uncalC14N :: String -> CalExpr 13 | uncalC14N s = UnCalDate (UncalC14 s 3000 30) 14 | windowBPN :: String -> CalExpr 15 | windowBPN s = WindowBP (TimeWindowBP s 3000 2000) 16 | windowBCADN :: String -> CalExpr 17 | windowBCADN s = WindowBCAD (TimeWindowBCAD s (-1050) (-50)) 18 | uncalC14 :: CalExpr 19 | uncalC14 = uncalC14N "" 20 | windowBP :: CalExpr 21 | windowBP = windowBPN "" 22 | windowBCAD :: CalExpr 23 | windowBCAD = windowBCADN "" 24 | 25 | testReadNamedExpression :: Spec 26 | testReadNamedExpression = 27 | describe "Currycarbon.Parsers.readOneNamedCalExpr" $ do 28 | it "should read uncalibrated C14 dates correctly" $ do 29 | readOneNamedCalExpr "3000,30" 30 | `shouldBe` 31 | Right (NamedCalExpr "" uncalC14) 32 | readOneNamedCalExpr "uncalC14(3000,30)" 33 | `shouldBe` 34 | Right (NamedCalExpr "" uncalC14) 35 | readOneNamedCalExpr "uncalC14(test,3000,30)" 36 | `shouldBe` 37 | Right (NamedCalExpr "" (uncalC14N "test")) 38 | it "should read named function arguments correctly" $ do 39 | readOneNamedCalExpr "uncalC14(id = test, yearBP = 3000, sigma = 30)" 40 | `shouldBe` 41 | Right (NamedCalExpr "" (uncalC14N "test")) 42 | it "should read partially named function arguments correctly" $ do 43 | readOneNamedCalExpr "uncalC14(3000,sigma=30)" 44 | `shouldBe` 45 | Right (NamedCalExpr "" uncalC14) 46 | it "should read time windows correctly" $ do 47 | readOneNamedCalExpr "rangeBP(3000,2000)" 48 | `shouldBe` 49 | Right (NamedCalExpr "" windowBP) 50 | readOneNamedCalExpr "rangeBCAD(-1050,-50)" 51 | `shouldBe` 52 | Right (NamedCalExpr "" windowBCAD) 53 | readOneNamedCalExpr "rangeBP(test,3000,2000)" 54 | `shouldBe` 55 | Right (NamedCalExpr "" (windowBPN "test")) 56 | readOneNamedCalExpr "rangeBCAD(test,-1050,-50)" 57 | `shouldBe` 58 | Right (NamedCalExpr "" (windowBCADN "test")) 59 | it "should read sums with + operator correctly " $ do 60 | readOneNamedCalExpr "uncalC14(3000,30) + rangeBP(3000,2000)" 61 | `shouldBe` 62 | Right (NamedCalExpr "" $ SumCal uncalC14 windowBP) 63 | readOneNamedCalExpr "uncalC14(3000,30) + rangeBP(3000,2000) + rangeBCAD(-1050,-50)" 64 | `shouldBe` 65 | Right (NamedCalExpr "" $ SumCal uncalC14 (SumCal windowBP windowBCAD)) 66 | readOneNamedCalExpr "uncalC14(3000,30) + rangeBP(3000,2000) + rangeBCAD(-1050,-50) + uncalC14(3000,30)" 67 | `shouldBe` 68 | Right (NamedCalExpr "" $ SumCal uncalC14 (SumCal windowBP (SumCal windowBCAD uncalC14))) 69 | it "should read sums with sum() function and + operator correctly " $ do 70 | readOneNamedCalExpr "sum(uncalC14(3000,30), rangeBP(3000,2000))" 71 | `shouldBe` 72 | Right (NamedCalExpr "" $ SumCal uncalC14 windowBP) 73 | readOneNamedCalExpr "sum(uncalC14(3000,30), rangeBP(3000,2000)) + rangeBCAD(-1050,-50)" 74 | `shouldBe` 75 | Right (NamedCalExpr "" $ SumCal (SumCal uncalC14 windowBP) windowBCAD) 76 | readOneNamedCalExpr "uncalC14(3000,30) + sum(rangeBP(3000,2000), rangeBCAD(-1050,-50)) + uncalC14(3000,30)" 77 | `shouldBe` 78 | Right (NamedCalExpr "" $ SumCal uncalC14 (SumCal (SumCal windowBP windowBCAD) uncalC14)) 79 | it "should read products with * operator correctly " $ do 80 | readOneNamedCalExpr "uncalC14(3000,30) * rangeBP(3000,2000)" 81 | `shouldBe` 82 | Right (NamedCalExpr "" $ ProductCal uncalC14 windowBP) 83 | readOneNamedCalExpr "uncalC14(3000,30) * rangeBP(3000,2000) * rangeBCAD(-1050,-50)" 84 | `shouldBe` 85 | Right (NamedCalExpr "" $ ProductCal uncalC14 (ProductCal windowBP windowBCAD)) 86 | readOneNamedCalExpr "uncalC14(3000,30) * rangeBP(3000,2000) * rangeBCAD(-1050,-50) * uncalC14(3000,30)" 87 | `shouldBe` 88 | Right (NamedCalExpr "" $ ProductCal uncalC14 (ProductCal windowBP (ProductCal windowBCAD uncalC14))) 89 | it "should read products with product() function and * operator correctly " $ do 90 | readOneNamedCalExpr "product(uncalC14(3000,30), rangeBP(3000,2000))" 91 | `shouldBe` 92 | Right (NamedCalExpr "" $ ProductCal uncalC14 windowBP) 93 | readOneNamedCalExpr "product(uncalC14(3000,30), rangeBP(3000,2000)) * rangeBCAD(-1050,-50)" 94 | `shouldBe` 95 | Right (NamedCalExpr "" $ ProductCal (ProductCal uncalC14 windowBP) windowBCAD) 96 | readOneNamedCalExpr "uncalC14(3000,30) * product(rangeBP(3000,2000), rangeBCAD(-1050,-50)) * uncalC14(3000,30)" 97 | `shouldBe` 98 | Right (NamedCalExpr "" $ ProductCal uncalC14 (ProductCal (ProductCal windowBP windowBCAD) uncalC14)) 99 | it "should understand parenthesis correctly" $ do 100 | readOneNamedCalExpr "(uncalC14(3000,30) + rangeBP(3000,2000)) * rangeBCAD(-1050,-50)" 101 | `shouldBe` 102 | Right (NamedCalExpr "" $ ProductCal (SumCal uncalC14 windowBP) windowBCAD) 103 | it "should read unnamed and named calibration expressions correctly" $ do 104 | readOneNamedCalExpr "test: 3000,30" 105 | `shouldBe` 106 | Right (NamedCalExpr "test" uncalC14) 107 | readOneNamedCalExpr "calExpr(test,3000,30)" 108 | `shouldBe` 109 | Right (NamedCalExpr "test" uncalC14) 110 | readOneNamedCalExpr "calExpr(3000,30)" 111 | `shouldBe` 112 | Right (NamedCalExpr "" uncalC14) 113 | it "should be able to handle complex, nested queries" $ do 114 | readOneNamedCalExpr "calExpr(id = test, sum(uncalC14(3000,30), product(rangeBP(3000,2000), rangeBCAD(-1050,-50))) * uncalC14(3000,30))" 115 | `shouldBe` 116 | Right (NamedCalExpr "test" $ ProductCal (SumCal uncalC14 (ProductCal windowBP windowBCAD)) uncalC14) 117 | 118 | -------------------------------------------------------------------------------- /src/Currycarbon/Calibration/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Strict #-} 2 | 3 | module Currycarbon.Calibration.Utils where 4 | 5 | import Currycarbon.Types 6 | 7 | import Data.Maybe (fromMaybe) 8 | import qualified Data.Vector.Unboxed as VU 9 | import Numeric.SpecFunctions (logBeta) 10 | 11 | -- https://hackage.haskell.org/package/either-5.0.2/docs/Data-Either-Combinators.html 12 | mapEither :: (a -> c) -> (b -> d) -> Either a b -> Either c d 13 | mapEither f _ (Left x) = Left (f x) 14 | mapEither _ f (Right x) = Right (f x) 15 | 16 | -- | Rescale a CalPDF so that the sum of the densities is approx. 1.0 17 | normalizeCalPDF :: CalPDF -> CalPDF 18 | normalizeCalPDF (CalPDF name cals dens) = 19 | case VU.sum dens of 20 | 0.0 -> CalPDF name cals dens -- product calibration can yield empty calPDFs 21 | s -> CalPDF name cals $ VU.map (/s) dens 22 | 23 | -- | get the density of a normal distribution at a point x 24 | dnorm :: Double -> Double -> Double -> Double 25 | dnorm mu sigma x = 26 | let a = recip (sqrt (2 * pi * sigma2)) 27 | b = exp (-c2 / (2 * sigma2)) 28 | c = x - mu 29 | c2 = c * c 30 | sigma2 = sigma * sigma 31 | in a*b 32 | -- alternative implemenation with the statistics package: 33 | -- import Statistics.Distribution (density) 34 | -- realToFrac $ density (normalDistr (realToFrac mu) (realToFrac sigma)) (realToFrac x) 35 | 36 | -- | get the density of student's-t distribution at a point x 37 | dt :: Double -> Double -> Double 38 | dt dof x = 39 | let xDouble = realToFrac x 40 | logDensityUnscaled = log (dof / (dof + xDouble*xDouble)) * (0.5 * (1 + dof)) - logBeta 0.5 (0.5 * dof) 41 | in realToFrac $ exp logDensityUnscaled / sqrt dof 42 | -- alternative implemenation with the statistics package: 43 | -- import Statistics.Distribution.StudentT (studentT) 44 | -- realToFrac $ density (studentT (realToFrac dof)) (realToFrac x) -- dof: number of degrees of freedom 45 | 46 | isOutsideRangeOfCalCurve :: CalCurveBP -> UncalC14 -> Bool 47 | isOutsideRangeOfCalCurve (CalCurveBP _ uncals _) (UncalC14 _ age _) = 48 | age < VU.minimum uncals || age > VU.maximum uncals 49 | 50 | -- | Take an uncalibrated date and a raw calibration curve and return 51 | -- the relevant segment of the calibration curve 52 | getRelevantCalCurveSegment :: UncalC14 -> CalCurveBP -> CalCurveBP 53 | getRelevantCalCurveSegment (UncalC14 _ mean std) (CalCurveBP cals uncals sigmas) = 54 | let start = mean+6*std 55 | stop = mean-6*std 56 | startIndex = fromMaybe 0 $ VU.findIndex (<= start) uncals 57 | stopIndex = (VU.length uncals - 1) - fromMaybe 0 (VU.findIndex (>= stop) $ VU.reverse uncals) 58 | toIndex = stopIndex - startIndex 59 | in CalCurveBP (VU.slice startIndex toIndex cals) (VU.slice startIndex toIndex uncals) (VU.slice startIndex toIndex sigmas) 60 | 61 | -- | Modify a calibration curve (segment) with multiple optional steps, 62 | -- including interpolation and transforming dates to BC/AD format 63 | prepareCalCurveSegment :: Bool -> CalCurveBP -> CalCurveBCAD 64 | prepareCalCurveSegment interpolate calCurve = 65 | makeBCADCalCurve $ if interpolate then interpolateCalCurve calCurve else calCurve 66 | 67 | makeBCADCalCurve :: CalCurveBP -> CalCurveBCAD 68 | makeBCADCalCurve (CalCurveBP cals uncals sigmas) = CalCurveBCAD (vectorBPToBCAD cals) (vectorBPToBCAD uncals) sigmas 69 | 70 | punchOutCalCurveBCAD :: Int -> Int -> CalCurveBCAD -> CalCurveBCAD 71 | punchOutCalCurveBCAD start stop (CalCurveBCAD cals uncals sigmas) = 72 | let startIndex = fromMaybe 0 $ VU.findIndex (>= start) cals 73 | stopIndex = VU.length cals - fromMaybe 0 (VU.findIndex (<= stop) $ VU.reverse cals) 74 | toIndex = stopIndex - startIndex 75 | --in error $ show $ (start, stop, VU.slice startIndex toIndex cals) 76 | in CalCurveBCAD 77 | (VU.slice startIndex toIndex cals) 78 | (VU.slice startIndex toIndex uncals) 79 | (VU.slice startIndex toIndex sigmas) 80 | 81 | vectorBPToBCAD :: VU.Vector YearBP -> VU.Vector YearBCAD 82 | vectorBPToBCAD = VU.map bp2BCAD 83 | 84 | bp2BCAD :: YearBP -> YearBCAD 85 | bp2BCAD x = -(fromIntegral x) + 1950 86 | 87 | bcad2BP :: YearBCAD -> YearBP 88 | bcad2BP y = 1950 - fromIntegral y 89 | 90 | interpolateCalCurve :: CalCurveBP -> CalCurveBP 91 | interpolateCalCurve (CalCurveBP cals uncals sigmas) = 92 | let obs = VU.zip3 cals uncals sigmas 93 | timeWindows = getTimeWindows obs 94 | obsFilled = VU.concatMap fillTimeWindows timeWindows 95 | in uncurry3 CalCurveBP $ VU.unzip3 obsFilled 96 | where 97 | getTimeWindows :: VU.Vector (YearBP,YearBP,YearRange) -> VU.Vector ((YearBP,YearBP,YearRange),(YearBP,YearBP,YearRange)) 98 | getTimeWindows xs = VU.zipWith (,) (VU.init xs) (VU.tail xs) 99 | fillTimeWindows :: ((YearBP,YearBP,YearRange),(YearBP,YearBP,YearRange)) -> VU.Vector (YearBP,YearBP,YearRange) 100 | fillTimeWindows ((calbp1,bp1,sigma1),(calbp2,bp2,sigma2)) = 101 | if calbp1 == calbp2 || calbp1+1 == calbp2 || calbp1-1 == calbp2 102 | then VU.singleton (calbp1,bp1,sigma1) 103 | else 104 | let newCals = VU.fromList [calbp1,calbp1-1..calbp2+1] -- range definition like this to trigger counting down 105 | newBPs = VU.map (snd . getInBetweenPointsInt (calbp1,bp1) (calbp2,bp2)) newCals 106 | newSigmas = VU.map (snd . getInBetweenPointsInt (calbp1,sigma1) (calbp2,sigma2)) newCals 107 | in VU.zip3 newCals newBPs newSigmas 108 | getInBetweenPointsInt :: (Word, Word) -> (Word, Word) -> Word -> (Word, Word) 109 | getInBetweenPointsInt (x1,y1) (x2,y2) xPred = 110 | let (_,yPred) = getInBetweenPoints (fromIntegral x1,fromIntegral y1) (fromIntegral x2,fromIntegral y2) $ fromIntegral xPred 111 | in (xPred, round yPred) 112 | getInBetweenPoints :: (Double, Double) -> (Double, Double) -> Double -> (Double, Double) 113 | getInBetweenPoints (x1,y1) (x2,y2) xPred = 114 | let yDiff = y2 - y1 115 | xDiff = abs $ x1 - x2 116 | yDiffPerxDiff = yDiff/xDiff 117 | xPredRel = x1 - xPred 118 | in (xPred, y1 + xPredRel * yDiffPerxDiff) 119 | uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) 120 | uncurry3 f ~(a,b,c) = f a b c 121 | 122 | -- | Subset the calibration curve to the non-zero density range. The threshold is set to 0.00001. 123 | trimLowDensityEdgesCalPDF :: CalPDF -> CalPDF 124 | trimLowDensityEdgesCalPDF (CalPDF name cals dens) = 125 | let firstAboveThreshold = fromMaybe 0 (VU.findIndex (> 0.00001) dens) 126 | lastAboveThreshold = fromMaybe 0 (VU.findIndex (> 0.00001) $ VU.reverse dens) 127 | untilLastAboveThreshold = VU.length dens - firstAboveThreshold - lastAboveThreshold 128 | calsSlice = VU.slice firstAboveThreshold untilLastAboveThreshold cals 129 | densSlice = VU.slice firstAboveThreshold untilLastAboveThreshold dens 130 | in CalPDF name calsSlice densSlice 131 | -------------------------------------------------------------------------------- /src/Currycarbon/Calibration/Calibration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Strict #-} 2 | 3 | module Currycarbon.Calibration.Calibration 4 | ( -- * Calibration functions 5 | -- 6 | -- $calibration 7 | -- 8 | -- This module provides an interface to the calibration logic 9 | getRelevantCalCurveSegment 10 | , prepareCalCurveSegment 11 | , makeCalCurveMatrix 12 | , uncalToPDF 13 | , calibrateDate 14 | , calibrateDates 15 | , refineCalDates 16 | , refineCalDate 17 | , CalibrateDatesConf (..) 18 | , defaultCalConf 19 | , AgeSamplingConf (..) 20 | , sampleAgesFromCalPDF 21 | ) where 22 | 23 | import Currycarbon.Calibration.Bchron 24 | import Currycarbon.Calibration.MatrixMult 25 | import Currycarbon.Calibration.Utils 26 | import Currycarbon.Types 27 | import Currycarbon.Utils 28 | 29 | import qualified Control.Monad.Random as CMR 30 | import Data.List (elemIndex, groupBy, sort, 31 | sortBy) 32 | import Data.Maybe (fromJust) 33 | import qualified Data.Vector.Unboxed as VU 34 | import qualified System.Random as R 35 | 36 | -- | Calibrates a list of dates with the provided calibration curve 37 | calibrateDates :: CalibrationMethod -- ^ Calibration method to use 38 | -> CalibrateDatesConf -- ^ Configuration options to consider 39 | -> CalCurveBP -- ^ A calibration curve 40 | -> [UncalC14] -- ^ A list of uncalibrated radiocarbon dates 41 | -> [Either CurrycarbonException CalPDF] -- ^ The function returns a list for each input date, with 42 | -- either an exception if the calibration failed for some 43 | -- reason, or a 'CalPDF' 44 | calibrateDates _ _ _ [] = [] 45 | calibrateDates MatrixMultiplication config calCurve uncalDates = 46 | map (calibrateDateMatrixMult config calCurve) uncalDates 47 | calibrateDates Bchron{distribution=distr} config calCurve uncalDates = 48 | map (calibrateDateBchron distr config calCurve) uncalDates 49 | 50 | -- | Calibrates a date with the provided calibration curve 51 | calibrateDate :: CalibrationMethod -- ^ Calibration method to use 52 | -> CalibrateDatesConf -- ^ Configuration options to consider 53 | -> CalCurveBP -- ^ A calibration curve 54 | -> UncalC14 -- ^ An uncalibrated radiocarbon date 55 | -> Either CurrycarbonException CalPDF -- ^ The function returns either an exception if the 56 | -- calibration failed for some reason, or a 'CalPDF' 57 | calibrateDate method config calCurve uncalDate = head $ calibrateDates method config calCurve [uncalDate] 58 | 59 | -- | Transforms the raw, calibrated probability density table to a meaningful representation of a 60 | -- calibrated radiocarbon date 61 | refineCalDates :: [CalPDF] -> [Either CurrycarbonException CalC14] 62 | refineCalDates = map refineCalDate 63 | 64 | refineCalDate :: CalPDF -> Either CurrycarbonException CalC14 65 | refineCalDate calPDF@(CalPDF name cals dens) 66 | -- don't calculate CalC14, if it's not meaningful 67 | | isInvalidCalPDF calPDF = 68 | Left $ CurrycarbonInvalidCalPDFException "refinement" 69 | -- for simple uniform age ranges 70 | | VU.length (VU.uniq dens) == 1 = 71 | let start = VU.head cals 72 | stop = VU.last cals 73 | in Right $ CalC14 { 74 | _calC14id = name 75 | , _calC14RangeSummary = CalRangeSummary { 76 | _calRangeStartTwoSigma = start 77 | , _calRangeStartOneSigma = start 78 | , _calRangeMedian = median 79 | , _calRangeStopOneSigma = stop 80 | , _calRangeStopTwoSigma = stop 81 | } 82 | , _calC14HDROneSigma = [HDR start stop] 83 | , _calC14HDRTwoSigma = [HDR start stop] 84 | } 85 | -- for normal post-calibration probability distributions 86 | | otherwise = 87 | Right $ CalC14 { 88 | _calC14id = name 89 | , _calC14RangeSummary = CalRangeSummary { 90 | _calRangeStartTwoSigma = _hdrstart $ head hdrs95 91 | , _calRangeStartOneSigma = _hdrstart $ head hdrs68 92 | , _calRangeMedian = median 93 | , _calRangeStopOneSigma = _hdrstop $ last hdrs68 94 | , _calRangeStopTwoSigma = _hdrstop $ last hdrs95 95 | } 96 | , _calC14HDROneSigma = hdrs68 97 | , _calC14HDRTwoSigma = hdrs95 98 | } 99 | where 100 | -- simple density cumsum for median age 101 | cumsumDensities = cumsumDens (VU.toList $ VU.zip cals dens) 102 | distanceTo05 = map (\x -> abs $ (x - 0.5)) cumsumDensities 103 | median = fromJust $ cals `indexVU` elemIndex (minimum distanceTo05) distanceTo05 104 | -- sorted density cumsum for hdrs 105 | sortedDensities = sortBy (flip (\ (_, dens1) (_, dens2) -> compare dens1 dens2)) (VU.toList $ VU.zip cals dens) 106 | cumsumSortedDensities = cumsumDens sortedDensities 107 | isIn68 = map (< 0.683) cumsumSortedDensities 108 | isIn95 = map (< 0.954) cumsumSortedDensities 109 | contextualizedDensities = sort $ zipWith3 (\(y,d) in68 in95 -> (y,d,in68,in95)) sortedDensities isIn68 isIn95 110 | hdrs68 = densities2HDR68 contextualizedDensities 111 | hdrs95 = densities2HDR95 contextualizedDensities 112 | -- helper functions 113 | indexVU _ Nothing = Nothing 114 | indexVU x (Just i) = x VU.!? i 115 | cumsumDens :: [(YearBCAD, Double)] -> [Double] 116 | cumsumDens x = scanl1 (+) $ map snd x 117 | densities2HDR68 :: [(Int, Double, Bool, Bool)] -> [HDR] 118 | densities2HDR68 cDensities = 119 | let highDensityGroups = groupBy (\(_,_,in681,_) (_,_,in682,_) -> in681 == in682) cDensities 120 | filteredDensityGroups = filter (all getIn68) highDensityGroups 121 | in map (\xs -> let yearRange = map getYear xs in HDR (head yearRange) (last yearRange)) filteredDensityGroups 122 | densities2HDR95 :: [(Int, Double, Bool, Bool)] -> [HDR] 123 | densities2HDR95 cDensities = 124 | let highDensityGroups = groupBy (\(_,_,_,in951) (_,_,_,in952) -> in951 == in952) cDensities 125 | filteredDensityGroups = filter (all getIn95) highDensityGroups 126 | in map (\xs -> let yearRange = map getYear xs in HDR (head yearRange) (last yearRange)) filteredDensityGroups 127 | getIn68 :: (Int, Double, Bool, Bool) -> Bool 128 | getIn68 (_,_,x,_) = x 129 | getIn95 :: (Int, Double, Bool, Bool) -> Bool 130 | getIn95 (_,_,_,x) = x 131 | getYear :: (Int, Double, Bool, Bool) -> Int 132 | getYear (year,_,_,_) = year 133 | 134 | -- age sampling 135 | 136 | -- | A data type to define the settings for age sampling 137 | data AgeSamplingConf = AgeSamplingConf { 138 | -- | Random number generator 139 | _assRNG :: R.StdGen 140 | -- | Number of samples that should be drawn per sample 141 | , _assNumberOfSamples :: Word 142 | } deriving (Show, Eq) 143 | 144 | -- | Draw random samples from a probability density table 145 | sampleAgesFromCalPDF :: AgeSamplingConf -> CalPDF -> Either CurrycarbonException RandomAgeSample 146 | sampleAgesFromCalPDF (AgeSamplingConf rng n) calPDF@(CalPDF calPDFid cals dens) = 147 | let weightedList = zip (VU.toList cals) (map toRational $ VU.toList dens) 148 | infSamplesList = sampleWeightedList rng weightedList 149 | samples = take (fromIntegral n) infSamplesList 150 | in if isInvalidCalPDF calPDF 151 | then Left $ CurrycarbonInvalidCalPDFException "random age sampling" 152 | else Right $ RandomAgeSample calPDFid (VU.fromList samples) 153 | where 154 | sampleWeightedList :: CMR.RandomGen g => g -> [(a, Rational)] -> [a] 155 | sampleWeightedList gen weights = CMR.evalRand m gen 156 | where m = sequence . repeat . CMR.fromList $ weights 157 | 158 | isInvalidCalPDF :: CalPDF -> Bool 159 | isInvalidCalPDF (CalPDF _ _ dens) = VU.sum dens == 0 || VU.any (>= 1.0) dens 160 | -------------------------------------------------------------------------------- /src/Currycarbon/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StrictData #-} 2 | 3 | module Currycarbon.Types where 4 | 5 | import qualified Data.Vector as V 6 | import qualified Data.Vector.Unboxed as VU 7 | 8 | -- * Data types 9 | -- 10 | -- $dataTypes 11 | -- 12 | -- This module defines the relevant data types for handling radiocarbon dates 13 | 14 | -- | currycarbon includes different calibration algorithms. Currently two distinct 15 | -- implementations are available. Maybe more algorithms will be added in the future. 16 | -- A good default is @Bchron { distribution = StudentTDist 100 }@. 17 | data CalibrationMethod = 18 | -- | A matrix multiplication method generally following [this blog post by Martin Hinz](https://www.martinhinz.info/jekyll/update/blog/2016/06/03/simple_calibration.html). 19 | -- This method is slower and the underlying code more verbose than 'Bchron', but it 20 | -- has some advantages regarding didactics and the inspection of intermediate data 21 | -- products for debugging. 22 | -- Using this method is generally not advisable, except for specific applications, 23 | -- where a more technical insight into C14 calibration is needed 24 | MatrixMultiplication 25 | -- | A fast and reliable calibration algorithm very similar to the implementation in the 26 | -- [R package Bchron by Andrew Parnell](https://github.com/andrewcparnell/Bchron/blob/master/R/BchronCalibrate.R). 27 | -- This algorithm can be run with a simple normal distribution ('NormalDist') or 28 | -- Student's t-distribution ('StudentTDist'), which is recommended 29 | | Bchron { distribution :: CalibrationDistribution } 30 | deriving (Show, Eq) 31 | 32 | -- | A data type to cover the configuration options of the calibrateDates function 33 | data CalibrateDatesConf = CalibrateDatesConf { 34 | -- | Allow calibration to run outside of the range of the calibration curve 35 | _calConfAllowOutside :: Bool 36 | -- | Interpolate the calibration curve before calibration. 37 | -- This is a simple linear interpolation only to increase the output 38 | -- resolution for earlier time periods, where the typical calibration 39 | -- curves are less dense by default. With the interpolation, the output 40 | -- will be a per-year density. The mechanism is inspired by the 41 | -- [implementation in the Bchron R package](https://github.com/andrewcparnell/Bchron/blob/b202d18550319b488e676a8b542aba55853f6fa3/R/BchronCalibrate.R#L118-L119) 42 | , _calConfInterpolateCalCurve :: Bool 43 | -- | Trim the calibration curve before the calibration. 44 | -- Reduces the calibration curve to a segment around the mean of the 45 | -- uncalibrated date +/- six times its standard deviation. 46 | -- This speeds up calibration. 47 | , _calConfTrimCalCurveBeforeCalibration :: Bool 48 | -- | Trim the output CalPDF with a fixed threshold. 49 | -- Years before or after the first or the last density value of 50 | -- 0.00001 get removed. 51 | , _calConfTrimCalPDFAfterCalibration :: Bool 52 | } deriving (Show, Eq) 53 | 54 | -- | A default configuration that should yield almost identical calibration results 55 | -- to the [Bchron R package](https://github.com/andrewcparnell/Bchron) 56 | defaultCalConf :: CalibrateDatesConf 57 | defaultCalConf = CalibrateDatesConf { 58 | _calConfAllowOutside = False 59 | , _calConfInterpolateCalCurve = True 60 | , _calConfTrimCalCurveBeforeCalibration = True 61 | , _calConfTrimCalPDFAfterCalibration = True 62 | } 63 | 64 | -- | Statistical distributions to be used with the 'CalibrationMethod' 'Bchron' 65 | data CalibrationDistribution = 66 | -- | Normal distribution 67 | NormalDist 68 | -- | Student's t-distribution. 69 | | StudentTDist { 70 | ndf :: Double -- ^ number of degrees of freedom 71 | } 72 | deriving (Show, Eq) 73 | 74 | -- | A type to represent years BP. All numbers are positive and describe the distance in years 75 | -- to 1950AD: 3000 = 3000BP = 1050BC 76 | type YearBP = Word 77 | -- | A type to represent years BC or AD. Negative values describe years BC, positive values 78 | -- years AD: -5000 = 5000BC and 1300 = 1300AD 79 | type YearBCAD = Int 80 | -- | A type to represent a range of years 81 | type YearRange = Word 82 | 83 | -- | A data type to represent an uncalibrated radiocarbon date 84 | data UncalC14 = UncalC14 { 85 | -- | Sample identifier, e.g. a lab number 86 | _uncalC14Id :: String 87 | -- | C14 age in years BP 88 | , _uncalC14UnCal :: YearBP 89 | -- | C14 standard deviation (one sigma in years) 90 | , _uncalC14Sigma :: YearRange 91 | } deriving (Show, Eq) 92 | 93 | -- | A data type to represent a year-wise probability density for uncalibrated dates 94 | -- Although technically not correct, we still call this a probability density function (PDF) 95 | data UncalPDF = UncalPDF { 96 | -- | Sample identifier, e.g. a lab number 97 | _uncalPDFid :: String 98 | -- | Years BP 99 | , _uncalPDFUnCals :: VU.Vector YearBP 100 | -- | Probability densities 101 | , _uncalPDFDens :: VU.Vector Double 102 | } deriving Show 103 | 104 | -- | A data type to represent a calibration curve with 'YearBP' 105 | data CalCurveBP = CalCurveBP { 106 | -- | Years calBP 107 | _calCurveBPCals :: VU.Vector YearBP 108 | -- | Years BP 109 | , _calCurveBPUnCals :: VU.Vector YearBP 110 | -- | Standard deviation (one sigma in years) 111 | , _calCurveBPSigmas :: VU.Vector YearRange 112 | } deriving Show 113 | 114 | -- | A second data type to represent a calibration curve, here now with 'YearBCAD' 115 | data CalCurveBCAD = CalCurveBCAD { 116 | -- | Years calBCAD 117 | _calCurveBCADCals :: VU.Vector YearBCAD 118 | -- | Years BCAD 119 | , _calCurveBCADUnCals :: VU.Vector YearBCAD 120 | -- | Standard deviation (one sigma in years) 121 | , _calCurveBCADSigmas :: VU.Vector YearRange 122 | } deriving Show 123 | 124 | -- | A data type to represent a calibration curve in a /wide/ matrix form 125 | data CalCurveMatrix = CalCurveMatrix { 126 | -- | Row names of the calibration curve matrix: Years BCAD 127 | _calCurveMatrixUnCals :: VU.Vector YearBCAD 128 | -- | Column names of the calibration curve matrix: Years calBCAD 129 | , _calCurveMatrixCals :: VU.Vector YearBCAD 130 | -- | Matrix (as a list of columns) with the probability densities 131 | , _calCurveMatrixDens :: V.Vector (VU.Vector Double) 132 | } deriving Show 133 | 134 | -- | A data type to represent a year-wise probability density for calibrated dates. 135 | -- Although technically not correct, we still call this a probability density function (PDF) 136 | data CalPDF = CalPDF { 137 | -- | Sample identifier, e.g. a lab number 138 | _calPDFid :: String 139 | -- | Years calBCAD 140 | , _calPDFCals :: VU.Vector YearBCAD 141 | -- | Probability densities for each year in '_calPDFCals' 142 | , _calPDFDens :: VU.Vector Double 143 | } deriving (Show, Eq) 144 | 145 | -- | A data type for named calibration expressions 146 | data NamedCalExpr = NamedCalExpr { 147 | -- | Expression identifier 148 | _exprID :: String 149 | -- | Expression 150 | , _expr :: CalExpr 151 | } deriving (Show, Eq) 152 | 153 | -- | A data type to represent an expression for sum- or product calibration 154 | data CalExpr = 155 | UnCalDate UncalC14 156 | | WindowBP TimeWindowBP 157 | | WindowBCAD TimeWindowBCAD 158 | | CalDate CalPDF 159 | | SumCal CalExpr CalExpr 160 | | ProductCal CalExpr CalExpr 161 | deriving (Show, Eq) 162 | -- http://www.cse.chalmers.se/edu/year/2018/course/TDA452/lectures/RecursiveDataTypes.html 163 | 164 | data TimeWindowBP = TimeWindowBP String YearBP YearBP 165 | deriving (Show, Eq) 166 | 167 | data TimeWindowBCAD = TimeWindowBCAD String YearBCAD YearBCAD 168 | deriving (Show, Eq) 169 | 170 | -- | A data type to represent a human readable summary of a calibrated radiocarbon date 171 | data CalC14 = CalC14 { 172 | -- | Identifier, e.g. a lab number 173 | _calC14id :: String 174 | -- | Summary of the range of the calibrated date 175 | , _calC14RangeSummary :: CalRangeSummary 176 | -- | One-sigma high density regions 177 | , _calC14HDROneSigma :: [HDR] 178 | -- | Two-sigma high density regions 179 | , _calC14HDRTwoSigma :: [HDR] 180 | } deriving Show 181 | 182 | -- | A data type to store a simple range summary of the calibrated date, including 183 | -- the median age 184 | data CalRangeSummary = CalRangeSummary { 185 | -- | Start of the two-sigma age range 186 | _calRangeStartTwoSigma :: YearBCAD 187 | -- | Start of the one-sigma age range 188 | , _calRangeStartOneSigma :: YearBCAD 189 | -- | Median age 190 | , _calRangeMedian :: YearBCAD 191 | -- | End of the one-sigma age range 192 | , _calRangeStopOneSigma :: YearBCAD 193 | -- | End of the two-sigma age range 194 | , _calRangeStopTwoSigma :: YearBCAD 195 | } deriving Show 196 | 197 | -- | A data type to represent a high density region of a probability distribution. 198 | -- A high density region is here defined as an age range, within which the respective 199 | -- cumulative probability (e.g. of an calibrated radiocarbon date density curve) 200 | -- is above a certain threshold 201 | data HDR = HDR { 202 | -- | Start of the high density region in years calBCAD 203 | _hdrstart :: YearBCAD 204 | -- | End of the high density region in years calBCAD 205 | , _hdrstop :: YearBCAD 206 | } deriving (Show, Eq) 207 | 208 | -- | A data type to store random samples drawn from a calPDF 209 | data RandomAgeSample = RandomAgeSample { 210 | -- | Identifier 211 | _rasId :: String 212 | -- | Random samples 213 | , _rasSamples :: VU.Vector YearBCAD 214 | } deriving Show 215 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | - V 0.5.0.0: Cleaned up parser error behaviour: 2 | - Parsing errors are now more helpful with better positional information, using a modified `showParsecErr` and a new `showParsecErrOneLine`. 3 | - Breaking change: The type of `readCalCurve` changed. It is now safe, returning `Either String CalCurveBP`. The old version is preserved in `readCalCurveUnsafe`. 4 | - V 0.4.0.2: Support for `optparse-applicative-0.19.0.0`. 5 | - V 0.4.0.1: Support for `random-1.3`. Now possible, because MonadRandom supports it as well (https://github.com/byorgey/MonadRandom/blob/master/CHANGES.markdown#062-5-march-2025). 6 | - V 0.4.0.0: Another major update: 7 | - Added more calibration curves next to `intcal20`: `shcal20` and `marine20`. Renamed the `Currycarbon.CalCurves.IntCal20` module to just `Currycarbon.CalCurves`. In the CLI, `--calCurveFile` is now just `--calCurve`, and it allows to either select the different packaged curves or read arbitrary .14c files. 8 | - Added a new CLI plot element to the output of individual dates. `renderCLIPlotCalCurve` plots a relevant section of the calibration curve. 9 | - Added the command line options `--noTrimCalCurve` and `--noTrimOutCalPDF` to allow control over the pre- and post-calibration trimming behaviour for radiocarbon dates. 10 | - Changed the way products between calibration expressions are computed in `evalCalExpr`. Input expressions in a multiplication are now calibrated for the entire length of the calibration curve. This allows to compute proper products and not fail in case of non-overlapping output. 11 | - Changed the way calibration curves are embedded in currycarbon. This now uses the brilliant `file-embed` library. 12 | - Changed the interface of the core calibration functions. `CalibrateDatesConf` no longer includes the `CalibrationMethod`, so `calibrateDates` and `evalNamedCalExpr` functions need it as an extra argument. `calibrateDateBchron` and `calibrateDateMatrixMult` now take `CalibrateDatesConf` and not its individual elements. 13 | - Moved from Float to Double for probability densities and all functions that interact with them. 14 | - Added a new output option `--basicFile` to the CLI to enable simple per-expression output: The minimum start and maximum end of the high probability density regions and the median age. In this context `writeCalC14` was split into `writeCalC14HDR` and `writeCalC14CalRangeSummary` in the library. 15 | - Added little axis labels (BC/AD) to the command line plot to improve readability. 16 | - Changed the release pipeline: Now again with a windows executable. currycarbon-macOS was replaced by currycarbon-macOS-X64 and currycarbon-macOS-ARM64. 17 | - Switched to a new GHC version (v9.6.6) and stackage resolver version (lts-22.43). 18 | - V 0.3.0.1: The golden tests can not run on stackage as it stands, so I hid them behind an environment variable. 19 | - V 0.3.0.0: Major update with multiple breaking changes and new features: 20 | - Added a new mechanism to draw random age samples from a CalPDF (`sampleAgesFromCalPDF :: AgeSamplingConf -> CalPDF -> RandomAgeSample`). This is available from the command line with the options `samplesFile`, `--seed`, and `-n`/`--nrSamples`. 21 | - Added a new concept to the `CalExpr` data type: Age ranges with uniform probability for each year in the range (`TimeWindowBP` and `TimeWindowBCAD`). 22 | - Reworked the encoding and evaluation mechanism for calibration expressions: 23 | - Introduced the `NamedCalExpr` as a wrapper around `CalExpr` with an identifier, and then adjusted the ID generation for `CalPDF`s to prioritize this identifier. 24 | - Reworked the CLI DSL to support a standardized configuration language syntax implemented in a new module `ParserHelpers.hs`. This introduces a set of flexible functions (`calExpr()`, `uncalC14()`, `rangeBP()`, `rangeBCAD()`, `sum()` and `product()`) which generally complement the previously available syntax and operators. The old syntax is mostly preserved as syntactic sugar for the new, more standardized syntax. Unfortunately this is not entirely seamless: The change breaks some expressions that were valid before (e.g. `"3000,30 + 3020,50"`). They now require additional parentheses to pass (so e.g. `"(3000,30) + (3020,50)"`). 25 | - Added some unit tests to cover the increasingly complex DSL. 26 | - Changed the output files from .csv to .tsv and to a more meaningful and consistent set of column names. 27 | - Slightly adjusted the rendering of the pretty, human-focussed command line output. 28 | - Updated and improved the command line documentation. 29 | - Renamed some CLI arguments: 30 | - `--calibrationCurveFile` -> `--calCurveFile` 31 | - `--calCurveSegmentFile` -> `--calCurveSegFile` 32 | - `--calCurveMatrixFile` -> `--calCurveMatFile` 33 | - Changed the CLI behaviour with `--calCurveSegFile` and `--calCurveMatFile`: currycarbon now fails with these options if the first sample is not a single, uncalibrated radiocarbon date (so `uncalC14()`). 34 | - Added a simple golden test system with some basic calls to the `currycarbon` CLI tool. 35 | - Switched to a new GHC version (v9.4.7) and stackage resolver version (lts-21.17). 36 | - V 0.2.1.2: Maintenance: Switched to a newer compiler/resolver version, lifted some dependency restrictions, ran stylish-haskell on the entire codebase, updated the github actions, deprecated the haddock documentation for the dev version on GitHub. 37 | - V 0.2.1.1: Lifted some restrictions regarding the upper version bounds of dependencies. 38 | - V 0.2.1.0: Added a mechanism to detect terminal encoding and fall back on a simpler CLI plot if it is not UTF-8. 39 | - V 0.2.0.1: Brought sample names back to default CLI output. 40 | - V 0.2.0.0: Added sum (and product) calibration and made the necessary changes to various interfaces (including CLI) to make this functionality accessible. 41 | - V 0.1.2.0: Added simple summary data (`CalRangeSummary` with calibrated median age + begin and end of 1- and 2-sigma ranges) to `CalC14` and the CLI output and plot. The latter got refactored and enhanced in the process. `HDR`s are now "ordered", so `_hdrstart` actually stores the older and `_hdrstop` the younger date. 42 | - V 0.1.1.0: Complete rewrite of the CLI output handling to avoid a memory leak. 43 | - V 0.1.0.0: Switch to PVP versioning (https://pvp.haskell.org/). 44 | - V 0.24.4: Removed big dependencies bytestring and statistics. 45 | - V 0.24.3: Multiple changes in .cabal to make cabal check happy. 46 | - V 0.24.2: Found and fixed another severe bug in `renderCalCurve`. 47 | - V 0.24.1: Fixed a serious bug in `renderCalCurveMatrix`. 48 | - V 0.24.0: Introduced more precise data types to distinguish years BP and years BC/AD. 49 | - V 0.23.1: Small changes to the instances of some general types. 50 | - V 0.23.0: Renamed multiple functions to make the naming of operations for parsing, reading, from-file reading, rendering and writing consistent across data types. 51 | - V 0.22.0: Changed the interface of the important `calibrateDates` function with a new config data type `CalibrateDatesConf`. 52 | - V 0.21.3: Refactored the calibration curve interpolation. 53 | - V 0.21.2: Introduced doctest and added some tiny examples/tests to try it out. 54 | - V 0.21.1: Split up the calibration module for better readability. 55 | - V 0.21.0: Added a neat CLI density plot for calibrated dates. 56 | - V 0.20.2: Some performance improvements for the calibration of large numbers of dates. 57 | - V 0.20.1: Better (parsing) error handling. 58 | - V 0.20.0: Added an option `--allowOutside` to allow for calibrations to run outside the range of the calibration curve. 59 | - V 0.19.0: Added functionality to filter out dates outside of the range of the calibration curve and report an error in this case. 60 | - V 0.18.0: Implemented calibration with a StudentT distribution to mimic Bchron and established that as the new default. Reimplemented the `--method` option of the CLI tool to reflect that change. 61 | - V 0.17.0: Changed argument order in the `CalCurve` data type to adjust to the order in `.14C` files. 62 | - V 0.16.0: Refactoring in the library to simplify and clarify the interface. 63 | - V 0.15.0: Added another calibration algorithm (following the implementation by Andrew Parnell in Bchron) and a method switch for the CLI. 64 | - V 0.14.0: Introduced strictness, which brought a significant increase in performance. See the discussion here: https://old.reddit.com/r/haskell/comments/picjy6/how_could_i_improve_the_performance_of_my/. 65 | - V 0.13.0: Major rewrite with the vector library - includes multiple bugfixes, but is surprisingly slow. 66 | - V 0.12.0: Renamed some core functions. 67 | - V 0.11.0: Made calibration curve interpolation optional and turned it off by default. 68 | - V 0.10.0: Simplified CLI interface by dropping the `calibrate` subcommand (`currycarbon` is sufficient now) and by repurposing `-q` from `--quickOut` to `--quiet`. 69 | - V 0.9.0: Made `--hdrFile` output a lot more machine-readable. 70 | - V 0.8.0: Added option `--calibrationCurveFile` to calibrate with different calibration curves. 71 | - V 0.7.2: More documentation, small changes in code layout and renamed CLI module that provides `runCalibrate`. 72 | - V 0.7.1: Added type documentation with haddock and replaced the existing types with record types. 73 | - V 0.7.0: Changed the date input interface once more. 74 | - V 0.6.0: Changed the date input interface, because parenthesis can be part of valid lab numbers. 75 | - V 0.5.2: Fixed parallel evaluation (deepseq forced memory-intensive, non-lazy behaviour). 76 | - V 0.5.1: Added github release action (copied from poseidon-hs). 77 | - V 0.5.0: Added file input for dates to calibrate. 78 | - V 0.4.0: Made output calibrated dates negative numbers for BC and positive for AD - and adjusted HDR printing accordingly. 79 | - V 0.3.2: Some optimisation. 80 | - V 0.3.1: Added automatic filling of unknown sample names. 81 | - V 0.3.0: Simplified interface. 82 | - V 0.2.1: Removed ascii plot functionality. 83 | - V 0.2.0: Added parallel processing for the main calibration operation. 84 | - V 0.1.0: First basically working version. 85 | -------------------------------------------------------------------------------- /test/golden/actual_data/cal_curve_seg_file.tsv: -------------------------------------------------------------------------------- 1 | calYearBCAD uncalYearBCAD sigma 2 | -1441 -1229 17 3 | -1440 -1227 17 4 | -1439 -1226 17 5 | -1438 -1224 17 6 | -1437 -1222 17 7 | -1436 -1221 17 8 | -1435 -1219 16 9 | -1434 -1218 16 10 | -1433 -1217 16 11 | -1432 -1215 16 12 | -1431 -1214 16 13 | -1430 -1212 16 14 | -1429 -1210 17 15 | -1428 -1209 17 16 | -1427 -1207 18 17 | -1426 -1205 18 18 | -1425 -1204 19 19 | -1424 -1202 19 20 | -1423 -1200 19 21 | -1422 -1198 19 22 | -1421 -1196 19 23 | -1420 -1193 19 24 | -1419 -1191 19 25 | -1418 -1189 18 26 | -1417 -1186 18 27 | -1416 -1183 17 28 | -1415 -1181 17 29 | -1414 -1178 17 30 | -1413 -1176 17 31 | -1412 -1173 17 32 | -1411 -1171 17 33 | -1410 -1168 17 34 | -1409 -1166 18 35 | -1408 -1164 18 36 | -1407 -1162 18 37 | -1406 -1160 18 38 | -1405 -1158 18 39 | -1404 -1157 18 40 | -1403 -1155 18 41 | -1402 -1154 17 42 | -1401 -1153 17 43 | -1400 -1152 17 44 | -1399 -1151 16 45 | -1398 -1150 16 46 | -1397 -1149 16 47 | -1396 -1148 16 48 | -1395 -1147 17 49 | -1394 -1146 17 50 | -1393 -1144 17 51 | -1392 -1143 18 52 | -1391 -1142 18 53 | -1390 -1140 18 54 | -1389 -1139 18 55 | -1388 -1137 17 56 | -1387 -1135 17 57 | -1386 -1133 17 58 | -1385 -1131 17 59 | -1384 -1129 17 60 | -1383 -1127 17 61 | -1382 -1125 17 62 | -1381 -1123 18 63 | -1380 -1120 18 64 | -1379 -1118 19 65 | -1378 -1116 19 66 | -1377 -1114 19 67 | -1376 -1112 19 68 | -1375 -1110 19 69 | -1374 -1108 19 70 | -1373 -1106 19 71 | -1372 -1104 18 72 | -1371 -1102 18 73 | -1370 -1101 18 74 | -1369 -1099 17 75 | -1368 -1098 17 76 | -1367 -1097 18 77 | -1366 -1096 18 78 | -1365 -1095 18 79 | -1364 -1094 19 80 | -1363 -1094 19 81 | -1362 -1094 19 82 | -1361 -1094 19 83 | -1360 -1094 19 84 | -1359 -1095 19 85 | -1358 -1096 18 86 | -1357 -1097 18 87 | -1356 -1098 17 88 | -1355 -1099 17 89 | -1354 -1101 16 90 | -1353 -1102 16 91 | -1352 -1104 16 92 | -1351 -1106 16 93 | -1350 -1107 16 94 | -1349 -1109 16 95 | -1348 -1110 16 96 | -1347 -1112 16 97 | -1346 -1113 16 98 | -1345 -1115 16 99 | -1344 -1116 16 100 | -1343 -1118 16 101 | -1342 -1119 16 102 | -1341 -1121 16 103 | -1340 -1124 16 104 | -1339 -1126 16 105 | -1338 -1129 16 106 | -1337 -1133 15 107 | -1336 -1136 15 108 | -1335 -1139 15 109 | -1334 -1142 16 110 | -1333 -1145 16 111 | -1332 -1147 16 112 | -1331 -1148 15 113 | -1330 -1149 15 114 | -1329 -1150 15 115 | -1328 -1150 15 116 | -1327 -1149 15 117 | -1326 -1148 16 118 | -1325 -1147 16 119 | -1324 -1145 16 120 | -1323 -1143 16 121 | -1322 -1141 15 122 | -1321 -1138 15 123 | -1320 -1136 15 124 | -1319 -1134 15 125 | -1318 -1132 15 126 | -1317 -1131 15 127 | -1316 -1130 15 128 | -1315 -1129 15 129 | -1314 -1128 15 130 | -1313 -1127 15 131 | -1312 -1126 15 132 | -1311 -1125 15 133 | -1310 -1124 15 134 | -1309 -1124 15 135 | -1308 -1122 15 136 | -1307 -1121 15 137 | -1306 -1120 15 138 | -1305 -1118 15 139 | -1304 -1116 15 140 | -1303 -1114 15 141 | -1302 -1112 15 142 | -1301 -1109 15 143 | -1300 -1107 15 144 | -1299 -1105 15 145 | -1298 -1103 15 146 | -1297 -1102 15 147 | -1296 -1101 16 148 | -1295 -1100 16 149 | -1294 -1099 15 150 | -1293 -1098 15 151 | -1292 -1098 15 152 | -1291 -1097 15 153 | -1290 -1097 15 154 | -1289 -1096 15 155 | -1288 -1096 15 156 | -1287 -1095 14 157 | -1286 -1094 14 158 | -1285 -1094 14 159 | -1284 -1093 14 160 | -1283 -1092 14 161 | -1282 -1090 14 162 | -1281 -1089 15 163 | -1280 -1088 15 164 | -1279 -1087 15 165 | -1278 -1086 15 166 | -1277 -1085 15 167 | -1276 -1084 15 168 | -1275 -1084 15 169 | -1274 -1084 15 170 | -1273 -1083 15 171 | -1272 -1083 15 172 | -1271 -1083 15 173 | -1270 -1082 15 174 | -1269 -1082 15 175 | -1268 -1081 15 176 | -1267 -1080 15 177 | -1266 -1078 15 178 | -1265 -1076 15 179 | -1264 -1074 14 180 | -1263 -1072 15 181 | -1262 -1070 15 182 | -1261 -1067 15 183 | -1260 -1064 15 184 | -1259 -1061 15 185 | -1258 -1058 14 186 | -1257 -1055 14 187 | -1256 -1053 14 188 | -1255 -1050 14 189 | -1254 -1048 15 190 | -1253 -1047 15 191 | -1252 -1046 15 192 | -1251 -1045 15 193 | -1250 -1046 15 194 | -1249 -1047 15 195 | -1248 -1048 15 196 | -1247 -1049 15 197 | -1246 -1051 15 198 | -1245 -1052 15 199 | -1244 -1054 15 200 | -1243 -1056 15 201 | -1242 -1057 15 202 | -1241 -1059 15 203 | -1240 -1060 15 204 | -1239 -1061 15 205 | -1238 -1061 15 206 | -1237 -1061 15 207 | -1236 -1061 15 208 | -1235 -1061 15 209 | -1234 -1060 15 210 | -1233 -1059 15 211 | -1232 -1058 15 212 | -1231 -1057 15 213 | -1230 -1056 15 214 | -1229 -1055 15 215 | -1228 -1054 15 216 | -1227 -1053 15 217 | -1226 -1051 15 218 | -1225 -1050 15 219 | -1224 -1049 15 220 | -1223 -1048 15 221 | -1222 -1046 15 222 | -1221 -1044 15 223 | -1220 -1042 15 224 | -1219 -1040 15 225 | -1218 -1037 15 226 | -1217 -1034 15 227 | -1216 -1032 15 228 | -1215 -1029 15 229 | -1214 -1026 16 230 | -1213 -1024 16 231 | -1212 -1021 17 232 | -1211 -1019 17 233 | -1210 -1018 18 234 | -1209 -1016 18 235 | -1208 -1015 18 236 | -1207 -1014 18 237 | -1206 -1014 18 238 | -1205 -1013 18 239 | -1204 -1013 19 240 | -1203 -1012 19 241 | -1202 -1011 19 242 | -1201 -1011 20 243 | -1200 -1010 20 244 | -1199 -1009 20 245 | -1198 -1007 20 246 | -1197 -1006 20 247 | -1196 -1004 19 248 | -1195 -1003 19 249 | -1194 -1001 18 250 | -1193 -999 18 251 | -1192 -998 18 252 | -1191 -996 17 253 | -1190 -995 17 254 | -1189 -993 18 255 | -1188 -992 18 256 | -1187 -991 18 257 | -1186 -990 19 258 | -1185 -989 19 259 | -1184 -988 20 260 | -1183 -988 20 261 | -1182 -988 20 262 | -1181 -989 20 263 | -1180 -989 20 264 | -1179 -991 20 265 | -1178 -992 20 266 | -1177 -994 19 267 | -1176 -995 19 268 | -1175 -997 19 269 | -1174 -999 18 270 | -1173 -1001 18 271 | -1172 -1003 18 272 | -1171 -1005 18 273 | -1170 -1006 18 274 | -1169 -1007 19 275 | -1168 -1008 19 276 | -1167 -1009 19 277 | -1166 -1009 19 278 | -1165 -1009 18 279 | -1164 -1008 18 280 | -1163 -1007 17 281 | -1162 -1005 17 282 | -1161 -1003 16 283 | -1160 -1001 16 284 | -1159 -999 16 285 | -1158 -997 16 286 | -1157 -995 16 287 | -1156 -993 16 288 | -1155 -990 15 289 | -1154 -988 15 290 | -1153 -987 15 291 | -1152 -985 14 292 | -1151 -984 14 293 | -1150 -984 15 294 | -1149 -984 15 295 | -1148 -985 15 296 | -1147 -987 15 297 | -1146 -989 15 298 | -1145 -993 14 299 | -1144 -996 14 300 | -1143 -1000 14 301 | -1142 -1003 15 302 | -1141 -1006 15 303 | -1140 -1009 15 304 | -1139 -1011 15 305 | -1138 -1013 15 306 | -1137 -1014 15 307 | -1136 -1014 14 308 | -1135 -1014 14 309 | -1134 -1013 15 310 | -1133 -1012 15 311 | -1132 -1010 15 312 | -1131 -1008 15 313 | -1130 -1005 15 314 | -1129 -1002 15 315 | -1128 -999 15 316 | -1127 -996 15 317 | -1126 -992 15 318 | -1125 -989 15 319 | -1124 -985 15 320 | -1123 -982 15 321 | -1122 -979 16 322 | -1121 -976 16 323 | -1120 -973 15 324 | -1119 -971 15 325 | -1118 -969 15 326 | -1117 -967 15 327 | -1116 -965 15 328 | -1115 -963 15 329 | -1114 -962 15 330 | -1113 -960 15 331 | -1112 -959 15 332 | -1111 -957 15 333 | -1110 -956 15 334 | -1109 -954 15 335 | -1108 -953 15 336 | -1107 -951 16 337 | -1106 -950 16 338 | -1105 -949 16 339 | -1104 -948 17 340 | -1103 -948 17 341 | -1102 -947 18 342 | -1101 -947 18 343 | -1100 -947 18 344 | -1099 -948 18 345 | -1098 -948 17 346 | -1097 -949 17 347 | -1096 -950 17 348 | -1095 -950 16 349 | -1094 -951 16 350 | -1093 -952 16 351 | -1092 -953 17 352 | -1091 -953 17 353 | -1090 -954 17 354 | -1089 -955 18 355 | -1088 -955 18 356 | -1087 -955 18 357 | -1086 -955 18 358 | -1085 -954 18 359 | -1084 -954 18 360 | -1083 -953 18 361 | -1082 -953 17 362 | -1081 -952 17 363 | -1080 -951 17 364 | -1079 -950 17 365 | -1078 -949 17 366 | -1077 -949 17 367 | -1076 -948 18 368 | -1075 -947 18 369 | -1074 -947 18 370 | -1073 -947 18 371 | -1072 -947 18 372 | -1071 -947 18 373 | -1070 -948 18 374 | -1069 -949 17 375 | -1068 -950 17 376 | -1067 -951 17 377 | -1066 -952 17 378 | -1065 -953 17 379 | -1064 -954 17 380 | -1063 -954 17 381 | -1062 -955 17 382 | -1061 -956 17 383 | -1060 -956 18 384 | -1059 -956 18 385 | -1058 -955 18 386 | -1057 -954 18 387 | -1056 -953 18 388 | -1055 -952 18 389 | -1054 -950 18 390 | -1053 -947 17 391 | -1052 -945 17 392 | -1051 -942 16 393 | -1050 -939 16 394 | -1049 -936 16 395 | -1048 -933 16 396 | -1047 -930 16 397 | -1046 -927 16 398 | -1045 -925 17 399 | -1044 -922 17 400 | -1043 -920 17 401 | -1042 -918 18 402 | -1041 -917 18 403 | -1040 -916 18 404 | -1039 -915 18 405 | -1038 -915 18 406 | -1037 -915 18 407 | -1036 -916 18 408 | -1035 -917 17 409 | -1034 -918 17 410 | -1033 -919 17 411 | -1032 -920 16 412 | -1031 -922 16 413 | -1030 -923 16 414 | -1029 -924 16 415 | -1028 -926 17 416 | -1027 -927 17 417 | -1026 -928 17 418 | -1025 -929 17 419 | -1024 -930 18 420 | -1023 -930 18 421 | -1022 -930 18 422 | -1021 -929 18 423 | -1020 -928 18 424 | -1019 -927 18 425 | -1018 -925 17 426 | -1017 -923 17 427 | -1016 -921 16 428 | -1015 -918 16 429 | -1014 -915 16 430 | -1013 -912 15 431 | -1012 -909 15 432 | -1011 -906 15 433 | -1010 -902 15 434 | -1009 -899 16 435 | -1008 -896 16 436 | -1007 -893 16 437 | -1006 -890 17 438 | -1005 -887 17 439 | -1004 -885 17 440 | -1003 -883 17 441 | -1002 -881 17 442 | -1001 -880 17 443 | -1000 -879 17 444 | -999 -878 17 445 | -998 -878 16 446 | -997 -877 16 447 | -996 -877 16 448 | -995 -877 16 449 | -994 -877 17 450 | -993 -877 17 451 | -992 -877 17 452 | -991 -877 18 453 | -990 -877 18 454 | -989 -877 18 455 | -988 -876 18 456 | -987 -876 18 457 | -986 -875 18 458 | -985 -875 17 459 | -984 -874 17 460 | -983 -873 16 461 | -982 -872 16 462 | -981 -871 16 463 | -980 -869 16 464 | -979 -868 16 465 | -978 -867 16 466 | -977 -866 16 467 | -976 -864 17 468 | -975 -863 17 469 | -974 -862 17 470 | -973 -860 17 471 | -972 -859 17 472 | -971 -858 17 473 | -970 -857 17 474 | -969 -856 16 475 | -968 -855 16 476 | -967 -855 16 477 | -966 -854 16 478 | -965 -853 16 479 | -964 -853 16 480 | -963 -853 17 481 | -962 -853 17 482 | -961 -853 17 483 | -960 -853 18 484 | -959 -854 18 485 | -958 -854 18 486 | -957 -855 18 487 | -956 -856 18 488 | -955 -857 18 489 | -954 -859 17 490 | -953 -860 17 491 | -952 -862 16 492 | -951 -863 16 493 | -950 -865 16 494 | -949 -866 16 495 | -948 -867 16 496 | -947 -869 16 497 | -946 -870 16 498 | -945 -871 16 499 | -944 -872 17 500 | -943 -872 17 501 | -942 -872 17 502 | -941 -872 17 503 | -940 -872 18 -------------------------------------------------------------------------------- /test/golden/expected_data/cal_curve_seg_file.tsv: -------------------------------------------------------------------------------- 1 | calYearBCAD uncalYearBCAD sigma 2 | -1441 -1229 17 3 | -1440 -1227 17 4 | -1439 -1226 17 5 | -1438 -1224 17 6 | -1437 -1222 17 7 | -1436 -1221 17 8 | -1435 -1219 16 9 | -1434 -1218 16 10 | -1433 -1217 16 11 | -1432 -1215 16 12 | -1431 -1214 16 13 | -1430 -1212 16 14 | -1429 -1210 17 15 | -1428 -1209 17 16 | -1427 -1207 18 17 | -1426 -1205 18 18 | -1425 -1204 19 19 | -1424 -1202 19 20 | -1423 -1200 19 21 | -1422 -1198 19 22 | -1421 -1196 19 23 | -1420 -1193 19 24 | -1419 -1191 19 25 | -1418 -1189 18 26 | -1417 -1186 18 27 | -1416 -1183 17 28 | -1415 -1181 17 29 | -1414 -1178 17 30 | -1413 -1176 17 31 | -1412 -1173 17 32 | -1411 -1171 17 33 | -1410 -1168 17 34 | -1409 -1166 18 35 | -1408 -1164 18 36 | -1407 -1162 18 37 | -1406 -1160 18 38 | -1405 -1158 18 39 | -1404 -1157 18 40 | -1403 -1155 18 41 | -1402 -1154 17 42 | -1401 -1153 17 43 | -1400 -1152 17 44 | -1399 -1151 16 45 | -1398 -1150 16 46 | -1397 -1149 16 47 | -1396 -1148 16 48 | -1395 -1147 17 49 | -1394 -1146 17 50 | -1393 -1144 17 51 | -1392 -1143 18 52 | -1391 -1142 18 53 | -1390 -1140 18 54 | -1389 -1139 18 55 | -1388 -1137 17 56 | -1387 -1135 17 57 | -1386 -1133 17 58 | -1385 -1131 17 59 | -1384 -1129 17 60 | -1383 -1127 17 61 | -1382 -1125 17 62 | -1381 -1123 18 63 | -1380 -1120 18 64 | -1379 -1118 19 65 | -1378 -1116 19 66 | -1377 -1114 19 67 | -1376 -1112 19 68 | -1375 -1110 19 69 | -1374 -1108 19 70 | -1373 -1106 19 71 | -1372 -1104 18 72 | -1371 -1102 18 73 | -1370 -1101 18 74 | -1369 -1099 17 75 | -1368 -1098 17 76 | -1367 -1097 18 77 | -1366 -1096 18 78 | -1365 -1095 18 79 | -1364 -1094 19 80 | -1363 -1094 19 81 | -1362 -1094 19 82 | -1361 -1094 19 83 | -1360 -1094 19 84 | -1359 -1095 19 85 | -1358 -1096 18 86 | -1357 -1097 18 87 | -1356 -1098 17 88 | -1355 -1099 17 89 | -1354 -1101 16 90 | -1353 -1102 16 91 | -1352 -1104 16 92 | -1351 -1106 16 93 | -1350 -1107 16 94 | -1349 -1109 16 95 | -1348 -1110 16 96 | -1347 -1112 16 97 | -1346 -1113 16 98 | -1345 -1115 16 99 | -1344 -1116 16 100 | -1343 -1118 16 101 | -1342 -1119 16 102 | -1341 -1121 16 103 | -1340 -1124 16 104 | -1339 -1126 16 105 | -1338 -1129 16 106 | -1337 -1133 15 107 | -1336 -1136 15 108 | -1335 -1139 15 109 | -1334 -1142 16 110 | -1333 -1145 16 111 | -1332 -1147 16 112 | -1331 -1148 15 113 | -1330 -1149 15 114 | -1329 -1150 15 115 | -1328 -1150 15 116 | -1327 -1149 15 117 | -1326 -1148 16 118 | -1325 -1147 16 119 | -1324 -1145 16 120 | -1323 -1143 16 121 | -1322 -1141 15 122 | -1321 -1138 15 123 | -1320 -1136 15 124 | -1319 -1134 15 125 | -1318 -1132 15 126 | -1317 -1131 15 127 | -1316 -1130 15 128 | -1315 -1129 15 129 | -1314 -1128 15 130 | -1313 -1127 15 131 | -1312 -1126 15 132 | -1311 -1125 15 133 | -1310 -1124 15 134 | -1309 -1124 15 135 | -1308 -1122 15 136 | -1307 -1121 15 137 | -1306 -1120 15 138 | -1305 -1118 15 139 | -1304 -1116 15 140 | -1303 -1114 15 141 | -1302 -1112 15 142 | -1301 -1109 15 143 | -1300 -1107 15 144 | -1299 -1105 15 145 | -1298 -1103 15 146 | -1297 -1102 15 147 | -1296 -1101 16 148 | -1295 -1100 16 149 | -1294 -1099 15 150 | -1293 -1098 15 151 | -1292 -1098 15 152 | -1291 -1097 15 153 | -1290 -1097 15 154 | -1289 -1096 15 155 | -1288 -1096 15 156 | -1287 -1095 14 157 | -1286 -1094 14 158 | -1285 -1094 14 159 | -1284 -1093 14 160 | -1283 -1092 14 161 | -1282 -1090 14 162 | -1281 -1089 15 163 | -1280 -1088 15 164 | -1279 -1087 15 165 | -1278 -1086 15 166 | -1277 -1085 15 167 | -1276 -1084 15 168 | -1275 -1084 15 169 | -1274 -1084 15 170 | -1273 -1083 15 171 | -1272 -1083 15 172 | -1271 -1083 15 173 | -1270 -1082 15 174 | -1269 -1082 15 175 | -1268 -1081 15 176 | -1267 -1080 15 177 | -1266 -1078 15 178 | -1265 -1076 15 179 | -1264 -1074 14 180 | -1263 -1072 15 181 | -1262 -1070 15 182 | -1261 -1067 15 183 | -1260 -1064 15 184 | -1259 -1061 15 185 | -1258 -1058 14 186 | -1257 -1055 14 187 | -1256 -1053 14 188 | -1255 -1050 14 189 | -1254 -1048 15 190 | -1253 -1047 15 191 | -1252 -1046 15 192 | -1251 -1045 15 193 | -1250 -1046 15 194 | -1249 -1047 15 195 | -1248 -1048 15 196 | -1247 -1049 15 197 | -1246 -1051 15 198 | -1245 -1052 15 199 | -1244 -1054 15 200 | -1243 -1056 15 201 | -1242 -1057 15 202 | -1241 -1059 15 203 | -1240 -1060 15 204 | -1239 -1061 15 205 | -1238 -1061 15 206 | -1237 -1061 15 207 | -1236 -1061 15 208 | -1235 -1061 15 209 | -1234 -1060 15 210 | -1233 -1059 15 211 | -1232 -1058 15 212 | -1231 -1057 15 213 | -1230 -1056 15 214 | -1229 -1055 15 215 | -1228 -1054 15 216 | -1227 -1053 15 217 | -1226 -1051 15 218 | -1225 -1050 15 219 | -1224 -1049 15 220 | -1223 -1048 15 221 | -1222 -1046 15 222 | -1221 -1044 15 223 | -1220 -1042 15 224 | -1219 -1040 15 225 | -1218 -1037 15 226 | -1217 -1034 15 227 | -1216 -1032 15 228 | -1215 -1029 15 229 | -1214 -1026 16 230 | -1213 -1024 16 231 | -1212 -1021 17 232 | -1211 -1019 17 233 | -1210 -1018 18 234 | -1209 -1016 18 235 | -1208 -1015 18 236 | -1207 -1014 18 237 | -1206 -1014 18 238 | -1205 -1013 18 239 | -1204 -1013 19 240 | -1203 -1012 19 241 | -1202 -1011 19 242 | -1201 -1011 20 243 | -1200 -1010 20 244 | -1199 -1009 20 245 | -1198 -1007 20 246 | -1197 -1006 20 247 | -1196 -1004 19 248 | -1195 -1003 19 249 | -1194 -1001 18 250 | -1193 -999 18 251 | -1192 -998 18 252 | -1191 -996 17 253 | -1190 -995 17 254 | -1189 -993 18 255 | -1188 -992 18 256 | -1187 -991 18 257 | -1186 -990 19 258 | -1185 -989 19 259 | -1184 -988 20 260 | -1183 -988 20 261 | -1182 -988 20 262 | -1181 -989 20 263 | -1180 -989 20 264 | -1179 -991 20 265 | -1178 -992 20 266 | -1177 -994 19 267 | -1176 -995 19 268 | -1175 -997 19 269 | -1174 -999 18 270 | -1173 -1001 18 271 | -1172 -1003 18 272 | -1171 -1005 18 273 | -1170 -1006 18 274 | -1169 -1007 19 275 | -1168 -1008 19 276 | -1167 -1009 19 277 | -1166 -1009 19 278 | -1165 -1009 18 279 | -1164 -1008 18 280 | -1163 -1007 17 281 | -1162 -1005 17 282 | -1161 -1003 16 283 | -1160 -1001 16 284 | -1159 -999 16 285 | -1158 -997 16 286 | -1157 -995 16 287 | -1156 -993 16 288 | -1155 -990 15 289 | -1154 -988 15 290 | -1153 -987 15 291 | -1152 -985 14 292 | -1151 -984 14 293 | -1150 -984 15 294 | -1149 -984 15 295 | -1148 -985 15 296 | -1147 -987 15 297 | -1146 -989 15 298 | -1145 -993 14 299 | -1144 -996 14 300 | -1143 -1000 14 301 | -1142 -1003 15 302 | -1141 -1006 15 303 | -1140 -1009 15 304 | -1139 -1011 15 305 | -1138 -1013 15 306 | -1137 -1014 15 307 | -1136 -1014 14 308 | -1135 -1014 14 309 | -1134 -1013 15 310 | -1133 -1012 15 311 | -1132 -1010 15 312 | -1131 -1008 15 313 | -1130 -1005 15 314 | -1129 -1002 15 315 | -1128 -999 15 316 | -1127 -996 15 317 | -1126 -992 15 318 | -1125 -989 15 319 | -1124 -985 15 320 | -1123 -982 15 321 | -1122 -979 16 322 | -1121 -976 16 323 | -1120 -973 15 324 | -1119 -971 15 325 | -1118 -969 15 326 | -1117 -967 15 327 | -1116 -965 15 328 | -1115 -963 15 329 | -1114 -962 15 330 | -1113 -960 15 331 | -1112 -959 15 332 | -1111 -957 15 333 | -1110 -956 15 334 | -1109 -954 15 335 | -1108 -953 15 336 | -1107 -951 16 337 | -1106 -950 16 338 | -1105 -949 16 339 | -1104 -948 17 340 | -1103 -948 17 341 | -1102 -947 18 342 | -1101 -947 18 343 | -1100 -947 18 344 | -1099 -948 18 345 | -1098 -948 17 346 | -1097 -949 17 347 | -1096 -950 17 348 | -1095 -950 16 349 | -1094 -951 16 350 | -1093 -952 16 351 | -1092 -953 17 352 | -1091 -953 17 353 | -1090 -954 17 354 | -1089 -955 18 355 | -1088 -955 18 356 | -1087 -955 18 357 | -1086 -955 18 358 | -1085 -954 18 359 | -1084 -954 18 360 | -1083 -953 18 361 | -1082 -953 17 362 | -1081 -952 17 363 | -1080 -951 17 364 | -1079 -950 17 365 | -1078 -949 17 366 | -1077 -949 17 367 | -1076 -948 18 368 | -1075 -947 18 369 | -1074 -947 18 370 | -1073 -947 18 371 | -1072 -947 18 372 | -1071 -947 18 373 | -1070 -948 18 374 | -1069 -949 17 375 | -1068 -950 17 376 | -1067 -951 17 377 | -1066 -952 17 378 | -1065 -953 17 379 | -1064 -954 17 380 | -1063 -954 17 381 | -1062 -955 17 382 | -1061 -956 17 383 | -1060 -956 18 384 | -1059 -956 18 385 | -1058 -955 18 386 | -1057 -954 18 387 | -1056 -953 18 388 | -1055 -952 18 389 | -1054 -950 18 390 | -1053 -947 17 391 | -1052 -945 17 392 | -1051 -942 16 393 | -1050 -939 16 394 | -1049 -936 16 395 | -1048 -933 16 396 | -1047 -930 16 397 | -1046 -927 16 398 | -1045 -925 17 399 | -1044 -922 17 400 | -1043 -920 17 401 | -1042 -918 18 402 | -1041 -917 18 403 | -1040 -916 18 404 | -1039 -915 18 405 | -1038 -915 18 406 | -1037 -915 18 407 | -1036 -916 18 408 | -1035 -917 17 409 | -1034 -918 17 410 | -1033 -919 17 411 | -1032 -920 16 412 | -1031 -922 16 413 | -1030 -923 16 414 | -1029 -924 16 415 | -1028 -926 17 416 | -1027 -927 17 417 | -1026 -928 17 418 | -1025 -929 17 419 | -1024 -930 18 420 | -1023 -930 18 421 | -1022 -930 18 422 | -1021 -929 18 423 | -1020 -928 18 424 | -1019 -927 18 425 | -1018 -925 17 426 | -1017 -923 17 427 | -1016 -921 16 428 | -1015 -918 16 429 | -1014 -915 16 430 | -1013 -912 15 431 | -1012 -909 15 432 | -1011 -906 15 433 | -1010 -902 15 434 | -1009 -899 16 435 | -1008 -896 16 436 | -1007 -893 16 437 | -1006 -890 17 438 | -1005 -887 17 439 | -1004 -885 17 440 | -1003 -883 17 441 | -1002 -881 17 442 | -1001 -880 17 443 | -1000 -879 17 444 | -999 -878 17 445 | -998 -878 16 446 | -997 -877 16 447 | -996 -877 16 448 | -995 -877 16 449 | -994 -877 17 450 | -993 -877 17 451 | -992 -877 17 452 | -991 -877 18 453 | -990 -877 18 454 | -989 -877 18 455 | -988 -876 18 456 | -987 -876 18 457 | -986 -875 18 458 | -985 -875 17 459 | -984 -874 17 460 | -983 -873 16 461 | -982 -872 16 462 | -981 -871 16 463 | -980 -869 16 464 | -979 -868 16 465 | -978 -867 16 466 | -977 -866 16 467 | -976 -864 17 468 | -975 -863 17 469 | -974 -862 17 470 | -973 -860 17 471 | -972 -859 17 472 | -971 -858 17 473 | -970 -857 17 474 | -969 -856 16 475 | -968 -855 16 476 | -967 -855 16 477 | -966 -854 16 478 | -965 -853 16 479 | -964 -853 16 480 | -963 -853 17 481 | -962 -853 17 482 | -961 -853 17 483 | -960 -853 18 484 | -959 -854 18 485 | -958 -854 18 486 | -957 -855 18 487 | -956 -856 18 488 | -955 -857 18 489 | -954 -859 17 490 | -953 -860 17 491 | -952 -862 16 492 | -951 -863 16 493 | -950 -865 16 494 | -949 -866 16 495 | -948 -867 16 496 | -947 -869 16 497 | -946 -870 16 498 | -945 -871 16 499 | -944 -872 17 500 | -943 -872 17 501 | -942 -872 17 502 | -941 -872 17 503 | -940 -872 18 -------------------------------------------------------------------------------- /presentations/CAA2022_LittleMinions.md: -------------------------------------------------------------------------------- 1 | # Currycarbon 2 | 3 | **A Haskell library and command line tool for radiocarbon calibration** 4 | 5 | CAA 2022 6 | 7 | S05 - Little minions 8 | 9 | --- 10 | 11 | ## What is currycarbon 12 | 13 | - A simple radiocarbon calibration software library in and for Haskell 14 | - Intercept calibration 15 | - Sums and products of calibrated dates 16 | - Reasonably fast 17 | 18 | --- 19 | 20 | ## What is currycarbon 21 | 22 | - A simple radiocarbon calibration software library in and for Haskell 23 | - Intercept calibration 24 | - Sums and products of calibrated dates 25 | - Reasonably fast 26 | - A didactic exercise 27 | - Calibration as vector-matrix multiplication 28 | - Understanding by implementation 29 | 30 | --- 31 | 32 | ## What is currycarbon 33 | 34 | - A simple radiocarbon calibration software library in and for Haskell 35 | - Intercept calibration 36 | - Sums and products of calibrated dates 37 | - Reasonably fast 38 | - A didactic exercise 39 | - Calibration as vector-matrix multiplication 40 | - Understanding by implementation 41 | - A command line tool for your quick calibration needs 42 | 43 | ```bash 44 | currycarbon "5000,30" 45 | ``` 46 | 47 | --- 48 | 49 | ## Why yet another calibration library? 50 | 51 | 1. I wanted to understand intercept calibration 52 | 53 | --- 54 | 55 | ## Why yet another calibration library? 56 | 57 | 1. I wanted to understand intercept calibration 58 | 59 | ``` 60 | uncal date 61 | ┌─┐ 62 | │ │ - The uncalibrated date as a vector 63 | │.│ of probability densities 64 | │.│ 65 | │#│ 66 | │#│ 67 | │#│ 68 | │.│ 69 | │ │ 70 | └─┘ 71 | ``` 72 | 73 | --- 74 | 75 | ## Why yet another calibration library? 76 | 77 | 1. I wanted to understand intercept calibration 78 | 79 | ``` 80 | uncal date calibration curve 81 | ┌─┐ ┌───────────────────────────┐ 82 | │ │ │.#. │ - The uncalibrated date as a vector 83 | │.│ │ .#... │ of probability densities 84 | │.│ │ ..###.. . │ - The calibration curve as a matrix 85 | │#│ │ ..##.. .###. │ of probability densities 86 | │#│ * │ ..#...##...#. │ 87 | │#│ │ #.#. ..#.. │ 88 | │.│ │ # .###. │ 89 | │ │ │ ..##│ 90 | └─┘ └───────────────────────────┘ 91 | ``` 92 | 93 | --- 94 | 95 | ## Why yet another calibration library? 96 | 97 | 1. I wanted to understand intercept calibration 98 | 99 | ``` 100 | uncal date calibration curve 101 | ┌─┐ ┌───────────────────────────┐ 102 | │ │ │.#. │ - The uncalibrated date as a vector 103 | │.│ │ .#... │ of probability densities 104 | │.│ │ ..###.. . │ - The calibration curve as a matrix 105 | │#│ │ ..##.. .###. │ of probability densities 106 | │#│ * │ ..#...##...#. │ - Column-wise multiplication to 107 | │#│ │ #.#. ..#.. │ derive the post-calibration 108 | │.│ │ # .###. │ probability distribution 109 | │ │ │ ..##│ 110 | └─┘ └───────────────────────────┘ 111 | = 112 | ┌───────────────────────────┐ post-calibration 113 | │ *** ***** *** │ probability distribution 114 | │ **'''***'''''*'''** │ 115 | │****'''''''''''''''''''****│ 116 | └───────────────────────────┘ 117 | ``` 118 | 119 | --- 120 | 121 | ## Why yet another calibration library? 122 | 123 | 1. I wanted to understand intercept calibration 124 | 125 | ``` 126 | uncal date calibration curve 127 | ┌─┐ ┌───────────────────────────┐ 128 | │ │ │.#. │ - The uncalibrated date as a vector 129 | │.│ │ .#... │ of probability densities 130 | │.│ │ ..###.. . │ - The calibration curve as a matrix 131 | │#│ │ ..##.. .###. │ of probability densities 132 | │#│ * │ ..#...##...#. │ - Column-wise multiplication to 133 | │#│ │ #.#. ..#.. │ derive the post-calibration 134 | │.│ │ # .###. │ probability distribution 135 | │ │ │ ..##│ 136 | └─┘ └───────────────────────────┘ 137 | = 138 | ┌───────────────────────────┐ post-calibration 139 | │ *** ***** *** │ probability distribution 140 | │ **'''***'''''*'''** │ 141 | │****'''''''''''''''''''****│ 142 | └───────────────────────────┘ 143 | ``` 144 | 145 | - Martin Hinz: https://www.martinhinz.info/jekyll/update/blog/2016/06/03/simple_calibration.html 146 | - Andrew Parnell: https://github.com/andrewcparnell/Bchron 147 | 148 | --- 149 | 150 | ## Why yet another calibration library? 151 | 152 | 2. I wanted to write a Haskell library 153 | 154 | ``` 155 | .,,,,,,, ******* 156 | ,,,,,,, ******* - Haskell is a purely functional programming language 157 | ,,,,,,, ******* 158 | ,,,,,,,, ******* /////////////// - Looks and feels different from C, R, Java, ... 159 | ,,,,,,, ******* ///////////// 160 | ,,,,,,, ******* - Pure: Side effects are well contained 161 | ,,,,,,, ********** ////////// - Statically typed: Most errors are caught at compile time 162 | .,,,,,,, ************** //////// - Lazy: It evaluates only what it really must 163 | ,,,,,,, ******* ******* 164 | ,,,,,,, ,******* ******* - Well suitable for command line applications 165 | .,,,,,,, ******* ******* - We're developing tools for aDNA in it 166 | ``` 167 | 168 | --- 169 | 170 | ## Why yet another calibration library? 171 | 172 | 2. I wanted to write a Haskell library 173 | 174 | ``` 175 | .,,,,,,, ******* 176 | ,,,,,,, ******* - Haskell is a purely functional programming language 177 | ,,,,,,, ******* 178 | ,,,,,,,, ******* /////////////// - Looks and feels different from C, R, Java, ... 179 | ,,,,,,, ******* ///////////// 180 | ,,,,,,, ******* - Pure: Side effects are well contained 181 | ,,,,,,, ********** ////////// - Statically typed: Most errors are caught at compile time 182 | .,,,,,,, ************** //////// - Lazy: It evaluates only what it really must 183 | ,,,,,,, ******* ******* 184 | ,,,,,,, ,******* ******* - Well suitable for command line applications 185 | .,,,,,,, ******* ******* - We're developing tools for aDNA in it 186 | ``` 187 | 188 | I needed a calibration library in Haskell, but there was none 189 | 190 | --- 191 | 192 | ## How does it work? 193 | 194 | Simple calibration 195 | 196 | ```Haskell 197 | calibrateDate :: CalibrateDatesConf -- ^ configuration options 198 | -> CalCurveBP -- ^ calibration curve 199 | -> UncalC14 -- ^ uncalibrated date 200 | -> Either CurrycarbonException CalPDF 201 | 202 | data CalPDF = CalPDF { 203 | _calPDFid :: String -- | Identifier, e.g. a lab number 204 | , _calPDFCals :: VU.Vector YearBCAD -- | years calBC/AD 205 | , _calPDFDens :: VU.Vector Double -- | probability for each year 206 | } 207 | ``` 208 | 209 | --- 210 | 211 | ## How does it work? 212 | 213 | Simple calibration 214 | 215 | ```Haskell 216 | calibrateDate :: CalibrateDatesConf -- ^ configuration options 217 | -> CalCurveBP -- ^ calibration curve 218 | -> UncalC14 -- ^ uncalibrated date 219 | -> Either CurrycarbonException CalPDF 220 | 221 | data CalPDF = CalPDF { 222 | _calPDFid :: String -- | Identifier, e.g. a lab number 223 | , _calPDFCals :: VU.Vector YearBCAD -- | years calBC/AD 224 | , _calPDFDens :: VU.Vector Double -- | probability for each year 225 | } 226 | ``` 227 | 228 | Sum- and Product calibration 229 | 230 | ```Haskell 231 | data CalExpr = 232 | UnCalDate UncalC14 -- | uncalibrated date 233 | | CalDate CalPDF -- | calibrated date 234 | | SumCal CalExpr CalExpr -- | sum of two CalExpressions 235 | | ProductCal CalExpr CalExpr -- | product of two CalExpressions 236 | 237 | evalCalExpr :: CalibrateDatesConf -> CalCurveBP -> CalExpr -> Either CurrycarbonException CalPDF 238 | ``` 239 | 240 | --- 241 | 242 | ## How can you use it? 243 | 244 | 1. Download a statically compiled exectuable for your OS here: https://github.com/nevrome/currycarbon 245 | 2. Give it execution permission `chmod +x` 246 | 3. Have fun! 247 | 248 | ```bash 249 | wget https://github.com/nevrome/currycarbon/releases/latest/download/currycarbon-Linux -O currycarbon-Linux 250 | chmod +x currycarbon-Linux 251 | ./currycarbon-Linux "Sample1,5000,30" 252 | ``` 253 | 254 | --- 255 | 256 | ## Features: Calibrating multiple dates 257 | 258 | ```bash 259 | currycarbon "Sample1,5000,30;Sample2,3900,30;Sample3,2700,40" > results.txt 260 | tail --lines 30 results.txt 261 | ``` 262 | 263 | --- 264 | 265 | ## Features: Post-calibration probability distributions 266 | 267 | ```bash 268 | currycarbon "Sample1,5000,30;Sample2,3900,30;Sample3,2700,40" -q --densityFile results.txt 269 | head --lines 15 results.txt | column -s "," -t 270 | ``` 271 | 272 | --- 273 | 274 | ## Features: High density regions 275 | 276 | ```bash 277 | currycarbon "Sample1,5000,30;Sample2,3900,30;Sample3,2700,40" -q --hdrFile results.txt 278 | column -s "," -t results.txt 279 | ``` 280 | 281 | --- 282 | 283 | ## Features: Sum calibration 284 | 285 | ```bash 286 | currycarbon "Sample1,5000,30+Sample2,4900,30+Sample3,4800,40" 287 | ``` 288 | 289 | --- 290 | 291 | ## Features: Product calibration ("combine") 292 | 293 | ```bash 294 | currycarbon "Sample1,5000,30*Sample2,4900,30*Sample3,4800,40" 295 | ``` 296 | 297 | --- 298 | 299 | ## Conclusion 300 | 301 | - If you want to understand an algorithm, implement it 302 | - If you need calibration in your Haskell software, use currycarbon 303 | - If you want to quickly calibrate dates without opening OxCal or R, download currycarbon 304 | 305 | at https://github.com/nevrome/currycarbon 306 | -------------------------------------------------------------------------------- /src/Currycarbon/CLI/RunCalibrate.hs: -------------------------------------------------------------------------------- 1 | module Currycarbon.CLI.RunCalibrate 2 | (CalibrateOptions (..), runCalibrate) where 3 | 4 | import Currycarbon.CalCurves 5 | import Currycarbon.Calibration.Calibration 6 | import Currycarbon.Calibration.Utils 7 | import Currycarbon.Parsers 8 | import Currycarbon.SumCalibration 9 | import Currycarbon.Types 10 | import Currycarbon.Utils 11 | 12 | import Control.Exception (throwIO) 13 | import Control.Monad (unless, when) 14 | import Data.Maybe (fromJust, isJust) 15 | import System.IO (hPutStrLn, stderr) 16 | import qualified System.Random as R 17 | 18 | -- | A data type to represent the options to the CLI module function runCalibrate 19 | data CalibrateOptions = CalibrateOptions { 20 | _calibrateExprs :: [NamedCalExpr] -- ^ String listing the uncalibrated dates that should be calibrated 21 | , _calibrateExprFiles :: [FilePath] -- ^ List of files with uncalibrated dates to be calibrated 22 | , _calibrateCalCurveFile :: CalCurveSelection -- ^ Either a preloaded calibration curve or a path to a .14c file 23 | , _calibrateCalibrationMethod :: CalibrationMethod -- ^ Calibration algorithm that should be used 24 | , _calibrateAllowOutside :: Bool -- ^ Allow calibration to run outside of the range of the calibration curve 25 | , _calibrateDontInterpolateCalCurve :: Bool -- ^ Don't interpolate the calibration curve 26 | , _calibrateDontTrimCalCurve :: Bool -- ^ Don't trim the calibration curve before the calibration 27 | , _calibrateDontTrimOutCalPDF :: Bool -- ^ Don't trim the output CalPDF 28 | , _calibrateQuiet :: Bool -- ^ Suppress the printing of calibration results to the command line 29 | , _calibrateStdOutEncoding :: String -- ^ Encoding of the stdout stream (show TextEncoding) 30 | , _calibrateBasicFile :: Maybe FilePath -- ^ Path to an output file (see CLI documentation) 31 | , _calibrateDensityFile :: Maybe FilePath -- ^ Path to an output file 32 | , _calibrateHDRFile :: Maybe FilePath -- ^ Path to an output file 33 | , _calibrateAgeSampling :: Maybe (Maybe Word, Word, FilePath) -- ^ Settings for the age sampling 34 | , _calibrateCalCurveSegmentFile :: Maybe FilePath -- ^ Path to an output file 35 | , _calibrateCalCurveMatrixFile :: Maybe FilePath -- ^ Path to an output file 36 | } 37 | 38 | -- | Interface function to trigger calibration from the command line 39 | runCalibrate :: CalibrateOptions -> IO () 40 | runCalibrate ( 41 | CalibrateOptions 42 | exprs exprFiles 43 | calCurveSelection method allowOutside noInterpolate noTrimCalCurve noTrimOutCalPDF 44 | quiet encoding 45 | basicFile densityFile hdrFile 46 | ageSampling 47 | calCurveSegmentFile calCurveMatrixFile 48 | ) = do 49 | let ascii = encoding /= "UTF-8" 50 | -- compile dates 51 | exprsFromFile <- mapM readNamedCalExprsFromFile exprFiles 52 | let exprsCombined = exprs ++ concat exprsFromFile 53 | exprsRenamed = replaceEmptyNames exprsCombined 54 | if null exprsRenamed 55 | then hPutStrLn stderr "Nothing to calibrate. See currycarbon -h for help" 56 | else do 57 | -- prep data 58 | hPutStrLn stderr $ "Method: " ++ show method 59 | hPutStrLn stderr $ "Curve: " ++ show calCurveSelection 60 | calCurve <- getCalCurve calCurveSelection 61 | let calConf = defaultCalConf { 62 | _calConfAllowOutside = allowOutside 63 | , _calConfInterpolateCalCurve = not noInterpolate 64 | , _calConfTrimCalCurveBeforeCalibration = not noTrimCalCurve 65 | -- previously set to: not noTrimOutCalPDF 66 | -- but for the command line app it's better to always do this later (see below!) 67 | , _calConfTrimCalPDFAfterCalibration = False 68 | } 69 | -- handle the special debug cases 70 | when (isJust calCurveSegmentFile || isJust calCurveMatrixFile) $ do 71 | case exprsRenamed of 72 | [NamedCalExpr _ (UnCalDate uncal)] -> do 73 | let calCurveSegment = prepareCalCurveSegment (not noInterpolate) $ 74 | getRelevantCalCurveSegment uncal calCurve 75 | when (isJust calCurveSegmentFile) $ 76 | writeCalCurve (fromJust calCurveSegmentFile) calCurveSegment 77 | when (isJust calCurveMatrixFile) $ 78 | writeCalCurveMatrix (fromJust calCurveMatrixFile) $ 79 | makeCalCurveMatrix (uncalToPDF uncal) calCurveSegment 80 | _ -> do 81 | throwIO $ CurrycarbonCLIException 82 | "--calCurveSegFile and --calCurveMatFile only work with \ 83 | \a single uncalibrated radiocarbon date." 84 | -- run calibration 85 | hPutStrLn stderr "Calibrating..." 86 | let errorOrCalPDFs = map (evalNamedCalExpr method calConf calCurve) exprsRenamed 87 | -- trim output 88 | calRes = if not noTrimOutCalPDF 89 | then map (mapEither id trimLowDensityEdgesCalPDF) errorOrCalPDFs 90 | else errorOrCalPDFs 91 | -- prepare random number generator for age sampling 92 | maybeRNG <- case ageSampling of 93 | Nothing -> pure Nothing 94 | Just (maybeSeed, _, _) -> case maybeSeed of 95 | Nothing -> Just <$> R.initStdGen 96 | Just seed -> return $ Just $ R.mkStdGen (fromIntegral seed) 97 | -- prepare and write the output per expression 98 | handleExprs ascii True calCurve maybeRNG $ zip exprsRenamed calRes 99 | where 100 | 101 | -- loop over first and subsequent expressions 102 | handleExprs :: 103 | Bool -- encoding 104 | -> Bool -- is this expression the first in the list of expressions? 105 | -> CalCurveBP 106 | -> Maybe R.StdGen -- rng for the age sampling seeds 107 | -> [(NamedCalExpr, Either CurrycarbonException CalPDF)] 108 | -> IO () 109 | handleExprs _ _ _ _ [] = hPutStrLn stderr "Done." 110 | -- first expression 111 | handleExprs _ascii True calCurve maybeRNG (firstDate:otherDates) = 112 | case firstDate of 113 | (_, Left e) -> do 114 | printE e 115 | handleExprs _ascii True calCurve maybeRNG otherDates 116 | (namedCalExpr, Right cPDF) -> do 117 | let (sampleSeed, newRNG) = drawSeed maybeRNG 118 | flexOut _ascii namedCalExpr cPDF sampleSeed writeCalPDF writeCalC14CalRangeSummary writeCalC14HDR writeRandomAgeSample 119 | handleExprs _ascii False calCurve newRNG otherDates 120 | -- subsequent expression 121 | handleExprs _ascii False calCurve maybeRNG (nextDate:otherDates) = 122 | case nextDate of 123 | (_, Left e) -> do 124 | printE e 125 | handleExprs _ascii False calCurve maybeRNG otherDates 126 | (namedCalExpr, Right cPDF) -> do 127 | let (sampleSeed, newRNG) = drawSeed maybeRNG 128 | flexOut _ascii namedCalExpr cPDF sampleSeed appendCalPDF appendCalC14CalRangeSummary appendCalC14HDR appendRandomAgeSample 129 | handleExprs _ascii False calCurve newRNG otherDates 130 | 131 | printE :: CurrycarbonException -> IO () 132 | printE e = hPutStrLn stderr $ renderCurrycarbonException e 133 | 134 | drawSeed :: Maybe R.StdGen -> (Maybe Int, Maybe R.StdGen) 135 | drawSeed maybeRNG = (\x -> (fromIntegral . fst <$> x, snd <$> x)) (R.genWord32 <$> maybeRNG) 136 | 137 | -- flexible expression handler 138 | flexOut :: 139 | Bool 140 | -> NamedCalExpr 141 | -> CalPDF 142 | -> Maybe Int 143 | -> (FilePath -> CalPDF -> IO ()) 144 | -> (FilePath -> CalC14 -> IO ()) 145 | -> (FilePath -> CalC14 -> IO ()) 146 | -> (FilePath -> RandomAgeSample -> IO ()) 147 | -> IO () 148 | flexOut _ascii namedCalExpr calPDF maybeSeed calPDFToFile calC14CalRangeSummaryToFile calC14HDRToFile randomAgeSampleToFile = do 149 | case refineCalDate calPDF of 150 | Left e -> do 151 | unless quiet $ do 152 | putStrLn ("CalEXPR: " ++ renderNamedCalExpr namedCalExpr) 153 | printE e 154 | when (isJust basicFile) $ unless quiet $ 155 | hPutStrLn stderr " Error: Can not create --basicFile" 156 | when (isJust hdrFile) $ unless quiet $ 157 | hPutStrLn stderr " Error: Can not create --hdrFile" 158 | Right calC14 -> do 159 | unless quiet $ do 160 | putStrLn (renderCalDatePretty _ascii (namedCalExpr, calPDF, calC14)) 161 | when (isJust basicFile) $ 162 | calC14CalRangeSummaryToFile (fromJust basicFile) calC14 163 | when (isJust hdrFile) $ 164 | calC14HDRToFile (fromJust hdrFile) calC14 165 | when (isJust ageSampling && isJust maybeSeed) $ do 166 | let (_, nrOfSamples, path) = fromJust ageSampling 167 | rng = R.mkStdGen (fromJust maybeSeed) 168 | conf = AgeSamplingConf rng nrOfSamples 169 | case sampleAgesFromCalPDF conf calPDF of 170 | Left e -> do 171 | unless quiet $ do 172 | printE e 173 | hPutStrLn stderr " Error: Can not create --samplesFile" 174 | Right res -> randomAgeSampleToFile path res 175 | when (isJust densityFile) $ 176 | calPDFToFile (fromJust densityFile) calPDF 177 | 178 | -- | Helper function to replace empty input names with a sequence of numbers, 179 | -- to get each input date an unique identifier 180 | replaceEmptyNames :: [NamedCalExpr] -> [NamedCalExpr] 181 | replaceEmptyNames = zipWith (modifyNamedExpr . show) ([1..] :: [Integer]) 182 | where 183 | modifyNamedExpr :: String -> NamedCalExpr -> NamedCalExpr 184 | modifyNamedExpr i nexpr = 185 | if _exprID nexpr == "" 186 | then nexpr { _exprID = i, _expr = replaceName i (_expr nexpr) } 187 | else nexpr { _expr = replaceName i (_expr nexpr) } 188 | replaceName :: String -> CalExpr -> CalExpr 189 | replaceName i (UnCalDate (UncalC14 name x y)) = 190 | if name == "" 191 | then UnCalDate $ UncalC14 i x y 192 | else UnCalDate $ UncalC14 name x y 193 | replaceName i (WindowBP (TimeWindowBP name start stop)) = 194 | if name == "" 195 | then WindowBP $ TimeWindowBP i start stop 196 | else WindowBP $ TimeWindowBP name start stop 197 | replaceName i (WindowBCAD (TimeWindowBCAD name start stop)) = 198 | if name == "" 199 | then WindowBCAD $ TimeWindowBCAD i start stop 200 | else WindowBCAD $ TimeWindowBCAD name start stop 201 | replaceName i (CalDate (CalPDF name x y)) = 202 | if name == "" 203 | then CalDate $ CalPDF i x y 204 | else CalDate $ CalPDF name x y 205 | replaceName i (SumCal a b) = SumCal (replaceName (i ++ "s") a) (replaceName (i ++ "S") b) 206 | replaceName i (ProductCal a b) = ProductCal (replaceName (i ++ "p") a) (replaceName (i ++ "P") b) 207 | -------------------------------------------------------------------------------- /src-executables/Main-currycarbon.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Currycarbon.CalCurves 4 | import Currycarbon.CLI.RunCalibrate (CalibrateOptions (..), 5 | runCalibrate) 6 | import Currycarbon.Parsers 7 | import Currycarbon.Types 8 | import Currycarbon.Utils 9 | import Paths_currycarbon (version) 10 | 11 | import Control.Exception (catch) 12 | import Data.Version (showVersion) 13 | import qualified Options.Applicative as OP 14 | import qualified Options.Applicative.Help as OH 15 | import System.Exit (exitFailure) 16 | import System.IO (hGetEncoding, hPutStrLn, stderr, 17 | stdout) 18 | -- * CLI interface configuration 19 | -- 20 | -- $cliInterface 21 | -- 22 | -- This module contains the necessary code to configure the currycarbon CLI interface 23 | 24 | -- data types 25 | data Options = CmdCalibrate CalibrateOptions 26 | 27 | -- CLI interface configuration 28 | main :: IO () 29 | main = do 30 | -- check stdout encoding for the CLI plot 31 | stdOutEncoding <- hGetEncoding stdout 32 | let encoding = maybe "unknown" show stdOutEncoding 33 | hPutStrLn stderr $ "currycarbon v" ++ showVersion version ++ " (" ++ encoding ++ ")" 34 | -- prepare input parsing 35 | cmdOpts <- OP.customExecParser p optParserInfo 36 | catch (runCmd encoding cmdOpts) handler 37 | where 38 | p = OP.prefs OP.showHelpOnEmpty 39 | handler :: CurrycarbonException -> IO () 40 | handler e = do 41 | hPutStrLn stderr $ renderCurrycarbonException e 42 | exitFailure 43 | 44 | runCmd :: String -> Options -> IO () 45 | runCmd enc o = case o of 46 | CmdCalibrate opts -> runCalibrate opts {_calibrateStdOutEncoding = enc} 47 | 48 | optParserInfo :: OP.ParserInfo Options 49 | optParserInfo = OP.info (OP.helper <*> versionOption <*> optParser) ( 50 | OP.progDesc "currycarbon calibrates radiocarbon dates" 51 | ) 52 | 53 | versionOption :: OP.Parser (a -> a) 54 | versionOption = OP.infoOption (showVersion version) (OP.long "version" <> OP.help "Show version") 55 | 56 | optParser :: OP.Parser Options 57 | optParser = CmdCalibrate <$> calibrateOptParser 58 | 59 | calibrateOptParser :: OP.Parser CalibrateOptions 60 | calibrateOptParser = CalibrateOptions <$> optParseNamedCalExprString 61 | <*> optParseNamedCalExprFromFile 62 | <*> optParseCalCurveSelection 63 | <*> optParseCalibrationMethod 64 | <*> optParseAllowOutside 65 | <*> optParseDontInterpolateCalCurve 66 | <*> optParseDontTrimCalCurve 67 | <*> optParseDontTrimOutCalPDF 68 | <*> optParseQuiet 69 | <*> pure "unknown" 70 | <*> optParseBasicFile 71 | <*> optParseDensityFile 72 | <*> optParseHDRFile 73 | <*> optParseAgeSamplingSettings 74 | <*> optParseCalCurveSegmentFile 75 | <*> optParseCalCurveMatrixFile 76 | 77 | -- ** Input parsing functions 78 | -- 79 | -- $inputParsing 80 | -- 81 | -- These functions define and handle the CLI input arguments 82 | 83 | optParseNamedCalExprString :: OP.Parser [NamedCalExpr] 84 | optParseNamedCalExprString = concat <$> OP.many (OP.argument (OP.eitherReader readNamedCalExprs) ( 85 | OP.metavar "CalEXPRs" <> 86 | OP.helpDoc ( Just ( 87 | "---" 88 | <> OH.hardline 89 | <> s2d "A string to specify \"calibration expressions\", so small chronological \ 90 | \models for individual events. These can include uncalibrated radiocarbon ages, \ 91 | \uniform age ranges and operations to combine the resulting age probability \ 92 | \distribution as sums or products." 93 | <> OH.hardline <> 94 | s2d "The expression language includes the following functions:" 95 | <> OH.hardline 96 | <> OH.hardline <> "- calExpr(id = STRING, expr = EXPR)" 97 | <> OH.hardline <> "- uncalC14(id = STRING, yearBP = INT, sigma = INT)" 98 | <> OH.hardline <> "- rangeBP(id = STRING, start = INT, stop = INT)" 99 | <> OH.hardline <> "- rangeBCAD(id = STRING, start = INT, stop = INT)" 100 | <> OH.hardline <> "- sum(a = EXPR, b = EXPR)" 101 | <> OH.hardline <> "- product(a = EXPR, b = EXPR)" 102 | <> OH.hardline 103 | <> OH.hardline 104 | <> s2d "The order of arguments is fixed, but the argument names ' =' \ 105 | \can be left out. The 'id' arguments are optional. \ 106 | \Some functions can be shortened with syntactic sugar:" 107 | <> OH.hardline 108 | <> OH.hardline <> "- calExpr(STRING, EXPR) -> id: EXPR" 109 | <> OH.hardline <> "- uncalC14(STRING, INT, INT) -> STRING,INT,INT" 110 | <> OH.hardline <> "- sum(EXPR, EXPR) -> EXPR + EXPR" 111 | <> OH.hardline <> "- product(EXPR, EXPR) -> EXPR * EXPR" 112 | <> OH.hardline 113 | <> OH.hardline 114 | <> s2d "Parentheses '()' can be used to specify the evaluation order within \ 115 | \an expression. Multiple expressions can be chained, separated by ';'." 116 | <> OH.hardline 117 | <> OH.hardline 118 | <> "Examples:" 119 | <> OH.hardline <> s2d "1. Calibrate a single radiocarbon date with a mean age BP \ 120 | \and a one sigma standard deviation:" 121 | <> OH.hardline <> "\"3000,30\" or \"uncalC14(yearBP = 3000, sigma = 30)\"" 122 | <> OH.hardline <> s2d "2. Calibrate two radiocarbon dates and sum them:" 123 | <> OH.hardline <> "\"(3000,30) + (3100,40)\" or" 124 | <> OH.hardline <> "\"sum(uncalC14(3000,30), uncalC14(3100,40))\"" 125 | <> OH.hardline <> s2d "3. Compile a complex, named expression:" 126 | <> OH.hardline <> "\"Ex3: ((3000,30) + (3100,40)) * rangeBP(3200,3000)\"" 127 | <> OH.hardline 128 | <> "---" 129 | )) 130 | )) 131 | 132 | s2d :: String -> OH.Doc 133 | s2d str = OH.fillSep $ map OH.pretty $ words str 134 | 135 | optParseNamedCalExprFromFile :: OP.Parser [FilePath] 136 | optParseNamedCalExprFromFile = OP.many (OP.strOption ( 137 | OP.long "inputFile" <> 138 | OP.short 'i' <> 139 | OP.metavar "FILE" <> 140 | OP.help "A file with a list of calibration expressions. \ 141 | \Formatted just as CalEXPRs, but with a new line for each input expression. \ 142 | \CalEXPRs and --inputFile can be combined and you can provide multiple \ 143 | \instances of --inputFile. \ 144 | \Note that syntactic sugar allows to read simple radiocarbon dates from \ 145 | \a headless .csv file with one sample per row: \ 146 | \,,." 147 | )) 148 | 149 | optParseCalCurveSelection :: OP.Parser CalCurveSelection 150 | optParseCalCurveSelection = OP.option (OP.eitherReader readCalCurveSelection) ( 151 | OP.long "calCurve" <> 152 | OP.metavar "IntCal20 | SHCal20 | Marine20 | FILE" <> 153 | OP.help "Either one of the included calibration curves, or a \ 154 | \file path to an calibration curve file in '.14c' format. \ 155 | \The calibration curve will be read and used for calibration." <> 156 | OP.value IntCal20 <> 157 | OP.showDefault 158 | ) 159 | 160 | optParseCalibrationMethod :: OP.Parser CalibrationMethod 161 | optParseCalibrationMethod = OP.option (OP.eitherReader readCalibrationMethod) ( 162 | OP.long "method" <> 163 | OP.metavar "DSL" <> 164 | OP.helpDoc ( Just ( 165 | s2d "The calibration algorithm that should be used: \ 166 | \',,'. " 167 | <> OH.hardline <> 168 | s2d "The default setting is equivalent to \"Bchron,StudentT,100\" \ 169 | \which copies the algorithm implemented in the Bchron R package. \ 170 | \For the Bchron algorithm with a normal distribution (\"Bchron,Normal\") \ 171 | \the degrees of freedom argument is not relevant" 172 | <> OH.hardline <> 173 | s2d "Alternatively we implemented \"MatrixMult\", which comes without further \ 174 | \arguments." 175 | )) <> 176 | OP.value (Bchron $ StudentTDist 100) 177 | ) 178 | 179 | optParseAllowOutside :: OP.Parser Bool 180 | optParseAllowOutside = OP.switch ( 181 | OP.long "allowOutside" <> 182 | OP.help "Allow calibrations to run outside the range of the calibration curve." 183 | ) 184 | 185 | optParseDontInterpolateCalCurve :: OP.Parser Bool 186 | optParseDontInterpolateCalCurve = OP.switch ( 187 | OP.long "noInterpolation" <> 188 | OP.help "Do not interpolate the calibration curve." 189 | ) 190 | 191 | optParseDontTrimCalCurve :: OP.Parser Bool 192 | optParseDontTrimCalCurve = OP.switch ( 193 | OP.long "noTrimCalCurve" <> 194 | OP.help "Do not trim the calibration curve before the calibration. \ 195 | \If a probability distribution over the entire range \ 196 | \of the calibration curve is needed. See also --noTrimOutCalPDF." 197 | ) 198 | 199 | optParseDontTrimOutCalPDF :: OP.Parser Bool 200 | optParseDontTrimOutCalPDF = OP.switch ( 201 | OP.long "noTrimOutCalPDF" <> 202 | OP.help "Do not trim the output CalPDF. \ 203 | \If an untrimmed probability distribution is needed. \ 204 | \See also --noTrimCalCurve." 205 | ) 206 | 207 | optParseQuiet :: OP.Parser Bool 208 | optParseQuiet = OP.switch ( 209 | OP.long "quiet" <> 210 | OP.short 'q' <> 211 | OP.help "Suppress the printing of calibration results to the command line." 212 | ) 213 | 214 | optParseBasicFile :: OP.Parser (Maybe FilePath) 215 | optParseBasicFile = OP.option (Just <$> OP.str) ( 216 | OP.long "basicFile" <> 217 | OP.metavar "FILE" <> 218 | OP.help "Path to an output file to store basic, per-expression output: \ 219 | \The minimum start and maximum end of \ 220 | \the high probability density regions and the median age." <> 221 | OP.value Nothing 222 | ) 223 | 224 | optParseDensityFile :: OP.Parser (Maybe FilePath) 225 | optParseDensityFile = OP.option (Just <$> OP.str) ( 226 | OP.long "densityFile" <> 227 | OP.metavar "FILE" <> 228 | OP.help "Path to an output file to store output densities per CalEXPR and calender \ 229 | \year." <> 230 | OP.value Nothing 231 | ) 232 | 233 | optParseHDRFile :: OP.Parser (Maybe FilePath) 234 | optParseHDRFile = OP.option (Just <$> OP.str) ( 235 | OP.long "hdrFile" <> 236 | OP.metavar "FILE" <> 237 | OP.help "Path to an output file to store the high probability density regions for each \ 238 | \CalEXPR." <> 239 | OP.value Nothing 240 | ) 241 | 242 | optParseAgeSamplingSettings :: OP.Parser (Maybe (Maybe Word, Word, FilePath)) 243 | optParseAgeSamplingSettings = 244 | OP.optional $ (,,) <$> 245 | optParseAgeSamplingConfSeed 246 | <*> optParseAgeSamplingConfNrOfSamples 247 | <*> optParseAgeSamplingFile 248 | 249 | optParseAgeSamplingConfSeed :: OP.Parser (Maybe Word) 250 | optParseAgeSamplingConfSeed = OP.option (Just <$> OP.auto) ( 251 | OP.long "seed" 252 | <> OP.metavar "INT" 253 | <> OP.help "Seed for the random number generator for age sampling. \ 254 | \The default causes currycarbon to fall back to a random seed." 255 | <> OP.value Nothing 256 | <> OP.showDefault 257 | ) 258 | 259 | optParseAgeSamplingConfNrOfSamples :: OP.Parser Word 260 | optParseAgeSamplingConfNrOfSamples = OP.option OP.auto ( 261 | OP.short 'n' 262 | <> OP.long "nrSamples" 263 | <> OP.metavar "INT" 264 | <> OP.help "Number of age samples to draw per CalEXPR." 265 | ) 266 | 267 | optParseAgeSamplingFile :: OP.Parser FilePath 268 | optParseAgeSamplingFile = OP.strOption ( 269 | OP.long "samplesFile" <> 270 | OP.metavar "FILE" <> 271 | OP.help "Path to an output file to store age samples for each CalEXPR." 272 | ) 273 | 274 | optParseCalCurveSegmentFile :: OP.Parser (Maybe FilePath) 275 | optParseCalCurveSegmentFile = OP.option (Just <$> OP.str) ( 276 | OP.long "calCurveSegFile" <> 277 | OP.metavar "FILE" <> 278 | OP.help "Path to an output file to store the relevant, interpolated calibration curve \ 279 | \segment for the first (!) input date. \ 280 | \This option as well as --calCurveMatFile are meant for debugging." <> 281 | OP.value Nothing 282 | ) 283 | 284 | optParseCalCurveMatrixFile :: OP.Parser (Maybe FilePath) 285 | optParseCalCurveMatrixFile = OP.option (Just <$> OP.str) ( 286 | OP.long "calCurveMatFile" <> 287 | OP.metavar "FILE" <> 288 | OP.help "Path to an output file which stores the relevant, interpolated calibration curve \ 289 | \segment for the first (!) input date in a wide matrix format." <> 290 | OP.value Nothing 291 | ) 292 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![GitHub Workflow Status](https://github.com/nevrome/currycarbon/actions/workflows/normalCheck.yml/badge.svg)](https://github.com/nevrome/currycarbon/actions/workflows/normalCheck.yml) 2 | [![Coverage Status](https://img.shields.io/codecov/c/github/nevrome/currycarbon/master.svg)](https://codecov.io/github/nevrome/currycarbon?branch=master) 3 | [![GitHub release (latest by date including pre-releases)](https://img.shields.io/github/v/release/nevrome/currycarbon?include_prereleases) 4 | ![GitHub all releases](https://img.shields.io/github/downloads/nevrome/currycarbon/total)](https://github.com/nevrome/currycarbon/releases) 5 | 6 | # currycarbon 7 | 8 | Radiocarbon calibration module written in and for [Haskell](https://www.haskell.org). Comes with a small CLI app to run calibration on the command line. 9 | 10 | ### Library 11 | 12 | The Haskell library is available on Hackage [here](https://hackage.haskell.org/package/currycarbon) and on Stackage [here](https://www.stackage.org/package/currycarbon). 13 | 14 | ### CLI app 15 | 16 | For stable release versions we automatically prepare statically built binaries that can be downloaded and run directly. 17 | 18 | - [📥 Linux](https://github.com/nevrome/currycarbon/releases/latest/download/currycarbon-Linux) 19 | - [📥 macOS (ARM64)](https://github.com/nevrome/currycarbon/releases/latest/download/currycarbon-macOS-ARM64) 20 | - [📥 macOS (X64)](https://github.com/nevrome/currycarbon/releases/latest/download/currycarbon-macOS-X64) 21 | - [📥 Windows](https://github.com/nevrome/currycarbon/releases/latest/download/currycarbon-Windows.exe) 22 | 23 | So in Linux you can run the following commands to get started: 24 | 25 | ```bash 26 | # download the current stable release binary 27 | wget https://github.com/nevrome/currycarbon/releases/latest/download/currycarbon-Linux 28 | # make it executable 29 | chmod +x currycarbon-Linux 30 | # test it 31 | ./currycarbon-Linux "Sample1,4990,30" 32 | ``` 33 | 34 | ``` 35 | currycarbon v0.4.0.2 (UTF-8) 36 | Method: Bchron {distribution = StudentTDist {ndf = 100.0}} 37 | Curve: IntCal20 38 | Calibrating... 39 | CalEXPR: [1] Sample1:4990±30BP 40 | Calibrated: 3936BC >> 3794BC > 3757BC < 3662BC << 3654BC 41 | 1-sigma: 3794-3707BC, 3666-3662BC 42 | 2-sigma: 3936-3874BC, 3804-3697BC, 3684-3654BC 43 | 44 | BP 45 | 5120 ┤ ┆ 46 | │ ┆┆ ┆┆┆┆┆┆┆┆┆┆ 47 | │ ┆┆┆┆┆┆┆ ┆ ┆┆ 48 | │ ┄┄┄┄┄┄┄┄┄┄┆┆┆┄┄┄┄┄┄┄┄┄┄┄┄┄┆┆┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄ 49 | 4990 ┤ ┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┆┆┆┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅┅ 50 | │ ┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄┆┆┆┆┆┆┆┆┆┆┄┄┄┄┄┄┄┆┄┄┄ 51 | │ ┆┆ ┆┆┆ ┆ 52 | │ ┆┆ ┆ 53 | 4870 ┤ ┆ 54 | ▁▁▁ ▁▁▁▁ 55 | ▁▁▒▒▒▁▁▁▁▒▒▒▒▁ 56 | ▒▒▒▒▒▒▒▒▒▒▒▒▒▒ ▁ 57 | ▁▁ ▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁ ▁▒ 58 | ▁▁▒▒▁ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ ▁▒▒▁ 59 | ▁▁▁▁▁▒▒▒▒▒▁ ▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▁▁▒▒▒▒▁ 60 | ▁▁▁▒▒▒▒▒▒▒▒▒▒▒▁▁▁▁▁▁▁▁▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁ 61 | -3950 ┄─────────┬───────────────┬────────────────┬─────────┄ -3640 62 | BC > > ^ < < BC 63 | ──────────────── ─ 64 | ─────────── ────────────────── ────── 65 | Done. 66 | ``` 67 | 68 | ``` 69 | Usage: currycarbon [--version] [CalEXPRs] [-i|--inputFile FILE] 70 | [--calCurve IntCal20 | SHCal20 | Marine20 | FILE] 71 | [--method DSL] [--allowOutside] [--noInterpolation] 72 | [--noTrimCalCurve] [--noTrimOutCalPDF] [-q|--quiet] 73 | [--basicFile FILE] [--densityFile FILE] [--hdrFile FILE] 74 | [[--seed INT] (-n|--nrSamples INT) --samplesFile FILE] 75 | [--calCurveSegFile FILE] [--calCurveMatFile FILE] 76 | 77 | currycarbon calibrates radiocarbon dates 78 | 79 | Available options: 80 | -h,--help Show this help text 81 | --version Show version 82 | CalEXPRs --- 83 | A string to specify "calibration expressions", so 84 | small chronological models for individual events. 85 | These can include uncalibrated radiocarbon ages, 86 | uniform age ranges and operations to combine the 87 | resulting age probability distribution as sums or 88 | products. 89 | The expression language includes the following 90 | functions: 91 | 92 | - calExpr(id = STRING, expr = EXPR) 93 | - uncalC14(id = STRING, yearBP = INT, sigma = INT) 94 | - rangeBP(id = STRING, start = INT, stop = INT) 95 | - rangeBCAD(id = STRING, start = INT, stop = INT) 96 | - sum(a = EXPR, b = EXPR) 97 | - product(a = EXPR, b = EXPR) 98 | 99 | The order of arguments is fixed, but the argument 100 | names ' =' can be left out. The 'id' arguments 101 | are optional. Some functions can be shortened with 102 | syntactic sugar: 103 | 104 | - calExpr(STRING, EXPR) -> id: EXPR 105 | - uncalC14(STRING, INT, INT) -> STRING,INT,INT 106 | - sum(EXPR, EXPR) -> EXPR + EXPR 107 | - product(EXPR, EXPR) -> EXPR * EXPR 108 | 109 | Parentheses '()' can be used to specify the 110 | evaluation order within an expression. Multiple 111 | expressions can be chained, separated by ';'. 112 | 113 | Examples: 114 | 1. Calibrate a single radiocarbon date with a mean 115 | age BP and a one sigma standard deviation: 116 | "3000,30" or "uncalC14(yearBP = 3000, sigma = 30)" 117 | 2. Calibrate two radiocarbon dates and sum them: 118 | "(3000,30) + (3100,40)" or 119 | "sum(uncalC14(3000,30), uncalC14(3100,40))" 120 | 3. Compile a complex, named expression: 121 | "Ex3: ((3000,30) + (3100,40)) * rangeBP(3200,3000)" 122 | --- 123 | -i,--inputFile FILE A file with a list of calibration expressions. 124 | Formatted just as CalEXPRs, but with a new line for 125 | each input expression. CalEXPRs and --inputFile can 126 | be combined and you can provide multiple instances of 127 | --inputFile. Note that syntactic sugar allows to read 128 | simple radiocarbon dates from a headless .csv file 129 | with one sample per row: ,,. 131 | --calCurve IntCal20 | SHCal20 | Marine20 | FILE 132 | Either one of the included calibration curves, or a 133 | file path to an calibration curve file in '.14c' 134 | format. The calibration curve will be read and used 135 | for calibration. (default: IntCal20) 136 | --method DSL The calibration algorithm that should be used: 137 | ',,'. 138 | The default setting is equivalent to 139 | "Bchron,StudentT,100" which copies the algorithm 140 | implemented in the Bchron R package. For the Bchron 141 | algorithm with a normal distribution 142 | ("Bchron,Normal") the degrees of freedom argument is 143 | not relevant 144 | Alternatively we implemented "MatrixMult", which 145 | comes without further arguments. 146 | --allowOutside Allow calibrations to run outside the range of the 147 | calibration curve. 148 | --noInterpolation Do not interpolate the calibration curve. 149 | --noTrimCalCurve Do not trim the calibration curve before the 150 | calibration. If a probability distribution over the 151 | entire range of the calibration curve is needed. See 152 | also --noTrimOutCalPDF. 153 | --noTrimOutCalPDF Do not trim the output CalPDF. If an untrimmed 154 | probability distribution is needed. See also 155 | --noTrimCalCurve. 156 | -q,--quiet Suppress the printing of calibration results to the 157 | command line. 158 | --basicFile FILE Path to an output file to store basic, per-expression 159 | output: The minimum start and maximum end of the high 160 | probability density regions and the median age. 161 | --densityFile FILE Path to an output file to store output densities per 162 | CalEXPR and calender year. 163 | --hdrFile FILE Path to an output file to store the high probability 164 | density regions for each CalEXPR. 165 | --seed INT Seed for the random number generator for age 166 | sampling. The default causes currycarbon to fall back 167 | to a random seed. (default: Nothing) 168 | -n,--nrSamples INT Number of age samples to draw per CalEXPR. 169 | --samplesFile FILE Path to an output file to store age samples for each 170 | CalEXPR. 171 | --calCurveSegFile FILE Path to an output file to store the relevant, 172 | interpolated calibration curve segment for the first 173 | (!) input date. This option as well as 174 | --calCurveMatFile are meant for debugging. 175 | --calCurveMatFile FILE Path to an output file which stores the relevant, 176 | interpolated calibration curve segment for the first 177 | (!) input date in a wide matrix format. 178 | ``` 179 | 180 | ### For developers who want to edit the code 181 | 182 | To install the latest development version you can follow these steps: 183 | 184 | 1. Install the Haskell build tool [Stack](https://docs.haskellstack.org/en/stable/README/) 185 | 2. Clone the repository 186 | 3. Execute `stack install` inside the repository to build the tool and automatically copy the executables to `~/.local/bin` (which you may want to add to your path). This will install the compiler and all dependencies into folders that won't interfere with any installation you might already have. 187 | 188 | #### Running the golden tests 189 | 190 | Because the golden tests can not run on stackage as they are set up now (see the discussion [here](https://github.com/nevrome/currycarbon/issues/17)) I hid them behind an environment variable. You can run them with 191 | 192 | ```bash 193 | CURRY_RUN_GOLDEN=true stack test --pedantic 194 | ``` 195 | 196 | Just calling `stack test --pedantic` without this variable will skip any test with the pattern `"Golden"` in their descriptors. 197 | 198 | #### Upload to Hackage 199 | 200 | See the documentation here: 201 | - https://hackage.haskell.org/upload 202 | - https://docs.haskellstack.org/en/stable/commands/upload_command 203 | 204 | `stack` allows to upload a release candidate with 205 | 206 | ``` 207 | stack upload . --test-tarball --candidate --no-save-hackage-creds 208 | ``` 209 | 210 | using my Hackage credentials. It can then be published at https://hackage.haskell.org/package/currycarbon/candidates 211 | 212 | The building of the haddock documentation can be tested with 213 | 214 | ``` 215 | stack haddock --haddock-for-hackage 216 | ``` 217 | 218 | #### Preparing a new stable release 219 | 220 | The Github Actions script in `.github/workflows/release.yml` registers a new draft release and automatically builds and uploads currycarbon binaries when a new Git tag with the prefix `v*` is pushed. 221 | 222 | ```bash 223 | # locally register a new tag (e.g. 0.3.1) 224 | git tag -a v0.3.1 -m "see CHANGELOG.md" 225 | # push tag 226 | git push origin v0.3.1 227 | ``` 228 | 229 | In case of a failing build delete the tag and the release draft on Github and then delete the tag locally with 230 | 231 | ```bash 232 | git tag -d v0.3.1 233 | ``` 234 | 235 | before rerunning the procedure above. 236 | 237 | #### Profiling 238 | 239 | ``` 240 | stack build --profile 241 | stack exec --profile -- currycarbon "1000,200;2000,200;3000,200;4000,200;5000,200;6000,200;7000,200;8000,200" -q --densityFile /dev/null +RTS -p 242 | stack exec -- currycarbon "1000,200;2000,200;3000,200;4000,200;5000,200;6000,200;7000,200;8000,200" -q --densityFile /dev/null +RTS -s 243 | ``` 244 | -------------------------------------------------------------------------------- /test/golden/actual_data/density_file.tsv: -------------------------------------------------------------------------------- 1 | id yearBCAD density 2 | 1 -1414 1.2484277307163715e-5 3 | 1 -1413 1.5096420631606685e-5 4 | 1 -1412 1.998803764083492e-5 5 | 1 -1411 2.4030892330116914e-5 6 | 1 -1410 3.1538598474982654e-5 7 | 1 -1409 4.366221509645768e-5 8 | 1 -1408 5.181932205051161e-5 9 | 1 -1407 6.135226448948473e-5 10 | 1 -1406 7.246211306416831e-5 11 | 1 -1405 8.537321039537996e-5 12 | 1 -1404 9.258108031984863e-5 13 | 1 -1403 1.086693761571088e-4 14 | 1 -1402 1.0426396490711256e-4 15 | 1 -1401 1.1302146631796101e-4 16 | 1 -1400 1.2243467595778366e-4 17 | 1 -1399 1.1829017131799134e-4 18 | 1 -1398 1.2823854608963312e-4 19 | 1 -1397 1.3892963275606956e-4 20 | 1 -1396 1.5040978122647387e-4 21 | 1 -1395 1.8085221842514774e-4 22 | 1 -1394 1.9513635454604887e-4 23 | 1 -1393 2.2671807319720778e-4 24 | 1 -1392 2.6926749633678055e-4 25 | 1 -1391 2.8917897608255497e-4 26 | 1 -1390 3.328553286029605e-4 27 | 1 -1389 3.567458756653848e-4 28 | 1 -1388 3.750698384192567e-4 29 | 1 -1387 4.303768082286073e-4 30 | 1 -1386 4.924405994482622e-4 31 | 1 -1385 5.61845361356958e-4 32 | 1 -1384 6.391864309074129e-4 33 | 1 -1383 7.250635883106889e-4 34 | 1 -1382 8.200731952273836e-4 35 | 1 -1381 9.839340593674967e-4 36 | 1 -1380 1.1661434275192647e-3 37 | 1 -1379 1.3733857829327752e-3 38 | 1 -1378 1.5233569814230622e-3 39 | 1 -1377 1.6848285873788055e-3 40 | 1 -1376 1.8580052862051423e-3 41 | 1 -1375 2.0429974931165545e-3 42 | 1 -1374 2.239809381540531e-3 43 | 1 -1373 2.4483273816610215e-3 44 | 1 -1372 2.577845523255269e-3 45 | 1 -1371 2.8079603190694397e-3 46 | 1 -1370 2.9272191808455594e-3 47 | 1 -1369 3.084303895635148e-3 48 | 1 -1368 3.2114583848607227e-3 49 | 1 -1367 3.430371134532966e-3 50 | 1 -1366 3.5621789542802937e-3 51 | 1 -1365 3.6961540010936834e-3 52 | 1 -1364 3.921621611069951e-3 53 | 1 -1363 3.921621611069951e-3 54 | 1 -1362 3.921621611069951e-3 55 | 1 -1361 3.921621611069951e-3 56 | 1 -1360 3.921621611069951e-3 57 | 1 -1359 3.7863936818896392e-3 58 | 1 -1358 3.5621789542802937e-3 59 | 1 -1357 3.430371134532966e-3 60 | 1 -1356 3.2114583848607227e-3 61 | 1 -1355 3.084303895635148e-3 62 | 1 -1354 2.751865868717371e-3 63 | 1 -1353 2.633444780113943e-3 64 | 1 -1352 2.40578945736931e-3 65 | 1 -1351 2.1907027626884247e-3 66 | 1 -1350 2.0879544204108263e-3 67 | 1 -1349 1.8921278876466291e-3 68 | 1 -1348 1.7990551522725799e-3 69 | 1 -1347 1.6225431840612454e-3 70 | 1 -1346 1.5390623779674918e-3 71 | 1 -1345 1.3814964500618772e-3 72 | 1 -1344 1.307331154244936e-3 73 | 1 -1343 1.1679953652450799e-3 74 | 1 -1342 1.102714573310709e-3 75 | 1 -1341 9.806216775320685e-4 76 | 1 -1340 8.176418428665694e-4 77 | 1 -1339 7.215856927735813e-4 78 | 1 -1338 5.948752618395377e-4 79 | 1 -1337 4.208518608448752e-4 80 | 1 -1336 3.3977394717732564e-4 81 | 1 -1335 2.724987756073075e-4 82 | 1 -1334 2.3871709416418613e-4 83 | 1 -1333 1.9007903727128538e-4 84 | 1 -1332 1.6272739812967435e-4 85 | 1 -1331 1.3519717948682838e-4 86 | 1 -1330 1.2462688196469574e-4 87 | 1 -1329 1.148033756791068e-4 88 | 1 -1328 1.148033756791068e-4 89 | 1 -1327 1.2462688196469574e-4 90 | 1 -1326 1.5040978122647387e-4 91 | 1 -1325 1.6272739812967435e-4 92 | 1 -1324 1.9007903727128538e-4 93 | 1 -1323 2.2141335928260893e-4 94 | 1 -1322 2.3436717049439196e-4 95 | 1 -1321 2.935112039555652e-4 96 | 1 -1320 3.3977394717732564e-4 97 | 1 -1319 3.9216843145759825e-4 98 | 1 -1318 4.512953629497663e-4 99 | 1 -1317 4.83577493578026e-4 100 | 1 -1316 5.17777863773553e-4 101 | 1 -1315 5.539769330715575e-4 102 | 1 -1314 5.922557826579035e-4 103 | 1 -1313 6.32695868097863e-4 104 | 1 -1312 6.753787514040828e-4 105 | 1 -1311 7.203858123305412e-4 106 | 1 -1310 7.67797938906543e-4 107 | 1 -1309 7.67797938906543e-4 108 | 1 -1308 8.701564817422859e-4 109 | 1 -1307 9.25259143666846e-4 110 | 1 -1306 9.830786028502015e-4 111 | 1 -1305 1.1071574672978062e-3 112 | 1 -1304 1.2429418660561333e-3 113 | 1 -1303 1.3909218642924616e-3 114 | 1 -1302 1.5515135988923943e-3 115 | 1 -1301 1.8167336700278237e-3 116 | 1 -1300 2.0100466198439346e-3 117 | 1 -1299 2.2166151106550952e-3 118 | 1 -1298 2.4363251289291773e-3 119 | 1 -1297 2.5510292229232456e-3 120 | 1 -1296 2.751865868717371e-3 121 | 1 -1295 2.873264094835862e-3 122 | 1 -1294 2.9139011294527857e-3 123 | 1 -1293 3.0408684109738534e-3 124 | 1 -1292 3.0408684109738534e-3 125 | 1 -1291 3.170689427609433e-3 126 | 1 -1290 3.170689427609433e-3 127 | 1 -1289 3.3032551412201937e-3 128 | 1 -1288 3.3032551412201937e-3 129 | 1 -1287 3.3581756461021255e-3 130 | 1 -1286 3.4962053754479154e-3 131 | 1 -1285 3.4962053754479154e-3 132 | 1 -1284 3.636728238921216e-3 133 | 1 -1283 3.7795861203898553e-3 134 | 1 -1282 4.071608221183953e-3 135 | 1 -1281 4.2962785942424345e-3 136 | 1 -1280 4.4453743877853665e-3 137 | 1 -1279 4.595672267179621e-3 138 | 1 -1278 4.746940727805428e-3 139 | 1 -1277 4.8989373979645865e-3 140 | 1 -1276 5.051409553264873e-3 141 | 1 -1275 5.051409553264873e-3 142 | 1 -1274 5.051409553264873e-3 143 | 1 -1273 5.204094697948097e-3 144 | 1 -1272 5.204094697948097e-3 145 | 1 -1271 5.204094697948097e-3 146 | 1 -1270 5.356721212258653e-3 147 | 1 -1269 5.356721212258653e-3 148 | 1 -1268 5.509009064474462e-3 149 | 1 -1267 5.66067058574163e-3 150 | 1 -1266 5.960930843761602e-3 151 | 1 -1265 6.255081048085693e-3 152 | 1 -1264 6.496271793365417e-3 153 | 1 -1263 6.815086293458017e-3 154 | 1 -1262 7.0759225459377335e-3 155 | 1 -1261 7.436292363311631e-3 156 | 1 -1260 7.752607680654792e-3 157 | 1 -1259 8.01767567462796e-3 158 | 1 -1258 8.219048811611574e-3 159 | 1 -1257 8.36801821040614e-3 160 | 1 -1256 8.429927763289144e-3 161 | 1 -1255 8.464956955090752e-3 162 | 1 -1254 8.44977156175193e-3 163 | 1 -1253 8.430828879227146e-3 164 | 1 -1252 8.404381852896069e-3 165 | 1 -1251 8.370502805455045e-3 166 | 1 -1250 8.404381852896069e-3 167 | 1 -1249 8.430828879227146e-3 168 | 1 -1248 8.44977156175193e-3 169 | 1 -1247 8.461157999571157e-3 170 | 1 -1246 8.461157999571157e-3 171 | 1 -1245 8.44977156175193e-3 172 | 1 -1244 8.404381852896069e-3 173 | 1 -1243 8.329284145534294e-3 174 | 1 -1242 8.280837939702966e-3 175 | 1 -1241 8.162806256579362e-3 176 | 1 -1240 8.093538120867983e-3 177 | 1 -1239 8.01767567462796e-3 178 | 1 -1238 8.01767567462796e-3 179 | 1 -1237 8.01767567462796e-3 180 | 1 -1236 8.01767567462796e-3 181 | 1 -1235 8.01767567462796e-3 182 | 1 -1234 8.093538120867983e-3 183 | 1 -1233 8.162806256579362e-3 184 | 1 -1232 8.225295395169299e-3 185 | 1 -1231 8.280837939702966e-3 186 | 1 -1230 8.329284145534294e-3 187 | 1 -1229 8.370502805455045e-3 188 | 1 -1228 8.404381852896069e-3 189 | 1 -1227 8.430828879227146e-3 190 | 1 -1226 8.461157999571157e-3 191 | 1 -1225 8.464956955090752e-3 192 | 1 -1224 8.461157999571157e-3 193 | 1 -1223 8.44977156175193e-3 194 | 1 -1222 8.404381852896069e-3 195 | 1 -1221 8.329284145534294e-3 196 | 1 -1220 8.225295395169299e-3 197 | 1 -1219 8.093538120867983e-3 198 | 1 -1218 7.846986967054746e-3 199 | 1 -1217 7.546998430388022e-3 200 | 1 -1216 7.320685439613755e-3 201 | 1 -1215 6.947361318769239e-3 202 | 1 -1214 6.58591611723459e-3 203 | 1 -1213 6.305886827488075e-3 204 | 1 -1212 5.9298394251020865e-3 205 | 1 -1211 5.637345197754985e-3 206 | 1 -1210 5.557835462586986e-3 207 | 1 -1209 5.265776629448123e-3 208 | 1 -1208 5.119387112835432e-3 209 | 1 -1207 4.973083246476742e-3 210 | 1 -1206 4.973083246476742e-3 211 | 1 -1205 4.82710015859024e-3 212 | 1 -1204 4.906879561672736e-3 213 | 1 -1203 4.763267316260542e-3 214 | 1 -1202 4.620280995929707e-3 215 | 1 -1201 4.704477321832974e-3 216 | 1 -1200 4.563957977288564e-3 217 | 1 -1199 4.424321616138066e-3 218 | 1 -1198 4.148428528170371e-3 219 | 1 -1197 4.0125155909635155e-3 220 | 1 -1196 3.653039077567977e-3 221 | 1 -1195 3.521697541053114e-3 222 | 1 -1194 3.173759822427648e-3 223 | 1 -1193 2.9272191808455594e-3 224 | 1 -1192 2.8079603190694397e-3 225 | 1 -1191 2.4902302735080434e-3 226 | 1 -1190 2.3802568132954617e-3 227 | 1 -1189 2.254524756327637e-3 228 | 1 -1188 2.152737552717012e-3 229 | 1 -1187 2.053983954076986e-3 230 | 1 -1186 2.0429974931165545e-3 231 | 1 -1185 1.9490215625023862e-3 232 | 1 -1184 1.9432077248556056e-3 233 | 1 -1183 1.9432077248556056e-3 234 | 1 -1182 1.9432077248556056e-3 235 | 1 -1181 2.0355578656358043e-3 236 | 1 -1180 2.0355578656358043e-3 237 | 1 -1179 2.2288546084408044e-3 238 | 1 -1178 2.3297756207667835e-3 239 | 1 -1177 2.4483273816610215e-3 240 | 1 -1176 2.556905823683014e-3 241 | 1 -1175 2.7824863048723806e-3 242 | 1 -1174 2.9272191808455594e-3 243 | 1 -1173 3.173759822427648e-3 244 | 1 -1172 3.430371134532966e-3 245 | 1 -1171 3.6961540010936834e-3 246 | 1 -1170 3.8321572945305316e-3 247 | 1 -1169 4.058573170180611e-3 248 | 1 -1168 4.197088823535216e-3 249 | 1 -1167 4.336999351332677e-3 250 | 1 -1166 4.336999351332677e-3 251 | 1 -1165 4.250788192423513e-3 252 | 1 -1164 4.109639709449054e-3 253 | 1 -1163 3.883197707028445e-3 254 | 1 -1162 3.6078258107035154e-3 255 | 1 -1161 3.2544879034669193e-3 256 | 1 -1160 2.9975617876123644e-3 257 | 1 -1159 2.751865868717371e-3 258 | 1 -1158 2.5180673943496156e-3 259 | 1 -1157 2.2966562150948063e-3 260 | 1 -1156 2.0879544204108263e-3 261 | 1 -1155 1.7250434594129442e-3 262 | 1 -1154 1.5515135988923943e-3 263 | 1 -1153 1.4696185733314125e-3 264 | 1 -1152 1.2533026559854523e-3 265 | 1 -1151 1.1825766860469056e-3 266 | 1 -1150 1.2429418660561333e-3 267 | 1 -1149 1.2429418660561333e-3 268 | 1 -1148 1.3153794909812212e-3 269 | 1 -1147 1.4696185733314125e-3 270 | 1 -1146 1.6366448105954367e-3 271 | 1 -1145 1.9360792585115445e-3 272 | 1 -1144 2.2476898128398837e-3 273 | 1 -1143 2.7100312726132834e-3 274 | 1 -1142 3.170689427609433e-3 275 | 1 -1141 3.5761221976395963e-3 276 | 1 -1140 4.00256233315608e-3 277 | 1 -1139 4.2962785942424345e-3 278 | 1 -1138 4.595672267179621e-3 279 | 1 -1137 4.746940727805428e-3 280 | 1 -1136 4.675259513505448e-3 281 | 1 -1135 4.675259513505448e-3 282 | 1 -1134 4.595672267179621e-3 283 | 1 -1133 4.4453743877853665e-3 284 | 1 -1132 4.1486050770902375e-3 285 | 1 -1131 3.858346852849138e-3 286 | 1 -1130 3.4384440741748864e-3 287 | 1 -1129 3.0408684109738534e-3 288 | 1 -1128 2.6689027484470516e-3 289 | 1 -1127 2.3248406407503004e-3 290 | 1 -1126 1.911731935870725e-3 291 | 1 -1125 1.6366448105954367e-3 292 | 1 -1124 1.3153794909812212e-3 293 | 1 -1123 1.1071574672978062e-3 294 | 1 -1122 9.806216775320685e-4 295 | 1 -1121 8.176418428665694e-4 296 | 1 -1120 6.32695868097863e-4 297 | 1 -1119 5.539769330715575e-4 298 | 1 -1118 4.83577493578026e-4 299 | 1 -1117 4.208518608448752e-4 300 | 1 -1116 3.65167761306329e-4 301 | 1 -1115 3.1591264552033213e-4 302 | 1 -1114 2.935112039555652e-4 303 | 1 -1113 2.5280641702553976e-4 304 | 1 -1112 2.3436717049439196e-4 305 | 1 -1111 2.0099050259006772e-4 306 | 1 -1110 1.859296333340531e-4 307 | 1 -1109 1.5877046809935892e-4 308 | 1 -1108 1.4656180719851885e-4 309 | 1 -1107 1.3892963275606956e-4 310 | 1 -1106 1.2823854608963312e-4 311 | 1 -1105 1.1829017131799134e-4 312 | 1 -1104 1.2243467595778366e-4 313 | 1 -1103 1.2243467595778366e-4 314 | 1 -1102 1.2723143433428656e-4 315 | 1 -1101 1.2723143433428656e-4 316 | 1 -1100 1.2723143433428656e-4 317 | 1 -1099 1.3753808580035254e-4 318 | 1 -1098 1.2243467595778366e-4 319 | 1 -1097 1.3254498357872548e-4 320 | 1 -1096 1.4339568599045576e-4 321 | 1 -1095 1.2823854608963312e-4 322 | 1 -1094 1.3892963275606956e-4 323 | 1 -1093 1.5040978122647387e-4 324 | 1 -1092 1.8085221842514774e-4 325 | 1 -1091 1.8085221842514774e-4 326 | 1 -1090 1.9513635454604887e-4 327 | 1 -1089 2.3299579118782056e-4 328 | 1 -1088 2.3299579118782056e-4 329 | 1 -1087 2.3299579118782056e-4 330 | 1 -1086 2.3299579118782056e-4 331 | 1 -1085 2.1651980039156992e-4 332 | 1 -1084 2.1651980039156992e-4 333 | 1 -1083 2.0107615060877286e-4 334 | 1 -1082 1.8085221842514774e-4 335 | 1 -1081 1.6750114168857832e-4 336 | 1 -1080 1.5503201204553448e-4 337 | 1 -1079 1.4339568599045576e-4 338 | 1 -1078 1.3254498357872548e-4 339 | 1 -1077 1.3254498357872548e-4 340 | 1 -1076 1.3753808580035254e-4 341 | 1 -1075 1.2723143433428656e-4 342 | 1 -1074 1.2723143433428656e-4 343 | 1 -1073 1.2723143433428656e-4 344 | 1 -1072 1.2723143433428656e-4 345 | 1 -1071 1.2723143433428656e-4 346 | 1 -1070 1.3753808580035254e-4 347 | 1 -1069 1.3254498357872548e-4 348 | 1 -1068 1.4339568599045576e-4 349 | 1 -1067 1.5503201204553448e-4 350 | 1 -1066 1.6750114168857832e-4 351 | 1 -1065 1.8085221842514774e-4 352 | 1 -1064 1.9513635454604887e-4 353 | 1 -1063 1.9513635454604887e-4 354 | 1 -1062 2.1040662842548757e-4 355 | 1 -1061 2.2671807319720778e-4 356 | 1 -1060 2.5055935238099474e-4 357 | 1 -1059 2.5055935238099474e-4 358 | 1 -1058 2.3299579118782056e-4 359 | 1 -1057 2.1651980039156992e-4 360 | 1 -1056 2.0107615060877286e-4 361 | 1 -1055 1.8661142765739902e-4 362 | 1 -1054 1.6041430930148937e-4 363 | 1 -1053 1.1302146631796101e-4 364 | 1 -1052 9.612265873070429e-5 365 | 1 -1051 6.597267979082289e-5 366 | 1 -1050 5.0866536059988307e-5 367 | 1 -1049 3.8994974932609313e-5 368 | 1 -1048 2.972595175938836e-5 369 | 1 -1047 2.25349232772979e-5 370 | 1 -1046 1.699074613594545e-5 371 | 1 -1045 1.658658107917938e-5 372 | 1 -1044 1.2484277307163715e-5 373 | 1 -1043 1.0300778062200006e-5 374 | 1 -1042 1.0202565515150597e-5 375 | 1 -1041 9.272195448868473e-6 376 | 1 -1040 8.422125779914841e-6 377 | 1 -1039 7.645894705912038e-6 378 | 1 -1038 7.645894705912038e-6 379 | 1 -1037 7.645894705912038e-6 380 | 1 -1036 8.422125779914841e-6 381 | 1 -1035 7.688015958235523e-6 382 | 1 -1034 8.480202462649825e-6 383 | 1 -1033 9.34885998820139e-6 384 | 1 -1032 8.611791816138628e-6 385 | 1 -1031 1.0487462457655117e-5 386 | 1 -1030 1.1563383516905554e-5 387 | 1 -1029 1.2742305051699932e-5 388 | 1 -1028 1.821333369197085e-5 389 | 1 -1027 1.998803764083492e-5 390 | 1 -1026 2.1922873914274345e-5 391 | 1 -1025 2.4030892330116914e-5 392 | 1 -1024 3.0777861111539e-5 393 | 1 -1023 3.0777861111539e-5 394 | 1 -1022 3.0777861111539e-5 395 | 1 -1021 2.8160161502765864e-5 396 | 1 -1020 2.5750173625429978e-5 397 | 1 -1019 2.353287308894043e-5 398 | 1 -1018 1.658658107917938e-5 399 | 1 -1017 1.3732269511194603e-5 400 | -------------------------------------------------------------------------------- /test/golden/expected_data/density_file.tsv: -------------------------------------------------------------------------------- 1 | id yearBCAD density 2 | 1 -1414 1.2484277307163715e-5 3 | 1 -1413 1.5096420631606685e-5 4 | 1 -1412 1.998803764083492e-5 5 | 1 -1411 2.4030892330116914e-5 6 | 1 -1410 3.1538598474982654e-5 7 | 1 -1409 4.366221509645768e-5 8 | 1 -1408 5.181932205051161e-5 9 | 1 -1407 6.135226448948473e-5 10 | 1 -1406 7.246211306416831e-5 11 | 1 -1405 8.537321039537996e-5 12 | 1 -1404 9.258108031984863e-5 13 | 1 -1403 1.086693761571088e-4 14 | 1 -1402 1.0426396490711256e-4 15 | 1 -1401 1.1302146631796101e-4 16 | 1 -1400 1.2243467595778366e-4 17 | 1 -1399 1.1829017131799134e-4 18 | 1 -1398 1.2823854608963312e-4 19 | 1 -1397 1.3892963275606956e-4 20 | 1 -1396 1.5040978122647387e-4 21 | 1 -1395 1.8085221842514774e-4 22 | 1 -1394 1.9513635454604887e-4 23 | 1 -1393 2.2671807319720778e-4 24 | 1 -1392 2.6926749633678055e-4 25 | 1 -1391 2.8917897608255497e-4 26 | 1 -1390 3.328553286029605e-4 27 | 1 -1389 3.567458756653848e-4 28 | 1 -1388 3.750698384192567e-4 29 | 1 -1387 4.303768082286073e-4 30 | 1 -1386 4.924405994482622e-4 31 | 1 -1385 5.61845361356958e-4 32 | 1 -1384 6.391864309074129e-4 33 | 1 -1383 7.250635883106889e-4 34 | 1 -1382 8.200731952273836e-4 35 | 1 -1381 9.839340593674967e-4 36 | 1 -1380 1.1661434275192647e-3 37 | 1 -1379 1.3733857829327752e-3 38 | 1 -1378 1.5233569814230622e-3 39 | 1 -1377 1.6848285873788055e-3 40 | 1 -1376 1.8580052862051423e-3 41 | 1 -1375 2.0429974931165545e-3 42 | 1 -1374 2.239809381540531e-3 43 | 1 -1373 2.4483273816610215e-3 44 | 1 -1372 2.577845523255269e-3 45 | 1 -1371 2.8079603190694397e-3 46 | 1 -1370 2.9272191808455594e-3 47 | 1 -1369 3.084303895635148e-3 48 | 1 -1368 3.2114583848607227e-3 49 | 1 -1367 3.430371134532966e-3 50 | 1 -1366 3.5621789542802937e-3 51 | 1 -1365 3.6961540010936834e-3 52 | 1 -1364 3.921621611069951e-3 53 | 1 -1363 3.921621611069951e-3 54 | 1 -1362 3.921621611069951e-3 55 | 1 -1361 3.921621611069951e-3 56 | 1 -1360 3.921621611069951e-3 57 | 1 -1359 3.7863936818896392e-3 58 | 1 -1358 3.5621789542802937e-3 59 | 1 -1357 3.430371134532966e-3 60 | 1 -1356 3.2114583848607227e-3 61 | 1 -1355 3.084303895635148e-3 62 | 1 -1354 2.751865868717371e-3 63 | 1 -1353 2.633444780113943e-3 64 | 1 -1352 2.40578945736931e-3 65 | 1 -1351 2.1907027626884247e-3 66 | 1 -1350 2.0879544204108263e-3 67 | 1 -1349 1.8921278876466291e-3 68 | 1 -1348 1.7990551522725799e-3 69 | 1 -1347 1.6225431840612454e-3 70 | 1 -1346 1.5390623779674918e-3 71 | 1 -1345 1.3814964500618772e-3 72 | 1 -1344 1.307331154244936e-3 73 | 1 -1343 1.1679953652450799e-3 74 | 1 -1342 1.102714573310709e-3 75 | 1 -1341 9.806216775320685e-4 76 | 1 -1340 8.176418428665694e-4 77 | 1 -1339 7.215856927735813e-4 78 | 1 -1338 5.948752618395377e-4 79 | 1 -1337 4.208518608448752e-4 80 | 1 -1336 3.3977394717732564e-4 81 | 1 -1335 2.724987756073075e-4 82 | 1 -1334 2.3871709416418613e-4 83 | 1 -1333 1.9007903727128538e-4 84 | 1 -1332 1.6272739812967435e-4 85 | 1 -1331 1.3519717948682838e-4 86 | 1 -1330 1.2462688196469574e-4 87 | 1 -1329 1.148033756791068e-4 88 | 1 -1328 1.148033756791068e-4 89 | 1 -1327 1.2462688196469574e-4 90 | 1 -1326 1.5040978122647387e-4 91 | 1 -1325 1.6272739812967435e-4 92 | 1 -1324 1.9007903727128538e-4 93 | 1 -1323 2.2141335928260893e-4 94 | 1 -1322 2.3436717049439196e-4 95 | 1 -1321 2.935112039555652e-4 96 | 1 -1320 3.3977394717732564e-4 97 | 1 -1319 3.9216843145759825e-4 98 | 1 -1318 4.512953629497663e-4 99 | 1 -1317 4.83577493578026e-4 100 | 1 -1316 5.17777863773553e-4 101 | 1 -1315 5.539769330715575e-4 102 | 1 -1314 5.922557826579035e-4 103 | 1 -1313 6.32695868097863e-4 104 | 1 -1312 6.753787514040828e-4 105 | 1 -1311 7.203858123305412e-4 106 | 1 -1310 7.67797938906543e-4 107 | 1 -1309 7.67797938906543e-4 108 | 1 -1308 8.701564817422859e-4 109 | 1 -1307 9.25259143666846e-4 110 | 1 -1306 9.830786028502015e-4 111 | 1 -1305 1.1071574672978062e-3 112 | 1 -1304 1.2429418660561333e-3 113 | 1 -1303 1.3909218642924616e-3 114 | 1 -1302 1.5515135988923943e-3 115 | 1 -1301 1.8167336700278237e-3 116 | 1 -1300 2.0100466198439346e-3 117 | 1 -1299 2.2166151106550952e-3 118 | 1 -1298 2.4363251289291773e-3 119 | 1 -1297 2.5510292229232456e-3 120 | 1 -1296 2.751865868717371e-3 121 | 1 -1295 2.873264094835862e-3 122 | 1 -1294 2.9139011294527857e-3 123 | 1 -1293 3.0408684109738534e-3 124 | 1 -1292 3.0408684109738534e-3 125 | 1 -1291 3.170689427609433e-3 126 | 1 -1290 3.170689427609433e-3 127 | 1 -1289 3.3032551412201937e-3 128 | 1 -1288 3.3032551412201937e-3 129 | 1 -1287 3.3581756461021255e-3 130 | 1 -1286 3.4962053754479154e-3 131 | 1 -1285 3.4962053754479154e-3 132 | 1 -1284 3.636728238921216e-3 133 | 1 -1283 3.7795861203898553e-3 134 | 1 -1282 4.071608221183953e-3 135 | 1 -1281 4.2962785942424345e-3 136 | 1 -1280 4.4453743877853665e-3 137 | 1 -1279 4.595672267179621e-3 138 | 1 -1278 4.746940727805428e-3 139 | 1 -1277 4.8989373979645865e-3 140 | 1 -1276 5.051409553264873e-3 141 | 1 -1275 5.051409553264873e-3 142 | 1 -1274 5.051409553264873e-3 143 | 1 -1273 5.204094697948097e-3 144 | 1 -1272 5.204094697948097e-3 145 | 1 -1271 5.204094697948097e-3 146 | 1 -1270 5.356721212258653e-3 147 | 1 -1269 5.356721212258653e-3 148 | 1 -1268 5.509009064474462e-3 149 | 1 -1267 5.66067058574163e-3 150 | 1 -1266 5.960930843761602e-3 151 | 1 -1265 6.255081048085693e-3 152 | 1 -1264 6.496271793365417e-3 153 | 1 -1263 6.815086293458017e-3 154 | 1 -1262 7.0759225459377335e-3 155 | 1 -1261 7.436292363311631e-3 156 | 1 -1260 7.752607680654792e-3 157 | 1 -1259 8.01767567462796e-3 158 | 1 -1258 8.219048811611574e-3 159 | 1 -1257 8.36801821040614e-3 160 | 1 -1256 8.429927763289144e-3 161 | 1 -1255 8.464956955090752e-3 162 | 1 -1254 8.44977156175193e-3 163 | 1 -1253 8.430828879227146e-3 164 | 1 -1252 8.404381852896069e-3 165 | 1 -1251 8.370502805455045e-3 166 | 1 -1250 8.404381852896069e-3 167 | 1 -1249 8.430828879227146e-3 168 | 1 -1248 8.44977156175193e-3 169 | 1 -1247 8.461157999571157e-3 170 | 1 -1246 8.461157999571157e-3 171 | 1 -1245 8.44977156175193e-3 172 | 1 -1244 8.404381852896069e-3 173 | 1 -1243 8.329284145534294e-3 174 | 1 -1242 8.280837939702966e-3 175 | 1 -1241 8.162806256579362e-3 176 | 1 -1240 8.093538120867983e-3 177 | 1 -1239 8.01767567462796e-3 178 | 1 -1238 8.01767567462796e-3 179 | 1 -1237 8.01767567462796e-3 180 | 1 -1236 8.01767567462796e-3 181 | 1 -1235 8.01767567462796e-3 182 | 1 -1234 8.093538120867983e-3 183 | 1 -1233 8.162806256579362e-3 184 | 1 -1232 8.225295395169299e-3 185 | 1 -1231 8.280837939702966e-3 186 | 1 -1230 8.329284145534294e-3 187 | 1 -1229 8.370502805455045e-3 188 | 1 -1228 8.404381852896069e-3 189 | 1 -1227 8.430828879227146e-3 190 | 1 -1226 8.461157999571157e-3 191 | 1 -1225 8.464956955090752e-3 192 | 1 -1224 8.461157999571157e-3 193 | 1 -1223 8.44977156175193e-3 194 | 1 -1222 8.404381852896069e-3 195 | 1 -1221 8.329284145534294e-3 196 | 1 -1220 8.225295395169299e-3 197 | 1 -1219 8.093538120867983e-3 198 | 1 -1218 7.846986967054746e-3 199 | 1 -1217 7.546998430388022e-3 200 | 1 -1216 7.320685439613755e-3 201 | 1 -1215 6.947361318769239e-3 202 | 1 -1214 6.58591611723459e-3 203 | 1 -1213 6.305886827488075e-3 204 | 1 -1212 5.9298394251020865e-3 205 | 1 -1211 5.637345197754985e-3 206 | 1 -1210 5.557835462586986e-3 207 | 1 -1209 5.265776629448123e-3 208 | 1 -1208 5.119387112835432e-3 209 | 1 -1207 4.973083246476742e-3 210 | 1 -1206 4.973083246476742e-3 211 | 1 -1205 4.82710015859024e-3 212 | 1 -1204 4.906879561672736e-3 213 | 1 -1203 4.763267316260542e-3 214 | 1 -1202 4.620280995929707e-3 215 | 1 -1201 4.704477321832974e-3 216 | 1 -1200 4.563957977288564e-3 217 | 1 -1199 4.424321616138066e-3 218 | 1 -1198 4.148428528170371e-3 219 | 1 -1197 4.0125155909635155e-3 220 | 1 -1196 3.653039077567977e-3 221 | 1 -1195 3.521697541053114e-3 222 | 1 -1194 3.173759822427648e-3 223 | 1 -1193 2.9272191808455594e-3 224 | 1 -1192 2.8079603190694397e-3 225 | 1 -1191 2.4902302735080434e-3 226 | 1 -1190 2.3802568132954617e-3 227 | 1 -1189 2.254524756327637e-3 228 | 1 -1188 2.152737552717012e-3 229 | 1 -1187 2.053983954076986e-3 230 | 1 -1186 2.0429974931165545e-3 231 | 1 -1185 1.9490215625023862e-3 232 | 1 -1184 1.9432077248556056e-3 233 | 1 -1183 1.9432077248556056e-3 234 | 1 -1182 1.9432077248556056e-3 235 | 1 -1181 2.0355578656358043e-3 236 | 1 -1180 2.0355578656358043e-3 237 | 1 -1179 2.2288546084408044e-3 238 | 1 -1178 2.3297756207667835e-3 239 | 1 -1177 2.4483273816610215e-3 240 | 1 -1176 2.556905823683014e-3 241 | 1 -1175 2.7824863048723806e-3 242 | 1 -1174 2.9272191808455594e-3 243 | 1 -1173 3.173759822427648e-3 244 | 1 -1172 3.430371134532966e-3 245 | 1 -1171 3.6961540010936834e-3 246 | 1 -1170 3.8321572945305316e-3 247 | 1 -1169 4.058573170180611e-3 248 | 1 -1168 4.197088823535216e-3 249 | 1 -1167 4.336999351332677e-3 250 | 1 -1166 4.336999351332677e-3 251 | 1 -1165 4.250788192423513e-3 252 | 1 -1164 4.109639709449054e-3 253 | 1 -1163 3.883197707028445e-3 254 | 1 -1162 3.6078258107035154e-3 255 | 1 -1161 3.2544879034669193e-3 256 | 1 -1160 2.9975617876123644e-3 257 | 1 -1159 2.751865868717371e-3 258 | 1 -1158 2.5180673943496156e-3 259 | 1 -1157 2.2966562150948063e-3 260 | 1 -1156 2.0879544204108263e-3 261 | 1 -1155 1.7250434594129442e-3 262 | 1 -1154 1.5515135988923943e-3 263 | 1 -1153 1.4696185733314125e-3 264 | 1 -1152 1.2533026559854523e-3 265 | 1 -1151 1.1825766860469056e-3 266 | 1 -1150 1.2429418660561333e-3 267 | 1 -1149 1.2429418660561333e-3 268 | 1 -1148 1.3153794909812212e-3 269 | 1 -1147 1.4696185733314125e-3 270 | 1 -1146 1.6366448105954367e-3 271 | 1 -1145 1.9360792585115445e-3 272 | 1 -1144 2.2476898128398837e-3 273 | 1 -1143 2.7100312726132834e-3 274 | 1 -1142 3.170689427609433e-3 275 | 1 -1141 3.5761221976395963e-3 276 | 1 -1140 4.00256233315608e-3 277 | 1 -1139 4.2962785942424345e-3 278 | 1 -1138 4.595672267179621e-3 279 | 1 -1137 4.746940727805428e-3 280 | 1 -1136 4.675259513505448e-3 281 | 1 -1135 4.675259513505448e-3 282 | 1 -1134 4.595672267179621e-3 283 | 1 -1133 4.4453743877853665e-3 284 | 1 -1132 4.1486050770902375e-3 285 | 1 -1131 3.858346852849138e-3 286 | 1 -1130 3.4384440741748864e-3 287 | 1 -1129 3.0408684109738534e-3 288 | 1 -1128 2.6689027484470516e-3 289 | 1 -1127 2.3248406407503004e-3 290 | 1 -1126 1.911731935870725e-3 291 | 1 -1125 1.6366448105954367e-3 292 | 1 -1124 1.3153794909812212e-3 293 | 1 -1123 1.1071574672978062e-3 294 | 1 -1122 9.806216775320685e-4 295 | 1 -1121 8.176418428665694e-4 296 | 1 -1120 6.32695868097863e-4 297 | 1 -1119 5.539769330715575e-4 298 | 1 -1118 4.83577493578026e-4 299 | 1 -1117 4.208518608448752e-4 300 | 1 -1116 3.65167761306329e-4 301 | 1 -1115 3.1591264552033213e-4 302 | 1 -1114 2.935112039555652e-4 303 | 1 -1113 2.5280641702553976e-4 304 | 1 -1112 2.3436717049439196e-4 305 | 1 -1111 2.0099050259006772e-4 306 | 1 -1110 1.859296333340531e-4 307 | 1 -1109 1.5877046809935892e-4 308 | 1 -1108 1.4656180719851885e-4 309 | 1 -1107 1.3892963275606956e-4 310 | 1 -1106 1.2823854608963312e-4 311 | 1 -1105 1.1829017131799134e-4 312 | 1 -1104 1.2243467595778366e-4 313 | 1 -1103 1.2243467595778366e-4 314 | 1 -1102 1.2723143433428656e-4 315 | 1 -1101 1.2723143433428656e-4 316 | 1 -1100 1.2723143433428656e-4 317 | 1 -1099 1.3753808580035254e-4 318 | 1 -1098 1.2243467595778366e-4 319 | 1 -1097 1.3254498357872548e-4 320 | 1 -1096 1.4339568599045576e-4 321 | 1 -1095 1.2823854608963312e-4 322 | 1 -1094 1.3892963275606956e-4 323 | 1 -1093 1.5040978122647387e-4 324 | 1 -1092 1.8085221842514774e-4 325 | 1 -1091 1.8085221842514774e-4 326 | 1 -1090 1.9513635454604887e-4 327 | 1 -1089 2.3299579118782056e-4 328 | 1 -1088 2.3299579118782056e-4 329 | 1 -1087 2.3299579118782056e-4 330 | 1 -1086 2.3299579118782056e-4 331 | 1 -1085 2.1651980039156992e-4 332 | 1 -1084 2.1651980039156992e-4 333 | 1 -1083 2.0107615060877286e-4 334 | 1 -1082 1.8085221842514774e-4 335 | 1 -1081 1.6750114168857832e-4 336 | 1 -1080 1.5503201204553448e-4 337 | 1 -1079 1.4339568599045576e-4 338 | 1 -1078 1.3254498357872548e-4 339 | 1 -1077 1.3254498357872548e-4 340 | 1 -1076 1.3753808580035254e-4 341 | 1 -1075 1.2723143433428656e-4 342 | 1 -1074 1.2723143433428656e-4 343 | 1 -1073 1.2723143433428656e-4 344 | 1 -1072 1.2723143433428656e-4 345 | 1 -1071 1.2723143433428656e-4 346 | 1 -1070 1.3753808580035254e-4 347 | 1 -1069 1.3254498357872548e-4 348 | 1 -1068 1.4339568599045576e-4 349 | 1 -1067 1.5503201204553448e-4 350 | 1 -1066 1.6750114168857832e-4 351 | 1 -1065 1.8085221842514774e-4 352 | 1 -1064 1.9513635454604887e-4 353 | 1 -1063 1.9513635454604887e-4 354 | 1 -1062 2.1040662842548757e-4 355 | 1 -1061 2.2671807319720778e-4 356 | 1 -1060 2.5055935238099474e-4 357 | 1 -1059 2.5055935238099474e-4 358 | 1 -1058 2.3299579118782056e-4 359 | 1 -1057 2.1651980039156992e-4 360 | 1 -1056 2.0107615060877286e-4 361 | 1 -1055 1.8661142765739902e-4 362 | 1 -1054 1.6041430930148937e-4 363 | 1 -1053 1.1302146631796101e-4 364 | 1 -1052 9.612265873070429e-5 365 | 1 -1051 6.597267979082289e-5 366 | 1 -1050 5.0866536059988307e-5 367 | 1 -1049 3.8994974932609313e-5 368 | 1 -1048 2.972595175938836e-5 369 | 1 -1047 2.25349232772979e-5 370 | 1 -1046 1.699074613594545e-5 371 | 1 -1045 1.658658107917938e-5 372 | 1 -1044 1.2484277307163715e-5 373 | 1 -1043 1.0300778062200006e-5 374 | 1 -1042 1.0202565515150597e-5 375 | 1 -1041 9.272195448868473e-6 376 | 1 -1040 8.422125779914841e-6 377 | 1 -1039 7.645894705912038e-6 378 | 1 -1038 7.645894705912038e-6 379 | 1 -1037 7.645894705912038e-6 380 | 1 -1036 8.422125779914841e-6 381 | 1 -1035 7.688015958235523e-6 382 | 1 -1034 8.480202462649825e-6 383 | 1 -1033 9.34885998820139e-6 384 | 1 -1032 8.611791816138628e-6 385 | 1 -1031 1.0487462457655117e-5 386 | 1 -1030 1.1563383516905554e-5 387 | 1 -1029 1.2742305051699932e-5 388 | 1 -1028 1.821333369197085e-5 389 | 1 -1027 1.998803764083492e-5 390 | 1 -1026 2.1922873914274345e-5 391 | 1 -1025 2.4030892330116914e-5 392 | 1 -1024 3.0777861111539e-5 393 | 1 -1023 3.0777861111539e-5 394 | 1 -1022 3.0777861111539e-5 395 | 1 -1021 2.8160161502765864e-5 396 | 1 -1020 2.5750173625429978e-5 397 | 1 -1019 2.353287308894043e-5 398 | 1 -1018 1.658658107917938e-5 399 | 1 -1017 1.3732269511194603e-5 400 | -------------------------------------------------------------------------------- /src/Currycarbon/Parsers.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Currycarbon.Parsers where 4 | 5 | import Currycarbon.CalCurves (intcal20) 6 | import Currycarbon.Calibration.Utils 7 | import Currycarbon.ParserHelpers 8 | import Currycarbon.Types 9 | import Currycarbon.Utils 10 | 11 | import Control.Exception (throwIO) 12 | import Data.List (intercalate, transpose) 13 | import qualified Data.Vector as V 14 | import qualified Data.Vector.Unboxed as VU 15 | import qualified Text.Parsec as P 16 | import qualified Text.Parsec.String as P 17 | 18 | -- * Parsing, rendering and writing functions 19 | -- 20 | -- $importExport 21 | -- 22 | -- This module contains a number of functions to manage data input and 23 | -- output plumbing for different datatypes 24 | 25 | -- read the calibration method 26 | 27 | readCalibrationMethod :: String -> Either String CalibrationMethod 28 | readCalibrationMethod s = 29 | case P.runParser parseCalibrationMethod () s s of 30 | Left err -> Left $ showParsecErrOneLine err 31 | Right x -> Right x 32 | 33 | parseCalibrationMethod :: P.Parser CalibrationMethod 34 | parseCalibrationMethod = do 35 | P.try bchron P.<|> matrixMultiplication 36 | where 37 | bchron = do 38 | _ <- P.string "Bchron," 39 | P.try studentT P.<|> normal 40 | studentT = do 41 | _ <- P.string "StudentT," 42 | dof <- parsePositiveDouble 43 | return (Bchron $ StudentTDist dof) 44 | normal = do 45 | _ <- P.string "Normal" 46 | return (Bchron NormalDist) 47 | matrixMultiplication = do 48 | _ <- P.string "MatrixMult" 49 | return MatrixMultiplication 50 | 51 | -- pretty printing 52 | 53 | -- | Combine 'CalExpr', 'CalPDF' and 'CalC14' to render pretty command line output 54 | -- like this: 55 | -- 56 | -- @ 57 | -- CalEXPR: [1] (S1:5000±30BP + S2:5100±100BP) 58 | -- Calibrated: 4150BC >> 3941BC > 3814BC < 3660BC << 3651BC 59 | -- 1-sigma: 3941-3864BC, 3810-3707BC, 3667-3660BC 60 | -- 2-sigma: 4150-4147BC, 4048-3651BC 61 | -- 62 | -- 63 | -- ▁ 64 | -- ▁ ▁▒▁ ▁▁ 65 | -- ▁▒ ▒▒▒▁▒▒ 66 | -- ▁▁▒▒▁ ▁▒▒▒▒▒▒ 67 | -- ▁▁▁▒▒▒▒▒▁▁▁▒▒▒▒▒▒▒▁ ▁ 68 | -- ▁▁▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▒ 69 | -- ▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▁▁▁▁▁▁▁ 70 | -- -4330 ┄─┬──────┬──────┬─────┬──────┬──────┬─────┬──────┬─────┄ -3530 71 | -- BC > > ^ << BC 72 | -- ────── ──────── ─ 73 | -- ── ──────────────────────────── 74 | -- @ 75 | -- 76 | renderCalDatePretty :: 77 | Bool -- ^ Should the CLI plot be restricted to (boring) ASCII symbols? 78 | -> (NamedCalExpr, CalPDF, CalC14) 79 | -> String 80 | renderCalDatePretty ascii (calExpr, calPDF, calC14) = 81 | "CalEXPR: " ++ intercalate "\n" [ 82 | renderNamedCalExpr calExpr 83 | , renderCalC14 calC14 84 | , "" 85 | , renderCLIPlotCalCurve ascii 8 50 calPDF calExpr 86 | , renderCLIPlotCalPDF ascii 6 50 calPDF calC14 87 | ] 88 | 89 | -- write and read calibration expressions 90 | 91 | renderNamedCalExpr :: NamedCalExpr -> String 92 | renderNamedCalExpr (NamedCalExpr exprID calExpr) = renderExprID exprID ++ " " ++ renderCalExpr calExpr 93 | 94 | renderExprID :: String -> String 95 | renderExprID s = "[" ++ s ++ "]" 96 | 97 | renderCalExpr :: CalExpr -> String 98 | renderCalExpr (UnCalDate a) = renderUncalC14 a 99 | renderCalExpr (WindowBP a) = renderTimeWindowBP a 100 | renderCalExpr (WindowBCAD a) = renderTimeWindowBCAD a 101 | renderCalExpr (CalDate (CalPDF name _ _)) = name 102 | renderCalExpr (SumCal a b) = "(" ++ renderCalExpr a ++ " + " ++ renderCalExpr b ++ ")" 103 | renderCalExpr (ProductCal a b) = "(" ++ renderCalExpr a ++ " * " ++ renderCalExpr b ++ ")" 104 | 105 | renderTimeWindowBP :: TimeWindowBP -> String 106 | renderTimeWindowBP (TimeWindowBP name start stop) = 107 | name ++ ":" ++ renderYearBP start ++ "-" ++ renderYearBP stop 108 | 109 | renderTimeWindowBCAD :: TimeWindowBCAD -> String 110 | renderTimeWindowBCAD (TimeWindowBCAD name start stop) = 111 | name ++ ":" ++ renderYearBCAD start ++ "-" ++ renderYearBCAD stop 112 | 113 | parseTimeWindowBP :: P.Parser TimeWindowBP 114 | parseTimeWindowBP = parseRecordType "rangeBP" $ P.try long P.<|> short 115 | where 116 | long = do 117 | name <- parseArgument "id" parseAnyString 118 | start <- parseArgument "start" parseWord 119 | stop <- parseArgument "stop" parseWord 120 | construct name start stop 121 | short = do 122 | start <- parseArgument "start" parseWord 123 | stop <- parseArgument "stop" parseWord 124 | construct "" start stop 125 | construct name start stop = do 126 | if start >= stop 127 | then return (TimeWindowBP name start stop) 128 | else fail "the BP stop date can not be larger than the start date" 129 | 130 | parseTimeWindowBCAD :: P.Parser TimeWindowBCAD 131 | parseTimeWindowBCAD = parseRecordType "rangeBCAD" $ P.try long P.<|> short 132 | where 133 | long = do 134 | name <- parseArgument "id" parseAnyString 135 | start <- parseArgument "start" parseInt 136 | stop <- parseArgument "stop" parseInt 137 | construct name start stop 138 | short = do 139 | start <- parseArgument "start" parseInt 140 | stop <- parseArgument "stop" parseInt 141 | construct "" start stop 142 | construct name start stop = do 143 | if start <= stop 144 | then return (TimeWindowBCAD name start stop) 145 | else fail "the BC/AD stop date can not be smaller than the start date" 146 | 147 | -- https://gist.github.com/abhin4v/017a36477204a1d57745 148 | addFun :: P.Parser CalExpr 149 | addFun = parseRecordType "sum" $ do 150 | a <- parseArgument "a" term 151 | b <- parseArgument "b" expr 152 | return $ SumCal a b 153 | 154 | addOperator :: P.Parser CalExpr 155 | addOperator = SumCal <$> term <*> (parseCharInSpace '+' *> expr) 156 | 157 | mulFun :: P.Parser CalExpr 158 | mulFun = parseRecordType "product" $ do 159 | a <- parseArgument "a" factor 160 | b <- parseArgument "b" term 161 | return $ ProductCal a b 162 | 163 | mulOperator :: P.Parser CalExpr 164 | mulOperator = ProductCal <$> factor <*> (parseCharInSpace '*' *> term) 165 | 166 | parens :: P.Parser CalExpr 167 | parens = P.between (parseCharInSpace '(') (parseCharInSpace ')') expr 168 | 169 | factor :: P.Parser CalExpr 170 | factor = P.try parens 171 | P.<|> P.try addFun 172 | P.<|> P.try mulFun 173 | P.<|> P.try (WindowBP <$> parseTimeWindowBP) 174 | P.<|> P.try (WindowBCAD <$> parseTimeWindowBCAD) 175 | P.<|> (UnCalDate <$> parseUncalC14) 176 | 177 | term :: P.Parser CalExpr 178 | term = P.try mulOperator P.<|> factor 179 | 180 | expr :: P.Parser CalExpr 181 | expr = P.try addOperator P.<|> term -- <* P.eof 182 | 183 | namedExpr :: P.Parser NamedCalExpr 184 | namedExpr = P.try nameBeforeColon P.<|> P.try record P.<|> onlyExpr 185 | where 186 | nameBeforeColon = do 187 | name <- parseAnyString 188 | _ <- P.char ':' 189 | _ <- P.spaces 190 | ex <- expr 191 | return (NamedCalExpr name ex) 192 | record = parseRecordType "calExpr" $ P.try long P.<|> short 193 | long = do 194 | name <- parseArgument "id" parseAnyString 195 | ex <- parseArgument "expr" expr 196 | return (NamedCalExpr name ex) 197 | short = do 198 | ex <- parseArgument "expr" expr 199 | return (NamedCalExpr "" ex) 200 | onlyExpr = NamedCalExpr "" <$> expr 201 | 202 | readNamedCalExprs :: String -> Either String [NamedCalExpr] 203 | readNamedCalExprs s = 204 | case P.runParser parseCalExprSepBySemicolon () s s of 205 | Left err -> Left $ showParsecErrOneLine err 206 | Right x -> Right x 207 | where 208 | parseCalExprSepBySemicolon :: P.Parser [NamedCalExpr] 209 | parseCalExprSepBySemicolon = P.sepBy namedExpr (P.char ';' <* P.spaces) <* P.eof 210 | 211 | readOneNamedCalExpr :: String -> Either String NamedCalExpr 212 | readOneNamedCalExpr s = 213 | case P.runParser namedExpr () s s of 214 | Left err -> Left $ showParsecErrOneLine err 215 | Right x -> Right x 216 | 217 | readNamedCalExprsFromFile :: FilePath -> IO [NamedCalExpr] 218 | readNamedCalExprsFromFile uncalFile = do 219 | ss <- lines <$> readFile uncalFile 220 | mapM readOneLine ss 221 | where 222 | readOneLine :: String -> IO NamedCalExpr 223 | readOneLine s = case readOneNamedCalExpr s of 224 | Left err -> throwIO $ CurrycarbonCLIParsingException $ err ++ "\nin \"" ++ s ++ "\"" 225 | Right x -> return x 226 | 227 | -- UncalC14 228 | renderUncalC14WithoutName :: UncalC14 -> String 229 | renderUncalC14WithoutName (UncalC14 _ bp sigma) = show bp ++ "±" ++ show sigma ++ "BP" 230 | 231 | renderUncalC14 :: UncalC14 -> String 232 | renderUncalC14 (UncalC14 name bp sigma) = name ++ ":" ++ show bp ++ "±" ++ show sigma ++ "BP" 233 | 234 | -- | Read uncalibrated radiocarbon dates from a file. The file should feature one radiocarbon date 235 | -- per line in the form "\,\,\", where 236 | -- \ is optional. A valid file could look like this: 237 | -- 238 | -- @ 239 | -- Sample1,5000,30 240 | -- 6000,50 241 | -- Sample3,4000,25 242 | -- @ 243 | -- 244 | readUncalC14FromFile :: FilePath -> IO [UncalC14] 245 | readUncalC14FromFile uncalFile = do 246 | s <- readFile uncalFile 247 | case P.runParser uncalC14SepByNewline () uncalFile s of 248 | Left err -> throwIO $ CurrycarbonCLIParsingException $ showParsecErr err 249 | Right x -> return x 250 | where 251 | uncalC14SepByNewline :: P.Parser [UncalC14] 252 | uncalC14SepByNewline = P.endBy parseUncalC14 (P.newline <* P.spaces) <* P.eof 253 | 254 | readUncalC14 :: String -> Either String [UncalC14] 255 | readUncalC14 s = 256 | case P.runParser uncalC14SepBySemicolon () s s of 257 | Left err -> Left $ showParsecErrOneLine err 258 | Right x -> Right x 259 | where 260 | uncalC14SepBySemicolon :: P.Parser [UncalC14] 261 | uncalC14SepBySemicolon = P.sepBy parseUncalC14 (P.char ';' <* P.spaces) <* P.eof 262 | 263 | parseUncalC14 :: P.Parser UncalC14 264 | parseUncalC14 = P.try record P.<|> P.try long P.<|> short 265 | where 266 | record = parseRecordType "uncalC14" $ P.try long P.<|> short 267 | long = do 268 | name <- parseArgument "id" parseAnyString 269 | age <- parseArgument "yearBP" parseWord 270 | sigma <- parseArgument "sigma" parseWord 271 | return (UncalC14 name age sigma) 272 | short = do 273 | age <- parseArgument "yearBP" parseWord 274 | sigma <- parseArgument "sigma" parseWord 275 | return (UncalC14 "" age sigma) 276 | 277 | -- CalC14 278 | renderCalC14s :: [CalC14] -> String 279 | renderCalC14s xs = 280 | "Calibrated high density ranges (HDR):\n" 281 | ++ intercalate "\n" (map renderCalC14 xs) 282 | 283 | renderCalC14 :: CalC14 -> String 284 | renderCalC14 (CalC14 _ rangeSummary hdrs68 hdrs95) = 285 | "Calibrated: " ++ renderCalRangeSummary rangeSummary ++ "\n" 286 | ++ "1-sigma: " ++ renderHDRs hdrs68 ++ "\n" 287 | ++ "2-sigma: " ++ renderHDRs hdrs95 288 | 289 | -- CalC14 - CalRangeSummary 290 | -- | Write 'CalRangeSummary's to the file system. The output file is a .tsv file with the following structure: 291 | -- 292 | -- @ 293 | -- id startTwoSigmaYearBCAD startOneSigmaYearBCAD medianYearBCAD stopOneSigmaYearBCAD stopTwoSigmaYearBCAD 294 | -- Sample1 -3941 -3894 -3773 -3709 -3655 295 | -- Sample3 -2572 -2566 -2527 -2472 -2467 296 | -- @ 297 | -- 298 | writeCalC14CalRangeSummaries :: FilePath -> [CalC14] -> IO () 299 | writeCalC14CalRangeSummaries path calC14s = writeFile path $ 300 | "id\tstartTwoSigmaYearBCAD\tstartOneSigmaYearBCAD\tmedianYearBCAD\tstopOneSigmaYearBCAD\tstopTwoSigmaYearBCAD\n" 301 | ++ intercalate "\n" (map renderCalC14CalRangeSummaryForFile calC14s) 302 | 303 | writeCalC14CalRangeSummary :: FilePath -> CalC14 -> IO () 304 | writeCalC14CalRangeSummary path calC14 = writeFile path $ 305 | "id\tstartTwoSigmaYearBCAD\tstartOneSigmaYearBCAD\tmedianYearBCAD\tstopOneSigmaYearBCAD\tstopTwoSigmaYearBCAD\n" 306 | ++ renderCalC14CalRangeSummaryForFile calC14 307 | 308 | appendCalC14CalRangeSummary :: FilePath -> CalC14 -> IO () 309 | appendCalC14CalRangeSummary path calC14 = 310 | appendFile path $ "\n" ++ renderCalC14CalRangeSummaryForFile calC14 311 | 312 | renderCalC14CalRangeSummaryForFile :: CalC14 -> String 313 | renderCalC14CalRangeSummaryForFile (CalC14 name (CalRangeSummary start2 start1 median stop1 stop2) _ _) = 314 | intercalate "\t" $ name:map show [start2,start1,median,stop1,stop2] 315 | 316 | -- CalRangeSummary 317 | renderCalRangeSummary :: CalRangeSummary -> String 318 | renderCalRangeSummary s = 319 | renderYearBCAD (_calRangeStartTwoSigma s) ++ " >> " 320 | ++ renderYearBCAD (_calRangeStartOneSigma s) ++ " > " 321 | ++ renderYearBCAD (_calRangeMedian s) ++ " < " 322 | ++ renderYearBCAD (_calRangeStopOneSigma s) ++ " << " 323 | ++ renderYearBCAD (_calRangeStopTwoSigma s) 324 | 325 | -- CalC14 - HDR 326 | -- | Write 'HDR's to the file system. The output file is a long .tsv file with the following structure: 327 | -- 328 | -- @ 329 | -- id hdrSigmaLevel hdrStartYearBCAD hdrStopYearBCAD 330 | -- Sample1 1 -3797 -3709 331 | -- Sample1 1 -3894 -3880 332 | -- Sample1 2 -3680 -3655 333 | -- Sample1 2 -3810 -3700 334 | -- Sample1 2 -3941 -3864 335 | -- Sample2 1 -1142 -1130 336 | -- Sample2 1 -1173 -1161 337 | -- Sample2 1 -1293 -1194 338 | -- Sample2 1 -1368 -1356 339 | -- Sample2 2 -1061 -1059 340 | -- Sample2 2 -1323 -1112 341 | -- Sample2 2 -1393 -1334 342 | -- @ 343 | -- 344 | writeCalC14HDRs :: FilePath -> [CalC14] -> IO () 345 | writeCalC14HDRs path calC14s = writeFile path $ 346 | "id\thdrSigmaLevel\thdrStartYearBCAD\thdrStopYearBCAD\n" 347 | ++ intercalate "\n" (map renderCalC14HDRForFile calC14s) 348 | 349 | writeCalC14HDR :: FilePath -> CalC14 -> IO () 350 | writeCalC14HDR path calC14 = writeFile path $ 351 | "id\thdrSigmaLevel\thdrStartYearBCAD\thdrStopYearBCAD\n" 352 | ++ renderCalC14HDRForFile calC14 353 | 354 | appendCalC14HDR :: FilePath -> CalC14 -> IO () 355 | appendCalC14HDR path calC14 = 356 | appendFile path $ "\n" ++ renderCalC14HDRForFile calC14 357 | 358 | renderCalC14HDRForFile :: CalC14 -> String 359 | renderCalC14HDRForFile (CalC14 name _ hdrs68 hdrs95) = 360 | intercalate "\n" $ 361 | map renderRow $ 362 | zip3 (repeat name) (repeat "1") (renderHDRsForFile hdrs68) ++ 363 | zip3 (repeat name) (repeat "2") (renderHDRsForFile hdrs95) 364 | where 365 | renderRow :: (String, String, (String, String)) -> String 366 | renderRow (a, b, (c, d)) = intercalate "\t" [a,b,c,d] 367 | 368 | -- BP 369 | renderYearBP :: YearBP -> String 370 | renderYearBP x = 371 | show x ++ "BP" -- ++ " (" ++ (renderYearBCAD $ bp2BCAD x) ++ ")" 372 | 373 | -- BCAD 374 | renderYearBCAD :: YearBCAD -> String 375 | renderYearBCAD x 376 | | x < 0 = show (-x) ++ "BC" 377 | | x >= 0 = show x ++ "AD" 378 | | otherwise = error $ "This should never happen: " ++ show x 379 | 380 | -- HDR for CLI output 381 | renderHDRsForFile :: [HDR] -> [(String, String)] 382 | renderHDRsForFile = map renderHDRForFile 383 | 384 | renderHDRForFile :: HDR -> (String, String) 385 | renderHDRForFile (HDR start stop) = (show start, show stop) 386 | 387 | renderHDRs :: [HDR] -> String 388 | renderHDRs xs = intercalate ", " (map renderHDR xs) 389 | 390 | renderHDR :: HDR -> String 391 | renderHDR (HDR start stop) 392 | | start < 0 && stop <= 0 = show (-start) ++ "-" ++ show (-stop) ++ "BC" 393 | | start < 0 && stop > 0 = show (-start) ++ "BC-" ++ show stop ++ "AD" 394 | | start >= 0 && stop >= 0 = show start ++ "-" ++ show stop ++ "AD" 395 | | otherwise = error $ "This should never happen: " ++ show start ++ "-" ++ show stop 396 | 397 | -- CalCurveMatrix 398 | writeCalCurveMatrix :: FilePath -> CalCurveMatrix -> IO () 399 | writeCalCurveMatrix path calCurveMatrix = 400 | writeFile path $ renderCalCurveMatrix calCurveMatrix 401 | 402 | renderCalCurveMatrix :: CalCurveMatrix -> String 403 | renderCalCurveMatrix (CalCurveMatrix uncals cals curveDensities) = 404 | let header = "\t" ++ intercalate "\t" (map show $ VU.toList cals) ++ "\n" 405 | body = zipWith makeRow (VU.toList uncals) (transpose $ V.toList (V.map VU.toList curveDensities)) 406 | in header ++ intercalate "\n" body 407 | where 408 | makeRow uncal dens = show uncal ++ "\t" ++ intercalate "\t" (map show dens) 409 | 410 | -- CalPDF 411 | -- | Write 'CalPDF's to the file system. The output file is a long .tsv file with the following structure: 412 | -- 413 | -- @ 414 | -- id yearBCAD density 415 | -- ... 416 | -- Sample1 -1391 2.8917924e-4 417 | -- Sample1 -1390 3.3285577e-4 418 | -- Sample1 -1389 3.5674628e-4 419 | -- Sample1 -1388 3.750703e-4 420 | -- ... 421 | -- Sample2 -3678 1.8128564e-3 422 | -- Sample2 -3677 1.9512239e-3 423 | -- Sample2 -3676 2.0227064e-3 424 | -- Sample2 -3675 2.095691e-3 425 | -- ... 426 | -- @ 427 | -- 428 | writeCalPDFs :: FilePath -> [CalPDF] -> IO () 429 | writeCalPDFs path calPDFs = 430 | writeFile path $ 431 | "id\tyearBCAD\tdensity\n" 432 | ++ renderCalPDFs calPDFs 433 | 434 | writeCalPDF :: FilePath -> CalPDF -> IO () 435 | writeCalPDF path calPDF = 436 | writeFile path $ 437 | "id\tyearBCAD\tdensity\n" 438 | ++ renderCalPDF calPDF 439 | 440 | appendCalPDF :: FilePath -> CalPDF -> IO () 441 | appendCalPDF path calPDF = 442 | appendFile path $ renderCalPDF calPDF 443 | 444 | renderCalPDFs :: [CalPDF] -> String 445 | renderCalPDFs = concatMap renderCalPDF 446 | 447 | renderCalPDF :: CalPDF -> String 448 | renderCalPDF (CalPDF name cals dens) = 449 | concatMap makeRow $ VU.toList $ VU.zip cals dens 450 | where 451 | makeRow (x,y) = name ++ "\t" ++ show x ++ "\t" ++ show y ++ "\n" 452 | 453 | -- cli plot 454 | data PlotSymbol = 455 | -- density histogram 456 | HistFill | HistTop | AxisEnd | AxisLine | AxisTick | HDRLine 457 | -- calcurve plot 458 | | CalCurve | BPLine | RibbonLine | YAxisLine | YAxisTick 459 | 460 | getSymbol :: Bool -> PlotSymbol -> Char 461 | -- density histogram 462 | getSymbol True HistFill = '*' 463 | getSymbol False HistFill = '▒' 464 | getSymbol True HistTop = '_' 465 | getSymbol False HistTop = '▁' 466 | getSymbol True AxisEnd = '+' 467 | getSymbol False AxisEnd = '┄' 468 | getSymbol True AxisLine = '-' 469 | getSymbol False AxisLine = '─' 470 | getSymbol True AxisTick = '|' 471 | getSymbol False AxisTick = '┬' 472 | getSymbol True HDRLine = '-' 473 | getSymbol False HDRLine = '─' 474 | -- calcurve plot 475 | getSymbol True CalCurve = '|' 476 | getSymbol False CalCurve = '┆' 477 | getSymbol True BPLine = '-' 478 | getSymbol False BPLine = '┅' 479 | getSymbol True RibbonLine = '-' 480 | getSymbol False RibbonLine = '┄' 481 | getSymbol True YAxisLine = '|' 482 | getSymbol False YAxisLine = '│' 483 | getSymbol True YAxisTick = '|' 484 | getSymbol False YAxisTick = '┤' 485 | 486 | splitEvery :: Int -> [a] -> [[a]] -- https://stackoverflow.com/a/8681226/3216883 487 | splitEvery _ [] = [] 488 | splitEvery n list = first : splitEvery n rest 489 | where (first,rest) = splitAt n list 490 | 491 | avg :: [Double] -> Double 492 | avg x = sum x / fromIntegral (length x) 493 | 494 | padString :: Int -> String -> String 495 | padString l x = replicate (l - length x) ' ' ++ x 496 | 497 | roundTo10 :: Int -> Int 498 | roundTo10 x = 499 | let (dec,rest) = quotRem (abs x) 10 500 | roundedDec = if rest >= 5 then dec + 1 else dec 501 | in roundedDec * 10 * signum x 502 | 503 | renderCLIPlotCalCurve :: Bool -> Int -> Int -> CalPDF -> NamedCalExpr -> String 504 | renderCLIPlotCalCurve 505 | ascii rows cols (CalPDF _ cals _) 506 | (NamedCalExpr _ (UnCalDate (UncalC14 _ yearBP sigma))) = 507 | let startYear = VU.head cals 508 | stopYear = VU.last cals 509 | -- prepare calcurve 510 | calcurvePrep = makeBCADCalCurve $ interpolateCalCurve intcal20 511 | calCurveSegment = punchOutCalCurveBCAD startYear stopYear calcurvePrep 512 | calCurveUncals = VU.map fromIntegral $ _calCurveBCADUnCals calCurveSegment 513 | calCurveUncalStart = bcad2BP $ round $ VU.head calCurveUncals 514 | calCurveUncalStop = bcad2BP $ round $ VU.last calCurveUncals 515 | yearsPerCol = case quot (VU.length calCurveUncals) cols of 516 | 0 -> 1 -- relevant for very short PDFs 517 | 1 -> 2 518 | q -> q 519 | meanUncalPerCol = map avg $ splitEvery yearsPerCol $ VU.toList calCurveUncals 520 | meanYearsPerCol = map rescale meanUncalPerCol 521 | -- rescaling setup for rendering to correct size 522 | minUncalYear = minimum meanUncalPerCol 523 | maxUncalYear = maximum meanUncalPerCol 524 | rescale = rescaleToRows minUncalYear maxUncalYear 525 | -- prepare static elements for uncal date 526 | uncalAgePlusSigma = rescale $ fromIntegral $ bp2BCAD (yearBP + sigma) 527 | uncalAge = rescale $ fromIntegral $ bp2BCAD yearBP 528 | uncalAgeMinusSigma = rescale $ fromIntegral $ bp2BCAD (yearBP - sigma) 529 | -- perform row-wise rendering 530 | renderYAxis = yAxis calCurveUncalStart calCurveUncalStop uncalAge 531 | renderRow = getLineSymbol uncalAgeMinusSigma uncalAge uncalAgePlusSigma 532 | plotRows = map (\r -> renderYAxis r ++ map (renderRow r) meanYearsPerCol) [0..rows] 533 | axisUnitLine = replicate 4 ' ' ++ "BP" 534 | in intercalate "\n" $ axisUnitLine:plotRows 535 | where 536 | yAxis :: Word -> Word -> Int -> Int -> String 537 | yAxis ysta ysto a x 538 | | a == x = makeTick yearBP 539 | | x == 0 = makeTick ysta 540 | | x == 8 = makeTick ysto 541 | | otherwise = replicate 6 ' ' ++ " " ++ getSymbol ascii YAxisLine : " " 542 | rescaleToRows :: Double -> Double -> Double -> Int 543 | rescaleToRows minVal maxVal x = 544 | let range = maxVal - minVal 545 | scaler = fromIntegral rows / range 546 | in (round . (*) scaler . subtract minVal) x 547 | getLineSymbol :: Int -> Int -> Int -> Int -> Int -> Char 548 | getLineSymbol ma a pa x y 549 | | x == y = getSymbol ascii CalCurve 550 | | a == x = getSymbol ascii BPLine 551 | | x == pa = getSymbol ascii RibbonLine 552 | | x == ma = getSymbol ascii RibbonLine 553 | | otherwise = ' ' 554 | makeTick :: (Integral n) => n -> String 555 | makeTick n = padString 6 (show $ roundTo10 $ fromIntegral n) ++ " " ++ getSymbol ascii YAxisTick : " " 556 | renderCLIPlotCalCurve _ _ _ _ _ = "" 557 | 558 | renderCLIPlotCalPDF :: Bool -> Int -> Int -> CalPDF -> CalC14 -> String 559 | renderCLIPlotCalPDF ascii rows cols (CalPDF _ cals dens) c14 = 560 | let startYear = VU.head cals 561 | stopYear = VU.last cals 562 | yearsPerCol = case quot (VU.length cals) cols of 563 | 0 -> 1 -- relevant for very short PDFs 564 | 1 -> 2 565 | q -> q 566 | -- last bin will often be shorter, which renders the whole plot slightly incorrect for the last column 567 | meanDensPerCol = calculateMeanDens yearsPerCol dens 568 | effectiveCols = length meanDensPerCol 569 | plotRows = map (replicate 9 ' ' ++) $ map (\x -> map (getHistSymbol x) meanDensPerCol) $ reverse [0..rows] 570 | xAxis = constructXAxis startYear stopYear effectiveCols yearsPerCol 571 | in intercalate "\n" plotRows ++ "\n" ++ xAxis 572 | where 573 | calculateMeanDens :: Int -> VU.Vector Double -> [Int] 574 | calculateMeanDens yearsPerCol dens_ = 575 | let scaling = fromIntegral rows 576 | meanDens = map (\x -> sum x / fromIntegral (length x)) $ splitEvery yearsPerCol $ VU.toList dens_ 577 | maxDens = maximum meanDens 578 | in map (\x -> round $ (x / maxDens) * scaling) meanDens 579 | getHistSymbol :: Int -> Int -> Char 580 | getHistSymbol x y 581 | | x == y = getSymbol ascii HistTop 582 | | x < y = getSymbol ascii HistFill 583 | | otherwise = ' ' 584 | constructXAxis :: Int -> Int -> Int -> Int -> String 585 | constructXAxis startYear stopYear effCols yearsPerCol = 586 | let startS = padString 6 (show $ roundTo10 startYear) 587 | stopS = show (roundTo10 stopYear) 588 | tickFreq = if abs (startYear - stopYear) < 1500 then 100 else 1000 589 | colStartYears = map (\a -> startYear + yearsPerCol * a) [0..(effCols - 1)] 590 | colStopYears = map (\b -> startYear + yearsPerCol * b - 1) [1..effCols] 591 | axis = zipWith (getAxisSymbol tickFreq) colStartYears colStopYears 592 | simpleRange = zipWith (getRangeSymbol (_calC14RangeSummary c14)) colStartYears colStopYears 593 | hdrOne = zipWith (getHDRSymbol (_calC14HDROneSigma c14)) colStartYears colStopYears 594 | hdrTwo = zipWith (getHDRSymbol (_calC14HDRTwoSigma c14)) colStartYears colStopYears 595 | in startS ++ (" " ++ [getSymbol ascii AxisEnd]) ++ axis ++ ([getSymbol ascii AxisEnd] ++ " ") ++ stopS ++ "\n" ++ 596 | replicate 4 ' ' ++ getADBC startYear ++ " " ++ simpleRange ++ " " ++ getADBC stopYear ++ "\n" ++ 597 | replicate 9 ' ' ++ hdrOne ++ "\n" ++ 598 | replicate 9 ' ' ++ hdrTwo 599 | where 600 | getAxisSymbol :: Int -> Int -> Int -> Char 601 | getAxisSymbol tickFreq colStartYear colStopYear 602 | | any (\x -> rem x tickFreq == 0) [colStartYear..colStopYear] = getSymbol ascii AxisTick 603 | | otherwise = getSymbol ascii AxisLine 604 | getRangeSymbol :: CalRangeSummary -> Int -> Int -> Char 605 | getRangeSymbol range colStartYear colStopYear 606 | | colStartYear <= _calRangeMedian range && colStopYear >= _calRangeMedian range = '^' 607 | | colStartYear <= _calRangeStartOneSigma range && colStopYear >= _calRangeStartOneSigma range = '>' 608 | | colStartYear <= _calRangeStopOneSigma range && colStopYear >= _calRangeStopOneSigma range = '<' 609 | | colStartYear <= _calRangeStartTwoSigma range && colStopYear >= _calRangeStartTwoSigma range = '>' 610 | | colStartYear <= _calRangeStopTwoSigma range && colStopYear >= _calRangeStopTwoSigma range = '<' 611 | | otherwise = ' ' 612 | getHDRSymbol :: [HDR] -> Int -> Int -> Char 613 | getHDRSymbol hdr colStartYear colStopYear 614 | | any (doesOverlap colStartYear colStopYear) hdr = getSymbol ascii HDRLine 615 | | otherwise = ' ' 616 | where 617 | doesOverlap :: Int -> Int -> HDR -> Bool 618 | doesOverlap a b h = 619 | let ha = _hdrstart h; hb = _hdrstop h 620 | in (a >= ha && a <= hb) || (b >= ha && b <= hb) || (a <= ha && b >= hb) 621 | getADBC :: Int -> String 622 | getADBC y 623 | | y < 0 = "BC" 624 | | otherwise = "AD" 625 | 626 | -- CalCurve 627 | writeCalCurve :: FilePath -> CalCurveBCAD -> IO () 628 | writeCalCurve path calCurve = 629 | writeFile path $ renderCalCurve calCurve 630 | 631 | renderCalCurve :: CalCurveBCAD -> String 632 | renderCalCurve (CalCurveBCAD cals uncals sigmas) = 633 | let header = "calYearBCAD\tuncalYearBCAD\tsigma\n" 634 | body = map makeRow $ VU.toList $ VU.zip3 cals uncals sigmas 635 | in header ++ intercalate "\n" body 636 | where 637 | makeRow (x,y,z) = show x ++ "\t" ++ show y ++ "\t" ++ show z 638 | 639 | -- RandomAgeSamples 640 | -- | Write 'RandomAgeSamples's to the file system. The output file is a long .tsv file with the following structure: 641 | -- 642 | -- @ 643 | -- id yearBCAD 644 | -- ... 645 | -- Sample1 -1221 646 | -- Sample1 -1211 647 | -- Sample1 -1230 648 | -- Sample1 -1225 649 | -- ... 650 | -- Sample2 -3763 651 | -- Sample2 -3788 652 | -- Sample2 -3767 653 | -- Sample2 -3774 654 | -- ... 655 | -- @ 656 | -- 657 | writeRandomAgeSamples :: FilePath -> [RandomAgeSample] -> IO () 658 | writeRandomAgeSamples path calPDFs = 659 | writeFile path $ 660 | "id\tyearBCAD\n" 661 | ++ renderRandomAgeSamples calPDFs 662 | 663 | writeRandomAgeSample :: FilePath -> RandomAgeSample -> IO () 664 | writeRandomAgeSample path calPDF = 665 | writeFile path $ 666 | "id\tyearBCAD\n" 667 | ++ renderRandomAgeSample calPDF 668 | 669 | appendRandomAgeSample :: FilePath -> RandomAgeSample -> IO () 670 | appendRandomAgeSample path calPDF = 671 | appendFile path $ renderRandomAgeSample calPDF 672 | 673 | renderRandomAgeSamples :: [RandomAgeSample] -> String 674 | renderRandomAgeSamples = concatMap renderRandomAgeSample 675 | 676 | renderRandomAgeSample :: RandomAgeSample -> String 677 | renderRandomAgeSample (RandomAgeSample name samples) = 678 | concatMap makeRow $ VU.toList samples 679 | where 680 | makeRow x = name ++ "\t" ++ show x ++ "\n" 681 | --------------------------------------------------------------------------------