├── .github ├── .gitignore └── workflows │ └── check-standard.yaml ├── revdep ├── failures.md ├── problems.md ├── .gitignore ├── cran.md └── README.md ├── inst ├── extdata │ ├── obdp │ │ └── start_time_trace.p │ ├── graphs │ │ ├── plotHiSSE_df.rds │ │ ├── plotMuSSE_df.rds │ │ ├── plotPopSizes.rds │ │ ├── plotTrace_df.rds │ │ ├── plotTree_df.rds │ │ ├── plotDivRates_df.rds │ │ ├── plotFBDTree_df.rds │ │ ├── geomStepRibbon_df.rds │ │ ├── plotAncStatesMAP_df.rds │ │ ├── plotAncStatesPie_df.rds │ │ ├── plotDiversityOBDP_df.rds │ │ ├── plotPostPredStats_df.rds │ │ └── plotMassExtinctions_df.rds │ ├── pop_size │ │ ├── horses_constant_popsizes_mini.p │ │ ├── horses_CPP_times_mini.p │ │ ├── horses_CPP_popsizes_mini.p │ │ ├── horses_GMRF_times_mini.p │ │ └── horses_GMRF_popsizes_mini.p │ ├── PPS │ │ ├── empirical_data_pps_example.csv │ │ └── simulated_data_pps_mini.csv │ ├── epi_bd │ │ ├── primates_EBD_extinction_times_mini.p │ │ ├── primates_EBD_speciation_times_mini.p │ │ ├── primates_EBD_speciation_rates_mini.p │ │ └── primates_EBD_extinction_rates_mini.p │ ├── sse │ │ └── primates_BiSSE_activity_period_mini.p │ ├── dec │ │ └── small_dec.tre │ ├── fbd │ │ └── bears.mcc.tre │ └── sub_models │ │ └── primates_cytb_GTR_MAP.tre └── hex_sticker.png ├── tests ├── testthat.R └── testthat │ ├── test_colFun.R │ ├── test_setMRFGlobalScaleHyperpriorNShifts.R │ ├── test_matchNodes.R │ ├── test_getMAP.R │ ├── test_removeBurnin.R │ ├── test_simulateMRF.R │ ├── test_processSSE.R │ ├── test_posteriorSamplesToParametricPrior.R │ ├── test_processPostPredStats.R │ ├── test_plotMuSSE.R │ ├── test_plotHiSSE.R │ ├── test_readOBDP.R │ ├── test_processBranchData.R │ ├── test_geomStepRibbon.R │ ├── test_processAncStates.R │ ├── test_plotTree.R │ ├── test_plotTrace.R │ ├── test_plotFBDTree.R │ ├── test_dropTip.R │ ├── test_plotPostPredStats.R │ ├── test_readTrace.R │ ├── test_readTrees.R │ ├── test_summarizeTrace.R │ ├── test_plotDiversityOBDP.R │ ├── test_calculateShiftBayesFactor.R │ ├── test_densiTreeWithBranchData.R │ ├── test_processDivRates.R │ ├── test_plotMassExtinctions.R │ ├── test_rerootPhylo.R │ ├── test_plotAncStatesMAP.R │ ├── test_plotDivRates.R │ ├── test_plotAncStatesPie.R │ ├── test_plotPopSizes.R │ └── test_processPopSizes.R ├── CRAN-SUBMISSION ├── .Rbuildignore ├── .gitignore ├── man ├── RevGadgets.Rd ├── colFun.Rd ├── matchNodes.Rd ├── dropTip.Rd ├── plotHiSSE.Rd ├── getMAP.Rd ├── plotMuSSE.Rd ├── removeBurnin.Rd ├── processPostPredStats.Rd ├── processSSE.Rd ├── rerootPhylo.Rd ├── processAncStates.Rd ├── plotPopSizes.Rd ├── combineTraces.Rd ├── simulateMRF.Rd ├── setMRFGlobalScaleHyperpriorNShifts.Rd ├── processBranchData.Rd ├── plotMassExtinctions.Rd ├── readOBDP.Rd ├── readTrees.Rd ├── readTrace.Rd ├── posteriorSamplesToParametricPrior.Rd ├── calculateShiftBayesFactor.Rd ├── plotPostPredStats.Rd ├── processPopSizes.Rd ├── summarizeTrace.Rd ├── plotDivRates.Rd ├── geom_stepribbon.Rd ├── plotTrace.Rd ├── processDivRates.Rd └── plotDiversityOBDP.Rd ├── R ├── RevGadgets.R ├── global.R ├── getMAP.R ├── plotHiSSE.R ├── plotMuSSE.R ├── matchNodes.R ├── dropTip.R ├── removeBurnin.R ├── processAncStates.R ├── setMRFGlobalScaleHyperpriorNShifts.R ├── processPostPredStats.R ├── colFun.R ├── simulateMRF.R ├── plotPopSizes.R ├── geomStepRibbon.R ├── processSSE.R ├── combineTrace.R ├── processBranchData.R └── posteriorSamplesToParametricPrior.R ├── cran-comments.md ├── NEWS.md ├── DESCRIPTION ├── NAMESPACE └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /inst/extdata/obdp/start_time_trace.p: -------------------------------------------------------------------------------- 1 | Start ages 2 | [ 59.422, 58.622, 58.491 ] 3 | -------------------------------------------------------------------------------- /inst/hex_sticker.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/hex_sticker.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(RevGadgets) 3 | 4 | test_check("RevGadgets") 5 | -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 1.2.1 2 | Date: 2023-11-29 20:17:24 UTC 3 | SHA: 984989a07708c02f30f0f28ac5c8b69f09ee343e -------------------------------------------------------------------------------- /inst/extdata/graphs/plotHiSSE_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotHiSSE_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotMuSSE_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotMuSSE_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotPopSizes.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotPopSizes.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotTrace_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotTrace_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotTree_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotTree_df.rds -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /inst/extdata/graphs/plotDivRates_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotDivRates_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotFBDTree_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotFBDTree_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/geomStepRibbon_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/geomStepRibbon_df.rds -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.github$ 4 | ^cran-comments\.md$ 5 | ^CRAN-RELEASE$ 6 | ^CRAN-SUBMISSION$ 7 | ^revdep$ 8 | -------------------------------------------------------------------------------- /inst/extdata/graphs/plotAncStatesMAP_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotAncStatesMAP_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotAncStatesPie_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotAncStatesPie_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotDiversityOBDP_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotDiversityOBDP_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotPostPredStats_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotPostPredStats_df.rds -------------------------------------------------------------------------------- /inst/extdata/graphs/plotMassExtinctions_df.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/revbayes/RevGadgets/HEAD/inst/extdata/graphs/plotMassExtinctions_df.rds -------------------------------------------------------------------------------- /tests/testthat/test_colFun.R: -------------------------------------------------------------------------------- 1 | context("Tests colFun()") 2 | 3 | test_that("colFun() doesn't error out", { 4 | expect_error(colFun(1), NA) 5 | }) 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.Rproj 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | .Ruserdata 6 | .DS_Store 7 | # mac files 8 | .DS_Store 9 | ._* 10 | 11 | # plot file 12 | tests/testthat/Rplots.pdf 13 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 1 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /man/RevGadgets.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RevGadgets.R 3 | \docType{package} 4 | \name{RevGadgets} 5 | \alias{RevGadgets} 6 | \title{RevGadgets} 7 | \description{ 8 | This package provides functions to process and plot the output of RevBayes 9 | analyses. 10 | } 11 | -------------------------------------------------------------------------------- /tests/testthat/test_setMRFGlobalScaleHyperpriorNShifts.R: -------------------------------------------------------------------------------- 1 | context("Tests setting of MRF hyperpriors") 2 | 3 | test_that("MRF settings match known values", { 4 | expect_equal(0.002093737, 5 | setMRFGlobalScaleHyperpriorNShifts(100, "HSMRF")) 6 | expect_equal(0.009376335, 7 | setMRFGlobalScaleHyperpriorNShifts(100, "GMRF")) 8 | }) 9 | -------------------------------------------------------------------------------- /tests/testthat/test_matchNodes.R: -------------------------------------------------------------------------------- 1 | context("Tests matchNodes function") 2 | 3 | test_that("compare node map from documentation example", { 4 | treefile <- 5 | system.file("extdata", "bds/primates.tre", package = "RevGadgets") 6 | tree <- readTrees(treefile) 7 | map <- matchNodes(tree[[1]][[1]]@phylo) 8 | 9 | expect_equal(class(map), "data.frame") 10 | expect_equal(dim(map), c(465, 2)) 11 | expect_equal(map[1, 1], 1) 12 | expect_equal(map[1, 2], 233) 13 | }) 14 | -------------------------------------------------------------------------------- /R/RevGadgets.R: -------------------------------------------------------------------------------- 1 | #' RevGadgets 2 | #' 3 | #' This package provides functions to process and plot the output of RevBayes 4 | #' analyses. 5 | #' 6 | #' @importFrom grDevices col2rgb 7 | #' @importFrom graphics axis par plot.new plot.window strwidth text 8 | #' @importFrom stats approxfun density na.omit optimize pnorm qcauchy quantile 9 | #' rcauchy rnorm time 10 | #' @importFrom utils read.csv read.table setTxtProgressBar txtProgressBar 11 | #' 12 | #' @docType package 13 | #' @name RevGadgets 14 | NULL 15 | -------------------------------------------------------------------------------- /tests/testthat/test_getMAP.R: -------------------------------------------------------------------------------- 1 | context("Tests getMAP() function for traces") 2 | 3 | test_that("compare getMAP() for example from documentation", { 4 | # read in and process example data 5 | file <- system.file("extdata", 6 | "sub_models/primates_cytb_GTR_mini.p", 7 | package = "RevGadgets") 8 | trace <- readTrace(paths = file) 9 | 10 | #some error is to be expected given the function, so round to 3 digits 11 | expect_equal(0.26, round(getMAP(trace[[1]]$"pi[1]"), digits = 2)) 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test_removeBurnin.R: -------------------------------------------------------------------------------- 1 | context("tests the removeBurnin function") 2 | 3 | test_that("removes burnin", { 4 | # load in the trace file 5 | file <- system.file("extdata", 6 | "sub_models/primates_cytb_GTR_mini.p", 7 | package = "RevGadgets") 8 | 9 | one_trace <- readTrace(paths = file, burnin = 0) 10 | 11 | one_trace_burnin <- removeBurnin(trace = one_trace, burnin = 0.1) 12 | 13 | #check the new length of the trace 14 | expect_equal(dim(one_trace_burnin[[1]])[1], 9) 15 | 16 | }) 17 | -------------------------------------------------------------------------------- /inst/extdata/pop_size/horses_constant_popsizes_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Replicate_ID Posterior Likelihood Prior pop_size 2 | 0 0 -27295.63 -26802.57 -493.0608 319708 3 | 1 1 -27291.2 -26795.64 -495.5592 270671.5 4 | 2 0 -27295.8 -26800.96 -494.8372 317736 5 | 3 1 -27298.12 -26798.12 -500.0036 294283.7 6 | 4 0 -27311.41 -26810.52 -500.8865 357159.6 7 | 5 1 -27295.8 -26800.01 -495.7901 299880.6 8 | 6 0 -27288.52 -26792.1 -496.4209 313240.8 9 | 7 1 -27295.96 -26793.17 -502.7868 275489.5 10 | 8 0 -27291.87 -26794.01 -497.861 357034.3 11 | 9 1 -27303.53 -26804.28 -499.2486 270212.1 12 | 10 0 -27298.59 -26804 -494.583 363124.1 13 | -------------------------------------------------------------------------------- /man/colFun.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colFun.R 3 | \name{colFun} 4 | \alias{colFun} 5 | \title{Color Function} 6 | \usage{ 7 | colFun(n) 8 | } 9 | \arguments{ 10 | \item{n}{(integer; no default) Number of colors to return. Maximum of 12.} 11 | } 12 | \value{ 13 | Character vector of color hex codes. 14 | } 15 | \description{ 16 | Produce default RevGadgets colors 17 | } 18 | \details{ 19 | Produces a vector of colors from the default RevGadgets colors 20 | of length given by n, maximum of 12 colors. 21 | } 22 | \examples{ 23 | 24 | my_colors <- colFun(2) 25 | 26 | } 27 | -------------------------------------------------------------------------------- /tests/testthat/test_simulateMRF.R: -------------------------------------------------------------------------------- 1 | context("Tests simulation of MRF") 2 | 3 | test_that("MRF simulation matches", { 4 | set.seed(42) 5 | x <- 6 | simulateMRF( 7 | n_episodes = 100, 8 | model = "HSMRF", 9 | global_scale_hyperprior = 0.0021 10 | ) 11 | expect_equal(1.0351365237, mean(x)) 12 | expect_equal(1.0628421716, median(x)) 13 | expect_equal(1.0, x[1]) 14 | expect_equal(0.8160889846, x[100]) 15 | expect_equal(0.9739524255, sum(abs(x[-1] - x[-100]))) 16 | expect_equal(0.3520475309, max(x) - min(x)) 17 | expect_equal(99, which.min(x)) 18 | expect_equal(42, which.max(x)) 19 | }) 20 | -------------------------------------------------------------------------------- /man/matchNodes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/matchNodes.R 3 | \name{matchNodes} 4 | \alias{matchNodes} 5 | \title{match Nodes} 6 | \usage{ 7 | matchNodes(phy) 8 | } 9 | \arguments{ 10 | \item{phy}{(tree in ape format; no default) Tree on which to match nodes} 11 | } 12 | \value{ 13 | a data frame that translates ape node numbers to RevBayes node 14 | numbers 15 | } 16 | \description{ 17 | match Nodes 18 | } 19 | \examples{ 20 | 21 | treefile <- system.file("extdata", "bds/primates.tre", package="RevGadgets") 22 | tree <- readTrees(treefile) 23 | map <- matchNodes(tree[[1]][[1]]@phylo) 24 | 25 | } 26 | -------------------------------------------------------------------------------- /tests/testthat/test_processSSE.R: -------------------------------------------------------------------------------- 1 | context("tests the processSSE function") 2 | 3 | test_that("processes SSE traces", { 4 | 5 | # read in and process file 6 | bisse_file <- system.file("extdata", 7 | "sse/primates_BiSSE_activity_period_mini.p", 8 | package="RevGadgets") 9 | pdata <- processSSE(bisse_file) 10 | 11 | # test file format 12 | expect_equal(class(pdata), "data.frame") 13 | 14 | # check data 15 | expect_equal(ncol(pdata), 6) 16 | expect_equal(colnames(pdata), c("value", "rate", "hidden_state", "label", 17 | "observed_state", "Iteration" )) 18 | 19 | }) 20 | -------------------------------------------------------------------------------- /tests/testthat/test_posteriorSamplesToParametricPrior.R: -------------------------------------------------------------------------------- 1 | context("Tests simulation of MRF") 2 | 3 | test_that("MRF simulation matches", { 4 | set.seed(47) 5 | gp <- 6 | posteriorSamplesToParametricPrior(rgamma(1e4, 1, 2), "gamma", 2.0) 7 | np <- 8 | posteriorSamplesToParametricPrior(rnorm(1e4, -2, 3), "normal", 2.0) 9 | 10 | gp.ref <- c(0.4771022693, 0.9396894192) 11 | names(gp.ref) <- c("gamma.shape", "gamma.rate") 12 | np.ref <- c(-1.9965172801, 4.1974666979) 13 | names(np.ref) <- c("normal.mean", "normal.sd") 14 | 15 | expect_equal(gp.ref[1], gp[1]) 16 | expect_equal(gp.ref[2], gp[2]) 17 | 18 | expect_equal(np.ref[1], np[1]) 19 | expect_equal(np.ref[2], np[2]) 20 | }) 21 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Release summary 2 | This is a patch release to adjust tests that were failing on development R after 3 | changes to the scales package. 4 | 5 | ## Test environments 6 | Tested via GitHub actions on the following platforms (and R versions): 7 | 8 | * macOS-latest (release R) 9 | * windows-latest (release R) 10 | * ubuntu-latest (release R) 11 | * ubuntu-latest (devel R) 12 | 13 | Tested locally on OS X v. 13.3, R v. 4.3.1 14 | 15 | ## R CMD check results 16 | 17 | 0 errors | 0 warnings | 0 notes 18 | 19 | ## revdepcheck results 20 | 21 | We checked 1 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 22 | 23 | * We saw 0 new problems 24 | * We failed to check 0 packages 25 | -------------------------------------------------------------------------------- /tests/testthat/test_processPostPredStats.R: -------------------------------------------------------------------------------- 1 | context("Tests processPostPredStats function") 2 | 3 | test_that("compare processed output from documentation example", { 4 | file_sim <- system.file("extdata", 5 | "PPS/simulated_data_pps_mini.csv", 6 | package = "RevGadgets") 7 | file_emp <- system.file("extdata", 8 | "PPS/empirical_data_pps_example.csv", 9 | package = "RevGadgets") 10 | t <- processPostPredStats(path_sim = file_sim, 11 | path_emp = file_emp) 12 | 13 | expect_equal(class(t), "list") 14 | expect_equal(length(t), 2) 15 | expect_equal(names(t), c("simulated", "observed")) 16 | 17 | }) 18 | -------------------------------------------------------------------------------- /tests/testthat/test_plotMuSSE.R: -------------------------------------------------------------------------------- 1 | context("tests the plotMuSSE function") 2 | 3 | test_that("plot MuSSE", { 4 | # read in and process file 5 | bisse_file <- 6 | system.file("extdata", 7 | "sse/primates_BiSSE_activity_period_mini.p", 8 | package = "RevGadgets") 9 | pdata <- processSSE(bisse_file, burnin = 0) 10 | plot_new <- plotMuSSE(pdata) 11 | 12 | plot_file <- 13 | system.file("extdata", "graphs/plotMuSSE_df.rds", package = "RevGadgets") 14 | plot_orig <- readRDS(plot_file) 15 | 16 | tmp <- tempdir() 17 | pdf(paste0(tmp,"/Rplots.pdf")) 18 | # test for errors in plot_new 19 | expect_error(print(plot_new), NA) 20 | dev.off() 21 | 22 | # compare plot data objects 23 | expect_equal(plot_new$data, plot_orig) 24 | 25 | }) 26 | -------------------------------------------------------------------------------- /tests/testthat/test_plotHiSSE.R: -------------------------------------------------------------------------------- 1 | context("tests the plotHiSSE function") 2 | 3 | test_that("plot HiSSE", { 4 | # read in and process file 5 | hisse_file <- 6 | system.file("extdata", 7 | "sse/primates_HiSSE_2_mini.p", 8 | package = "RevGadgets") 9 | pdata <- processSSE(hisse_file, burnin = 0) 10 | plot_new <- plotHiSSE(pdata) 11 | 12 | plot_file <- 13 | system.file("extdata", 14 | "graphs/plotHiSSE_df.rds", 15 | package = "RevGadgets") 16 | plot_orig <- readRDS(plot_file) 17 | 18 | tmp <- tempdir() 19 | pdf(paste0(tmp,"/Rplots.pdf")) 20 | # test for errors in plot_new 21 | expect_error(print(plot_new), NA) 22 | dev.off() 23 | 24 | # compare plot data objects 25 | expect_equal(plot_new$data, plot_orig) 26 | 27 | }) 28 | -------------------------------------------------------------------------------- /inst/extdata/pop_size/horses_CPP_times_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Replicate_ID Posterior Likelihood Prior interval_times[1] interval_times[2] interval_times[3] interval_times[4] 2 | 0 0 -27416.72 -26789.2 -627.5243 6640.32 328448 5391.97 341593 3 | 1 1 -27623.81 -26794.64 -829.1711 439918 481920 331374 499632 324370 461567 258253 418396 306054 439246 4 | 2 0 -27363.77 -26794.78 -568.9939 330239 376741 5 | 3 1 -27326.28 -26800.8 -525.4761 6 | 4 0 -27389.44 -26792.64 -596.7936 269861 368438 342463 7 | 5 1 -27345.25 -26804.4 -540.8486 421404 8 | 6 0 -27487.12 -26793.37 -693.7547 459061 466634 330019 445370 450246 360630 9 | 7 1 -27417.69 -26806.43 -611.2526 247611 236086 263610 10 | 8 0 -27370.49 -26793.26 -577.2322 299531 375243 11 | 9 1 -27490.4 -26800.36 -690.0313 362424 420972 442642 403442 378284 138025 12 | 10 0 -27339.91 -26799.73 -540.1776 414116 13 | -------------------------------------------------------------------------------- /tests/testthat/test_readOBDP.R: -------------------------------------------------------------------------------- 1 | context("tests the readOBDP function") 2 | test_that("read and format OBDP outputs", { 3 | start_time_trace_file <- 4 | system.file("extdata", "obdp/start_time_trace.p", package="RevGadgets") 5 | popSize_distribution_matrices_file <- 6 | system.file("extdata", "obdp/Kt_trace.p", package="RevGadgets") 7 | trees_trace_file <- 8 | system.file("extdata", "obdp/mcmc_OBDP_trees.p", package="RevGadgets") 9 | 10 | capture.output(Kt_mean <- readOBDP( start_time_trace_file=start_time_trace_file, 11 | popSize_distribution_matrices_file=popSize_distribution_matrices_file, 12 | trees_trace_file=trees_trace_file )) 13 | 14 | expect_equal(length(Kt_mean), 96) 15 | expect_equal(class(Kt_mean), "data.frame") 16 | expect_equal(nrow(Kt_mean), 100) 17 | 18 | }) 19 | -------------------------------------------------------------------------------- /tests/testthat/test_processBranchData.R: -------------------------------------------------------------------------------- 1 | context("Tests processBranchData function") 2 | 3 | test_that("compare annotated tree from documentation example", { 4 | treefile <- 5 | system.file("extdata", "bds/primates.tre", package = "RevGadgets") 6 | logfile <- 7 | system.file("extdata", "bds/primates_BDS_rates_truncated.p", package = 8 | "RevGadgets") 9 | 10 | branch_data <- readTrace(logfile)[[1]] 11 | tree <- readTrees(paths = treefile)[[1]][[1]] 12 | 13 | annotated_tree <- 14 | processBranchData(tree, branch_data, summary = "median") 15 | 16 | expect_equal(class(annotated_tree), "list") 17 | expect_equal(length(annotated_tree), 1) 18 | expect_equal(class(annotated_tree[[1]]), "list") 19 | expect_equal(length(annotated_tree[[1]]), 1) 20 | expect_equal(class(annotated_tree[[1]][[1]])[1], "treedata") 21 | expect_equal(class(annotated_tree[[1]][[1]]@phylo), "phylo") 22 | 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test_geomStepRibbon.R: -------------------------------------------------------------------------------- 1 | context("tests the geomStepRibbon function") 2 | 3 | test_that("geomStepRibbon example works", { 4 | 5 | # make new plot 6 | huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) 7 | plot_new <- ggplot2::ggplot(huron, ggplot2::aes(year)) + 8 | geom_stepribbon(ggplot2::aes(ymin = level - 1, ymax = level + 1), 9 | fill = "grey70") + 10 | ggplot2::geom_step(ggplot2::aes(y = level)) 11 | 12 | # read in old saved version 13 | plot_file <- system.file("extdata", 14 | "graphs/geomStepRibbon_df.rds", 15 | package = "RevGadgets") 16 | plot_orig <- readRDS(plot_file) 17 | 18 | tmp <- tempdir() 19 | pdf(paste0(tmp,"/Rplots.pdf")) 20 | 21 | # test for errors in plot_new 22 | expect_error(print(plot_new), NA) 23 | 24 | # compare plot data objects 25 | expect_equal(plot_new$data, plot_orig) 26 | 27 | dev.off() 28 | }) 29 | 30 | -------------------------------------------------------------------------------- /R/global.R: -------------------------------------------------------------------------------- 1 | # define variables used within gg expressions 2 | # https://community.rstudio.com/t/how-to-solve-no-visible-binding-for-global-variable-note/28887 3 | utils::globalVariables(c("anc_state_1", "anc_state_1_pp", "anc_state_2", 4 | "anc_state_3","anc_state_other", "bf", 5 | "clado_node_color_as", "clado_node_shape_as", 6 | "clado_node_size_as", "end_state_1", "end_state_1_pp", 7 | "end_state_2", "end_state_3", "end_state_other", 8 | "extant", "isTip", "isTip.x", "item", "kula", "label", 9 | "lower", "node_id", "observed_state", "olena", 10 | "posterior", "Probability", "rate.name", 11 | "start_state_1", "start_state_1_pp", "start_state_2", 12 | "start_state_3", "State", "upper", "value", "Variable", 13 | "vx", "vy", "x", "y", ".")) 14 | -------------------------------------------------------------------------------- /tests/testthat/test_processAncStates.R: -------------------------------------------------------------------------------- 1 | context("tests the processAncStates function") 2 | 3 | test_that("processes ancestral states scripts", { 4 | # read in and process file 5 | file <- 6 | system.file("extdata", 7 | "comp_method_disc/ase_freeK.tree", 8 | package = "RevGadgets") 9 | example <- processAncStates(file, 10 | state_labels = c("1" = "Awesome", 11 | "2" = "Beautiful", 12 | "3" = "Cool!")) 13 | # test file format 14 | expect_equal(class(example)[1], "treedata") 15 | 16 | # check tree 17 | expect_equal(example@phylo$Nnode, 341) 18 | expect_equal(example@phylo$tip.label[1], "Vulpes_macrotis") 19 | 20 | # check data 21 | expect_equal(class(example@data), c("tbl_df", "tbl", "data.frame")) 22 | expect_equal(names(table(example@data$anc_state_1)), 23 | c("Awesome", "Beautiful", "Cool!")) 24 | 25 | }) 26 | -------------------------------------------------------------------------------- /tests/testthat/test_plotTree.R: -------------------------------------------------------------------------------- 1 | context("tests the plotTree function") 2 | 3 | test_that("plot basic, not-yet-rooted phylogeny", { 4 | # load in the trace file 5 | file_1 <- system.file("extdata", 6 | "sub_models/primates_cytb_GTR_MAP.tre", 7 | package = "RevGadgets") 8 | tree <- readTrees(paths = file_1) 9 | # produce the plot pi parameters object 10 | plot_new <- plotTree(tree = tree, node_labels = "posterior") 11 | #print(plot_new) 12 | # load the saved plot for comparison 13 | file_2 <- system.file("extdata", 14 | "graphs/plotTree_df.rds", 15 | package = "RevGadgets") 16 | plot_orig <- readRDS(file_2) # loads an object called 'plot' 17 | 18 | tmp <- tempdir() 19 | pdf(paste0(tmp,"/Rplots.pdf")) 20 | 21 | # test for errors in plot_new 22 | expect_error(print(plot_new), NA) 23 | 24 | # compare plot data objects 25 | expect_equal(plot_new$data, plot_orig) 26 | 27 | dev.off() 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test_plotTrace.R: -------------------------------------------------------------------------------- 1 | context("tests the plotTrace function") 2 | 3 | test_that("plot pi traces", { 4 | # load in the trace file 5 | file_1 <- system.file("extdata", 6 | "sub_models/primates_cytb_GTR_mini.p", 7 | package = "RevGadgets") 8 | one_trace <- readTrace(path = file_1, burnin = 0) 9 | # produce the plot pi parameters object 10 | plot_new <- plotTrace(trace = one_trace, 11 | vars = c("pi[1]", "pi[2]", "pi[3]", "pi[4]"))[[1]] 12 | # load the saved plot for comparison 13 | plot_file <- system.file("extdata", 14 | "graphs/plotTrace_df.rds", 15 | package = "RevGadgets") 16 | #read in original plot 17 | plot_orig <- readRDS(plot_file) 18 | 19 | tmp <- tempdir() 20 | pdf(paste0(tmp,"/Rplots.pdf")) 21 | # test for errors in plot_new 22 | expect_error(print(plot_new), NA) 23 | dev.off() 24 | 25 | # compare plot data objects 26 | expect_equal(plot_new$data, plot_orig) 27 | 28 | }) 29 | -------------------------------------------------------------------------------- /inst/extdata/pop_size/horses_CPP_popsizes_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Replicate_ID Posterior Likelihood Prior population_size[1] population_size[2] population_size[3] population_size[4] population_size[5] 2 | 0 0 -27416.72 -26789.2 -627.5243 1.06816e+06 502725 8.74296e+07 2.19279e+07 6.97812e+07 3 | 1 1 -27623.81 -26794.64 -829.1711 422350 1.83437e+06 6.85158e+07 5.81411e+07 2.94419e+07 9.40817e+07 9.70649e+07 6.32732e+07 6.0044e+07 7.09645e+07 5.03165e+07 4 | 2 0 -27363.77 -26794.78 -568.9939 526859 1.65008e+07 8.83514e+07 5 | 3 1 -27326.28 -26800.8 -525.4761 777607 6 | 4 0 -27389.44 -26792.64 -596.7936 326794 7.11307e+07 9.64289e+07 1.88354e+07 7 | 5 1 -27345.25 -26804.4 -540.8486 511757 9.0328e+07 8 | 6 0 -27487.12 -26793.37 -693.7547 557899 3.29181e+06 2.51307e+07 2.1774e+07 6.27178e+07 9.19468e+07 7.36723e+07 9 | 7 1 -27417.69 -26806.43 -611.2526 563358 3.61497e+06 7.35408e+07 2.34853e+07 10 | 8 0 -27370.49 -26793.26 -577.2322 513859 363524 1.33221e+07 11 | 9 1 -27490.4 -26800.36 -690.0313 426920 9.12489e+07 5.41227e+07 8.34142e+07 9.62909e+06 4.07307e+07 473909 12 | 10 0 -27339.91 -26799.73 -540.1776 499807 3.09123e+07 13 | -------------------------------------------------------------------------------- /tests/testthat/test_plotFBDTree.R: -------------------------------------------------------------------------------- 1 | context("tests the plotFBDTree function") 2 | 3 | test_that("plots FBD tree", { 4 | # get files 5 | tree_file <- 6 | system.file("extdata", "fbd/bears.mcc.tre", package = "RevGadgets") 7 | plot_file <- 8 | system.file("extdata", "graphs/plotFBDTree_df.rds", package = "RevGadgets") 9 | 10 | # make a new plot 11 | example <- readTrees(paths = tree_file) 12 | plot_new <- 13 | plotFBDTree( 14 | tree = example, 15 | timeline = T, 16 | tip_labels_italics = F, 17 | tip_labels_remove_underscore = T, 18 | tip_age_bars = T, 19 | node_age_bars = T, 20 | age_bars_colored_by = "posterior", 21 | age_bars_color = rev(colFun(2)) 22 | ) + ggplot2::theme(legend.position = c(.25, .85)) 23 | 24 | # read original plot data object 25 | plot_orig <- readRDS(plot_file) 26 | 27 | tmp <- tempdir() 28 | pdf(paste0(tmp,"/Rplots.pdf")) 29 | # test for errors in plot_new 30 | expect_error(print(plot_new), NA) 31 | dev.off() 32 | 33 | # compare plot data objects 34 | expect_equal(plot_new$data, plot_orig) 35 | 36 | }) 37 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | ## RevGadgets 1.2.1 2 | Patch release to fix testing failures on development R, no changes to functions. 3 | 4 | ## RevGadgets 1.2.0 5 | New minor release with a few updates to existing code: 6 | 7 | * changing theme for posterior probability plots for stylistic consistency. 8 | 9 | and some new functionality: 10 | 11 | * adds population size plotting for coalescent analyses 12 | 13 | ## RevGadgets 1.1.1 14 | Patch for a bug caused by changes to stats::density() defaults. 15 | 16 | * additional updates to posterior predictive plotting for posterior predictive effect size 17 | * adds age_bar_width argument to tree plotting functions 18 | 19 | ## RevGadgets 1.1.0 20 | Fixes a few bugs in initial version and adds Occurrence Birth Death Process functionality 21 | 22 | * better behavior for legends in ancestral state plots 23 | * fixes errors associated with changes to ggplot2 and ggtree 24 | * and more 25 | 26 | ## RevGadgets 1.0.0 27 | Initial release. Includes processing and plotting functions for common RevBayes Analyses 28 | 29 | * ancestral trees 30 | * trees (including FBD trees) 31 | * diversity rates 32 | * and more -------------------------------------------------------------------------------- /inst/extdata/PPS/empirical_data_pps_example.csv: -------------------------------------------------------------------------------- 1 | Number Invariant Sites,Number Invariant Sites Excluding Ambiguous,Max GC,Max GC Excluding Ambiguous,Max Invariant Block Length,Max Invariant Block Length Excluding Ambiguous,Max Pairwise Difference,Max Pairwise Difference Excluding Ambiguous,Max Variable Block Length,Max Variable Block Length Excluding Ambiguous,Min GC,Min GC Excluding Ambiguous,Min Pairwise Difference,Min Pairwise Difference Excluding Ambiguous,Number Invariable Block,Number Invariable Block Excluding Ambiguous,Mean GC,Mean GC Excluding Ambiguous,Mean GC 1,Mean GC 1 Excluding Ambiguous,Mean GC 2,Mean GC 2 Excluding Ambiguous,Mean GC 3,Mean GC 3 Excluding Ambiguous,Var GC,Var GC Excluding Ambiguous,Var GC 1,Var GC 1 Excluding Ambiguous,Var GC 2,Var GC 2 Excluding Ambiguous,Var GC 3,Var GC 3 Excluding Ambiguous,Theta,Tajima-D,Tajima-Pi,Segregating-Sites 2 | 454,475,0.4671341,0.4671341,5,5,332,371,77,17,0.3917616,0.3921053,160,160,275,288,0.4260946,0.4276406,0.4625128,0.4648048,0.3935927,0.3947464,0.4220824,0.4233585,0.0005181071,0.0005453741,0.0003231249,0.0002960245,0.000111953,0.0001451516,0.003221946,0.003301652,0.1631357,687,1.981138,0.242385 3 | -------------------------------------------------------------------------------- /tests/testthat/test_dropTip.R: -------------------------------------------------------------------------------- 1 | context("tests the dropTip function") 2 | 3 | test_that("drops tips", { 4 | # load in the file 5 | file <- 6 | system.file("extdata", 7 | "sub_models/primates_cytb_GTR_MAP.tre", 8 | package = "RevGadgets") 9 | tree <- readTrees(paths = file) 10 | # root, then drop 1 tip 11 | tree <- rerootPhylo(tree = tree, outgroup = "Galeopterus_variegatus") 12 | tree_dropped <- dropTip(tree, "Otolemur_crassicaudatus") 13 | 14 | # check that tree_dropped is a list of lists of a treedata object 15 | expect_equal(class(tree_dropped), "list") 16 | expect_equal(length(tree_dropped), 1) 17 | expect_equal(class(tree_dropped[[1]]), "list") 18 | expect_equal(length(tree_dropped[[1]]), 1) 19 | expect_equal(class(tree_dropped[[1]][[1]])[1], "treedata") 20 | 21 | # check that dropped tip tree has one fewer tip 22 | expect_equal(length(tree[[1]][[1]]@phylo$tip.label), 23 | length(tree_dropped[[1]][[1]]@phylo$tip.label)+1) 24 | 25 | # check that data was also dropped 26 | expect_equal(dim(tree[[1]][[1]]@data)[1], 27 | dim(tree_dropped[[1]][[1]]@data)[1] + 1) 28 | 29 | }) 30 | -------------------------------------------------------------------------------- /tests/testthat/test_plotPostPredStats.R: -------------------------------------------------------------------------------- 1 | context("Tests plotPostPredStats function") 2 | 3 | test_that("compare processed output from documentation example", { 4 | file_sim <- system.file("extdata", 5 | "PPS/simulated_data_pps_mini.csv", package = 6 | "RevGadgets") 7 | file_emp <- system.file("extdata", 8 | "PPS/empirical_data_pps_example.csv", package = 9 | "RevGadgets") 10 | file_old_plot <- system.file("extdata", 11 | "graphs/plotPostPredStats_df.rds", package = 12 | "RevGadgets") 13 | t <- processPostPredStats(path_sim = file_sim, 14 | path_emp = file_emp) 15 | 16 | plots <- plotPostPredStats(data = t, old.coords = TRUE) 17 | plot_new <- plots[[1]] 18 | plot_orig <- readRDS(file = file_old_plot) 19 | 20 | expect_equal(length(plots), dim(t[[1]])[2]) 21 | 22 | tmp <- tempdir() 23 | pdf(paste0(tmp,"/Rplots.pdf")) 24 | # test for errors in plot_new 25 | expect_error(print(plot_new), NA) 26 | dev.off() 27 | 28 | # compare plot data objects 29 | expect_equal(plot_new$data, plot_orig) 30 | 31 | }) 32 | -------------------------------------------------------------------------------- /man/dropTip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropTip.R 3 | \name{dropTip} 4 | \alias{dropTip} 5 | \title{dropTip} 6 | \usage{ 7 | dropTip(tree, tips) 8 | } 9 | \arguments{ 10 | \item{tree}{(list of lists of treedata objects; no default) Name of a list of 11 | lists of treedata objects, such as produced by readTrees().} 12 | 13 | \item{tips}{(character or numeric, no default) The tips(s) to drop. Either a 14 | single taxon name or node number or vector of such.} 15 | } 16 | \value{ 17 | returns a list of list of treedata objects, with the modified tips. 18 | } 19 | \description{ 20 | Drop one or multiple tips from your tree 21 | } 22 | \details{ 23 | Modifies a tree object (in RevGadget's format) by dropping one or more tips 24 | from the tree and from any associated data. Wrapper for treeio::drop.tip(). 25 | } 26 | \examples{ 27 | 28 | file <- system.file("extdata", 29 | "sub_models/primates_cytb_GTR_MAP.tre", 30 | package="RevGadgets") 31 | tree <- readTrees(paths = file) 32 | tree_dropped <- dropTip(tree, "Otolemur_crassicaudatus") 33 | 34 | 35 | } 36 | \seealso{ 37 | treeio: \link[treeio]{drop.tip} and ape: \link[ape]{drop.tip}. 38 | } 39 | -------------------------------------------------------------------------------- /man/plotHiSSE.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotHiSSE.R 3 | \name{plotHiSSE} 4 | \alias{plotHiSSE} 5 | \title{plotHiSSE} 6 | \usage{ 7 | plotHiSSE(rates) 8 | } 9 | \arguments{ 10 | \item{rates}{(data.frame; no default) a data frame containing columns 11 | "value", "rate", "hidden_state", "observed_state" (such as the output 12 | of processSSE())} 13 | } 14 | \value{ 15 | a ggplot object 16 | } 17 | \description{ 18 | plotHiSSE 19 | } 20 | \examples{ 21 | \donttest{ 22 | # download the example dataset to working directory 23 | 24 | url <- "https://revbayes.github.io/tutorials/intro/data/primates_HiSSE_2.log" 25 | dest_path <- "primates_HiSSE_2.log" 26 | download.file(url, dest_path) 27 | 28 | # to run on your own data, change this to the path to your data file 29 | hisse_file <- dest_path 30 | 31 | pdata <- processSSE(hisse_file) 32 | p <- plotHiSSE(pdata);p 33 | 34 | # change colors: 35 | p + ggplot2::scale_fill_manual(values = c("red","green")) 36 | 37 | # change x-axis label 38 | p + ggplot2::xlab("Rate (events/Ma)") 39 | 40 | # remove file 41 | # WARNING: only run for example dataset! 42 | # otherwise you might delete your data! 43 | file.remove(dest_path) 44 | 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /tests/testthat/test_readTrace.R: -------------------------------------------------------------------------------- 1 | context("tests the readTrace function") 2 | 3 | test_that("reads one trace", { 4 | file <- 5 | system.file("extdata", 6 | "sub_models/primates_cytb_GTR_mini.p", 7 | package = "RevGadgets") 8 | trace_single <- readTrace(path = file, burnin = 0) 9 | expect_equal(length(trace_single), 1) 10 | expect_equal(class(trace_single), "list") 11 | expect_equal(class(trace_single[[1]]), "data.frame") 12 | expect_equal(nrow(trace_single[[1]]), 11) 13 | expect_equal(ncol(trace_single[[1]]), 59) 14 | }) 15 | 16 | test_that("reads multiple traces", { 17 | file_1 <- 18 | system.file("extdata", 19 | "sub_models/primates_cytb_GTR_mini.p", 20 | package = "RevGadgets") 21 | file_2 <- 22 | system.file("extdata", 23 | "sub_models/primates_cytb_GTR_mini.p", 24 | package = "RevGadgets") 25 | trace_multi <- readTrace(path = c(file_1, file_2), burnin = 0) 26 | expect_equal(length(trace_multi), 2) 27 | expect_equal(class(trace_multi), "list") 28 | expect_equal(class(trace_multi[[1]]), "data.frame") 29 | expect_equal(nrow(trace_multi[[1]]), 11) 30 | expect_equal(ncol(trace_multi[[1]]), 59) 31 | }) 32 | -------------------------------------------------------------------------------- /man/getMAP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getMAP.R 3 | \name{getMAP} 4 | \alias{getMAP} 5 | \title{get MAP} 6 | \usage{ 7 | getMAP(var) 8 | } 9 | \arguments{ 10 | \item{var}{(numeric vector; no default) Vector of the samples from the 11 | trace of a quantitative variable} 12 | } 13 | \value{ 14 | the MAP estimate 15 | } 16 | \description{ 17 | Calculates the Maximum a Posteriori estimate for the trace of a 18 | quantitative variable 19 | } 20 | \details{ 21 | Uses the SANN method of the optim() function to approximate the MAP estimate 22 | } 23 | \examples{ 24 | 25 | \donttest{ 26 | # download the example dataset to working directory 27 | url <- 28 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 29 | dest_path <- "primates_cytb_GTR.log" 30 | download.file(url, dest_path) 31 | 32 | # to run on your own data, change this to the path to your data file 33 | file <- dest_path 34 | 35 | trace <- readTrace(paths = file) 36 | MAP <- getMAP(trace[[1]]$"pi[1]") 37 | 38 | # remove file 39 | # WARNING: only run for example dataset! 40 | # otherwise you might delete your data! 41 | file.remove(dest_path) 42 | } 43 | 44 | } 45 | \seealso{ 46 | \link[stats]{optim} 47 | } 48 | -------------------------------------------------------------------------------- /tests/testthat/test_readTrees.R: -------------------------------------------------------------------------------- 1 | context("tests the readTrees function") 2 | 3 | test_that("reads single nexus tree", { 4 | file <- 5 | system.file("extdata", 6 | "sub_models/primates_cytb_GTR_MAP.tre", 7 | package = "RevGadgets") 8 | tree_single <- readTrees(paths = file) 9 | expect_equal(length(tree_single), 1) 10 | expect_equal(class(tree_single[[1]][[1]])[1], "treedata") 11 | expect_equal(length(tree_single[[1]][[1]]@phylo$tip.label), 23) 12 | }) 13 | 14 | test_that("reads tree trace", { 15 | file <- 16 | system.file("extdata", "sub_models/primates_cytb_GTR_mini.trees", package = 17 | "RevGadgets") 18 | tree_multi <- readTrees(path = file) 19 | expect_equal(length(tree_multi[[1]]), 10) 20 | expect_equal(class(tree_multi[[1]]), "list") 21 | expect_equal(length(tree_multi[[1]][[1]]@phylo$tip.label), 23) 22 | }) 23 | 24 | test_that("reads single newick", { 25 | file <- 26 | system.file("extdata", "bds/primates.tre", package = "RevGadgets") 27 | tree_new <- readTrees(path = file) 28 | expect_equal(length(tree_new[[1]]), 1) 29 | expect_equal(class(tree_new[[1]][[1]])[1], "treedata") 30 | expect_equal(length(tree_new[[1]][[1]]@phylo$tip.label), 233) 31 | }) 32 | -------------------------------------------------------------------------------- /man/plotMuSSE.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotMuSSE.R 3 | \name{plotMuSSE} 4 | \alias{plotMuSSE} 5 | \title{plotMuSSE} 6 | \usage{ 7 | plotMuSSE(rates) 8 | } 9 | \arguments{ 10 | \item{rates}{(data.frame; no default) a data frame containing columns 11 | "value", "rate", "hidden_state", "observed_state" (such as the output 12 | of processSSE())} 13 | } 14 | \value{ 15 | a ggplot object 16 | } 17 | \description{ 18 | plotMuSSE 19 | } 20 | \examples{ 21 | \donttest{ 22 | 23 | # download the example dataset to working directory 24 | 25 | url <- 26 | "https://revbayes.github.io/tutorials/intro/data/primates_BiSSE_activity_period.log" 27 | dest_path <- "primates_BiSSE_activity_period.log" 28 | download.file(url, dest_path) 29 | 30 | # to run on your own data, change this to the path to your data file 31 | bisse_file <- dest_path 32 | 33 | pdata <- processSSE(bisse_file) 34 | p <- plotMuSSE(pdata);p 35 | 36 | # change colors: 37 | p + ggplot2::scale_fill_manual(values = c("red","green")) 38 | 39 | # change x-axis label 40 | p + ggplot2::xlab("Rate (events/Ma)") 41 | 42 | # remove file 43 | # WARNING: only run for example dataset! 44 | # otherwise you might delete your data! 45 | file.remove(dest_path) 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /tests/testthat/test_summarizeTrace.R: -------------------------------------------------------------------------------- 1 | context("tests the summarize trace function") 2 | 3 | test_that("summarizes continuous correctly", { 4 | file <- system.file("extdata", 5 | "sub_models/primates_cytb_GTR_mini.p", 6 | package = "RevGadgets") 7 | one_trace <- readTrace(paths = file) 8 | trace_sum <- summarizeTrace(trace = one_trace, 9 | vars = c("pi[1]", "pi[2]", "pi[3]", "pi[4]")) 10 | 11 | expect_equal(length(trace_sum), 4) 12 | expect_equal(class(trace_sum), "list") 13 | expect_equal(names(trace_sum), c("pi[1]", "pi[2]", "pi[3]", "pi[4]")) 14 | 15 | expect_equal(length(trace_sum[[1]]), 1) 16 | expect_equal(class(trace_sum[[1]]), "list") 17 | expect_equal(names(trace_sum[[1]]), "trace_1") 18 | 19 | expect_equal(class(trace_sum[[1]][[1]]), "numeric") 20 | expect_equal(names(trace_sum[[1]][[1]]), 21 | c("mean", "median", "MAP", "quantile_2.5", "quantile_97.5")) 22 | expect_equal(round(trace_sum[[1]][[1]]["mean"], digits = 3), 23 | c("mean" = 0.255)) 24 | expect_equal(round(trace_sum[[1]][[1]]["quantile_2.5"], digits = 3), 25 | c("quantile_2.5" = 0.236)) 26 | expect_equal(round(trace_sum[[1]][[1]]["quantile_97.5"], digits = 3), 27 | c("quantile_97.5" = 0.276)) 28 | }) 29 | -------------------------------------------------------------------------------- /inst/extdata/pop_size/horses_GMRF_times_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Replicate_ID Posterior Likelihood Prior interval_times[1] interval_times[2] interval_times[3] interval_times[4] interval_times[5] interval_times[6] interval_times[7] interval_times[8] interval_times[9] 2 | 0 0 -27293.28 -26794.41 -498.8719 50000 100000 150000 200000 250000 300000 350000 400000 450000 3 | 1 1 -27305.97 -26806.15 -499.82 50000 100000 150000 200000 250000 300000 350000 400000 450000 4 | 2 0 -27299.8 -26792.07 -507.7262 50000 100000 150000 200000 250000 300000 350000 400000 450000 5 | 3 1 -27302.12 -26801.16 -500.9541 50000 100000 150000 200000 250000 300000 350000 400000 450000 6 | 4 0 -27296.65 -26792.96 -503.6901 50000 100000 150000 200000 250000 300000 350000 400000 450000 7 | 5 1 -27313.4 -26813.55 -499.8493 50000 100000 150000 200000 250000 300000 350000 400000 450000 8 | 6 0 -27286.35 -26796.64 -489.7169 50000 100000 150000 200000 250000 300000 350000 400000 450000 9 | 7 1 -27292.94 -26794.38 -498.5664 50000 100000 150000 200000 250000 300000 350000 400000 450000 10 | 8 0 -27283.8 -26797.77 -486.0275 50000 100000 150000 200000 250000 300000 350000 400000 450000 11 | 9 1 -27309.71 -26799.06 -510.6495 50000 100000 150000 200000 250000 300000 350000 400000 450000 12 | 10 0 -27316.23 -26803.92 -512.3078 50000 100000 150000 200000 250000 300000 350000 400000 450000 13 | -------------------------------------------------------------------------------- /tests/testthat/test_plotDiversityOBDP.R: -------------------------------------------------------------------------------- 1 | context("tests the plotDiversityOBDP function") 2 | #note: does not compare the generated plot to the expectation 3 | test_that("plot diversity OBDP", { 4 | file_plot_orig <- 5 | system.file("extdata", "graphs/plotDiversityOBDP_df.rds", package = "RevGadgets") 6 | start_time_trace_file <- 7 | system.file("extdata", "obdp/start_time_trace.p", package="RevGadgets") 8 | popSize_distribution_matrices_file <- 9 | system.file("extdata", "obdp/Kt_trace.p", package="RevGadgets") 10 | trees_trace_file <- 11 | system.file("extdata", "obdp/mcmc_OBDP_trees.p", package="RevGadgets") 12 | 13 | capture.output(Kt_mean <- readOBDP( start_time_trace_file=start_time_trace_file, 14 | popSize_distribution_matrices_file=popSize_distribution_matrices_file, 15 | trees_trace_file=trees_trace_file )) 16 | 17 | plot_new <- plotDiversityOBDP( Kt_mean ) 18 | 19 | plot_orig <- readRDS(file_plot_orig) 20 | 21 | tmp <- tempdir() 22 | pdf(paste0(tmp,"/Rplots.pdf")) 23 | 24 | # check that plot doesn't error out 25 | expect_error(print(plot_new), NA) 26 | 27 | dev.off() 28 | 29 | # compare plot data objects 30 | expect_equal(plot_new$data, plot_orig) 31 | }) 32 | -------------------------------------------------------------------------------- /R/getMAP.R: -------------------------------------------------------------------------------- 1 | #' get MAP 2 | #' 3 | #' Calculates the Maximum a Posteriori estimate for the trace of a 4 | #' quantitative variable 5 | #' 6 | #' Uses the SANN method of the optim() function to approximate the MAP estimate 7 | #' 8 | #' @param var (numeric vector; no default) Vector of the samples from the 9 | #' trace of a quantitative variable 10 | #' 11 | #' @return the MAP estimate 12 | #' 13 | #' @seealso \link[stats]{optim} 14 | #' 15 | #' @examples 16 | #' 17 | #' \donttest{ 18 | #' # download the example dataset to working directory 19 | #' url <- 20 | #' "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 21 | #' dest_path <- "primates_cytb_GTR.log" 22 | #' download.file(url, dest_path) 23 | #' 24 | #' # to run on your own data, change this to the path to your data file 25 | #' file <- dest_path 26 | #' 27 | #' trace <- readTrace(paths = file) 28 | #' MAP <- getMAP(trace[[1]]$"pi[1]") 29 | #' 30 | #' # remove file 31 | #' # WARNING: only run for example dataset! 32 | #' # otherwise you might delete your data! 33 | #' file.remove(dest_path) 34 | #' } 35 | #' 36 | #' @export 37 | 38 | getMAP <- function(var) { 39 | d <- density(var) 40 | f <- approxfun(d$x, d$y) 41 | op <- stats::optim( 42 | par = mean(var), 43 | fn = f, 44 | method = "SANN", 45 | control = list(fnscale = -1) 46 | ) 47 | return(op$par) 48 | } 49 | -------------------------------------------------------------------------------- /inst/extdata/epi_bd/primates_EBD_extinction_times_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Posterior Likelihood Prior interval_times[1] interval_times[2] interval_times[3] interval_times[4] interval_times[5] interval_times[6] interval_times[7] interval_times[8] interval_times[9] interval_times[10] 2 | 0 -2179.41 -2201.24 21.8288 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 3 | 10 -1549.77 -1575 25.2292 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 4 | 20 -1557.53 -1572.61 15.0827 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 5 | 30 -1551.32 -1570.3 18.9817 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 6 | 40 -1547.23 -1573.13 25.9012 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 7 | 50 -1547.83 -1569.29 21.4658 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 8 | 60 -1552.16 -1568.71 16.5455 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 9 | 70 -1546.9 -1568.08 21.1761 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 10 | 80 -1543.67 -1568.34 24.6743 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 11 | 90 -1553.36 -1570.64 17.2769 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 -------------------------------------------------------------------------------- /inst/extdata/epi_bd/primates_EBD_speciation_times_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Posterior Likelihood Prior interval_times[1] interval_times[2] interval_times[3] interval_times[4] interval_times[5] interval_times[6] interval_times[7] interval_times[8] interval_times[9] interval_times[10] 2 | 0 -2179.41 -2201.24 21.8288 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 3 | 10 -1549.77 -1575 25.2292 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 4 | 20 -1557.53 -1572.61 15.0827 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 5 | 30 -1551.32 -1570.3 18.9817 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 6 | 40 -1547.23 -1573.13 25.9012 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 7 | 50 -1547.83 -1569.29 21.4658 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 8 | 60 -1552.16 -1568.71 16.5455 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 9 | 70 -1546.9 -1568.08 21.1761 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 10 | 80 -1543.67 -1568.34 24.6743 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 11 | 90 -1553.36 -1570.64 17.2769 6.50917 13.0183 19.5275 26.0367 32.5458 39.055 45.5642 52.0733 58.5825 65.0917 12 | -------------------------------------------------------------------------------- /tests/testthat/test_calculateShiftBayesFactor.R: -------------------------------------------------------------------------------- 1 | context("Tests Bayes Factor calculations from MRF models") 2 | 3 | test_that("compare expected calculations from documentation example", { 4 | # read in and process primates diversification rate data 5 | speciation_time_file <- 6 | system.file("extdata", 7 | "epi_bd/primates_EBD_speciation_times_mini.p", 8 | package = "RevGadgets") 9 | speciation_rate_file <- 10 | system.file("extdata", 11 | "epi_bd/primates_EBD_speciation_rates_mini.p", 12 | package = "RevGadgets") 13 | 14 | speciation_rate <- readTrace(speciation_rate_file, burnin = 0) 15 | speciation_times <- readTrace(speciation_time_file, burnin = 0) 16 | 17 | expect_equal( 18 | 2.773, 19 | round(calculateShiftBayesFactor(speciation_rate, 20 | speciation_times, 21 | "speciation", 22 | "interval_times", 23 | 0.0, 24 | 40.0, 25 | decrease = FALSE), 26 | digits = 3) 27 | ) 28 | 29 | expect_error( 30 | calculateShiftBayesFactor( 31 | speciation_rate, 32 | speciation_times, 33 | "fossilization", 34 | "interval_times", 35 | 0.0, 36 | 40.0, 37 | decrease = FALSE 38 | ) 39 | ) 40 | 41 | }) 42 | -------------------------------------------------------------------------------- /inst/extdata/pop_size/horses_GMRF_popsizes_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Replicate_ID Posterior Likelihood Prior population_size[1] population_size[2] population_size[3] population_size[4] population_size[5] population_size[6] population_size[7] population_size[8] population_size[9] population_size[10] 2 | 0 0 -27293.28 -26794.41 -498.8719 545066 488329 496800 464740 515613 565988 601042 711891 703247 731441 3 | 1 1 -27305.97 -26806.15 -499.82 465357 405545 406713 372441 372278 408185 375759 348221 287431 325384 4 | 2 0 -27299.8 -26792.07 -507.7262 603280 600461 510016 465931 329919 176525 137952 161883 169902 183102 5 | 3 1 -27302.12 -26801.16 -500.9541 394040 355091 358833 203446 176374 209973 344189 220691 276648 230552 6 | 4 0 -27296.65 -26792.96 -503.6901 682751 562485 507785 403587 343172 347070 312312 350040 276571 246983 7 | 5 1 -27313.4 -26813.55 -499.8493 535117 539395 547334 621626 559307 507038 547615 593320 601757 716761 8 | 6 0 -27286.35 -26796.64 -489.7169 519354 482748 413996 428221 426397 404095 405185 381620 376414 363327 9 | 7 1 -27292.94 -26794.38 -498.5664 535540 453571 507046 440589 396384 362098 347487 356969 304221 261713 10 | 8 0 -27283.8 -26797.77 -486.0275 502588 523604 514390 527376 529096 522862 498597 504810 510396 504526 11 | 9 1 -27309.71 -26799.06 -510.6495 729053 687115 268630 238534 168277 150654 126805 81110.7 64628.1 48018.6 12 | 10 0 -27316.23 -26803.92 -512.3078 737713 582291 770146 804303 791191 745571 635706 706351 659156 437289 13 | -------------------------------------------------------------------------------- /inst/extdata/sse/primates_BiSSE_activity_period_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Replicate_ID Posterior Likelihood Prior diversification[1] diversification[2] extinction[1] extinction[2] rate_category_prior[1] rate_category_prior[2] speciation[1] speciation[2] transition_rates[1] transition_rates[2] 2 | 8000 0 -1584.73 -1591.957 7.227356 0.0910273 0.0583606 0.181531 0.085079 0.161688 0.838312 0.272558 0.14344 0.00198255 0.0105712 3 | 8001 1 -1581.334 -1596.439 15.10467 0.207142 0.077321 0.00237425 0.0230505 0.245235 0.754765 0.209516 0.100372 0.000530591 0.00278749 4 | 8002 0 -1580.549 -1588.346 7.796988 0.126091 0.0651868 0.167025 0.085079 0.115082 0.884918 0.293116 0.150266 0.000643726 0.00844616 5 | 8003 1 -1581.073 -1597.214 16.1404 0.185935 0.0962546 0.004777 0.004117 0.245235 0.754765 0.190712 0.100372 0.000517495 0.00326819 6 | 8004 0 -1580.429 -1588.337 7.907709 0.13534 0.0651868 0.157776 0.085079 0.115082 0.884918 0.293116 0.150266 0.000643726 0.00813869 7 | 8005 1 -1584.139 -1596.57 12.43131 0.226292 0.0613196 0.00556188 0.0525107 0.449629 0.550371 0.231854 0.11383 0.000517495 0.00721446 8 | 8006 0 -1580.011 -1588.76 8.749866 0.122458 0.0651868 0.155206 0.085079 0.115082 0.884918 0.277663 0.150266 0.000656888 0.00371206 9 | 8007 1 -1583.442 -1596.627 13.18514 0.227045 0.0710092 0.00486716 0.0525107 0.054034 0.945966 0.231912 0.12352 0.00166821 0.00204625 10 | 8008 0 -1583.651 -1591.414 7.763255 0.155123 0.0598652 0.12254 0.0869726 0.115082 0.884918 0.277663 0.146838 0.00568467 0.00568555 -------------------------------------------------------------------------------- /inst/extdata/epi_bd/primates_EBD_speciation_rates_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Posterior Likelihood Prior speciation[1] speciation[2] speciation[3] speciation[4] speciation[5] speciation[6] speciation[7] speciation[8] speciation[9] speciation[10] speciation[11] 2 | 0 -2179.41 -2201.24 21.8288 0.782358 0.786632 0.803608 0.807696 0.774212 0.873602 0.842407 0.899987 0.923264 0.982062 1.02421 3 | 10 -1549.77 -1575 25.2292 0.217584 0.214347 0.217048 0.208974 0.213053 0.206623 0.223 0.215842 0.230035 0.235064 0.248632 4 | 20 -1557.53 -1572.61 15.0827 0.238448 0.237802 0.226321 0.224331 0.232188 0.250144 0.223166 0.217998 0.219603 0.273266 0.282141 5 | 30 -1551.32 -1570.3 18.9817 0.269239 0.241385 0.229363 0.213317 0.212464 0.218869 0.24042 0.238623 0.230845 0.231325 0.247834 6 | 40 -1547.23 -1573.13 25.9012 0.240562 0.2306 0.21482 0.212276 0.200658 0.209834 0.215075 0.21226 0.202137 0.209771 0.204456 7 | 50 -1547.83 -1569.29 21.4658 0.256347 0.243482 0.215512 0.214857 0.219163 0.224451 0.223073 0.203159 0.223218 0.227343 0.212601 8 | 60 -1552.16 -1568.71 16.5455 0.261398 0.248465 0.220583 0.230808 0.22775 0.232143 0.239014 0.215726 0.188526 0.184649 0.177795 9 | 70 -1546.9 -1568.08 21.1761 0.270236 0.240438 0.23854 0.207022 0.206467 0.214076 0.215133 0.216879 0.209525 0.203935 0.189334 10 | 80 -1543.67 -1568.34 24.6743 0.297752 0.286049 0.255643 0.257659 0.255227 0.229978 0.244353 0.24624 0.267382 0.24778 0.258252 11 | 90 -1553.36 -1570.64 17.2769 0.225109 0.224258 0.195186 0.163451 0.162149 0.16138 0.161946 0.174818 0.173339 0.194132 0.18037 -------------------------------------------------------------------------------- /inst/extdata/epi_bd/primates_EBD_extinction_rates_mini.p: -------------------------------------------------------------------------------- 1 | Iteration Posterior Likelihood Prior extinction[1] extinction[2] extinction[3] extinction[4] extinction[5] extinction[6] extinction[7] extinction[8] extinction[9] extinction[10] extinction[11] 2 | 0 -2179.41 -2201.24 21.8288 0.0444232 0.0443115 0.0473306 0.0475149 0.0410633 0.0381735 0.0407801 0.0436527 0.0421112 0.0410916 0.0428336 3 | 10 -1549.77 -1575 25.2292 0.108597 0.110856 0.124852 0.120471 0.118872 0.109692 0.100671 0.103333 0.103532 0.105534 0.103517 4 | 20 -1557.53 -1572.61 15.0827 0.134077 0.145164 0.151916 0.155799 0.140362 0.131532 0.124645 0.131452 0.128462 0.130684 0.148648 5 | 30 -1551.32 -1570.3 18.9817 0.159287 0.16131 0.173407 0.174757 0.152374 0.148989 0.142758 0.13181 0.152548 0.147234 0.142429 6 | 40 -1547.23 -1573.13 25.9012 0.129401 0.127785 0.12196 0.115083 0.106223 0.102632 0.0943524 0.0933347 0.0923227 0.0994755 0.102333 7 | 50 -1547.83 -1569.29 21.4658 0.145188 0.153134 0.15307 0.153364 0.149928 0.168195 0.149085 0.146143 0.143858 0.149838 0.146502 8 | 60 -1552.16 -1568.71 16.5455 0.149014 0.151033 0.164279 0.175497 0.178436 0.154208 0.155385 0.148123 0.132593 0.121848 0.128951 9 | 70 -1546.9 -1568.08 21.1761 0.146964 0.149135 0.163887 0.156057 0.163281 0.156037 0.163962 0.145966 0.143379 0.138968 0.133879 10 | 80 -1543.67 -1568.34 24.6743 0.190233 0.197741 0.203159 0.204081 0.206704 0.197081 0.191784 0.186425 0.186771 0.176791 0.179644 11 | 90 -1553.36 -1570.64 17.2769 0.123102 0.130336 0.126595 0.122341 0.116057 0.116978 0.121935 0.117174 0.111445 0.101494 0.0938683 -------------------------------------------------------------------------------- /tests/testthat/test_densiTreeWithBranchData.R: -------------------------------------------------------------------------------- 1 | context("tests densiTree-style plots with branch data") 2 | 3 | test_that("plot doesn't error out", { 4 | trees <- lapply(1:5, function(x) 5 | ape::rcoal(5)) 6 | data <- lapply(1:5, function(x) 7 | stats::runif(9, 1, 10)) 8 | #TODO file used here is Beast2 file because RB 9 | # doesn't output distributions as Nexus 10 | tree_file <- 11 | system.file("extdata", "beast2", "msbd.rates.trees", package = "RevGadgets") 12 | 13 | tmp <- tempdir() 14 | pdf(paste0(tmp,"/Rplots.pdf")) 15 | 16 | expect_silent(densiTreeWithBranchData(trees = trees, data = data)) 17 | expect_silent(densiTreeWithBranchData( 18 | trees = trees, 19 | data = data, 20 | data_intervals = c(0, 11) 21 | )) 22 | expect_silent(densiTreeWithBranchData( 23 | trees = trees, 24 | data = data, 25 | data_intervals = 0:5 26 | )) 27 | 28 | dev.off() 29 | 30 | }) 31 | 32 | test_that("invalid inputs are rejected", { 33 | trees <- lapply(1:5, function(x) 34 | ape::rcoal(5)) 35 | data <- lapply(1:5, function(x) 36 | stats::runif(9, 1, 10)) 37 | #TODO file used here is Beast2 file because RB doesn't output 38 | # distributions as Nexus 39 | tree_file <- 40 | system.file("extdata", "beast2", "msbd.rates.trees", package = "RevGadgets") 41 | 42 | expect_error(densiTreeWithBranchData(trees = trees)) 43 | expect_error(densiTreeWithBranchData(data = data)) 44 | expect_error(densiTreeWithBranchData( 45 | tree_files = tree_file, 46 | burnin = 0, 47 | data_name = "psi" 48 | )) 49 | }) 50 | -------------------------------------------------------------------------------- /man/removeBurnin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/removeBurnin.R 3 | \name{removeBurnin} 4 | \alias{removeBurnin} 5 | \title{Remove Burnin} 6 | \usage{ 7 | removeBurnin(trace, burnin) 8 | } 9 | \arguments{ 10 | \item{trace}{(list of data frames; no default) Name of a list of data frames, 11 | such as produced by readTrace().} 12 | 13 | \item{burnin}{(single numeric value; 0.1) Fraction of generations to 14 | discard (if value provided is between 0 and 1) or number of generations (if 15 | value provided is greater than 1).} 16 | } 17 | \value{ 18 | List of dataframes (of length 1 if only 1 log file provided). 19 | } 20 | \description{ 21 | Removes burnin from MCMC trace 22 | } 23 | \details{ 24 | Removes burnin from an MCMC trace, such as the output of readTrace(). If 25 | multiple traces are provided, this function will remove the burnin from each. 26 | } 27 | \examples{ 28 | 29 | \donttest{ 30 | # download the example dataset to working directory 31 | url_gtr <- 32 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 33 | dest_path_gtr <- "primates_cytb_GTR.log" 34 | download.file(url_gtr, dest_path_gtr) 35 | 36 | # to run on your own data, change this to the path to your data file 37 | file_single <- dest_path_gtr 38 | 39 | one_trace <- readTrace(paths = file_single) 40 | one_trace_burnin <- removeBurnin(trace = one_trace, burnin = 0.1) 41 | 42 | # remove file 43 | # WARNING: only run for example dataset! 44 | # otherwise you might delete your data! 45 | file.remove(dest_path_gtr) 46 | } 47 | 48 | } 49 | -------------------------------------------------------------------------------- /tests/testthat/test_processDivRates.R: -------------------------------------------------------------------------------- 1 | context("tests the processDivRates function") 2 | 3 | # relies heavily on readTrace(), so we only test for elements not 4 | # included in the readTrace() testing. 5 | 6 | test_that("processes birth-death scripts", { 7 | file_spectimes <- 8 | system.file("extdata", 9 | "epi_bd/primates_EBD_speciation_times_mini.p", 10 | package = "RevGadgets") 11 | file_specrates <- 12 | system.file("extdata", 13 | "epi_bd/primates_EBD_speciation_rates_mini.p", 14 | package = "RevGadgets") 15 | file_exttimes <- 16 | system.file("extdata", 17 | "epi_bd/primates_EBD_extinction_times_mini.p", 18 | package = "RevGadgets") 19 | file_extrates <- 20 | system.file("extdata", 21 | "epi_bd/primates_EBD_extinction_rates_mini.p", 22 | package = "RevGadgets") 23 | 24 | primates <- processDivRates( 25 | speciation_time_log = file_spectimes, 26 | speciation_rate_log = file_specrates, 27 | extinction_time_log = file_exttimes, 28 | extinction_rate_log = file_extrates, 29 | burnin = 0.25 30 | ) 31 | expect_equal(ncol(primates), 5) 32 | expect_equal(class(primates), c("tbl_df", "tbl", "data.frame")) 33 | expect_equal(nrow(primates), 66) 34 | }) 35 | -------------------------------------------------------------------------------- /man/processPostPredStats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/processPostPredStats.R 3 | \name{processPostPredStats} 4 | \alias{processPostPredStats} 5 | \title{process Posterior Predictive Statistics} 6 | \usage{ 7 | processPostPredStats(path_sim, path_emp) 8 | } 9 | \arguments{ 10 | \item{path_sim}{(character string; no default) Path to the .csv file 11 | containing the simulated data results} 12 | 13 | \item{path_emp}{(character string; no default) Path to the .csv file 14 | containing the empirical values} 15 | } 16 | \value{ 17 | A list of data frames 18 | } 19 | \description{ 20 | Reads in and processes posterior-predictive statistics 21 | } 22 | \examples{ 23 | 24 | \donttest{ 25 | # download the example datasets to working directory 26 | 27 | url_emp <- 28 | "https://revbayes.github.io/tutorials/intro/data/empirical_data_pps_example.csv" 29 | dest_path_emp <- "empirical_data_pps_example.csv" 30 | download.file(url_emp, dest_path_emp) 31 | 32 | url_sim <- 33 | "https://revbayes.github.io/tutorials/intro/data/simulated_data_pps_example.csv" 34 | dest_path_sim <- "simulated_data_pps_example.csv" 35 | download.file(url_sim, dest_path_sim) 36 | 37 | # to run on your own data, change this to the path to your data file 38 | file_sim <- dest_path_sim 39 | file_emp <- dest_path_emp 40 | 41 | t <- processPostPredStats(path_sim = file_sim, 42 | path_emp = file_emp) 43 | 44 | # remove files 45 | # WARNING: only run for example dataset! 46 | # otherwise you might delete your data! 47 | file.remove(dest_path_sim, dest_path_emp) 48 | } 49 | 50 | 51 | } 52 | -------------------------------------------------------------------------------- /.github/workflows/check-standard.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: 6 | - master 7 | - development 8 | pull_request: 9 | branches: 10 | - master 11 | - development 12 | 13 | name: R-CMD-check 14 | 15 | env: 16 | R_BIOC_VERSION: 3.16 17 | 18 | jobs: 19 | R-CMD-check: 20 | runs-on: ${{ matrix.config.os }} 21 | 22 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 23 | 24 | strategy: 25 | fail-fast: false 26 | matrix: 27 | config: 28 | - {os: macos-latest, r: 'release'} 29 | - {os: windows-latest, r: 'release'} 30 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 31 | - {os: ubuntu-latest, r: 'release'} 32 | 33 | env: 34 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 35 | R_KEEP_PKG_SOURCE: yes 36 | 37 | steps: 38 | - uses: actions/checkout@v3 39 | 40 | - uses: r-lib/actions/setup-pandoc@v2 41 | 42 | - uses: r-lib/actions/setup-r@v2 43 | with: 44 | r-version: ${{ matrix.config.r }} 45 | http-user-agent: ${{ matrix.config.http-user-agent }} 46 | use-public-rspm: true 47 | 48 | - uses: r-lib/actions/setup-r-dependencies@v2 49 | with: 50 | extra-packages: any::rcmdcheck 51 | needs: check 52 | cache: false 53 | 54 | - uses: r-lib/actions/check-r-package@v2 55 | with: 56 | upload-snapshots: true 57 | -------------------------------------------------------------------------------- /tests/testthat/test_plotMassExtinctions.R: -------------------------------------------------------------------------------- 1 | context("tests the plotMassExtinctions function") 2 | 3 | test_that("tests mass extinctions example", { 4 | # get files 5 | mass_extinction_probability_file <- 6 | system.file("extdata", 7 | "mass_extinction/crocs_mass_extinction_probabilities_mini.p", 8 | package = "RevGadgets") 9 | 10 | plot_file <- 11 | system.file("extdata", 12 | "graphs/plotMassExtinctions_df.rds", 13 | package = "RevGadgets") 14 | 15 | mass_extinction_probabilities <- 16 | readTrace(mass_extinction_probability_file, burnin = 0) 17 | 18 | # prior probability of mass extinction at any time 19 | prior_n_expected <- 0.1 20 | n_intervals <- 100 21 | prior_prob <- prior_n_expected / (n_intervals - 1) 22 | 23 | # times when mass extinctions were allowed 24 | tree_age <- 243.5 25 | interval_times <- 26 | tree_age * seq(1 / n_intervals, 27 | (n_intervals - 1) / n_intervals, 28 | 1 / n_intervals) 29 | 30 | # then plot results: 31 | plot_new <- 32 | plotMassExtinctions( 33 | mass_extinction_trace = mass_extinction_probabilities, 34 | mass_extinction_times = interval_times, 35 | mass_extinction_name = "mass_extinction_probabilities", 36 | prior_prob 37 | ) 38 | 39 | # read original plot object 40 | plot_orig <- readRDS(plot_file) 41 | 42 | tmp <- tempdir() 43 | pdf(paste0(tmp,"/Rplots.pdf")) 44 | # test for errors in plot_new 45 | expect_error(print(plot_new), NA) 46 | dev.off() 47 | 48 | # compare plot data objects 49 | expect_equal(plot_new$data, plot_orig) 50 | 51 | }) 52 | -------------------------------------------------------------------------------- /man/processSSE.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/processSSE.R 3 | \name{processSSE} 4 | \alias{processSSE} 5 | \title{Title} 6 | \usage{ 7 | processSSE( 8 | path, 9 | speciation = "speciation", 10 | extinction = "extinction", 11 | speciation_hidden = "speciation_hidden", 12 | rates = c(speciation, extinction, "net-diversification"), 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{path}{(vector of character strings; no default) File path(s) to 18 | trace file.} 19 | 20 | \item{speciation}{(single character string; "speciation") RevBayes variable 21 | name} 22 | 23 | \item{extinction}{(single character string; "extinction") RevBayes variable 24 | name} 25 | 26 | \item{speciation_hidden}{(single character string; "speciation_hidden") 27 | RevBayes variable name} 28 | 29 | \item{rates}{(vector; c(speciation, extinction, "net-diversification")) 30 | names of rates to be included in plot} 31 | 32 | \item{...}{additional arguments passed to readTrace()} 33 | } 34 | \value{ 35 | a data frame 36 | } 37 | \description{ 38 | Title 39 | } 40 | \examples{ 41 | 42 | \donttest{ 43 | # download the example dataset to working directory 44 | 45 | url <- 46 | "https://revbayes.github.io/tutorials/intro/data/primates_BiSSE_activity_period.log" 47 | dest_path <- "primates_BiSSE_activity_period.log" 48 | download.file(url, dest_path) 49 | 50 | # to run on your own data, change this to the path to your data file 51 | bisse_file <- dest_path 52 | 53 | pdata <- processSSE(bisse_file) 54 | 55 | # remove file 56 | # WARNING: only run for example dataset! 57 | # otherwise you might delete your data! 58 | file.remove(dest_path) 59 | } 60 | 61 | } 62 | -------------------------------------------------------------------------------- /inst/extdata/dec/small_dec.tre: -------------------------------------------------------------------------------- 1 | #NEXUS 2 | begin trees; 3 | tree tree_1 = [&R] ((Argyroxiphium_caliginis[&index=18,posterior=1.0,end_state_1=3,end_state_2="NA",end_state_3="NA",end_state_1_pp=1.0,end_state_2_pp=0.0,end_state_3_pp=0.0,end_state_other_pp=0.0,start_state_1=3,start_state_2="NA",start_state_3="NA",start_state_1_pp=1.0,start_state_2_pp=0.0,start_state_3_pp=0.0,start_state_other_pp=0.0]:0.027354,Argyroxiphium_grayanum_East_Maui[&index=17,posterior=1.0,end_state_1=3,end_state_2="NA",end_state_3="NA",end_state_1_pp=1.0,end_state_2_pp=0.0,end_state_3_pp=0.0,end_state_other_pp=0.0,start_state_1=3,start_state_2="NA",start_state_3="NA",start_state_1_pp=1.0,start_state_2_pp=0.0,start_state_3_pp=0.0,start_state_other_pp=0.0]:0.027354)[&index=52,posterior=1.0,end_state_1=3,end_state_2="NA",end_state_3="NA",end_state_1_pp=1.0,end_state_2_pp=0.0,end_state_3_pp=0.0,end_state_other_pp=0.0,start_state_1=3,start_state_2=7,start_state_3=6,start_state_1_pp=0.986726,start_state_2_pp=0.004425,start_state_3_pp=0.004425,start_state_other_pp=0.004425]:0.149658,Argyroxiphium_grayanum_West_Maui[&index=16,posterior=1.0,end_state_1=3,end_state_2="NA",end_state_3="NA",end_state_1_pp=1.0,end_state_2_pp=0.0,end_state_3_pp=0.0,end_state_other_pp=0.0,start_state_1=3,start_state_2=6,start_state_3=10,start_state_1_pp=0.982301,start_state_2_pp=0.00885,start_state_3_pp=0.00885,start_state_other_pp=0.0]:0.177012)[&index=53,posterior=1.0,end_state_1=3,end_state_2=6,end_state_3=10,end_state_1_pp=0.969027,end_state_2_pp=0.013274,end_state_3_pp=0.013274,end_state_other_pp=0.004425,start_state_1=3,start_state_2=10,start_state_3=6,start_state_1_pp=0.955752,start_state_2_pp=0.026549,start_state_3_pp=0.013274,start_state_other_pp=0.004425]; 4 | end; 5 | -------------------------------------------------------------------------------- /man/rerootPhylo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rerootPhylo.R 3 | \name{rerootPhylo} 4 | \alias{rerootPhylo} 5 | \title{Reroot Phylo} 6 | \usage{ 7 | rerootPhylo(tree, outgroup) 8 | } 9 | \arguments{ 10 | \item{tree}{(list of lists of treedata objects; no default) Name of a list of 11 | lists of treedata objects, such as produced by readTrees().} 12 | 13 | \item{outgroup}{(character, no default) Name of the outgroup(s). Either a 14 | single taxon name or a character vector of length two to specify a clade; 15 | in this case the root will be placed at the midpoint of the branch subtending 16 | the two taxa's MRCA. Modified from phytools::reroot().} 17 | } 18 | \value{ 19 | returns a list of list of treedata objects, with the trees rooted. 20 | } 21 | \description{ 22 | Reroots a phylogeny given an outgroup taxon or clade 23 | } 24 | \details{ 25 | Modifies a tree object by rerooting using a specified 26 | outgroup taxon or clade. Places the root at the midpoint 27 | of the branch subtending the outgroup. If the input 28 | contains multiple trees, all trees will be rerooted. 29 | } 30 | \examples{ 31 | 32 | file <- system.file("extdata", 33 | "sub_models/primates_cytb_GTR_MAP.tre", 34 | package="RevGadgets") 35 | tree <- readTrees(paths = file) 36 | # root with one taxon 37 | tree_rooted <- rerootPhylo(tree = tree, outgroup = "Galeopterus_variegatus") 38 | # root with clade, specified by two taxa 39 | tree_rooted <- rerootPhylo(tree = tree, 40 | outgroup = c("Varecia_variegata_variegata", 41 | "Propithecus_coquereli")) 42 | 43 | } 44 | \seealso{ 45 | phytools: \link[phytools]{reroot}. 46 | } 47 | -------------------------------------------------------------------------------- /tests/testthat/test_rerootPhylo.R: -------------------------------------------------------------------------------- 1 | context("tests the rerootPhylo function") 2 | 3 | test_that("reroots tree", { 4 | # load in the file 5 | file <- 6 | system.file("extdata", 7 | "sub_models/primates_cytb_GTR_MAP.tre", 8 | package = "RevGadgets") 9 | tree <- readTrees(paths = file) 10 | # root with one taxon 11 | tree_rooted <- 12 | rerootPhylo(tree = tree, outgroup = "Galeopterus_variegatus") 13 | 14 | # check that tree_rooted is a list of lists of a treedata object 15 | expect_equal(class(tree_rooted), "list") 16 | expect_equal(length(tree_rooted), 1) 17 | expect_equal(class(tree_rooted[[1]]), "list") 18 | expect_equal(length(tree_rooted[[1]]), 1) 19 | expect_equal(class(tree_rooted[[1]][[1]])[1], "treedata") 20 | 21 | # if input is unrooted, check that rerooted added a branch to edge matrix 22 | expect_equal(dim(tree[[1]][[1]]@phylo$edge)[1], 43) 23 | expect_equal(dim(tree_rooted[[1]][[1]]@phylo$edge)[1], 44) 24 | 25 | # check that data are correctly re-associated 26 | node <- ape::getMRCA(tree[[1]][[1]]@phylo, c("Callicebus_donacophilus", 27 | "Pan_paniscus")) 28 | node_pp <- tree[[1]][[1]]@data[which(tree[[1]][[1]]@data$node == node), 29 | "posterior"] 30 | 31 | node_root <- ape::getMRCA(tree_rooted[[1]][[1]]@phylo, c("Saimiri_sciureus", 32 | "Cebus_albifrons")) 33 | 34 | node_pp_root <- 35 | tree_rooted[[1]][[1]]@data[which(tree_rooted[[1]][[1]]@data$node == 36 | node_root), 37 | "posterior"] 38 | 39 | expect_equal(node_pp, node_pp_root) 40 | 41 | }) 42 | -------------------------------------------------------------------------------- /tests/testthat/test_plotAncStatesMAP.R: -------------------------------------------------------------------------------- 1 | context("tests the plotAncStatesMAP function") 2 | 3 | test_that("plots MAP of ancestral states", { 4 | # get files 5 | tree_file <- 6 | system.file("extdata", 7 | "comp_method_disc/ase_freeK.tree", 8 | package = "RevGadgets") 9 | plot_file <- 10 | system.file("extdata", 11 | "graphs/plotAncStatesMAP_df.rds", 12 | package = "RevGadgets") 13 | 14 | # make a new plot 15 | example <- 16 | processAncStates(tree_file, 17 | state_labels = c("1" = "Awesome", 18 | "2" = "Beautiful", 19 | "3" = "Cool!")) 20 | plot_new <- plotAncStatesMAP(t = example) 21 | 22 | # read original plot object 23 | plot_orig <- readRDS(plot_file) 24 | 25 | tmp <- tempdir() 26 | pdf(paste0(tmp,"/Rplots.pdf")) 27 | 28 | # plot new doesn't error out 29 | expect_error(print(plot_new), NA) 30 | 31 | # compare plot dataobjects 32 | expect_equal(plot_new$data, plot_orig) 33 | 34 | dev.off() 35 | }) 36 | 37 | test_that("error messages behave as expected", { 38 | # get files 39 | tree_file <- 40 | system.file("extdata", 41 | "comp_method_disc/ase_freeK.tree", 42 | package = "RevGadgets") 43 | 44 | # make a new plot 45 | example <- 46 | processAncStates(tree_file, 47 | state_labels = c("1" = "Awesome", 48 | "2" = "Beautiful", 49 | "3" = "Cool!")) 50 | expect_error(plotAncStatesMAP(t = example, 51 | geo_units = 52 | list('epochs','periods','years'))) 53 | 54 | }) 55 | -------------------------------------------------------------------------------- /man/processAncStates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/processAncStates.R 3 | \name{processAncStates} 4 | \alias{processAncStates} 5 | \title{Process Ancestral States} 6 | \usage{ 7 | processAncStates( 8 | path, 9 | state_labels = NULL, 10 | labels_as_numbers = FALSE, 11 | missing_to_NA = TRUE 12 | ) 13 | } 14 | \arguments{ 15 | \item{path}{(character string; no default) File path to annotated tree.} 16 | 17 | \item{state_labels}{(character vector; NULL) Vector of labels for ancestral 18 | states named with the current state labels in annotated tree file 19 | (as characters).} 20 | 21 | \item{labels_as_numbers}{(logical; FALSE) Should the state labels be treated 22 | as integers (for example, as chromosome numbers)?} 23 | 24 | \item{missing_to_NA}{(logical; TRUE) Should missing data, coded as "?", be 25 | coded to NA? If TRUE, the state will not be plotted. If FALSE, it will be 26 | considered an additional state when plotting.} 27 | } 28 | \value{ 29 | A treedata object 30 | } 31 | \description{ 32 | Process data for ancestral states plotting 33 | } 34 | \examples{ 35 | 36 | # standard ancestral state estimation example 37 | file <- system.file("extdata", 38 | "comp_method_disc/ase_freeK.tree", 39 | package="RevGadgets") 40 | example <- processAncStates(file, 41 | state_labels = c("1" = "Awesome", 42 | "2" = "Beautiful", 43 | "3" = "Cool!")) 44 | 45 | #chromosome evolution example 46 | file <- system.file("extdata", 47 | "chromo/ChromEvol_simple_final.tree", 48 | package="RevGadgets") 49 | chromo_example <- processAncStates(file, labels_as_numbers = TRUE) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /R/plotHiSSE.R: -------------------------------------------------------------------------------- 1 | #' plotHiSSE 2 | #' 3 | #' @inheritParams plotMuSSE 4 | #' 5 | #' @return a ggplot object 6 | #' @examples 7 | #' \donttest{ 8 | #' # download the example dataset to working directory 9 | #' 10 | #' url <- "https://revbayes.github.io/tutorials/intro/data/primates_HiSSE_2.log" 11 | #' dest_path <- "primates_HiSSE_2.log" 12 | #' download.file(url, dest_path) 13 | #' 14 | #' # to run on your own data, change this to the path to your data file 15 | #' hisse_file <- dest_path 16 | #' 17 | #' pdata <- processSSE(hisse_file) 18 | #' p <- plotHiSSE(pdata);p 19 | #' 20 | #' # change colors: 21 | #' p + ggplot2::scale_fill_manual(values = c("red","green")) 22 | #' 23 | #' # change x-axis label 24 | #' p + ggplot2::xlab("Rate (events/Ma)") 25 | #' 26 | #' # remove file 27 | #' # WARNING: only run for example dataset! 28 | #' # otherwise you might delete your data! 29 | #' file.remove(dest_path) 30 | #' 31 | #' } 32 | #' @export 33 | plotHiSSE <- function(rates) { 34 | if (is.data.frame(rates) == FALSE) 35 | stop("rates should be a data frame") 36 | p <- 37 | ggplot2::ggplot(rates, ggplot2::aes(x = value, fill = observed_state)) + 38 | ggplot2::geom_density(alpha = 0.8) + 39 | ggplot2::facet_grid( 40 | rate ~ hidden_state, 41 | scales = "free", 42 | labeller = ggplot2::labeller(rate = .titleFormatLabeller) 43 | ) + 44 | ggplot2::scale_fill_manual(values = colFun(length(unique( 45 | rates$observed_state 46 | ))), 47 | name = "Observed state") + 48 | ggplot2::xlab("Rate") + 49 | ggplot2::ylab("Posterior density") + 50 | ggplot2::theme_bw() + 51 | ggplot2::theme( 52 | panel.grid.major = ggplot2::element_blank(), 53 | panel.grid.minor = ggplot2::element_blank(), 54 | strip.background = ggplot2::element_blank() 55 | ) 56 | return(p) 57 | } 58 | -------------------------------------------------------------------------------- /man/plotPopSizes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotPopSizes.R 3 | \name{plotPopSizes} 4 | \alias{plotPopSizes} 5 | \title{Plot Population Sizes} 6 | \usage{ 7 | plotPopSizes( 8 | df, 9 | plot_CIs = TRUE, 10 | add = FALSE, 11 | existing_plot = NULL, 12 | col = "#00883a" 13 | ) 14 | } 15 | \arguments{ 16 | \item{df}{(data frame) such as produced by processPopSizes(), containing 17 | the data on population sizes and corresponding grid points (points in time for population size evaluation)} 18 | 19 | \item{plot_CIs}{(boolean; default: TRUE) specifies whether the credible intervals should be plotted.} 20 | 21 | \item{add}{(boolean; default: FALSE) specifies whether the new plot should be added to an existing ggplot2 object. If TRUE, 22 | the existing_plot has to be given.} 23 | 24 | \item{existing_plot}{(ggplot2 object; default: NULL) a ggplot2 object to which the new plot should be added.} 25 | 26 | \item{col}{(string; default: "#00883a") color for the trajectories} 27 | } 28 | \value{ 29 | a ggplot object 30 | } 31 | \description{ 32 | Plots the output of a coalescent demographic analysis. 33 | } 34 | \details{ 35 | Plots the output of coalescent demographic analyses. Takes as 36 | input the output of processPopSizes() and plotting parameters. 37 | 38 | The return object can be manipulated. For example, you can change the 39 | axis labels, the color palette, whether the axes are to be linked, or the 40 | overall plotting style/theme, just as with any ggplot object. 41 | } 42 | \examples{ 43 | df <- dplyr::tibble("time" = c(0.0, 1.0, 2.0, 3.0, 4.0), 44 | "value" = c(1.0, 1.5, 2.0, 1.5, 1.5), 45 | "upper" = c(3.5, 7.0, 6.5, 5.0, 5.0), 46 | "lower" = c(0.5, 0.1, 0.5, 0.5, 0.8)) 47 | 48 | plotPopSizes(df) 49 | 50 | } 51 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: RevGadgets 2 | Type: Package 3 | Title: Visualization and Post-Processing of 'RevBayes' Analyses 4 | Version: 1.2.1 5 | Authors@R: c( 6 | person("Carrie", "Tribble", 7 | email = "ctribble09@gmail.com", 8 | role = c("aut", "cre"), 9 | comment = c(ORCID = "0000-0001-7263-7885")), 10 | person("Michael R.", "May", role = "aut"), 11 | person("William A.", "Freyman", role = "aut"), 12 | person("Michael J.", "Landis", role = "aut"), 13 | person("Lim Jun", "Ying", role = "aut"), 14 | person("Joelle", "Barido-Sottani", role = "aut"), 15 | person("Andrew", "Magee", role = "aut"), 16 | person("Bjorn Tore", "Kopperud", role = "aut"), 17 | person("Sebastian", "Hohna", role = "aut"), 18 | person("Nagashima", "Kengo", role = "ctb"), 19 | person("Schliep", "Klaus", role = "ctb"), 20 | person("Ronja J.", "Billenstein", role = "aut") 21 | ) 22 | Maintainer: Carrie Tribble 23 | Description: Processes and visualizes the output of complex phylogenetic analyses from the 'RevBayes' phylogenetic graphical modeling software. 24 | URL: https://github.com/revbayes/RevGadgets, https://revbayes.github.io/tutorials/intro/revgadgets 25 | BugReports: https://github.com/revbayes/RevGadgets/issues 26 | License: GPL-3 27 | Encoding: UTF-8 28 | RoxygenNote: 7.2.3 29 | Depends: R (>= 4.2.0) 30 | biocViews: 31 | Imports: ape (>= 5.4), phytools (>= 0.7-70), dplyr (>= 1.0.0), 32 | ggtree (>= 3.6.1), tidytree (>= 0.3.4), treeio (>= 1.12.0), 33 | ggplot2 (>= 3.4.0), reshape (>= 0.8.8), methods (>= 4.1.0), 34 | tidyr (>= 1.1.0), tibble (>= 3.0.1), gginnards (>= 0.0.3), 35 | ggplotify (>= 0.0.5), ggpp, ggimage, 36 | png (>= 0.1-7), stats (>= 4.0.1), utils (>= 4.0.1), 37 | grDevices (>= 4.0.1), deeptime (>= 0.1.0), scales (>= 1.1.1) 38 | Suggests: testthat, 39 | knitr, 40 | rmarkdown, 41 | phangorn 42 | -------------------------------------------------------------------------------- /tests/testthat/test_plotDivRates.R: -------------------------------------------------------------------------------- 1 | context("tests the plotDivRates function") 2 | #note: does not compare the generated plot to the expectation 3 | test_that("plot works", { 4 | file_plot_orig <- 5 | system.file("extdata", 6 | "graphs/plotDivRates_df.rds", 7 | package = "RevGadgets") 8 | file_spectimes <- 9 | system.file("extdata", 10 | "epi_bd/primates_EBD_speciation_times_mini.p", 11 | package = "RevGadgets") 12 | file_specrates <- 13 | system.file("extdata", 14 | "epi_bd/primates_EBD_speciation_rates_mini.p", 15 | package = "RevGadgets") 16 | file_exttimes <- 17 | system.file("extdata", 18 | "epi_bd/primates_EBD_extinction_times_mini.p", 19 | package = "RevGadgets") 20 | file_extrates <- 21 | system.file("extdata", 22 | "epi_bd/primates_EBD_extinction_rates_mini.p", 23 | package = "RevGadgets") 24 | 25 | primates <- processDivRates( 26 | speciation_time_log = file_spectimes, 27 | speciation_rate_log = file_specrates, 28 | extinction_time_log = file_exttimes, 29 | extinction_rate_log = file_extrates, 30 | burnin = 0.25, 31 | summary = "mean" 32 | ) 33 | plot_new <- plotDivRates(primates, ) 34 | plot_orig <- readRDS(file_plot_orig) 35 | 36 | tmp <- tempdir() 37 | pdf(paste0(tmp,"/Rplots.pdf")) 38 | 39 | # check that plot doesn't error out 40 | expect_error(print(plot_new), NA) 41 | 42 | dev.off() 43 | 44 | # compare plot data objects 45 | expect_equal(plot_new$data, plot_orig) 46 | 47 | }) 48 | -------------------------------------------------------------------------------- /man/combineTraces.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/combineTrace.R 3 | \name{combineTraces} 4 | \alias{combineTraces} 5 | \title{Combine traces} 6 | \usage{ 7 | combineTraces(traces, burnin = 0) 8 | } 9 | \arguments{ 10 | \item{traces}{(list of data frames; no default) Name of a list of data 11 | frames, such as produced by readTrace().} 12 | 13 | \item{burnin}{(single numeric value; default = 0.0) Fraction of generations 14 | to discard (if value provided is between 0 and 1) or number of generations 15 | to discard (if value provided is greater than 1) before combining the 16 | samples.} 17 | } 18 | \value{ 19 | combineTraces() returns a list of data frames of length 1, 20 | corresponding to the combination of the provided samples. 21 | } 22 | \description{ 23 | Combine traces into one trace file 24 | } 25 | \details{ 26 | Combines multiple traces from independent MCMC replicates 27 | into one trace file. 28 | } 29 | \examples{ 30 | 31 | \donttest{ 32 | 33 | #' # download the example dataset to working directory 34 | url_1 <- 35 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_1.log" 36 | dest_path_1 <- "primates_cytb_GTR_run_1.log" 37 | download.file(url_1, dest_path_1) 38 | 39 | url_2 <- 40 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_2.log" 41 | dest_path_2 <- "primates_cytb_GTR_run_2.log" 42 | download.file(url_2, dest_path_2) 43 | 44 | # to run on your own data, change this to the path to your data file 45 | file_1 <- dest_path_1 46 | file_2 <- dest_path_2 47 | 48 | # read in the multiple trace files 49 | multi_trace <- readTrace(path = c(file_1, file_2), burnin = 0.0) 50 | 51 | # combine samples after discarding 10\% burnin 52 | combined_trace <- combineTraces(trace = multi_trace, 53 | burnin = 0.1) 54 | 55 | # remove files 56 | # WARNING: only run for example dataset! 57 | # otherwise you might delete your data! 58 | file.remove(dest_path_1, dest_path_2) 59 | } 60 | 61 | 62 | } 63 | -------------------------------------------------------------------------------- /R/plotMuSSE.R: -------------------------------------------------------------------------------- 1 | #' plotMuSSE 2 | #' 3 | #' @param rates (data.frame; no default) a data frame containing columns 4 | #' "value", "rate", "hidden_state", "observed_state" (such as the output 5 | #' of processSSE()) 6 | #' 7 | #' @return a ggplot object 8 | #' @examples 9 | #' \donttest{ 10 | #' 11 | #' # download the example dataset to working directory 12 | #' 13 | #' url <- 14 | #' "https://revbayes.github.io/tutorials/intro/data/primates_BiSSE_activity_period.log" 15 | #' dest_path <- "primates_BiSSE_activity_period.log" 16 | #' download.file(url, dest_path) 17 | #' 18 | #' # to run on your own data, change this to the path to your data file 19 | #' bisse_file <- dest_path 20 | #' 21 | #' pdata <- processSSE(bisse_file) 22 | #' p <- plotMuSSE(pdata);p 23 | #' 24 | #' # change colors: 25 | #' p + ggplot2::scale_fill_manual(values = c("red","green")) 26 | #' 27 | #' # change x-axis label 28 | #' p + ggplot2::xlab("Rate (events/Ma)") 29 | #' 30 | #' # remove file 31 | #' # WARNING: only run for example dataset! 32 | #' # otherwise you might delete your data! 33 | #' file.remove(dest_path) 34 | #' } 35 | #' @export 36 | 37 | plotMuSSE <- function(rates) { 38 | if (is.data.frame(rates) == FALSE) 39 | stop("rates should be a data frame") 40 | p <- 41 | ggplot2::ggplot(rates, ggplot2::aes(x = value, fill = observed_state)) + 42 | ggplot2::geom_density(alpha = 0.8) + 43 | ggplot2::scale_fill_manual(values = colFun(length(unique( 44 | rates$observed_state 45 | ))), 46 | name = "Observed state") + 47 | ggplot2::facet_wrap( 48 | ~ rate, 49 | scales = "free", 50 | ncol = 1, 51 | labeller = ggplot2::labeller(rate = .titleFormatLabeller) 52 | ) + 53 | ggplot2::xlab("Rate") + 54 | ggplot2::ylab("Posterior density") + 55 | ggplot2::theme_bw() + 56 | ggplot2::theme( 57 | panel.grid.major = ggplot2::element_blank(), 58 | panel.grid.minor = ggplot2::element_blank(), 59 | strip.background = ggplot2::element_blank() 60 | ) 61 | return(p) 62 | } 63 | -------------------------------------------------------------------------------- /R/matchNodes.R: -------------------------------------------------------------------------------- 1 | #' match Nodes 2 | #' 3 | #' @param phy (tree in ape format; no default) Tree on which to match nodes 4 | #' 5 | #' @return a data frame that translates ape node numbers to RevBayes node 6 | #' numbers 7 | #' 8 | #' @examples 9 | #' 10 | #' treefile <- system.file("extdata", "bds/primates.tre", package="RevGadgets") 11 | #' tree <- readTrees(treefile) 12 | #' map <- matchNodes(tree[[1]][[1]]@phylo) 13 | #' 14 | #' @export 15 | 16 | matchNodes <- function(phy) { 17 | # get some useful info 18 | num_tips <- length(phy$tip.label) 19 | num_nodes <- phy$Nnode 20 | tip_indexes <- 1:num_tips 21 | node_indexes <- num_tips + num_nodes:1 22 | 23 | node_map <- 24 | data.frame(R = 1:(num_tips + num_nodes), 25 | Rev = NA, 26 | visits = 0) 27 | current_node <- phy$Nnode + 2 28 | k <- 1 29 | t <- 1 30 | 31 | while (TRUE) { 32 | if (current_node <= num_tips) { 33 | node_map$Rev[node_map$R == current_node] <- t 34 | current_node <- phy$edge[phy$edge[, 2] == current_node, 1] 35 | t <- t + 1 36 | } else { 37 | if (node_map$visits[node_map$R == current_node] == 0) { 38 | node_map$Rev[node_map$R == current_node] <- node_indexes[k] 39 | k <- k + 1 40 | } 41 | node_map$visits[node_map$R == current_node] <- 42 | node_map$visits[node_map$R == current_node] + 1 43 | 44 | if (node_map$visits[node_map$R == current_node] == 1) { 45 | # go right 46 | current_node <- phy$edge[phy$edge[, 1] == current_node, 2][2] 47 | } else if (node_map$visits[node_map$R == current_node] == 2) { 48 | # go left 49 | current_node <- phy$edge[phy$edge[, 1] == current_node, 2][1] 50 | } else if (node_map$visits[node_map$R == current_node] == 3) { 51 | # go down 52 | if (current_node == num_tips + 1) { 53 | break 54 | } else { 55 | current_node <- phy$edge[phy$edge[, 2] == current_node, 1] 56 | } 57 | } 58 | } 59 | } 60 | 61 | return(node_map[, 1:2]) 62 | 63 | } 64 | 65 | 66 | -------------------------------------------------------------------------------- /R/dropTip.R: -------------------------------------------------------------------------------- 1 | #' dropTip 2 | #' 3 | #' Drop one or multiple tips from your tree 4 | #' 5 | #' Modifies a tree object (in RevGadget's format) by dropping one or more tips 6 | #' from the tree and from any associated data. Wrapper for treeio::drop.tip(). 7 | #' 8 | #' @param tree (list of lists of treedata objects; no default) Name of a list of 9 | #' lists of treedata objects, such as produced by readTrees(). 10 | #' 11 | #' @param tips (character or numeric, no default) The tips(s) to drop. Either a 12 | #' single taxon name or node number or vector of such. 13 | #' 14 | #' @return returns a list of list of treedata objects, with the modified tips. 15 | #' 16 | #' @seealso treeio: \link[treeio]{drop.tip} and ape: \link[ape]{drop.tip}. 17 | #' 18 | #' @examples 19 | #' 20 | #' file <- system.file("extdata", 21 | #' "sub_models/primates_cytb_GTR_MAP.tre", 22 | #' package="RevGadgets") 23 | #' tree <- readTrees(paths = file) 24 | #' tree_dropped <- dropTip(tree, "Otolemur_crassicaudatus") 25 | #' 26 | #' 27 | #' @export 28 | 29 | dropTip <- function(tree, tips) { 30 | if (!is.list(tree)) 31 | stop("tree should be a list of lists of treedata objects") 32 | if (!methods::is(tree[[1]][[1]], "treedata")) 33 | stop("tree should be a list of lists of treedata objects") 34 | if (!methods::is(tips, "character") & !methods::is(tips, "numeric")) 35 | stop("tips should be of class character or numeric") 36 | if (length(tips) > length(tree[[1]][[1]]@phylo$tip.label)) 37 | stop("number of tips to drop larger than the number of tips in the tree") 38 | missing_tips <- tips[ !tips %in% tree[[1]][[1]]@phylo$tip.label ] 39 | if (length(missing_tips > 0)) 40 | stop(paste0("Tips not found in tree object: ", 41 | paste0(missing_tips, collapse = ", "))) 42 | 43 | for (i in seq_len(length(tree))) { 44 | for (j in seq_len(length(tree[[i]]))) { 45 | t <- tree[[i]][[j]] 46 | t_dropped <- treeio::drop.tip(t, tip = tips) 47 | # replace old treedata object with new 48 | tree[[i]][[j]] <- t_dropped 49 | } 50 | } 51 | return(tree) 52 | } 53 | -------------------------------------------------------------------------------- /tests/testthat/test_plotAncStatesPie.R: -------------------------------------------------------------------------------- 1 | context("tests the plotAncStatesPie function") 2 | # note - this test does NOT compare the layers elements of the plot objects. 3 | test_that("plots pies of ancestral states", { 4 | # get files 5 | tree_file <- 6 | system.file("extdata", 7 | "dec/small_dec.tre", 8 | package = "RevGadgets") 9 | plot_file <- 10 | system.file("extdata", 11 | "graphs/plotAncStatesPie_df.rds", 12 | package = "RevGadgets") 13 | 14 | # make a new plot 15 | # labels that correspond to each region/ possible combination of regions 16 | labs <- c( 17 | "1" = "K", 18 | "2" = "O", 19 | "3" = "M", 20 | "4" = "H", 21 | "5" = "KO", 22 | "6" = "KM", 23 | "7" = "OM", 24 | "8" = "KH", 25 | "9" = "OH", 26 | "10" = "MH", 27 | "11" = "KOM", 28 | "12" = "KOH", 29 | "13" = "KMH", 30 | "14" = "OMH", 31 | "15" = "KOMH" 32 | ) 33 | dec_example <- processAncStates(tree_file , state_labels = labs) 34 | # Use the state_labels in the returned tidytree object to define color palette 35 | # These state_labels may be a subset of the labels you provided 36 | # (not all possible regions may be sampled in the dataset) 37 | colors <- 38 | colorRampPalette(colFun(12))(length(dec_example@state_labels)) 39 | names(colors) <- dec_example@state_labels 40 | # create plot 41 | plot_new <- 42 | plotAncStatesPie( 43 | t = dec_example, 44 | pie_colors = colors, 45 | tip_labels_size = 2, 46 | cladogenetic = TRUE, 47 | tip_labels_offset = 0.01, 48 | timeline = F, 49 | node_pie_size = .5, 50 | tip_pie_size = .3 51 | ) + 52 | ggplot2::scale_x_continuous(limits = c(-0.5, 1)) + 53 | ggplot2::theme(legend.position = c(0.1, 0.75)) 54 | 55 | # read original plot object 56 | plot_orig <- readRDS(plot_file) 57 | 58 | tmp <- tempdir() 59 | pdf(paste0(tmp,"/Rplots.pdf")) 60 | 61 | # test for errors in plot_new 62 | expect_error(print(plot_new), NA) 63 | 64 | dev.off() 65 | 66 | # compare plot data objects 67 | expect_equal(plot_new$data, plot_orig) 68 | 69 | }) 70 | -------------------------------------------------------------------------------- /R/removeBurnin.R: -------------------------------------------------------------------------------- 1 | #' Remove Burnin 2 | #' 3 | #' Removes burnin from MCMC trace 4 | #' 5 | #' Removes burnin from an MCMC trace, such as the output of readTrace(). If 6 | #' multiple traces are provided, this function will remove the burnin from each. 7 | #' 8 | #' @param trace (list of data frames; no default) Name of a list of data frames, 9 | #' such as produced by readTrace(). 10 | #' 11 | #' @param burnin (single numeric value; 0.1) Fraction of generations to 12 | #' discard (if value provided is between 0 and 1) or number of generations (if 13 | #' value provided is greater than 1). 14 | #' 15 | #' @return List of dataframes (of length 1 if only 1 log file provided). 16 | #' 17 | #' @examples 18 | #' 19 | #' \donttest{ 20 | #' # download the example dataset to working directory 21 | #' url_gtr <- 22 | #' "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 23 | #' dest_path_gtr <- "primates_cytb_GTR.log" 24 | #' download.file(url_gtr, dest_path_gtr) 25 | #' 26 | #' # to run on your own data, change this to the path to your data file 27 | #' file_single <- dest_path_gtr 28 | #' 29 | #' one_trace <- readTrace(paths = file_single) 30 | #' one_trace_burnin <- removeBurnin(trace = one_trace, burnin = 0.1) 31 | #' 32 | #' # remove file 33 | #' # WARNING: only run for example dataset! 34 | #' # otherwise you might delete your data! 35 | #' file.remove(dest_path_gtr) 36 | #' } 37 | #' 38 | #' @export 39 | #' 40 | 41 | removeBurnin <- function(trace, burnin) { 42 | if (is.list(trace) == FALSE) 43 | stop("trace should be a list of data frames") 44 | if (is.data.frame(trace[[1]]) == FALSE) 45 | stop("trace should be a list of data frames") 46 | if (is.numeric(burnin) == FALSE) 47 | stop("burnin must be a single numeric value") 48 | if (burnin < 0) 49 | stop("burnin must be a positive value") 50 | 51 | for (i in seq_len(length(trace))) { 52 | if (burnin >= nrow(trace[[i]])) 53 | stop("Burnin larger than provided trace file") 54 | 55 | if (burnin >= 1) { 56 | trace[[i]] <- trace[[i]][(burnin + 1):nrow(trace[[i]]),] 57 | } else if (burnin < 1 & burnin > 0) { 58 | discard <- ceiling(burnin * nrow(trace[[i]])) 59 | trace[[i]] <- trace[[i]][(discard + 1):nrow(trace[[i]]),] 60 | } else if (burnin == 0) { 61 | trace[[i]] <- trace[[i]] 62 | } 63 | } 64 | return(trace) 65 | } 66 | -------------------------------------------------------------------------------- /tests/testthat/test_plotPopSizes.R: -------------------------------------------------------------------------------- 1 | context("tests the plotPopSizes function") 2 | 3 | test_that("plot population size trajectories", { 4 | file_plot_orig <- 5 | system.file("extdata", 6 | "graphs/plotPopSizes.rds", 7 | package = "RevGadgets") 8 | 9 | file_popsizes_CPP <- 10 | system.file("extdata", 11 | "pop_size/horses_CPP_popsizes_mini.p", 12 | package = "RevGadgets") 13 | file_changepoints_CPP <- 14 | system.file("extdata", 15 | "pop_size/horses_CPP_times_mini.p", 16 | package = "RevGadgets") 17 | 18 | file_popsizes_GMRF <- 19 | system.file("extdata", 20 | "pop_size/horses_GMRF_popsizes_mini.p", 21 | package = "RevGadgets") 22 | file_changepoints_GMRF <- 23 | system.file("extdata", 24 | "pop_size/horses_GMRF_times_mini.p", 25 | package = "RevGadgets") 26 | 27 | CPP <- processPopSizes( 28 | population_size_log = file_popsizes_CPP, 29 | interval_change_points_log = file_changepoints_CPP, 30 | num_grid_points = 200 31 | ) 32 | 33 | GMRF <- processPopSizes( 34 | population_size_log = file_popsizes_GMRF, 35 | interval_change_points_log = file_changepoints_GMRF, 36 | spacing = "equal", 37 | min_age = 0, 38 | max_age = 300000 39 | ) 40 | 41 | plot_new_1 <- plotPopSizes(CPP) 42 | plot_new_2 <- plotPopSizes(GMRF, add = TRUE, 43 | existing_plot = plot_new_1, 44 | col = "blue") 45 | 46 | plot_orig <- readRDS(file_plot_orig) 47 | 48 | tmp <- tempdir() 49 | pdf(paste0(tmp,"/Rplots.pdf")) 50 | 51 | # check that plot doesn't error out 52 | expect_error(print(plot_new_2), NA) 53 | 54 | dev.off() 55 | 56 | # compare plot data objects 57 | expect_equal(plot_new_2$data, plot_orig$data) 58 | # expect_equal(plot_new_2$scales, plot_orig$scales) 59 | # expect_equal(plot_new_2$layers, plot_orig$layers) 60 | 61 | }) 62 | -------------------------------------------------------------------------------- /man/simulateMRF.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulateMRF.R 3 | \name{simulateMRF} 4 | \alias{simulateMRF} 5 | \title{Simulates a single Markov random field trajectory.} 6 | \usage{ 7 | simulateMRF( 8 | n_episodes, 9 | model, 10 | global_scale_hyperprior, 11 | initial_value = NULL, 12 | exponentiate = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{n_episodes}{(numeric; no default) The number of episodes in the random 17 | field (the parameter vector will be this long).} 18 | 19 | \item{model}{(character; no default) What model should the global scale 20 | parameter be set for? Options are "GMRF" and "HSMRF".} 21 | 22 | \item{global_scale_hyperprior}{(numeric; no default) The hyperprior on the 23 | global scale parameter.} 24 | 25 | \item{initial_value}{(numeric; NULL) The first value in the MRF. If no value 26 | is specified, the field is assumed to start at 0 (if exponentiate=FALSE) or 27 | 1 (if exponentiate=TRUE).} 28 | 29 | \item{exponentiate}{(logical; TRUE) If TRUE, the MRF model is taken to be on 30 | the log-scale and the values are returned on the real-scale (note this means 31 | that the specified initial value will be the log of the true initial value). 32 | If FALSE, the model is taken to be on the real scale.} 33 | } 34 | \value{ 35 | A vector drawn from the specified MRF model on the specified 36 | (log- or real-) scale. 37 | } 38 | \description{ 39 | This function simulates a draw from a HSMRF or GMRF distribution given a 40 | user-specified global scale parameter. The MRF can be taken to be on the 41 | log-scale (such as for a birth rate) or the real-scale. The first value 42 | must be specified 43 | } 44 | \examples{ 45 | \donttest{ 46 | # Simulate a 100-episode HSMRF model for a speciation-rate through time 47 | trajectory <- simulateMRF(n_episodes = 100, 48 | model = "HSMRF", 49 | global_scale_hyperprior = 0.0021) 50 | plot(1:100, 51 | rev(trajectory), 52 | type = "l", 53 | xlab = "time", 54 | ylab = "speciation rate") 55 | } 56 | } 57 | \references{ 58 | Magee et al. (2020) Locally adaptive Bayesian birth-death model 59 | successfully detects slow and rapid rate shifts. 60 | \emph{PLoS Computational Biology}, \bold{16 (10)}: e1007999. 61 | 62 | Faulkner, James R., and Vladimir N. Minin. Locally adaptive smoothing with 63 | Markov random fields and shrinkage priors. 64 | \emph{Bayesian analysis}, \bold{13 (1)}, 225. 65 | } 66 | -------------------------------------------------------------------------------- /man/setMRFGlobalScaleHyperpriorNShifts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/setMRFGlobalScaleHyperpriorNShifts.R 3 | \name{setMRFGlobalScaleHyperpriorNShifts} 4 | \alias{setMRFGlobalScaleHyperpriorNShifts} 5 | \title{Sets a global scale parameter for a GMRF or HSMRF model given a prior 6 | mean number of effective shifts.} 7 | \usage{ 8 | setMRFGlobalScaleHyperpriorNShifts( 9 | n_episodes, 10 | model, 11 | prior_n_shifts = log(2), 12 | shift_size = 2 13 | ) 14 | } 15 | \arguments{ 16 | \item{n_episodes}{(numeric; no default) The number of episodes in the random 17 | field (the parameter vector will be this long).} 18 | 19 | \item{model}{(character; no default) What model should the global scale 20 | parameter be set for? Options are "GMRF" and "HSMRF" for first-order models 21 | (also allowable: "GMRF1" and "HSMRF1") and "GMRF2" and HSMRF2" for 22 | second-order models.} 23 | 24 | \item{prior_n_shifts}{(numeric; log(2)) The desired prior mean number of 25 | shifts.} 26 | 27 | \item{shift_size}{(numeric; 2) The magnitude of change that defines an 28 | effective shift (measured as a fold-change).} 29 | } 30 | \value{ 31 | The hyperprior. 32 | } 33 | \description{ 34 | This function finds the global scale parameter value that produces the 35 | desired prior mean number of "effective" rate shifts. Given a specified 36 | magnitude for an effective shift, shift_size, an effective shift occurs 37 | when two adjacent values are more than shift_size-fold apart from each other. 38 | That is, an effective shift is the event that rate[i+1]/rate[i] > shift_size 39 | or rate[i+1]/rate[i] < 1/shift_size. 40 | } 41 | \details{ 42 | Finding these values for a HSMRF model can take several seconds for large 43 | values of n_episodes because of the required numerical integration. 44 | } 45 | \examples{ 46 | \donttest{ 47 | # Get global scale for a HSMRF model with 100 episodes. 48 | gs <- setMRFGlobalScaleHyperpriorNShifts(100, "HSMRF") 49 | 50 | # Plot a draw from this HSMRF distribution 51 | 52 | trajectory <- simulateMRF(n_episodes = 100, 53 | model = "HSMRF", 54 | global_scale_hyperprior = gs) 55 | 56 | plot(1:100, 57 | rev(trajectory), 58 | type = "l", 59 | xlab = "time", 60 | ylab = "speciation rate") 61 | } 62 | } 63 | \references{ 64 | Magee et al. (2019) Locally adaptive Bayesian birth-death model 65 | successfully detects slow and rapid rate shifts. 66 | doi: https://doi.org/10.1101/853960 67 | } 68 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(GeomStepribbon) 4 | export(calculateShiftBayesFactor) 5 | export(colFun) 6 | export(combineTraces) 7 | export(densiTreeWithBranchData) 8 | export(dropTip) 9 | export(geom_stepribbon) 10 | export(getMAP) 11 | export(matchNodes) 12 | export(plotAncStatesMAP) 13 | export(plotAncStatesPie) 14 | export(plotDivRates) 15 | export(plotDiversityOBDP) 16 | export(plotFBDTree) 17 | export(plotHiSSE) 18 | export(plotMassExtinctions) 19 | export(plotMuSSE) 20 | export(plotPopSizes) 21 | export(plotPostPredStats) 22 | export(plotTrace) 23 | export(plotTree) 24 | export(posteriorSamplesToParametricPrior) 25 | export(processAncStates) 26 | export(processBranchData) 27 | export(processDivRates) 28 | export(processPopSizes) 29 | export(processPostPredStats) 30 | export(processSSE) 31 | export(readOBDP) 32 | export(readTrace) 33 | export(readTrees) 34 | export(removeBurnin) 35 | export(rerootPhylo) 36 | export(setMRFGlobalScaleHyperpriorNShifts) 37 | export(simulateMRF) 38 | export(summarizeTrace) 39 | importClassesFrom(tidytree,treedata) 40 | importFrom(ape,collapse.singles) 41 | importFrom(ape,ltt.plot.coords) 42 | importFrom(ape,read.tree) 43 | importFrom(ggplot2,GeomRibbon) 44 | importFrom(ggplot2,aes) 45 | importFrom(ggplot2,aes_) 46 | importFrom(ggplot2,annotate) 47 | importFrom(ggplot2,element_blank) 48 | importFrom(ggplot2,element_line) 49 | importFrom(ggplot2,element_rect) 50 | importFrom(ggplot2,geom_line) 51 | importFrom(ggplot2,ggplot) 52 | importFrom(ggplot2,ggtitle) 53 | importFrom(ggplot2,layer) 54 | importFrom(ggplot2,scale_color_manual) 55 | importFrom(ggplot2,scale_x_continuous) 56 | importFrom(ggplot2,scale_y_continuous) 57 | importFrom(ggplot2,theme) 58 | importFrom(grDevices,col2rgb) 59 | importFrom(grDevices,colorRampPalette) 60 | importFrom(graphics,axis) 61 | importFrom(graphics,par) 62 | importFrom(graphics,plot.new) 63 | importFrom(graphics,plot.window) 64 | importFrom(graphics,strwidth) 65 | importFrom(graphics,text) 66 | importFrom(scales,colour_ramp) 67 | importFrom(stats,approxfun) 68 | importFrom(stats,density) 69 | importFrom(stats,na.omit) 70 | importFrom(stats,optimize) 71 | importFrom(stats,pnorm) 72 | importFrom(stats,qcauchy) 73 | importFrom(stats,quantile) 74 | importFrom(stats,rcauchy) 75 | importFrom(stats,rnorm) 76 | importFrom(stats,time) 77 | importFrom(stats,weighted.mean) 78 | importFrom(tidyr,pivot_longer) 79 | importFrom(utils,read.csv) 80 | importFrom(utils,read.table) 81 | importFrom(utils,setTxtProgressBar) 82 | importFrom(utils,txtProgressBar) 83 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:------------------------------------------| 5 | |version |R version 4.3.1 (2023-06-16) | 6 | |os |macOS Ventura 13.3 | 7 | |system |aarch64, darwin20 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |Pacific/Honolulu | 13 | |date |2023-11-29 | 14 | |rstudio |2023.06.1+524 Mountain Hydrangea (desktop) | 15 | |pandoc |NA | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:-----------------|:-----|:----------|:--| 21 | |RevGadgets |1.2.0 |1.2.0.9000 |* | 22 | |aplot |NA |0.2.2 |* | 23 | |clusterGeneration |NA |1.3.8 |* | 24 | |dplyr |NA |1.1.4 |* | 25 | |expm |NA |0.999-7 |* | 26 | |fastmatch |NA |1.1-4 |* | 27 | |ggfittext |NA |0.10.1 |* | 28 | |ggfun |NA |0.1.3 |* | 29 | |ggplot2 |NA |3.4.4 |* | 30 | |ggplotify |NA |0.1.2 |* | 31 | |ggpp |NA |0.5.5 |* | 32 | |ggtree |NA |3.10.0 |* | 33 | |gtable |NA |0.3.4 |* | 34 | |igraph |NA |1.5.1 |* | 35 | |labeling |NA |0.4.3 |* | 36 | |lifecycle |NA |1.0.4 |* | 37 | |lubridate |NA |1.9.3 |* | 38 | |magick |NA |2.8.1 |* | 39 | |maps |NA |3.4.1.1 |* | 40 | |markdown |NA |1.11 |* | 41 | |patchwork |NA |1.1.3 |* | 42 | |phytools |NA |2.0-3 |* | 43 | |plyr |NA |1.8.9 |* | 44 | |polyclip |NA |1.10-6 |* | 45 | |purrr |NA |1.0.2 |* | 46 | |RcppEigen |NA |0.3.3.9.4 |* | 47 | |rlang |NA |1.1.2 |* | 48 | |stringi |NA |1.8.2 |* | 49 | |stringr |NA |1.5.1 |* | 50 | |systemfonts |NA |1.0.5 |* | 51 | |tidytree |NA |0.4.5 |* | 52 | |treeio |NA |1.26.0 |* | 53 | |yulab.utils |NA |0.1.0 |* | 54 | 55 | # Revdeps 56 | 57 | -------------------------------------------------------------------------------- /man/processBranchData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/processBranchData.R 3 | \name{processBranchData} 4 | \alias{processBranchData} 5 | \title{processBranchData} 6 | \usage{ 7 | processBranchData( 8 | tree, 9 | dat, 10 | burnin = 0.25, 11 | parnames = c("avg_lambda", "avg_mu", "num_shifts"), 12 | summary = "median", 13 | net_div = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{tree}{(treedata object; no default) a phylogenetic tree in the 18 | treedata format, or a list of lists of a single tree data object, such as the 19 | output of readTrees().} 20 | 21 | \item{dat}{(data.frame or list; no default) a data frame, or a list 22 | (of length 1) of a data frame, with branch specific data, such as the output 23 | of readTrace().} 24 | 25 | \item{burnin}{(numeric; 0.25) fraction of the markov-chain to discard} 26 | 27 | \item{parnames}{(character vector; c("avg_lambda", "avg_mu", "num_shifts")) 28 | Names of parameters to process} 29 | 30 | \item{summary}{(character; "median") function to summarize the continuous 31 | parameter. Typically mean or median} 32 | 33 | \item{net_div}{(logical; FALSE) Calculate net diversification?} 34 | } 35 | \value{ 36 | a treedata file with attached branch-specific data 37 | } 38 | \description{ 39 | processBranchData 40 | } 41 | \examples{ 42 | \donttest{ 43 | 44 | # download the example dataset to working directory 45 | url_rates <- 46 | "https://revbayes.github.io/tutorials/intro/data/primates_BDS_rates.log" 47 | dest_path_rates <- "primates_BDS_rates.log" 48 | download.file(url_rates, dest_path_rates) 49 | 50 | url_tree <- 51 | "https://revbayes.github.io/tutorials/divrate/data/primates_tree.nex" 52 | dest_path_tree <- "primates_tree.nex" 53 | download.file(url_tree, dest_path_tree) 54 | 55 | # to run on your own data, change this to the path to your data file 56 | treefile <- dest_path_tree 57 | logfile <- dest_path_rates 58 | 59 | branch_data <- readTrace(logfile) 60 | tree <- readTrees(paths = treefile) 61 | 62 | annotated_tree <- processBranchData(tree, branch_data, summary = "median") 63 | 64 | # you can plot this output 65 | p <- plotTree(tree = annotated_tree, 66 | node_age_bars = FALSE, 67 | node_pp = FALSE, 68 | tip_labels = FALSE, 69 | color_branch_by = "avg_lambda", 70 | line_width = 0.8) + 71 | ggplot2::theme(legend.position=c(.1, .9));p 72 | # remove files 73 | # WARNING: only run for example dataset! 74 | # otherwise you might delete your data! 75 | file.remove(dest_path_tree, dest_path_rates) 76 | } 77 | } 78 | -------------------------------------------------------------------------------- /R/processAncStates.R: -------------------------------------------------------------------------------- 1 | #' Process Ancestral States 2 | #' 3 | #' Process data for ancestral states plotting 4 | #' 5 | #' @param path (character string; no default) File path to annotated tree. 6 | #' @param state_labels (character vector; NULL) Vector of labels for ancestral 7 | #' states named with the current state labels in annotated tree file 8 | #' (as characters). 9 | #' @param labels_as_numbers (logical; FALSE) Should the state labels be treated 10 | #' as integers (for example, as chromosome numbers)? 11 | #' 12 | #' @param missing_to_NA (logical; TRUE) Should missing data, coded as "?", be 13 | #' coded to NA? If TRUE, the state will not be plotted. If FALSE, it will be 14 | #' considered an additional state when plotting. 15 | #' 16 | #' @return A treedata object 17 | #' 18 | #' @examples 19 | #' 20 | #' # standard ancestral state estimation example 21 | #' file <- system.file("extdata", 22 | #' "comp_method_disc/ase_freeK.tree", 23 | #' package="RevGadgets") 24 | #' example <- processAncStates(file, 25 | #' state_labels = c("1" = "Awesome", 26 | #' "2" = "Beautiful", 27 | #' "3" = "Cool!")) 28 | #' 29 | #' #chromosome evolution example 30 | #' file <- system.file("extdata", 31 | #' "chromo/ChromEvol_simple_final.tree", 32 | #' package="RevGadgets") 33 | #' chromo_example <- processAncStates(file, labels_as_numbers = TRUE) 34 | #' 35 | #' @export 36 | #' 37 | processAncStates <- 38 | function(path, 39 | state_labels = NULL, 40 | labels_as_numbers = FALSE, 41 | missing_to_NA = TRUE) { 42 | # read in tree 43 | tree <- readTrees(path) 44 | t <- tree[[1]][[1]] 45 | 46 | # process column names 47 | include_start_states <- FALSE 48 | if ("anc_state_1" %in% names(t@data)) { 49 | # do nothing 50 | } else if ("start_state_1" %in% names(t@data) && 51 | "end_state_1" %in% names(t@data)) { 52 | include_start_states <- TRUE 53 | } else { 54 | stop( 55 | "tree file does not contain expected state labels: 56 | [\'anc_state\'] or [\'start_state\' and \'end_state\']" 57 | ) 58 | } 59 | 60 | # add state labels 61 | t <- 62 | .assign_state_labels(t, 63 | state_labels, 64 | include_start_states, 65 | labels_as_numbers, 66 | missing_to_NA) 67 | 68 | # add range for pp factors 69 | t <- .set_pp_factor_range(t, include_start_states) 70 | 71 | # return processed TreeIO object 72 | return(t) 73 | 74 | } 75 | -------------------------------------------------------------------------------- /tests/testthat/test_processPopSizes.R: -------------------------------------------------------------------------------- 1 | context("tests the processPopSizes function") 2 | 3 | test_that("processes population size output", { 4 | file_popsizes_constant <- 5 | system.file("extdata", 6 | "pop_size/horses_constant_popsizes_mini.p", 7 | package = "RevGadgets") 8 | 9 | file_popsizes_CPP <- 10 | system.file("extdata", 11 | "pop_size/horses_CPP_popsizes_mini.p", 12 | package = "RevGadgets") 13 | file_changepoints_CPP <- 14 | system.file("extdata", 15 | "pop_size/horses_CPP_times_mini.p", 16 | package = "RevGadgets") 17 | 18 | file_popsizes_GMRF <- 19 | system.file("extdata", 20 | "pop_size/horses_GMRF_popsizes_mini.p", 21 | package = "RevGadgets") 22 | file_changepoints_GMRF <- 23 | system.file("extdata", 24 | "pop_size/horses_GMRF_times_mini.p", 25 | package = "RevGadgets") 26 | 27 | constant <- processPopSizes( 28 | population_size_log = file_popsizes_constant, 29 | ) 30 | 31 | CPP <- processPopSizes( 32 | population_size_log = file_popsizes_CPP, 33 | interval_change_points_log = file_changepoints_CPP, 34 | num_grid_points = 200 35 | ) 36 | 37 | GMRF <- processPopSizes( 38 | population_size_log = file_popsizes_GMRF, 39 | interval_change_points_log = file_changepoints_GMRF, 40 | burnin = 0, 41 | spacing = "equal", 42 | min_age = 0, 43 | max_age = 300000, 44 | distribution = TRUE 45 | ) 46 | 47 | expect_equal(ncol(constant), 4) 48 | expect_equal(class(constant), c("tbl_df", "tbl", "data.frame")) 49 | expect_equal(nrow(constant), 100) 50 | expect_equal(max(constant$time), 1e5) 51 | expect_equal(constant$value[1], 313240.8) 52 | 53 | expect_equal(ncol(CPP), 4) 54 | expect_equal(class(CPP), c("tbl_df", "tbl", "data.frame")) 55 | expect_equal(nrow(CPP), 200) 56 | expect_equal(max(CPP$time), 466634) 57 | expect_equal(round(CPP$value[c(1,200)]), c(505782, 27198800)) 58 | 59 | expect_equal(ncol(GMRF), 11) 60 | expect_equal(class(GMRF), c("matrix", "array")) 61 | expect_equal(nrow(GMRF), 100) 62 | expect_equal(GMRF[1,], c(545066, 465357, 603280, 394040, 682751, 535117, 519354, 535540, 502588, 729053, 737713)) 63 | expect_equal(GMRF[100,], c(601042, 375759, 137952, 344189, 312312, 547615, 405185, 347487, 498597, 126805, 635706)) 64 | }) 65 | -------------------------------------------------------------------------------- /R/setMRFGlobalScaleHyperpriorNShifts.R: -------------------------------------------------------------------------------- 1 | #' Sets a global scale parameter for a GMRF or HSMRF model given a prior 2 | #' mean number of effective shifts. 3 | #' 4 | #' This function finds the global scale parameter value that produces the 5 | #' desired prior mean number of "effective" rate shifts. Given a specified 6 | #' magnitude for an effective shift, shift_size, an effective shift occurs 7 | #' when two adjacent values are more than shift_size-fold apart from each other. 8 | #' That is, an effective shift is the event that rate[i+1]/rate[i] > shift_size 9 | #' or rate[i+1]/rate[i] < 1/shift_size. 10 | #' 11 | #' Finding these values for a HSMRF model can take several seconds for large 12 | #' values of n_episodes because of the required numerical integration. 13 | #' 14 | #' @param n_episodes (numeric; no default) The number of episodes in the random 15 | #' field (the parameter vector will be this long). 16 | #' @param model (character; no default) What model should the global scale 17 | #' parameter be set for? Options are "GMRF" and "HSMRF" for first-order models 18 | #' (also allowable: "GMRF1" and "HSMRF1") and "GMRF2" and HSMRF2" for 19 | #' second-order models. 20 | #' @param prior_n_shifts (numeric; log(2)) The desired prior mean number of 21 | #' shifts. 22 | #' @param shift_size (numeric; 2) The magnitude of change that defines an 23 | #' effective shift (measured as a fold-change). 24 | #' @return The hyperprior. 25 | #' 26 | #' @references 27 | #' 28 | #' Magee et al. (2019) Locally adaptive Bayesian birth-death model 29 | #' successfully detects slow and rapid rate shifts. 30 | #' doi: https://doi.org/10.1101/853960 31 | #' 32 | #' @examples 33 | #' \donttest{ 34 | #' # Get global scale for a HSMRF model with 100 episodes. 35 | #' gs <- setMRFGlobalScaleHyperpriorNShifts(100, "HSMRF") 36 | #' 37 | #' # Plot a draw from this HSMRF distribution 38 | #' 39 | #' trajectory <- simulateMRF(n_episodes = 100, 40 | #' model = "HSMRF", 41 | #' global_scale_hyperprior = gs) 42 | #' 43 | #' plot(1:100, 44 | #' rev(trajectory), 45 | #' type = "l", 46 | #' xlab = "time", 47 | #' ylab = "speciation rate") 48 | #' } 49 | #' @export 50 | 51 | 52 | setMRFGlobalScaleHyperpriorNShifts <- 53 | function(n_episodes, 54 | model, 55 | prior_n_shifts = log(2), 56 | shift_size = 2) { 57 | if (model == "GMRF") { 58 | hyperprior <- 59 | .setGMRFGlobalScaleExpectedNumberOfJumps(n_episodes, 60 | prior_n_shifts, 61 | shift_size) 62 | } else if (model == "HSMRF") { 63 | hyperprior <- 64 | .setHSMRFGlobalScaleExpectedNumberOfJumps(n_episodes, 65 | prior_n_shifts, 66 | shift_size) 67 | } else { 68 | stop("Unrecognized option for \"model\"") 69 | } 70 | return(hyperprior$hyperprior) 71 | } 72 | -------------------------------------------------------------------------------- /inst/extdata/fbd/bears.mcc.tre: -------------------------------------------------------------------------------- 1 | #NEXUS 2 | 3 | Begin taxa; 4 | Dimensions ntax=20; 5 | Taxlabels 6 | Agriarctos_spp 7 | Ailurarctos_lufengensis 8 | Ailuropoda_melanoleuca 9 | Arctodus_simus 10 | Ballusia_elmensis 11 | Helarctos_malayanus 12 | Indarctos_arctoides 13 | Indarctos_punjabiensis 14 | Indarctos_vireti 15 | Kretzoiarctos_beatrix 16 | Melursus_ursinus 17 | Tremarctos_ornatus 18 | Ursavus_brevirhinus 19 | Ursavus_primaevus 20 | Ursus_americanus 21 | Ursus_arctos 22 | Ursus_maritimus 23 | Ursus_spelaeus 24 | Ursus_thibetanus 25 | Zaragocyon_daamsi 26 | ; 27 | End; 28 | 29 | Begin trees; 30 | tree TREE1 = [&R](((((((((Ailuropoda_melanoleuca[&index=10]:7.801817)Ailurarctos_lufengensis[&index=21,posterior=0.256991,age_95%_HPD={6.64001,8.1982},sampled_ancestor=0.467377]:1.366333,Agriarctos_spp[&index=19,sampled_ancestor=0.264980,age_95%_HPD={5.13563,7.7489}]:2.559428)[&index=22,posterior=0.328895,age_95%_HPD={7.75754,10.9303}]:1.473766,((Indarctos_arctoides[&index=7,sampled_ancestor=0.351531,age_95%_HPD={5.0131,9.69924}]:1.875503)Indarctos_punjabiensis[&index=23,posterior=0.154461,age_95%_HPD={7.28854,9.69991},sampled_ancestor=0.528628]:0.808470,Indarctos_vireti[&index=4,sampled_ancestor=0.138482,age_95%_HPD={7.85346,8.69269}]:1.606633)[&index=24,posterior=0.312916,age_95%_HPD={8.72817,10.9523}]:0.717725)[&index=25,posterior=0.591212,age_95%_HPD={9.44492,11.7607}]:1.038375)Kretzoiarctos_beatrix[&index=26,posterior=0.535286,age_95%_HPD={11.3942,11.7999},sampled_ancestor=0.909454]:4.177918)Ursavus_primaevus[&index=27,posterior=0.420772,age_95%_HPD={15.5618,15.97},sampled_ancestor=0.569907]:0.883936)Ursavus_brevirhinus[&index=28,posterior=0.354194,age_95%_HPD={16.2798,16.8996},sampled_ancestor=0.842876]:3.765166,(((((Ursus_americanus[&index=15]:2.829507,Ursus_thibetanus[&index=18]:2.829507)[&index=29,posterior=0.758988,age_95%_HPD={1.22039,4.36821}]:0.737650,Helarctos_malayanus[&index=13]:3.567157)[&index=30,posterior=0.993342,age_95%_HPD={1.85239,5.83876}]:0.941132,((Ursus_arctos[&index=16]:1.503686,Ursus_maritimus[&index=12]:1.503686)[&index=31,posterior=1.000000,age_95%_HPD={0.513308,2.69051}]:1.642701,Ursus_spelaeus[&index=14,age_95%_HPD={0.06962,0.245158}]:2.972521)[&index=32,posterior=0.986684,age_95%_HPD={1.22187,5.83336}]:1.361901)[&index=33,posterior=0.965379,age_95%_HPD={2.39173,7.55755}]:2.506113,Melursus_ursinus[&index=17]:7.014401)[&index=34,posterior=1.000000,age_95%_HPD={4.41289,11.1142}]:4.086867,(Arctodus_simus[&index=6,sampled_ancestor=0.003995,age_95%_HPD={0.670375,2.58573}]:3.401332,Tremarctos_ornatus[&index=9]:5.247488)[&index=35,posterior=0.994674,age_95%_HPD={1.73983,9.46342}]:5.853780)[&index=36,posterior=1.000000,age_95%_HPD={5.75446,17.6826}]:9.406043)[&index=37,posterior=0.399467,age_95%_HPD={16.7729,27.5404}]:5.439961,Ballusia_elmensis[&index=11,sampled_ancestor=0.487350,age_95%_HPD={14.4635,22.7975}]:6.045218)[&index=38,posterior=0.403462,age_95%_HPD={19.7677,34.694}]:6.089001,Zaragocyon_daamsi[&index=2,sampled_ancestor=0.017310,age_95%_HPD={20.2921,22.7797}]:10.366901)[&index=39,posterior=0.997337,age_95%_HPD={24.7003,41.1459}]:0.000000; 31 | End; 32 | -------------------------------------------------------------------------------- /R/processPostPredStats.R: -------------------------------------------------------------------------------- 1 | #' process Posterior Predictive Statistics 2 | #' 3 | #' Reads in and processes posterior-predictive statistics 4 | #' 5 | #' @param path_sim (character string; no default) Path to the .csv file 6 | #' containing the simulated data results 7 | #' @param path_emp (character string; no default) Path to the .csv file 8 | #' containing the empirical values 9 | #' 10 | #' @return A list of data frames 11 | #' 12 | #' @examples 13 | #' 14 | #' \donttest{ 15 | #' # download the example datasets to working directory 16 | #' 17 | #' url_emp <- 18 | #' "https://revbayes.github.io/tutorials/intro/data/empirical_data_pps_example.csv" 19 | #' dest_path_emp <- "empirical_data_pps_example.csv" 20 | #' download.file(url_emp, dest_path_emp) 21 | #' 22 | #' url_sim <- 23 | #' "https://revbayes.github.io/tutorials/intro/data/simulated_data_pps_example.csv" 24 | #' dest_path_sim <- "simulated_data_pps_example.csv" 25 | #' download.file(url_sim, dest_path_sim) 26 | #' 27 | #' # to run on your own data, change this to the path to your data file 28 | #' file_sim <- dest_path_sim 29 | #' file_emp <- dest_path_emp 30 | #' 31 | #' t <- processPostPredStats(path_sim = file_sim, 32 | #' path_emp = file_emp) 33 | #' 34 | #' # remove files 35 | #' # WARNING: only run for example dataset! 36 | #' # otherwise you might delete your data! 37 | #' file.remove(dest_path_sim, dest_path_emp) 38 | #' } 39 | #' 40 | #' 41 | #' @export 42 | 43 | processPostPredStats <- function(path_sim, path_emp) { 44 | # parameter checks 45 | paths <- c(path_sim, path_emp) 46 | 47 | character_paths_are_strings <- is.character(paths) 48 | if (any(character_paths_are_strings == FALSE) == TRUE) { 49 | # print out the ones that are not character strings 50 | stop( 51 | paste0("Some paths are not character strings:", 52 | paste0("\t", paths[character_paths_are_strings == FALSE]), 53 | sep = "\n") 54 | ) 55 | } 56 | 57 | do_files_exist <- file.exists(paths) 58 | if (any(do_files_exist == FALSE) == TRUE) { 59 | # print out paths to files that don't exist 60 | stop( 61 | paste0("Some files do not exist:", 62 | paste0("\t", paths[do_files_exist == FALSE]), sep = "\n") 63 | ) 64 | } 65 | 66 | # read in data 67 | posterior_predictive_statistics <- read.table(path_sim, 68 | header = TRUE, 69 | sep = ",", 70 | check.names = FALSE) 71 | 72 | observed_statistics <- read.table(path_emp, 73 | header = TRUE, 74 | sep = ",", 75 | check.names = FALSE) 76 | 77 | # check that the statistics match 78 | if (length(setdiff( 79 | colnames(posterior_predictive_statistics), 80 | colnames(observed_statistics) 81 | )) > 0) { 82 | stop("Simulated and observed files do not have the same statistics.\n") 83 | } 84 | 85 | # return list 86 | return(list(simulated = posterior_predictive_statistics, 87 | observed = observed_statistics)) 88 | } 89 | 90 | -------------------------------------------------------------------------------- /R/colFun.R: -------------------------------------------------------------------------------- 1 | #' Color Function 2 | #' 3 | #' Produce default RevGadgets colors 4 | #' 5 | #' Produces a vector of colors from the default RevGadgets colors 6 | #' of length given by n, maximum of 12 colors. 7 | #' 8 | #' @param n (integer; no default) Number of colors to return. Maximum of 12. 9 | #' 10 | #' @return Character vector of color hex codes. 11 | #' 12 | #' @examples 13 | #' 14 | #' my_colors <- colFun(2) 15 | #' 16 | #' @export 17 | #' 18 | 19 | colFun <- function(n) { 20 | if (n %% 1 != 0) { 21 | stop("n must be an integer") 22 | } 23 | if (n == 1) { 24 | return("#005ac8") 25 | } 26 | if (n == 2) { 27 | return(c("#005ac8", "#fa7850")) 28 | } 29 | if (n == 3) { 30 | return(c("#14d2dc", "#005ac8", "#fa7850")) 31 | } 32 | if (n == 4) { 33 | return(c("#14d2dc", "#005ac8", "#fa7850", "#aa0a3c")) 34 | } 35 | if (n == 5) { 36 | return(c("#14d2dc", "#005ac8", "#fa7850", "#aa0a3c", 37 | "#0ab45a")) 38 | } 39 | if (n == 6) { 40 | return(c( 41 | "#14d2dc", 42 | "#005ac8", 43 | "#fa7850", 44 | "#aa0a3c", 45 | "#0ab45a", 46 | "#006e82" 47 | )) 48 | } 49 | if (n == 7) { 50 | return(c( 51 | "#14d2dc", 52 | "#005ac8", 53 | "#fa7850", 54 | "#aa0a3c", 55 | "#0ab45a", 56 | "#006e82", 57 | "#fa78fa" 58 | )) 59 | } 60 | if (n == 8) { 61 | return( 62 | c( 63 | "#14d2dc", 64 | "#005ac8", 65 | "#fa7850", 66 | "#aa0a3c", 67 | "#0ab45a", 68 | "#006e82", 69 | "#fa78fa", 70 | "#8214a0" 71 | ) 72 | ) 73 | } 74 | if (n == 9) { 75 | return( 76 | c( 77 | "#14d2dc", 78 | "#005ac8", 79 | "#fa7850", 80 | "#aa0a3c", 81 | "#0ab45a", 82 | "#006e82", 83 | "#fa78fa", 84 | "#8214a0", 85 | "#fae6be" 86 | ) 87 | ) 88 | } 89 | if (n == 10) { 90 | return( 91 | c( 92 | "#14d2dc", 93 | "#005ac8", 94 | "#fa7850", 95 | "#aa0a3c", 96 | "#0ab45a", 97 | "#006e82", 98 | "#fa78fa", 99 | "#8214a0", 100 | "#fae6be", 101 | "#00a0fa" 102 | ) 103 | ) 104 | } 105 | if (n == 11) { 106 | return( 107 | c( 108 | "#14d2dc", 109 | "#005ac8", 110 | "#fa7850", 111 | "#aa0a3c", 112 | "#0ab45a", 113 | "#006e82", 114 | "#fa78fa", 115 | "#8214a0", 116 | "#fae6be", 117 | "#00a0fa", 118 | "#f0f032" 119 | ) 120 | ) 121 | } 122 | 123 | if (n == 12) { 124 | return( 125 | c( 126 | "#14d2dc", 127 | "#005ac8", 128 | "#fa7850", 129 | "#aa0a3c", 130 | "#0ab45a", 131 | "#006e82", 132 | "#fa78fa", 133 | "#8214a0", 134 | "#fae6be", 135 | "#00a0fa", 136 | "#f0f032", 137 | "#a0fa82" 138 | ) 139 | ) 140 | } 141 | if (n >= 13) { 142 | stop("more than 12 colors is not supported") 143 | } 144 | } 145 | -------------------------------------------------------------------------------- /man/plotMassExtinctions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotMassExtinctions.R 3 | \name{plotMassExtinctions} 4 | \alias{plotMassExtinctions} 5 | \title{Plot Mass Extinction Support} 6 | \usage{ 7 | plotMassExtinctions( 8 | mass_extinction_trace, 9 | mass_extinction_times, 10 | mass_extinction_name, 11 | prior_prob, 12 | return_2lnBF = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{mass_extinction_trace}{(list; no default) The processed Rev output of 17 | the mass extinction probabilities (output of readTrace()).} 18 | 19 | \item{mass_extinction_times}{(numeric; no default) Vector of the fixed grid 20 | of times at which mass extinctions were allowed to occur.} 21 | 22 | \item{mass_extinction_name}{(character; no default) The name of the mass 23 | extinction probability parameter (e.g. "mass_extinction_probabilities") 24 | for which support is to be calculated/plotted.} 25 | 26 | \item{prior_prob}{(numeric; no default) The per-interval prior probability 27 | of a mass extinction (one minus the p parameter in RevBayes' 28 | dnReversibleJumpMixture()).} 29 | 30 | \item{return_2lnBF}{(logical; TRUE) Should the 2ln(BF) be returned (if TRUE) 31 | or simply the BF (if FALSE)?} 32 | } 33 | \value{ 34 | A ggplot object 35 | } 36 | \description{ 37 | Plots the support (as 2ln Bayes factors) for mass extinctions. 38 | } 39 | \details{ 40 | Works only for analyses with a fixed grid where mass extinctions may occur. 41 | 42 | The return object can be manipulated. For example, you can change the axis 43 | labels, the color palette, whether the axes are to be linked, or the overall 44 | plotting style/theme, just as with any ggplot object. 45 | } 46 | \examples{ 47 | \donttest{ 48 | 49 | # download the example dataset to working directory 50 | url <- 51 | "https://revbayes.github.io/tutorials/intro/data/crocs_mass_extinction_probabilities.log" 52 | dest_path <- "crocs_mass_extinction_probabilities.log" 53 | download.file(url, dest_path) 54 | 55 | # to run on your own data, change this to the path to your data file 56 | mass_extinction_probability_file <- dest_path 57 | 58 | mass_extinction_probabilities <- 59 | readTrace(mass_extinction_probability_file,burnin = 0.25) 60 | 61 | # prior probability of mass extinction at any time 62 | prior_n_expected <- 0.1 63 | n_intervals <- 100 64 | prior_prob <- prior_n_expected/(n_intervals-1) 65 | 66 | # times when mass extinctions were allowed 67 | tree_age <- 243.5 68 | interval_times <- tree_age * seq(1/n_intervals,(n_intervals-1) / 69 | n_intervals,1/n_intervals) 70 | 71 | # then plot results: 72 | p <- plotMassExtinctions(mass_extinction_trace=mass_extinction_probabilities, 73 | mass_extinction_times=interval_times, 74 | mass_extinction_name="mass_extinction_probabilities" 75 | ,prior_prob);p 76 | 77 | # remove file 78 | # WARNING: only run for example dataset! 79 | # otherwise you might delete your data! 80 | file.remove(dest_path) 81 | } 82 | 83 | } 84 | \references{ 85 | Kass and Raftery (1995) Bayes Factors. 86 | \emph{JASA}, \bold{90 (430)}, 773-795. 87 | } 88 | -------------------------------------------------------------------------------- /man/readOBDP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readOBDP.R 3 | \name{readOBDP} 4 | \alias{readOBDP} 5 | \title{Read OBDP Outputs} 6 | \usage{ 7 | readOBDP( 8 | start_time_trace_file, 9 | popSize_distribution_matrices_file, 10 | trees_trace_file 11 | ) 12 | } 13 | \arguments{ 14 | \item{start_time_trace_file}{(character; no default) Trace of the starting times along the MCMC chain.} 15 | 16 | \item{popSize_distribution_matrices_file}{(character; no default) Kt matrices computed with `fnInferAncestralPopSize` in RevBayes.} 17 | 18 | \item{trees_trace_file}{(character; no default) Trace of the trees.} 19 | } 20 | \value{ 21 | A data.frame 22 | } 23 | \description{ 24 | Reads and formats the outputs of an analysis with the Occurrence Birth Death Process (MCMC parameter 25 | inference + diversity estimation) 26 | } 27 | \examples{ 28 | 29 | \dontrun{ 30 | # first run readOBDP() 31 | start_time_trace_file <- 32 | system.file("extdata", "obdp/start_time_trace.p", package="RevGadgets") 33 | popSize_distribution_matrices_file <- 34 | system.file("extdata", "obdp/Kt_trace.p", package="RevGadgets") 35 | trees_trace_file <- 36 | system.file("extdata", "obdp/mcmc_OBDP_trees.p", package="RevGadgets") 37 | 38 | Kt_mean <- readOBDP( start_time_trace_file=start_time_trace_file, 39 | popSize_distribution_matrices_file=popSize_distribution_matrices_file, 40 | trees_trace_file=trees_trace_file ) 41 | 42 | # then get the customized ggplot object with plotDiversityOBDP() 43 | p <- plotDiversityOBDP( Kt_mean, 44 | xlab="Time (My)", 45 | ylab="Number of lineages", 46 | xticks_n_breaks=21, 47 | col_Hidden="dodgerblue3", 48 | col_LTT="gray25", 49 | col_Total="forestgreen", 50 | col_Hidden_interval="dodgerblue2", 51 | col_Total_interval="darkolivegreen4", 52 | palette_Hidden=c("transparent", "dodgerblue2", "dodgerblue3", 53 | "dodgerblue4", "black"), 54 | palette_Total=c("transparent", "green4", "forestgreen", "black"), 55 | line_size=0.7, 56 | interval_line_size=0.5, 57 | show_Hidden=TRUE, 58 | show_LTT=TRUE, 59 | show_Total=TRUE, 60 | show_intervals=TRUE, 61 | show_densities=TRUE, 62 | show_expectations=TRUE, 63 | use_interpolate=TRUE ) 64 | 65 | # basic plot 66 | p 67 | 68 | # option: add a stratigraphic scale 69 | library(deeptime) 70 | library(ggplot2) 71 | q <- gggeo_scale(p, dat="periods", height=unit(1.3, "line"), abbrv=F, size=4.5, neg=T) 72 | r <- gggeo_scale(q, dat="epochs", height=unit(1.1, "line"), abbrv=F, size=3.5, neg=T, 73 | skip=c("Paleocene", "Pliocene", "Pleistocene", "Holocene")) 74 | s <- gggeo_scale(r, dat="stages", height=unit(1, "line"), abbrv=T, size=2.5, neg=T) 75 | s 76 | } 77 | 78 | } 79 | -------------------------------------------------------------------------------- /R/simulateMRF.R: -------------------------------------------------------------------------------- 1 | #' Simulates a single Markov random field trajectory. 2 | #' 3 | #' This function simulates a draw from a HSMRF or GMRF distribution given a 4 | #' user-specified global scale parameter. The MRF can be taken to be on the 5 | #' log-scale (such as for a birth rate) or the real-scale. The first value 6 | #' must be specified 7 | #' 8 | #' @param n_episodes (numeric; no default) The number of episodes in the random 9 | #' field (the parameter vector will be this long). 10 | #' @param model (character; no default) What model should the global scale 11 | #' parameter be set for? Options are "GMRF" and "HSMRF". 12 | #' @param global_scale_hyperprior (numeric; no default) The hyperprior on the 13 | #' global scale parameter. 14 | #' @param initial_value (numeric; NULL) The first value in the MRF. If no value 15 | #' is specified, the field is assumed to start at 0 (if exponentiate=FALSE) or 16 | #' 1 (if exponentiate=TRUE). 17 | #' @param exponentiate (logical; TRUE) If TRUE, the MRF model is taken to be on 18 | #' the log-scale and the values are returned on the real-scale (note this means 19 | #' that the specified initial value will be the log of the true initial value). 20 | #' If FALSE, the model is taken to be on the real scale. 21 | #' @return A vector drawn from the specified MRF model on the specified 22 | #' (log- or real-) scale. 23 | #' 24 | #' @references 25 | #' 26 | #' Magee et al. (2020) Locally adaptive Bayesian birth-death model 27 | #' successfully detects slow and rapid rate shifts. 28 | #' \emph{PLoS Computational Biology}, \bold{16 (10)}: e1007999. 29 | #' 30 | #' Faulkner, James R., and Vladimir N. Minin. Locally adaptive smoothing with 31 | #' Markov random fields and shrinkage priors. 32 | #' \emph{Bayesian analysis}, \bold{13 (1)}, 225. 33 | #' 34 | #' @examples 35 | #' \donttest{ 36 | #' # Simulate a 100-episode HSMRF model for a speciation-rate through time 37 | #' trajectory <- simulateMRF(n_episodes = 100, 38 | #' model = "HSMRF", 39 | #' global_scale_hyperprior = 0.0021) 40 | #' plot(1:100, 41 | #' rev(trajectory), 42 | #' type = "l", 43 | #' xlab = "time", 44 | #' ylab = "speciation rate") 45 | #' } 46 | #' @export 47 | 48 | simulateMRF <- 49 | function(n_episodes, 50 | model, 51 | global_scale_hyperprior, 52 | initial_value = NULL, 53 | exponentiate = TRUE) { 54 | ndiffs <- n_episodes - 1 55 | if (toupper(model) == "GMRF") { 56 | local_scales <- rep(1.0, ndiffs) 57 | } else if (toupper(model) == "HSMRF") { 58 | local_scales <- abs(rcauchy(ndiffs, 0.0, 1.0)) 59 | } else { 60 | stop("Unrecognized option for \"model\"") 61 | } 62 | 63 | global_scale <- abs(rcauchy(1, 0.0, 1.0)) 64 | 65 | delta <- 66 | rnorm(ndiffs, 67 | 0.0, 68 | local_scales * global_scale * global_scale_hyperprior) 69 | 70 | x <- numeric(n_episodes) 71 | if (is.numeric(initial_value)) { 72 | x[1] <- initial_value 73 | } else { 74 | x[1] <- 0.0 75 | } 76 | 77 | x[2:n_episodes] <- x[1] + cumsum(delta) 78 | 79 | if (exponentiate == TRUE) { 80 | x <- exp(x) 81 | } 82 | 83 | return(x) 84 | } 85 | -------------------------------------------------------------------------------- /man/readTrees.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readTrees.R 3 | \name{readTrees} 4 | \alias{readTrees} 5 | \title{Read trees} 6 | \usage{ 7 | readTrees(paths, tree_name = "psi", burnin = 0, n_cores = 1L, verbose = TRUE) 8 | } 9 | \arguments{ 10 | \item{paths}{(vector of character strings; no default) File path(s) to 11 | tree(s).} 12 | 13 | \item{tree_name}{(character string; default psi) Name of the tree variable.} 14 | 15 | \item{burnin}{(single numeric value; default = 0.1) Fraction of generations 16 | to discard (if value provided is between 0 and 1) or number of generations 17 | (if value provided is greater than 1).} 18 | 19 | \item{n_cores}{(integer; default 1) Number of cores for parallelizing.} 20 | 21 | \item{verbose}{(logical; default true) Display a status bar?} 22 | } 23 | \value{ 24 | A list (across runs) of lists (across samples) of treedata objects. 25 | } 26 | \description{ 27 | Reads in a tree file containing one or multiple trees 28 | } 29 | \details{ 30 | Reads in a tree file in either nexus or newick format, and containing a 31 | single tree or multiple trees (as in the results of a Bayesian analysis). 32 | For reading in annotated tree files of continuous character evolution, 33 | the parameter must be considered a node parameter rather than branch 34 | parameter. Set isNodeParameter = TRUE in the extended newick monitor 35 | (mnExtNewick) 36 | } 37 | \examples{ 38 | 39 | \donttest{ 40 | # read in a single nexus file 41 | 42 | # download the example dataset to working directory 43 | url_nex <- 44 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_MAP.tre" 45 | dest_path_nex <- "primates_cytb_GTR_MAP.tre" 46 | download.file(url_nex, dest_path_nex) 47 | 48 | # to run on your own data, change this to the path to your data file 49 | file <- dest_path_nex 50 | tree_single_old <- readTrees(paths = file) 51 | 52 | # remove file 53 | # WARNING: only run for example dataset! 54 | # otherwise you might delete your data! 55 | file.remove(dest_path_nex) 56 | 57 | # read in a single newick string 58 | 59 | # download the example dataset to working directory 60 | url_new <- 61 | "https://revbayes.github.io/tutorials/intro/data/primates.tre" 62 | dest_path_new <- "primates.tre" 63 | download.file(url_new, dest_path_new) 64 | 65 | # to run on your own data, change this to the path to your data file 66 | file_new <- dest_path_new 67 | tree_new <- readTrees(paths = file_new) 68 | 69 | # remove file 70 | # WARNING: only run for example dataset! 71 | # otherwise you might delete your data! 72 | file.remove(dest_path_new) 73 | 74 | 75 | # read in a tree trace (may take a few seconds) 76 | 77 | # download the example dataset to working directory 78 | url_multi <- 79 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.trees" 80 | dest_path_multi <- "primates_cytb_GTR.trees" 81 | download.file(url_multi, dest_path_multi) 82 | 83 | # to run on your own data, change this to the path to your data file 84 | file_multi <- dest_path_multi 85 | tree_multi <- readTrees(paths = file_multi) 86 | 87 | # remove file 88 | # WARNING: only run for example dataset! 89 | # otherwise you might delete your data! 90 | file.remove(dest_path_multi) 91 | } 92 | 93 | } 94 | -------------------------------------------------------------------------------- /R/plotPopSizes.R: -------------------------------------------------------------------------------- 1 | #' Plot Population Sizes 2 | #' 3 | #' Plots the output of a coalescent demographic analysis. 4 | #' 5 | #' Plots the output of coalescent demographic analyses. Takes as 6 | #' input the output of processPopSizes() and plotting parameters. 7 | #' 8 | #' The return object can be manipulated. For example, you can change the 9 | #' axis labels, the color palette, whether the axes are to be linked, or the 10 | #' overall plotting style/theme, just as with any ggplot object. 11 | #' 12 | #' @param df (data frame) such as produced by processPopSizes(), containing 13 | #' the data on population sizes and corresponding grid points (points in time for population size evaluation) 14 | #' @param plot_CIs (boolean; default: TRUE) specifies whether the credible intervals should be plotted. 15 | #' @param add (boolean; default: FALSE) specifies whether the new plot should be added to an existing ggplot2 object. If TRUE, 16 | #' the existing_plot has to be given. 17 | #' @param existing_plot (ggplot2 object; default: NULL) a ggplot2 object to which the new plot should be added. 18 | #' @param col (string; default: "#00883a") color for the trajectories 19 | #' 20 | #' 21 | #' @return a ggplot object 22 | #' 23 | #' @examples 24 | #' df <- dplyr::tibble("time" = c(0.0, 1.0, 2.0, 3.0, 4.0), 25 | #' "value" = c(1.0, 1.5, 2.0, 1.5, 1.5), 26 | #' "upper" = c(3.5, 7.0, 6.5, 5.0, 5.0), 27 | #' "lower" = c(0.5, 0.1, 0.5, 0.5, 0.8)) 28 | #' 29 | #' plotPopSizes(df) 30 | #' 31 | #' @export 32 | 33 | plotPopSizes <- function(df, 34 | plot_CIs = TRUE, 35 | add = FALSE, 36 | existing_plot = NULL, 37 | col = "#00883a"){ 38 | if (add == TRUE && is.null(existing_plot)){ 39 | stop("Please provide an existing plot if you want to add this one.") 40 | } 41 | 42 | `%>%` <- dplyr::`%>%` 43 | 44 | if (add == FALSE){ 45 | message("Using default time units in x-axis label: Age (years)") 46 | 47 | p <- df %>% 48 | ggplot2::ggplot(ggplot2::aes(x = time, y = value)) + 49 | ggplot2::geom_line(color = col, linewidth = 0.8) + 50 | ggplot2::scale_y_log10() + 51 | ggplot2::scale_x_reverse() + 52 | ggplot2::xlab("Age (years)") + 53 | ggplot2::ylab("Population Size") 54 | 55 | } else { 56 | p <- existing_plot + 57 | ggplot2::geom_line(data = df, 58 | ggplot2::aes(x = time, y = value), 59 | color = col, 60 | linewidth = 0.8) 61 | } 62 | 63 | if (plot_CIs == TRUE){ 64 | p <- p + 65 | ggplot2::geom_ribbon(data = df, 66 | ggplot2::aes(ymin = lower, ymax = upper), 67 | fill = col, 68 | alpha = 0.4) 69 | } 70 | 71 | p <- p + 72 | ggplot2::theme_bw() + 73 | ggplot2::theme(legend.title = ggplot2::element_blank(), 74 | legend.position = "none", 75 | panel.grid.major = ggplot2::element_blank(), 76 | panel.grid.minor = ggplot2::element_blank(), 77 | strip.background = ggplot2::element_blank()) 78 | 79 | return(p) 80 | } 81 | -------------------------------------------------------------------------------- /man/readTrace.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readTrace.R 3 | \name{readTrace} 4 | \alias{readTrace} 5 | \title{Read trace} 6 | \usage{ 7 | readTrace( 8 | paths, 9 | format = "simple", 10 | delim = "\\t", 11 | burnin = 0.1, 12 | check.names = FALSE, 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{paths}{(vector of character strings; no default) File path(s) to trace 18 | file.} 19 | 20 | \item{format}{(single character string; default = simple) Indicates type of 21 | MCMC trace, complex indicates cases where trace contains vectors of vectors/ 22 | matrices - mnStochasticVariable monitor will sometimes be of this type.} 23 | 24 | \item{delim}{(single character string; default = "\\t") Delimiter of file.} 25 | 26 | \item{burnin}{(single numeric value; default = 0.1) Fraction of generations 27 | to discard (if value provided is between 0 and 1) or number of generations 28 | (if value provided is greater than 1).} 29 | 30 | \item{check.names}{(logical; default = FALSE) Passed to utils::read.table(); 31 | indicates if utils::read.table() should check column names and replace 32 | syntactically invalid characters.} 33 | 34 | \item{...}{(various) Additional arguments passed to utils::read.table().} 35 | } 36 | \value{ 37 | List of dataframes (of length 1 if only 1 log file provided). 38 | } 39 | \description{ 40 | Reads in MCMC log files 41 | } 42 | \details{ 43 | Reads in one or multiple MCMC log files from the same analysis 44 | and discards a user-specified burn-in, compatible with multiple monitor 45 | types. If the trace contains vectors of vectors and the user does not specify 46 | format = "complex", readTrace() will read in those columns as factors 47 | rather than as numeric vectors. 48 | } 49 | \examples{ 50 | # read and process a single trace file 51 | 52 | \donttest{ 53 | # download the example dataset to working directory 54 | url_gtr <- 55 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 56 | dest_path_gtr <- "primates_cytb_GTR.log" 57 | download.file(url_gtr, dest_path_gtr) 58 | 59 | # to run on your own data, change this to the path to your data file 60 | file_single <- dest_path_gtr 61 | 62 | one_trace <- readTrace(paths = file_single) 63 | 64 | # remove file 65 | # WARNING: only run for example dataset! 66 | # otherwise you might delete your data! 67 | file.remove(dest_path_gtr) 68 | 69 | # read and process multiple trace files, such as from multiple runs of 70 | # the same analysis 71 | 72 | # download the example dataset to working directory 73 | url_1 <- 74 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_1.log" 75 | dest_path_1 <- "primates_cytb_GTR_run_1.log" 76 | download.file(url_1, dest_path_1) 77 | 78 | url_2 <- 79 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_2.log" 80 | dest_path_2 <- "primates_cytb_GTR_run_2.log" 81 | download.file(url_2, dest_path_2) 82 | 83 | # to run on your own data, change this to the path to your data file 84 | file_1 <- dest_path_1 85 | file_2 <- dest_path_2 86 | 87 | # read in the multiple trace files 88 | multi_trace <- readTrace(path = c(file_1, file_2), burnin = 0.0) 89 | 90 | # remove files 91 | # WARNING: only run for example dataset! 92 | # otherwise you might delete your data! 93 | file.remove(dest_path_1, dest_path_2) 94 | } 95 | 96 | } 97 | -------------------------------------------------------------------------------- /man/posteriorSamplesToParametricPrior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/posteriorSamplesToParametricPrior.R 3 | \name{posteriorSamplesToParametricPrior} 4 | \alias{posteriorSamplesToParametricPrior} 5 | \title{Priors from MCMC samples} 6 | \usage{ 7 | posteriorSamplesToParametricPrior( 8 | samples, 9 | distribution, 10 | variance_inflation_factor = 2 11 | ) 12 | } 13 | \arguments{ 14 | \item{samples}{(numeric vector; no default) MCMC samples for a single 15 | parameter.} 16 | 17 | \item{distribution}{(character; no default) The distribution to fit. Options 18 | are gamma for strictly positive 19 | parameters and normal for unbounded parameters.} 20 | 21 | \item{variance_inflation_factor}{(single numeric value; default = 2.0) Makes 22 | the prior variance larger than the variance of the posterior} 23 | } 24 | \value{ 25 | Numeric vector of parameters with names (to avoid rate/scale and 26 | var/sd confusion). 27 | } 28 | \description{ 29 | Turn posterior samples collected by MCMC into a parametric prior 30 | distribution. 31 | } 32 | \details{ 33 | The distributions are fit by the method of moments. 34 | The function allows inflating the prior variance relative to the posterior 35 | being supplied. 36 | } 37 | \examples{ 38 | 39 | \donttest{ 40 | # download the example datasets to working directory 41 | 42 | url_ex_times <- 43 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_times.log" 44 | dest_path_ex_times <- "primates_EBD_extinction_times.log" 45 | download.file(url_ex_times, dest_path_ex_times) 46 | 47 | url_ex_rates <- 48 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_rates.log" 49 | dest_path_ex_rates <- "primates_EBD_extinction_rates.log" 50 | download.file(url_ex_rates, dest_path_ex_rates) 51 | 52 | url_sp_times <- 53 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_times.log" 54 | dest_path_sp_times <- "primates_EBD_speciation_times.log" 55 | download.file(url_sp_times, dest_path_sp_times) 56 | 57 | url_sp_rates <- 58 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_rates.log" 59 | dest_path_sp_rates <- "primates_EBD_speciation_rates.log" 60 | download.file(url_sp_rates, dest_path_sp_rates) 61 | 62 | # to run on your own data, change this to the path to your data file 63 | speciation_time_file <- dest_path_sp_times 64 | speciation_rate_file <- dest_path_sp_rates 65 | extinction_time_file <- dest_path_ex_times 66 | extinction_rate_file <- dest_path_ex_rates 67 | 68 | primates <- processDivRates(speciation_time_log = speciation_time_file, 69 | speciation_rate_log = speciation_rate_file, 70 | extinction_time_log = extinction_time_file, 71 | extinction_rate_log = extinction_rate_file, 72 | burnin = 0.25) 73 | 74 | speciation_rates <- 75 | dplyr::pull(primates[which(primates$item == "speciation rate"),], 76 | "value") 77 | speciation_1_gamma_prior <- 78 | posteriorSamplesToParametricPrior(speciation_rates,"gamma") 79 | 80 | # remove files 81 | # WARNING: only run for example dataset! 82 | # otherwise you might delete your data! 83 | file.remove(dest_path_sp_times, dest_path_ex_times, 84 | dest_path_sp_rates, dest_path_ex_rates) 85 | } 86 | 87 | } 88 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # RevGadgets 2 | 3 | 4 | 5 | 6 | ![CRAN](https://www.r-pkg.org/badges/last-release/RevGadgets) 7 | ![downloads](https://cranlogs.r-pkg.org/badges/grand-total/RevGadgets) 8 | [![R-CMD-check](https://github.com/revbayes/RevGadgets/workflows/R-CMD-check/badge.svg)](https://github.com/revbayes/RevGadgets/actions) 9 | DOI 10 | 11 | 12 | 13 | 14 | 15 | Postprocessing gadgets for output generated by [RevBayes](http://www.revbayes.com) 16 | 17 | Through user-friendly data pipelines, RevGadgets guides users through importing RevBayes output into R, processing the output, and producing figures or other summaries of the results. RevGadgets provide paired processing and plotting functions built around commonly implemented analyses, such as tree building and divergence-time estimation, diversification-rate estimation, ancestral-state reconstruction and biogeographic range reconstruction, and posterior predictive simulations. 18 | 19 | ### To install: 20 | 21 | First, make sure that you have a recent version of [R](https://www.r-project.org) installed. 22 | RevGadgets requires R version 4.0 or greater. 23 | 24 | Then, install the devtools R-package: 25 | 26 | ```R 27 | install.packages("devtools") 28 | ``` 29 | 30 | Install RevGadgets directly from GitHub: 31 | 32 | ```R 33 | devtools::install_github("revbayes/RevGadgets") 34 | ``` 35 | 36 | ### Note about magick dependency: 37 | 38 | A few RevGadgets dependencies require magick, which may require 39 | you to install the imagemagick software external to R. 40 | 41 | On a mac, you can do this with homebrew on terminal: 42 | 43 | ```bash 44 | brew install imagemagick 45 | ``` 46 | ### Tutorial: 47 | 48 | For an introduction to using RevGadgets, check out the [tutorial](https://revbayes.github.io/tutorials/intro/revgadgets) on the RevBayes website. 49 | 50 | ### Legacy: 51 | 52 | Some old RevBayes tutorials reference a legacy version of RevGadgets. To reproduce those tutorials, or the results of papers published using the legacy version, you'll need to install the legacy version of RevGadgets. To use this code, install the package using devtools, specifying the legacy branch: 53 | 54 | ```R 55 | devtools::install_github("revbayes/RevGadgets@legacy") 56 | ``` 57 | 58 | ### Gists: 59 | 60 | Here's a list of useful `R` scripts for working with `RevBayes`/`RevGadgets`, but separate from core `RevGadgets` functionality. 61 | This is a growing list: please let us know if you want to contribute your own! 62 | 63 | - [Reading stochastic maps for use with phytools](https://gist.github.com/cmt2/f8f875461ae993e35f51f2b41877913c) 64 | - [Convert BioGeoBears output for plotting with RevGadgets](https://gist.github.com/cmt2/c2425575be47c1a574df02ebe4058d38) 65 | 66 | ### Contributing: 67 | 68 | If you'd like to contribute to `RevGadgets`, please have a look at our [developer guide](https://github.com/revbayes/RevGadgets/blob/development/inst/developers_guide.md)! For minor changes to existing code, make changes to development. To develop new code or make more substantial changes, create a new feature branch from development and then submit a pull request to merge back with development when the code is ready. No changes should happen directly on the master branch. 69 | -------------------------------------------------------------------------------- /man/calculateShiftBayesFactor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculateShiftBayesFactor.R 3 | \name{calculateShiftBayesFactor} 4 | \alias{calculateShiftBayesFactor} 5 | \title{Bayes Factors in support of a shift in diversification rates over a given 6 | time interval.} 7 | \usage{ 8 | calculateShiftBayesFactor( 9 | rate_trace, 10 | time_trace, 11 | rate_name, 12 | time_name, 13 | t1, 14 | t2, 15 | prior_prob = 0.5, 16 | decrease = TRUE, 17 | return_2lnBF = TRUE 18 | ) 19 | } 20 | \arguments{ 21 | \item{rate_trace}{(list; no default) The processed Rev output of the rate 22 | of interest through time for computation (output of readTrace()).} 23 | 24 | \item{time_trace}{(list; no default) The processed Rev output of the 25 | change/interval times of the rate of interest through time for computation 26 | (output of readTrace()).} 27 | 28 | \item{rate_name}{(character; no default) The name of the parameter 29 | (e.g. "speciation") for which Bayes Factor is to be calculated.} 30 | 31 | \item{time_name}{(character; no default) The name of the interval times 32 | (e.g. "interval_times) for the rate change times.} 33 | 34 | \item{t1}{(numeric; no default) Support will be assessed for a shift between 35 | time t1 and time t2 (t1 < t2).} 36 | 37 | \item{t2}{(numeric; no default) Support will be assessed for a shift between 38 | time t1 and time t2 (t1 < t2).} 39 | 40 | \item{prior_prob}{(numeric; 0.5) The prior probability of a shift over this 41 | interval (default of 0.5 applies to standard HSMRF- and GMRF-based models).} 42 | 43 | \item{decrease}{(logical; default TRUE) Should support be assessed for a 44 | decrease in the parameter (if TRUE) or an increase (if FALSE) between 45 | t1 and t2?} 46 | 47 | \item{return_2lnBF}{(logical; TRUE) Should the 2ln(BF) be returned 48 | (if TRUE) or simply the BF (if FALSE)?} 49 | } 50 | \value{ 51 | The Bayes Factor. 52 | } 53 | \description{ 54 | This function computes the Bayes Factor in favor of a rate-shift between 55 | time t1 and t2 (t1 < t2). 56 | The default assumption (suitable to standard HSMRF and GMRF models) is 57 | that the prior probability of a shift is 0.5. 58 | } 59 | \examples{ 60 | 61 | \donttest{ 62 | #' # download the example datasets to working directory 63 | url_times <- 64 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_times.log" 65 | dest_path_times <- "primates_EBD_speciation_times.log" 66 | download.file(url_times, dest_path_times) 67 | 68 | url_rates <- 69 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_rates.log" 70 | dest_path_rates <- "primates_EBD_speciation_rates.log" 71 | download.file(url_rates, dest_path_rates) 72 | 73 | # to run on your own data, change this to the path to your data file 74 | speciation_time_file <- dest_path_times 75 | speciation_rate_file <- dest_path_rates 76 | 77 | speciation_times <- readTrace(speciation_time_file, burnin = 0.25) 78 | speciation_rate <- readTrace(speciation_rate_file, burnin = 0.25) 79 | 80 | calculateShiftBayesFactor(speciation_rate, 81 | speciation_times, 82 | "speciation", 83 | "interval_times", 84 | 0.0,40.0, 85 | decrease=FALSE) 86 | 87 | # remove file 88 | # WARNING: only run for example dataset! 89 | # otherwise you might delete your data! 90 | file.remove(dest_path_times, dest_path_rates) 91 | } 92 | 93 | } 94 | \references{ 95 | Kass and Raftery (1995) Bayes Factors. 96 | \emph{JASA}, \bold{90 (430)}, 773-795. 97 | } 98 | -------------------------------------------------------------------------------- /man/plotPostPredStats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotPostPredStats.R 3 | \name{plotPostPredStats} 4 | \alias{plotPostPredStats} 5 | \title{plot Posterior Predictive Statistics} 6 | \usage{ 7 | plotPostPredStats( 8 | data, 9 | prob = c(0.9, 0.95), 10 | col = NULL, 11 | side = "both", 12 | type = "strict", 13 | PPES = FALSE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{data}{(list of data frames; no default) A list of data frames 19 | of the empirical and simulated values, such as the output of 20 | processPostPredStats.R} 21 | 22 | \item{prob}{(vector of numerics; default c(0.9, 0.95)) The 23 | posterior-predictive intervals to shade.} 24 | 25 | \item{col}{(vector of colors; default NULL) The colors for each quantile. 26 | Defaults to blue and red.} 27 | 28 | \item{side}{(character; default "both") Whether the plotted/colored 29 | intervals are on "both" sides, the "left" side, or the "right" 30 | side of the distribution.} 31 | 32 | \item{type}{(character; default "strict") Whether equal values are 33 | considered as less extreme as the observed data ("strict") or half of the 34 | equal values are considered to be higher and half to be lower ("midpoint")} 35 | 36 | \item{PPES}{(boolean; default FALSE) Whether we provide the posterior 37 | predictive effect size (PPES).} 38 | 39 | \item{...}{Additional arguments are passed to stats::density().} 40 | } 41 | \value{ 42 | A list of ggplot objects, where each plot contains a density 43 | distribution of the predicted values and a dashed line of the empirical 44 | value. The blue shaded region of the density plot corresponds to the 5\% 45 | two-sided quantile and the orange corresponds to the 2\% two-sided quantile. 46 | } 47 | \description{ 48 | Plots the posterior predictive statistics data 49 | } 50 | \details{ 51 | Produces one ggplot object per metric. Intended 52 | to plot the results of the RevBayes tutorial: 53 | Assessing Phylogenetic Reliability Using RevBayes and P3 54 | Model adequacy testing using posterior prediction (Data Version). 55 | 56 | Each plot shows the rejection region for the provided quantiles, 57 | as well as a p-value for the observed statistic. If side="left" (or "right"), 58 | then the p-value is the fraction of simulated statistics that are less than 59 | ( or greater than) or equal to the observed statistic. If side="both", then 60 | the p-value is calculated by first fitting a KDE to the samples, then 61 | computing the fraction of simulated statistics with density lower than the 62 | density of he observed statistic; in this sense, the "both" option computes 63 | the size of HPD defined by the observed statistic. 64 | } 65 | \examples{ 66 | 67 | \donttest{ 68 | # download the example datasets to working directory 69 | 70 | url_emp <- 71 | "https://revbayes.github.io/tutorials/intro/data/empirical_data_pps_example.csv" 72 | dest_path_emp <- "empirical_data_pps_example.csv" 73 | download.file(url_emp, dest_path_emp) 74 | 75 | url_sim <- 76 | "https://revbayes.github.io/tutorials/intro/data/simulated_data_pps_example.csv" 77 | dest_path_sim <- "simulated_data_pps_example.csv" 78 | download.file(url_sim, dest_path_sim) 79 | 80 | # to run on your own data, change this to the path to your data file 81 | file_sim <- dest_path_sim 82 | file_emp <- dest_path_emp 83 | 84 | t <- processPostPredStats(path_sim = file_sim, 85 | path_emp = file_emp) 86 | plots <- plotPostPredStats(data = t) 87 | plots[[1]] 88 | 89 | # remove files 90 | # WARNING: only run for example dataset! 91 | # otherwise you might delete your data! 92 | file.remove(dest_path_sim, dest_path_emp) 93 | 94 | } 95 | 96 | } 97 | -------------------------------------------------------------------------------- /R/geomStepRibbon.R: -------------------------------------------------------------------------------- 1 | #' plot geom stepribbon for diversification rates 2 | #' 3 | #' Modified from \code{RmcdrPlugin.KMggplot2} step ribbon plots. 4 | #' 5 | #' \code{geom_stepribbon} is an extension of the \code{geom_ribbon}, and 6 | #' is optimized for Kaplan-Meier plots with pointwise confidence intervals 7 | #' or a confidence band. 8 | #' 9 | #' @seealso 10 | #' \code{\link[ggplot2]{geom_ribbon}} \code{geom_stepribbon} 11 | #' inherits from \code{geom_ribbon}. 12 | #' \code{geom_stepribbon} is modified from 13 | #' \code{RcmdrPlugin.KMggplot2::geom_stepribbon}. 14 | #' 15 | #' @inheritParams ggplot2::geom_ribbon 16 | #' 17 | #' @rdname geom_stepribbon 18 | #' @examples 19 | #' 20 | #' huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) 21 | #' 22 | #' h <- ggplot2::ggplot(huron, ggplot2::aes(year)) 23 | #' 24 | #' h + geom_stepribbon(ggplot2::aes(ymin = level - 1, ymax = level + 1), 25 | #' fill = "grey70") + 26 | #' ggplot2::geom_step(ggplot2::aes(y = level)) 27 | #' 28 | #' # contrast ggplot2::geom_ribbon with geom_stepribbon: 29 | #' h + ggplot2::geom_ribbon(ggplot2::aes(ymin = level - 1, ymax = level + 1), 30 | #' fill = "grey70") + 31 | #' ggplot2::geom_line(ggplot2::aes(y = level)) 32 | #' 33 | #' @importFrom ggplot2 layer GeomRibbon 34 | #' 35 | #' @export 36 | #' 37 | geom_stepribbon <- function(mapping = NULL, 38 | data = NULL, 39 | stat = "identity", 40 | position = "identity", 41 | na.rm = FALSE, 42 | show.legend = NA, 43 | inherit.aes = TRUE, 44 | ...) { 45 | layer( 46 | data = data, 47 | mapping = mapping, 48 | stat = stat, 49 | geom = GeomStepribbon, 50 | position = position, 51 | show.legend = show.legend, 52 | inherit.aes = inherit.aes, 53 | params = list(na.rm = na.rm, ...) 54 | ) 55 | } 56 | 57 | #' @rdname geom_stepribbon 58 | #' @format NULL 59 | #' @usage NULL 60 | #' @export 61 | GeomStepribbon <- ggplot2::ggproto( 62 | "GeomStepribbon", 63 | GeomRibbon, 64 | 65 | extra_params = c("na.rm"), 66 | 67 | draw_group = function(data, 68 | panel_scales, 69 | coord, 70 | direction = "vh", 71 | include_final = FALSE, 72 | na.rm = FALSE) { 73 | n <- nrow(data) 74 | data <- as.data.frame(data)[order(data$x),] 75 | 76 | if (direction == "vh") { 77 | xs <- rep(1:n, each = 2)[-2 * n] 78 | ys <- c(1, rep(2:n, each = 2)) 79 | } else if (direction == "hv") { 80 | xs <- c(1, rep(2:n, each = 2)) 81 | ys <- rep(1:n, each = 2)[-2 * n] 82 | } else { 83 | abort("Parameter `direction` is invalid.") 84 | } 85 | if (!include_final) { 86 | xs <- tail(xs, n = -1) 87 | ys <- tail(ys, n = -1) 88 | } 89 | x <- data$x[xs] 90 | ymin <- data$ymin[ys] 91 | ymax <- data$ymax[ys] 92 | # recover() 93 | data_attr <- 94 | data[xs, setdiff(names(data), c("x", "ymin", "ymax"))] 95 | #data <- 96 | # .new_data_frame(c(list( 97 | # x = x, ymin = ymin, ymax = ymax 98 | # ), data_attr)) 99 | data <- cbind(data.frame(x = x, ymin = ymin, ymax = ymax), 100 | data_attr) 101 | 102 | GeomRibbon$draw_group(data, panel_scales, coord, na.rm = FALSE) 103 | 104 | } 105 | 106 | ) 107 | -------------------------------------------------------------------------------- /inst/extdata/PPS/simulated_data_pps_mini.csv: -------------------------------------------------------------------------------- 1 | Number Invariant Sites,Number Invariant Sites Excluding Ambiguous,Max GC,Max GC Excluding Ambiguous,Max Invariant Block Length,Max Invariant Block Length Excluding Ambiguous,Max Pairwise Difference,Max Pairwise Difference Excluding Ambiguous,Max Variable Block Length,Max Variable Block Length Excluding Ambiguous,Min GC,Min GC Excluding Ambiguous,Min Pairwise Difference,Min Pairwise Difference Excluding Ambiguous,Number Invariable Block,Number Invariable Block Excluding Ambiguous,Mean GC,Mean GC Excluding Ambiguous,Mean GC 1,Mean GC 1 Excluding Ambiguous,Mean GC 2,Mean GC 2 Excluding Ambiguous,Mean GC 3,Mean GC 3 Excluding Ambiguous,Var GC,Var GC Excluding Ambiguous,Var GC 1,Var GC 1 Excluding Ambiguous,Var GC 2,Var GC 2 Excluding Ambiguous,Var GC 3,Var GC 3 Excluding Ambiguous,Theta,Tajima-D,Tajima-Pi,Segregating-Sites 2 | 62,62,0.514461,0.514461,2,2,473,473,82,82,0.4583699,0.4789474,165,165,59,59,0.4947605,0.4964597,0.5099852,0.5125715,0.4845538,0.4858244,0.4897025,0.4909752,0.000144956,8.287848e-05,0.0004154852,0.0004463224,0.0002998642,0.0002045544,0.0003424283,0.0002355432,0.2562204,1079,0.9870377,0.3181558 3 | 50,53,0.5030675,0.5035088,2,2,484,484,174,174,0.456617,0.4763158,147,147,46,49,0.4886255,0.4903156,0.4903572,0.4927609,0.4918764,0.4932542,0.4836384,0.4849288,9.335231e-05,4.412326e-05,0.0002214796,0.0001654483,0.0001818893,0.0001663506,0.0002750922,0.000199382,0.2590699,1091,0.9356593,0.318433 4 | 68,73,0.5425066,0.5425066,2,2,479,479,79,79,0.479404,0.4894737,131,131,63,67,0.5249781,0.5267614,0.5405683,0.543195,0.5076659,0.5090227,0.526659,0.5280622,0.0002388851,0.0001498031,0.000395472,0.0003035964,0.0005822923,0.0005015268,0.0002709043,0.0001796889,0.2547956,1073,0.8594933,0.3084286 5 | 42,47,0.520596,0.5210526,2,2,509,509,93,85,0.4680105,0.4715162,153,153,40,45,0.4973517,0.4990835,0.4919548,0.4943966,0.498627,0.500033,0.5014874,0.5028182,0.0002443227,0.0002049347,0.0002297299,0.0002029877,0.0003474374,0.0003409692,0.0006225296,0.0005345962,0.2609696,1099,0.9676517,0.3228116 6 | 66,70,0.4995618,0.5,3,3,525,525,76,70,0.4478528,0.4767748,137,137,61,65,0.4850436,0.4867071,0.5008559,0.5032982,0.4655606,0.4668377,0.4886728,0.4899818,9.481568e-05,3.319407e-05,0.0002603079,0.00019047,0.0002687692,0.0002296846,0.0002892438,0.0002168481,0.2552706,1075,0.8826058,0.3104482 7 | 55,61,0.5214724,0.5219298,2,2,475,475,95,95,0.4785276,0.4850877,153,153,53,59,0.5015814,0.5033426,0.5014265,0.5039013,0.5090389,0.5104329,0.4942792,0.4956914,0.0001199268,9.413298e-05,0.0002432899,0.0002006813,0.0003392257,0.0002902972,0.0001376556,0.0001504578,0.2578826,1086,0.7576731,0.3057335 8 | 59,69,0.5293602,0.5298246,2,2,489,490,120,58,0.4741455,0.4877193,142,142,56,65,0.5074877,0.5092448,0.5073605,0.5097437,0.5064073,0.5078901,0.5086957,0.5100916,0.0001942279,0.0001431392,0.0005551421,0.0004037509,0.0002876014,0.0003406526,0.0004183044,0.0003721906,0.2569328,1082,0.9439171,0.3163268 9 | 46,52,0.5328659,0.5333333,2,2,504,504,131,84,0.4776512,0.5,173,173,44,50,0.5139275,0.5156981,0.5331507,0.5357735,0.5188787,0.5202798,0.4897025,0.4910377,0.0001348915,7.348262e-05,0.0003126963,0.0002572361,0.0002113146,0.000140556,0.0003336144,0.0002825776,0.2600198,1095,0.9741272,0.3220495 10 | 58,63,0.5127082,0.5131579,2,2,481,482,72,64,0.4636284,0.4763158,150,150,56,61,0.4946462,0.4963623,0.5164898,0.5190821,0.4791762,0.4804176,0.4882151,0.4895858,0.000135101,8.983358e-05,0.000235448,0.0002363776,0.0004494542,0.0003437535,0.0003115522,0.000299495,0.2571703,1083,0.7765237,0.3060764 11 | 38,44,0.5197195,0.5201754,2,2,532,532,106,106,0.4645048,0.4833333,172,172,37,43,0.5011622,0.502886,0.4929819,0.4953605,0.4961098,0.4974834,0.5144165,0.5158169,0.0001556945,9.476779e-05,0.0002790959,0.0001884676,0.0004544633,0.0004224632,0.0002630758,0.0002047364,0.2619195,1103,1.007022,0.3265113 -------------------------------------------------------------------------------- /man/processPopSizes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/processPopSizes.R 3 | \name{processPopSizes} 4 | \alias{processPopSizes} 5 | \title{Process Population Sizes} 6 | \usage{ 7 | processPopSizes( 8 | population_size_log = "", 9 | interval_change_points_log = "", 10 | model = "constant", 11 | burnin = 0.25, 12 | probs = c(0.025, 0.975), 13 | summary = "median", 14 | num_grid_points = 100, 15 | spacing = "exponential", 16 | max_age = NULL, 17 | min_age = NULL, 18 | distribution = FALSE 19 | ) 20 | } 21 | \arguments{ 22 | \item{population_size_log}{(vector of character strings or 23 | single character string; "") Path to population sizes log file(s)} 24 | 25 | \item{interval_change_points_log}{(vector of character strings or 26 | single character string; "") Path to interval change points log file(s). 27 | If not given, a constant process with only one population size is assumed.} 28 | 29 | \item{model}{(string, default: "constant") The demographic model of the intervals. 30 | Can be "constant" or "linear".} 31 | 32 | \item{burnin}{(single numeric value; default: 0.25) Fraction of generations to 33 | discard (if value provided is between 0 and 1) or number of generations (if 34 | value provided is greater than 1).} 35 | 36 | \item{probs}{(numeric vector; c(0.025, 0.975)) a vector of length two 37 | containing the upper and lower bounds for the confidence intervals.} 38 | 39 | \item{summary}{(string, default: "median") the metric to summarize the 40 | posterior distribution, typically "mean" or "median".} 41 | 42 | \item{num_grid_points}{(numeric; default: 100) defines the number of grid points through time for which to 43 | evaluate the demographic functions.} 44 | 45 | \item{spacing}{(string, default: "exponential") The spacing of grid points. Can be "exponential" or "equal". 46 | Exponentially spaced grid points are dense towards the present and have larger distances towards the past.} 47 | 48 | \item{max_age}{(numeric; default: NULL, i.e. not provided) defines the maximal age up to which the demographic functions should be evaluated. 49 | If not provided, it will either be automatically set to 1e5 (in case of a constant process) or 50 | to the maximal age provided with the interval_change_points_log.} 51 | 52 | \item{min_age}{(numeric; default: NULL, i.e. not provided) defines the minimal age up to which the demographic functions should be evaluated. 53 | If not provided, it will either be automatically set to 1e2 (in case of a constant process) or 54 | to the minimal age provided with the interval_change_points_log. Can not be 0 in case of exponential spacing.} 55 | 56 | \item{distribution}{(boolean; default: FALSE) specifies whether the summary data frame will be returned 57 | (distribution = FALSE) or a matrix with distributions of population size for each point on the grid and 58 | with the times of the grid points as row names (distribution = TRUE).} 59 | } 60 | \value{ 61 | List object with processed rate and, if applicable, time parameters (if distribution = FALSE). 62 | Matrix object with distributions of population size (if distribution = TRUE). If applicable, one row for each point on the grid, 63 | with the times of the grid points as row names. 64 | } 65 | \description{ 66 | Processing the output of a coalescent demographic analysis. 67 | } 68 | \details{ 69 | For processing the output of a coalescent demographic analysis. 70 | processPopSizes() assumes that the the first size parameter (i.e. population_size[1]) 71 | corresponds to the present. processPopSizes() partly 72 | relies on readTrace and produces a list object that can be read by 73 | plotPopSizes() to visualize the results. For now, only one log file per 74 | parameter type is accepted (i.e. log files from multiple runs must be 75 | combined before reading into the function). 76 | } 77 | -------------------------------------------------------------------------------- /R/processSSE.R: -------------------------------------------------------------------------------- 1 | #' Title 2 | #' 3 | #' @param path (vector of character strings; no default) File path(s) to 4 | #' trace file. 5 | #' @param speciation (single character string; "speciation") RevBayes variable 6 | #' name 7 | #' @param extinction (single character string; "extinction") RevBayes variable 8 | #' name 9 | #' @param speciation_hidden (single character string; "speciation_hidden") 10 | #' RevBayes variable name 11 | #' @param rates (vector; c(speciation, extinction, "net-diversification")) 12 | #' names of rates to be included in plot 13 | #' @param ... additional arguments passed to readTrace() 14 | #' 15 | #' @return a data frame 16 | #' @examples 17 | #' 18 | #' \donttest{ 19 | #' # download the example dataset to working directory 20 | #' 21 | #' url <- 22 | #' "https://revbayes.github.io/tutorials/intro/data/primates_BiSSE_activity_period.log" 23 | #' dest_path <- "primates_BiSSE_activity_period.log" 24 | #' download.file(url, dest_path) 25 | #' 26 | #' # to run on your own data, change this to the path to your data file 27 | #' bisse_file <- dest_path 28 | #' 29 | #' pdata <- processSSE(bisse_file) 30 | #' 31 | #' # remove file 32 | #' # WARNING: only run for example dataset! 33 | #' # otherwise you might delete your data! 34 | #' file.remove(dest_path) 35 | #' } 36 | #' 37 | #' @export 38 | processSSE <- function(path, 39 | speciation = "speciation", 40 | extinction = "extinction", 41 | speciation_hidden = "speciation_hidden", 42 | rates = c(speciation, extinction, "net-diversification"), 43 | ...) { 44 | # parameter compatibility checks 45 | if (!is.character(speciation)) 46 | stop("speciation should be a single character string") 47 | if (length(speciation) != 1) 48 | stop("speciation should be a single character string") 49 | if (!is.character(extinction)) 50 | stop("extinction should be a single character string") 51 | if (length(extinction) != 1) 52 | stop("extinction should be a single character string") 53 | if (!is.character(speciation_hidden)) 54 | stop("speciation_hidden should be a single character string") 55 | if (length(speciation_hidden) != 1) 56 | stop("speciation_hidden should be a single character string") 57 | 58 | # read in trace 59 | tr <- readTrace(paths = path, ...)[[1]] 60 | 61 | # process trace 62 | n_hidden <- 63 | max(1, sum(grepl( 64 | paste0(speciation_hidden, "\\["), names(tr) 65 | ))) 66 | n_states <- 67 | sum(grepl(paste0(speciation, "\\["), names(tr))) / n_hidden 68 | n_rates <- n_hidden * n_states 69 | 70 | for (index in 1:n_rates) { 71 | netdiv <- 72 | tr[[paste0(speciation, 73 | "[", 74 | index, 75 | "]")]] - tr[[paste0(extinction, 76 | "[", 77 | index, 78 | "]")]] 79 | tr[[paste0("net-diversification[", index, "]")]] <- netdiv 80 | } 81 | 82 | dfs <- list() 83 | m <- 1 84 | for (k in seq_along(rates)) { 85 | for (i in 1:n_states) { 86 | for (j in 1:n_hidden) { 87 | hiddenletter <- LETTERS[j] 88 | index <- i + (j * n_states) - n_states 89 | 90 | value <- tr[[paste0(rates[k], "[", index, "]")]] 91 | 92 | df1 <- data.frame( 93 | "value" = value, 94 | "rate" = rates[k], 95 | "hidden_state" = hiddenletter, 96 | "label" = paste0(i - 1, hiddenletter), 97 | "observed_state" = as.factor(i - 1), 98 | "Iteration" = tr$Iteration 99 | ) 100 | 101 | 102 | dfs[[m]] <- df1 103 | m <- m + 1 104 | } 105 | } 106 | } 107 | res <- dplyr::bind_rows(dfs) 108 | return(res) 109 | } 110 | -------------------------------------------------------------------------------- /inst/extdata/sub_models/primates_cytb_GTR_MAP.tre: -------------------------------------------------------------------------------- 1 | #NEXUS 2 | 3 | Begin taxa; 4 | Dimensions ntax=23; 5 | Taxlabels 6 | Aotus_trivirgatus 7 | Callicebus_donacophilus 8 | Cebus_albifrons 9 | Cheirogaleus_major 10 | Chlorocebus_aethiops 11 | Colobus_guereza 12 | Daubentonia_madagascariensis 13 | Galago_senegalensis 14 | Galeopterus_variegatus 15 | Hylobates_lar 16 | Lemur_catta 17 | Lepilemur_hubbardorum 18 | Loris_tardigradus 19 | Macaca_mulatta 20 | Microcebus_murinus 21 | Nycticebus_coucang 22 | Otolemur_crassicaudatus 23 | Pan_paniscus 24 | Perodicticus_potto 25 | Propithecus_coquereli 26 | Saimiri_sciureus 27 | Tarsius_syrichta 28 | Varecia_variegata_variegata 29 | ; 30 | End; 31 | 32 | Begin trees; 33 | tree TREE1 = [&U](((((((((((Cheirogaleus_major[&index=8]:0.077871[&brlen_95%_HPD={0.057172,0.095527}],Microcebus_murinus[&index=10]:0.120469[&brlen_95%_HPD={0.095768,0.143598}])[&index=24,posterior=1.000000]:0.038563[&brlen_95%_HPD={0.02299,0.054983}],Lepilemur_hubbardorum[&index=16]:0.127209[&brlen_95%_HPD={0.101725,0.151732}])[&index=25,posterior=0.844770]:0.026987[&brlen_95%_HPD={0.01336,0.041185}],((Lemur_catta[&index=7]:0.085491[&brlen_95%_HPD={0.065681,0.106427}],Varecia_variegata_variegata[&index=14]:0.108696[&brlen_95%_HPD={0.086403,0.131499}])[&index=26,posterior=1.000000]:0.034707[&brlen_95%_HPD={0.021562,0.04977}],Propithecus_coquereli[&index=22]:0.085657[&brlen_95%_HPD={0.065592,0.106044}])[&index=27,posterior=0.744837]:0.017992[&brlen_95%_HPD={0.006051,0.030213}])[&index=28,posterior=1.000000]:0.043443[&brlen_95%_HPD={0.026541,0.059462}],Daubentonia_madagascariensis[&index=5]:0.128249[&brlen_95%_HPD={0.104849,0.152093}])[&index=29,posterior=0.893404]:0.017257[&brlen_95%_HPD={0.005102,0.028368}],(((Galago_senegalensis[&index=6]:0.074971[&brlen_95%_HPD={0.056547,0.092027}],Otolemur_crassicaudatus[&index=13]:0.078208[&brlen_95%_HPD={0.059861,0.096264}])[&index=30,posterior=1.000000]:0.040396[&brlen_95%_HPD={0.025245,0.054656}],Perodicticus_potto[&index=2]:0.096414[&brlen_95%_HPD={0.074783,0.116156}])[&index=31,posterior=0.996336]:0.018477[&brlen_95%_HPD={0.008194,0.029497}],(Loris_tardigradus[&index=11]:0.098621[&brlen_95%_HPD={0.076423,0.119459}],Nycticebus_coucang[&index=21]:0.109164[&brlen_95%_HPD={0.088418,0.132747}])[&index=32,posterior=1.000000]:0.035387[&brlen_95%_HPD={0.020554,0.05035}])[&index=33,posterior=1.000000]:0.031018[&brlen_95%_HPD={0.017106,0.04556}])[&index=34,posterior=0.736842]:0.013934[&brlen_95%_HPD={0.004163,0.024503}],Tarsius_syrichta[&index=15]:0.175394[&brlen_95%_HPD={0.146249,0.203639}])[&index=35,posterior=0.990340]:0.020095[&brlen_95%_HPD={0.007841,0.033593}],Galeopterus_variegatus[&index=1]:0.162280[&brlen_95%_HPD={0.133959,0.190464}])[&index=36,posterior=1.000000]:0.041931[&brlen_95%_HPD={0.026463,0.057881}],(((Chlorocebus_aethiops[&index=20]:0.074356[&brlen_95%_HPD={0.055266,0.091297}],Macaca_mulatta[&index=3]:0.086484[&brlen_95%_HPD={0.067093,0.105397}])[&index=37,posterior=1.000000]:0.022698[&brlen_95%_HPD={0.010882,0.034301}],Colobus_guereza[&index=17]:0.120344[&brlen_95%_HPD={0.098652,0.143764}])[&index=38,posterior=1.000000]:0.044801[&brlen_95%_HPD={0.029876,0.060365}],(Hylobates_lar[&index=9]:0.103472[&brlen_95%_HPD={0.082088,0.124069}],Pan_paniscus[&index=23]:0.074779[&brlen_95%_HPD={0.058194,0.094183}])[&index=39,posterior=1.000000]:0.026565[&brlen_95%_HPD={0.014212,0.039594}])[&index=40,posterior=1.000000]:0.042396[&brlen_95%_HPD={0.026861,0.058215}])[&index=41,posterior=1.000000]:0.084457[&brlen_95%_HPD={0.062639,0.104939}],Callicebus_donacophilus[&index=19]:0.099118[&brlen_95%_HPD={0.077608,0.121161}])[&index=42,posterior=0.985676]:0.024094[&brlen_95%_HPD={0.01123,0.037208}],Cebus_albifrons[&index=4]:0.102170[&brlen_95%_HPD={0.081451,0.125311}])[&index=43,posterior=0.984011]:0.024148[&brlen_95%_HPD={0.010475,0.038082}],Aotus_trivirgatus[&index=12]:0.095534[&brlen_95%_HPD={0.075419,0.118512}],Saimiri_sciureus[&index=18]:0.126686[&brlen_95%_HPD={0.102493,0.15089}])[&index=44,posterior=1.000000]:0.000000; 34 | End; 35 | -------------------------------------------------------------------------------- /man/summarizeTrace.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summarizeTrace.R 3 | \name{summarizeTrace} 4 | \alias{summarizeTrace} 5 | \title{Summarize trace} 6 | \usage{ 7 | summarizeTrace(trace, vars) 8 | } 9 | \arguments{ 10 | \item{trace}{(list of data frames; no default) Name of a list of data frames, 11 | such as produced by readTrace(). If the readTrace() output 12 | contains multiple traces (such as from multiple runs), summarizeTrace() will 13 | provide summaries for each trace individually, as well as the combined trace.} 14 | 15 | \item{vars}{(character or character vector; no default) The name of the 16 | variable(s) to be summarized.} 17 | } 18 | \value{ 19 | summarizeTrace() returns a list of the length of provided variables. 20 | For quantitative variables, it returns the mean and 95% credible interval. 21 | For discrete variables, it returns the 95% credible set of states and their 22 | associated probabilities. 23 | } 24 | \description{ 25 | Summarizes trace file(s) that have been read into memory 26 | } 27 | \details{ 28 | Summarizes a trace file for continuous or discrete characters by 29 | computing the mean and 95\% credible interval for quantitative 30 | character and the 95\% credible set for discrete characters. 31 | } 32 | \examples{ 33 | 34 | \donttest{ 35 | # continuous character only example, one run 36 | 37 | # download the example dataset to working directory 38 | url_gtr <- 39 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 40 | dest_path_gtr <- "primates_cytb_GTR.log" 41 | download.file(url_gtr, dest_path_gtr) 42 | 43 | # to run on your own data, change this to the path to your data file 44 | file_single <- dest_path_gtr 45 | 46 | one_trace <- readTrace(paths = file_single) 47 | trace_sum <- summarizeTrace(trace = one_trace, 48 | vars = c("pi[1]","pi[2]","pi[3]","pi[4]")) 49 | trace_sum[["pi[1]"]] 50 | 51 | # remove file 52 | # WARNING: only run for example dataset! 53 | # otherwise you might delete your data! 54 | file.remove(dest_path_gtr) 55 | 56 | # continuous character example, multiple runs 57 | 58 | #' # download the example dataset to working directory 59 | url_1 <- 60 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_1.log" 61 | dest_path_1 <- "primates_cytb_GTR_run_1.log" 62 | download.file(url_1, dest_path_1) 63 | 64 | url_2 <- 65 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_2.log" 66 | dest_path_2 <- "primates_cytb_GTR_run_2.log" 67 | download.file(url_2, dest_path_2) 68 | 69 | # to run on your own data, change this to the path to your data file 70 | file_1 <- dest_path_1 71 | file_2 <- dest_path_2 72 | 73 | # read in the multiple trace files 74 | multi_trace <- readTrace(path = c(file_1, file_2), burnin = 0.0) 75 | 76 | trace_sum_multi <- summarizeTrace(trace = multi_trace, 77 | vars = c("pi[1]","pi[2]","pi[3]","pi[4]")) 78 | trace_sum_multi[["pi[1]"]] 79 | 80 | # remove files 81 | # WARNING: only run for example dataset! 82 | # otherwise you might delete your data! 83 | file.remove(dest_path_1, dest_path_2) 84 | 85 | # discrete character example 86 | 87 | # download the example dataset to working directory 88 | url_rj <- "https://revbayes.github.io/tutorials/intro/data/freeK_RJ.log" 89 | dest_path_rj <- "freeK_RJ.log" 90 | download.file(url_rj, dest_path_rj) 91 | 92 | file <- dest_path_rj 93 | trace <- readTrace(path = file) 94 | 95 | trace_sum_discrete <- summarizeTrace(trace = trace, 96 | vars = c("prob_rate_12", 97 | "prob_rate_13", 98 | "prob_rate_31", 99 | "prob_rate_32")) 100 | trace_sum_discrete[["prob_rate_12"]] 101 | 102 | #' # remove file 103 | # WARNING: only run for example dataset! 104 | # otherwise you might delete your data! 105 | file.remove(dest_path_rj) 106 | } 107 | 108 | } 109 | -------------------------------------------------------------------------------- /R/combineTrace.R: -------------------------------------------------------------------------------- 1 | #' Combine traces 2 | #' 3 | #' Combine traces into one trace file 4 | #' 5 | #' Combines multiple traces from independent MCMC replicates 6 | #' into one trace file. 7 | #' 8 | #' @param traces (list of data frames; no default) Name of a list of data 9 | #' frames, such as produced by readTrace(). 10 | #' 11 | #' @param burnin (single numeric value; default = 0.0) Fraction of generations 12 | #' to discard (if value provided is between 0 and 1) or number of generations 13 | #' to discard (if value provided is greater than 1) before combining the 14 | #' samples. 15 | #' 16 | #' @return combineTraces() returns a list of data frames of length 1, 17 | #' corresponding to the combination of the provided samples. 18 | #' 19 | #' @examples 20 | #' 21 | #' \donttest{ 22 | #' 23 | #' #' # download the example dataset to working directory 24 | #' url_1 <- 25 | #' "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_1.log" 26 | #' dest_path_1 <- "primates_cytb_GTR_run_1.log" 27 | #' download.file(url_1, dest_path_1) 28 | #' 29 | #' url_2 <- 30 | #' "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR_run_2.log" 31 | #' dest_path_2 <- "primates_cytb_GTR_run_2.log" 32 | #' download.file(url_2, dest_path_2) 33 | #' 34 | #' # to run on your own data, change this to the path to your data file 35 | #' file_1 <- dest_path_1 36 | #' file_2 <- dest_path_2 37 | #' 38 | #' # read in the multiple trace files 39 | #' multi_trace <- readTrace(path = c(file_1, file_2), burnin = 0.0) 40 | #' 41 | #' # combine samples after discarding 10% burnin 42 | #' combined_trace <- combineTraces(trace = multi_trace, 43 | #' burnin = 0.1) 44 | #' 45 | #' # remove files 46 | #' # WARNING: only run for example dataset! 47 | #' # otherwise you might delete your data! 48 | #' file.remove(dest_path_1, dest_path_2) 49 | #' } 50 | #' 51 | #' 52 | #' @export 53 | 54 | 55 | combineTraces <- function(traces, burnin = 0.0) { 56 | # enforce argument matching 57 | if (is.list(traces) == FALSE) 58 | stop("trace should be a list of data frames") 59 | if (is.data.frame(traces[[1]]) == FALSE) 60 | stop("trace should be a list of data frames") 61 | if (burnin < 0) 62 | stop("burnin must be a positive value") 63 | 64 | # only combine if there are multiple traces 65 | num_traces <- length(traces) 66 | if (num_traces < 2) { 67 | stop("Provided a list of 1 trace; can only combine multiple traces") 68 | } 69 | 70 | # check that the file headings match for all traces 71 | header <- vector("list", num_traces) 72 | for (i in 1:num_traces) { 73 | header[[i]] <- colnames(traces[[i]]) 74 | } 75 | all_headers <- unique(unlist(header)) 76 | for (i in 1:num_traces) { 77 | if (setequal(all_headers, header[[i]]) == FALSE) { 78 | stop("Not all headers of trace files match") 79 | } 80 | } 81 | 82 | # order columns, discard burnin 83 | post_burnin_samples <- vector("list", num_traces) 84 | for (i in 1:num_traces) { 85 | # get the trace 86 | this_trace <- traces[[i]] 87 | 88 | # order the trace 89 | this_trace <- this_trace[, all_headers] 90 | 91 | # discard burnin 92 | if (burnin >= 1) { 93 | post_burnin_samples[[i]] <- 94 | this_trace[(burnin + 1):nrow(this_trace),] 95 | } else if (burnin < 1 & burnin > 0) { 96 | discard <- ceiling(burnin * nrow(this_trace)) 97 | post_burnin_samples[[i]] <- 98 | this_trace[(discard + 1):nrow(this_trace),] 99 | } else if (burnin == 0) { 100 | post_burnin_samples[[i]] <- this_trace 101 | } else { 102 | stop("What have you done?") 103 | } 104 | 105 | } 106 | 107 | # concatenate the samples 108 | output <- do.call(rbind, post_burnin_samples) 109 | 110 | # re-index the generations 111 | rownames(output) <- seq_len(nrow(output)) 112 | if ("Iteration" %in% all_headers) { 113 | output$Iteration <- seq_len(nrow(output)) 114 | } 115 | 116 | # return 117 | return(list("combined" = output)) 118 | 119 | } 120 | -------------------------------------------------------------------------------- /man/plotDivRates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotDivRates.R 3 | \name{plotDivRates} 4 | \alias{plotDivRates} 5 | \title{Plot Diversification Rates} 6 | \usage{ 7 | plotDivRates(rates, facet = TRUE) 8 | } 9 | \arguments{ 10 | \item{rates}{(list of dataframes; no default) A list of dataframes, 11 | such as produced by processDivRates(), containing the data on rates 12 | and interval times for each type of rate to be plotted (e.g. 13 | speciation rate, etc.).} 14 | 15 | \item{facet}{(logical; TRUE) plot rates in separate facets.} 16 | } 17 | \value{ 18 | A ggplot object 19 | } 20 | \description{ 21 | Plots the output of an episodic diversification rate analysis 22 | } 23 | \details{ 24 | Plots the output of episodic diversification rate analyses. Takes as 25 | input the output of processDivRates() and plotting parameters. 26 | For now, only variable names (under "item") that contain the word "rate" are 27 | included in the plot. 28 | 29 | The return object can be manipulated. For example, you can change the 30 | axis labels, the color palette, whether the axes are to be linked, or the 31 | overall plotting style/theme, just as with any ggplot object. 32 | } 33 | \examples{ 34 | 35 | \donttest{ 36 | # download the example datasets to working directory 37 | 38 | url_ex_times <- 39 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_times.log" 40 | dest_path_ex_times <- "primates_EBD_extinction_times.log" 41 | download.file(url_ex_times, dest_path_ex_times) 42 | 43 | url_ex_rates <- 44 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_rates.log" 45 | dest_path_ex_rates <- "primates_EBD_extinction_rates.log" 46 | download.file(url_ex_rates, dest_path_ex_rates) 47 | 48 | url_sp_times <- 49 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_times.log" 50 | dest_path_sp_times <- "primates_EBD_speciation_times.log" 51 | download.file(url_sp_times, dest_path_sp_times) 52 | 53 | url_sp_rates <- 54 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_rates.log" 55 | dest_path_sp_rates <- "primates_EBD_speciation_rates.log" 56 | download.file(url_sp_rates, dest_path_sp_rates) 57 | 58 | # to run on your own data, change this to the path to your data file 59 | speciation_time_file <- dest_path_sp_times 60 | speciation_rate_file <- dest_path_sp_rates 61 | extinction_time_file <- dest_path_ex_times 62 | extinction_rate_file <- dest_path_ex_rates 63 | 64 | rates <- processDivRates(speciation_time_log = speciation_time_file, 65 | speciation_rate_log = speciation_rate_file, 66 | extinction_time_log = extinction_time_file, 67 | extinction_rate_log = extinction_rate_file, 68 | burnin = 0.25) 69 | 70 | # then plot results: 71 | p <- plotDivRates(rates = rates);p 72 | 73 | # change the x-axis 74 | p <- p + ggplot2::xlab("Thousands of years ago");p 75 | 76 | # change the colors 77 | p <- p + ggplot2::scale_fill_manual(values = c("red", 78 | "green", 79 | "yellow", 80 | "purple")) + 81 | ggplot2::scale_color_manual(values = c("red", 82 | "green", 83 | "yellow", 84 | "purple"));p 85 | 86 | # let's say we don't want to plot relative-extinction rate, 87 | # and use the same y-axis for all three rates 88 | rates <- rates[!grepl("relative-extinction", rates$item),] 89 | p2 <- plotDivRates(rates) 90 | p2 <- p2 + ggplot2::facet_wrap(ggplot2::vars(item), scale = "fixed");p2 91 | 92 | # remove files 93 | # WARNING: only run for example dataset! 94 | # otherwise you might delete your data! 95 | file.remove(dest_path_sp_times, dest_path_ex_times, 96 | dest_path_sp_rates, dest_path_ex_rates) 97 | 98 | } 99 | 100 | } 101 | -------------------------------------------------------------------------------- /R/processBranchData.R: -------------------------------------------------------------------------------- 1 | #' processBranchData 2 | #' 3 | #' @param tree (treedata object; no default) a phylogenetic tree in the 4 | #' treedata format, or a list of lists of a single tree data object, such as the 5 | #' output of readTrees(). 6 | #' @param dat (data.frame or list; no default) a data frame, or a list 7 | #' (of length 1) of a data frame, with branch specific data, such as the output 8 | #' of readTrace(). 9 | #' @param burnin (numeric; 0.25) fraction of the markov-chain to discard 10 | #' @param parnames (character vector; c("avg_lambda", "avg_mu", "num_shifts")) 11 | #' Names of parameters to process 12 | #' @param summary (character; "median") function to summarize the continuous 13 | #' parameter. Typically mean or median 14 | #' @param net_div (logical; FALSE) Calculate net diversification? 15 | #' 16 | #' @return a treedata file with attached branch-specific data 17 | #' @export 18 | #' 19 | #' @examples 20 | #' \donttest{ 21 | #' 22 | #' # download the example dataset to working directory 23 | #' url_rates <- 24 | #' "https://revbayes.github.io/tutorials/intro/data/primates_BDS_rates.log" 25 | #' dest_path_rates <- "primates_BDS_rates.log" 26 | #' download.file(url_rates, dest_path_rates) 27 | #' 28 | #' url_tree <- 29 | #' "https://revbayes.github.io/tutorials/divrate/data/primates_tree.nex" 30 | #' dest_path_tree <- "primates_tree.nex" 31 | #' download.file(url_tree, dest_path_tree) 32 | #' 33 | #' # to run on your own data, change this to the path to your data file 34 | #' treefile <- dest_path_tree 35 | #' logfile <- dest_path_rates 36 | #' 37 | #' branch_data <- readTrace(logfile) 38 | #' tree <- readTrees(paths = treefile) 39 | #' 40 | #' annotated_tree <- processBranchData(tree, branch_data, summary = "median") 41 | #' 42 | #' # you can plot this output 43 | #' p <- plotTree(tree = annotated_tree, 44 | #' node_age_bars = FALSE, 45 | #' node_pp = FALSE, 46 | #' tip_labels = FALSE, 47 | #' color_branch_by = "avg_lambda", 48 | #' line_width = 0.8) + 49 | #' ggplot2::theme(legend.position=c(.1, .9));p 50 | #' # remove files 51 | #' # WARNING: only run for example dataset! 52 | #' # otherwise you might delete your data! 53 | #' file.remove(dest_path_tree, dest_path_rates) 54 | #' } 55 | processBranchData <- function(tree, 56 | dat, 57 | burnin = 0.25, 58 | parnames = c("avg_lambda", 59 | "avg_mu", 60 | "num_shifts"), 61 | summary = "median", 62 | net_div = FALSE) { 63 | if (methods::is(dat, "list")) { 64 | dat <- dat[[1]] 65 | } 66 | if (methods::is(tree, "list")) { 67 | tree <- tree[[1]][[1]] 68 | } 69 | 70 | if (!"data.frame" %in% class(dat)) 71 | stop("dat must be a data.frame or a single list of a data.frame") 72 | if (!"treedata" %in% class(tree)) 73 | stop("tree must be a treedata object or a list of 74 | lists of treedata objects") 75 | 76 | dat <- dat[floor(nrow(dat) * burnin):nrow(dat), ] 77 | tree_tbl <- tibble::as_tibble(tree) 78 | map <- matchNodes(tree@phylo) 79 | 80 | for (item in parnames) { 81 | parameter <- 82 | unname(unlist(lapply(dat[, grepl(item, 83 | colnames(dat))], 84 | summary)))[map$Rev] 85 | tree_tbl[[item]] <- parameter 86 | } 87 | 88 | if (net_div) { 89 | if ("avg_lambda" %in% parnames & "avg_mu" %in% parnames) { 90 | lambdas <- as.matrix(dat[, grepl("avg_lambda", colnames(dat))]) 91 | mus <- as.matrix(dat[, grepl("avg_mu", colnames(dat))]) 92 | net_divs <- as.data.frame(lambdas - mus) 93 | tree_tbl[["net_div"]] <- 94 | unname(unlist(lapply(net_divs, summary)))[map$Rev] 95 | } else { 96 | stop( 97 | "You set net_div = TRUE. Cannot calculate net_div without 98 | 'avg_lambda and avg_mu' in parnames" 99 | ) 100 | } 101 | } 102 | tree2 <- tidytree::as.treedata(tree_tbl) 103 | 104 | return(list(list(tree2))) 105 | } 106 | -------------------------------------------------------------------------------- /man/geom_stepribbon.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geomStepRibbon.R 3 | \docType{data} 4 | \name{geom_stepribbon} 5 | \alias{geom_stepribbon} 6 | \alias{GeomStepribbon} 7 | \title{plot geom stepribbon for diversification rates} 8 | \usage{ 9 | geom_stepribbon( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | na.rm = FALSE, 15 | show.legend = NA, 16 | inherit.aes = TRUE, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 22 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 23 | at the top level of the plot. You must supply \code{mapping} if there is no plot 24 | mapping.} 25 | 26 | \item{data}{The data to be displayed in this layer. There are three 27 | options: 28 | 29 | If \code{NULL}, the default, the data is inherited from the plot 30 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 31 | 32 | A \code{data.frame}, or other object, will override the plot 33 | data. All objects will be fortified to produce a data frame. See 34 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 35 | 36 | A \code{function} will be called with a single argument, 37 | the plot data. The return value must be a \code{data.frame}, and 38 | will be used as the layer data. A \code{function} can be created 39 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 40 | 41 | \item{stat}{The statistical transformation to use on the data for this 42 | layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the 43 | stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than 44 | \code{"stat_count"})} 45 | 46 | \item{position}{Position adjustment, either as a string naming the adjustment 47 | (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a 48 | position adjustment function. Use the latter if you need to change the 49 | settings of the adjustment.} 50 | 51 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 52 | a warning. If \code{TRUE}, missing values are silently removed.} 53 | 54 | \item{show.legend}{logical. Should this layer be included in the legends? 55 | \code{NA}, the default, includes if any aesthetics are mapped. 56 | \code{FALSE} never includes, and \code{TRUE} always includes. 57 | It can also be a named logical vector to finely select the aesthetics to 58 | display.} 59 | 60 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 61 | rather than combining with them. This is most useful for helper functions 62 | that define both data and aesthetics and shouldn't inherit behaviour from 63 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 64 | 65 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 66 | often aesthetics, used to set an aesthetic to a fixed value, like 67 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 68 | to the paired geom/stat.} 69 | } 70 | \description{ 71 | Modified from \code{RmcdrPlugin.KMggplot2} step ribbon plots. 72 | } 73 | \details{ 74 | \code{geom_stepribbon} is an extension of the \code{geom_ribbon}, and 75 | is optimized for Kaplan-Meier plots with pointwise confidence intervals 76 | or a confidence band. 77 | } 78 | \examples{ 79 | 80 | huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) 81 | 82 | h <- ggplot2::ggplot(huron, ggplot2::aes(year)) 83 | 84 | h + geom_stepribbon(ggplot2::aes(ymin = level - 1, ymax = level + 1), 85 | fill = "grey70") + 86 | ggplot2::geom_step(ggplot2::aes(y = level)) 87 | 88 | # contrast ggplot2::geom_ribbon with geom_stepribbon: 89 | h + ggplot2::geom_ribbon(ggplot2::aes(ymin = level - 1, ymax = level + 1), 90 | fill = "grey70") + 91 | ggplot2::geom_line(ggplot2::aes(y = level)) 92 | 93 | } 94 | \seealso{ 95 | \code{\link[ggplot2]{geom_ribbon}} \code{geom_stepribbon} 96 | inherits from \code{geom_ribbon}. 97 | \code{geom_stepribbon} is modified from 98 | \code{RcmdrPlugin.KMggplot2::geom_stepribbon}. 99 | } 100 | \keyword{datasets} 101 | -------------------------------------------------------------------------------- /man/plotTrace.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotTrace.R 3 | \name{plotTrace} 4 | \alias{plotTrace} 5 | \title{Plot trace} 6 | \usage{ 7 | plotTrace(trace, color = "default", vars = NULL, match = NULL) 8 | } 9 | \arguments{ 10 | \item{trace}{(list of data frames; no default) Name of a list of data frames, 11 | such as produced by readTrace(). If the readTrace() output 12 | contains multiple traces (such as from multiple runs), summarizeTrace() will 13 | provide summaries for each trace individually, as well as the combined trace.} 14 | 15 | \item{color}{("character"; "default") Colors for parameters. Defaults to 16 | default RevGadgets colors. For non-default colors, provide a named vector of 17 | length of the number of parameters.} 18 | 19 | \item{vars}{(character or character vector; NULL) The specific name(s) of 20 | the variable(s) to be summarized.} 21 | 22 | \item{match}{(character; NULL) A string to match to a group of parameters. 23 | For example, match = "er" will plot the variables "er[1]", "er[2]", "er[3]", 24 | etc.. match will only work if your search string is followed by brackets in 25 | one or more of the column names of the provided trace file. match = "er" will 26 | only return the exchangeability parameters, but will not plot "Posterior".} 27 | } 28 | \value{ 29 | plotTrace() returns a list of the length of provided trace object, 30 | plus one combined trace. Each element of the list contains a ggplot object 31 | with plots of the provided parameters. These plots may be modified in 32 | typical ggplot fashion. 33 | } 34 | \description{ 35 | Plots the posterior distributions of variables from trace file. 36 | } 37 | \details{ 38 | Plots the posterior distributions of continuous variables from one or 39 | multiple traces (as in, from multiple runs). Shaded regions under the curve 40 | represent the 95\% credible interval. If multiple traces are provided, 41 | plotTrace() will plot each run independently as well as plot the combined 42 | output. Note that for variables ith very different distributions, overlaying 43 | the plots may result in illegible figures. In these cases, we recommend 44 | plotting each parameter separately. 45 | } 46 | \examples{ 47 | 48 | \donttest{ 49 | 50 | # example with quantitative parameters 51 | 52 | # download the example dataset to working directory 53 | url_gtr <- 54 | "https://revbayes.github.io/tutorials/intro/data/primates_cytb_GTR.log" 55 | dest_path_gtr <- "primates_cytb_GTR.log" 56 | download.file(url_gtr, dest_path_gtr) 57 | 58 | # to run on your own data, change this to the path to your data file 59 | file <- dest_path_gtr 60 | 61 | one_trace <- readTrace(paths = file) 62 | plots <- plotTrace(trace = one_trace, 63 | vars = c("pi[1]","pi[2]","pi[3]","pi[4]")) 64 | plots[[1]] 65 | 66 | # add custom colors 67 | plots <- plotTrace(trace = one_trace, 68 | vars = c("pi[3]","pi[4]","pi[1]","pi[2]"), 69 | color = c("pi[1]" = "green", 70 | "pi[2]"= "red", 71 | "pi[3]"= "blue", 72 | "pi[4]"= "orange")) 73 | plots[[1]] 74 | 75 | # make the same plot, using match 76 | plots <- plotTrace(trace = one_trace, match = "pi") 77 | plots[[1]] 78 | 79 | #' # remove file 80 | # WARNING: only run for example dataset! 81 | # otherwise you might delete your data! 82 | file.remove(dest_path_gtr) 83 | 84 | # plot some qualitative variables 85 | 86 | # download the example dataset to working directory 87 | url_rj <- "https://revbayes.github.io/tutorials/intro/data/freeK_RJ.log" 88 | dest_path_rj <- "freeK_RJ.log" 89 | download.file(url_rj, dest_path_rj) 90 | 91 | file <- dest_path_rj 92 | trace <- readTrace(path = file) 93 | 94 | plots <- plotTrace(trace = trace, 95 | vars = c("prob_rate_12", "prob_rate_13", 96 | "prob_rate_31", "prob_rate_32")) 97 | plots[[1]] 98 | 99 | # with custom colors 100 | plots <- plotTrace(trace = trace, 101 | vars = c("prob_rate_12", "prob_rate_13", 102 | "prob_rate_31", "prob_rate_32"), 103 | color = c("prob_rate_12" = "green", 104 | "prob_rate_13" = "red", 105 | "prob_rate_31"= "blue", 106 | "prob_rate_32" = "orange")) 107 | plots[[1]] 108 | 109 | # remove file 110 | # WARNING: only run for example dataset! 111 | # otherwise you might delete your data! 112 | file.remove(dest_path_rj) 113 | 114 | } 115 | 116 | } 117 | -------------------------------------------------------------------------------- /R/posteriorSamplesToParametricPrior.R: -------------------------------------------------------------------------------- 1 | #' Priors from MCMC samples 2 | #' 3 | #' 4 | #' Turn posterior samples collected by MCMC into a parametric prior 5 | #' distribution. 6 | #' 7 | #' The distributions are fit by the method of moments. 8 | #' The function allows inflating the prior variance relative to the posterior 9 | #' being supplied. 10 | #' 11 | #' @param samples (numeric vector; no default) MCMC samples for a single 12 | #' parameter. 13 | #' @param distribution (character; no default) The distribution to fit. Options 14 | #' are gamma for strictly positive 15 | #' parameters and normal for unbounded parameters. 16 | #' @param variance_inflation_factor (single numeric value; default = 2.0) Makes 17 | #' the prior variance larger than the variance of the posterior 18 | #' 19 | #' @return Numeric vector of parameters with names (to avoid rate/scale and 20 | #' var/sd confusion). 21 | #' 22 | #' @examples 23 | #' 24 | #' \donttest{ 25 | #' # download the example datasets to working directory 26 | #' 27 | #' url_ex_times <- 28 | #' "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_times.log" 29 | #' dest_path_ex_times <- "primates_EBD_extinction_times.log" 30 | #' download.file(url_ex_times, dest_path_ex_times) 31 | #' 32 | #' url_ex_rates <- 33 | #' "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_rates.log" 34 | #' dest_path_ex_rates <- "primates_EBD_extinction_rates.log" 35 | #' download.file(url_ex_rates, dest_path_ex_rates) 36 | #' 37 | #' url_sp_times <- 38 | #' "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_times.log" 39 | #' dest_path_sp_times <- "primates_EBD_speciation_times.log" 40 | #' download.file(url_sp_times, dest_path_sp_times) 41 | #' 42 | #' url_sp_rates <- 43 | #' "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_rates.log" 44 | #' dest_path_sp_rates <- "primates_EBD_speciation_rates.log" 45 | #' download.file(url_sp_rates, dest_path_sp_rates) 46 | #' 47 | #' # to run on your own data, change this to the path to your data file 48 | #' speciation_time_file <- dest_path_sp_times 49 | #' speciation_rate_file <- dest_path_sp_rates 50 | #' extinction_time_file <- dest_path_ex_times 51 | #' extinction_rate_file <- dest_path_ex_rates 52 | #' 53 | #' primates <- processDivRates(speciation_time_log = speciation_time_file, 54 | #' speciation_rate_log = speciation_rate_file, 55 | #' extinction_time_log = extinction_time_file, 56 | #' extinction_rate_log = extinction_rate_file, 57 | #' burnin = 0.25) 58 | #' 59 | #' speciation_rates <- 60 | #' dplyr::pull(primates[which(primates$item == "speciation rate"),], 61 | #' "value") 62 | #' speciation_1_gamma_prior <- 63 | #' posteriorSamplesToParametricPrior(speciation_rates,"gamma") 64 | #' 65 | #' # remove files 66 | #' # WARNING: only run for example dataset! 67 | #' # otherwise you might delete your data! 68 | #' file.remove(dest_path_sp_times, dest_path_ex_times, 69 | #' dest_path_sp_rates, dest_path_ex_rates) 70 | #' } 71 | #' 72 | #' @export 73 | 74 | posteriorSamplesToParametricPrior <- function(samples, 75 | distribution, 76 | variance_inflation_factor = 77 | 2.0) { 78 | if (!is.numeric(samples)) { 79 | stop("This function requires numeric input data.") 80 | } 81 | if (!length(samples) >= 3) { 82 | stop("Must provide at least 3 samples to compute mean/variance 83 | (many more is recommended).") 84 | } 85 | if (variance_inflation_factor < 1.0) { 86 | stop("Not recommended to decrease variance from posterior.") 87 | } 88 | if (length(distribution) > 1) { 89 | stop("Only one distribution can be selected.") 90 | } 91 | 92 | par <- numeric() 93 | 94 | sample_mean <- mean(samples) 95 | sample_var <- variance_inflation_factor * stats::var(samples) 96 | 97 | if (grepl("gam", tolower(distribution))) { 98 | # Fit a gamma distribution 99 | b <- sample_mean / sample_var 100 | a <- sample_mean * b 101 | par <- c(a, b) 102 | names(par) <- c("gamma.shape", "gamma.rate") 103 | } else if (grepl("^norm", tolower(distribution))) { 104 | # Fit a normal distribution 105 | par <- c(sample_mean, sqrt(sample_var)) 106 | names(par) <- c("normal.mean", "normal.sd") 107 | } else { 108 | stop("Unrecognized distribution choice.") 109 | } 110 | 111 | return(par) 112 | } 113 | -------------------------------------------------------------------------------- /man/processDivRates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/processDivRates.R 3 | \name{processDivRates} 4 | \alias{processDivRates} 5 | \title{Process Diversification Rates} 6 | \usage{ 7 | processDivRates( 8 | speciation_time_log = "", 9 | speciation_rate_log = "", 10 | extinction_time_log = "", 11 | extinction_rate_log = "", 12 | fossilization_time_log = "", 13 | fossilization_rate_log = "", 14 | burnin = 0.25, 15 | probs = c(0.025, 0.975), 16 | summary = "median" 17 | ) 18 | } 19 | \arguments{ 20 | \item{speciation_time_log}{(vector of character strings or 21 | single character string; "") Path to speciation times log file(s)} 22 | 23 | \item{speciation_rate_log}{(vector of character strings or 24 | single character string; "") Path to speciation rates log file(s)} 25 | 26 | \item{extinction_time_log}{(vector of character strings or 27 | single character string; "") Path to extinction times log file(s)} 28 | 29 | \item{extinction_rate_log}{(vector of character strings or 30 | single character string; "") Path to extinction rates log file(s)} 31 | 32 | \item{fossilization_time_log}{(vector of character strings or 33 | single character string; "") Path to fossilization times log file(s)} 34 | 35 | \item{fossilization_rate_log}{(vector of character strings or 36 | single character string; "") Path to fossilization rates log file(s)} 37 | 38 | \item{burnin}{(single numeric value; default = 0) Fraction of generations to 39 | discard (if value provided is between 0 and 1) or number of generations (if 40 | value provided is greater than 1). Passed to readTrace().} 41 | 42 | \item{probs}{(numeric vector; c(0.025, 0.975)) a vector of length two 43 | containing the upper and lower bounds for the confidence intervals.} 44 | 45 | \item{summary}{typically "mean" or "median"; the metric to summarize the 46 | posterior distribution. Defaults to "median"} 47 | } 48 | \value{ 49 | List object with processed rate and time parameters. 50 | } 51 | \description{ 52 | Processing the output of a episodic diversification rate analysis with 53 | mass-extinction events. 54 | } 55 | \details{ 56 | For processing the output of an episodic diversification rate analysis. 57 | processDivRates() assumes that the epochs are fixed rather than inferred. 58 | Additionally, it assumes that times correspond to rates such that the first 59 | rate parameter (i.e. speciation[1]) corresponds to the present. Conversely, 60 | the first time parameter (i.e. interval_times[1]) corresponds to the first 61 | time interval after the present, moving backwards in time. processDivRates() 62 | relies on readTrace and produces a list object that can be read by 63 | plotDivRates() to visualize the results. For now, only one log file per 64 | parameter type is accepted (i.e. log files from multiple runs must be 65 | combined before reading into the function). 66 | } 67 | \examples{ 68 | 69 | \donttest{ 70 | # download the example datasets to working directory 71 | 72 | url_ex_times <- 73 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_times.log" 74 | dest_path_ex_times <- "primates_EBD_extinction_times.log" 75 | download.file(url_ex_times, dest_path_ex_times) 76 | 77 | url_ex_rates <- 78 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_extinction_rates.log" 79 | dest_path_ex_rates <- "primates_EBD_extinction_rates.log" 80 | download.file(url_ex_rates, dest_path_ex_rates) 81 | 82 | url_sp_times <- 83 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_times.log" 84 | dest_path_sp_times <- "primates_EBD_speciation_times.log" 85 | download.file(url_sp_times, dest_path_sp_times) 86 | 87 | url_sp_rates <- 88 | "https://revbayes.github.io/tutorials/intro/data/primates_EBD_speciation_rates.log" 89 | dest_path_sp_rates <- "primates_EBD_speciation_rates.log" 90 | download.file(url_sp_rates, dest_path_sp_rates) 91 | 92 | # to run on your own data, change this to the path to your data file 93 | speciation_time_file <- dest_path_sp_times 94 | speciation_rate_file <- dest_path_sp_rates 95 | extinction_time_file <- dest_path_ex_times 96 | extinction_rate_file <- dest_path_ex_rates 97 | 98 | rates <- processDivRates(speciation_time_log = speciation_time_file, 99 | speciation_rate_log = speciation_rate_file, 100 | extinction_time_log = extinction_time_file, 101 | extinction_rate_log = extinction_rate_file, 102 | burnin = 0.25) 103 | 104 | # remove files 105 | # WARNING: only run for example dataset! 106 | # otherwise you might delete your data! 107 | file.remove(dest_path_sp_times, dest_path_ex_times, 108 | dest_path_sp_rates, dest_path_ex_rates) 109 | } 110 | 111 | } 112 | -------------------------------------------------------------------------------- /man/plotDiversityOBDP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotDiversityOBDP.R 3 | \name{plotDiversityOBDP} 4 | \alias{plotDiversityOBDP} 5 | \title{Plot Diversity Distribution from OBDP Analysis} 6 | \usage{ 7 | plotDiversityOBDP( 8 | Kt_mean, 9 | xlab = "Time", 10 | ylab = "Number of lineages", 11 | xticks_n_breaks = 5, 12 | col_Hidden = "dodgerblue3", 13 | col_LTT = "gray25", 14 | col_Total = "forestgreen", 15 | col_Hidden_interval = "dodgerblue2", 16 | col_Total_interval = "darkolivegreen4", 17 | palette_Hidden = c("transparent", "dodgerblue2", "dodgerblue3", "dodgerblue4", "black"), 18 | palette_Total = c("transparent", "green4", "forestgreen", "black"), 19 | line_size = 0.7, 20 | interval_line_size = 0.5, 21 | show_Hidden = TRUE, 22 | show_LTT = TRUE, 23 | show_Total = TRUE, 24 | show_intervals = TRUE, 25 | show_densities = TRUE, 26 | show_expectations = TRUE, 27 | use_interpolate = TRUE 28 | ) 29 | } 30 | \arguments{ 31 | \item{Kt_mean}{(data.frame; no default) The processed data.frame (output of readOBDP()).} 32 | 33 | \item{xlab}{(character; "Time") The label of the x-axis.} 34 | 35 | \item{ylab}{(character; "Number of lineages") The label of the y-axis.} 36 | 37 | \item{xticks_n_breaks}{(numeric; 5) An integer guiding the number of major breaks.} 38 | 39 | \item{col_Hidden}{(character; "dodgerblue3") The color of the hidden lineages plot line.} 40 | 41 | \item{col_LTT}{(character; "gray25") The color of the LTT plot line.} 42 | 43 | \item{col_Total}{(character; "forestgreen") The color of the total lineages plot line.} 44 | 45 | \item{col_Hidden_interval}{(character; "dodgerblue2") The color of the credible interval lines around the hidden lineages plot.} 46 | 47 | \item{col_Total_interval}{(character; "darkolivegreen4") The color of the credible interval lines around the total lineages plot.} 48 | 49 | \item{palette_Hidden}{(character; c("transparent", "dodgerblue2", "dodgerblue3", "dodgerblue4", "black")) The palette of the hidden lineages plot distribution.} 50 | 51 | \item{palette_Total}{(character; c("transparent", "green4", "forestgreen", "black")) The palette of the total lineages plot distribution.} 52 | 53 | \item{line_size}{(numeric; 0.7) The width of the lineage plot line.} 54 | 55 | \item{interval_line_size}{(numeric; 0.5) The width of the credible interval.} 56 | 57 | \item{show_Hidden}{(boolean; TRUE) Whether to show the plot for hidden lineages.} 58 | 59 | \item{show_LTT}{(boolean; TRUE) Whether to show the plot for observed lineages.} 60 | 61 | \item{show_Total}{(boolean; TRUE) Whether to show the plot for total lineages.} 62 | 63 | \item{show_intervals}{(boolean; TRUE) Whether to show the credible intervals.} 64 | 65 | \item{show_densities}{(boolean; TRUE) Whether to show the diversity densities.} 66 | 67 | \item{show_expectations}{(boolean; TRUE) Whether to show the diversity expectations.} 68 | 69 | \item{use_interpolate}{(boolean; TRUE) Whether to interpolate densities.} 70 | } 71 | \value{ 72 | A ggplot object 73 | } 74 | \description{ 75 | Plots the probability distribution of the number of lineages through time inferred with the 76 | Occurrence Birth Death Process 77 | #' 78 | } 79 | \examples{ 80 | 81 | \dontrun{ 82 | # first run readOBDP() 83 | start_time_trace_file <- 84 | system.file("extdata", "obdp/start_time_trace.p", package="RevGadgets") 85 | popSize_distribution_matrices_file <- 86 | system.file("extdata", "obdp/Kt_trace.p", package="RevGadgets") 87 | trees_trace_file <- 88 | system.file("extdata", "obdp/mcmc_OBDP_trees.p", package="RevGadgets") 89 | 90 | Kt_mean <- readOBDP( start_time_trace_file=start_time_trace_file, 91 | popSize_distribution_matrices_file=popSize_distribution_matrices_file, 92 | trees_trace_file=trees_trace_file ) 93 | 94 | # then get the customized ggplot object with plotDiversityOBDP() 95 | p <- plotDiversityOBDP( Kt_mean, 96 | xlab="Time (My)", 97 | ylab="Number of lineages", 98 | xticks_n_breaks=21, 99 | col_Hidden="dodgerblue3", 100 | col_LTT="gray25", 101 | col_Total="forestgreen", 102 | col_Hidden_interval="dodgerblue2", 103 | col_Total_interval="darkolivegreen4", 104 | palette_Hidden=c("transparent", "dodgerblue2", "dodgerblue3", 105 | "dodgerblue4", "black"), 106 | palette_Total=c("transparent", "green4", "forestgreen", "black"), 107 | line_size=0.7, 108 | interval_line_size=0.5, 109 | show_Hidden=TRUE, 110 | show_LTT=TRUE, 111 | show_Total=TRUE, 112 | show_intervals=TRUE, 113 | show_densities=TRUE, 114 | show_expectations=TRUE, 115 | use_interpolate=TRUE ) 116 | 117 | # basic plot 118 | p 119 | 120 | # option: add a stratigraphic scale 121 | library(deeptime) 122 | library(ggplot2) 123 | q <- gggeo_scale(p, dat="periods", height=unit(1.3, "line"), abbrv=F, size=4.5, neg=T) 124 | r <- gggeo_scale(q, dat="epochs", height=unit(1.1, "line"), abbrv=F, size=3.5, neg=T, 125 | skip=c("Paleocene", "Pliocene", "Pleistocene", "Holocene")) 126 | s <- gggeo_scale(r, dat="stages", height=unit(1, "line"), abbrv=T, size=2.5, neg=T) 127 | s 128 | } 129 | 130 | } 131 | --------------------------------------------------------------------------------