From f61f437f842180add45bbc59825559e91571f4e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=98ystein=20Olav=20Skaar?= Date: Sat, 3 Nov 2018 18:26:53 +0100 Subject: [PATCH] 0.2.0.9005 --- .gitignore | 2 +- .travis.yml | 11 +- DESCRIPTION | 8 +- NAMESPACE | 5 +- NEWS.md | 25 ++ R/basic_functions.R | 80 +++++- R/mcmc.R | 250 ++++++++++-------- R/mcmc_misc.R | 32 ++- R/mcmc_summary.R | 2 +- R/plot_circlize.R | 19 +- R/plot_mean.R | 20 +- R/plot_param.R | 203 ++++++++++++++ R/plot_parse.R | 4 +- R/settings.R | 125 +++------ R/stats_bernoulli.R | 8 +- R/stats_covariate.R | 45 ++-- R/stats_fit.R | 36 +-- R/stats_kappa.R | 15 +- R/stats_mean.R | 12 +- R/stats_metric.R | 18 +- R/stats_nominal.R | 12 +- R/stats_regression.R | 42 +-- R/stats_softmax.R | 16 +- README.md | 32 ++- TODO.md | 13 +- inst/doc/{plot_data.md => plot_mean.md} | 24 +- inst/extdata/models/stats_fit_cfa.txt | 10 + inst/extdata/models/stats_regression.txt | 8 +- .../models/stats_regression_robust.txt | 8 +- inst/extdata/templates/apa.pptx | Bin 0 -> 32693 bytes man/MatrixCombn.Rd | 11 +- man/MultiGrep.Rd | 20 ++ man/ParsePlot.Rd | 2 +- man/PlotCirclize.Rd | 10 +- man/PlotMean.Rd | 4 +- man/PlotParam.Rd | 52 ++++ man/RemoveGarbage.Rd | 14 + man/RunMCMC.Rd | 25 +- man/StatsBernoulli.Rd | 3 +- man/StatsCovariate.Rd | 5 +- man/StatsFit.Rd | 10 +- man/StatsKappa.Rd | 3 +- man/StatsMean.Rd | 3 +- man/StatsMetric.Rd | 5 +- man/StatsNominal.Rd | 5 +- man/StatsRegression.Rd | 5 +- man/StatsSoftmax.Rd | 5 +- man/SumMCMC.Rd | 2 +- man/TidyCode.Rd | 2 +- man/TrimSplit.Rd | 2 +- man/bfw.Rd | 95 +------ 51 files changed, 865 insertions(+), 503 deletions(-) create mode 100644 R/plot_param.R rename inst/doc/{plot_data.md => plot_mean.md} (84%) create mode 100644 inst/extdata/templates/apa.pptx create mode 100644 man/MultiGrep.Rd create mode 100644 man/PlotParam.Rd create mode 100644 man/RemoveGarbage.Rd diff --git a/.gitignore b/.gitignore index 5ed9cc2..32d6254 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ Meta .Rproj.user -.Rhistory +*.Rhistory .RData .Ruserdata *.Rmd diff --git a/.travis.yml b/.travis.yml index 3040555..75b6af7 100644 --- a/.travis.yml +++ b/.travis.yml @@ -34,12 +34,13 @@ apt_packages: - libv8-dev r_packages: - - coda - - MASS - - runjags + - covr + - circlize + - dplyr - ggplot2 - knitr - lavaan + - magrittr - officer - plyr - png @@ -47,7 +48,8 @@ r_packages: - rmarkdown - rvg - scales - + - testthat + notifications: email: on_success: change @@ -55,6 +57,7 @@ notifications: r_github_packages: - r-lib/covr + - r-lib/devtools after_success: - Rscript -e 'covr::coveralls()' diff --git a/DESCRIPTION b/DESCRIPTION index 5297cf5..dde7937 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: bfw -Version: 0.2.0.9004 -Date: 2018-09-18 +Version: 0.2.0.9005 +Date: 2018-11-03 Title: Bayesian Framework for Computational Modeling Authors@R: person( "Øystein Olav","Skaar", email="bayesianfw@gmail.com", role=c("aut","cre")) Maintainer: Øystein Olav Skaar @@ -19,13 +19,15 @@ SystemRequirements: JAGS >=4.3.0 , Depends: R (>= 3.5.0), Imports: coda (>= 0.19-1), MASS (>= 7.3-47), - runjags (>= 2.0.4-2) + runjags (>= 2.0.4-2) Suggests: covr (>= 3.1.0), circlize (>= 0.4.4), + dplyr (>= 0.7.7), ggplot2 (>= 2.2.1), knitr (>= 1.20), lavaan (>= 0.6-1), + magrittr (>= 1.5), officer (>= 0.3.1), plyr (>= 1.8.4), png (>= 0.1-7), diff --git a/NAMESPACE b/NAMESPACE index b3e1214..d256728 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,16 +15,18 @@ export(Interleave) export(Layout) export(MatrixCombn) export(MergeMCMC) +export(MultiGrep) export(Normalize) export(PadVector) export(ParseNumber) export(ParsePlot) export(PlotCirclize) -export(PlotData) export(PlotMean) export(PlotNominal) +export(PlotParam) export(ReadFile) export(RemoveEmpty) +export(RemoveGarbage) export(RemoveSpaces) export(RunContrasts) export(RunMCMC) @@ -79,6 +81,7 @@ importFrom(runjags,run.jags) importFrom(runjags,runjags.options) importFrom(stats,acf) importFrom(stats,aggregate) +importFrom(stats,approx) importFrom(stats,approxfun) importFrom(stats,complete.cases) importFrom(stats,cor) diff --git a/NEWS.md b/NEWS.md index 335a230..0766a18 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,28 @@ +# bfw 0.2.0.9005 + +### Feature + +* Updated `CFA` function to include correlation matrix +* Added a option to run `PPP` for every kth length of MCMC chains (Default is every 10th) + +#### Moderate + +* Optimized `RunContrasts` to allow larger MCMC simulations (2nd review) + +#### Minor + +* Fixed `plot_data` vignette +* Updated `README` +* Fixed title bug in `circlize` plots +* Added `RemoveGarbage` function to clear up working memory +* Added `MultiGrep` function to use multiple patterns to select an element from a vector +* Fixed bug in `kappa` function +* Fixed bug in `covariate` function +* Fixed inlinde comment bug in `TidyCode` function +* Added option to define which parameters to use for diagnostics +* Removed (some of the...) unnecessary arguments in `bfw` function +* Added a `apa` PowerPoint template + # bfw 0.2.0.9004 ### Feature diff --git a/R/basic_functions.R b/R/basic_functions.R index 18f5b35..39a93b1 100644 --- a/R/basic_functions.R +++ b/R/basic_functions.R @@ -283,6 +283,7 @@ Layout <- function(x = "a4", layout.inverse = FALSE) { x <- switch (x, "pt" = c(10,7.5), "pw" = c(13.33,7.5), + "apa" = c(5.1338582677, 7.2515748), "4a0" = c(66.2,93.6), "2a0" = c(46.8,66.2), "a0" = c(33.1,46.8), @@ -459,7 +460,7 @@ Trim <- function(s, multi = TRUE) { #' @param sep symbol to separate data (e.g., comma-delimited), Default: ',' #' @param fixed logical, if TRUE match split exactly, otherwise use regular expressions. Has priority over perl, Default: FALSE #' @param perl logical, indicating whether or not to use Perl-compatible regexps, Default: FALSE -#' @param useBytes logical. If TRUE the matching is done byte-by-byte rather than character-by-character, Default: FALSE +#' @param useBytes logical, if TRUE the matching is done byte-by-byte rather than character-by-character, Default: FALSE #' @param rm.empty logical. indicating whether or not to remove empty elements, Default: TRUE #' @details \link[base]{strsplit} #' @examples @@ -515,7 +516,7 @@ VectorSub <- function ( pattern , replacement , string ) { #' @title Tidy Code #' @description Small function that clears up messy code #' @param tidy.code Messy code that needs cleaning -#' @param jags logical. If TRUE run code as JAGS model, Default: TRUE +#' @param jags logical, if TRUE run code as JAGS model, Default: TRUE #' @return (Somewhat) tidy code #' @examples #' messy <- "code <- function( x ) { @@ -540,35 +541,47 @@ TidyCode <- function(tidy.code, tidy.code <- gsub("model[[:space:]]+\\{", "if (TidyJagsModel) {" , tidy.code) tidy.code <- gsub("model\\{", "if (TidyJagsModel) {" , tidy.code) } - - # Extract blocks from cod + + # Extract blocks from code tidy.code <- TrimSplit(tidy.code,"\\\n") - + # Wrap comments prior to parsing - invisible(lapply(grep("\\#",tidy.code), function (i){ - tidy.code[i] <<- sprintf("invisible(\"StartPreParse%sEndPreParse\")" , tidy.code[i]) + invisible(lapply(grep("\\#",tidy.code), function (i) { + if (substring(tidy.code[[i]], 1, 1) == "#") { + tidy.code[i] <<- sprintf("invisible(\"StartPreParse%sEndPreParse\")" , tidy.code[i]) + } else { + tidy.code[i] <<- sprintf("%s\ninvisible(\"StartInlinePreParse%sEndPreParse\")" , + gsub('\\#.*', '', tidy.code[[i]]), + gsub('.*\\#', '#', tidy.code[[i]]) ) + } })) - + # Parse code tidy.code <- base::parse(text = tidy.code, keep.source = FALSE) - + # Collapse parsed function into a vector tidy.code <- sapply(tidy.code, function(e) { paste(base::deparse(e, getOption("width")), collapse = "\n") }) - + # remove spaces between commas tidy.code <- gsub("\\s*\\,\\s*", "," , tidy.code) - + # Revert comments (remove invisibility) tidy.code <- gsub("invisible\\(\\\"StartPreParse" , "" , tidy.code) tidy.code <- gsub("EndPreParse\\\")" , "" , tidy.code) - + # Revert inline comments (remove invisibility) + tidy.code <- gsub("\n[[:space:]]+invisible\\(\\\"StartInlinePreParse" , " " , tidy.code) + + # If jags replace placeholder if (jags) { tidy.code <- gsub("if \\(TidyJagsData\\)", "data" , tidy.code) tidy.code <- gsub("if \\(TidyJagsModel\\)", "model" , tidy.code) } + + # Collapse to string + tidy.code <- paste0(tidy.code, collapse="\n") return (tidy.code) } @@ -594,4 +607,47 @@ ETA <- function (start.time, i , total) { cat("\r" , eta.message , sep="") utils::flush.console() if (i == total) cat("\n") +} + +#' @title Remove Garbage +#' @description Remove variable(s) and remove garbage from memory +#' @param v variables to remove +#' @rdname RemoveGarbage +#' @export + +RemoveGarbage <- function (v) { + v <- TrimSplit(v) + rm( list = v, envir=sys.frame(-1) ) + # Garbage Collection + invisible(base::gc(verbose = FALSE, full = TRUE)) +} + +#' @title Multi Grep +#' @description Use multiple patterns from vector to find element in another vector, with option to remove certain patterns +#' @param find vector to find +#' @param from vector to find from +#' @param remove variables to remove, Default: NULL +#' @param value logical, if TRUE returns value, Default: TRUE +#' @rdname MultiGrep +#' @export + +MultiGrep <- function (find, from , remove = NULL , value = TRUE) { + + find <- TrimSplit(find) + remove <- TrimSplit(remove) + + found <- grep(paste(sprintf("(?=.*%s)",find), collapse=""), + from, perl = TRUE , value=value) + + if (length(remove)) { + remove.find <- if (value) found else from[found] + remove <- unique(unlist(lapply(remove, function (x) { + grep(paste(sprintf("(?=.*\\b%s\\b)",x), collapse=""), + remove.find, perl = TRUE) + }))) + found <- found[-remove] + } + + return (found) + } \ No newline at end of file diff --git a/R/mcmc.R b/R/mcmc.R index e4b7f2b..7eebb1a 100644 --- a/R/mcmc.R +++ b/R/mcmc.R @@ -6,15 +6,17 @@ #' @param data.list list of data #' @param initial.list initial values for analysis, Default: list() #' @param run.contrasts logical, indicating whether or not to run contrasts, Default: FALSE -#' @param use.contrast choose from "between", "within" and "mixed". Between compare groups at different conditions. Within compare a group at different conditions. Mixed compute all comparisons. +#' @param use.contrast choose from "between", "within" and "mixed". Between compare groups at different conditions. Within compare a group at different conditions. Mixed compute all comparisons, Default: "between", #' @param contrasts define contrasts to use for analysis (defaults to all) , Default: NULL #' @param run.ppp logical, indicating whether or not to conduct ppp analysis, Default: FALSE +#' @param k.ppp run ppp for every kth length of MCMC chains, Default: 10 #' @param n.data sample size for each parameter #' @param credible.region summarize uncertainty by defining a region of most credible values (e.g., 95 percent of the distribution), Default: 0.95 #' @param save.data logical, indicating whether or not to save data, Default: FALSE #' @param ROPE define range for region of practical equivalence (e.g., c(-0.05 , 0.05), Default: NULL #' @param merge.MCMC logical, indicating whether or not to merge MCMC chains, Default: FALSE #' @param run.diag logical, indicating whether or not to run diagnostics, Default: FALSE +#' @param param.diag define parameters to use for diagnostics, default equals all parameters, Default: NULL #' @param sep symbol to separate data (e.g., comma-delimited), Default: ',' #' @param monochrome logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE #' @param plot.colors range of color to use, Default: c("#495054", "#e3e8ea") @@ -49,21 +51,23 @@ #' @importFrom MASS mvrnorm #' @importFrom utils write.table RunMCMC <- function(jags.model, - params, + params = NULL, name.list, data.list, - initial.list, - run.contrasts, - use.contrast, - contrasts, - run.ppp, + initial.list = list(), + run.contrasts = FALSE, + use.contrast = "between", + contrasts = NULL, + run.ppp = FALSE, + k.ppp = 10, n.data, - credible.region, + credible.region = 0.95, save.data = FALSE, - ROPE, - merge.MCMC, - run.diag, - sep, + ROPE = NULL, + merge.MCMC = FALSE, + run.diag = FALSE, + param.diag = NULL, + sep = ",", monochrome = TRUE, plot.colors = c("#495054", "#e3e8ea"), graphic.type = "pdf", @@ -100,24 +104,7 @@ RunMCMC <- function(jags.model, # Add jags seed to initial list initial.list <- c(initial.list, .RNG.seed = jags.seed) - - # Number of adapting steps - if (!length(adapt.steps)) adapt.steps <- max ( (saved.steps * 5) / 100 , 2000 ) - # Number of burn-in steps - if (!length(burnin.steps)) burnin.steps <- max ( (saved.steps * 7.5) / 100 , 3000 ) - - # Runjags options - # Disable redundant warnings - try( runjags::runjags.options( inits.warning=FALSE , rng.warning=FALSE ) ) - # Set runjags method and number of chains - if (!length(jags.method)) { - detect.cores <- parallel::detectCores() - jags.method <- if ( !is.finite(detect.cores || detect.cores < 4) ) "simple" else "parallel" - } - if (!length(jags.chains)) { - jags.chains <- if ( detect.cores >= 4 ) 4 else detect.cores - } - + # Number of samples n.samples <- ceiling(saved.steps / jags.chains) @@ -153,8 +140,13 @@ RunMCMC <- function(jags.model, data.MCMC <- merge.MCMC } + # Clean up working memory + RemoveGarbage("jags.data") + # Treat results as matrix for further examination matrix.MCMC <- as.matrix(data.MCMC) + # Sort matrix by column names + if (ncol(matrix.MCMC)>1) matrix.MCMC <- matrix.MCMC[, order(colnames(matrix.MCMC))] # Append bracket (ie., [1] ) for naming purposes colnames(matrix.MCMC) <- unlist(lapply(colnames(matrix.MCMC), function (x) if(regexpr('\\[', x)[1]<0) paste0(x,"[1]") else x )) @@ -163,12 +155,19 @@ RunMCMC <- function(jags.model, # Diagnostics if (run.diag) { cat("\nConducting diagnostics. Please wait.\n") + diag.start.time <- Sys.time() - diag.length <- length(coda::varnames(data.MCMC)) + if (length(param.diag)) { + param.diag <- grep(paste(TrimSplit(param.diag),collapse="|"), + coda::varnames(data.MCMC), value = TRUE) + } else { + param.diag <- coda::varnames(data.MCMC) + } + diag.length <- length(param.diag) diag.plots <- lapply(1:diag.length, function(i) { - x <- coda::varnames(data.MCMC)[i] - + x <- param.diag[i] + if (stats::sd(matrix.MCMC[,x]) > 0) { diag <- DiagMCMC(data.MCMC = data.MCMC, par.name = x, @@ -183,20 +182,18 @@ RunMCMC <- function(jags.model, ETA(diag.start.time , i , diag.length) return (diag) - + } ) - + # Adding names to diagnostics - names(diag.plots) <- coda::varnames(data.MCMC) + names(diag.plots) <- param.diag if (save.data) { cat("\nAdjusting and saving diagnostic plots. Please wait.\n") - diag.plots <- diag.plots[lapply(diag.plots,length)>1] - # Save plots as PowerPoint, Default is raster graphics. ## Change vector.graphic to TRUE if needed (not recommended) - ParsePlot(diag.plots, + ParsePlot(diag.plots[lapply(diag.plots,length)>1], project.dir = paste0(project.dir,"Diagnostics/"), project.name = project.name, graphic.type = graphic.type, @@ -218,43 +215,57 @@ RunMCMC <- function(jags.model, cat("\nComputing contrasts. Please wait.\n") - # Createsum to zero contrasts for mettric and nominal models + # Createsum to zero contrasts for metric and nominal models if (model.type == "Metric" | model.type == "Nominal") { sum.zero <- SumToZero(q.levels, matrix.MCMC, contrasts) - matrix.MCMC <- cbind(matrix.MCMC, sum.zero) } # Add odds (and odds-ratios/cohen's d) for nominal models if (model.type == "Nominal") { - + + # Create expected and observed nominal and proportions data + expected.observed <- MatrixCombn(matrix.MCMC, + "o,o,e,e", + "NULL,p,NULL,p", + q.levels, + rm.last = FALSE, + row.means=FALSE) + + # Remove expected and observed columns from MCMC matrix + matrix.MCMC <- matrix.MCMC[ , !colnames(matrix.MCMC) %in% colnames(expected.observed)] + contrast.type <- c("b","o") - # Create matrix combiantions for models with multiple factors - if (length(q.levels)>1) { - odds <- MatrixCombn(matrix.MCMC, "o", lvl = q.levels, row.means=FALSE) - expected.observed <- MatrixCombn(matrix.MCMC, "e,o", "p", q.levels, row.means=FALSE) - matrix.MCMC <- cbind(matrix.MCMC, cbind(odds, expected.observed)) - } + contrast.data <- list(sum.zero, expected.observed) + } + # Add effect size cohen's d for metric model if (model.type == "Metric") { + + # Create mean difference data + mean.diff <- MatrixCombn(matrix.MCMC, "m,s", q.levels = q.levels, rm.last = FALSE) + + # Remove mean difference columns from MCMC matrix + matrix.MCMC <- matrix.MCMC[ , !colnames(matrix.MCMC) %in% colnames(mean.diff)] + contrast.type <- c("b","m") - # Create matrix combiantions for models with multiple factors - if (length(q.levels)>1) { - mean.diff <- MatrixCombn(matrix.MCMC, "m,s", lvl = q.levels) - matrix.MCMC <- cbind(matrix.MCMC, mean.diff) - } + contrast.data <- list(sum.zero, mean.diff) } - - # Run contrasts and add contrasts to data matrix - done.contrasts <- do.call(cbind, lapply(contrast.type, function (x) { - RunContrasts(x , q.levels , use.contrast , contrasts , matrix.MCMC , job.names) + + # Run contrasts + contrasts <- do.call(cbind, lapply(1:length(contrast.type), function (i) { + RunContrasts(contrast.type[[i]], + q.levels, + use.contrast, + contrasts, + contrast.data[[i]], + job.names) })) - matrix.MCMC <- cbind(matrix.MCMC, done.contrasts) } # Add R^2 if regression if (model.type == "Regression") { - + x <- data.list$x n.x <- data.list$n.x y <- data.list$y @@ -276,19 +287,15 @@ RunMCMC <- function(jags.model, adjusted.rob.r <- as.matrix(1 - (1-rob.r.squared) * ( (n-1) / (n -(q+1)) )) # Add names - colnames(r.squared) <- sprintf("R^2 (block: %s)",i) - colnames(rob.r.squared) <- sprintf("Robust R^2 (block: %s)",i) - colnames(adjusted.r) <- sprintf("Adjusted R^2 (block: %s)",i) - colnames(adjusted.rob.r) <- sprintf("Adjusted Robust R^2 (block: %s)",i) - + colnames(r.squared) <- if (q>1) sprintf("R^2 (block: %s)",i) else "R^2" + colnames(rob.r.squared) <- if (q>1) sprintf("Robust R^2 (block: %s)",i) else "Robust R^2" + colnames(adjusted.r) <- if (q>1) sprintf("Adjusted R^2 (block: %s)",i) else "Adjusted R^2" + colnames(adjusted.rob.r) <- if (q>1) sprintf("Adjusted Robust R^2 (block: %s)",i) else "Adjusted Robust R^2" + # Return as matrix cbind(r.squared , rob.r.squared , adjusted.r , adjusted.rob.r) })) - - # Add R^2 to MCMC matrix - matrix.MCMC <- cbind(matrix.MCMC, r.squared) - } # Add PPP if SEM/CFA @@ -299,12 +306,14 @@ RunMCMC <- function(jags.model, n <- data.list$n ppp.start.time <- Sys.time() - cov.mat <- stats::cov(y) pppv <- 0 + jags.ppp <- sample(1:nrow(matrix.MCMC), nrow(matrix.MCMC)/k.ppp) + + cov.mat <- stats::cov(y) cat("\nComputing PPP-value, please wait (it may take some time).\n") - PPP <- lapply(1:nrow(matrix.MCMC), function (i) { + PPP <- lapply(1:length(jags.ppp), function (i) { - x <- matrix.MCMC[i,] + x <- matrix.MCMC[jags.ppp[i],] # Epsilon/Error variance matrix eps.pos <- grep("error", names(x)) eps.length <- length(eps.pos) @@ -318,12 +327,12 @@ RunMCMC <- function(jags.model, lam.pos <- grep("lam", names(x)) lam.length <- length(lam.pos) - lambda <- do.call( rbind, lapply(1:lam.length, function (i) c(factor.seq[i], x[lam.pos][i]) ) ) - lam.matrix <- matrix( unlist ( lapply(1:lat, function (i) { - if (i < max(lat)) { - c ( lambda[ lambda[,1] == i , 2], rep(0,lam.length) ) + lambda <- do.call( rbind, lapply(1:lam.length, function (j) c(factor.seq[j], x[lam.pos][j]) ) ) + lam.matrix <- matrix( unlist ( lapply(1:lat, function (j) { + if (j < max(lat)) { + c ( lambda[ lambda[,1] == j , 2], rep(0,lam.length) ) } else { - lambda[ lambda[,1] == i , 2] + lambda[ lambda[,1] == j , 2] } } ) ), lam.length, lat) @@ -340,11 +349,11 @@ RunMCMC <- function(jags.model, sim.fit <- (n - 1) * (log(det(pred.sigma)) + sum(diag(solve(pred.sigma) %*% sim.sigma)) - log(det(sim.sigma)) - eps.length) # Compute PPP-value - if (pred.fit <= sim.fit) pppv <<- pppv + 1 + pppv <<- if (pred.fit < sim.fit) pppv + 1 else if (pred.fit == sim.fit) pppv + 0.5 else pppv PPP <- as.numeric(pppv / i) - ETA(ppp.start.time , i , nrow(matrix.MCMC)) - + ETA(ppp.start.time , i , length(jags.ppp)) + # Create matrix with chi-square, discrepancy between predicted and simulated data and PPP PPP <- as.data.frame(t( c("Fit (Predicted)" = pred.fit, @@ -358,44 +367,63 @@ RunMCMC <- function(jags.model, } ) if (requireNamespace("plyr", quietly = TRUE)) { - matrix.MCMC <- cbind(matrix.MCMC, plyr::rbind.fill(PPP)) + PPP <- plyr::rbind.fill(PPP) } else { - matrix.MCMC <- cbind(matrix.MCMC, do.call(rbind,PPP)) + PPP <- do.call(rbind,PPP) } } - # Find params from MCMC list - params <- colnames(matrix.MCMC) + # create list of matrices to summarize + list.MCMC <- list( + matrix = matrix.MCMC, + PPP = if (exists("PPP")) PPP, + r.squared = if (exists("r.squared")) r.squared, + sum.zero = if (exists("sum.zero")) sum.zero, + count.data = if (exists("expected.observed")) expected.observed, + mean.difference = if (exists("mean.diff")) mean.diff, + contrasts = if (exists("contrasts")) contrasts + ) + + # Remove empty plots + list.MCMC <- Filter(length, list.MCMC) - # Create final posterior parameter indicies - summary.start.time <- Sys.time() - cat("\nSummarizing data of each parameter. Please wait.\n") - summary.MCMC <- do.call(rbind,lapply(1:length(params), function(i) { + summary.MCMC <- do.call(rbind,lapply(1:length(list.MCMC), function (k) { - summary <- SumMCMC( par = matrix.MCMC[, params[i]] , - par.names = params[i], - job.names = job.names, - job.group = job.group, - n.data = n.data, - credible.region = credible.region, - ROPE = ROPE - ) + # Find params from MCMC list + params <- colnames(list.MCMC[[k]]) - ETA(summary.start.time , i , length(params)) - - return (summary) + # Create final posterior parameter indicies + summary.start.time <- Sys.time() + summary.cat <- sprintf("\nSummarizing data for each parameter in %s. Please wait.\n" , + gsub("\\."," ",names(list.MCMC)[[k]]) ) + cat(summary.cat) + do.call(rbind,lapply(1:length(params), function(i) { - } ) ) - + summary <- SumMCMC( par = list.MCMC[[k]][, params[i]] , + par.names = params[i], + job.names = job.names, + job.group = job.group, + n.data = n.data, + credible.region = credible.region, + ROPE = ROPE + ) + + ETA(summary.start.time , i , length(params)) + + return (summary) + + })) + })) + # Display completion and running time stop.time <- Sys.time() total.time <- capture.output(difftime(stop.time, start.time)) cat(format(stop.time,"\nCompleted at %d.%m.%Y - %H:%M:%S\n"), gsub("Time difference of","Running time:",total.time),"\n", sep="") - + # Create MCMC and summary list (without chain information) final.MCMC <- list( raw.MCMC = data.MCMC, - matrix.MCMC = matrix.MCMC, + matrix.MCMC = do.call(cbind,list.MCMC), summary.MCMC = summary.MCMC, name.list = name.list, initial.list = initial.list, @@ -418,11 +446,27 @@ RunMCMC <- function(jags.model, MCMC.file.name <- paste0(project.dir,"MCMC/",project.name,".rds") saveRDS( final.MCMC , file = MCMC.file.name, compress="bzip2") + # Create meta data + meta.final.MCMC <- list(summary.MCMC = summary.MCMC, + name.list = name.list, + initial.list = initial.list, + data.list = data.list, + jags.model = jags.model, + run.time = c(start.time,stop.time) + ) + + # Save meta data + MCMC.file.name <- sub('-', '-META-', MCMC.file.name) + saveRDS( meta.final.MCMC , file = MCMC.file.name, compress="bzip2") + # Append to final MCMC list final.MCMC <- c(final.MCMC, data.file.name = data.file.name, MCMC.file.name = MCMC.file.name) } - + + # Clear up working memory + RemoveGarbage("data.MCMC,list.MCMC") + return (final.MCMC) } diff --git a/R/mcmc_misc.R b/R/mcmc_misc.R index f65bf2a..f9bcaa6 100644 --- a/R/mcmc_misc.R +++ b/R/mcmc_misc.R @@ -124,39 +124,45 @@ ContrastNames <- function(items , job.names , col.names) { #' @title Matrix Combinations #' @description Create matrices from combinations of columns -#' @param m matrix to combine -#' @param s stem first name of columns to use (e.g., "m" for mean) -#' @param p stem last name of columns to use (e.g., "p" for proportions) -#' @param lvl number of levels per column +#' @param matrix matrix to combine +#' @param first.stem first name of columns to use (e.g., "m" for mean) +#' @param last.stem optional last name of columns to use (e.g., "p" for proportions) , Default: NONE +#' @param q.levels number of levels per column #' @param rm.last logical, indicating whether or not to remove last combination (i.e., m1m2m3m4) , Default: TRUE #' @param row.means logical, indicating whether or not to compute row means from combined columns, else use row sums, Default: TRUE #' @rdname MatrixCombn #' @export -MatrixCombn <- function(m , s, p = NULL, lvl, rm.last=TRUE, row.means=TRUE) { - s <- TrimSplit(s) - grid <- expand.grid(lapply(lvl, function (x) seq(x))) +MatrixCombn <- function(matrix , first.stem, last.stem = NULL, q.levels, rm.last=TRUE, row.means=TRUE) { + first.stem <- TrimSplit(first.stem) + last.stem <- TrimSplit(last.stem) + grid <- expand.grid(lapply(q.levels, function (x) seq(x))) q <- ncol(grid) matrix.list <- lapply(seq(q-as.numeric(rm.last)), function (i) { q.combn <- t(combn(as.numeric(paste0(seq(q))),i)) q.combn <- split(q.combn, 1:nrow(q.combn)) lapply(q.combn, function (x) { - cols <- expand.grid(lapply(x, function (j) seq(lvl[[j]] ) ) ) + cols <- expand.grid(lapply(x, function (j) seq(q.levels[[j]] ) ) ) colnames(cols) <- c(x) lapply(1:nrow(cols), function (k) { col <- paste(sprintf("grid[,%s]==%s",colnames(cols),cols[k,]),collapse="&") - lapply(s, function (y) { + lapply(1:length(first.stem), function (l) { - s <- paste0(paste0(y,seq(q),collapse=""),p) - s.names <- colnames(m[, grep(paste0("\\b",s,"\\b"),colnames(m))]) + if (length(last.stem) >= l) { + last.stem <- if (tolower(last.stem[[l]]) != "null") last.stem[[l]] + } else { + last.stem <- NULL + } + new.stem <- paste0( paste0(first.stem[[l]], seq(q), collapse=""), last.stem ) + s.names <- colnames(matrix[, grep(paste0("\\b", new.stem, "\\b"), colnames(matrix))]) - new.col <- as.matrix(m[,s.names[eval(parse(text=paste0(col)))]]) + new.col <- as.matrix(matrix[,s.names[eval(parse(text=paste0(col)))]]) if (ncol(new.col)>1) { new.col <- if (row.means) rowMeans(new.col) else rowSums(new.col) } new.col <- as.matrix(new.col) - new.colname <- paste0(paste0(y,colnames(cols),collapse=""),p) + new.colname <- paste0(paste0(first.stem[[l]],colnames(cols),collapse=""),last.stem) new.colname <- sprintf("%s[%s]",new.colname,paste(cols[k,],collapse=",")) colnames(new.col) <- new.colname diff --git a/R/mcmc_summary.R b/R/mcmc_summary.R index 551916f..9f89153 100644 --- a/R/mcmc_summary.R +++ b/R/mcmc_summary.R @@ -19,7 +19,7 @@ SumMCMC <- function(par, job.names = NULL, job.group = NULL, credible.region = 0.95, - ROPE, + ROPE = NULL, n.data, ... ) { diff --git a/R/plot_circlize.R b/R/plot_circlize.R index 04cea27..d6250de 100644 --- a/R/plot_circlize.R +++ b/R/plot_circlize.R @@ -1,7 +1,6 @@ #' @title Circlize Plot #' @description Create a circlize plot -#' @param category.items named items for circlize plot -#' @param category.selects selected data for ciclize plot +#' @param data data for circlize plot #' @param category.spacing spacing between category items , Default: 1.25 #' @param category.inset inset of category items form plot , Default: c(-0.5, 0) #' @param monochrome logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE @@ -20,14 +19,14 @@ #' @importFrom grDevices dev.new recordPlot dev.off #' @importFrom graphics legend -PlotCirclize <- function (category.items, - category.selects, +PlotCirclize <- function (data, category.spacing = 1.2, category.inset = c(-0.4, 0), monochrome = TRUE, plot.colors = c("#CCCCCC", "#DEDEDE"), font.type = "serif") { - + + # Check if circlize is installed if (!requireNamespace("circlize", quietly = TRUE)) { @@ -35,6 +34,14 @@ PlotCirclize <- function (category.items, call. = FALSE) } + # Clear circlize + circlize::circos.clear() + + # Fetch category, items and selects + category <- data$category + category.items <- data$category.items + category.selects <- data$category.selects + # Set 0 as missing category.selects[category.selects == 0] <- NA # Remove missing @@ -111,7 +118,7 @@ PlotCirclize <- function (category.items, # Legend title legend.title <- list( bquote( - bold(.(sprintf("%s (%s)", category.items, nrow(category.selects)))) + bold(.(sprintf("%s (%s)", category, nrow(category.selects)))) ) ) diff --git a/R/plot_mean.R b/R/plot_mean.R index 64f5344..1d1e68d 100644 --- a/R/plot_mean.R +++ b/R/plot_mean.R @@ -10,6 +10,7 @@ #' @param ribbon.plot logical, indicating whether or not to use ribbon plot for HDI, Default: TRUE #' @param y.text label on y axis, Default: 'Score' #' @param x.text label on x axis, Default: NULL +#' @param remove.x logical, indicating whether or not to show x.axis information, Default: FALSE #' @seealso #' \code{\link[ggplot2]{ggproto}}, #' \code{\link[ggplot2]{ggplot2-ggproto}}, @@ -49,7 +50,8 @@ PlotMean <- function (data, y.split = FALSE , ribbon.plot = TRUE, y.text = "Score", - x.text = NULL) { + x.text = NULL, + remove.x = FALSE) { # Check if ggplots is installed if (!requireNamespace("ggplot2", quietly = TRUE) | @@ -200,7 +202,7 @@ PlotMean <- function (data, # Lists of variables to plot plot.variables <- lapply(1:max(plot.sequence), function (i) matrix(which(plot.sequence %in% i) ) ) # Create data frame with group indices and Bayesian statistics - plot.data <- plyr::rbind.fill(lapply(1:q, function (i) { + plot.data <- do.call(rbind,lapply(1:q, function (i) { x.names <- if (!i %in% y.position) x.names[x.groups[i]] else NA sub.names <- if (!i %in% y.position) sub.names[(repeated.position-1)[i]] else NA @@ -272,19 +274,19 @@ PlotMean <- function (data, if ( (run.split & !y.split & !run.repeated) | !run.repeated ) job.names <- y.names if (run.repeated & run.split) { - plotTitle <- paste(job.title, "by", x.names) + plot.title <- paste(job.title, "by", x.names) label.groups <- y.names } else if (all(is.na(sub.names))) { - plotTitle <- job.title + plot.title <- job.title label.groups <- unique(y.names) } else if (all(sub.names[1] == sub.names) & run.repeated) { - plotTitle <- sprintf("%s by %s [%s]",job.title,x.names,sub.names) + plot.title <- sprintf("%s by %s [%s]",job.title,x.names,sub.names) label.groups <- unique(y.names) } else if (all(sub.names[1] == sub.names)) { - plotTitle <- sprintf("%s [%s]", x.names,sub.names) + plot.title <- sprintf("%s [%s]", x.names,sub.names) label.groups <- unique(y.names) } else { - plotTitle <- paste(job.names, "by", x.names) + plot.title <- paste(job.names, "by", x.names) label.groups <- unique(sub.names) } @@ -411,7 +413,7 @@ PlotMean <- function (data, {if (run.split) geom_errorbar(aes(x=x.pos2, ymin = sd.lower.mode2, ymax = sd.lower.mode2), lwd=0.05, width = 0.1)}+ {if (!run.split | run.repeated & run.split) scale_x_discrete(labels=x.ticks)}+ scale_fill_manual(labels = label.groups , values = plot.colors)+ - ggplot2::labs(title=plotTitle ,x=x.text, y = y.text)+ + ggplot2::labs(title = plot.title , x = x.text, y = y.text)+ theme(legend.position="top", legend.key.size = grid::unit(0.75, 'lines'), legend.key = element_rect(size = 1), @@ -424,7 +426,7 @@ PlotMean <- function (data, panel.grid.major.y = element_line( size=.01, color="lightgrey"), axis.title.x=element_blank())+ {if (!run.split) theme(legend.position = "none")}+ - {if (run.split & !run.repeated) theme(axis.text.x=element_blank(), + {if (run.split & !run.repeated | remove.x) theme(axis.text.x=element_blank(), axis.ticks.x=element_blank())} ) diff --git a/R/plot_param.R b/R/plot_param.R new file mode 100644 index 0000000..24d0349 --- /dev/null +++ b/R/plot_param.R @@ -0,0 +1,203 @@ +#' @title Plot Param +#' @description Create a density plot with parameter values +#' @param data MCMC data to plot +#' @param param parameter of interest +#' @param ROPE plot ROPE values, Default: FALSE +#' @param monochrome logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE +#' @param plot.colors range of color to use, Default: c("#495054", "#e3e8ea") +#' @param font.type font type used for visualizations, Default: 'serif' +#' @param font.size font size, Default: 4.5 +#' @param rope.line size of ROPE lien, Default: -0.2 +#' @param rope.tick distance to ROPE tick, Default: -0.1 +#' @param rope.label distance to ROPE label, Default: -0.35 +#' @param line.size overall line size, Default: 0.5 +#' @param dens.zero.col colour of line indicating zero, Default: 'black' +#' @param dens.mean.col colour of line indicating mean value, Default: 'white' +#' @param dens.median.col colour of line indicating median value, Default: 'white' +#' @param dens.mode.col colour of line indicating mode value, Default: 'black' +#' @param dens.rope.col colour of line indicating ROPE value, Default: 'black' +#' @return Density plot of parameter values +#' @seealso +#' \code{\link[magrittr]{`%>%`}} +#' \code{\link[dplyr]{mutate}},\code{\link[dplyr]{group_by}},\code{\link[dplyr]{join}},\code{\link[dplyr]{select}},\code{\link[dplyr]{slice}},\code{\link[dplyr]{filter}} +#' \code{\link[stats]{approxfun}} +#' \code{\link[ggplot2]{aes}},\code{\link[ggplot2]{margin}},\code{\link[ggplot2]{geom_density}},\code{\link[ggplot2]{geom_polygon}},\code{\link[ggplot2]{geom_segment}},\code{\link[ggplot2]{geom_label}},\code{\link[ggplot2]{ggplot}},\code{\link[ggplot2]{ggplot_build}},\code{\link[ggplot2]{scale_continuous}},\code{\link[ggplot2]{theme}},\code{\link[ggplot2]{labs}} +#' @rdname PlotParam +#' @export +#' @importFrom stats approx + +PlotParam <- function (data, + param, + ROPE = FALSE, + monochrome = TRUE, + plot.colors = c("#495054", "#e3e8ea"), + font.type = "serif", + font.size = 4.5, + rope.line = -0.2, + rope.tick = -0.1, + rope.label = -0.35, + line.size = 0.5, + dens.zero.col = "black", + dens.mean.col = "white", + dens.median.col = "white", + dens.mode.col = "black", + dens.rope.col = "black") { + + # Check if ggplots is installed + if (!requireNamespace("ggplot2", quietly = TRUE) | + !requireNamespace("magrittr", quietly = TRUE) | + !requireNamespace("dplyr", quietly = TRUE)) { + stop("Packages \"ggplot2\", \"magrittr\", and \"dplyr\" are needed for this function to work. Please install them.", + call. = FALSE) + } + + # Define import elements + `%>%` <- magrittr::`%>%` + mutate <- dplyr::mutate + group_by <- dplyr::group_by + left_join <- dplyr::left_join + select <- dplyr::select + slice <- dplyr::slice + approx <- stats::approx + filter <- dplyr::filter + aes <- ggplot2::aes + element_blank <- ggplot2::element_blank + element_line <- ggplot2::element_line + element_text <- ggplot2::element_text + geom_density <- ggplot2::geom_density + geom_polygon <- ggplot2::geom_polygon + geom_segment <- ggplot2::geom_segment + geom_text <- ggplot2::geom_text + ggplot <- ggplot2::ggplot + ggplot_build <- ggplot2::ggplot_build + scale_x_continuous <- ggplot2::scale_x_continuous + theme <- ggplot2::theme + HDIhi <- NULL + HDIlo <- NULL + Mean <- NULL + Median <- NULL + Mode <- NULL + ROPEhi <- NULL + ROPEin <- NULL + ROPElo <- NULL + ROPEmax <- NULL + ROPEmin <- NULL + dens.mean <- NULL + dens.median <- NULL + dens.mode <- NULL + dens.rope.max <- NULL + dens.rope.min <- NULL + dens.zero <- NULL + var <- NULL + x <- NULL + y <- NULL + + data.matrix <- data$matrix.MCMC + param.col <- MultiGrep(param, rownames(data$summary.MCMC), value = FALSE) + param <- TrimSplit(param)[[2]] + + raw.data <- data.frame(data.matrix[, param.col]) + colnames(raw.data) <- "var" + raw.data$param <- param + + summary <- as.data.frame(t(data$summary.MCMC[ param.col , ])) + use.cols <- c("Mean", "Median", "Mode", "HDIlo", "HDIhi", "ROPEmin", "ROPEmax", "ROPElo", "ROPEhi", "ROPEin") + summary <- summary[colnames(summary) %in% use.cols] + summary$Min <- min(raw.data$var) + summary$Max <- max(raw.data$var) + summary$param <- param + + dens.data <- suppressMessages(ggplot_build(ggplot(raw.data, aes(x=var, colour=param)) + + geom_density())$data[[1]] %>% + mutate(param = summary$param) %>% + left_join(summary) %>% + select(y, x, Mean, Median, Mode, HDIlo, HDIhi, ROPEmin, ROPEmax, ROPElo, ROPEhi, ROPEin, Max, Min, param) %>% + mutate(dens.zero = approx(x, y, xout = 0)[[2]], + dens.mean = approx(x, y, xout = Mean)[[2]], + dens.median = approx(x, y, xout = Median)[[2]], + dens.mode = approx(x, y, xout = Mode)[[2]], + dens.rope.min = approx(x, y, xout = ROPEmin)[[2]], + dens.rope.max = approx(x, y, xout = ROPEmax)[[2]]) %>% + select(-y, -x) %>% + slice(1)) + + + dens.data[is.na(dens.data)] <- dens.data$dens.mode + + # Create area for hdi in density plot + hdi.ribbon <- suppressMessages(ggplot_build(ggplot(raw.data, aes(x=var, colour=param)) + + geom_density())$data[[1]] %>% + mutate(param = summary$param) %>% + left_join(dens.data) %>% + group_by(param) %>% + filter(x >= HDIlo & x <= HDIhi) %>% + select(param, x, y)) + + # Add zero distribution to ribbon + hdi.ribbon <- rbind(data.frame(param = summary$param, x = summary$HDIlo, y = 0), + as.data.frame(hdi.ribbon), + data.frame(param = summary$param, x = summary$HDIhi, y = 0)) + + if (ROPE) { + Min <- dens.data$ROPEmin + Max <- dens.data$ROPEmax + } else { + Min <- 0 + Max <- 0 + } + + dens.data$Min <- min(dens.data$Min,Min) + dens.data$Max <- max(dens.data$Max,Max) + font.size.pts <- font.size/0.352777778 + + plot <- ggplot() + + ggplot2::labs(title = summary$param , x = "Parameter value", y = "Density")+ + scale_x_continuous(breaks = round(seq(dens.data$Min, dens.data$Max, by = 0.05),1)) + + theme(plot.title = element_text(hjust = 0.5), + panel.background = element_blank(), + panel.grid.major.y = element_line(size=.1, color="grey"), + text=element_text(family=font.type, size = font.size.pts), + legend.position="none") + + geom_density(data = raw.data, aes(x = var), fill = "grey" , alpha = .7) + + geom_polygon(data = hdi.ribbon, aes(x = x, y = y), fill = "black", alpha = .4) + + geom_segment(data = dens.data, aes(x = 0, xend = 0, y = 0, yend = dens.zero), + color = dens.zero.col , linetype = "dotted", size = line.size) + + geom_segment(data = dens.data, aes(x = Mean, xend = Mean, y = 0, yend = dens.mean), + color =dens.mean.col , linetype = "solid", size = line.size) + + geom_segment(data = dens.data, aes(x = Median, xend = Median, y = 0, yend = dens.median), + color = dens.median.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = Mode, xend = Mode, y = 0, yend = dens.mode), + color = dens.mode.col , linetype = "solid", size = line.size) + + + if (ROPE) { + + plot <- plot + geom_segment(data = dens.data, aes(x = ROPEmin, xend = ROPEmin, y = 0, yend = dens.rope.min), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = ROPEmax, xend = ROPEmax, y = 0, yend = dens.rope.max), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = Min, xend = ROPEmin, y = rope.line , yend = rope.line), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = ROPEmin, xend = ROPEmax, y = rope.line , yend = rope.line), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = ROPEmax, xend = Max, y = rope.line , yend = rope.line), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = ROPEmin, xend = ROPEmin, y = rope.line, yend = rope.tick), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = ROPEmax, xend = ROPEmax, y = rope.line, yend = rope.tick), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = Min, xend = Min, y = rope.line, yend = rope.tick), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_segment(data = dens.data, aes(x = Max, xend = Max, y = rope.line, yend = rope.tick), + colour = dens.rope.col , linetype = "dashed", size = line.size) + + geom_text(data = dens.data, aes(x = mean(c(Min, ROPEmin)), + y = rope.label, label = sprintf("%0.2f%%", ROPElo)), family = font.type , size = font.size) + + geom_text(data = dens.data, aes(x = mean(c(ROPEmin, ROPEmax)), + y = rope.label, label = sprintf("%0.2f%%", ROPEin)), family = font.type , size = font.size) + + geom_text(data = dens.data, aes(x = mean(c(ROPEmax, Max)), + y = rope.label, label = sprintf("%0.2f%%", ROPEhi)), family = font.type , size = font.size) + } + + return (plot) + +} \ No newline at end of file diff --git a/R/plot_parse.R b/R/plot_parse.R index af236e2..ff1a746 100644 --- a/R/plot_parse.R +++ b/R/plot_parse.R @@ -2,7 +2,7 @@ #' @description Display and/or save plots #' @param plot.data a list of plots #' @param project.dir define where to save data, Default: 'Results/' -#' @param project.name define name of project, Default: 'FileName(name="Plot")' +#' @param project.name define name of project, Default: 'FileName(name="Print")' #' @param save.data logical, indicating whether or not to save data, Default: FALSE #' @param graphic.type type of graphics to use (e.g., pdf, png, ps), Default: 'pdf' #' @param plot.size size of plot, Default: '15,10' @@ -363,7 +363,7 @@ ParsePlot <- function (plot.data, if (font.type == "serif") font.type <- "Times New Roman" # Select template - template <- if (layout == "pt") "legacy" else "widescreen" + template <- if (layout == "pt") "legacy" else if (layout == "apa") "apa" else "widescreen" template.file <- paste0(system.file(package = 'bfw'),"/extdata/templates/",template,".pptx") # Create PowerPoint document diff --git a/R/settings.R b/R/settings.R index a0b5576..9069193 100644 --- a/R/settings.R +++ b/R/settings.R @@ -1,17 +1,5 @@ #' @title Settings #' @description main settings for bfw -#' @param y criterion variable(s), Default: NULL -#' @param y.names optional names for criterion variable(s), Default: NULL -#' @param x predictor variable(s), Default: NULL -#' @param x.names optional names for predictor variable(s), Default: NULL -#' @param latent latent variables, Default: NULL -#' @param latent.names optional names for for latent variables, Default: NULL -#' @param observed observed variable(s), Default: NULL -#' @param observed.names optional names for for observed variable(s), Default: NULL -#' @param additional supplemental parameters for fitted data (e.g., indirect pathways and total effect), Default: NULL -#' @param additional.names optional names for supplemental parameters, Default: NULL -#' @param x.steps define number of steps in hierarchical regression , Default: NULL -#' @param x.blocks define which predictors are included in each step (e.g., for three steps "1,2,3") , Default: NULL #' @param job.title title of analysis, Default: NULL #' @param job.group for some hierarchical models with several layers of parameter names (e.g., latent and observed parameters), Default: NULL #' @param jags.model specify which module to use @@ -25,12 +13,6 @@ #' @param thinned.steps save every kth step of the original saved.steps, Default: 1 #' @param adapt.steps the number of adaptive iterations to use at the start of each simulation, Default: NULL #' @param burnin.steps the number of burnin iterations, NOT including the adaptive iterations to use for the simulation, Default: NULL -#' @param credible.region summarize uncertainty by defining a region of most credible values (e.g., 95 percent of the distribution), Default: 0.95 -#' @param ROPE define range for region of practical equivalence (e.g., c(-0.05 , 0.05), Default: NULL -#' @param run.contrasts logical, indicating whether or not to run contrasts, Default: FALSE -#' @param use.contrast choose from "between", "within" and "mixed". Between compare groups at different conditions. Within compare a group at different conditions. Mixed compute all comparisons -#' @param contrasts define contrasts to use for analysis (defaults to all) , Default: NULL -#' @param run.ppp logical, indicating whether or not to conduct ppp analysis, Default: FALSE #' @param initial.list initial values for analysis, Default: list() #' @param project.name name of project, Default: 'Project' #' @param project.dir define where to save data, Default: 'Results/' @@ -44,21 +26,7 @@ #' @param merge.MCMC logical, indicating whether or not to merge MCMC chains, Default: FALSE #' @param run.diag logical, indicating whether or not to run diagnostics, Default: FALSE #' @param sep symbol to separate data (e.g., comma-delimited), Default: ',' -#' @param monochrome logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE -#' @param plot.colors range of color to use, Default: c("#495054", "#e3e8ea") -#' @param graphic.type type of graphics to use (e.g., pdf, png, ps), Default: 'pdf' -#' @param plot.size size of plot, Default: '15,10' -#' @param scaling scale size of plot, Default: 100 -#' @param plot.aspect aspect of plot, Default: NULL -#' @param vector.graphic logical, indicating whether or not visualizations should be vector or raster graphics, Default: FALSE -#' @param point.size point size used for visualizations, Default: 12 -#' @param font.type font type used for visualizations, Default: 'serif' -#' @param one.file logical, indicating whether or not visualizations should be placed in one or several files, Default: TRUE -#' @param ppi define pixel per inch used for visualizations, Default: 300 -#' @param units define unit of length used for visualizations, Default: 'in' -#' @param layout define a layout size for visualizations, Default: 'a4' -#' @param layout.inverse logical, indicating whether or not to inverse layout (e.g., landscape) , Default: FALSE -#' @param silent logical, indicating whether or not analysis should be run silent, Default: FALSE +#' @param silent logical, indicating whether or not to run analysis without output, Default: FALSE #' @param ... further arguments passed to or from other methods #' @return data from MCMC \link[bfw]{RunMCMC} #' @details Settings act like the main framework for bfw, connecting function, model and JAGS. @@ -67,19 +35,7 @@ #' @rdname bfw #' @export #' @importFrom utils tail modifyList capture.output -bfw <- function(y = NULL, - y.names = NULL, - x = NULL, - x.names = NULL, - latent = NULL, - latent.names = NULL, - observed = NULL, - observed.names = NULL, - additional = NULL, - additional.names = NULL, - x.steps = NULL, - x.blocks = NULL, - job.title = NULL, +bfw <- function(job.title = NULL, job.group = NULL, jags.model, jags.seed = NULL, @@ -92,12 +48,6 @@ bfw <- function(y = NULL, thinned.steps = 1, adapt.steps = NULL, burnin.steps = NULL, - credible.region = 0.95, - ROPE = NULL, - run.contrasts = FALSE, - use.contrast = "between", - contrasts = NULL, - run.ppp = FALSE, initial.list = list(), project.name = "Project", project.dir = "Results/", @@ -111,20 +61,6 @@ bfw <- function(y = NULL, merge.MCMC = FALSE, run.diag = FALSE, sep = ",", - monochrome = TRUE, - plot.colors = c("#495054", "#e3e8ea"), - graphic.type = "pdf", - plot.size = "15,10", - scaling = 100, - plot.aspect = NULL, - vector.graphic = FALSE, - point.size = 12, - font.type = "serif", - one.file = TRUE, - ppi = 300, - units = "in", - layout = "a4", - layout.inverse = FALSE, silent = FALSE, ... ) { @@ -195,6 +131,7 @@ bfw <- function(y = NULL, # Select model function stats.model <- eval(parse(text=paste0("Stats",model.type))) } + # If custom jags model if (length(custom.model)) { model.name <- paste0("Custom JAGS model") @@ -220,12 +157,14 @@ bfw <- function(y = NULL, # Get arguments from model function model.arguments <- TrimSplit(names(formals(stats.model))) - # Create argument list - model.arguments <- paste0(paste(model.arguments, - model.arguments,sep="="), - collapse=",") + + # Create argument list not defined by user + model.arguments <- paste0(unlist(lapply(model.arguments, function (arg) { + if (exists(arg) & arg != "...") sprintf("%s = %s", arg , arg) + })), collapse = ",") + # Create data list from model from specified argument list - stats.model <- eval(parse(text=sprintf("stats.model(%s)" , model.arguments))) + stats.model <- eval(parse(text=sprintf("stats.model(%s , ...)" , model.arguments))) # assign attributes from stats.model for (i in 1:length(stats.model)){ @@ -236,10 +175,33 @@ bfw <- function(y = NULL, if (is.null(jags.seed)) jags.seed <- sample(1:10^6,1) # Create save name + if (run.robust) { + job.title <- if (is.null(job.title)) "Robust" else paste0(job.title,"-Robust") + } project.name <- FileName( project.name , data.set , model.type , job.title , time.stamp) # Tidy up JAGS model jags.model <- TidyCode(jags.model) + + # Number of adapting steps + if (!length(adapt.steps)) adapt.steps <- max ( (saved.steps * 5) / 100 , 2000 ) + + # Number of burn-in steps + if (!length(burnin.steps)) burnin.steps <- max ( (saved.steps * 7.5) / 100 , 3000 ) + + # Runjags options + + # Disable redundant warnings + try( runjags::runjags.options( inits.warning=FALSE , rng.warning=FALSE ) ) + + # Set runjags method and number of chains + if (!length(jags.method)) { + detect.cores <- parallel::detectCores() + jags.method <- if ( !is.finite(detect.cores || detect.cores < 4) ) "simple" else "parallel" + } + if (!length(jags.chains)) { + jags.chains <- if ( detect.cores >= 4 ) 4 else detect.cores + } # Create name list tmp.list <- list( @@ -277,31 +239,12 @@ bfw <- function(y = NULL, initial.list = initial.list, saved.steps = saved.steps, thinned.steps = thinned.steps, - run.contrasts = run.contrasts, - use.contrast = use.contrast, - contrasts = contrasts, - run.ppp = run.ppp, n.data = n.data, - credible.region = credible.region, - ROPE = ROPE, merge.MCMC = merge.MCMC, run.diag = run.diag, sep = sep, - monochrome = monochrome, - plot.colors = plot.colors, - graphic.type = graphic.type, - plot.size = plot.size, - scaling = scaling, - plot.aspect = plot.aspect, save.data = save.data, - vector.graphic = vector.graphic, - point.size = point.size, - font.type = font.type, - one.file = one.file, - ppi = 300, - units = units, - layout = layout, - layout.inverse = layout.inverse) + ...) # Run MCMC if (silent) { diff --git a/R/stats_bernoulli.R b/R/stats_bernoulli.R index 9f4d581..75fb7af 100644 --- a/R/stats_bernoulli.R +++ b/R/stats_bernoulli.R @@ -68,11 +68,11 @@ #' @rdname StatsBernoulli #' @export #' @importFrom stats complete.cases -StatsBernoulli <- function(x, - x.names, +StatsBernoulli <- function(x = NULL, + x.names = NULL, DF, - params, - initial.list, + params = NULL, + initial.list = list(), ... ) { diff --git a/R/stats_covariate.R b/R/stats_covariate.R index 65f2853..52224db 100644 --- a/R/stats_covariate.R +++ b/R/stats_covariate.R @@ -6,6 +6,7 @@ #' @param x.names optional names for predictor variable(s), Default: NULL #' @param DF data to analyze #' @param params define parameters to observe, Default: NULL +#' @param job.group for some hierarchical models with several layers of parameter names (e.g., latent and observed parameters), Default: NULL #' @param initial.list initial values for analysis, Default: list() #' @param jags.model specify which module to use #' @param ... further arguments passed to or from other methods @@ -105,13 +106,14 @@ #' @rdname StatsCovariate #' @export #' @importFrom stats complete.cases -StatsCovariate <- function(y, - y.names, - x, - x.names, +StatsCovariate <- function(y = NULL, + y.names = NULL, + x = NULL, + x.names = NULL, DF, - params, - initial.list, + params = NULL, + job.group = NULL, + initial.list = list(), jags.model, ... ) { @@ -181,22 +183,16 @@ StatsCovariate <- function(y, if (length(x)) { n.data <- data.frame(do.call(rbind,lapply(y.names, function (z) { m <- expand.grid(z,x.names) - data.frame(m,n) + data.frame(m,n, stringsAsFactors = FALSE) }))) } else { # Create n data for y variables - n.data <- data.frame(t(combn(job.names, 2)),n) + n.data <- data.frame(t(combn(job.names, 2)),n, stringsAsFactors = FALSE) } - + # Paramter(s) of interest params <- if(length(params)) TrimSplit(params) else c("cor") - - # Add Cronbach's alpha if requested - if ("Alpha" %in% params) { - alpha <- "Alpha <- q / (q - 1) * (1 - sum(diag[]) / (sum(cov)))" - jags.model <- gsub("\\#ALPHA", alpha , jags.model) - } - + # Create data for Jags data.list <- list( n = n, @@ -206,8 +202,25 @@ StatsCovariate <- function(y, m2 = m2 ) + # Define name group + if (is.null(job.group)) job.group <- list ( c("cov","cor") , c("Alpha") ) + + # Add Cronbach's alpha if requested + if ("Alpha" %in% params) { + alpha <- "Alpha <- q / (q - 1) * (1 - sum(diag[]) / (sum(cov)))" + jags.model <- gsub("\\#ALPHA", alpha , jags.model) + job.names <- list(list(job.names) , list("Tau-equivalent reliability")) + alpha.n <- c( rep("Alpha" , ncol(n.data)-1) , + mean(n.data[ , ncol(n.data)]) ) + n.data <- rbind(n.data , alpha.n) + } + + # Make certain n column in n.data is numeric + n.data$n <- as.numeric(n.data$n) + # Create name list name.list <- list( + job.group = job.group, job.names = job.names ) diff --git a/R/stats_fit.R b/R/stats_fit.R index 3030b37..9ef5999 100644 --- a/R/stats_fit.R +++ b/R/stats_fit.R @@ -1,6 +1,6 @@ #' @title Fit Data #' @description Apply latent or observed models to fit data (e.g., SEM, CFA, mediation) -#' @param latent laten variables, Default: NULL +#' @param latent latenr variables, Default: NULL #' @param latent.names optional names for for latent variables, Default: NULL #' @param observed observed variable(s), Default: NULL #' @param observed.names optional names for for observed variable(s), Default: NULL @@ -21,21 +21,21 @@ #' @rdname StatsFit #' @export #' @importFrom stats complete.cases -StatsFit <- function(latent, - latent.names, - observed, - observed.names, - additional, - additional.names, +StatsFit <- function(latent = NULL, + latent.names = NULL, + observed = NULL, + observed.names = NULL, + additional = NULL, + additional.names = NULL, DF, - params, - job.group, - initial.list, + params = NULL, + job.group = NULL, + initial.list = list(), model.name, jags.model, - custom.model, - run.ppp, - run.robust, + custom.model = NULL, + run.ppp = FALSE, + run.robust = FALSE, ... ) { @@ -75,6 +75,9 @@ StatsFit <- function(latent, # Number of observed variables lat <- length(name.stems) + # Latent variable permutations + m <- t(combn(1:lat, 2)) + # Select appropriate model if (!length(custom.model)) jags.model <- ReadFile( model.name , data.format = "txt" ) @@ -162,7 +165,7 @@ StatsFit <- function(latent, params <- TrimSplit(params) } else { lambda <- if(length(observed)) c("lam", "error") else NULL - params <- if (run.ppp) c( lambda , "cov") else c( lambda , "beta", "zbeta") + params <- if (run.ppp) c( lambda , "cov" , "cor") else c( lambda , "beta", "zbeta") } # Create data for Jags @@ -177,7 +180,7 @@ StatsFit <- function(latent, fl = fl) if (run.ppp) { - data.list <- c(data.list, list(psi.prec = psi.prec)) + data.list <- c(data.list, list(psi.prec = psi.prec , m = m)) } else { data.list <- c(data.list, list(b.priors = b.priors)) } @@ -190,7 +193,7 @@ StatsFit <- function(latent, } # Define name group - if (is.null(job.group)) job.group <- list ( c("lam","error") , c("cov","beta","zbeta") ) + if (is.null(job.group)) job.group <- list ( c("lam","error") , c("cov","cor","beta","zbeta") ) # Add observed names if present if(length(observed.names)) { @@ -233,6 +236,7 @@ StatsFit <- function(latent, name.list = name.list, params = params, jags.model = jags.model, + run.ppp = run.ppp, n.data = as.matrix(n) )) } \ No newline at end of file diff --git a/R/stats_kappa.R b/R/stats_kappa.R index 6835b81..954e84a 100644 --- a/R/stats_kappa.R +++ b/R/stats_kappa.R @@ -35,11 +35,11 @@ #' @rdname StatsKappa #' @export #' @importFrom stats complete.cases -StatsKappa <- function(x, - x.names, +StatsKappa <- function(x = NULL, + x.names = NULL, DF, - params, - initial.list, + params = NULL, + initial.list = list(), ... ) { @@ -47,10 +47,7 @@ StatsKappa <- function(x, x <- TrimSplit(x) # Exclude noncomplete observations - DF <- DF[stats::complete.cases(DF[, x]), ] - - # If data is binary ( ones and zeros ) add one - if (any(DF == 0)) DF <- DF + 1 + DF <- DF[stats::complete.cases(DF[, x]), x] # Create crosstable for x parameters n.data <- as.data.frame(table(DF[, x])) @@ -75,7 +72,7 @@ StatsKappa <- function(x, # Paramter(s) of interest params <- if(length(params)) TrimSplit(params) else c("Kappa") - + # Create data for Jags data.list <- list( rater = rater, diff --git a/R/stats_mean.R b/R/stats_mean.R index e2e22e5..2f9146a 100644 --- a/R/stats_mean.R +++ b/R/stats_mean.R @@ -12,13 +12,13 @@ #' @rdname StatsMean #' @export -StatsMean <- function(y, - y.names, - x, - x.names, +StatsMean <- function(y = NULL, + y.names = NULL, + x = NULL, + x.names = NULL, DF, - params, - initial.list, + params = NULL, + initial.list = list(), ... ) { diff --git a/R/stats_metric.R b/R/stats_metric.R index c834b81..2e783ee 100644 --- a/R/stats_metric.R +++ b/R/stats_metric.R @@ -22,18 +22,18 @@ #' @rdname StatsMetric #' @export #' @importFrom stats complete.cases sd aggregate median -StatsMetric <- function(y, - y.names, - x, - x.names, +StatsMetric <- function(y = NULL, + y.names = NULL, + x = NULL, + x.names = NULL, DF, - params, - job.group, - initial.list, + params = NULL, + job.group = NULL, + initial.list = list(), model.name, jags.model, - custom.model, - run.robust, + custom.model = NULL, + run.robust = FALSE, ... ) { diff --git a/R/stats_nominal.R b/R/stats_nominal.R index fb4b2d0..c8db73e 100644 --- a/R/stats_nominal.R +++ b/R/stats_nominal.R @@ -53,15 +53,15 @@ #' @rdname StatsNominal #' @export -StatsNominal <- function(x, - x.names, +StatsNominal <- function(x = NULL, + x.names = NULL, DF, - params, - job.group, - initial.list, + params = NULL, + job.group = NULL, + initial.list = list(), model.name, jags.model, - custom.model, + custom.model = NULL, ... ) { diff --git a/R/stats_regression.R b/R/stats_regression.R index c0823b9..f946540 100644 --- a/R/stats_regression.R +++ b/R/stats_regression.R @@ -16,16 +16,16 @@ #' @rdname StatsRegression #' @export #' @importFrom stats complete.cases -StatsRegression <- function(y, - y.names, - x, - x.names, - x.steps, - x.blocks, +StatsRegression <- function(y = NULL, + y.names = NULL, + x = NULL, + x.names = NULL, + x.steps = NULL, + x.blocks = NULL, DF, - params, - job.group, - initial.list, + params = NULL, + job.group = NULL, + initial.list = list(), ... ) { @@ -41,25 +41,29 @@ StatsRegression <- function(y, # Number of datapoints n <- dim(x.matrix)[1] - # Number of blocks - if (is.null(x.blocks)) x.blocks <- 1 + # Number of steps + x.steps <- if (is.null(x.steps)) 1 else as.numeric(x.steps) # Number of variables per block - x.steps <- if (is.null(x.steps)) dim(x.matrix)[2] else as.numeric(TrimSplit(x.steps)) + x.blocks <- if (is.null(x.blocks)) dim(x.matrix)[2] else as.numeric(TrimSplit(x.blocks)) # Create job.names y.names <- if (!is.null(y.names)) TrimSplit(y.names) else CapWords(y) x.names <- if (!is.null(x.names)) TrimSplit(x.names) else CapWords(x) # Create job group - if (is.null(job.group)) job.group <- list ( c("beta0","zbeta0") , - c("beta","zbeta","sigma","zsigma") + if (is.null(job.group)) job.group <- list ( c("beta0","zbeta0","sigma","zsigma") , + c("beta","zbeta") ) # Final name list - job.names <- list(list("Intercept"), - list(rep(y.names,x.blocks), x.names) - ) + if (x.steps > 1) { + job.names <- list(list(sprintf("Intercept (block: %s)", seq(x.steps))), + list(sprintf("%s (block: %s)", y.names, seq(x.steps)), x.names) + ) + } else { + job.names <- list(list("Intercept"), list(y.names,x.names)) + } # Create crosstable for y parameters n.data <- data.frame(t(combn(job.names, 2)),n) @@ -72,8 +76,8 @@ StatsRegression <- function(y, x = x.matrix, y = y.matrix, n = n, - n.x = x.steps, - q = x.blocks) + n.x = x.blocks, + q = x.steps) # Create name list name.list <- list( diff --git a/R/stats_softmax.R b/R/stats_softmax.R index 2b89a10..74cd13e 100644 --- a/R/stats_softmax.R +++ b/R/stats_softmax.R @@ -52,15 +52,15 @@ #' @rdname StatsSoftmax #' @export #' @importFrom stats complete.cases -StatsSoftmax <- function(y, - y.names, - x, - x.names, +StatsSoftmax <- function(y = NULL, + y.names = NULL, + x = NULL, + x.names = NULL, DF, - params, - job.group, - initial.list, - run.robust, + params = NULL, + job.group = NULL, + initial.list = NULL, + run.robust = FALSE, ... ) { diff --git a/README.md b/README.md index 7a65382..7bc07a0 100644 --- a/README.md +++ b/README.md @@ -7,16 +7,16 @@ Logo II

