Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

object.size.reduce #27

Merged
merged 9 commits into from
Mar 21, 2023
Merged

object.size.reduce #27

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
40566d7
Update AgeS_Computation to reduce output size
baumbuddy Mar 9, 2023
5efbeef
Updage Age_OSLC14 to reduce object size
baumbuddy Mar 9, 2023
5e5c7f6
Update AgeS_Computation.R
baumbuddy Mar 9, 2023
cd6f3ad
update AgeS_Computation documentation
baumbuddy Mar 10, 2023
6ecf915
AgeS_computation: removing redundant characters
baumbuddy Mar 10, 2023
83fec57
Age_OSLC14: minor corrections
baumbuddy Mar 10, 2023
7cf30c4
fix so markdown syntax is used
baumbuddy Mar 21, 2023
c95864c
fix so markdown syntax is used
baumbuddy Mar 21, 2023
cf44803
Merge branch 'crp2a:master' into object.size.reduce
baumbuddy Mar 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 18 additions & 11 deletions R/AgeS_Computation.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@
#' \code{DATA} contains informations for more than one sample.
#' If there is stratigraphic relations between samples, informations in DATA must be ordered by order of increasing ages.
#' See the details section to for more informations.
#' (2): An object of class "runjags" which is provided by the output of [AgeS_Computation]. When input of class "runjags" is identified, no new JAGS model is created. Instead, the JAGS model specified by the "runjags" object is extended. Useful for when convergence was not originally achieved and a complete restart is not desirable.
#' (2): An object of class `BayLum.list` which is provided by the output of [AgeS_Computation]. When input of class `BayLum.list` is identified, no new JAGS model is created. Instead, the JAGS model specified by the [AgeS_Computation] output is extended. Useful for when convergence was not originally achieved and a complete restart is not desirable.
#'
#' @param SampleNames [character] vector: names of samples. The length of this vector is equal to `Nb_sample`.
#'
Expand Down Expand Up @@ -287,7 +287,7 @@
#'
#' ## extend model
#' Age_extended <- AgeS_Computation(
#' DATA = Age$runjags_object,
#' DATA = Age,
#' Nb_sample = Nb_sample,
#' SampleNames = c("GDB5","GDB3"),
#' PriorAge = rep(c(1,100), 2),
Expand Down Expand Up @@ -357,10 +357,14 @@ AgeS_Computation <- function(
...
) {
#---check to see if DATA input is a runjags-object and extend if so ####
if (inherits(DATA, "runjags")) {
if (inherits(DATA, "BayLum.list")) {
# reattach mcmc-list which was removed to reduce object size
DATA$runjags_object$mcmc <- DATA$Sampling

# extend via runjags
results_runjags <-
runjags::extend.JAGS(
runjags.object = DATA,
runjags.object = DATA$runjags_object,
adapt = adapt,
burnin = burnin,
sample = Iter,
Expand All @@ -372,16 +376,16 @@ AgeS_Computation <- function(

# storing the arguments used for the original BayLum run (as to not lose them when results are processed)
results_runjags$args <- list(
"Model_GrowthCurve" = DATA$args$Model_GrowthCurve,
"Distribution" = DATA$args$Distribution,
"PriorAge" = DATA$args$PriorAge,
"StratiConstraints" = DATA$args$StratiConstraints,
"CovarianceMatrix" = DATA$args$CovarianceMatrix,
"model" = DATA$args$model
"Model_GrowthCurve" = DATA$runjags_object$args$Model_GrowthCurve,
"Distribution" = DATA$runjags_object$args$Distribution,
"PriorAge" = DATA$runjags_object$args$PriorAge,
"StratiConstraints" = DATA$runjags_object$args$StratiConstraints,
"CovarianceMatrix" = DATA$runjags_object$args$CovarianceMatrix,
"model" = DATA$runjags_object$args$model
)
}
#---check to see if DATA input is a DataFile and run JAGS ####
if (!inherits(DATA, "runjags")) {
if (!inherits(DATA, "BayLum.list")) {
##---Index preparation ####
CSBinPerSample <- cumsum(BinPerSample)
LengthSample <- c()
Expand Down Expand Up @@ -563,6 +567,9 @@ AgeS_Computation <- function(
#---processing of JAGS results
##extract mcmc list from runjags object
echantillon <- results_runjags$mcmc

##remove mcmc-list from runjags output to reduce output object size
results_runjags$mcmc <- list("MCMC-list is not here. Go to first level -> object named *Sampling*")

##combine chains into one data.frame
sample <- as.data.frame(runjags::combine.mcmc(echantillon))
Expand Down
52 changes: 29 additions & 23 deletions R/Age_OSLC14.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@
#' \code{DATA} contains information for more than one sample.
#' If there is stratigraphic relations between samples, informations in DATA must be ordered by order of
#' increasing ages. See the details section to for more informations.
#' (2): an object of class "runjags" which is provided by the output of [Age_OSLC14]. When input of class "runjags" is identified, no new JAGS model is created. Instead, the JAGS model specified by the "runjags" object is extended. Useful for when convergence was not originally achieved and a complete restart is not desirable.
#' (2): an object of class `BayLum.list` which is provided by the output of [Age_OSLC14]. When input of class `BayLum.list` is identified, no new JAGS model is created. Instead, the JAGS model specified within the `BayLum.list` is extended. Useful for when convergence was not originally achieved and a complete restart is not desirable.
#'
#' @param Data_C14Cal [numeric] vector: corresponding to C-14 age estimate
#' (in years, conversion in ka is automatically done in the function).
Expand Down Expand Up @@ -297,7 +297,7 @@
#' of the age estimates if the chains have converged.
#'
#' @seealso
#' [rjags], [plot_MCMC], [SCMatrix], [plot_Ages]
#' [runjags], [plot_MCMC], [SCMatrix], [plot_Ages]
#'
#' @references
#' Reimer PJ, Bard E, Bayliss A, Beck JW, Blackwell PC, Bronl Ramsey C, Buck CE, Cheng H, Edwards RL, Friedrich M,
Expand Down Expand Up @@ -389,20 +389,23 @@ Age_OSLC14 <- function(
roundingOfValue = 3,
...
) {
if (inherits(DATA, "runjags")) {
ind_OSL <- which(DATA$args$SampleNature[1,] == 1)
CS_OSL <- cumsum(DATA$args$SampleNature[1,])
ind_C14 <- which(DATA$args$SampleNature[2,] == 1)
CS_C14 <- cumsum(DATA$args$SampleNature[2,])
if (inherits(DATA, "BayLum.list")) {
## reattach mcmc-list to runjags_object
DATA$runjags_object$mcmc <- DATA$Sampling

ind_OSL <- which(DATA$runjags_object$args$SampleNature[1,] == 1)
CS_OSL <- cumsum(DATA$runjags_object$args$SampleNature[1,])
ind_C14 <- which(DATA$runjags_object$args$SampleNature[2,] == 1)
CS_C14 <- cumsum(DATA$runjags_object$args$SampleNature[2,])


AgeBP = rev(DATA$args$TableauCalib[, 1])
CalC14 = rev(DATA$args$TableauCalib[, 2])
SigmaCalC14 = rev(DATA$args$TableauCalib[, 3])
AgeBP = rev(DATA$runjags_object$args$TableauCalib[, 1])
CalC14 = rev(DATA$runjags_object$args$TableauCalib[, 2])
SigmaCalC14 = rev(DATA$runjags_object$args$TableauCalib[, 3])

results_runjags <-
runjags::extend.JAGS(
runjags.object = DATA,
runjags.object = DATA$runjags_object,
adapt = adapt,
burnin = burnin,
sample = Iter,
Expand All @@ -414,21 +417,21 @@ Age_OSLC14 <- function(

# storing the arguments used for the orignal BayLum run (as to not lose them when results are processed)
results_runjags$args <- list(
"Model_OSL_GrowthCurve" = DATA$args$Model_OSL_GrowthCurve,
"Model_OSL_Distribution" = DATA$args$Model_OSL_Distribution,
"PriorAge" = DATA$args$PriorAge,
"StratiConstraints" = DATA$args$StratiConstraints,
"CovarianceMatrix" = DATA$args$CovarianceMatrix,
"Model_C14" = DATA$args$Model_C14,
"TableauCalib" = DATA$args$TableauCalib,
"Outlier" = DATA$args$Outlier,
"SampleNature" = DATA$args$SampleNature,
"Data_C14Cal" = DATA$args$Data_C14Cal,
"Nb_sample" = DATA$args$Nb_sample
"Model_OSL_GrowthCurve" = DATA$runjags_object$args$Model_OSL_GrowthCurve,
"Model_OSL_Distribution" = DATA$runjags_object$args$Model_OSL_Distribution,
"PriorAge" = DATA$runjags_object$args$PriorAge,
"StratiConstraints" = DATA$runjags_object$args$StratiConstraints,
"CovarianceMatrix" = DATA$runjags_object$args$CovarianceMatrix,
"Model_C14" = DATA$runjags_object$args$Model_C14,
"TableauCalib" = DATA$runjags_object$args$TableauCalib,
"Outlier" = DATA$runjags_object$args$Outlier,
"SampleNature" = DATA$runjags_object$args$SampleNature,
"Data_C14Cal" = DATA$runjags_object$args$Data_C14Cal,
"Nb_sample" = DATA$runjags_object$args$Nb_sample
)
}

if(!inherits(DATA, "runjags")) {
if(!inherits(DATA, "BayLum.list")) {
#--- StratiConstraints matrix ####
if (length(StratiConstraints) == 0) {
StratiConstraints = matrix(
Expand Down Expand Up @@ -727,6 +730,9 @@ Age_OSLC14 <- function(
echantillon <- results_runjags$mcmc
U <- summary(echantillon)

##remove mcmc-list from runjags output to reduce output object size
results_runjags$mcmc <- list("MCMC-list is not here. Go to first level -> object named *Sampling*")

##combine chains into one data.frame
Sample <- as.data.frame(runjags::combine.mcmc(echantillon))

Expand Down