-News +News CRAN Version -GitHub Version +GitHub Version
License Build Status

What is *bfw*? --------------- +----------------------- The purpose of *`bfw`* is to establish a framework for conducting Bayesian analysis in [R](https://www.r-project.org/), using @@ -30,9 +30,7 @@ Derived from the excellent work of Kruschke (2015), the goal of the framework is to easily estimate parameter values and the stability of estimates from the *highest density interval* (HDI), make null value assessment through *region of practical equivalence testing* (ROPE) and -conduct convergence diagnostics (e.g., Gelman & Rubin, 1992). Though the -initial version only support plotting mean data (including repeated -measures), future releases will support other types of visualizations. +conduct convergence diagnostics (e.g., Gelman & Rubin, 1992). Users are encouraged to apply justified priors by modifying existing JAGS models found in `extdata/models` or by adding custom models. @@ -45,15 +43,23 @@ List of current modules ----------------------- - Bernoulli trials -- Covariate estimations (including correlation and Cronbach's alpha) +- Covariate estimations (including correlation and Cronbach’s alpha) - Fit observed and latent data (e.g., SEM, CFA, mediation models) -- Bayesian equivalent of Cohen's kappa +- Bayesian equivalent of Cohen’s kappa - Mean and standard deviation estimations - Predict metric values (cf., ANOVA) - Predict nominal values (cf., chi-square test) - Simple, multiple and hierarchical regression - Softmax regression (i.e., multinomial logistic regression) +List of current visualizations +------------------------------ + +- Plot density of parameter values (including ROPE) +- Plot mean data (including repeated measures) +- Plot nominal data (e.g., expected and observed values) +- Plot circlize data (e.g., multiple response categories) + Prerequisites ------------- @@ -193,7 +199,7 @@ Shamelessly adapted from (credits to James Curran). # Create a function for left-censored data - custom.function <- function(DF) { + custom.function <- function(DF, ...) { x <- as.vector(unlist(DF)) x[x < log(29)] = NA @@ -260,11 +266,11 @@ The cost of conducting robust estimates # Running time for normal distribution analyis biased.mcmc$run.time[2] - biased.mcmc$run.time[1] - #> Time difference of 9.83 secs + #> Time difference of 7.43 secs # Running time for t-distribution analysis biased.mcmc.robust$run.time[2] - biased.mcmc.robust$run.time[1] - #> Time difference of 55.6 secs + #> Time difference of 34.1 secs License ------- @@ -286,8 +292,8 @@ References Simulation Using Multiple Sequences. *Statistical Science*, *7*(4), 457-472. - Kruschke, J. K. (2013). Posterior predictive checks can and should - be Bayesian: Comment on Gelman and Shalizi, 'Philosophy and the - practice of Bayesian statistics'. *British Journal of Mathematical + be Bayesian: Comment on Gelman and Shalizi, ‘Philosophy and the + practice of Bayesian statistics’. *British Journal of Mathematical and Statistical Psychology*, *66*(1), 4556. - Kruschke, J. K. (2015). *Doing Bayesian data analysis: a tutorial diff --git a/TODO.md b/TODO.md index efee1dc..b92a097 100644 --- a/TODO.md +++ b/TODO.md @@ -1,13 +1,10 @@ -# List of past and present TODO's +# TODO -## bfw 0.0.1 (Initial launch) - -- [x] Develop a more elegant system to generate models for jags -- [] Write a more detailed manual/vignettes +- [] Replace cumbersome diagnostics plot +- [] Write more detailed manual/vignettes - [] Add more visualizations (e.g., correlation and regression paths and SEM models) - [] Add ROPE for more than one parameter +- [] Develop a more elegant system to generate models for jags - -## bfw 0.0.0-1 (Pre-launch) - +# Archive - [x] Merge modules for initial launch \ No newline at end of file diff --git a/inst/doc/plot_data.md b/inst/doc/plot_mean.md similarity index 84% rename from inst/doc/plot_data.md rename to inst/doc/plot_mean.md index 7fd7a00..0d58c53 100644 --- a/inst/doc/plot_data.md +++ b/inst/doc/plot_mean.md @@ -29,13 +29,14 @@ Enjoy this brief demonstration of the plot data module #> sigma[1]: Before 1 1 1.000 49354 0.958 1.046 1000 #> sigma[2]: During 1 1 1.000 50000 0.957 1.045 1000 #> sigma[3]: After 1 1 0.997 50000 0.957 1.045 1000 - plot <- bfw::PlotData(mcmc, run.repeated = TRUE) - ParsePlot(plot) + Plot <- bfw::PlotMean(mcmc, + run.repeated = TRUE) + ParsePlot(Plot) ### Plot the data as repeated measures
-plot1
plot1
+plot1
plot1
### Lets add some noise set.seed(101) @@ -58,13 +59,14 @@ Enjoy this brief demonstration of the plot data module #> sigma[1]: Before 1.120 1.119 1.116 50000 1.072 1.170 1000 #> sigma[2]: During 1.116 1.116 1.112 50000 1.068 1.166 1000 #> sigma[3]: After 1.101 1.100 1.097 49233 1.054 1.151 1000 - plot <- bfw::PlotData(noise.mcmc, run.repeated = TRUE) - ParsePlot(plot) + Plot <- bfw::PlotMean(noise.mcmc, + run.repeated = TRUE) + ParsePlot(Plot) ### Plot the noise as repeated measures
-plot2
plot2
+plot2
plot2
### Let’s add a group combined.data <- as.data.frame(rbind(cbind(data,"Y"), cbind(noise,"X") ), stringsAsFactors=FALSE) @@ -102,12 +104,16 @@ Enjoy this brief demonstration of the plot data module #> sigma[7]: After 1.105 50000 1.072 1.140 2000 #> sigma[8]: After vs. Groups @ X 1.098 50000 1.054 1.150 1000 #> sigma[9]: After vs. Groups @ Y 1.000 50000 0.957 1.045 1000 + # Let's also add some colors! - plot <- bfw::PlotData(combined.data, run.split = TRUE, run.repeated = TRUE , monochrome = FALSE) - ParsePlot(plot) + Plot <- bfw::PlotMean(combined.data, + run.split = TRUE, + run.repeated = TRUE, + monochrome = FALSE) + ParsePlot(Plot) ### Plot the split data
-plot3
plot3
+plot3
plot3
diff --git a/inst/extdata/models/stats_fit_cfa.txt b/inst/extdata/models/stats_fit_cfa.txt index 9f27023..ef77280 100644 --- a/inst/extdata/models/stats_fit_cfa.txt +++ b/inst/extdata/models/stats_fit_cfa.txt @@ -40,4 +40,14 @@ model { # Priors Wishart Distribution psi[1:lat,1:lat] ~ dwish(psi.prec,lat) cov[1:lat,1:lat] <- inverse(psi[1:lat,1:lat]) + + # Compute covariance matrix + for(k in 1:lat) { + cor[k , k] <- 1 + } + + for (k in 1:length(m[, 1])) { + cor[m[k, 1], m[k, 2]] <- cov[m[k, 1], m[k, 2]]/(sqrt(cov[m[k, 1], m[k, 1]])*sqrt(cov[m[k, 2], m[k, 2]])) + cor[m[k, 2], m[k, 1]] <- cor[ m[k, 1] , m[k, 2] ] + } } \ No newline at end of file diff --git a/inst/extdata/models/stats_regression.txt b/inst/extdata/models/stats_regression.txt index 0d194dc..712a025 100644 --- a/inst/extdata/models/stats_regression.txt +++ b/inst/extdata/models/stats_regression.txt @@ -1,4 +1,4 @@ -# Standardize the data: +# Standardize the data data { y.m <- mean(y) y.sd <- sd(y) @@ -17,14 +17,14 @@ data { } } } -# Specify the model for standardized data: +# Specify the model for standardized data model { for (j in 1:q) { for (i in 1:n) { zY[i,j] ~ dnorm(zbeta0[j] + sum(zbeta[j,1:n.x[j]] * zX[i, j, 1:n.x[j]]), 1 / zsigma[j] ^ 2) } } - # Priors vague on standardized scale: + # Priors vague on standardized scale for (k in 1:q) { zbeta0[k] ~ dnorm(0 , 0.0001) for (l in 1:n.x[k]) { @@ -36,7 +36,7 @@ model { zsigma.prec[m] ~ dgamma(0.0001,0.0001) } - # Transform to original scale: + # Transform to original scale for (n in 1:q) { beta[n, 1:n.x[n]] <- (zbeta[n, 1:n.x[n]] / x.sd[n, 1:n.x[n]]) * y.sd beta0[n] <- zbeta0[n] * y.sd + y.m - sum(zbeta[n, 1:n.x[n]] * x.m[n, 1:n.x[n]] / x.sd[n, 1:n.x[n]]) * y.sd diff --git a/inst/extdata/models/stats_regression_robust.txt b/inst/extdata/models/stats_regression_robust.txt index 588857d..4f31845 100644 --- a/inst/extdata/models/stats_regression_robust.txt +++ b/inst/extdata/models/stats_regression_robust.txt @@ -1,4 +1,4 @@ -# Standardize the data: +# Standardize the data data { y.m <- mean(y) y.sd <- sd(y) @@ -17,14 +17,14 @@ data { } } } -# Specify the model for standardized data: +# Specify the model for standardized data model { for (j in 1:q) { for (i in 1:n) { zY[i,j] ~ dt(zbeta0[j] + sum(zbeta[j,1:n.x[j]] * zX[i, j, 1:n.x[j]]), 1 / zsigma[j] ^ 2, nu[j]) } } - # Priors vague on standardized scale: + # Priors vague on standardized scale for (k in 1:q) { zbeta0[k] ~ dnorm(0, 0.001) for (l in 1:n.x[k]) { @@ -38,7 +38,7 @@ model { nu.prec[m] ~ dexp(1 / 29) } - # Transform to original scale: + # Transform to original scale for (n in 1:q) { beta[n, 1:n.x[n]] <- (zbeta[n, 1:n.x[n]] / x.sd[n, 1:n.x[n]]) * y.sd beta0[n] <- zbeta0[n] * y.sd + y.m - sum(zbeta[n, 1:n.x[n]] * x.m[n, 1:n.x[n]] / x.sd[n, 1:n.x[n]]) * y.sd diff --git a/inst/extdata/templates/apa.pptx b/inst/extdata/templates/apa.pptx new file mode 100644 index 0000000000000000000000000000000000000000..92a3f6fef53ca51e91d15ba4a9216b8b7eecc318 GIT binary patch literal 32693 zcma&Nb8u!~w=EpAV>{{Cwr$(C^Takfb~<)Cwr$&XI=1=c{hf2~Ik(PRb-t=+?pky0 z+W+kJj4{W=R*(h-Lj{5Wf&u~pA_B6`UdX=%0Rqy32LeL<-f?hnrgv~M1(@178#-Is z+tIn(+MK5<+OIJn4sVlRaEth6Sr`omgCS928mBKv{%IiSk^Ld!vNz&NanW$q1u%js zSX>C>Jt}Rwy7WukZXIE7Y2Nc0-7D4HQkL;_G-Q}+pAAj0$hR2t{l{=A{3@YDG zu(oCUezKGfH}0jYhhjlJ2o%p5r{rfbKCC>sH0_hltJfW&t*|L2PxPqSe(2Pa$I*w# z2NK>&tEr3(md6f^PZp0n3z^A6pKv1$ifV^#p*8ZAEfOelfBou~p0k-=o(wuNqoghf zfKTr;w~qfZS#x+G?w&o`8=$^LMUoL`fhUGJUs%cZ2PgL9y4i-UF5G?9Hz!Bh6WM|V z-hGHn#Zy8RHH;gGAQ~^9#aPO~vs@uU9;}r%OaS0=a(cUmQ|qvyjCohn>S006 zvxw#~LS=FsHnea*sS(0LGiQQHaK(5DAO~-t<-KDNJ^9do?F-9$CnzEg{Dy+1A*Bn2lZOO!G8 zJidZ>k&i={kKvNBM*9s<#oGhM&C*+r)W4>*{2b~8%zXqZSFH`2;wQtaNZtzQOIX(L@hdJ8kKxE3puZODNw zB2>VmFmfpuVQ;N0|3Yy|#VuP@p)yVMq zfkW?orRMAAMC;_zz&TbnW&zkbU(Ht_Up%Fzg~1x@V^doA$FIn0R|h06<##wzd>f z(zDqn=%Dv_j}Tswn?CCW_mWM|#M*M_GJ$fSqXSR|ii1iK6<6gyHOJnr?4*t=N-ci< zLeRaR0^p6+Q_(*g9e;YWUXWJJOY{NysN}*fX>B*I*Fl(c|BFv*uu6WvQ%| z73yFU2QvLMe4niQld+`rfoa{C3zs%4fA!-8>?l>YPDj@q_U;WOi(AweRPUAt4BI4^ zcAgPsD!nF;Tbr=i@3zZ6*;bl&V?jMoX>soiA-}7FKG?UvS~+ z>NTa>rNHm+jp#Z_P(~}oBHG4&4;1jA_QSe5lP7W31XO(`i}q)WIJ{jr-~ znVBhsn;%z8)|4s{mJ1!`=y9D9r-Nv_#95QE{plT5yB)4x??w{!gbF*h+2^SiJ)Vbl zkY?$G7Vms1&U(Pb!>_9X29|kI$xO1FD!)FKUx_5FcQGjE!=FiqU!0 z7G$glBd;CtVvVY^#7z5tAaBi74x6O_5bD=RV7NTp6$8~({d~7($Hf#-1{O-&V1`k< zV$NP>+`I|V)Ww27c|f^^*%O6gLqI#_)$7tRTt$wO%OY8CmA075%yr8NXwex6#Z)?! zx87dnI7G9fG~;!->zpj~B!

TzN>qYVvKQKOk&FZr=l;Zk3l;!s1;FDmQ1_1ig+7 zL0)h`D4pBhd#8H|4pEjN?$l>Tq=gBr({Xp=uZnsaHYq&gMLe0@tU~U!_{&4&|0X!4 z6)V;EllG^!+s|_FzNbj1tMa&E>MB1%MW#z4Xm@C#@7+MqBH%M|RH_Nl5!f=i2M-!` zE$;xtO=iRnf=4!^s!Bc@k$y|Bn7_lQklEM~EAQVOjQmi-`yD{wDd|kkl*c~A#}pqC z#4@-`J$~)UWlMAVm`)^$(T85+XY5(SnMFO5%#C8>MukRwYuUS!Z5!Fa$W^y9C$Tqk zx0ckX$mXWa{qZQ;W;txQmUUyvH?3L4c^_L(0Uvntd;2bd;~czz;)3*K}Mp zB*<7vl|0vGm}mTC-ERb+W=;6j^%G>vK)ByVCL0+WQ`|6(B+MAp%Mu3a-O;#Uld!Yp z*j-ObjFyz%kY?effy&%1ywveS%cyS`LFQ_|_~;|C1#5t4XbW`Xz5nk8#@K}HmK<40 zBGMxnFVNo#jHm+1D;8c@PmU;Z!-GL$du-cV*Mjij0NhyFWqrP{H~R0(Uo5A_t_E>i z0|bA2?I|f#hWJ^E=xYwF2QiAY$3RK!C%F>Em5fk68kvFv=kuJ8V!1C0Oq0OVzMkO@ zTFTrVJ;iT+RAgP$=^8JaQzL(Md4NT8Q9T9$uMjC7%Okqwb*YQ036Mmn>^$u)tEqPh zi;5tSxR^kPLU)BehwL#_?Fe162}u4yjitt95l>T~6BugSfV?5a#^pX zlu(l_QVGU1k%0D&?VU$g#azAeBsS9|6B>Z)C}&rm{GO&w$c3y-E+B|Y;#EL1aQcd;n<0;I3W2wI?B?7bQ$;6FA+`-D z=$Lg}J8t5N=dU^7L_AkFafOy7?K3@gxI>`qO;Utxx7&i=d!hhWDhs)E(jCY3OpRt!uOl86DeTcF=7h?r+;GE#4kLk^7|GjTtZ9n zOX>3@!SKVHt^_b$BUhk@u|pkxeZFzUt6Xc66u>7iig9opEvthU^-T+5xw%$n6Xf1k zes941YvcC@Z+I?oQZ=+xNKOdTg#eZ)zLFk?(2HlT%Jc89=T&srQ$f;H6&oqY>wys9 zjj7A2CmrL3vhyV@72cQC-m6#4x9vYXcasR0e0`-^nVG|4T3CEcF zVe)nyBG5|u5L+EV@VMa%r?_~;=R1s`q>dHcG5C1S26r(^^uJ<>T-~K{J$-{?iIz4k zT%S^2mEGSIXS|tNzDzxC{r+ui=1Jx*Sp^3I^1}PC*lcI-Yzp{4vH8C_{}G!tZ0*`jV36T)MUBC#T5%Ce*P;q6QLF#ZNI0`xG>vm z#CzAu4e#Gv?)K0BuGZUDThK(_N?|=~?~T9W3O;mEtkc~7aNvDZTDAl?121MJ_IZkF zxIEh@@N-|h*PxYnLvIdrfb6Jg3VXZM2`^qgX?V$0Y2huy=`*m=x`TmrKdhJQy%E3G zo0U6$lPu{Y1x$K(O}~3`(E^;5{zm>{$jfpNs`dY|=CRtaq+K7|9GZx}@n=<=2v0cl z1&#Iqz%<`|HM&3d-yww!Yw83adVW$fqS@`YiLEn$!T2&AXGSz(tUkY z)_PzS5_w1pnX@zJf>{M*cp?CY$^0;uB6WN&lcS0BWLMIWAn!jM0A)yUbzm=kI#TK2 zR5`J{=KXmIyzcG$>hCg4H?yjtVpbH?o+D>5?;-2}4Axr6L4KDmrD<3gWqWN4(EH0? z*>5EwXOsuf)wBRQsQ=BqR|VXC7YNGC|FEf#kp>DriE3LC>=O4zjB2(?_#k^kA=hr% zmdtm_+JV*`*XC3>-7J)$g@P8Q*Lf1LZm7ETR;HP&dUnM-P zvF=t6M5Lkh2Lshj*nKyHII$8*P@GlQR6yI2^pZmHHUXlhBIx7?Jge#rn#n7^3UV!w zhFu*~iq_Wk426P*V+3c)JVnZbKjYP2*6-Cn=Qe6ov%^?Onqrv-f=$ne_<;x^4wI|z zW@I9kzY+*N>AZL35BrnQt;qejqvhn~`g&Kmv7+L__6$!=PZ;hYph8Ax2%gFNkKLB- ze%LfqP&3h)!^&;Zvha9^smN(ZAd#k3A|np_dZIpy=MfY#;pPRVkNxttu=*)INv(xG zz*&B6laV*Oj0H3IriE$A5|%rXYwHj9Hrre@sL9HVss_22L4g}g5s56jODGUu?dB|N zf;y-Kw!2}5NYqgG+w z{4s78s0A#7P55FFSH!kAcxVF;Wa9}?;P$3@K$;k2eH{quP3T$ZMGi9c)FjxI_ls4q ziB-SXu2KMv0kPcOKRqU4!V*aHyxdg|cO7Gw?-H)A6mAY2!}dLU2fgiMe=X_XXvh&b zyC3(buJp54S+{y+l+g1HoMimUl2akz1MfxQnnRs3z)YikdE+a5`{H*k7vg@A(^|N6 zC2*+yL&hB}2``BGycBd6#!>M6e6aPv$@Djey?)j*L5Lv$1AcEtxJ2>X)RE;@tZN(Z z2ZSTbl$`pc4Ru7X!QJD9VYm0^ehGcf7momFIsPLuuqy`Ju*6hgYTSrJ8tEG$6TOk!dulYd*_t3@kQkP5i zBmTOWZgEk1C*uugaRXcv({0}l-86IvF~g_K;;@xLor?3&-f>^X3^>ylShl_eytD<_ zk_onmE~!o7RG`m8E)58lSVPu=l{#a@>Swv2T2KX9Q~HV(a(O`YU}nlWL{A*T^6#bl zXf+MVR3Mi(m)Ind-mY{jc-_w& z-MtB}WE($S)$k~P-RSgxlmUtIJkMV12zPI9@dhLW^W;Csux3gaY;J6+g;?OXV$Sg@)jcjX~~Z%JOl^yhPRG6Z@Lh*1zUa;5Q2QUk?vkyYtJMAPyJ4lT# zLy3AQi47#*jZJmVf)meq!-=zi-7xSQkclwT#Urf+mh*LpUJWTq4`%UXVC@(oFEqpr zBtG7ZPIeDoOyknWxdJ2}()fm*c}@T3;#?Q#r@nO=(b70}g+(#Iw3l5Oj7oM5rR}6t z`F*OPs3CAkA%)6|;i~c<4~QbmI|P3OnK%5PYh$b|WM0l3X@^AXn3q-wtiEf*PzGfX zXs6ZM(PO&JY-lN@)ltttugg@cx!?%XUAFsGSJ*=M{97@4kEbXk-s>aAJ*f-EeMi*K zLL1((`-+JA7GEtRQ$Wp?$mP+FG{ z@1ygeUH{+yeMwFv=hDB=&E>zHo2#X%+y6bcDCKdxenP|!^;3SrOWK&^Bg4T6DplSG z1xm{+)NtVt;98FA>MLya%7TM9oc4){%kw^)+G@DfGN8591bBRAsU$QxEA8Zan_h$z26;QAn*+zNLjpD`le@DXrZ;vMLX*Uyc}7gv zcreSMhnj3gtjj5%xBax<&3e{(dYKkhrpDyRNxMiHVbPBcN_WkFUUGp5H<`-yz> z+Y%?acEJa3v6%$cTo2??tvCl8z_O^c$qLf5NI_yeBxcN`)y01;<1r?fP z%PJ*2h-%$r_cj#(-j+ncsT<|JxH5Xt)`O;Wx1H!+HtkY6^f+WATPbwGX;ZUdy*ES% zJ)&Zv`C~XTW3r^4jF0&L?LoHsT>>t?^=S>xf7Mr=Elh1q>HoR@ha}aMwMP-h>{37V z!@R(IM_MOAg8zkwqXi`rk+;XOg?9y?y{S1Fh2mYlqfx4)s`a2$+KgY;BtiHfD@o#NY$}XEXK0=3C!?T1&WP>C;$mv=$7!> zz)C3UfFAN5cC%#9#m=MLlqYRnf^IHMtly5LW=?+ZL6(5JI1CCr342SVAhazx8Dz)IRzQ2aJZ1* zVf(bYYh5g>ckF>=X!kuk^_tbGpRs@*eQH?di=u4r*{!p%rjaSM>FzGoG8RLl>2J0* z`s`h}vW`+h*mG@Gza2I0=*_l&9G#`^`t^$@nhs#o@g?LgKg;sPni~jI#`LJv8Ln(m z6PS_kdTY67vL1GGXa;drsnz6Jax2xU!DoC7AE2}yBT|rxS^Bp*ai|Rokn5RAJExBKn+<=i613``gw1c}RJAf_JCa>)n%}9K7IV2jmoJ zeebWq?QP#*pPsjyk>dKTH+4~8A0^YiZx7P!3dsS}-M;U`^TX5KFYnU?_?$cKAPD2v zz|j#R?4!_J2aGF6hytN|4-^nc#iqYDNs>5v(}w~sOGkvZGmS#=THtGW-Ngkk9Du9k zE;V5YM2+%q&EobNb(vlp*FbUdC+%WdmGYaFT76$8Z zkfbL;A&7>FB*TSXu?SH12-~Gg50`yTVd-8Z^4d{d7+l&+1j5wVCL^k5G545UD4}ke zyzBiST{r->+r-0c$YmhR7}9+-?0SPJA;u*`9A>5ma1}pO6U3Ewwc%4?e&QhyDbf=v zwOQCjlonmO9OGZsT-96J5QpR&W86X9)nGUt9fLekhNqjSgUL3 zGbv%Yi}yk~g)sck%3CTk&nHr3AP#u+8Ztmn0U*RjISAZhTDGUcm11>Q?y~tr=;*Jd zn0Y~1o`IFpRMiS?(0H0h%tiI`NVVBvjKz~a!e{xbO?u7?^U1AmK^@U)3{hSuwy7GT zli5zIw^CNq9Ek>PT56V8v8*7+!<0VOL@`m_Sv=~I{XWyTXKNss8U_+)*OHHno?QF- z6Y@e4mJ%g4piV7!wEm8jL-8{ve+LY1RRq^)M!SS+1w{c`AB}AJUQ8e)oxG-=n!h@5 z@QL5U#UMqD<4Uqk#2nqsp`Ol}p*_KK&`$7)on>1I%0s9Etr zkqAO0dXpf?xuUen&|H9Pn&f=N=Q^VmexT5$ABT5Jrf!rp?9`{5qy6Q%x9Lk;rZ~L1 zdWy74tayE7)GF;q*VIaOg_=(%Xb6ef3_A@KB8kQ zz5_?ox1oI7zuIrkhDJ7~%FZ4(rvE6k9}|-Bfee@eyPXkk7N0(}!iprQeT39*r@&N6 zL?;3k1<3oGrZ2Y%^ppHj`KcP;RWH!59bn`(*3Cjlh*+;6V}T{dO-IWHgBloEkEZP+ z9!Gf(Ksl=V*-WuTh66+a03Z}@E1uWFo2Geu@nEL7VcYtnQ2W_yKA9xoFJ8o6BE&*O zb}xHbAYpz(Ps#XUxTOTBjwj2Iqsr1^Yv~6Sjjur6zmI*LYYoMQ886Wx?Kg0!d(R{ij6BBlg?Ld%>P0@}Qpem7dAqpi@ z%V9Yr!tO<1xvoNCsk)8~+jcme9{MBE{@vf4!cIfg+viqCHl-@bI~a7HXf5!EAr#bI zZ4Ue!)14D8Nn{-)G7g@*m!(eII-l?JXJ&;O9&L&Hde$TDSPHUMXd=M`_lY?o-!E7#2o8Hh;&u<;WSjenVs#+GcC$;6S1Vi z!%=c56o_0^U*D`m9~$0nW1Y^B+Rk{g z5r&Q3p<5H2RJZHuop?uQntJHGM~B$Cudtr2=thO zcZ@&W7(4?XNaha5pg9&2gefEkFGyyQC3d!{1ZEQ6jt$Tcdv*W$`XA6ib)cC9z;c05 zVdhxK5T@(=o;<$iKI$KU?*he*l0|O<5X3)cf zOn2*{5-WM+fAte;zl5eNc>@tz|CA?3!bAJGVTm^9(TY4zdzRnN12Wz3NCJa6r>e+i&m&9i6nUsf8W(S?P4&$Sp4+9` zt6(UTG)~n+{ePi5n{db?uvvPFkM^ z#zQ%O-^_R>%9r2L^HZQSYt1Y@Fsec%66^D=E>oAn)+b_UNYLzHWHg0SmI5Ts9!{6_ z^=?862hsRyvV{C+N5J*8ij=%}Ihg1rqYuIN3j^%6$*d}NR5!RodUAl;i>C%$giD50 zjUV0yIp0=YwGT;5U#iHWPX)m8Gy=ZrDq3)7o;fXa5TO~&o{Uo$0zkE0pTa_-;w^R; z>(zR=w`V|DTS7zDr4$1N@RDl8fD;(w-qjHE&1K)juHm|o%(mMf#d6DLI6i#GPx$Z6 zjv6f|2R!ONeAD&@eW|T@12HYS8wkxHKb-HeSE-ZSB3~?7>8o>UC&wR{m!=&2?{*X> z%K(>NT!{g4M5w{_}zmVdUY-Ym$-%{^-u_{;_c z37jAcGzVa*7RB%=80mHRqi{gpi!{jDEYA@#5EDide{jlJEDbor?jGJ0MRjv=_NhX^@@k=zHT4BuF z@=MC=(PjY`!@Ct1CS)H=v*)M(lfVNanA^@bcGxIP=xh z*E7`A8^B;N$IvC7yhhq(^7zHW8l~56N9IM}y zhGMU^-q)%a|D1p|+vUN|2djcBa8w)iDLCnu7}TDq)=ngDe6c1qix8e)D;XITQ6@;= zS^W2IxADasiw$fBuW=ZO#+|A80Yt{6=ABU>EaXjt$>sCcH*NS7n zyv?ani=fNNCkbdO*{ZD6yXzgu;HuYD=yqhs;@7$k%TGLe=q&UXt{og^-y;}*DRI)4`^pEHCyz5OOM%}Z5>B5 zM_;Qwy&iillj4^sukep8-kw?4WXXJ}*K5jCUsJVS_GXF3pD2j$@kR9N%ENRI4|a6G zM3n(S4yIitxd!F;9cj7IL0B-;FxBRL#?S6aN;#O|>d+%KZJ9UZ9n64PNon z?yM_n^2?v@1!I65#sF(GqoV{BM1a%2#8#Z`f;YDDlko>Q$F2&!xEj}$`Q*W=(ZJn( zP!Uz6X=~kmO+@b#3jR5A6{y#^ zBXKZo^!l%1&+!Gb=dq94-abO)nw_E9#4dfsb|3%b$ zQ=hkpsNK*a9_bxrgxbZ^f^7_&dfq!o5;YQUjGx zjqG%i?a%H)@2$m0vXpI_OS7dg(&yaEbPSX+&dg!f$Zm4NRR6+A6nM$Kfzc7b z2+Qp-BMh?4Ov$Bp4zOx6hD|!XTHt0ylH{`>#7>;as8BRV!6BXEXvaH#sjv_F#^XN-X;<9oAU@bh3?kBSbV4_VA?FnHo zP#y`RWh?MZT-X@Cm3+yTrwbRs$Nt=aKAU4VJSuD41euF3W+=^lb|xbs%dW^w52Vfb z@b&PHzuV{K{R+Cl3V-tfy(x#fbS@<2xp+O?R&KZG-i zUcC1pv5Tz0Ar8jua?8H{aw(>-`tm|F`=58SqM_RO0P7kT`5-lN-{P14#7MV>E=`SV@ zNk1i{a}vAriY{%t3H^oP*ss-}+a0>9XewLPC3O zJxPm&_O{_QTiIW);~B-|7LF0@Hk3#X3;AJhOG0DCe>r~Y$H7E0FU4VRO=4Bo1dIEg zq2g`>yNTj$yBL@BncBLXy)d4wdg~pT4BVQETCFC0x39rI2J>x#4XtAgtvQec3e@>k zB<-+k)V6BNGx%u=9lgPsvt8he|0-+cVyiPSwi{cFSV6PACR>ZJm=JgfhWViL`};Po3f3K^t1%fD@Ec7Sn`1dX;SQtNhh|BxOHXPo;r#w z=Uwq;+zN7?fS8&p9xGF8EjfA~%G9K!6x`}m71N*9se7*%Up%obA4wwaB_~WcU`?hp*8>l2%a3;w^@u$fG z|0*Bw@S9YhKM%mc zL_z(DKm0u$Ivj9OENK!J#8E$QbG&v#awA@fVWN2M!$=+nB9m+?N_KdWkXT;CWx@jk z#(^3k1y9-g;6phAV0Yoch+)xdgM&GCc&!;Aqd^%`QM`a4;}SJEN@)I;Oc9*t27!Q` zj7QR5&Ps9Q{dh`R*g!s-@(gj`2>D$M4u8-Gy=B~I{SSGMj2JpG&~3cc_>7nf2h7;> zNE_TW-=wJg6svOlY=L zbI$TMYM2s3w_x^)g=SQRh>OlXnDT7w62YUl(g@@~W@42Uzur`SBM={6IRYBzIF(NP zD)X|fzTqn!Pb>1<&dzkI`#Z_`pXtvC)HMa}cVZOx-HrI)q!a5uETj2{_hss2s; z7Ea$R!}5PvMyl|?vCOE%uR0rX*Tt0{|4DXq*^l>U0{&07?JjM!)~4WKGfdr+M;z&8 zLMeyzyb|hQn4JBZ|wAV1Xt5Ys@1 z9!l;i3R$&Q!7EAPoG@EG)k&M^S{u)?R-%=c1n$d*%%ss5c~m0_SOg|WwM7Gg}8_wlF^2}1oGgJlXk>b6Cxnz*ecmbOG16kH; z95y5fN`TCe6h`C(lyGOCZRM@Y2|!s{Cd*(=K=9bme$xPTCk&6wG3+tM>M*tIyepJt z-(WR>@Z3cTtGoQzsZpG2`=W*^6;4K!wGu(hUWPmg=wGRNTp4SEc`;RB^-thD0=v-= zZ2GPm1GOf5WacF;H(*Nn58{#2wU)tji+%0DK;XL_8rvSprCjID1GP1wyxEDXu!lb> zf+q>N;4Jjq7*n5zpSDc#mH8|E(F?+ES44Gw@JD-l`vW4C_X<~b@$72iRUL+=0mHTu z_y9`(qwO^pT+M)T#Q~NLrhkUB7aBymR}8MgcvuZFdj~9_$Y7sVW7`SzFBmygg)2Nt zhC=|{@)t)*L|<}}m>b6hYscYY2WwBbqp;hbao*^*VCy5o9Ll`}k!P#DTX%3#l$KSsD>HbpP2W#`YiUI0PzX8Bq{omY{&ifeUO z%-E;3Xnl7i7g6j5QvkGBX-Yro1UF&X0&gfsmU$s}uFUwpzi|hl%@)?|nSa`(7Vz|@ z+zaG7W$A&(8fCm+H$BkqNghQR)dNAnAHv)BGB^GiomMs6!PKMEIUU{f@-IyQ8m@KK zL9Lq>pix>c0ZU(A?*eWK-9s0(#^N7y3Fs#PNh54@HH(%$rQzDZ`du7Hd}C+seaw5*?LNCS1z)u0amW;P_D zySgK+y?Sij!kzh?duisn(!#_& z$iQM_fOy*B-QgHgZKZjrm(0Gj2G{YTt@y0D+VA7`;%wV|MD^v*l?+GkwoWb`TSq-yGd(u5Y-z5j8pdfLq|C zC+XiLAv{eGPGu7_iDU6%A}e~^g}UG02mBjqt*Q-+r}(~8^Zi}T|3AJdf;`D2`r&vQOwVEo{b4K?JuSrm6ZO`y*W|!u_i+_}-U^_&x;TF*2QVr& zv<*OZEkb!Su=Xn37c{1U1yHdU_MS$;_U+hAng+3UjJ4+`JmWmuSujBLvsgGxc1-DY z4P;j@yGX+5+2Qm#pNSydfkq@7X;GMwU(;FR8^Y}1 zpoO1LOodU6oZ9i8kGStY++)9s$Er19hL#aF;O2Rex0xAuGBWp;sSXJkHP@&_l>akF z?UOsu1$9?rC=s4&q`Vyb(p;Vb%9}CY_8!P0URcKZ>Yq%8y!w`R-5W_HqODbd(N|_o zb5jyFwRMQ+*f(?%2!m_=_1EsWg}R39IDId{hNF@&P>_H{4ZH1$+Zm+T8i6iYMcg*Q zE6)Xv)6rQpBF+z{1P(E^hAODn7F$04J<`h{j5NxfS4}G$;d`BCO-IFppqlGM2JPn?9@_WF zo1c%6qkkmk9FoGu?=_mo2+a{UrN?Nr2W5)D@uiVl8NKWL6- z*quTI`VlK#ufgjb54fsaGKAd!s3(CH-;cMA?HM{!!>N>fAKM8_9z)R3xv+_6c?{xi z{t4^{p&Om4^27D1gz@dWMEgG#jEu*b_s#eBYS!QFwEqoe?Ek<_b=NNA8)p2LSN<#Z zFeCzmR!Yf;Ws-+bTu526^YjUTt@4ZJY+}lq+!!P$X z%WO;N07Ye{+7FcJCI(6i&BVolPuE25T3hG{i3n_|>wzs}!yH+DUk+2_*`!npdG@(L zT#=~R0X^x_p(^TMtakAnc|TB|)fBgWLRWhqrr>_~Z`kg`^UynKtDv;U{=JGQQB}p@ zC>Sgr6mga0u!{?R9c(k}Gcmpz9pXTb6BGZ^PS{`;@LDHyGS^;SA$Tm8~ODZ5At%+`6{Qx4&6qdi&aS68N%S7_F?TW!V7&LN1h~2_25=I-QO5 zD8&!RLJH$N0o|?dCu%Mw8CM}>EPR*NYFkNH(u_O5pvZy>8!pu0t8U(qrhWG5xkpla zQi_+$F>S?K_)v75bgO-hui>d;Kp@OuwFe7K;Hvkr`wfM2Ad6Hc$8Qh0q*w^ebA&{O z+bdcABp}r#+Nra}(EYRM230!vC;^-vgrEpOywGN4CM#w<=%Lf;VAYji&`Yh6mQ`0C zL?s?2MtDIreVubUL-f4AQ#9dMs;Py^C}lF?5Wo;(7_m5^L;2_p!jYpl+}J3VaLN%2 z`UmlNF%LN91X|^3%hkvG`QzkfcN)o4mEMf0FRcx=Zd(&a4>XQNHouofE^7h7iF_m> z9*`}bml!7e%sBt-&6c@c4t)l>A85>5&Yx;F_SRd@xxEBl5~y}tm}~22*b?>GlR2xk zjde}#s_YwyjcHQAAd@fxo2W`12AF+Mwlq{fM;NUkKW6Q!TzK4_I z$|Nc0$G^pkmvD#f00a=wG~vIUKl-P~ajrQTiNlWCjq%F=1K{?~x*v;3zGBRsVZyFi zmyv|q*u+zy!OWD{+$P#er4JDA^a|b>^U9)fy8=fkixqyy1wU z(UMB%`?(74tS81X1V2K)$8*{epHzQ$Sclomfc$sm2l=&4pL-OEvxf#gz!}8TSgT5v zD%vSZVvh^@m*7S8XmC^w;EzfhhWZ#JY8Nu)LQnWDXc0CJGB$U%+G4CmxWCh1%-I;& zyQtMsqAqgXu%AS`g2R=^vD#hkc^&BabpmYU>xLX zxxCBy<(nJCXFZ~v=1yiLY~U#QVlW+<67im>EL;F_7}MFje$V$W{o6VGp7-y&)#I(r zhpr09M~8YJ_mlkm-Y4%L>#^1Ne%8a0JfDa3`kn9l(_c#Ta9Z2E9xwN!kyqWHXMcy$ z-BSw+c;4d%G&q)TA^?elH3H*c&*9x!1BSs8difc_Afytb8Z)3+SjT6uBJtqM{l$3p z00|7Xox>O1pliW_zX=-t%lRunmyBXwQQFJSvXjZpeLTl?kHsgQSA z1H84RKYrTGY?SOcq3(f6i}M;QN6{L&K{1}UiHm(F$MI8md-sU7=?8JRShGpc7jc;H zbu~y}emG65?HBi$jip!n#wgHUpo$q%GH}d#Vt@!EYGc%S9w&^^5wTl?Uh&Z05HR_$ zG$wO~A)yr$yXz3aC+tG3_VuUZpKS3u38iqYk(lGeZ#LK>6xo`bi6mpj)!~%E6i$!7 z8xjnT;1zwYL8V|eeKHLCH>0LLMNH$)QLx^xL3?F%15G97v*dGwItEl(T9-@gU^BCHGy+F z2gUX@b4kQHB<>zcv6w(PPK~TP=4KZpih|2!t;rpQ2Zml@8ZX61pr{uy9^G{v`u*(d zh6Ro;xkq-IQvwD)hnhG=7Sae|(}clPLuoey!*@SrL~O}v*_y{>CuB2P^Ewpo2S_|@ z!5b9co(W1GUkp^IPnNkwDNXCgDEn-e*nszqZ%AH_@@Nr5C7Ee!IQNZFRhVtIE zqJ?Y8=4Zv2+lREvmpc{oo2#HGR-1|9GbTtBo8v61AoPWWs?Sw48fa;>q~a!X`tWeZkc5xdkRO^DfN2F^LjYyO_{{lUu99M0M8nco!Tk_exe8 zzgm*k-L6)L^lhBGTEzEPG(lDWaK0pZub0OdZ+`OhK7;e^plY0s*3dC)gQv4L{DA1z zqV^5CLadqi5VKvWYW9j&YTv?3>F}*qwStV+E8T`l|1jjg*1p&UUFKXesMbd47|K<( zQVGgEV5R!yTdr&6*{HQ_?Wzr0{bpckt?_c|W~w)Nw)gK_gvt_eTWHWgK(xca|5qg% zTNv7zn*t>5%;hQ%QA4tKcjc=(iaqTuG5ap`c$#7V)uboONBbCd=nCL> zVZU*%TbXFOJ3RXMxUc5_p~#tq8?$f5SJjj;_;LSt(D3ylga7L!WAohZara|=vfmXs zbOrZv=;3yjDv#gWbxkI1+r|05XDufme4T#9ka61QZoiY8JHBnE58H+(=ej+@df5J?O}j7l ziHDFONosZp00&s{?L6t5QzeFLphT4sexE^Wc*7QW0IY(Mlm-mOtv9F(mvRdvZ~ZCEKTRSyCSx zw%r&JR~;day@9=NCTSzOiXKD4Sq1KU(52BS*e} z?vBlPll*0B>GyK8`r3hX+1=^AQ#tztwlv=Z_C0Q)A>B;r!%}h}tL^-fhFmX$&w9t8H}*{I*};7FyfN z7;XOlmG{+QRW4iHo9-@=Zjh1^knRTQ2I<^{bgOiigdm_a0wNs}(kb2DNV5S6Mff&) z&V{qD=Ungie1CoSWe?9AvwrWIwPx>`Su?Yiz5MDFk*dc@hiQ5PTbhO4t3mL&^N(|T z`Hd-}kzZZbI?Ddtqic{q2-iCZ|8@Qkm{)Gj4+rLx`^&j=k9HzA`Mpejd3p6x>p!t| z{q8G&kH3Yu^@7V0kx zgcQRd2*utG&U6Ob_2Xf=lp;OEt$)vN5&cT#?;-xkKS0Wx^(X4TL;U$lfhUT;-~uAQ zm#I<&VoWF&6gwNGFs&qPS6c|+Y5r#^aY!i|{|*%2?_{F;&+h|k1yWJBSVjVi#%nd=wm|+(TGbiX3jSSb|AtCd zpZ{}3y5{esi{^IS`U}hdD$hnqTU=l%{e7E4E5Ib_86yrM^Z-LKM=pCr^ekFHhgb;cJM@78};X7nF(sM zxUc#5OvudB$CY<|2=P49+64F54cC4?H`Dv#GNG=#q=#b$B%;+%G8$Ib!OfA=Ng^OO z48G6?aY-nTDa=aAY_HIxP>GwxttzWN`2L7iA}O1pOOw(N-*Bo!W<{4EH%@&?x_=~p z%ZUulY9*!2?%TZr;YRH9va@LlmelFf*!>v?7v(V@wImHUtNdt_=j{vynfD&fftI(IV_CyliNfj>#H5n+35~PmkMfIB9Qqw3##bAAwl1Rwx;Ih_&r#0K z*KI&^n)eK5sbyU8-B_1HOZv?Rs;-)6>9o^n_l^h34En&6=Oys&3eI&Tk{@cmZw+`< znzfIs0Uw$+gnxBKB;X6g_%IW!n(XE=lIO^uJ!kT?vG22^U)0h0hcRz#*X_+2Pp|2+ zxn{!$BfTU$v-&!7?d=M_Un2(I`^PU#H*ffO*7|3-cC%tgM_cr+`F4XYK5WD+2&J=z zv``#YVh3vaIIbx9^}aGZ%)RG#a8C#b|EfAQcsJGWmj>bg^PZETB(>9%gYk1KH+c##Jho*7oQ#`*#3EZ|KLkh-_NsoGSw^ zm^Y>)Yipo>68v5aflPmA18r3pIeK!dfZc?tv4g5z2c#|pJ5NC!Dx0$xq=}zaT8)i) zvl8Ni2{^QH89FrUgM1KGB|-?i3Tl;hs1@qb#;r&*o%x3Od?TC%;s|r#hV%$)E`Eh@2wWLC|g)dX1McY0&2CkJL6B;cL-qB>lQBg$4_bGl>mp=-R#bk6n#(IAB#Nw^NoAWL7rN&o;{C-4VgYH#vm zS08vom4G@iDP*aPjc)P%#MZ;N#xG#>KAPEOCxzh0N?x}1L=KMMv?E-Y}lpkZNQU=gm% z1qJN}PB2)oa1?Ct*dodZMvgd??9UK!MPuKTHX~7Ss2t!KKN&*Cr{-Lu0bLjEN6CJ# zV9)=rO7^dU-IQw@fC>WzRvru%KnU<%H8YGJ@c$x}APsp-ty}>j1X)3C=|mv)B>!U! zlx^16(=$~u)n$fy61evK<%uqo0*AJ05rsx51m{mlcMTLg4mgxYF7%htELuqU#_CCc z%X|q9V-?#ra=OX$tCF!qA*e&u@l@27L_sQQB(>dihTC8FNYKSvh43n!&z=dU7Ho3| z&HIINPvc^B;?fG0OTDR_4D4lDi{P|fd^7jKlFrIV&D-mn_;xz=_lyhm6;=#)C(VP7 zsA=iZ3L%_1C2Ng!DkdYt9&C=z1|rXW16AH>U!7wVzo{#LqJKO7*AeR^?0N&{T98p- zmVPnyv}uZ$sM4vZw4uNgw&C}-P3DBfzIV2SFsMQ6C2or=d1$P1Be@k-p8}9S5BXER z_K>}YI2s2(>;`Xp--jUcBFuHYN$HIBSO8_IsV&);-mL!n^5ij9zWm&8{9Tlc)?;l^se<E-b45S_-N$vr}bv0%vcJw2K-no-_E&?@Wc7cBmO zF3f|#Nmf{>7P6^Gs^NFGKyQ<`+Tn)S3dVpowF)Q8U?-cz)@4y zKFk=5+zXB~;|z=mgZd9+d-W2_Xucr(N(G%mo@J|SEt5bjsz}jnD`M%lSpwbEaY`JE z7*prIWYZ+@3vEt@?xZ~Ln0JqfQc-+Btt|Vqm0ikIlFzyfBA>!=m?Z8G%JnT4H(4rS zx%Vz3JTnh&t=kXaXDxDf(i#Wm)O%^ezd@F;JvjtQIT42uS0^qylJ_ev){!A!K6Gzw z&%myySh@o2nBs zx-*+^V(vnUK{obh!b0UMH6U0OQU0#+WsvQ14YrGVl=fq$hqf$A@*}HfbIU%eCuPGI z47qalR{%t0DW6o8YSsxL< z;deBSJzf3!hY#^jiY^Dzn=;OQeI+(Otz7|NF0KH@^5KTlR{*h~l@9#6sz4_*zoiCr zKTIVvqx>mr_R4xDeCdUqqx)fxwb|c^E|n2KZ4+7co5tvH+#*Ao5j)VYKS^gCx3jen zE7IvN7fmD}z^cG$+exNno{6@cay(*G9|*nzl+7-n?-jFDTmeW7zvn3&thigqn~gB7 z=*rnYAjIkk0a0hvLQMq`Ig(T4j9dZCEIEBxnvWOo^sO4HDnR_{jQWZbN>$Quqg9a> z_h|ABnW-%GYl!!a*Fx#Iax*3j59z*M2=#>t%}_NTdCMvxXImdUsPpDHSt`)+XtGB) zq1s8e&sg(#-M()7ZFa?CK)nLK zcu7psp%31pQ&@ovWwgVqSa{dW)j`QUQzh?A}ARXU9 z1GdJ4=r*G7PO|Z>F_yj@)q_CR<67p8*w~U{qr((l7zS!ZH$lN|lA6b8svwI_d$Kuq zj+Md(FVe{jk+vE0tWqkA`|P$F)dQXp^7h`Zb({ML^?Zdq<(OIN#6J8{c*g^(w$swj z=~NRyesSk3K)JYYuNzu>{ho$Ayjjc){q%yHlL^1kCFS>5D-#*Z0(EEUCo>YDiXnqJ ztITOy{L@g93Q5b=jvY?d*vNoI?9LjfV}p#Si~~{K4{lcgp)+`)kS1GuM0dAku8F|a zNb|5xt*SwLR`@*gxK1}d@xrp99GvdE6+?w}xlnUYo9{$TEH`y%fq%H??+oKerD~7W zi!lvp3s<|I#FmD_u%DOLl_WO@bv5@I)xjAvOnPIbwqEj&xy&K7jcleEloq@z$^U$4 zb#jV)N`yttCcoWC6C?Q{_*1uW4pQM2;BF(10w})a(A`zvqoVlkAp@`y#c*farm{Bj zBcUNLQE%*hS)MMq(0gsD%pRJKUk>^Awok%A7Qx;?P#~8QoQ%toAMDihLgAFYxLtkj z(_RXO_=d2;`!Kn)PoxVM@O*hWle)9cbUf6HTn3Pe=Zj&e#F%t~^02wezH~ph0&tM+ z^(XU#CfxlNbD9D#T;6V1>5R?RX%y#7Z%zk=y5Ty}bXSLFhN&{5EuPzop)Q3WL^*8; zK{uIeUkDvgNgSMp(0mwi$y!Ds!ABQ)i_KpzY?e@_G z3JD$385n{U@GkzF$(fM$S**>HJC&-vTd~s8XV#z`%i+o$1ds5gSi6hBZ()l>xVP-@a8GmyY>hY2|ogB z@V1hD%5G{emZdD=TP1kD5OupxazGEG7}h^{ zA(88z(!n@)?{eW$Wg^eI4D%{FvUE5l=|ek74Z^KEq+eK)inMJWePWL6b5m~RuNvmG zpfHQE6Sa z?CYnVq9yn5fTDE(E_li5v_q@IyIh=OMY;+fEQjYoc8^*)_~3-2U$L2!12CwcGAcer zrq8@d_YxC|w6+rumGb7K+)$l9S?}YRGL=dXbp_Aq6Drkkx!z>GP4>q*k6%y|YR;Kk zzI)xe65jSaEh+if+L#K7-FCkM4-eVrlNA_KxhR5aGSyzKGYhRjUz#&;!%9XMQdBQf zptCT&UBFe6WP+>lUi^JeSr-jFuTi4f;ZTQpzk2xHle-LDF7`3|qvwV#O=yBtXBI8f z@EIOC+wq%K+qvy7xo3X5LH+w|mg9r)*yo_=dwj`jv(GMl(WeN4_Ak-hIXVn*K^tMz z6U%AGjNck0x8)C62F0wYn-W!MLJd#jWJ`#OlKIq05F=K5H`8fBRq;!N6=yDlERh{= zD8i=adwRTT^`0g2QAj<0i`W~3Yib%1R?QvC8E)2SRjEs#*a^MU&;n(jo^Gzxo8hfG zuV~N|Du69$T6w0u(uCq}YdP&2yMn~|xe^0YX3gr75o=b)MPRx&&mc4#ylc-aq=%H& z_T`;&5n4CWkrj(TUxsZR3;)-HE_^M6lS-r|4}!#XBe_?84wTDRRD|+#b`)e4t$k4oD{FV%Hy)`|GxHzNrMzfmA>+8nu zu1_!B?YT2$5}9j)!c;&mL2MMMaL*1SczOzRV=X=_PQ_h)E zi!WZ?2&EGGnYBKdUTHOfG6&1+Bc0UA%M&*EPonZ0Hs4F3O*?fb4DilseG1Pu*D65p zX}JrJr$zFtGtE7)&)CnIX>)U^;ua|C%gu$Up=uaPvN-LrwYMjxKNT0a#>>{}@=iUS z)-PUug~z*Uo5uU)ll9PtT0TZHMr$(EOBx;4Q2UBv4z1F0uBM&v599uZaqF~^%$Z?Z z!}tQ zB6g3BNlNfkuRpNJ=8|&cOMBfA^+C>D321Z>Ut5mX83%gcltQC6sZ)WK}F(kJiQCXxJ@)RHpFCBJ*H z0$pabicLq28*8d-h6DOCnGN(6sjK}s5f#r+ncwQi0C*wf#_VhpY2~N#V)1ngWp7v?htw z#tC-c4n*WfDQ*PUhu#(y> z_s+c>hdVKOD7xR@QjT&8DB7cMvcOm-dFBLu+3Ch|B-Yf`f9%Z>7&q2R&x_nO8^q(q zVr1h*nsYF))JKNqJhRQHofS8~EN2mQ$JkUFpNPmtIJ|Z)r2V~7BDGyJ9ic!Z<*R(b z(F#QR%rL-zn;6qay?tI=-QD>rahZdbFxOC|8JC)PxFVe$yAqLP%c8wv2E*G$n)UGR zM9^^twixll#w4@1?L_v{`@mr{jShAg82_-Gx9(&Trkmh@swx)JA$TU-cu_sNU|kN{q{yFS@O z%PeF``-J{*{RJ^pT3fm>B_9dQM>pkJtCMPcO<=yRKt<`h?BQ-s5z2Xvb$lU4Q8}0M z(T(-BLPKRCDi?3BrI+{`hFDfir4ObM8$$wUw4VxbBOq>kF7mot{`xFc5yU>%nCejd zXhxpGDvKhvJCp|Qjzf=%8ZWVvo_=-n6(FcMb8|fLtGd6H+q27dVmCYE)V>Ho3G8zROTls3a`tnT{TS6KgE@1%laDoJ?A6~@{F@IFgfPR&j+$B zHdO|#k6Z2mb0y*!-aPK6jE(7$g2fbpRU3W!->UaI|MJ?IZeCUD3ZvFOE6yc$NKVx1 zOZYDD_E8XzkwKn99SYCNxm$5YCW3a_&gA`|Z2NkNSb0-i{1Hoi%)gc?7U5JV|CwkEq zYgS8|YffabJY`yXXMWiP)tLUIYG6LNmu(@@wYft~GhbP8?-V_egP-k9=TbD<=0kp! z3Xs)FtPWGu{eCLprx{LRBbi~sxXKcM|B0l@W&hSaG}k3nT6z?-w{mpPzzuc(BmX;& zQFy^-$}xT^x}-E(E?!2;L<2ckSJRNK}Ck9WyT)V9N*TjH{{S&k6*%j}&X2q53*%c}fM(k<9ilplE z1b8IOLJ_r0@XUF{clz8=;8b+bMfb(P#Uzgm5xwZnlkfc>YHJ-mF2_f^(Y*)9nUGS= zsG+Eeht12Wn=eI_bab|xeS4}+-5~X@~ zm4lPAkJ4!Qp!=)j;}^bSX)(H`P!9*n;DCTYY@W6kQu4v)-{m6Iy0$=nt z>Rum^iTEQKrikb-q_lpAy@g-63f2kv6v{n%4!Lw4G!DE$gL(YZe%!VvP>pU(Dv3E@ z?;Q~v7W|BYJfx^W7wjqaMf)A&f(2RM^uGVnvD1^@Rufq8I`w1lEC<;A(Ty^V92~B7 z`AV(XZstB}1IDD#oknigGRiy95)vDfT}Ik4ZJYf?5_B!5-7%v@QxnmNHWO13P%oAC zW80{{h`*d`(75;Tjmz+7Gyb$}$AG%~qFb%(^BaY!1CFcwmQX#GdL0(dAd;)IXTaiu zAq<`WR2*O@(6f zioxgjj;FZp5zg+o^sY8L6E(-6^3g{PqX+2?JofhzBeEy)nTVN2I|n^JPAbYgqxc#$ z$-Ocoj54W%{OoJP-t+QLw5nz3q3C7$P{UGQ1LYoFP~O6tezeD>!(miw6vV$E@acNX8fhO9AX1VTe!G1*o= znFiF0dU*!AzGv;p(fs_*GB&Cjk@`&fY=SM?jt%E&o&4r~1&%Q%1Q-hRuk=T|My zoZo=wV*tzGS_59n4KRFSX6wYta{a$3ZblY{4KrvTZh@lDha2ptaoE;g{Bv5@SAYro z2ckJ*>D=MQhBu2wM$FF}`uc>(7O1uDPwa5_UzDL4G?%>jal6ApVt1_n|Ro7rl#gMM!}>U6mQZknvV1Uh-=)IbJdxbqfDi z1UhM&A;D>0Aj?j|gc5@dhT7-d(e4nh#f{!n<#zT_ zq?qRL5L-XaGK$EMd~(Q<`fIngS)ctv)WNcH0Pkf5Pdff^oAy&)kg zj(zERu>?K^j>)qumk;FGBr%u~2#5tUk`*$z!OipOYB;*=lGNFx-`g)QoUlC_FSb6| z!rR#M`fU9%l>H{lwAtfnQJ*pJ6~TXR-%DAdOWT zhue!x%QqXzHZVOIqthp|=YtPM9YFm=uj4b5m5DrKBvxM*zm1zzU;9>44e#r5s-hKH z=UO``Fy_MCzSv{_qI5DjEU^&YA;)_6Qw{KA0ySn9YND61s8XxmC6tr#AjwbzKA8Z$ zo3X)`yFWrY#ocVvt8K?`O)dw^RV3nfyx8E_330@&5YD=Wo(VjKHGUCWPxgQo-?i+y zNs({_dz@Cea>l0#(SyfgH8}C8BW#2Zumv-U9yE7O$uWc!vQb39@jssgpU(K%yn?w&r)^Zkrj;BQ;o#fj1(A85lx(1mqynqiqe&}gGT}ZsN;$RB#I+eEdVlz^o%;ur zXUE?c_R04!7DlAseXeIu5tBh7&(E<+*yHt1UodbL_QtHk%Npu3lEesJKexJimW5c_ zjnU(Yty-~hKj5(;;n9+ffs8E?{1I2#IU^psH1l3V=K^@MuKW<9{cKDjS3ceT}VrSKckFp1(T1cC=o zXkzR@XVJSs&Ghv=UtSI6lF@1PX!pHFy^Dh&JJGGfm?H2v(>!&d?U&8w*iam(9xMXx zTO#<2%fMUJ=$7NaAJr&gpaCobOoRjd1Co|q+G76@P8Y1^W{G2{sMTrs8S2%{&oik* z&;3_?zF+E<`zd6(s~8j12kB^#ccnf~+vl2n*Exm{YjKRk(KL!f(akO_^OVjE4*ECXn zHwk{{6olT)PkVSS6|g*{{gBE+Hn4qEb)0<7&96$W7aQs=aCB$x3?1dKitFo&r9Kl`-=a0Dg4-J{y#5;9~*)HKa;}c4$;UuxRo3Mj}@*x2kVO2 z+c|@yb{eXAIG8!wtroS5;+!kEe~qKste`U#0%C&U#)G zcdO+H^R(BAc|&rgR6=cS4ihM7jxnGsB~4AgU#Gbe#`O^#zDee4CDpN04LdX%0Zrt zm&<5Vk3|yV%F_LDHV<$VwBj+P#u1pDt1Dg^;K$4&k=X_0YR}ewOhcg77vT0;u!4Kb zEca5(=%|2JX8OU%mikL;icg1B1yf zl#RT1UQyh23zX_kt42QsITb{HKs3iDJrzALo~?y)&JjME^~JDG-DAEgUKH%Z+qo#z z9Va3g%rLggGjbG8H5Njs09|V4u8^{)9mi}sVZ2oI>T(_z%RRd48m)t=7P2Oqdv-3K zjC>Hxz+4rsU`M9lli&lpUzA-Fs1;YkINB=TA;<{t!(+j)hn(q>f8~~s^yL85uICz| zEZ|@YE7)~vf0QI%Ht%^#{vZnum$A%aE-pF)to)z-a42YI@QU2Oi|7ij8@G;M#dm!q z_g4hSc$YWi)Zp&QHNvfK{J%%PgoJ|((RBm&5xgq)8tzt)*6H@ekM1ob9Aspd8@NfZ zq2(IxFL7QV$sr@6+>kGTjc$L6=U;I)Aju&EbKH<8fxm^<?s{$KouLjpj0<-P&XBmN2Smk#%>i(je((xdJT+&=j~!~N*9 zLUIS`-17#mocf>PesumI;UL}W-N1z~{4?B-UKAu8r2niNxIN~7hWpVSfrNwf8FK?C z!|~5>KiYLjI7r_ZH*oJC{4?B-1`-ku(sjTM+#>H!xE~=*eg-o6r7|J6VcsB&3;#s8 zwGZ>(H)TRH1i1s@2JW8hPdLc^2tN`2e(n7Y!V|e$Hrl_g#D`=9(oTN^5^iz}=yYSc4A0sNGstDb(qCpY=)48kS4Pm!Ya$3!utmU8YCE`wdV#*+WIHh zUs{M;gZ7_c8E@0r)$}H-q=zM^3f-9psw<@$VzQvHu<9n?dI9Bj-8%4)V>w?e~$39e)S;W-#>o t$mLId2l-}z0f`LRO~0viwNAh6v_F!A1G{Uv-Y7%?7yxf!A9T6C`aeaGiah`T literal 0 HcmV?d00001 diff --git a/man/MatrixCombn.Rd b/man/MatrixCombn.Rd index dbac594..84b9e4c 100644 --- a/man/MatrixCombn.Rd +++ b/man/MatrixCombn.Rd @@ -4,16 +4,17 @@ \alias{MatrixCombn} \title{Matrix Combinations} \usage{ -MatrixCombn(m, s, p = NULL, lvl, rm.last = TRUE, row.means = TRUE) +MatrixCombn(matrix, first.stem, last.stem = NULL, q.levels, + rm.last = TRUE, row.means = TRUE) } \arguments{ -\item{m}{matrix to combine} +\item{matrix}{matrix to combine} -\item{s}{stem first name of columns to use (e.g., "m" for mean)} +\item{first.stem}{first name of columns to use (e.g., "m" for mean)} -\item{p}{stem last name of columns to use (e.g., "p" for proportions)} +\item{last.stem}{optional last name of columns to use (e.g., "p" for proportions) , Default: NONE} -\item{lvl}{number of levels per column} +\item{q.levels}{number of levels per column} \item{rm.last}{logical, indicating whether or not to remove last combination (i.e., m1m2m3m4) , Default: TRUE} diff --git a/man/MultiGrep.Rd b/man/MultiGrep.Rd new file mode 100644 index 0000000..d7aca61 --- /dev/null +++ b/man/MultiGrep.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{MultiGrep} +\alias{MultiGrep} +\title{Multi Grep} +\usage{ +MultiGrep(find, from, remove = NULL, value = TRUE) +} +\arguments{ +\item{find}{vector to find} + +\item{from}{vector to find from} + +\item{remove}{variables to remove, Default: NULL} + +\item{value}{logical, if TRUE returns value, Default: TRUE} +} +\description{ +Use multiple patterns from vector to find element in another vector, with option to remove certain patterns +} diff --git a/man/ParsePlot.Rd b/man/ParsePlot.Rd index 8ff7856..c9fedf8 100644 --- a/man/ParsePlot.Rd +++ b/man/ParsePlot.Rd @@ -16,7 +16,7 @@ ParsePlot(plot.data, project.dir = "Results/", \item{project.dir}{define where to save data, Default: 'Results/'} -\item{project.name}{define name of project, Default: 'FileName(name="Plot")'} +\item{project.name}{define name of project, Default: 'FileName(name="Print")'} \item{graphic.type}{type of graphics to use (e.g., pdf, png, ps), Default: 'pdf'} diff --git a/man/PlotCirclize.Rd b/man/PlotCirclize.Rd index 941ec4b..95d6091 100644 --- a/man/PlotCirclize.Rd +++ b/man/PlotCirclize.Rd @@ -4,14 +4,12 @@ \alias{PlotCirclize} \title{Circlize Plot} \usage{ -PlotCirclize(category.items, category.selects, category.spacing = 1.2, - category.inset = c(-0.4, 0), monochrome = TRUE, - plot.colors = c("#CCCCCC", "#DEDEDE"), font.type = "serif") +PlotCirclize(data, category.spacing = 1.2, category.inset = c(-0.4, 0), + monochrome = TRUE, plot.colors = c("#CCCCCC", "#DEDEDE"), + font.type = "serif") } \arguments{ -\item{category.items}{named items for circlize plot} - -\item{category.selects}{selected data for ciclize plot} +\item{data}{data for circlize plot} \item{category.spacing}{spacing between category items , Default: 1.25} diff --git a/man/PlotMean.Rd b/man/PlotMean.Rd index 38af565..b2dba21 100644 --- a/man/PlotMean.Rd +++ b/man/PlotMean.Rd @@ -7,7 +7,7 @@ PlotMean(data, monochrome = TRUE, plot.colors = c("#495054", "#e3e8ea"), font.type = "serif", run.repeated = FALSE, run.split = FALSE, y.split = FALSE, ribbon.plot = TRUE, - y.text = "Score", x.text = NULL) + y.text = "Score", x.text = NULL, remove.x = FALSE) } \arguments{ \item{data}{MCMC data to plot} @@ -29,6 +29,8 @@ PlotMean(data, monochrome = TRUE, plot.colors = c("#495054", \item{y.text}{label on y axis, Default: 'Score'} \item{x.text}{label on x axis, Default: NULL} + +\item{remove.x}{logical, indicating whether or not to show x.axis information, Default: FALSE} } \description{ Create a (repeated) mean plot diff --git a/man/PlotParam.Rd b/man/PlotParam.Rd new file mode 100644 index 0000000..da46894 --- /dev/null +++ b/man/PlotParam.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_param.R +\name{PlotParam} +\alias{PlotParam} +\title{Plot Param} +\usage{ +PlotParam(data, param, ROPE = FALSE, monochrome = TRUE, + plot.colors = c("#495054", "#e3e8ea"), font.type = "serif", + font.size = 4.5, rope.line = -0.2, rope.tick = -0.1, + rope.label = -0.35, line.size = 0.5, dens.zero.col = "black", + dens.mean.col = "white", dens.median.col = "white", + dens.mode.col = "black", dens.rope.col = "black") +} +\arguments{ +\item{data}{MCMC data to plot} + +\item{param}{parameter of interest} + +\item{ROPE}{plot ROPE values, Default: FALSE} + +\item{monochrome}{logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE} + +\item{plot.colors}{range of color to use, Default: c("#495054", "#e3e8ea")} + +\item{font.type}{font type used for visualizations, Default: 'serif'} + +\item{font.size}{font size, Default: 4.5} + +\item{rope.line}{size of ROPE lien, Default: -0.2} + +\item{rope.tick}{distance to ROPE tick, Default: -0.1} + +\item{rope.label}{distance to ROPE label, Default: -0.35} + +\item{line.size}{overall line size, Default: 0.5} + +\item{dens.zero.col}{colour of line indicating zero, Default: 'black'} + +\item{dens.mean.col}{colour of line indicating mean value, Default: 'white'} + +\item{dens.median.col}{colour of line indicating median value, Default: 'white'} + +\item{dens.mode.col}{colour of line indicating mode value, Default: 'black'} + +\item{dens.rope.col}{colour of line indicating ROPE value, Default: 'black'} +} +\value{ +Density plot of parameter values +} +\description{ +Create a density plot with parameter values +} diff --git a/man/RemoveGarbage.Rd b/man/RemoveGarbage.Rd new file mode 100644 index 0000000..3db9fa3 --- /dev/null +++ b/man/RemoveGarbage.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{RemoveGarbage} +\alias{RemoveGarbage} +\title{Remove Garbage} +\usage{ +RemoveGarbage(v) +} +\arguments{ +\item{v}{variables to remove} +} +\description{ +Remove variable(s) and remove garbage from memory +} diff --git a/man/RunMCMC.Rd b/man/RunMCMC.Rd index 10be7ee..454799c 100644 --- a/man/RunMCMC.Rd +++ b/man/RunMCMC.Rd @@ -4,14 +4,17 @@ \alias{RunMCMC} \title{Run MCMC} \usage{ -RunMCMC(jags.model, params, name.list, data.list, initial.list, - run.contrasts, use.contrast, contrasts, run.ppp, n.data, credible.region, - save.data = FALSE, ROPE, merge.MCMC, run.diag, sep, - monochrome = TRUE, plot.colors = c("#495054", "#e3e8ea"), - graphic.type = "pdf", plot.size = "15,10", scaling = 100, - plot.aspect = NULL, vector.graphic = FALSE, point.size = 12, - font.type = "serif", one.file = TRUE, ppi = 300, units = "in", - layout = "a4", layout.inverse = FALSE, ...) +RunMCMC(jags.model, params = NULL, name.list, data.list, + initial.list = list(), run.contrasts = FALSE, + use.contrast = "between", contrasts = NULL, run.ppp = FALSE, + k.ppp = 10, n.data, credible.region = 0.95, save.data = FALSE, + ROPE = NULL, merge.MCMC = FALSE, run.diag = FALSE, + param.diag = NULL, sep = ",", monochrome = TRUE, + plot.colors = c("#495054", "#e3e8ea"), graphic.type = "pdf", + plot.size = "15,10", scaling = 100, plot.aspect = NULL, + vector.graphic = FALSE, point.size = 12, font.type = "serif", + one.file = TRUE, ppi = 300, units = "in", layout = "a4", + layout.inverse = FALSE, ...) } \arguments{ \item{jags.model}{specify which module to use} @@ -26,12 +29,14 @@ RunMCMC(jags.model, params, name.list, data.list, initial.list, \item{run.contrasts}{logical, indicating whether or not to run contrasts, Default: FALSE} -\item{use.contrast}{choose from "between", "within" and "mixed". Between compare groups at different conditions. Within compare a group at different conditions. Mixed compute all comparisons.} +\item{use.contrast}{choose from "between", "within" and "mixed". Between compare groups at different conditions. Within compare a group at different conditions. Mixed compute all comparisons, Default: "between",} \item{contrasts}{define contrasts to use for analysis (defaults to all) , Default: NULL} \item{run.ppp}{logical, indicating whether or not to conduct ppp analysis, Default: FALSE} +\item{k.ppp}{run ppp for every kth length of MCMC chains, Default: 10} + \item{n.data}{sample size for each parameter} \item{credible.region}{summarize uncertainty by defining a region of most credible values (e.g., 95 percent of the distribution), Default: 0.95} @@ -44,6 +49,8 @@ RunMCMC(jags.model, params, name.list, data.list, initial.list, \item{run.diag}{logical, indicating whether or not to run diagnostics, Default: FALSE} +\item{param.diag}{define parameters to use for diagnostics, default equals all parameters, Default: NULL} + \item{sep}{symbol to separate data (e.g., comma-delimited), Default: ','} \item{monochrome}{logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE} diff --git a/man/StatsBernoulli.Rd b/man/StatsBernoulli.Rd index 968e3e3..6f8b5f0 100644 --- a/man/StatsBernoulli.Rd +++ b/man/StatsBernoulli.Rd @@ -4,7 +4,8 @@ \alias{StatsBernoulli} \title{Bernoulli Trials} \usage{ -StatsBernoulli(x, x.names, DF, params, initial.list, ...) +StatsBernoulli(x = NULL, x.names = NULL, DF, params = NULL, + initial.list = list(), ...) } \arguments{ \item{x}{predictor variable(s), Default: NULL} diff --git a/man/StatsCovariate.Rd b/man/StatsCovariate.Rd index 529a0f6..a2618c4 100644 --- a/man/StatsCovariate.Rd +++ b/man/StatsCovariate.Rd @@ -4,7 +4,8 @@ \alias{StatsCovariate} \title{Covariate} \usage{ -StatsCovariate(y, y.names, x, x.names, DF, params, initial.list, +StatsCovariate(y = NULL, y.names = NULL, x = NULL, x.names = NULL, + DF, params = NULL, job.group = NULL, initial.list = list(), jags.model, ...) } \arguments{ @@ -20,6 +21,8 @@ StatsCovariate(y, y.names, x, x.names, DF, params, initial.list, \item{params}{define parameters to observe, Default: NULL} +\item{job.group}{for some hierarchical models with several layers of parameter names (e.g., latent and observed parameters), Default: NULL} + \item{initial.list}{initial values for analysis, Default: list()} \item{jags.model}{specify which module to use} diff --git a/man/StatsFit.Rd b/man/StatsFit.Rd index c9b87de..ce86ae7 100644 --- a/man/StatsFit.Rd +++ b/man/StatsFit.Rd @@ -4,12 +4,14 @@ \alias{StatsFit} \title{Fit Data} \usage{ -StatsFit(latent, latent.names, observed, observed.names, additional, - additional.names, DF, params, job.group, initial.list, model.name, - jags.model, custom.model, run.ppp, run.robust, ...) +StatsFit(latent = NULL, latent.names = NULL, observed = NULL, + observed.names = NULL, additional = NULL, additional.names = NULL, + DF, params = NULL, job.group = NULL, initial.list = list(), + model.name, jags.model, custom.model = NULL, run.ppp = FALSE, + run.robust = FALSE, ...) } \arguments{ -\item{latent}{laten variables, Default: NULL} +\item{latent}{latenr variables, Default: NULL} \item{latent.names}{optional names for for latent variables, Default: NULL} diff --git a/man/StatsKappa.Rd b/man/StatsKappa.Rd index 5ff7357..a80ff83 100644 --- a/man/StatsKappa.Rd +++ b/man/StatsKappa.Rd @@ -4,7 +4,8 @@ \alias{StatsKappa} \title{Cohen's Kappa} \usage{ -StatsKappa(x, x.names, DF, params, initial.list, ...) +StatsKappa(x = NULL, x.names = NULL, DF, params = NULL, + initial.list = list(), ...) } \arguments{ \item{x}{predictor variable(s), Default: NULL} diff --git a/man/StatsMean.Rd b/man/StatsMean.Rd index 3fb8857..909e140 100644 --- a/man/StatsMean.Rd +++ b/man/StatsMean.Rd @@ -4,7 +4,8 @@ \alias{StatsMean} \title{Mean Data} \usage{ -StatsMean(y, y.names, x, x.names, DF, params, initial.list, ...) +StatsMean(y = NULL, y.names = NULL, x = NULL, x.names = NULL, DF, + params = NULL, initial.list = list(), ...) } \arguments{ \item{y}{criterion variable(s), Default: NULL} diff --git a/man/StatsMetric.Rd b/man/StatsMetric.Rd index 2853e8d..61d0ca0 100644 --- a/man/StatsMetric.Rd +++ b/man/StatsMetric.Rd @@ -4,8 +4,9 @@ \alias{StatsMetric} \title{Predict Metric} \usage{ -StatsMetric(y, y.names, x, x.names, DF, params, job.group, initial.list, - model.name, jags.model, custom.model, run.robust, ...) +StatsMetric(y = NULL, y.names = NULL, x = NULL, x.names = NULL, DF, + params = NULL, job.group = NULL, initial.list = list(), model.name, + jags.model, custom.model = NULL, run.robust = FALSE, ...) } \arguments{ \item{y}{criterion variable(s), Default: NULL} diff --git a/man/StatsNominal.Rd b/man/StatsNominal.Rd index a088c62..80188b9 100644 --- a/man/StatsNominal.Rd +++ b/man/StatsNominal.Rd @@ -4,8 +4,9 @@ \alias{StatsNominal} \title{Predict Nominal} \usage{ -StatsNominal(x, x.names, DF, params, job.group, initial.list, model.name, - jags.model, custom.model, ...) +StatsNominal(x = NULL, x.names = NULL, DF, params = NULL, + job.group = NULL, initial.list = list(), model.name, jags.model, + custom.model = NULL, ...) } \arguments{ \item{x}{categorical variable(s), Default: NULL} diff --git a/man/StatsRegression.Rd b/man/StatsRegression.Rd index 28e14bb..57d897d 100644 --- a/man/StatsRegression.Rd +++ b/man/StatsRegression.Rd @@ -4,8 +4,9 @@ \alias{StatsRegression} \title{Regression} \usage{ -StatsRegression(y, y.names, x, x.names, x.steps, x.blocks, DF, params, - job.group, initial.list, ...) +StatsRegression(y = NULL, y.names = NULL, x = NULL, x.names = NULL, + x.steps = NULL, x.blocks = NULL, DF, params = NULL, + job.group = NULL, initial.list = list(), ...) } \arguments{ \item{y}{criterion variable(s), Default: NULL} diff --git a/man/StatsSoftmax.Rd b/man/StatsSoftmax.Rd index 989586b..bfee35a 100644 --- a/man/StatsSoftmax.Rd +++ b/man/StatsSoftmax.Rd @@ -4,8 +4,9 @@ \alias{StatsSoftmax} \title{Softmax Regression} \usage{ -StatsSoftmax(y, y.names, x, x.names, DF, params, job.group, initial.list, - run.robust, ...) +StatsSoftmax(y = NULL, y.names = NULL, x = NULL, x.names = NULL, + DF, params = NULL, job.group = NULL, initial.list = NULL, + run.robust = FALSE, ...) } \arguments{ \item{y}{criterion variable(s), Default: NULL} diff --git a/man/SumMCMC.Rd b/man/SumMCMC.Rd index a778ad6..6264d4d 100644 --- a/man/SumMCMC.Rd +++ b/man/SumMCMC.Rd @@ -5,7 +5,7 @@ \title{Summarize MCMC} \usage{ SumMCMC(par, par.names, job.names = NULL, job.group = NULL, - credible.region = 0.95, ROPE, n.data, ...) + credible.region = 0.95, ROPE = NULL, n.data, ...) } \arguments{ \item{par}{defined parameter} diff --git a/man/TidyCode.Rd b/man/TidyCode.Rd index 63b8956..d330550 100644 --- a/man/TidyCode.Rd +++ b/man/TidyCode.Rd @@ -9,7 +9,7 @@ TidyCode(tidy.code, jags = TRUE) \arguments{ \item{tidy.code}{Messy code that needs cleaning} -\item{jags}{logical. If TRUE run code as JAGS model, Default: TRUE} +\item{jags}{logical, if TRUE run code as JAGS model, Default: TRUE} } \value{ (Somewhat) tidy code diff --git a/man/TrimSplit.Rd b/man/TrimSplit.Rd index 96f6bbe..e2af876 100644 --- a/man/TrimSplit.Rd +++ b/man/TrimSplit.Rd @@ -16,7 +16,7 @@ TrimSplit(x, sep = ",", fixed = FALSE, perl = FALSE, \item{perl}{logical, indicating whether or not to use Perl-compatible regexps, Default: FALSE} -\item{useBytes}{logical. If TRUE the matching is done byte-by-byte rather than character-by-character, Default: FALSE} +\item{useBytes}{logical, if TRUE the matching is done byte-by-byte rather than character-by-character, Default: FALSE} \item{rm.empty}{logical. indicating whether or not to remove empty elements, Default: TRUE} } diff --git a/man/bfw.Rd b/man/bfw.Rd index f719e7e..b78effe 100644 --- a/man/bfw.Rd +++ b/man/bfw.Rd @@ -4,52 +4,17 @@ \alias{bfw} \title{Settings} \usage{ -bfw(y = NULL, y.names = NULL, x = NULL, x.names = NULL, - latent = NULL, latent.names = NULL, observed = NULL, - observed.names = NULL, additional = NULL, additional.names = NULL, - x.steps = NULL, x.blocks = NULL, job.title = NULL, - job.group = NULL, jags.model, jags.seed = NULL, jags.method = NULL, - jags.chains = NULL, custom.function = NULL, custom.model = NULL, - params = NULL, saved.steps = 10000, thinned.steps = 1, - adapt.steps = NULL, burnin.steps = NULL, credible.region = 0.95, - ROPE = NULL, run.contrasts = FALSE, use.contrast = "between", - contrasts = NULL, run.ppp = FALSE, initial.list = list(), - project.name = "Project", project.dir = "Results/", - project.data = NULL, time.stamp = TRUE, save.data = FALSE, - data.set = "AllData", data.format = "csv", raw.data = FALSE, - run.robust = FALSE, merge.MCMC = FALSE, run.diag = FALSE, - sep = ",", monochrome = TRUE, plot.colors = c("#495054", - "#e3e8ea"), graphic.type = "pdf", plot.size = "15,10", - scaling = 100, plot.aspect = NULL, vector.graphic = FALSE, - point.size = 12, font.type = "serif", one.file = TRUE, ppi = 300, - units = "in", layout = "a4", layout.inverse = FALSE, - silent = FALSE, ...) +bfw(job.title = NULL, job.group = NULL, jags.model, jags.seed = NULL, + jags.method = NULL, jags.chains = NULL, custom.function = NULL, + custom.model = NULL, params = NULL, saved.steps = 10000, + thinned.steps = 1, adapt.steps = NULL, burnin.steps = NULL, + initial.list = list(), project.name = "Project", + project.dir = "Results/", project.data = NULL, time.stamp = TRUE, + save.data = FALSE, data.set = "AllData", data.format = "csv", + raw.data = FALSE, run.robust = FALSE, merge.MCMC = FALSE, + run.diag = FALSE, sep = ",", silent = FALSE, ...) } \arguments{ -\item{y}{criterion variable(s), Default: NULL} - -\item{y.names}{optional names for criterion variable(s), Default: NULL} - -\item{x}{predictor variable(s), Default: NULL} - -\item{x.names}{optional names for predictor variable(s), Default: NULL} - -\item{latent}{latent variables, Default: NULL} - -\item{latent.names}{optional names for for latent variables, Default: NULL} - -\item{observed}{observed variable(s), Default: NULL} - -\item{observed.names}{optional names for for observed variable(s), Default: NULL} - -\item{additional}{supplemental parameters for fitted data (e.g., indirect pathways and total effect), Default: NULL} - -\item{additional.names}{optional names for supplemental parameters, Default: NULL} - -\item{x.steps}{define number of steps in hierarchical regression , Default: NULL} - -\item{x.blocks}{define which predictors are included in each step (e.g., for three steps "1,2,3") , Default: NULL} - \item{job.title}{title of analysis, Default: NULL} \item{job.group}{for some hierarchical models with several layers of parameter names (e.g., latent and observed parameters), Default: NULL} @@ -76,18 +41,6 @@ bfw(y = NULL, y.names = NULL, x = NULL, x.names = NULL, \item{burnin.steps}{the number of burnin iterations, NOT including the adaptive iterations to use for the simulation, Default: NULL} -\item{credible.region}{summarize uncertainty by defining a region of most credible values (e.g., 95 percent of the distribution), Default: 0.95} - -\item{ROPE}{define range for region of practical equivalence (e.g., c(-0.05 , 0.05), Default: NULL} - -\item{run.contrasts}{logical, indicating whether or not to run contrasts, Default: FALSE} - -\item{use.contrast}{choose from "between", "within" and "mixed". Between compare groups at different conditions. Within compare a group at different conditions. Mixed compute all comparisons} - -\item{contrasts}{define contrasts to use for analysis (defaults to all) , Default: NULL} - -\item{run.ppp}{logical, indicating whether or not to conduct ppp analysis, Default: FALSE} - \item{initial.list}{initial values for analysis, Default: list()} \item{project.name}{name of project, Default: 'Project'} @@ -114,35 +67,7 @@ bfw(y = NULL, y.names = NULL, x = NULL, x.names = NULL, \item{sep}{symbol to separate data (e.g., comma-delimited), Default: ','} -\item{monochrome}{logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE} - -\item{plot.colors}{range of color to use, Default: c("#495054", "#e3e8ea")} - -\item{graphic.type}{type of graphics to use (e.g., pdf, png, ps), Default: 'pdf'} - -\item{plot.size}{size of plot, Default: '15,10'} - -\item{scaling}{scale size of plot, Default: 100} - -\item{plot.aspect}{aspect of plot, Default: NULL} - -\item{vector.graphic}{logical, indicating whether or not visualizations should be vector or raster graphics, Default: FALSE} - -\item{point.size}{point size used for visualizations, Default: 12} - -\item{font.type}{font type used for visualizations, Default: 'serif'} - -\item{one.file}{logical, indicating whether or not visualizations should be placed in one or several files, Default: TRUE} - -\item{ppi}{define pixel per inch used for visualizations, Default: 300} - -\item{units}{define unit of length used for visualizations, Default: 'in'} - -\item{layout}{define a layout size for visualizations, Default: 'a4'} - -\item{layout.inverse}{logical, indicating whether or not to inverse layout (e.g., landscape) , Default: FALSE} - -\item{silent}{logical, indicating whether or not analysis should be run silent, Default: FALSE} +\item{silent}{logical, indicating whether or not to run analysis without output, Default: FALSE} \item{...}{further arguments passed to or from other methods} }