├── .Rbuildignore ├── .gitattributes ├── .gitignore ├── .local_checks ├── @making_BEST_package.R └── READ_ME.txt ├── DESCRIPTION ├── NAMESPACE ├── NEWS ├── R ├── BESTmcmc.R ├── BESTpower.R ├── converters.R ├── justRunJags.R ├── makeData.R ├── pairs.BEST.R ├── plot.BEST.R ├── plotAll.R ├── plotAreaInROPE.R ├── plotDataPPC.R ├── plotPost.R ├── plotPostPred.R ├── postPriorOverlap.R ├── print.BEST.R ├── sumPost.R └── summary.BEST.R ├── README.md ├── inst ├── WORDLIST └── tests │ └── testthat │ ├── test-BESTmcmc.R │ ├── test-BESTmcmc_errors.R │ ├── test-BESTmcmc_issues.R │ ├── test-BESTmcmc_priors.R │ ├── test-BESTpower.R │ └── test-summary.R ├── man ├── BEST-package.Rd ├── BESTmcmc.Rd ├── BESTpower.Rd ├── figures │ ├── BESTmodel.jpg │ ├── HDIbimodal.jpg │ ├── HDIskew.jpg │ ├── makeData.jpg │ ├── plotPost1.jpg │ └── plotPost2.jpg ├── makeData.Rd ├── pairs.BEST.Rd ├── plot.BEST.Rd ├── plotAll.Rd ├── plotAreaInROPE.Rd ├── plotPost.Rd ├── plotPostPred.Rd ├── postPriorOverlap.Rd ├── print.BEST.Rd └── summary.BEST.Rd └── vignettes ├── BEST.Rnw ├── BEST.bib └── BESTmodel.jpg /.Rbuildignore: -------------------------------------------------------------------------------- 1 | .gitattributes 2 | .gitignore 3 | .git 4 | oldNEWS 5 | README 6 | .local_checks 7 | README.md 8 | Rplots.pdf 9 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | *.sln merge=union 7 | *.csproj merge=union 8 | *.vbproj merge=union 9 | *.fsproj merge=union 10 | *.dbproj merge=union 11 | 12 | # Standard to msysgit 13 | *.doc diff=astextplain 14 | *.DOC diff=astextplain 15 | *.docx diff=astextplain 16 | *.DOCX diff=astextplain 17 | *.dot diff=astextplain 18 | *.DOT diff=astextplain 19 | *.pdf diff=astextplain 20 | *.PDF diff=astextplain 21 | *.rtf diff=astextplain 22 | *.RTF diff=astextplain 23 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ################# 2 | ## Eclipse 3 | ################# 4 | 5 | *.pydevproject 6 | .project 7 | .metadata 8 | bin/ 9 | tmp/ 10 | *.tmp 11 | *.bak 12 | *.swp 13 | *~.nib 14 | local.properties 15 | .classpath 16 | .settings/ 17 | .loadpath 18 | 19 | # External tool builders 20 | .externalToolBuilders/ 21 | 22 | # Locally stored "Eclipse launch configurations" 23 | *.launch 24 | 25 | # CDT-specific 26 | .cproject 27 | 28 | # PDT-specific 29 | .buildpath 30 | 31 | 32 | ################# 33 | ## Visual Studio 34 | ################# 35 | 36 | ## Ignore Visual Studio temporary files, build results, and 37 | ## files generated by popular Visual Studio add-ons. 38 | 39 | # User-specific files 40 | *.suo 41 | *.user 42 | *.sln.docstates 43 | 44 | # Build results 45 | 46 | [Dd]ebug/ 47 | [Rr]elease/ 48 | x64/ 49 | build/ 50 | [Bb]in/ 51 | [Oo]bj/ 52 | 53 | # MSTest test Results 54 | [Tt]est[Rr]esult*/ 55 | [Bb]uild[Ll]og.* 56 | 57 | *_i.c 58 | *_p.c 59 | *.ilk 60 | *.meta 61 | *.obj 62 | *.pch 63 | *.pdb 64 | *.pgc 65 | *.pgd 66 | *.rsp 67 | *.sbr 68 | *.tlb 69 | *.tli 70 | *.tlh 71 | *.tmp 72 | *.tmp_proj 73 | *.log 74 | *.vspscc 75 | *.vssscc 76 | .builds 77 | *.pidb 78 | *.log 79 | *.scc 80 | 81 | # Visual C++ cache files 82 | ipch/ 83 | *.aps 84 | *.ncb 85 | *.opensdf 86 | *.sdf 87 | *.cachefile 88 | 89 | # Visual Studio profiler 90 | *.psess 91 | *.vsp 92 | *.vspx 93 | 94 | # Guidance Automation Toolkit 95 | *.gpState 96 | 97 | # ReSharper is a .NET coding add-in 98 | _ReSharper*/ 99 | *.[Rr]e[Ss]harper 100 | 101 | # TeamCity is a build add-in 102 | _TeamCity* 103 | 104 | # DotCover is a Code Coverage Tool 105 | *.dotCover 106 | 107 | # NCrunch 108 | *.ncrunch* 109 | .*crunch*.local.xml 110 | 111 | # Installshield output folder 112 | [Ee]xpress/ 113 | 114 | # DocProject is a documentation generator add-in 115 | DocProject/buildhelp/ 116 | DocProject/Help/*.HxT 117 | DocProject/Help/*.HxC 118 | DocProject/Help/*.hhc 119 | DocProject/Help/*.hhk 120 | DocProject/Help/*.hhp 121 | DocProject/Help/Html2 122 | DocProject/Help/html 123 | 124 | # Click-Once directory 125 | publish/ 126 | 127 | # Publish Web Output 128 | *.Publish.xml 129 | *.pubxml 130 | 131 | # NuGet Packages Directory 132 | ## TODO: If you have NuGet Package Restore enabled, uncomment the next line 133 | #packages/ 134 | 135 | # Windows Azure Build Output 136 | csx 137 | *.build.csdef 138 | 139 | # Windows Store app package directory 140 | AppPackages/ 141 | 142 | # Others 143 | sql/ 144 | *.Cache 145 | ClientBin/ 146 | [Ss]tyle[Cc]op.* 147 | ~$* 148 | *~ 149 | *.dbmdl 150 | *.[Pp]ublish.xml 151 | *.pfx 152 | *.publishsettings 153 | 154 | # RIA/Silverlight projects 155 | Generated_Code/ 156 | 157 | # Backup & report files from converting an old project file to a newer 158 | # Visual Studio version. Backup files are not needed, because we have git ;-) 159 | _UpgradeReport_Files/ 160 | Backup*/ 161 | UpgradeLog*.XML 162 | UpgradeLog*.htm 163 | 164 | # SQL Server files 165 | App_Data/*.mdf 166 | App_Data/*.ldf 167 | 168 | ############# 169 | ## Windows detritus 170 | ############# 171 | 172 | # Windows image file caches 173 | Thumbs.db 174 | ehthumbs.db 175 | 176 | # Folder config file 177 | Desktop.ini 178 | 179 | # Recycle Bin used on file shares 180 | $RECYCLE.BIN/ 181 | 182 | # Mac crap 183 | .DS_Store 184 | 185 | 186 | ############# 187 | ## Python 188 | ############# 189 | 190 | *.py[co] 191 | 192 | # Packages 193 | *.egg 194 | *.egg-info 195 | dist/ 196 | build/ 197 | eggs/ 198 | parts/ 199 | var/ 200 | sdist/ 201 | develop-eggs/ 202 | .installed.cfg 203 | 204 | # Installer logs 205 | pip-log.txt 206 | 207 | # Unit test / coverage reports 208 | .coverage 209 | .tox 210 | 211 | #Translations 212 | *.mo 213 | 214 | #Mr Developer 215 | .mr.developer.cfg 216 | -------------------------------------------------------------------------------- /.local_checks/@making_BEST_package.R: -------------------------------------------------------------------------------- 1 | 2 | setwd("D:/Github/BEST_package") # my desktop 3 | setwd("C:/Github/BEST_package") # my laptop 4 | dir() 5 | 6 | library(spelling) 7 | update_wordlist(pkg = "BEST", confirm = TRUE) 8 | out <- spell_check_package(pkg = "BEST") 9 | 10 | devtools::load_all("C:/GitHub/BEST_package/BEST") 11 | system("R CMD INSTALL BEST") # Use this for a "dev" install. 12 | 13 | # To check the current CRAN version 14 | # --------------------------------- 15 | # download.packages("BEST", destdir=".", type="source") 16 | # pkg <- "BEST_0.5.2.tar.gz" 17 | 18 | # Create the BEST package 19 | # ========================== 20 | unlink(list.files(pattern="Rplots.pdf", recursive=TRUE)) 21 | system("R CMD build BEST") # Produces the .tar.gz 22 | pkg <- "BEST_0.5.4.tar.gz" # <-- fix version number here ################ 23 | 24 | # Pick one to check: 25 | ## on desktop 26 | system(paste("R CMD check ", pkg)) 27 | system(paste("R CMD check ", pkg, "--as-cran")) # as-cran now runs donttest 28 | ## on laptop 29 | system(paste("R CMD check ", pkg, "--no-manual")) 30 | system(paste("R CMD check ", pkg, "--as-cran --no-manual")) 31 | 32 | # Pick one to install 33 | system(paste("R CMD INSTALL ", pkg)) # install only 34 | system(paste("R CMD INSTALL ", pkg, "--build")) # install and produce the .zip binary 35 | 36 | 37 | 38 | library(testthat) 39 | test_package("BEST", reporter=ProgressReporter) 40 | 41 | # Try it out: 42 | library(BEST) 43 | ?BEST 44 | 45 | # Run these examples, we need the output: 46 | example("BEST-package") 47 | example(BESTpower) 48 | 49 | # Check that the power plots come up ok and results are saved: 50 | unlink("testSave.Rda") # delete any old testSave.Rda files 51 | system.time( 52 | BESTpower(BESTout, N1=length(y1), N2=length(y2), 53 | ROPEm=c(-0.1,0.1), maxHDIWm=2.0, nRep=2, 54 | saveName = "testSave.Rda", showFirst=2, verbose=1) 55 | ) 56 | load("testSave.Rda") 57 | power 58 | graphics.off() # Clean up 59 | unlink("testSave.Rda") # Clean up 60 | 61 | # Check that the plots look ok (auto-checks can't do that): 62 | example(plotPost) 63 | example(plotAreaInROPE) 64 | 65 | # Check parallel and verbose options 66 | y1 <- c(5.77, 5.33, 4.59, 4.33, 3.66, 4.48) 67 | y2 <- c(3.88, 3.55, 3.29, 2.59, 2.33, 3.59) 68 | 69 | system.time( 70 | BESToutP0 <- BESTmcmc(y1, y2, rnd.seed=123) ) # default (depends on machine) 71 | system.time( 72 | BESToutPT <- BESTmcmc(y1, y2, rnd.seed=123, parallel=TRUE) ) # 5 secs 73 | system.time( 74 | BESToutPF <- BESTmcmc(y1, y2, rnd.seed=123, parallel=FALSE) ) # 10 secs 75 | BESToutP0 76 | BESToutPT 77 | BESToutPF 78 | 79 | ( BESToutP0Q <- BESTmcmc(y1, y2, rnd.seed=123, verbose=FALSE) ) 80 | ( BESToutPQ <- BESTmcmc(y1, y2, rnd.seed=123, verbose=FALSE, parallel=TRUE) ) 81 | ( BESToutQ <- BESTmcmc(y1, y2, rnd.seed=123, verbose=FALSE, parallel=FALSE) ) 82 | 83 | # Check priors only 84 | ( BESToutPrior <- BESTmcmc(y1, y2, priors=list(), doPriorsOnly=TRUE, rnd.seed=123) ) 85 | plotAll(BESToutPrior) 86 | priors <- list(muSD = 10, sigmaMode = 10, sigmaSD = 100) 87 | ( BESToutPriorInf <- BESTmcmc(y1, y2, priors=priors, doPriorsOnly=TRUE, rnd.seed=123) ) 88 | plotAll(BESToutPriorInf) 89 | 90 | 91 | # Check small samples 92 | y1 <- 4 93 | y2 <- 5 94 | ( BESToutPs <- BESTmcmc(y1, y2, rnd.seed=123) ) 95 | ( BESTouts <- BESTmcmc(y1, y2, rnd.seed=123, parallel=FALSE) ) 96 | plot(BESToutPs) 97 | plotPostPred(BESToutPs) 98 | plotAll(BESToutPs) 99 | priors <- list(muSD = 100, sigmaMode = 10, sigmaSD = 100) 100 | ( BESTout2pi <- BESTmcmc(y1, y2, priors=priors, rnd.seed=123) ) 101 | plotAll(BESTout2pi) 102 | 103 | y <- 4:5 104 | ( BESTout1 <- BESTmcmc(y, rnd.seed=123) ) 105 | ( BESTout1p <- BESTmcmc(y, priors=list(), rnd.seed=123) ) 106 | plot(BESTout1p) 107 | plotPostPred(BESTout1p) 108 | priors <- list(muSD = 10, sigmaMode = 10, sigmaSD = 100) 109 | ( BESTout1pi <- BESTmcmc(y, priors=priors, rnd.seed=123) ) 110 | plotAll(BESTout1pi) 111 | y <- 4 112 | ( BESTout1pi <- BESTmcmc(y, priors=priors, rnd.seed=123) ) 113 | 114 | 115 | -------------------------------------------------------------------------------- /.local_checks/READ_ME.txt: -------------------------------------------------------------------------------- 1 | 2 | # These are checking scripts intended to pick up any unwanted changes to the functions or data sets. 3 | 4 | # They are not included in the package built for R. 5 | 6 | # They are included on Github so that we have the same, up to date versions across different computers. 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: BEST 2 | Type: Package 3 | Title: Bayesian Estimation Supersedes the t-Test 4 | Version: 0.5.4 5 | Depends: HDInterval 6 | Imports: coda, rjags 7 | Date: 2021-10-13 8 | Authors@R: c( 9 | person("John", "Kruschke", role="aut"), 10 | person("Mike", "Meredith", role=c("aut", "cre"), email="mike@mmeredith.net") ) 11 | BugReports: https://github.com/mikemeredith/BEST/issues 12 | Description: An alternative to t-tests, producing posterior estimates for group means and standard deviations and their differences and effect sizes. It implements the method of Kruschke (2013) Bayesian estimation supersedes the t test. Journal of Experimental Psychology: General, 142(2):573-603 . 13 | License: GPL (>= 3) 14 | Language: en-US 15 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Namespace for package BEST 2 | 3 | importFrom(rjags, jags.model, coda.samples) 4 | importFrom(stats, update) 5 | importFrom(parallel, detectCores, makeCluster, stopCluster, 6 | clusterEvalQ, parLapply) 7 | importFrom(coda, effectiveSize, gelman.diag) 8 | importFrom(HDInterval, hdi) 9 | 10 | import(stats, graphics, utils, grDevices) 11 | 12 | export(BESTmcmc, 13 | plotPost, plotAll, plotPostPred, plotAreaInROPE, postPriorOverlap, 14 | BESTpower, makeData) 15 | 16 | 17 | S3method("pairs", "BEST") 18 | S3method("plot", "BEST") 19 | S3method("print", "BEST") 20 | S3method("print", "summary.BEST") 21 | S3method("summary", "BEST") 22 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | Changes in version 0.5.4 (2021-10-13) 2 | 3 | * Fixed bug in 'plotAll' (reported by jlwoodard). 4 | 5 | * Specify 'col = NULL' for the histograms in 'plotPostPred' (default in 4.2.0 will be gray). 6 | 7 | * Added more options for the user to specify colors in the plots (thanks to Jan Vorhagen for the patches). 8 | 9 | * Fixed formatting of NEWS file. 10 | 11 | * Spellcheck with 'spelling' package: standardized on US spellings. 12 | 13 | * Now using Authors@R in DESCRIPTION file. 14 | 15 | Changes in version 0.5.3 (2021-05-17) 16 | 17 | * Examples no longer use parallel processing. 18 | 19 | * Fixed: rebuilding of vignette (thanks to Kurt Hornik for the fix). 20 | 21 | * Updated help page for 'BESTmcmc' to clarify difference between scale and SD for t-distribution. 22 | 23 | * Added citation for Krushke (2013) to Description in DESCRIPTION file (suggestion of Uwe Ligges). 24 | 25 | Changes in version 0.5.2 (2020-05-18) 26 | 27 | * Change of maintainer email. 28 | 29 | * Updated testthat tests for new default RNGkind from R 3.6.0. 30 | 31 | * Increased resolution of fitted density from n=512 to n=2048 to give better estimates 32 | of HDI. 33 | 34 | Changes in version 0.5.1 (2018-04-19) 35 | 36 | * Fixed issue with position of text on density plots. 37 | 38 | * plotAll and plotPostPred modified to show the data with an 'ordinary' histogram. 39 | 40 | * Warning if adaptation is not adequate (instead of "NOTE: Stopping adaptation"). 41 | 42 | Changes in version 0.5.0 (2017-05-28) 43 | 44 | * 'BESTmcmc' uses 'rjags' directly, instead of 'jagsUI' wrappers. This resolves 'set.seed' issues, but values returned will not be the same as with previous versions. 45 | 46 | * Function 'hdi' removed; imports HDInterval::hdi instead. 47 | 48 | Changes in version 0.4.0 (2015-12-28) 49 | 50 | * BESTmcmc now allows normality parameter, nu < 1 (See John Kruschke's blog post 2 Dec 2015). 51 | 52 | * Vignette updated to use new prior specification. 53 | 54 | Changes in version 0.3.0 (2015-06-29) 55 | 56 | * BESTmcmc 'showPriors' argument changed to 'doPriorsOnly'. 57 | 58 | * Function postPriorOverlap added. 59 | 60 | Changes in version 0.2.6 (2015-05-09) 61 | 62 | * BESTmcmc gains a 'showPriors' argument. 63 | 64 | * Removed constraints on small samples in BESTmcmc (n=1 is ok if priors are specified). 65 | 66 | * makeData throws an error if the number of outliers is 1. 67 | 68 | Changes in version 0.2.5 (2015-05-07) 69 | 70 | * Run chains in parallel using jagsUI (>= 1.3.6) instead of rjags. 71 | 72 | Changes in version 0.2.4 (2015-05-03) 73 | 74 | * Function BESTmcmc now allows user to specify priors. 75 | 76 | CHANGES in v.0.2.3 (2014-11-17) 77 | 78 | * Added sanity checks to BESTmcmc. 79 | 80 | Changes in version 0.2.2 (2014-06-06) 81 | 82 | * hdi gains a density method, which can handle discontinuous HDIs. This is 83 | used for the posterior density plots when showCurve = TRUE. 84 | 85 | * Enhancements to plots: 86 | o credMass = NULL suppresses plotting of the credible interval. 87 | o plotPost, the plot.BEST method, and plotAreaInROPE now make full 88 | use of the ... argument for additional graphical parameters. 89 | o default xlim for posterior density plots is now based on 99% HDI (not range). 90 | o plotPost and plot.BEST return an object of class 'histogram' invisibly. 91 | o plotPost deals properly with a vector of integers. 92 | 93 | Changes in version 0.2.0 (2013-08-23) 94 | 95 | * Added function plotAreaInROPE. 96 | 97 | * In BESTpower, call to x11() (which is platform specific) changed to dev.new(); 98 | in Rstudio, the plot is shown on active device. 99 | 100 | * BESTmcmc and BESTpower gain 'rnd.seed' arguments for reproducible output; 101 | testthat test files for BESTmcmc and BESTpower added. 102 | 103 | * makeData gains a showPlot argument. 104 | 105 | * Fixed bug in plot.BEST: the ... argument was not being passed to plotPost. 106 | 107 | * BESTmcmc has 'verbose' argument; setting verbose = FALSE (or 0) suppresses 108 | output to the Console (wish of Ben Marwick). 109 | 110 | * BESTpower also has 'verbose' argument; here verbose = 0 (or FALSE) 111 | suppresses all output, verbose = 1 (or TRUE) provides just a progress bar; 112 | verbose = 2 (the default) displays full details. 113 | -------------------------------------------------------------------------------- /R/BESTmcmc.R: -------------------------------------------------------------------------------- 1 | 2 | ### Parallel processing version using jagsUI::jags.basic 3 | 4 | BESTmcmc <- 5 | function( y1, y2=NULL, priors=NULL, doPriorsOnly=FALSE, 6 | numSavedSteps=1e5, thinSteps=1, burnInSteps = 1000, 7 | verbose=TRUE, rnd.seed=NULL, parallel=NULL) { 8 | # This function generates an MCMC sample from the posterior distribution. 9 | # y1, y2 the data vectors; y2=NULL if only one group. 10 | # priors is a list specifying priors to use. 11 | # verbose=FALSE suppresses output to the R Console. 12 | # rnd.seed is passed to each of the chains, with a different pseudorandom 13 | # number generator for each. 14 | # Returns a data frame, not a matrix, with class 'BEST', 15 | # with attributes Rhat, n.eff, a list with the original data, and the priors. 16 | #------------------------------------------------------------------------------ 17 | 18 | if(doPriorsOnly && verbose) 19 | cat("Warning: The output shows the prior distributions, 20 | NOT the posterior distributions for your data.\n") 21 | # Parallel processing check 22 | nCores <- detectCores() 23 | if(!is.null(parallel) && parallel && nCores < 4) { 24 | if(verbose) 25 | warning("Not enough cores for parallel processing, running chains sequentially.") 26 | parallel <- FALSE 27 | } 28 | if(is.null(parallel)) 29 | parallel <- nCores > 3 30 | 31 | # Data checks 32 | y <- c( y1 , y2 ) # combine data into one vector 33 | if(!all(is.finite(y))) 34 | stop("The input data include NA or Inf.") 35 | if(length(unique(y)) < 2 && # sd(y) will be 0 or NA; ok if priors specified. 36 | (is.null(priors) || 37 | is.null(priors$muSD) || 38 | is.null(priors$sigmaMode) || 39 | is.null(priors$sigmaSD))) 40 | stop("If priors are not specified, data must include at least 2 (non-equal) values.") 41 | 42 | # Prior checks: 43 | if(!is.null(priors)) { 44 | if(!is.list(priors)) { 45 | if(is.numeric(priors)) { 46 | stop("'priors' is now the 3rd argument; it must be a list (or NULL).") 47 | } else { 48 | stop("'priors' must be a list (or NULL).") 49 | } 50 | } 51 | nameOK <- names(priors) %in% 52 | c("muM", "muSD", "sigmaMode", "sigmaSD", "nuMean", "nuSD") 53 | if(!all(nameOK)) 54 | stop("Invalid items in prior specification: ", 55 | paste(sQuote(names(priors)[!nameOK]), collapse=", ")) 56 | if(!all(sapply(priors, is.numeric))) 57 | stop("All items in 'priors' must be numeric.") 58 | if(!is.null(priors$muSD) && priors$muSD <= 0) 59 | stop("muSD must be > 0") 60 | } 61 | 62 | # following code addresses Issue #7, but maybe not acceptable on CRAN 63 | # oldseed <- try(.Random.seed, silent=TRUE) 64 | # if(!inherits(oldseed, "try-error")) 65 | # on.exit(assign(".Random.seed", oldseed, pos=1) ) 66 | # if(is.null(rnd.seed)) 67 | # rnd.seed <- floor(runif(1,1,10000)) ### FIXME 68 | 69 | # THE PRIORS 70 | if(is.null(priors)) { # use the old prior specification 71 | dataForJAGS <- list( 72 | muM = mean(y) , 73 | muP = 0.000001 * 1/sd(y)^2 , 74 | sigmaLow = sd(y) / 1000 , 75 | sigmaHigh = sd(y) * 1000 76 | ) 77 | } else { # use gamma priors 78 | priors0 <- list( # default priors 79 | muM = mean(y) , 80 | muSD = sd(y)*5 , 81 | sigmaMode = sd(y), 82 | sigmaSD = sd(y)*5, 83 | nuMean = 30, 84 | nuSD = 30 ) 85 | priors0 <- modifyList(priors0, priors) # user's priors take prior-ity (duh!!) 86 | # Convert to Shape/Rate 87 | sigmaShRa <- gammaShRaFromModeSD(mode=priors0$sigmaMode, sd=priors0$sigmaSD) 88 | nuShRa <- gammaShRaFromMeanSD(mean=priors0$nuMean, sd=priors0$nuSD) 89 | dataForJAGS <- list( 90 | muM = priors0$muM, 91 | muP = 1/priors0$muSD^2, # convert SD to precision 92 | Sh = sigmaShRa$shape, 93 | Ra = sigmaShRa$rate) 94 | if(!is.null(y2)) { # all the above must be vectors of length 2 95 | fixPrior <- function(x) { 96 | if(length(x) < 2) 97 | x <- rep(x, 2) 98 | return(x) 99 | } 100 | dataForJAGS <- lapply(dataForJAGS, fixPrior) 101 | } 102 | dataForJAGS$ShNu <- nuShRa$shape 103 | dataForJAGS$RaNu <- nuShRa$rate 104 | } 105 | 106 | # THE MODEL. 107 | modelFile <- file.path(tempdir(), "BESTmodel.txt") 108 | if(is.null(priors)) { # use old broad priors 109 | if(is.null(y2)) { 110 | modelString = " 111 | model { 112 | for ( i in 1:Ntotal ) { 113 | y[i] ~ dt( mu , tau , nu ) 114 | } 115 | mu ~ dnorm( muM , muP ) 116 | tau <- 1/pow( sigma , 2 ) 117 | sigma ~ dunif( sigmaLow , sigmaHigh ) 118 | nu <- nuMinusOne+1 119 | nuMinusOne ~ dexp(1/29) 120 | } 121 | " # close quote for modelString, old priors, single sample 122 | } else { 123 | modelString <- " 124 | model { 125 | for ( i in 1:Ntotal ) { 126 | y[i] ~ dt( mu[x[i]] , tau[x[i]] , nu ) 127 | } 128 | for ( j in 1:2 ) { 129 | mu[j] ~ dnorm( muM , muP ) 130 | tau[j] <- 1/pow( sigma[j] , 2 ) 131 | sigma[j] ~ dunif( sigmaLow , sigmaHigh ) 132 | } 133 | nu <- nuMinusOne+1 134 | nuMinusOne ~ dexp(1/29) 135 | } 136 | " # close quote for modelString, old priors, two samples 137 | } 138 | } else { # use gamma priors 139 | if(is.null(y2)) { 140 | modelString = " 141 | model { 142 | for ( i in 1:Ntotal ) { 143 | y[i] ~ dt( mu , tau , nu ) 144 | } 145 | mu ~ dnorm( muM[1] , muP[1] ) 146 | tau <- 1/pow( sigma , 2 ) 147 | sigma ~ dgamma( Sh[1] , Ra[1] )T(0.0001, ) 148 | nu ~ dgamma( ShNu , RaNu )T(0.001, ) # prior for nu 149 | } 150 | " # close quote for modelString, new priors, single sample 151 | } else { 152 | modelString <- " 153 | model { 154 | for ( i in 1:Ntotal ) { 155 | y[i] ~ dt( mu[x[i]] , tau[x[i]] , nu ) 156 | } 157 | for ( j in 1:2 ) { 158 | mu[j] ~ dnorm( muM[j] , muP[j] ) 159 | tau[j] <- 1/pow( sigma[j] , 2 ) 160 | sigma[j] ~ dgamma( Sh[j] , Ra[j] )T(0.0001, ) 161 | } 162 | nu ~ dgamma( ShNu , RaNu )T(0.001, ) # prior for nu 163 | } 164 | " # close quote for modelString, new priors, two samples 165 | } 166 | } 167 | # Write out modelString to a text file 168 | writeLines( modelString , con=modelFile ) 169 | 170 | #------------------------------------------------------------------------------ 171 | # THE DATA. 172 | # dataForJAGS already has the priors, add the data: 173 | if(!doPriorsOnly) 174 | dataForJAGS$y <- y 175 | dataForJAGS$Ntotal <- length(y) 176 | if(!is.null(y2)) # create group membership code 177 | dataForJAGS$x <- c( rep(1,length(y1)) , rep(2,length(y2)) ) 178 | 179 | #------------------------------------------------------------------------------ 180 | # INTIALIZE THE CHAINS. 181 | # Initial values of MCMC chains based on data: 182 | if(is.null(y2)) { 183 | mu = mean(y1) 184 | sigma = sd(y1) 185 | } else { 186 | mu = c( mean(y1) , mean(y2) ) 187 | sigma = c( sd(y1) , sd(y2) ) 188 | } 189 | # Regarding initial values in next line: (1) sigma will tend to be too big if 190 | # the data have outliers, and (2) nu starts at 5 as a moderate value. These 191 | # initial values keep the burn-in period moderate. 192 | 193 | initList0 <- list(mu=mu, sigma=sigma) 194 | if(!is.null(rnd.seed)) 195 | initList0$.RNG.seed <- rnd.seed 196 | if(is.null(priors)) { 197 | initList0$nuMinusOne <- 4 198 | } else { 199 | initList0$nu <- 5 200 | } 201 | initList <- list( 202 | c(initList0, .RNG.name="base::Wichmann-Hill"), 203 | c(initList0, .RNG.name="base::Marsaglia-Multicarry"), 204 | c(initList0, .RNG.name="base::Super-Duper") ) 205 | #------------------------------------------------------------------------------ 206 | # RUN THE CHAINS 207 | codaSamples <- justRunJags( 208 | data = dataForJAGS, 209 | initList = initList, 210 | params = c( "mu" , "sigma" , "nu" ), # The parameters to be monitored 211 | modelFile = modelFile, 212 | chains = 3, # Do not change this without also changing inits. 213 | adapt = 500, # adaptation continues during burnin 214 | sample = numSavedSteps, 215 | burnin = burnInSteps, 216 | thin = thinSteps, 217 | parallel = parallel, 218 | seed = rnd.seed, 219 | verbose = verbose) 220 | #------------------------------------------------------------------------------ 221 | mcmcChain = as.matrix( codaSamples ) 222 | if(dim(mcmcChain)[2] == 5 && 223 | all(colnames(mcmcChain) == c("mu[1]", "mu[2]", "nu", "sigma[1]", "sigma[2]"))) 224 | colnames(mcmcChain) <- c("mu1", "mu2", "nu", "sigma1", "sigma2") 225 | mcmcDF <- as.data.frame(mcmcChain) 226 | class(mcmcDF) <- c("BEST", class(mcmcDF)) 227 | attr(mcmcDF, "call") <- match.call() 228 | attr(mcmcDF, "Rhat") <- gelman.diag(codaSamples)$psrf[, 1] 229 | attr(mcmcDF, "n.eff") <- effectiveSize(codaSamples) 230 | attr(mcmcDF, "data") <- list(y1 = y1, y2 = y2) 231 | attr(mcmcDF, "doPriorsOnly") <- doPriorsOnly 232 | if(!is.null(priors)) 233 | attr(mcmcDF, "priors") <- priors0 234 | 235 | return( mcmcDF ) 236 | } 237 | -------------------------------------------------------------------------------- /R/BESTpower.R: -------------------------------------------------------------------------------- 1 | BESTpower <- 2 | function( BESTobj, N1, N2, credMass=0.95, ROPEm, ROPEsd, ROPEeff, 3 | maxHDIWm, maxHDIWsd, maxHDIWeff, compValm=0, nRep=200, 4 | mcmcLength=10000, saveName=NULL, 5 | showFirstNrep=0, verbose=2, rnd.seed=NULL, parallel=NULL) { 6 | # This function estimates power. 7 | 8 | # Sanity checks: 9 | if(!inherits(BESTobj, "data.frame")) 10 | stop("BESTobj is not a valid BEST object") 11 | if(ncol(BESTobj) == 3 && all(colnames(BESTobj) == c("mu","nu","sigma"))) { 12 | oneGrp <- TRUE 13 | } else if (ncol(BESTobj) == 5 && all(colnames(BESTobj) == c("mu1", "mu2","nu","sigma1","sigma2"))) { 14 | oneGrp <- FALSE 15 | } else { 16 | stop("BESTobj is not a valid BEST object") 17 | } 18 | chainLength = NROW( BESTobj ) 19 | if(chainLength < nRep) 20 | stop(paste("BESTobj does not have enough values; needs", nRep)) 21 | if(credMass <= 0 || credMass >= 1) 22 | stop("credMass must lie between 0 and 1.") 23 | if(missing(N1)) 24 | N1 <- length(attr(BESTobj, "data")$y1) 25 | N1 <- rep(N1, length.out=nRep) 26 | #if(!oneGrp && length(N2) < nRep) 27 | if(!oneGrp) { 28 | if(missing(N2)) 29 | N2 <- length(attr(BESTobj, "data")$y2) 30 | N2 <- rep(N2, length.out=nRep) 31 | } 32 | 33 | # Deal with missing or invalid arguments for criteria: 34 | wanted <- rep(TRUE, 12) 35 | if(missing(ROPEm) || length(ROPEm) != 2) { 36 | wanted[1:3] <- FALSE 37 | ROPEm <- c(NA_real_, NA_real_) 38 | } 39 | if(missing(ROPEsd) || length(ROPEsd) != 2) { 40 | wanted[5:7] <- FALSE 41 | ROPEsd <- c(NA_real_, NA_real_) 42 | } 43 | if(missing(ROPEeff) || length(ROPEeff) != 2) { 44 | wanted[9:11] <- FALSE 45 | ROPEeff <- c(NA_real_, NA_real_) 46 | } 47 | if(missing(maxHDIWm) || maxHDIWm <= 0) { 48 | wanted[4] <- FALSE 49 | maxHDIWm <- NA_real_ 50 | } 51 | if(missing(maxHDIWsd) || maxHDIWsd <= 0) { 52 | wanted[8] <- FALSE 53 | maxHDIWsd <- NA_real_ 54 | } 55 | if(missing(maxHDIWeff) || maxHDIWeff <= 0) { 56 | wanted[12] <- FALSE 57 | maxHDIWeff <- NA_real_ 58 | } 59 | if(!any(wanted)) 60 | stop("No valid criteria set.") 61 | 62 | # Deal with random number seeds 63 | if(!is.null(rnd.seed)) { 64 | set.seed(rnd.seed[1], "Mersenne-Twister") 65 | if(length(rnd.seed) != nRep) 66 | rnd.seed <- sample.int(1e6, nRep) 67 | on.exit(set.seed(NULL, "default")) 68 | } 69 | 70 | # Select thinned steps in chain for posterior predictions: 71 | stepIdxVec = seq( 1 , chainLength , floor(chainLength/nRep) )[1:nRep] 72 | paramDF <- BESTobj[stepIdxVec, ] 73 | 74 | goalTally <- numeric(12) 75 | power <- matrix(NA, 12, 3) 76 | colnames(power) <- c("mean", "CrIlo", "CrIhi") # "CrI", cos too many HDIs already! 77 | rownames(power) <- c( 78 | " mean: HDI > ROPE", 79 | " mean: HDI < ROPE", 80 | " mean: HDI in ROPE", 81 | " mean: HDI width ok", 82 | " sd: HDI > ROPE", 83 | " sd: HDI < ROPE", 84 | " sd: HDI in ROPE", 85 | " sd: HDI width ok", 86 | "effect: HDI > ROPE", 87 | "effect: HDI < ROPE", 88 | "effect: HDI in ROPE", 89 | "effect: HDI width ok") 90 | 91 | if(verbose == 1) { 92 | pb <- txtProgressBar(style = 3) 93 | on.exit(close(pb)) 94 | } 95 | for (i in 1:nRep) { 96 | if(verbose > 1) { 97 | cat( "\n:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::\n" ) 98 | cat( paste( "Power computation: Simulated Experiment" , i , "of" , 99 | nRep , ":\n\n" ) ) 100 | flush.console() 101 | } 102 | # Get parameter values for this simulation: 103 | if(oneGrp) { 104 | mu1Val = paramDF[i,"mu"] 105 | sigma1Val = paramDF[i,"sigma"] 106 | } else { 107 | mu1Val = paramDF[i,"mu1"] 108 | mu2Val = paramDF[i,"mu2"] 109 | sigma1Val = paramDF[i,"sigma1"] 110 | sigma2Val = paramDF[i,"sigma2"] 111 | } 112 | nuVal = paramDF[i,"nu"] 113 | # Generate simulated data: 114 | y1 <- rt(N1[i], df=nuVal) * sigma1Val + mu1Val 115 | y2 <- if(oneGrp) NULL else rt(N2[i], df=nuVal) * sigma2Val + mu2Val 116 | # Get posterior for simulated data: 117 | simChain <- BESTmcmc( y1, y2, numSavedSteps=mcmcLength, thinSteps=1, 118 | verbose=verbose > 1, rnd.seed=rnd.seed[i], parallel=parallel) 119 | if (i <= showFirstNrep ) { 120 | # x11() # Deprecated as "platform specific" in R 3.1 121 | dev.new() # Doesn't work properly in Rstudio: gives warning and plots to old device. 122 | plotAll(simChain, ROPEm=ROPEm, ROPEsd=ROPEsd, ROPEeff=ROPEeff, 123 | compValm=compValm) 124 | mtext(paste("Simulation", i), outer=TRUE, line=-1, font=4) 125 | } 126 | #simChain <- as.matrix(Bout) 127 | # Get the HDIs for each parameter: 128 | if(oneGrp) { 129 | HDIm <- hdi(simChain$mu, credMass=credMass) 130 | HDIsd <- hdi(simChain$sigma, credMass=credMass) 131 | mu0 <- if(is.null(compValm)) 0 else compValm 132 | HDIeff <- hdi((simChain$mu - mu0) / simChain$sigma, 133 | credMass=credMass) 134 | } else { 135 | HDIm <- hdi(simChain$mu1 - simChain$mu2, credMass=credMass) 136 | HDIsd = hdi(simChain$sigma1 - simChain$sigma2, 137 | credMass=credMass) 138 | HDIeff = hdi(( simChain$mu1 - simChain$mu2 ) / 139 | sqrt( ( simChain$sigma1^2 + simChain$sigma2^2 ) / 2 ), 140 | credMass=credMass) 141 | } 142 | # Assess which goals were achieved and tally them: 143 | goalTally <- goalTally + c( 144 | HDIm[1] > ROPEm[2], 145 | HDIm[2] < ROPEm[1], 146 | HDIm[1] > ROPEm[1] & HDIm[2] < ROPEm[2], 147 | HDIm[2] - HDIm[1] < maxHDIWm, 148 | HDIsd[1] > ROPEsd[2], 149 | HDIsd[2] < ROPEsd[1], 150 | HDIsd[1] > ROPEsd[1] & HDIsd[2] < ROPEsd[2], 151 | HDIsd[2] - HDIsd[1] < maxHDIWsd, 152 | HDIeff[1] > ROPEeff[2], 153 | HDIeff[2] < ROPEeff[1], 154 | HDIeff[1] > ROPEeff[1] & HDIeff[2] < ROPEeff[2], 155 | HDIeff[2] - HDIeff[1] < maxHDIWeff ) 156 | 157 | s1 = 1 + goalTally 158 | s2 = 1 + i - goalTally 159 | power[,1] = s1/(s1+s2) 160 | for ( j in which(wanted)) { 161 | power[j, 2:3] = hdi( qbeta , shape1=s1[j] , shape2=s2[j] ) 162 | } 163 | if(verbose > 1) { 164 | cat( "\nAfter", i, "Simulated Experiments, Posterior Probability 165 | of meeting each criterion is (mean and 95% CrI):\n" ) 166 | print(round(power[wanted, ], 3)) 167 | flush.console() 168 | } 169 | if(verbose == 1) 170 | setTxtProgressBar(pb, i/nRep) 171 | 172 | if(!is.null(saveName)) 173 | save( i , power , file=saveName ) 174 | } 175 | return(invisible(power)) 176 | } 177 | -------------------------------------------------------------------------------- /R/converters.R: -------------------------------------------------------------------------------- 1 | 2 | # Function for shape and rate parameters of gamma. From DBDA2E-utilities.R; see 3 | # p. 238 of "Doing Bayesian Data Analysis" Second Edition, 4 | # https://sites.google.com/site/doingbayesiandataanalysis/ 5 | 6 | # Modified by MM to accept mode/mean and sd as vectors 7 | 8 | # Not exported. 9 | 10 | gammaShRaFromModeSD = function( mode , sd ) { 11 | # if ( mode <=0 ) stop("mode must be > 0") 12 | # if ( sd <=0 ) stop("sd must be > 0") 13 | if ( any(mode <= 0) ) stop("mode of gamma prior must be > 0") 14 | if ( any(sd <= 0) ) stop("sd of gamma prior must be > 0") 15 | rate = ( mode + sqrt( mode^2 + 4 * sd^2 ) ) / ( 2 * sd^2 ) 16 | shape = 1 + mode * rate 17 | return( list( shape=shape , rate=rate ) ) 18 | } 19 | 20 | gammaShRaFromMeanSD = function( mean , sd ) { 21 | # if ( mean <=0 ) stop("mean must be > 0") 22 | # if ( sd <=0 ) stop("sd must be > 0") 23 | if ( any(mean <= 0) ) stop("mean of gamma prior must be > 0") 24 | if ( any(sd <= 0) ) stop("sd of gamma prior must be > 0") 25 | shape = mean^2/sd^2 26 | rate = mean/sd^2 27 | return( list( shape=shape , rate=rate ) ) 28 | } 29 | 30 | -------------------------------------------------------------------------------- /R/justRunJags.R: -------------------------------------------------------------------------------- 1 | 2 | # Functions to run JAGS via 'rjags' with no extra features/annoyances 3 | 4 | # data, params, modelFile have the usual meanings 5 | # initList must be a list with one component per chain (NOT a function) 6 | # sample = the number of values required 7 | # adapt, burnin - note that adaptation contines during the burn-in phase. 8 | 9 | # Run JAGS in serial mode. 10 | 11 | # This function is also called (with chains=1) to run JAGS in each worker. 12 | # Note that initList MUST be the first argument to work with parLapply. 13 | justRunJagsSerial <- function(initList, data, params, modelFile, 14 | chains, sample, burnin, adapt=1000, thin=1) { 15 | jm <- rjags::jags.model(modelFile, data, initList, n.chains=chains, n.adapt=0) 16 | update(jm, adapt + burnin) 17 | if(!rjags::adapt(jm, 0, end.adaptation=TRUE)) 18 | warning("Adaptation was not adequate.") 19 | cat("\nSampling from the posterior distributions:\n") 20 | rjags::coda.samples(jm, params, n.iter=ceiling(sample / chains) * thin, thin=thin) 21 | } 22 | # --------------------------------------------------------------- 23 | 24 | # The main function to run JAGS 25 | 26 | justRunJags <- function(data, initList, params, modelFile, 27 | chains, sample, burnin, thin=1, adapt = 1000, 28 | parallel = NULL, seed=NULL, verbose=verbose) { 29 | 30 | if(parallel) { ##### Do the parallel stuff ##### 31 | if(verbose) { 32 | message("Waiting for parallel processing to complete...", appendLF=FALSE) 33 | flush.console() 34 | } 35 | cl <- makeCluster(3) ; on.exit(stopCluster(cl)) 36 | clusterEvalQ(cl, library(rjags)) 37 | chainList <- parLapply(cl, initList, justRunJagsSerial, data=data, params=params, 38 | modelFile=modelFile, chains=1, sample=ceiling(sample / chains), burnin=burnin, adapt=adapt, thin=thin) 39 | mcmcList <- coda::mcmc.list(lapply(chainList, function(x) x[[1]])) 40 | if(verbose) 41 | message("done.") 42 | } else { ##### Do the serial stuff ##### 43 | if(verbose) { 44 | mcmcList <- justRunJagsSerial(initList, data=data, params=params, modelFile=modelFile, 45 | chains=chains, sample=sample, burnin=burnin, adapt=adapt, thin=thin) 46 | } else { 47 | null <- capture.output( 48 | mcmcList <- justRunJagsSerial(initList, data=data, params=params, modelFile=modelFile, 49 | chains=chains, sample=sample, burnin=burnin, adapt=adapt, thin=thin) ) 50 | } 51 | } 52 | 53 | invisible(mcmcList) 54 | } 55 | -------------------------------------------------------------------------------- /R/makeData.R: -------------------------------------------------------------------------------- 1 | makeData <- 2 | function( mu1 , sd1 , mu2=NULL , sd2=NULL , nPerGrp , 3 | pcntOut=0 , sdOutMult=2.0 , 4 | rnd.seed=NULL, showPlot=TRUE ) { 5 | # Auxilliary function for generating random values from a 6 | # mixture of normal distibutions. 7 | 8 | oneGrp <- is.null(mu2) || is.null(sd2) 9 | if(!is.null(rnd.seed)){set.seed(rnd.seed)} # Set seed for random values. 10 | nOut = ceiling(nPerGrp*pcntOut/100) # Number of outliers. 11 | nIn = nPerGrp - nOut # Number from main distribution. 12 | 13 | # Sanity checks 14 | if ( pcntOut > 100 || pcntOut < 0 ) 15 | stop("pcntOut must be between 0 and 100.") 16 | if ( pcntOut > 0 && pcntOut < 1 ) 17 | warning("pcntOut is specified as percentage 0-100, not proportion 0-1.") 18 | if ( pcntOut > 50 ) 19 | warning("pcntOut indicates more than 50% outliers; did you intend this?") 20 | if ( nOut < 2 && pcntOut > 0 ) 21 | stop("Combination of nPerGrp and pcntOut yields too few outliers.") 22 | if ( nIn < 2 ) 23 | stop("Combination of nPerGrp and pcntOut yields too few non-outliers.") 24 | 25 | sdN = function( x ) 26 | sqrt( mean( (x-mean(x))^2 ) ) 27 | exactify <- function(x, mean, sd) # Scale to exact mean and sdN. 28 | (x - mean(x))/sdN(x) * sd + mean 29 | 30 | y1 <- exactify(rnorm(n=nIn), mu1, sd1) # main distribution 31 | if(nOut > 0) 32 | y1 <- c(y1, exactify(rnorm(n=nOut), mu1, sd1*sdOutMult)) # outliers 33 | if(oneGrp) { 34 | y2 <- NULL 35 | } else { 36 | y2 <- exactify(rnorm(n=nIn), mu2, sd2) 37 | if(nOut > 0) 38 | y2 <- c(y2, exactify(rnorm(n=nOut), mu2, sd2*sdOutMult)) 39 | } 40 | # 41 | if(showPlot) { 42 | # Set up window and layout: 43 | opar <- par(mfrow=c(1,1)) ; on.exit(par(opar)) 44 | if(!oneGrp) 45 | par(mfrow=2:1) 46 | # layout(matrix(1:2,nrow=2)) 47 | histInfo = hist( y1 , main="Simulated Data" , col="pink2" , border="white" , 48 | xlim=range(c(y1,y2)) , breaks=30 , prob=TRUE ) 49 | text( max(c(y1,y2)) , max(histInfo$density) , 50 | bquote(N==.(nPerGrp)) , adj=c(1,1) ) 51 | xlow=min(histInfo$breaks) 52 | xhi=max(histInfo$breaks) 53 | xcomb=seq(xlow,xhi,length=1001) 54 | lines( xcomb , dnorm(xcomb,mean=mu1,sd=sd1)*nIn/(nIn+nOut) + 55 | dnorm(xcomb,mean=mu1,sd=sd1*sdOutMult)*nOut/(nIn+nOut) , lwd=3 ) 56 | lines( xcomb , dnorm(xcomb,mean=mu1,sd=sd1)*nIn/(nIn+nOut) , 57 | lty="dashed" , col="blue", lwd=3) 58 | lines( xcomb , dnorm(xcomb,mean=mu1,sd=sd1*sdOutMult)*nOut/(nIn+nOut) , 59 | lty="dashed" , col="red", lwd=3) 60 | if(!oneGrp) { 61 | histInfo = hist( y2 , main="" , col="pink2" , border="white" , 62 | xlim=range(c(y1,y2)) , breaks=30 , prob=TRUE ) 63 | text( max(c(y1,y2)) , max(histInfo$density) , 64 | bquote(N==.(nPerGrp)) , adj=c(1,1) ) 65 | xlow=min(histInfo$breaks) 66 | xhi=max(histInfo$breaks) 67 | xcomb=seq(xlow,xhi,length=1001) 68 | lines( xcomb , dnorm(xcomb,mean=mu2,sd=sd2)*nIn/(nIn+nOut) + 69 | dnorm(xcomb,mean=mu2,sd=sd2*sdOutMult)*nOut/(nIn+nOut) , lwd=3) 70 | lines( xcomb , dnorm(xcomb,mean=mu2,sd=sd2)*nIn/(nIn+nOut) , 71 | lty="dashed" , col="blue", lwd=3) 72 | lines( xcomb , dnorm(xcomb,mean=mu2,sd=sd2*sdOutMult)*nOut/(nIn+nOut) , 73 | lty="dashed" , col="red", lwd=3) 74 | } 75 | } 76 | # 77 | return( list( y1=y1 , y2=y2 ) ) 78 | } 79 | -------------------------------------------------------------------------------- /R/pairs.BEST.R: -------------------------------------------------------------------------------- 1 | pairs.BEST <- 2 | function(x, nPtToPlot = 1000, col="skyblue", ...) { 3 | # Plot the parameters pairwise, to see correlations 4 | 5 | # Sanity checks: 6 | if(!inherits(x, "data.frame")) 7 | stop("x is not a valid BEST object") 8 | if(ncol(x) == 3 && all(colnames(x) == c("mu","nu","sigma"))) { 9 | oneGrp <- TRUE 10 | } else if (ncol(x) == 5 && all(colnames(x) == c("mu1", "mu2","nu","sigma1","sigma2"))) { 11 | oneGrp <- FALSE 12 | } else { 13 | stop("x is not a valid BEST object") 14 | } 15 | 16 | nuCol <- which(colnames(x) == "nu") 17 | mcmcChain <- cbind(x[, -nuCol], log10(x$nu)) 18 | #plotIdx = floor(seq(1, nrow(mcmcChain),by=nrow(mcmcChain)/nPtToPlot)) #TODO Use length.out 19 | plotIdx = floor(seq(1, nrow(mcmcChain), length.out=nPtToPlot)) #TODO Use length.out 20 | 21 | panel.cor = function(x, y, digits=2, prefix="", cex.cor, ...) { 22 | usr = par("usr"); on.exit(par(usr)) 23 | par(usr = c(0, 1, 0, 1)) 24 | r = (cor(x, y)) 25 | txt = format(c(r, 0.123456789), digits=digits)[1] 26 | txt = paste(prefix, txt, sep="") 27 | if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt) # cex.cor is now cruft? 28 | text(0.5, 0.5, txt, cex=1.25 ) # was cex=cex.cor*r 29 | } 30 | if(oneGrp) { 31 | labels <- c( expression(mu), 32 | expression(sigma), 33 | expression(log10(nu)) ) 34 | } else { 35 | labels <- c( expression(mu[1]) , expression(mu[2]) , 36 | expression(sigma[1]) , expression(sigma[2]) , 37 | expression(log10(nu)) ) 38 | } 39 | pairs( mcmcChain[plotIdx, ] , labels=labels, 40 | lower.panel=panel.cor, col=col, ... ) 41 | } 42 | -------------------------------------------------------------------------------- /R/plot.BEST.R: -------------------------------------------------------------------------------- 1 | plot.BEST <- 2 | function(x, which=c("mean", "sd", "effect", "nu"), credMass=0.95, 3 | ROPE=NULL, compVal=0, showCurve=FALSE, 4 | mainColor="skyblue", dataColor="red", comparisonColor="darkgreen", ROPEColor = "darkred", 5 | ...) { 6 | # This function plots the posterior distribution for one selected item. 7 | # Description of arguments: 8 | # x is mcmc.list object of the type returned by function BESTmcmc. 9 | # which indicates which item should be displayed; possible values are "mean", "sd", 10 | # "effect" or "nu". 11 | # ROPE is a two element vector, such as c(-1,1), specifying the limit 12 | # of the ROPE. 13 | # compVal is a scalar specifying the value for comparison. 14 | # showCurve if TRUE the posterior should be displayed as a fitted density curve 15 | # instead of a histogram (default). 16 | 17 | # TODO additional sanity checks. 18 | # Sanity checks: 19 | if(!inherits(x, "data.frame")) 20 | stop("x is not a valid BEST object") 21 | if(ncol(x) == 3 && all(colnames(x) == c("mu","nu","sigma"))) { 22 | oneGrp <- TRUE 23 | } else if (ncol(x) == 5 && all(colnames(x) == c("mu1", "mu2","nu","sigma1","sigma2"))) { 24 | oneGrp <- FALSE 25 | } else { 26 | stop("x is not a valid BEST object") 27 | } 28 | 29 | # Deal with ... argument 30 | dots <- list(...) 31 | if(length(dots) == 1 && class(dots[[1]]) == "list") 32 | dots <- dots[[1]] 33 | 34 | whichID <- match.arg(which) 35 | 36 | toPlot <- switch(whichID, 37 | mean = if(oneGrp) x$mu else x$mu1 - x$mu2, 38 | sd = if(oneGrp) x$sigma else x$sigma1 - x$sigma2, 39 | effect = if(oneGrp) (x$mu - compVal) / x$sigma else 40 | (x$mu1 - x$mu2) / 41 | sqrt( ( x$sigma1^2 + x$sigma2^2 ) / 2 ), 42 | nu = log10(x$nu) ) 43 | 44 | if(is.null(dots$main)) 45 | dots$main <- switch(whichID, 46 | mean = if(oneGrp) "Mean" else "Difference of Means", 47 | sd = if(oneGrp) "Standard Deviation" else "Difference of Std. Dev.s", 48 | effect = "Effect Size", 49 | nu = "Normality") 50 | 51 | if(is.null(dots$xlab)) 52 | dots$xlab <- switch(whichID, 53 | mean = if(oneGrp) bquote(mu) else bquote(mu[1] - mu[2]), 54 | sd = if(oneGrp) bquote(sigma) else bquote(sigma[1] - sigma[2]), 55 | effect = if(oneGrp) bquote( (mu-.(compVal)) / sigma ) else 56 | bquote( (mu[1]-mu[2]) / sqrt((sigma[1]^2 +sigma[2]^2 )/2 ) ), 57 | nu = bquote("log10("*nu*")")) 58 | 59 | if(whichID=="nu" && !is.null(compVal) && compVal == 0) 60 | compVal <- NULL 61 | if(whichID=="sd" && oneGrp && !is.null(compVal) && compVal == 0) 62 | compVal <- NULL 63 | # Plot posterior distribution of selected item: 64 | histinfo <- plotPost(toPlot, credMass=credMass, ROPE=ROPE, showCurve=showCurve, 65 | showMode=whichID != "mean", 66 | compVal=compVal, graphPars=dots, 67 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 68 | 69 | return(invisible(histinfo)) 70 | } 71 | -------------------------------------------------------------------------------- /R/plotAll.R: -------------------------------------------------------------------------------- 1 | # Post. pred. plots modified 14 Aug 2017 to show the data as an ordinary histogram. 2 | 3 | plotAll <- 4 | function(BESTobj, credMass=0.95, 5 | ROPEm=NULL, ROPEsd=NULL, ROPEeff=NULL, 6 | compValm=0, compValsd=NULL, compValeff=0, 7 | showCurve=FALSE, 8 | mainColor="skyblue", dataColor="red", comparisonColor="darkgreen", ROPEColor = "darkred", 9 | ...) { 10 | # This function plots the posterior distribution (and data). It does not 11 | # produce a scatterplot matrix; use pairs(...) for that. 12 | # Description of arguments: 13 | # BESTobj is BEST object of the type returned by function BESTmcmc. 14 | # ROPEm is a two element vector, such as c(-1,1), specifying the limit 15 | # of the ROPE on the difference of means. 16 | # ROPEsd is a two element vector, such as c(-1,1), specifying the limit 17 | # of the ROPE on the difference of standard deviations. 18 | # ROPEeff is a two element vector, such as c(-1,1), specifying the limit 19 | # of the ROPE on the effect size. 20 | # showCurve if TRUE the posterior should be displayed as a fitted density curve 21 | # instead of a histogram (default). 22 | 23 | # Sanity checks: 24 | if(!inherits(BESTobj, "data.frame")) 25 | stop("BESTobj is not a valid BEST object") 26 | if(ncol(BESTobj) == 3 && all(colnames(BESTobj) == c("mu","nu","sigma"))) { 27 | oneGrp <- TRUE 28 | colnames(BESTobj) <- c("mu1","nu","sigma1") 29 | } else if (ncol(BESTobj) == 5 && all(colnames(BESTobj) == c("mu1", "mu2","nu","sigma1","sigma2"))) { 30 | oneGrp <- FALSE 31 | } else { 32 | stop("BESTobj is not a valid BEST object") 33 | } 34 | 35 | # Set up window and layout 36 | # ------------------------ 37 | # windows(width=6.0,height=8.0) # Better to use default plot window. 38 | oldpar <- par(mar=c(3.5,3.5,2.5,0.5), mgp=c(2.25,0.7,0), "mfrow") 39 | on.exit(par(oldpar)) 40 | if(oneGrp) { 41 | layout( matrix( c(3,3,4,4,5,5, 1,1,1,1,2,2) , nrow=6, ncol=2 , byrow=FALSE ) ) 42 | } else { 43 | layout( matrix( c(4,5,7,8,3,1,2,6,9,10) , nrow=5, byrow=FALSE ) ) 44 | } 45 | 46 | # Do posterior predictive curve plots 47 | # ----------------------------------- 48 | data <- attr(BESTobj, "data") 49 | 50 | # Select thinned steps in chain for plotting of posterior predictive curves: 51 | chainLength <- NROW( BESTobj ) 52 | nCurvesToPlot <- 30 53 | stepIdxVec <- seq(1, chainLength, length.out=nCurvesToPlot) 54 | toPlot <- BESTobj[stepIdxVec, ] 55 | 56 | plotDataPPC(toPlot=toPlot, oneGrp=oneGrp, data=data, lineColor = mainColor, dataColor=dataColor) 57 | 58 | # Plot posterior distributions and their differences 59 | # -------------------------------------------------- 60 | # Plot posterior distribution of parameter nu: 61 | plotPost( log10(BESTobj$nu) , 62 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor, 63 | credMass=credMass, 64 | showCurve=showCurve , 65 | xlab=bquote("log10("*nu*")") , cex.lab = 1.75 , showMode=TRUE , 66 | main="Normality" ) # (<0.7 suggests kurtosis) 67 | 68 | # Plot posterior distribution of parameters mu1, mu2, and their difference: 69 | xlim <- range(BESTobj$mu1, BESTobj$mu2) 70 | if(oneGrp) { 71 | plotPost( BESTobj$mu1 , xlim=xlim , cex.lab = 1.75 , credMass=credMass, 72 | showCurve=showCurve , ROPE=ROPEm, compVal=compValm, 73 | xlab=bquote(mu) , main="Mean" , 74 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 75 | } else { 76 | plotPost( BESTobj$mu1 , xlim=xlim , cex.lab = 1.75 , credMass=credMass, 77 | showCurve=showCurve , 78 | xlab=bquote(mu[1]) , main=paste("Group",1,"Mean") , 79 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 80 | plotPost( BESTobj$mu2 , xlim=xlim , cex.lab = 1.75 , credMass=credMass, 81 | showCurve=showCurve , 82 | xlab=bquote(mu[2]) , main=paste("Group",2,"Mean") , 83 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 84 | plotPost( BESTobj$mu1-BESTobj$mu2 , compVal=compValm , showCurve=showCurve , credMass=credMass, 85 | xlab=bquote(mu[1] - mu[2]) , cex.lab = 1.75 , ROPE=ROPEm , 86 | main="Difference of Means" , 87 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 88 | } 89 | 90 | # Plot posterior distribution of param's sigma1, sigma2, and their difference: 91 | xlim <- range(BESTobj$sigma1, BESTobj$sigma2) 92 | if(oneGrp) { 93 | plotPost(BESTobj$sigma1, xlim=xlim, cex.lab = 1.75, credMass=credMass, 94 | showCurve=showCurve, ROPE=ROPEsd, compVal=compValsd, 95 | xlab=bquote(sigma) , main="Std. Dev." , 96 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor, 97 | showMode=TRUE ) 98 | } else { 99 | plotPost( BESTobj$sigma1 , xlim=xlim , cex.lab = 1.75 , credMass=credMass, 100 | showCurve=showCurve , 101 | xlab=bquote(sigma[1]) , main=paste("Group",1,"Std. Dev.") , 102 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor, 103 | showMode=TRUE ) 104 | plotPost( BESTobj$sigma2 , xlim=xlim , cex.lab = 1.75 , credMass=credMass, 105 | showCurve=showCurve , 106 | xlab=bquote(sigma[2]) , main=paste("Group",2,"Std. Dev.") , 107 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor, 108 | showMode=TRUE ) 109 | plotPost( BESTobj$sigma1-BESTobj$sigma2 , credMass=credMass, 110 | compVal=compValsd , showCurve=showCurve , 111 | xlab=bquote(sigma[1] - sigma[2]) , cex.lab = 1.75 , 112 | ROPE=ROPEsd , 113 | main="Difference of Std. Dev.s" , 114 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor, 115 | showMode=TRUE ) 116 | } 117 | 118 | # Plot effect size 119 | # ---------------- 120 | # Effect size for 1 group: 121 | if(oneGrp) { 122 | effectSize = ( BESTobj$mu1 - compValm ) / BESTobj$sigma1 123 | plotPost( effectSize , compVal=compValeff , ROPE=ROPEeff , credMass=credMass, 124 | showCurve=showCurve , 125 | xlab=bquote( (mu-.(compValm)) / sigma ), 126 | showMode=TRUE , cex.lab=1.75 , main="Effect Size" , 127 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 128 | } else { 129 | # Plot of estimated effect size. Effect size is d-sub-a from 130 | # Macmillan & Creelman, 1991; Simpson & Fitter, 1973; Swets, 1986a, 1986b. 131 | effectSize <- ( BESTobj$mu1 - BESTobj$mu2 ) / sqrt( ( BESTobj$sigma1^2 + BESTobj$sigma2^2 ) / 2 ) 132 | plotPost( effectSize , compVal=compValeff , ROPE=ROPEeff , credMass=credMass, 133 | showCurve=showCurve , 134 | xlab=bquote( (mu[1]-mu[2]) 135 | /sqrt((sigma[1]^2 +sigma[2]^2 )/2 ) ), 136 | showMode=TRUE , cex.lab=1.0 , main="Effect Size" , 137 | mainColor = mainColor, comparisonColor = comparisonColor, ROPEColor = ROPEColor) 138 | } 139 | # Or use sample-size weighted version: 140 | # Hedges 1981; Wetzels, Raaijmakers, Jakab & Wagenmakers 2009. 141 | # N1 = length(y1) 142 | # N2 = length(y2) 143 | # effectSize = ( mu1 - mu2 ) / sqrt( ( sigma1^2 *(N1-1) + sigma2^2 *(N2-1) ) 144 | # / (N1+N2-2) ) 145 | # Be sure also to change BESTsummary function, above. 146 | # histInfo = plotPost( effectSize , compVal=0 , ROPE=ROPEeff , 147 | # showCurve=showCurve , 148 | # xlab=bquote( (mu[1]-mu[2]) 149 | # /sqrt((sigma[1]^2 *(N[1]-1)+sigma[2]^2 *(N[2]-1))/(N[1]+N[2]-2)) ), 150 | # showMode=TRUE , cex.lab=1.0 , main="Effect Size" , col=mainColor ) 151 | return(invisible(NULL)) 152 | } 153 | -------------------------------------------------------------------------------- /R/plotAreaInROPE.R: -------------------------------------------------------------------------------- 1 | plotAreaInROPE <- 2 | function(paramSampleVec, credMass = 0.95, compVal = 0, maxROPEradius, 3 | n = 201, plot = TRUE, 4 | ROPEColor = "darkred", ...) { 5 | # Plots the probability mass included in the ROPE as a function of 6 | # the half-width of the ROPE. 7 | 8 | # Sanity checks: 9 | if(missing(maxROPEradius)) 10 | stop("maxROPEradius is missing with no default.") 11 | if(!isTRUE(maxROPEradius > 0)) 12 | stop("maxROPEradius must be > 0.") 13 | if(!isTRUE(is.finite(compVal))) 14 | stop("A finite value for compVal is needed.") 15 | 16 | ropeRadVec = seq( 0 , maxROPEradius , length=n ) # arbitrary comb 17 | areaInRope = rep( NA , n ) 18 | for ( rIdx in 1:n ) { 19 | areaInRope[rIdx] <- mean( paramSampleVec > (compVal-ropeRadVec[rIdx]) 20 | & paramSampleVec < (compVal+ropeRadVec[rIdx]) ) 21 | } 22 | 23 | if(plot) { 24 | # Deal with ... argument: 25 | dots <- list(...) 26 | if(length(dots) == 1 && class(dots[[1]]) == "list") 27 | dots <- dots[[1]] 28 | defaultArgs <- list(xlab=bquote("Radius of ROPE around "*.(compVal)), 29 | ylab="Posterior in ROPE", type="l", lwd=4, col=ROPEColor, cex.lab=1.5) 30 | useArgs <- modifyList(defaultArgs, dots) 31 | useArgs$x <- ropeRadVec 32 | useArgs$y <- areaInRope 33 | do.call("plot", useArgs, quote=TRUE) 34 | HDIlim = hdi( paramSampleVec , credMass=credMass ) 35 | farHDIlim = HDIlim[which.max(abs(HDIlim-compVal))] 36 | ropeRadHDI = abs(compVal-farHDIlim) 37 | areaInFarHDIlim <- mean( paramSampleVec > (compVal-ropeRadHDI) 38 | & paramSampleVec < (compVal+ropeRadHDI) ) 39 | lines( c(ropeRadHDI, ropeRadHDI) , c(-0.5, areaInFarHDIlim) , 40 | lty="dashed" , col=ROPEColor ) 41 | text( ropeRadHDI , 0 , 42 | bquote( atop( .(100*credMass)*"% HDI limit" , 43 | "farthest from "*.(compVal) ) ) , adj=c(0.5,0) ) 44 | lines( c(-0.5, ropeRadHDI) ,c(areaInFarHDIlim, areaInFarHDIlim) , 45 | lty="dashed" , col=ROPEColor ) 46 | text( 0 , areaInFarHDIlim , bquote(.(signif(areaInFarHDIlim, 3))) , 47 | adj=c(0, 1.1) ) 48 | } 49 | 50 | invisible( list( x=ropeRadVec , y=areaInRope ) ) 51 | } 52 | -------------------------------------------------------------------------------- /R/plotDataPPC.R: -------------------------------------------------------------------------------- 1 | # Function rewritten 11 Aug 2017 to deal with the whole process of doing 1 or 2 plots 2 | # with same xlim and ylim parameters. 3 | 4 | plotDataPPC <- 5 | function(toPlot, oneGrp, data, 6 | lineColor= 'skyblue', dataColor='red') { 7 | # Does the plots of posterior predictive curves for one OR TWO samples 8 | # Called by plotAll and plotPostPred; no sanity checks; not exported. 9 | # Calling function should arrange for multiple plots with par(mfrow) or layout. 10 | # Now DOES do title and sample size. 11 | # toPlot : a data frame with parameters to use for the t-curves; for one sample case, 12 | # colnames should be c("mu1","nu","sigma1") 13 | # oneGroup : TRUE for 1 group, FALSE for 2 14 | # data : list with components y1 and y2, y2 should be NULL in the one-sample case. 15 | 16 | # Work out the x axis limits 17 | if(is.null(data$y1) && is.null(data$y2)) { 18 | xRange <- range(toPlot$mu1, toPlot$mu2) 19 | } else { 20 | # Get the breaks for the histograms, both must be same 21 | breaks <- hist(c(data$y1, data$y2), plot=FALSE)$breaks 22 | xRange <- range(breaks) 23 | } 24 | xLim <- c( xRange[1]-0.1*diff(xRange) , 25 | xRange[2]+0.1*diff(xRange) ) 26 | 27 | # Prepare the stuff to plot, so we can get the y axis limit 28 | npoints <- 100 29 | nlines <- nrow(toPlot) 30 | nplots <- if(oneGrp) 1 else 2 31 | xVec <- seq(xLim[1], xLim[2], length=npoints) 32 | PPDmat <- array(NA, c(npoints, nlines, nplots)) 33 | for(i in 1:nlines) 34 | PPDmat[, i, 1] <- dt( (xVec-toPlot$mu1[i])/toPlot$sigma1[i], df=toPlot$nu[i] )/toPlot$sigma1[i] 35 | if(!oneGrp) 36 | for(i in 1:nlines) 37 | PPDmat[, i, 2] <- dt( (xVec-toPlot$mu2[i])/toPlot$sigma2[i], df=toPlot$nu[i] )/toPlot$sigma2[i] 38 | hist1 <- hist2 <- NULL 39 | if(!is.null(data$y1)) 40 | hist1 <- hist(data$y1, breaks=breaks, plot=FALSE) 41 | if(!is.null(data$y2)) 42 | hist2 <- hist(data$y2, breaks=breaks, plot=FALSE) 43 | # Now get y axis limit 44 | maxY <- max(PPDmat, hist1$density, hist2$density) 45 | 46 | # Do first plot 47 | plot(xVec[1], 0, xlim=range(xVec), ylim=c(0, maxY), cex.lab=1.75, 48 | type="n", xlab="y", ylab="p(y)", lwd=1) 49 | if(oneGrp) { 50 | title(main="Data w. Post. Pred.") 51 | if(!is.null(data$y1)) 52 | text( max(xVec) , maxY , bquote(N ==.(length(data$y1))) , adj=c(1.1,1.1) ) 53 | } else { 54 | title(main="Data Group 1 w. Post. Pred.") 55 | if(!is.null(data$y1)) 56 | text( max(xVec) , maxY , bquote(N[1]==.(length(data$y1))) , adj=c(1.1,1.1) ) 57 | } 58 | matlines(x=xVec, y=PPDmat[, , 1], lty=1, col=lineColor) 59 | if(!is.null(hist1)) { 60 | op <- par(lwd=2) 61 | plot(hist1, freq=FALSE, border=dataColor, col=NULL, add=TRUE) 62 | segments(x0=xVec[1], y0=0, x1=xVec[npoints], col=dataColor) 63 | par(op) 64 | } 65 | # Maybe do second plot 66 | if(!oneGrp) { 67 | plot(xVec[1], 0, xlim=range(xVec), ylim=c(0, maxY), cex.lab=1.75, 68 | type="n", xlab="y", ylab="p(y)") 69 | title(main="Data Group 2 w. Post. Pred.") 70 | if(!is.null(data$y2)) 71 | text( max(xVec) , maxY , bquote(N[2]==.(length(data$y2))) , adj=c(1.1,1.1) ) 72 | 73 | matlines(x=xVec, y=PPDmat[, , 2], lty=1, col=lineColor) 74 | if(!is.null(hist2)) { 75 | op <- par(lwd=2) 76 | plot(hist2, freq=FALSE, border=dataColor, col=NULL, add=TRUE) 77 | segments(x0=xVec[1], y0=0, x1=xVec[npoints], col=dataColor) 78 | par(op) 79 | } 80 | } 81 | } 82 | -------------------------------------------------------------------------------- /R/plotPost.R: -------------------------------------------------------------------------------- 1 | # Original code by John Kruschke, modified by Mike. 2 | 3 | plotPost <- 4 | function( paramSampleVec, credMass=0.95, compVal=NULL, ROPE=NULL, 5 | HDItextPlace=0.7, showMode=FALSE, showCurve=FALSE, 6 | mainColor="skyblue", comparisonColor="darkgreen", ROPEColor = "darkred", 7 | ... ) { 8 | 9 | # Does a plot for a single parameter. Called by plot.BEST but also exported. 10 | # Returns a histogram object invisibly. 11 | # This stuff should be in the ... argument: 12 | # yaxt="n", ylab="", xlab="Parameter", main="", cex.lab=1.5, cex=1.4, 13 | # xlim=range(compVal, paramSampleVec), col=mainColor, border="white", 14 | # breaks=NULL 15 | 16 | # Deal with ... argument: 17 | dots <- list(...) 18 | if(length(dots) == 1 && class(dots[[1]]) == "list") 19 | dots <- dots[[1]] 20 | defaultArgs <- list(xlab=deparse(substitute(paramSampleVec)), 21 | yaxt="n", ylab="", main="", cex.lab=1.5, 22 | cex=1.4, col=mainColor, border="white", bty="n", lwd=5, freq=FALSE, 23 | xlim=range(compVal, hdi(paramSampleVec, 0.99))) 24 | useArgs <- modifyList(defaultArgs, dots) 25 | 26 | # Get breaks argument 27 | breaks <- dots$breaks 28 | if (is.null(breaks)) { 29 | if (all(paramSampleVec == round(paramSampleVec))) { # all integers 30 | breaks <- seq(min(paramSampleVec), max(paramSampleVec) + 1) - 0.5 31 | } else { 32 | by <- diff(hdi(paramSampleVec))/18 33 | breaks <- unique(c( seq( from=min(paramSampleVec), to=max(paramSampleVec), 34 | by=by), max(paramSampleVec) )) 35 | } 36 | } 37 | histinfo <- hist(paramSampleVec, breaks=breaks, plot=FALSE) 38 | histinfo$xname <- useArgs$xlab 39 | 40 | oldpar <- par(xpd=TRUE) ; on.exit(par(oldpar)) 41 | 42 | if (showCurve) { 43 | densCurve <- density( paramSampleVec, adjust=2, n=2048 ) 44 | cenTendHt <- 0.9 * max(densCurve$y) 45 | selPlot <- names(useArgs) %in% 46 | c(names(as.list(args(plot.default))), names(par(no.readonly=TRUE))) 47 | plotArgs <- useArgs[selPlot] 48 | plotArgs$x <- densCurve$x 49 | plotArgs$y <- densCurve$y 50 | plotArgs$type <- "l" 51 | plotArgs$xpd <- FALSE 52 | do.call(plot, plotArgs, quote=TRUE) 53 | abline(h=0, col='grey', xpd=FALSE) 54 | # Display the HDI. 55 | if(!is.null(credMass)) { 56 | HDI <- hdi(densCurve, credMass, allowSplit=TRUE) 57 | ht <- attr(HDI, "height") 58 | segments(HDI[, 1], ht, HDI[, 2], ht, lwd=4, lend='butt') 59 | segments(HDI, 0, HDI, ht, lty=2) 60 | text( mean(HDI), ht, bquote(.(100*credMass) * "% HDI" ), 61 | adj=c(.5,-1.7), cex=useArgs$cex ) 62 | text( HDI, ht, bquote(.(signif(HDI, 3))), 63 | pos=3, cex=useArgs$cex ) 64 | } 65 | } else { 66 | cenTendHt <- 0.9 * max(histinfo$density) 67 | plot.histogram.args.names <- c("freq", "density", "angle", "border", 68 | "main", "sub", "xlab", "ylab", "xlim", "ylim", "axes", "labels", 69 | "add") # plot.histogram not exported, so need to cheat! 70 | selPlot <- names(useArgs) %in% 71 | c(plot.histogram.args.names, names(par(no.readonly=TRUE))) 72 | plotArgs <- useArgs[selPlot] 73 | plotArgs$lwd <- 1 74 | plotArgs$x <- histinfo 75 | do.call(plot, plotArgs, quote=TRUE) 76 | # Display the HDI. 77 | if(!is.null(credMass)) { 78 | HDI <- hdi( paramSampleVec, credMass ) 79 | lines(HDI, c(0,0), lwd=4, lend='butt') 80 | text( mean(HDI), 0, bquote(.(100*credMass) * "% HDI" ), 81 | adj=c(.5,-1.7), cex=useArgs$cex ) 82 | text( HDI[1], 0, bquote(.(signif(HDI[1],3))), 83 | adj=c(HDItextPlace,-0.5), cex=useArgs$cex ) 84 | text( HDI[2], 0, bquote(.(signif(HDI[2],3))), 85 | adj=c(1.0-HDItextPlace,-0.5), cex=useArgs$cex ) 86 | } 87 | } 88 | 89 | 90 | # Display mean or mode: 91 | if ( showMode==FALSE ) { 92 | meanParam <- mean( paramSampleVec ) 93 | text( meanParam, cenTendHt, 94 | bquote(mean==.(signif(meanParam,3))), adj=c(.5,0), cex=useArgs$cex ) 95 | } else { 96 | dres <- density( paramSampleVec ) 97 | modeParam <- dres$x[which.max(dres$y)] 98 | text( modeParam, cenTendHt, 99 | bquote(mode==.(signif(modeParam,3))), adj=c(.5,0), cex=useArgs$cex ) 100 | } 101 | # Display the comparison value. 102 | if ( !is.null( compVal ) ) { 103 | cvHt <- 0.7 * max(histinfo$density) 104 | cvCol <- comparisonColor 105 | pcgtCompVal <- round( 100 * sum( paramSampleVec > compVal ) 106 | / length( paramSampleVec ) , 1 ) 107 | pcltCompVal <- 100 - pcgtCompVal 108 | lines( c(compVal,compVal), c(0.96*cvHt,0), 109 | lty="dotted", lwd=1, col=cvCol ) 110 | text( compVal, cvHt, 111 | bquote( .(pcltCompVal)*"% < " * 112 | .(signif(compVal,3)) * " < "*.(pcgtCompVal)*"%" ), 113 | adj=c(pcltCompVal/100,0), cex=0.8*useArgs$cex, col=cvCol ) 114 | } 115 | # Display the ROPE. 116 | if ( !is.null( ROPE ) ) { 117 | ROPEtextHt <- 0.55 * max(histinfo$density) 118 | ropeCol <- ROPEColor 119 | pcInROPE <- ( sum( paramSampleVec > ROPE[1] & paramSampleVec < ROPE[2] ) 120 | / length( paramSampleVec ) ) 121 | lines( c(ROPE[1],ROPE[1]), c(0.96*ROPEtextHt,0), lty="dotted", lwd=2, 122 | col=ropeCol ) 123 | lines( c(ROPE[2],ROPE[2]), c(0.96*ROPEtextHt,0), lty="dotted", lwd=2, 124 | col=ropeCol) 125 | text( mean(ROPE), ROPEtextHt, 126 | bquote( .(round(100*pcInROPE))*"% in ROPE" ), 127 | adj=c(.5,0), cex=1, col=ropeCol ) 128 | } 129 | 130 | return(invisible(histinfo)) 131 | } 132 | -------------------------------------------------------------------------------- /R/plotPostPred.R: -------------------------------------------------------------------------------- 1 | # Changed 11 Aug 2017 to show data as a typical histogram 2 | 3 | plotPostPred <- 4 | function(BESTobj, nCurvesToPlot = 30, 5 | mainColor="skyblue", dataColor="red") { 6 | # This function plots the posterior predictive distribution and the data. 7 | # Description of arguments: 8 | # BESTobj is mcmc.list object of the type returned by function BESTmcmc. 9 | 10 | # Sanity checks: 11 | if(!inherits(BESTobj, "data.frame")) 12 | stop("BESTobj is not a valid BEST object") 13 | if(ncol(BESTobj) == 3 && all(colnames(BESTobj) == c("mu","nu","sigma"))) { 14 | oneGrp <- TRUE 15 | colnames(BESTobj) <- c("mu1","nu","sigma1") 16 | } else if (ncol(BESTobj) == 5 && all(colnames(BESTobj) == c("mu1", "mu2","nu","sigma1","sigma2"))) { 17 | oneGrp <- FALSE 18 | } else { 19 | stop("BESTobj is not a valid BEST object") 20 | } 21 | 22 | 23 | # mcmcChain <- as.matrix(BESTobj) 24 | data <- attr(BESTobj, "data") 25 | 26 | # Set up window and layout: 27 | oldpar <- par(mar=c(3.5,3.5,2.5,0.5), mgp=c(2.25,0.7,0), "mfrow") 28 | on.exit(par(oldpar)) 29 | if(!oneGrp) 30 | par(mfrow=2:1) 31 | 32 | # Select thinned steps in chain for plotting of posterior predictive curves: 33 | stepIdxVec <- seq(1, NROW( BESTobj ), length= nCurvesToPlot) 34 | toPlot <- BESTobj[stepIdxVec, ] 35 | 36 | plotDataPPC(toPlot=toPlot, oneGrp=oneGrp, data=data, lineColor = mainColor , dataColor = dataColor) 37 | 38 | } 39 | -------------------------------------------------------------------------------- /R/postPriorOverlap.R: -------------------------------------------------------------------------------- 1 | postPriorOverlap <- 2 | function( paramSampleVec, prior, ..., yaxt="n", ylab="", 3 | xlab="Parameter", main="", cex.lab=1.5, cex=1.4, 4 | xlim=range(paramSampleVec), breaks=NULL, 5 | mainColor="skyblue", priorColor="yellow", overlapColor="green") { 6 | 7 | # Does a posterior histogram for a single parameter, adds the prior, 8 | # displays and calculates the overlap. 9 | # Returns the overlap. 10 | 11 | oldpar <- par(xpd=NA) ; on.exit(par(oldpar)) 12 | 13 | # get breaks: a sensible number over the hdi; cover the full range (and no more); 14 | # equal spacing. 15 | if (is.null(breaks)) { 16 | nbreaks <- ceiling(diff(range(paramSampleVec)) / as.numeric(diff(hdi(paramSampleVec))/18)) 17 | breaks <- seq(from=min(paramSampleVec), to=max(paramSampleVec), length.out=nbreaks) 18 | } 19 | # plot posterior histogram. 20 | histinfo <- hist(paramSampleVec, xlab=xlab, yaxt=yaxt, ylab=ylab, 21 | freq=FALSE, border='white', col=mainColor, 22 | xlim=xlim, main=main, cex=cex, cex.lab=cex.lab, 23 | breaks=breaks) 24 | 25 | if (is.numeric(prior)) { 26 | # plot the prior if it's numeric 27 | priorInfo <- hist(prior, breaks=c(-Inf, breaks, Inf), add=TRUE, 28 | freq=FALSE, col=priorColor, border='white')$density[2:length(breaks)] 29 | } else if (is.function(prior)) { 30 | if(class(try(prior(0.5, ...), TRUE)) == "try-error") 31 | stop(paste("Incorrect arguments for the density function", substitute(prior))) 32 | priorInfo <- prior(histinfo$mids, ...) 33 | } 34 | # get (and plot) the overlap 35 | minHt <- pmin(priorInfo, histinfo$density) 36 | rect(breaks[-length(breaks)], rep(0, length(breaks)-1), breaks[-1], minHt, col=overlapColor, 37 | border='white') 38 | overlap <- sum(minHt * diff(histinfo$breaks)) 39 | # Add curve if prior is a function 40 | if (is.function(prior)) 41 | lines(histinfo$mids, priorInfo, lwd=2, col=priorColor) 42 | # Add text 43 | text(mean(breaks), 0, paste0("overlap = ", round(overlap*100), "%"), pos=3, cex=cex) 44 | 45 | return(overlap) 46 | } 47 | -------------------------------------------------------------------------------- /R/print.BEST.R: -------------------------------------------------------------------------------- 1 | print.BEST <- function(x, digits=4, ...) { 2 | # Somewhat less quick and dirty print method for BEST objects. 3 | 4 | # Sanity checks: 5 | if(!inherits(x, "data.frame")) 6 | stop("x is not a valid BEST object") 7 | if(ncol(x) == 3 && all(colnames(x) == c("mu","nu","sigma"))) { 8 | oneGrp <- TRUE 9 | } else if (ncol(x) == 5 && all(colnames(x) == c("mu1", "mu2","nu","sigma1","sigma2"))) { 10 | oneGrp <- FALSE 11 | } else { 12 | stop("x is not a valid BEST object") 13 | } 14 | 15 | Rhat <- attr(x, "Rhat") 16 | n.eff <- attr(x, "n.eff") 17 | doPriorsOnly <- attr(x, "doPriorsOnly") 18 | 19 | toPrint <- cbind( 20 | mean = colMeans(x), 21 | sd = apply(x, 2, sd), 22 | median = apply(x, 2, median), 23 | t(hdi(x))) 24 | colnames(toPrint)[4:5] <- c("HDIlo", "HDIup") 25 | if(!is.null(Rhat)) 26 | toPrint <- cbind(toPrint, Rhat = Rhat) 27 | if(!is.null(n.eff)) 28 | toPrint <- cbind(toPrint, n.eff = round(n.eff)) 29 | 30 | if(!is.null(doPriorsOnly) && doPriorsOnly) { 31 | cat("MCMC fit results for BEST: PRIORS ONLY!\n") 32 | } else { 33 | cat("MCMC fit results for BEST analysis:\n") 34 | } 35 | cat(nrow(x), "simulations saved.\n") 36 | print(toPrint, digits = digits) 37 | cat("\n'HDIlo' and 'HDIup' are the limits of a 95% HDI credible interval.\n") 38 | if(!is.null(Rhat)) 39 | cat("'Rhat' is the potential scale reduction factor (at convergence, Rhat=1).\n") 40 | if(!is.null(n.eff)) 41 | cat("'n.eff' is a crude measure of effective sample size.\n") 42 | 43 | } 44 | -------------------------------------------------------------------------------- /R/sumPost.R: -------------------------------------------------------------------------------- 1 | sumPost <- 2 | function(paramSampleVec, credMass=0.95, compVal=NULL, ROPE=NULL) { 3 | # Gets summary information for a single parameter; 4 | # called by summary.BEST; not exported. 5 | postSummary <- rep(NA, 11) 6 | names(postSummary) <- c("mean","median","mode", 7 | "hdiMass","hdiLow","hdiHigh", 8 | "compVal","pcGTcompVal", 9 | "ROPElow","ROPEhigh","pcInROPE") 10 | postSummary["mean"] <- mean(paramSampleVec) 11 | postSummary["median"] <- median(paramSampleVec) 12 | mcmcDensity <- density(paramSampleVec) 13 | postSummary["mode"] <- mcmcDensity$x[which.max(mcmcDensity$y)] 14 | 15 | HDI <- hdi(paramSampleVec, credMass) 16 | postSummary["hdiMass"] <- credMass * 100 17 | postSummary["hdiLow"] <- HDI[1] 18 | postSummary["hdiHigh"] <- HDI[2] 19 | 20 | if (!is.null(compVal)) { 21 | postSummary["compVal"] <- compVal 22 | postSummary["pcGTcompVal"] <- mean(paramSampleVec > compVal) * 100 23 | } 24 | 25 | if (!is.null(ROPE)) { 26 | postSummary["ROPElow"] <- ROPE[1] 27 | postSummary["ROPEhigh"] <- ROPE[2] 28 | postSummary["pcInROPE"] <- mean(paramSampleVec > ROPE[1] & 29 | paramSampleVec < ROPE[2]) * 100 30 | } 31 | return(postSummary) 32 | } 33 | -------------------------------------------------------------------------------- /R/summary.BEST.R: -------------------------------------------------------------------------------- 1 | # This file contains summary.BEST and print.summary.BEST 2 | # (print.summary.BEST moved here 2013-02-15.) 3 | 4 | 5 | summary.BEST <- 6 | function(object, credMass=0.95, 7 | ROPEm=NULL, ROPEsd=NULL, ROPEeff=NULL, 8 | compValm=0, compValsd=NULL, compValeff=0, ...) { 9 | # Produces summary stats for a BEST object. 10 | # Should do the same set of stats as plotAll and use the same syntax 11 | # as far as possible. 12 | 13 | # Sanity checks: 14 | if(!inherits(object, "data.frame")) 15 | stop("object is not a valid BEST object") 16 | 17 | #mcmcChain <- as.matrix(object) 18 | if(ncol(object) == 3) { 19 | oneGrp <- TRUE 20 | nparam <- 5 21 | } else { 22 | if(ncol(object) != 5) 23 | stop("object is not a valid BEST object.") 24 | oneGrp <- FALSE 25 | nparam <- 9 26 | } 27 | 28 | # Define matrix for storing summary info: 29 | summaryInfo = matrix(NA, nrow=nparam, ncol=11) 30 | if(oneGrp) { 31 | rownames(summaryInfo) <- c("mu", "sigma", "nu", "log10nu", "effSz") 32 | } else { 33 | rownames(summaryInfo) <- c("mu1", "mu2", "muDiff", 34 | "sigma1", "sigma2", "sigmaDiff", 35 | "nu", "log10nu", "effSz") 36 | } 37 | colnames(summaryInfo) <- c("mean","median","mode", 38 | "HDI%","HDIlo","HDIup", 39 | "compVal","%>compVal", 40 | "ROPElow","ROPEhigh","%InROPE") 41 | 42 | if(oneGrp) { 43 | # Deal with 1-group case: 44 | summaryInfo["mu", ] <- sumPost(object$mu, 45 | credMass=credMass, compVal=compValm, ROPE=ROPEm) 46 | summaryInfo["sigma", ] = sumPost(object$sigma, 47 | credMass=credMass, compVal=compValsd, ROPE=ROPEsd) 48 | mu0 <- if(is.null(compValm)) 0 else compValm 49 | effectSize <- (object$mu - mu0) / object$sigma 50 | summaryInfo["effSz", ] = sumPost(effectSize, 51 | credMass=credMass, compVal=compValeff, ROPE=ROPEeff) 52 | } else { 53 | summaryInfo["mu1", ] <- sumPost(object$mu1, credMass=credMass) 54 | summaryInfo["mu2", ] <- sumPost(object$mu2, credMass=credMass) 55 | summaryInfo["muDiff", ] <- sumPost(object$mu1 - object$mu2, 56 | credMass=credMass, compVal=compValm, ROPE=ROPEm) 57 | summaryInfo["sigma1", ] <- sumPost(object$sigma1, credMass=credMass) 58 | summaryInfo["sigma2", ] <- sumPost(object$sigma2, credMass=credMass) 59 | if(is.null(compValsd)) compValsd <- 0 60 | summaryInfo["sigmaDiff", ] <- sumPost(object$sigma1 61 | - object$sigma2, 62 | credMass=credMass, compVal=compValsd, ROPE=ROPEsd) 63 | effSzChain = ((object$mu1 - object$mu2) 64 | / sqrt((object$sigma1^2 + object$sigma2^2) / 2)) 65 | summaryInfo["effSz", ] = sumPost(effSzChain, 66 | credMass=credMass, compVal=compValeff, ROPE=ROPEeff) 67 | # This does not use sample-size weighted version of effect size: 68 | # N1 = length(y1) 69 | # N2 = length(y2) 70 | # effSz = (mu1 - mu2) / sqrt((sigma1^2 *(N1-1) + sigma2^2 *(N2-1)) 71 | # / (N1+N2-2)) 72 | } 73 | # Deal with nu: 74 | summaryInfo["nu", ] = sumPost(object$nu, credMass=credMass) 75 | summaryInfo["log10nu", ] = sumPost(log10(object$nu), credMass=credMass) 76 | 77 | class(summaryInfo) <- c("summary.BEST", class(summaryInfo)) 78 | return(summaryInfo) 79 | } 80 | 81 | # ########################################################## 82 | 83 | print.summary.BEST <- 84 | function(x, digits=3, ...) { 85 | # print method for summary.BEST 86 | # Remove all-NA columns: 87 | ok <- apply(x, 2, function(y) !all(is.na(y))) 88 | class(x) <- NULL 89 | print.default(x[,ok], digits=digits, na.print="", ...) 90 | } 91 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | BEST 2 | ==== 3 | 4 | [![CRAN status](https://www.r-pkg.org/badges/version/BEST)](https://cran.r-project.org/web/packages/BEST/index.html) 5 | [![Downloads](https://cranlogs.r-pkg.org/badges/last-month/BEST)](https://www.r-pkg.org/services) 6 | 7 | 8 | Code for the BEST (Bayesian Estimation Supersedes t-Test) package based on John Kruschke's program. 9 | 10 | It implements the method of Kruschke (2013) Bayesian estimation supersedes the t test. _Journal of Experimental Psychology: General_, 142(2):573-603. doi: 10.1037/a0029146. 11 | 12 | For more on the approach used, see the book: Kruschke (2011) _Doing Bayesian data analysis: a tutorial with R and BUGS_. Elsevier, Amsterdam etc. 13 | 14 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | BESTmcmc 2 | BESTout 3 | BESTpower 4 | Conroy 5 | Cooch 6 | Creelman 7 | DSC 8 | Elsevier 9 | Gelman 10 | Gimenez 11 | HDI 12 | HDIs 13 | ISSN 14 | Kruschke 15 | Kruschke's 16 | Martyn 17 | Plummer 18 | Rhat 19 | Rstudio 20 | Springer 21 | al 22 | burnInSteps 23 | compVal 24 | dev 25 | doi 26 | effSz 27 | eg 28 | et 29 | hdi 30 | ie 31 | makeData 32 | meanDiffGTzero 33 | muDiff 34 | muM 35 | muSD 36 | nRep 37 | nuMean 38 | nuSD 39 | numSavedSteps 40 | plotAll 41 | plotPost 42 | rjags 43 | sd 44 | showPlot 45 | sigmaDiff 46 | sigmaMode 47 | sigmaSD 48 | thinSteps 49 | -------------------------------------------------------------------------------- /inst/tests/testthat/test-BESTmcmc.R: -------------------------------------------------------------------------------- 1 | 2 | # Tests for BESTmcmc and retro power with priors=NULL 3 | # (both work with the same BESTmcmc output object). 4 | 5 | 6 | context("BESTmcmc&retroPower") 7 | 8 | y1 <- c(5.77, 5.33, 4.59, 4.33, 3.66, 4.48) 9 | y2 <- c(3.88, 3.55, 3.29, 2.59, 2.33, 3.59) 10 | Bout2s <- BESTmcmc(y1, y2, numSavedSteps = 9, burnInSteps = 1, 11 | verbose=FALSE, rnd.seed=123, parallel=FALSE) 12 | Bout2p <- BESTmcmc(y1, y2, numSavedSteps = 9, burnInSteps = 1, 13 | verbose=FALSE, rnd.seed=123, parallel=TRUE) 14 | 15 | test_that("BESTmcmc with 2 groups gives same output", { 16 | expect_that(class(Bout2s), equals(c("BEST", "data.frame"))) 17 | expect_that(class(Bout2p), equals(c("BEST", "data.frame"))) 18 | expect_that(colnames(Bout2s), 19 | equals(c("mu1", "mu2", "nu", "sigma1", "sigma2"))) 20 | expect_that(colnames(Bout2p), 21 | equals(c("mu1", "mu2", "nu", "sigma1", "sigma2"))) 22 | expect_equivalent(Bout2s, Bout2p) 23 | if(packageVersion("rjags") >= "4.0.0") { 24 | expect_equivalent(round(colMeans(Bout2s), 5), 25 | c(4.73030, 3.06054, 28.10154, 0.77949, 0.69464)) 26 | expect_equal(round(mean(attr(Bout2s, "Rhat")), 5), 1.28783) 27 | expect_equal(round(mean(attr(Bout2p, "Rhat")), 5), round(mean(attr(Bout2s, "Rhat")), 5)) 28 | expect_equivalent(attr(Bout2s, "n.eff"), c(9, 9, 9, 9, 9)) 29 | expect_equivalent(attr(Bout2p, "n.eff"), c(9, 9, 9, 9, 9)) 30 | } 31 | }) 32 | 33 | test_that("BESTpower retro with 2 groups gives same output", { 34 | pow2s <- BESTpower(Bout2s, 35 | ROPEm=c(-0.1,0.1), ROPEsd=c(-2,2), ROPEeff=c(-0.5,0.5), 36 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 37 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456, parallel=FALSE) 38 | pow2p <- BESTpower(Bout2s, 39 | ROPEm=c(-0.1,0.1), ROPEsd=c(-2,2), ROPEeff=c(-0.5,0.5), 40 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 41 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456, parallel=TRUE) 42 | expect_equal(pow2s, pow2p) 43 | expect_that(class(pow2s), equals(c("matrix", "array"))) 44 | expect_that(colnames(pow2s), 45 | equals(c("mean", "CrIlo", "CrIhi"))) 46 | expect_that(rownames(pow2s), 47 | equals(c(" mean: HDI > ROPE", " mean: HDI < ROPE", 48 | " mean: HDI in ROPE", " mean: HDI width ok", 49 | " sd: HDI > ROPE", " sd: HDI < ROPE", 50 | " sd: HDI in ROPE", " sd: HDI width ok", 51 | "effect: HDI > ROPE", "effect: HDI < ROPE", 52 | "effect: HDI in ROPE", "effect: HDI width ok"))) 53 | expect_equivalent(round(colMeans(pow2s), 5), c(0.26515, 0.12176, 0.45393)) 54 | }) 55 | 56 | y0 <- c(1.89, 1.78, 1.30, 1.74, 1.33, 0.89) 57 | Bout1s <- BESTmcmc(y0, numSavedSteps = 9, burnInSteps = 1, 58 | verbose=FALSE, rnd.seed=123, parallel=FALSE) 59 | Bout1p <- BESTmcmc(y0, numSavedSteps = 9, burnInSteps = 1, 60 | verbose=FALSE, rnd.seed=123, parallel=TRUE) 61 | 62 | test_that("BESTmcmc with 1 group gives same output", { 63 | expect_that(class(Bout1s), equals(c("BEST", "data.frame"))) 64 | expect_that(class(Bout1p), equals(c("BEST", "data.frame"))) 65 | expect_that(colnames(Bout1s), 66 | equals(c("mu", "nu", "sigma"))) 67 | expect_that(colnames(Bout1s), 68 | equals(c("mu", "nu", "sigma"))) 69 | expect_equivalent(round(colMeans(Bout1s), 5), c(1.39340, 24.30192, 0.48864)) 70 | expect_equal(round(mean(attr(Bout1s, "Rhat")), 5), 1.36887) 71 | expect_equal(round(mean(attr(Bout1p, "Rhat")), 5), round(mean(attr(Bout1s, "Rhat")), 5)) 72 | expect_equal(attr(Bout1p, "Rhat"), attr(Bout1s, "Rhat")) 73 | expect_equivalent(attr(Bout1s, "n.eff"), c(9, 9, 9)) 74 | expect_equivalent(attr(Bout1p, "n.eff"), c(9, 9, 9)) 75 | }) 76 | 77 | test_that("BESTpower retro with 1 group gives same output", { 78 | pow1s <- BESTpower(Bout1s, 79 | ROPEm=c(-0.5,0.5), ROPEsd=c(-1,1), ROPEeff=c(-1,1), 80 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 81 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456, parallel=FALSE) 82 | pow1p <- BESTpower(Bout1s, 83 | ROPEm=c(-0.5,0.5), ROPEsd=c(-1,1), ROPEeff=c(-1,1), 84 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 85 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456, parallel=TRUE) 86 | expect_equal(pow1s, pow1p) 87 | expect_equal(class(pow1s), c("matrix", "array")) 88 | expect_that(colnames(pow1s), 89 | equals(c("mean", "CrIlo", "CrIhi"))) 90 | expect_that(rownames(pow1s), 91 | equals(c(" mean: HDI > ROPE", " mean: HDI < ROPE", 92 | " mean: HDI in ROPE", " mean: HDI width ok", 93 | " sd: HDI > ROPE", " sd: HDI < ROPE", 94 | " sd: HDI in ROPE", " sd: HDI width ok", 95 | "effect: HDI > ROPE", "effect: HDI < ROPE", 96 | "effect: HDI in ROPE", "effect: HDI width ok"))) 97 | expect_equivalent(round(colMeans(pow1s), 5), c(0.28030, 0.13426, 0.46934 )) 98 | }) 99 | -------------------------------------------------------------------------------- /inst/tests/testthat/test-BESTmcmc_errors.R: -------------------------------------------------------------------------------- 1 | 2 | # Tests for BESTmcmc 3 | 4 | context("BESTmcmc_errors") 5 | 6 | test_that("BESTmcmc gives sensible errors", { 7 | expect_error(BESTmcmc(c(1:4, NA), 1:4, numSavedSteps = 9, burnInSteps = 1), 8 | "The input data include NA or Inf") 9 | expect_error(BESTmcmc(1:4, 1:4, 9), 10 | "'priors' is now the 3rd argument") 11 | expect_error(BESTmcmc(1:4, 1:4, 9), 12 | "it must be a list") 13 | expect_error(BESTmcmc(1:4, 1:4, priors="A"), 14 | "'priors' must be a list") 15 | expect_error(BESTmcmc(1:4, 1:4, list(nonsense=8)), 16 | "Invalid items in prior specification") 17 | expect_error(BESTmcmc(1:4, 1:4, list(muSD=-1)), 18 | "muSD must be > 0") 19 | expect_error(BESTmcmc(1:4, 1:4, list(sigmaMode=-1)), 20 | "gamma prior must be > 0") 21 | expect_error(BESTmcmc(1:4, 1:4, list(nuSD=-1)), 22 | "gamma prior must be > 0") 23 | expect_error(BESTmcmc(4, 4, list()), 24 | "data must include at least 2") 25 | expect_error(BESTmcmc(4, 4), 26 | "data must include at least 2") 27 | }) 28 | -------------------------------------------------------------------------------- /inst/tests/testthat/test-BESTmcmc_issues.R: -------------------------------------------------------------------------------- 1 | 2 | # Tests for BESTmcmc 3 | 4 | context("BESTmcmc_issues") 5 | 6 | test_that("Old issues resolved with BESTmcmc", { 7 | # Issue #6 8 | # silberzwiebel's data: should no throw error (but output is nonsense) 9 | y0 <- rep(-7:4, c(1, 2, 10, 12, 7, 31, 89, 231, 19, 4, 1, 1)) 10 | expect_silent(BESTmcmc(y0, NULL, list(), numSavedSteps=100, burnInSteps = 100, 11 | parallel=FALSE, verbose=FALSE)) 12 | 13 | # Issue #7 : R's global RNG set by BESTmcmc (rnd.seed should be passed directly to JAGS) 14 | # This was a jagsUI problem. 15 | set.seed(123) # I want reproducible samples 16 | means <- numeric(6) 17 | for(i in 1:6) { 18 | y0 <- rnorm(7) 19 | means[i] <- mean(y0) 20 | BESTmcmc(y0, NULL, list(), numSavedSteps=100, burnInSteps = 100, 21 | rnd.seed=(456), verbose=FALSE) 22 | } 23 | expect_false(any(diff(means) == 0)) # all samples should be different 24 | }) 25 | -------------------------------------------------------------------------------- /inst/tests/testthat/test-BESTmcmc_priors.R: -------------------------------------------------------------------------------- 1 | 2 | # Tests for BESTmcmc and retro power with gamma priors 3 | # (both work with the same BESTmcmc output object). 4 | 5 | 6 | context("BESTmcmc&retroPower_gammaPriors") 7 | 8 | y1 <- c(5.77, 5.33, 4.59, 4.33, 3.66, 4.48) 9 | y2 <- c(3.88, 3.55, 3.29, 2.59, 2.33, 3.59) 10 | Bout2s <- BESTmcmc(y1, y2, priors=list(), 11 | numSavedSteps = 9, burnInSteps = 1, 12 | verbose=FALSE, rnd.seed=123, parallel=FALSE) 13 | Bout2p <- BESTmcmc(y1, y2, priors=list(), 14 | numSavedSteps = 9, burnInSteps = 1, 15 | verbose=FALSE, rnd.seed=123, parallel=TRUE) 16 | 17 | test_that("BESTmcmc with 2 groups and default gamma priors gives same output", { 18 | expect_equivalent(Bout2s, Bout2p) 19 | expect_that(class(Bout2s), equals(c("BEST", "data.frame"))) 20 | expect_that(colnames(Bout2s), 21 | equals(c("mu1", "mu2", "nu", "sigma1", "sigma2"))) 22 | if(packageVersion("rjags") >= "4.0.0") { 23 | expect_equivalent(round(colMeans(Bout2s), 5), 24 | c(4.50176, 3.00586, 38.12665, 0.78138, 0.99560)) 25 | } 26 | }) 27 | 28 | test_that("BESTpower retro with 2 groups gives same output", { 29 | pow2s <- BESTpower(Bout2s, 30 | ROPEm=c(-0.1,0.1), ROPEsd=c(-2,2), ROPEeff=c(-0.5,0.5), 31 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 32 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456, parallel=FALSE) 33 | pow2p <- BESTpower(Bout2s, 34 | ROPEm=c(-0.1,0.1), ROPEsd=c(-2,2), ROPEeff=c(-0.5,0.5), 35 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 36 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456, parallel=TRUE) 37 | expect_equivalent(pow2s, pow2p) 38 | expect_that(class(pow2s), equals(c("matrix", "array"))) 39 | expect_that(colnames(pow2s), 40 | equals(c("mean", "CrIlo", "CrIhi"))) 41 | expect_that(rownames(pow2s), 42 | equals(c(" mean: HDI > ROPE", " mean: HDI < ROPE", 43 | " mean: HDI in ROPE", " mean: HDI width ok", 44 | " sd: HDI > ROPE", " sd: HDI < ROPE", 45 | " sd: HDI in ROPE", " sd: HDI width ok", 46 | "effect: HDI > ROPE", "effect: HDI < ROPE", 47 | "effect: HDI in ROPE", "effect: HDI width ok"))) 48 | expect_equivalent(round(colMeans(pow2s), 5), c(0.21212, 0.05634, 0.41802)) 49 | }) 50 | 51 | Bout2a <- BESTmcmc(y1, y2, 52 | priors=list(muM=7:8, muSD=10:11, sigmaMode=4, sigmaSD=8, nuMean=5, nuSD=10), 53 | numSavedSteps = 9, burnInSteps = 1, 54 | verbose=FALSE, rnd.seed=123) 55 | 56 | test_that("BESTmcmc with 2 groups and informative gamma priors gives same output", { 57 | expect_equal(class(Bout2a), c("BEST", "data.frame")) 58 | expect_that(colnames(Bout2a), 59 | equals(c("mu1", "mu2", "nu", "sigma1", "sigma2"))) 60 | if(packageVersion("rjags") >= "4.0.0") { 61 | expect_equivalent(round(colMeans(Bout2a), 5), 62 | c(4.70158, 3.47429, 7.12125, 0.99167, 0.71483)) 63 | expect_equivalent(round(mean(attr(Bout2a, "Rhat")), 5), 1.83177) 64 | expect_equivalent(attr(Bout2a, "n.eff"), c(9, 9, 9, 9, 9)) 65 | } 66 | PR <- attr(Bout2a, "priors") 67 | expect_that(names(PR), equals(c("muM", "muSD", "sigmaMode", "sigmaSD", 68 | "nuMean", "nuSD"))) 69 | expect_that(PR$muM, equals(7:8)) 70 | expect_that(PR$muSD, equals(10:11)) 71 | }) 72 | 73 | 74 | #### One group tests 75 | #### =============== 76 | y0 <- c(1.89, 1.78, 1.30, 1.74, 1.33, 0.89) 77 | Bout1 <- BESTmcmc(y0, priors=list(), 78 | numSavedSteps = 9, burnInSteps = 1, 79 | verbose=FALSE, rnd.seed=123) 80 | 81 | test_that("BESTmcmc with 1 group and default gamma priors gives same output", { 82 | expect_that(class(Bout1), equals(c("BEST", "data.frame"))) 83 | expect_that(colnames(Bout1), 84 | equals(c("mu", "nu", "sigma"))) 85 | if(packageVersion("rjags") >= "4.0.0") { 86 | expect_equivalent(round(colMeans(Bout1), 5), c(1.53659, 21.29717, 0.36009)) 87 | expect_equivalent(round(mean(attr(Bout1, "Rhat")), 5), 2.18427) 88 | expect_equivalent(attr(Bout1, "n.eff"), c(9, 9, 9)) 89 | } 90 | }) 91 | 92 | test_that("BESTpower retro with 1 group and default gamma priors gives same output", { 93 | pow1 <- BESTpower(Bout1, 94 | ROPEm=c(-0.5,0.5), ROPEsd=c(-1,1), ROPEeff=c(-1,1), 95 | maxHDIWm=2.0, maxHDIWsd=2.0, maxHDIWeff=2.0, 96 | nRep=9, mcmcLength=1000, verbose=FALSE, rnd.seed=456) 97 | expect_that(class(pow1), equals(c("matrix", "array"))) 98 | expect_that(colnames(pow1), 99 | equals(c("mean", "CrIlo", "CrIhi"))) 100 | expect_that(rownames(pow1), 101 | equals(c(" mean: HDI > ROPE", " mean: HDI < ROPE", 102 | " mean: HDI in ROPE", " mean: HDI width ok", 103 | " sd: HDI > ROPE", " sd: HDI < ROPE", 104 | " sd: HDI in ROPE", " sd: HDI width ok", 105 | "effect: HDI > ROPE", "effect: HDI < ROPE", 106 | "effect: HDI in ROPE", "effect: HDI width ok"))) 107 | if(packageVersion("rjags") >= "4.0.0") { 108 | expect_equivalent(round(colMeans(pow1), 5), c(0.34848, 0.20931, 0.51474)) 109 | } 110 | }) 111 | 112 | 113 | y0 <- c(1.89, 1.78, 1.30, 1.74, 1.33, 0.89) 114 | Bout1a <- BESTmcmc(y0, 115 | priors=list(muM=2, muSD=10, sigmaMode=3, sigmaSD=12, nuMean=5, nuSD=10), 116 | numSavedSteps = 9, burnInSteps = 1, 117 | verbose=FALSE, rnd.seed=123) 118 | 119 | test_that("BESTmcmc with 1 group and informative gamma priors gives same output", { 120 | expect_that(class(Bout1a), equals(c("BEST", "data.frame"))) 121 | expect_that(colnames(Bout1a), 122 | equals(c("mu", "nu", "sigma"))) 123 | if(packageVersion("rjags") >= "4.0.0") { 124 | expect_equivalent(round(colMeans(Bout1a), 5), c(1.53828, 5.78369, 0.38535)) 125 | expect_equivalent(round(mean(attr(Bout1a, "Rhat")), 5), 1.33725) 126 | expect_that(attr(Bout1a, "n.eff"), 127 | is_equivalent_to(c(9, 9, 9))) 128 | } 129 | expect_that(names(attr(Bout1a, "priors")), equals(c("muM", "muSD", "sigmaMode", 130 | "sigmaSD", "nuMean", "nuSD"))) 131 | }) 132 | -------------------------------------------------------------------------------- /inst/tests/testthat/test-BESTpower.R: -------------------------------------------------------------------------------- 1 | 2 | # Tests for BESTpower 3 | 4 | 5 | 6 | context("BESTpower_Pro") 7 | 8 | test_that("BESTpower with 2 groups gives same output", { 9 | proData <- makeData(mu1=108, sd1=17, mu2=100, sd2=15, nPerGrp=20, 10 | pcntOut=15, sdOutMult=2.0, rnd.seed=1, 11 | showPlot=FALSE) 12 | expect_that(class(proData), equals("list")) 13 | expect_that(round(proData$y1, 5), 14 | is_equivalent_to(c(94.91088, 109.80678, 91.06461, 135.7637, 112.48891, 91.34337, 115.39274, 120.00616, 117.01734, 100.81456, 134.22832, 113.59835, 95.00674, 65.70652, 127.115, 105.60376, 106.13228, 144.94097, 116.18516, 62.87387))) 15 | expect_that(round(proData$y2, 5), 16 | is_equivalent_to(c(118.12939, 115.72711, 103.30548, 67.0728, 112.8777, 101.01111, 99.26143, 76.17697, 93.6024, 109.33356, 125.8485, 100.192, 108.80216, 101.05191, 77.82177, 94.71111, 95.07459, 59.30063, 130.72614, 109.97323))) 17 | proMCMCs <- BESTmcmc(proData$y1, proData$y2, numSavedSteps=9, 18 | burnInSteps = 1, verbose=FALSE, rnd.seed=2, parallel=FALSE) 19 | proMCMCp <- BESTmcmc(proData$y1, proData$y2, numSavedSteps=9, 20 | burnInSteps = 1, verbose=FALSE, rnd.seed=2, parallel=TRUE) 21 | expect_equivalent(proMCMCs, proMCMCp) 22 | expect_that(round(colMeans(proMCMCs), 5), 23 | is_equivalent_to(c(105.88920, 101.17133, 39.46793, 23.61237, 17.94958))) 24 | pow2s <- BESTpower(proMCMCs, N1=10, N2=10, 25 | ROPEm=c(-2,2) , ROPEsd=c(-2,2) , ROPEeff=c(-0.5,0.5) , 26 | maxHDIWm=25.0 , maxHDIWsd=10.0 , maxHDIWeff=1.0 , 27 | nRep=9, mcmcLength=1000, verbose=0, rnd.seed=3, parallel=FALSE) 28 | pow2p <- BESTpower(proMCMCs, N1=10, N2=10, 29 | ROPEm=c(-2,2) , ROPEsd=c(-2,2) , ROPEeff=c(-0.5,0.5) , 30 | maxHDIWm=25.0 , maxHDIWsd=10.0 , maxHDIWeff=1.0 , 31 | nRep=9, mcmcLength=1000, verbose=0, rnd.seed=3, parallel=TRUE) 32 | expect_equivalent(pow2s, pow2p) 33 | expect_equal(class(pow2s), c("matrix", "array")) 34 | expect_equal(colnames(pow2s), c("mean", "CrIlo", "CrIhi")) 35 | expect_that(rownames(pow2s), 36 | equals(c(" mean: HDI > ROPE", " mean: HDI < ROPE", 37 | " mean: HDI in ROPE", " mean: HDI width ok", 38 | " sd: HDI > ROPE", " sd: HDI < ROPE", 39 | " sd: HDI in ROPE", " sd: HDI width ok", 40 | "effect: HDI > ROPE", "effect: HDI < ROPE", 41 | "effect: HDI in ROPE", "effect: HDI width ok"))) 42 | expect_equivalent(round(colMeans(pow2s), 5), c(0.09091, 0.00000, 0.25887)) 43 | }) 44 | 45 | test_that("BESTpower with 1 group gives same output", { 46 | proData <- makeData(mu1=108, sd1=17, nPerGrp=20, 47 | pcntOut=15, sdOutMult=2.0, rnd.seed=4, 48 | showPlot=FALSE) 49 | expect_that(class(proData), equals("list")) 50 | expect_that(names(proData), equals(c("y1", "y2"))) 51 | expect_that(round(proData$y1, 5), 52 | is_equivalent_to(c(102.74455, 86.85525, 116.85798, 110.68087, 132.43809, 112.63332, 71.39483, 93.74775, 137.89858, 135.39402, 110.0661, 98.53734, 106.22488, 97.26376, 98.92728, 101.74571, 122.5897, 140.77532, 122.08091, 61.14377))) 53 | expect_null(proData$y2) 54 | proMCMC <- BESTmcmc(proData$y1, proData$y2, numSavedSteps=9, 55 | burnInSteps = 1, verbose=FALSE, rnd.seed=2) 56 | expect_equivalent(round(colMeans(proMCMC), 5), c(111.74948, 29.43007, 22.10254)) 57 | pow1 <- BESTpower(proMCMC, N1=10, N2=10, 58 | ROPEm=c(-2,2) , ROPEsd=c(-2,2) , ROPEeff=c(-0.5,0.5) , 59 | maxHDIWm=25.0 , maxHDIWsd=10.0 , maxHDIWeff=1.0 , 60 | nRep=9, mcmcLength=1000, verbose=0, rnd.seed=3) 61 | expect_that(class(pow1), equals(c("matrix", "array"))) 62 | expect_that(colnames(pow1), 63 | equals(c("mean", "CrIlo", "CrIhi"))) 64 | expect_that(rownames(pow1), 65 | equals(c(" mean: HDI > ROPE", " mean: HDI < ROPE", 66 | " mean: HDI in ROPE", " mean: HDI width ok", 67 | " sd: HDI > ROPE", " sd: HDI < ROPE", 68 | " sd: HDI in ROPE", " sd: HDI width ok", 69 | "effect: HDI > ROPE", "effect: HDI < ROPE", 70 | "effect: HDI in ROPE", "effect: HDI width ok"))) 71 | expect_equivalent(round(colMeans(pow1), 5), c(0.31818, 0.19418, 0.47534)) 72 | }) 73 | 74 | -------------------------------------------------------------------------------- /inst/tests/testthat/test-summary.R: -------------------------------------------------------------------------------- 1 | 2 | # Tests for summary.BEST 3 | 4 | # library(BEST) 5 | # library(testthat) 6 | # test_file("test-summary.R") 7 | 8 | context("summary.BEST") 9 | 10 | # Fake BEST object (2 groups) 11 | # JAGS returns different values for each run, so can't check for exact values of 12 | # output for summary, etc., so create a reproducable fake BEST object. 13 | # NB this is actually a matrix, not an mcmc.list object. 14 | set.seed(123) 15 | len <- 1e5 16 | fake <- data.frame(mu1 = rnorm(len, 4.7, 0.47), 17 | mu2 = rnorm(len, 3.2, 0.39), 18 | nu = exp(rnorm(len, 3.1, 0.9)), 19 | sigma1 = exp(rnorm(len, -0.08, 0.42)), 20 | sigma2 = exp(rnorm(len, -0.28, 0.42))) 21 | class(fake) <- c("BEST", "data.frame") 22 | 23 | test_that("summary.BEST with 2 groups and default values gives correct output", { 24 | tst <- summary(fake) 25 | expect_that(class(tst), equals(c("summary.BEST", "matrix", "array"))) 26 | expect_that(colnames(tst), 27 | equals(c("mean", "median", "mode", "HDI%", "HDIlo", "HDIup","compVal", 28 | "%>compVal", "ROPElow", "ROPEhigh", "%InROPE"))) 29 | expect_that(rownames(tst), 30 | equals(c("mu1", "mu2", "muDiff", "sigma1", "sigma2", "sigmaDiff", 31 | "nu", "log10nu", "effSz"))) 32 | expect_that(round(tst[, "mean"], 5), 33 | is_equivalent_to(c(4.70046, 3.20203, 1.49843, 1.00882, 0.82330, 0.18552, 34 | 33.33190, 1.34608, 1.73125))) 35 | expect_that(round(tst[, "median"], 5), 36 | is_equivalent_to(c(4.70044, 3.20177, 1.49882, 0.92136, 0.75354, 0.16123, 37 | 22.23564, 1.34705, 1.59928))) 38 | expect_that(round(tst[, "mode"], 5), 39 | is_equivalent_to(c(4.69105, 3.21097, 1.59130, 0.76825, 0.64755, 0.12847, 40 | 10.17372, 1.36961, 1.36379))) 41 | expect_that(tst[, "HDI%"], 42 | is_equivalent_to(rep(95, 9))) 43 | expect_that(round(tst[, "HDIlo"], 5), 44 | is_equivalent_to(c(3.78332, 2.44174, 0.30195, 0.31733, 0.25789, -0.98030, 45 | 1.04944, 0.57959, 0.10968))) 46 | expect_that(round(tst[, "HDIup"], 5), 47 | is_equivalent_to(c(5.62369, 3.97225, 2.70333, 1.88649, 1.53835, 1.34601, 48 | 97.71139, 2.10913, 3.61654))) 49 | }) 50 | 51 | test_that("summary.BEST with 2 groups and non-default values gives correct output", { 52 | tst <- summary(fake, credMass = 0.8, 53 | ROPEm = c(-0.1, 0.1), ROPEsd = c(-0.1, 0.1), ROPEeff = c(-0.1, 0.1), 54 | compValm = 1.5, compValsd = 0, compValeff = 0) 55 | expect_that(class(tst), equals(c("summary.BEST", "matrix", "array"))) 56 | expect_that(colnames(tst), 57 | equals(c("mean", "median", "mode", "HDI%", "HDIlo", "HDIup","compVal", 58 | "%>compVal", "ROPElow", "ROPEhigh", "%InROPE"))) 59 | expect_that(rownames(tst), 60 | equals(c("mu1", "mu2", "muDiff", "sigma1", "sigma2", "sigmaDiff", 61 | "nu", "log10nu", "effSz"))) 62 | expect_that(round(tst[, "mean"], 5), 63 | is_equivalent_to(c(4.70046, 3.20203, 1.49843, 1.00882, 0.82330, 0.18552, 64 | 33.33190, 1.34608, 1.73125))) 65 | expect_that(round(tst[, "median"], 5), 66 | is_equivalent_to(c(4.70044, 3.20177, 1.49882, 0.92136, 0.75354, 0.16123, 67 | 22.23564, 1.34705, 1.59928))) 68 | expect_that(round(tst[, "mode"], 5), 69 | is_equivalent_to(c(4.69105, 3.21097, 1.59130, 0.76825, 0.64755, 0.12847, 70 | 10.17372, 1.36961, 1.36379))) 71 | expect_that(tst[, "HDI%"], 72 | is_equivalent_to(rep(80, 9))) 73 | expect_that(round(tst[, "HDIlo"], 5), 74 | is_equivalent_to(c(4.08736, 2.70201, 0.72404, 0.42834, 0.36181, -0.51840, 75 | 2.13345, 0.83916, 0.50194))) 76 | expect_that(round(tst[, "HDIup"], 5), 77 | is_equivalent_to(c(5.28987, 3.70624, 2.29257, 1.38703, 1.14570, 0.84175, 78 | 48.01003, 1.84015, 2.65435))) 79 | notna <- c(3,6,9) 80 | expect_that(tst[notna, "compVal"], 81 | is_equivalent_to(c(1.5, 0.0, 0.0))) 82 | expect_that(tst[-notna, "compVal"], 83 | is_equivalent_to(rep(NA_real_, 6))) 84 | expect_that(round(tst[notna, "%>compVal"], 5), 85 | is_equivalent_to(c(49.922, 63.235, 99.289))) 86 | expect_that(tst[-notna, "%>compVal"], 87 | is_equivalent_to(rep(NA_real_, 6))) 88 | expect_that(tst[notna, "ROPElow"], 89 | is_equivalent_to(c(-0.1, -0.1, -0.1))) 90 | expect_that(tst[-notna, "ROPElow"], 91 | is_equivalent_to(rep(NA_real_, 6))) 92 | expect_that(tst[notna, "ROPEhigh"], 93 | is_equivalent_to(c(0.1, 0.1, 0.1))) 94 | expect_that(tst[-notna, "ROPEhigh"], 95 | is_equivalent_to(rep(NA_real_, 6))) 96 | expect_that(round(tst[notna, "%InROPE"], 5), 97 | is_equivalent_to(c(0.662, 15.724, 0.645))) 98 | expect_that(tst[-notna, "%InROPE"], 99 | is_equivalent_to(rep(NA_real_, 6))) 100 | }) 101 | 102 | # Fake BEST object (1 group) 103 | set.seed(123) 104 | len <- 1e5 105 | fake <- data.frame('mu' = rnorm(len, 1.5, 0.25), 106 | 'nu' = exp(rnorm(len, 3, 1)), 107 | 'sigma' = exp(rnorm(len, -0.75, 0.42))) 108 | class(fake) <- c("BEST", "data.frame") 109 | 110 | test_that("summary.BEST with 1 group and default values gives correct output", { 111 | tst <- summary(fake) 112 | expect_that(class(tst), equals(c("summary.BEST", "matrix", "array"))) 113 | expect_that(colnames(tst), 114 | equals(c("mean", "median", "mode", "HDI%", "HDIlo", "HDIup","compVal", 115 | "%>compVal", "ROPElow", "ROPEhigh", "%InROPE"))) 116 | expect_that(rownames(tst), 117 | equals(c("mu", "sigma", "nu", "log10nu", "effSz"))) 118 | expect_that(round(tst[, "mean"], 5), 119 | is_equivalent_to(c(1.50024, 0.51587, 33.42182, 1.30515, 3.46960))) 120 | expect_that(round(tst[, "median"], 5), 121 | is_equivalent_to(c(1.50024, 0.47274, 20.17708, 1.30486, 3.14097))) 122 | expect_that(round(tst[, "mode"], 5), 123 | is_equivalent_to(c(1.49524, 0.39606, 7.64812, 1.31510, 2.56656))) 124 | expect_that(tst[, "HDI%"], 125 | is_equivalent_to(rep(95, 5))) 126 | expect_that(round(tst[, "HDIlo"], 5), 127 | is_equivalent_to(c(1.01240, 0.16139, 0.48272, 0.45850, 0.95083))) 128 | expect_that(round(tst[, "HDIup"], 5), 129 | is_equivalent_to(c(1.99132, 0.96267, 105.88948, 2.16285, 6.73603))) 130 | }) 131 | 132 | test_that("summary.BEST with 1 group and non-default values gives correct output", { 133 | tst <- summary(fake, credMass = 0.8, 134 | ROPEm = c(-0.1, 0.1), ROPEsd = c(0, 1), ROPEeff = c(-0.1, 0.1), 135 | compValm = 0, compValsd = 2, compValeff = 0) 136 | expect_that(class(tst), equals(c("summary.BEST", "matrix", "array"))) 137 | expect_that(colnames(tst), 138 | equals(c("mean", "median", "mode", "HDI%", "HDIlo", "HDIup","compVal", 139 | "%>compVal", "ROPElow", "ROPEhigh", "%InROPE"))) 140 | expect_that(rownames(tst), 141 | equals(c("mu", "sigma", "nu", "log10nu", "effSz"))) 142 | expect_that(round(tst[, "mean"], 5), 143 | is_equivalent_to(c(1.50024, 0.51587, 33.42182, 1.30515, 3.46960))) 144 | expect_that(round(tst[, "median"], 5), 145 | is_equivalent_to(c(1.50024, 0.47274, 20.17708, 1.30486, 3.14097))) 146 | expect_that(round(tst[, "mode"], 5), 147 | is_equivalent_to(c(1.49524, 0.39606, 7.64812, 1.31510, 2.56656))) 148 | expect_that(tst[, "HDI%"], 149 | is_equivalent_to(rep(80, 5))) 150 | expect_that(round(tst[, "HDIlo"], 5), 151 | is_equivalent_to(c(1.17413, 0.21836, 1.08642, 0.74834, 1.32132))) 152 | expect_that(round(tst[, "HDIup"], 5), 153 | is_equivalent_to(c(1.81376, 0.70775, 47.20796, 1.86661, 4.82158))) 154 | notna <- c(1,2,5) 155 | expect_that(tst[notna, "compVal"], 156 | is_equivalent_to(c(0, 2, 0))) 157 | expect_that(tst[-notna, "compVal"], 158 | is_equivalent_to(rep(NA_real_, 2))) 159 | expect_that(round(tst[notna, "%>compVal"], 5), 160 | is_equivalent_to(c(100.000, 0.037, 100.000))) 161 | expect_that(tst[-notna, "%>compVal"], 162 | is_equivalent_to(rep(NA_real_, 2))) 163 | expect_that(tst[notna, "ROPElow"], 164 | is_equivalent_to(c(-0.1, 0, -0.1))) 165 | expect_that(tst[-notna, "ROPElow"], 166 | is_equivalent_to(rep(NA_real_, 2))) 167 | expect_that(tst[notna, "ROPEhigh"], 168 | is_equivalent_to(c(0.1, 1, 0.1))) 169 | expect_that(tst[-notna, "ROPEhigh"], 170 | is_equivalent_to(rep(NA_real_, 2))) 171 | expect_that(round(tst[notna, "%InROPE"], 5), 172 | is_equivalent_to(c(0.000, 96.358, 0.000))) 173 | expect_that(tst[-notna, "%InROPE"], 174 | is_equivalent_to(rep(NA_real_, 2))) 175 | }) 176 | 177 | 178 | 179 | 180 | 181 | -------------------------------------------------------------------------------- /man/BEST-package.Rd: -------------------------------------------------------------------------------- 1 | \name{BEST-package} 2 | \alias{BEST-package} 3 | \alias{BEST} 4 | \docType{package} 5 | \title{ 6 | Bayesian Estimation Supersedes the t Test 7 | } 8 | \description{ 9 | An alternative to \emph{t} tests, producing posterior estimates for groups means and standard deviations and their differences and effect sizes. Bayesian estimation provides a much richer picture of the data, and can be summarized as point estimates and credible intervals. 10 | } 11 | \details{ 12 | 13 | The core function, \code{\link{BESTmcmc}}, generates posterior distributions to compare the means of two groups, or to compare the mean of one group with a standard, taking into account the standard deviation(s). It is thus similar to a \emph{t} test. However, our Bayesian approach results in probability statements about the values of interest, rather than \emph{p}-values and significance levels. 14 | 15 | In addition, the procedure accounts for departures from normality by using a \emph{t}-distribution to model the variable of interest and estimating a measure of normality. 16 | 17 | Functions to summarize and to visualize the output are provided. 18 | 19 | The function \code{\link{BESTpower}} allows simulation-based estimates of power, either retrospective power directly with \code{BESTmcmc} output or prospective power analysis with \code{\link{makeData}}. 20 | 21 | } 22 | \author{ 23 | Original code by John K. Kruschke, packaged by Mike Meredith. 24 | } 25 | 26 | \references{ 27 | Kruschke, J. K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 28 | 29 | Kruschke, J. K. 2011. \emph{Doing Bayesian data analysis: a tutorial with R and BUGS.} Elsevier, Amsterdam, especially Chapter 18. 30 | } 31 | 32 | \keyword{ package } 33 | \keyword{ htest } 34 | 35 | \examples{ 36 | 37 | \donttest{ 38 | ## Comparison of two groups: 39 | ## ========================= 40 | y1 <- c(5.77, 5.33, 4.59, 4.33, 3.66, 4.48) 41 | y2 <- c(3.88, 3.55, 3.29, 2.59, 2.33, 3.59) 42 | 43 | # Run an analysis, takes up to 1 min. 44 | BESTout <- BESTmcmc(y1, y2, parallel=FALSE) 45 | 46 | # Look at the result: 47 | BESTout 48 | summary(BESTout) 49 | plot(BESTout) 50 | plot(BESTout, "sd") 51 | plotPostPred(BESTout) 52 | plotAll(BESTout, credMass=0.8, ROPEm=c(-0.1,0.1), 53 | ROPEeff=c(-0.2,0.2), compValm=0.5) 54 | plotAll(BESTout, credMass=0.8, ROPEm=c(-0.1,0.1), 55 | ROPEeff=c(-0.2,0.2), compValm=0.5, showCurve=TRUE) 56 | summary(BESTout, credMass=0.8, ROPEm=c(-0.1,0.1), ROPEsd=c(-0.15,0.15), 57 | ROPEeff=c(-0.2,0.2)) 58 | pairs(BESTout) 59 | 60 | head(BESTout$mu1) 61 | muDiff <- BESTout$mu1 - BESTout$mu2 62 | mean(muDiff > 1.5) 63 | mean(BESTout$sigma1 - BESTout$sigma2) 64 | hist(BESTout$nu) 65 | 66 | # Retrospective power analysis 67 | # ---------------------------- 68 | # This takes time, so we do 2 simulations here; a real analysis needs several hundred 69 | 70 | powerRet <- BESTpower(BESTout, N1=length(y1), N2=length(y2), 71 | ROPEm=c(-0.1,0.1), maxHDIWm=2.0, nRep=2, parallel=FALSE) 72 | powerRet 73 | # We only set criteria for the mean, so results for sd and effect size are all NA. 74 | 75 | ## Analysis with a single group: 76 | ## ============================= 77 | y0 <- c(1.89, 1.78, 1.30, 1.74, 1.33, 0.89) 78 | 79 | # Run an analysis, takes up to 40 secs. 80 | BESTout1 <- BESTmcmc(y0, parallel=FALSE) 81 | BESTout1 82 | summary(BESTout1) 83 | plot(BESTout1) 84 | 85 | head(BESTout1$mu) 86 | mean(BESTout1$sigma) 87 | } % end of donttest 88 | } 89 | -------------------------------------------------------------------------------- /man/BESTmcmc.Rd: -------------------------------------------------------------------------------- 1 | \name{BESTmcmc} 2 | \alias{BESTmcmc} 3 | \title{ 4 | Generate MCMC samples for posterior distributions 5 | } 6 | \description{ 7 | This function is the core of the BEST package. It calls JAGS and passes a description of the model, priors, and data, then retrieves and returns the MCMC samples for the parameters. 8 | } 9 | \usage{ 10 | 11 | BESTmcmc(y1, y2 = NULL, priors = NULL, doPriorsOnly = FALSE, 12 | numSavedSteps = 1e+05, thinSteps = 1, burnInSteps = 1000, 13 | verbose=TRUE, rnd.seed=NULL, parallel=NULL) 14 | } 15 | \arguments{ 16 | \item{y1}{ 17 | a numeric vector of data values. 18 | } 19 | \item{y2}{ 20 | a vector of values for a second group, or NULL if there is only one group of observations. 21 | } 22 | \item{priors}{ 23 | an optional list of values controlling the priors, see Details. 24 | } 25 | \item{doPriorsOnly}{ 26 | if TRUE, \code{BESTmcmc} returns MCMC chains representing the prior distributions, \emph{not} the posterior distributions for your data set. 27 | } 28 | \item{numSavedSteps}{ 29 | the number of MCMC observations to be returned. 30 | } 31 | \item{thinSteps}{ 32 | thinning rate. If set to n > 1, n steps of the MCMC chain are calculated for each one returned. This is useful if autocorrelation is high and you need to run long chains. 33 | } 34 | \item{burnInSteps}{ 35 | number of steps to discard as burn-in at the beginning of the chain. 36 | } 37 | \item{verbose}{ 38 | if FALSE, output to the R Console is suppressed. If chains are run in parallel, the output from JAGS is not displayed in the Console, even if \code{verbose = TRUE}. 39 | } 40 | \item{rnd.seed}{ 41 | a positive integer (or NULL): the seed for the random number generator, used to obtain reproducible samples if required. Values generated in different versions of BEST or different versions of JAGS may differ, even with the same seed. 42 | } 43 | \item{parallel}{ 44 | if NULL or TRUE and > 3 cores are available, the MCMC chains are run in parallel. (If TRUE and < 4 cores are available, a warning is given.) 45 | } 46 | } 47 | \details{ 48 | The function uses a t-distribution to model each sample, and generates vectors of random draws from the posterior distribution of the \emph{center} (\eqn{\mu}) and \emph{spread} or \emph{scale} (\eqn{\sigma}) of the distribution, as well as a measure of \emph{normality} (\eqn{\nu}). The procedure uses a Bayesian MCMC process implemented in JAGS (Plummer 2003). 49 | 50 | \eqn{\mu} is the population mean, except when \eqn{\nu} = 1 (which is the Cauchy distribution) or lower, when the mean is undefined. 51 | 52 | \eqn{\sigma} is a good approximation to the standard deviation (SD) for values of \eqn{\nu} > 20. More exactly the SD is \eqn{\sigma} * sqrt(\eqn{\nu}/(\eqn{\nu} - 2)). For a normal distribution (with \eqn{\nu = \infty}), SD = \eqn{\sigma} is exact. The SD is undefined when \eqn{\nu} = 2 or less. 53 | 54 | If \code{priors = NULL}, broad priors as described by Kruschke (2013) are used. For \eqn{\mu}, \code{Normal(mean(y), 1000 * sd(y))}; for \eqn{\sigma}, \code{Uniform(sd(y)/1000, sd(y) * 1000)}; for \eqn{\nu}, \code{Exponential(1/29) + 1}, with the constraint that \code{nu >= 1}. Here \code{y = c(y1, y2)}. Note that \code{priors = NULL} is not equivalent to \code{priors = list()}. 55 | 56 | Alternatively, \code{priors} can be a list with elements specifying the priors for one or more parameters:\cr 57 | \eqn{\mu} : population centers have separate normal priors, with mean \code{muM} and standard deviation \code{muSD}; if not included in the list, default values of \code{muM = mean(y), muSD = sd(y)*5} are used;\cr 58 | \eqn{\sigma} : population scales have separate gamma priors, with \emph{mode} \code{sigmaMode} and standard deviation \code{sigmaSD}; defaults are \code{sigmaMode = sd(y), sigmaSD = sd(y)*5};\cr 59 | \eqn{\nu} : the normality parameter has a gamma prior with \emph{mean} \code{nuMean} and standard deviation \code{nuSD}; defaults are \code{nuMean = 30, nuSD = 30}; versions before 0.4.0 constrained \eqn{\nu} to be >1. 60 | 61 | If there are 2 groups of observations, \code{muM, muSD, sigmaMode, sigmaSD} may be vectors of length 2 or scalar; if scalar, the same value is used for each population. 62 | 63 | The model is shown in the diagram below. 64 | 65 | \figure{BESTmodel.jpg} 66 | 67 | Derived parameters, including the differences in means or standard deviations, and effect sizes can be obtained from the results of the \code{BESTmcmc} run. 68 | 69 | The output from \code{BESTmcmc} has class \code{BEST}, which has print, plot and summary methods. These permit the extraction and display of credible intervals and proportions of the posterior mass above or below values of interest. 70 | 71 | } 72 | \value{ 73 | An object of class \code{BEST} inheriting from \code{data.frame}. If two samples are compared, the output has the following columns: 74 | 75 | \item{mu1, mu2}{simulated observations of center for each population} 76 | \item{sigma1, sigma2}{simulated observations of scale for each population} 77 | \item{nu}{simulated observations of normality parameter} 78 | 79 | while for a single sample, the columns are \code{mu, sigma, nu}. 80 | 81 | The output has the following attributes: 82 | 83 | \item{call}{the call to the function.} 84 | \item{Rhat}{the 'potential scale reduction factor'.} 85 | \item{n.eff}{sample size adjusted for autocorrelation.} 86 | \item{data}{a list with elements y1 and y2 containing the original data; y2 may be NULL.} 87 | \item{priors}{a list with the priors used, if the \code{priors} argument is not NULL.} 88 | \item{doPriorsOnly}{logical, the value of the \code{doPriorsOnly} argument.} 89 | 90 | The package provides \code{print}, \code{plot} and \code{summary} methods for \code{BEST} objects. 91 | } 92 | \references{ 93 | Kruschke, J K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 94 | 95 | For the informative priors, see Kruschke's blog post at \url{http://doingbayesiandataanalysis.blogspot.com/2015/04/informed-priors-for-bayesian-comparison.html} 96 | 97 | For the constraint on \eqn{\nu}, see the blog post at \url{http://doingbayesiandataanalysis.blogspot.com/2015/12/prior-on-df-normality-parameter-in-t.html} 98 | 99 | Plummer, Martyn (2003). JAGS: A Program for Analysis of Bayesian Graphical Models Using Gibbs Sampling, \emph{Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003)}, March 20-22, Vienna, Austria. ISSN 1609-395X 100 | } 101 | \author{ 102 | Original code by John K. Kruschke, modified by Mike Meredith. 103 | } 104 | 105 | \seealso{ 106 | \code{\link[=plot.BEST]{plot}}, \code{\link[=summary.BEST]{summary}}, \code{\link[=pairs.BEST]{pairs}} for relevant methods. 107 | } 108 | \examples{ 109 | ## See examples in BEST-package help. 110 | } 111 | -------------------------------------------------------------------------------- /man/BESTpower.Rd: -------------------------------------------------------------------------------- 1 | \name{BESTpower} 2 | \alias{BESTpower} 3 | \title{ 4 | Estimating statistical power 5 | } 6 | \description{ 7 | Estimation of the probability of meeting the goals of a study given initial information or assumptions about the population parameters. For prospective power estimation, the sequence\cr \code{makeData -> BESTmcmc -> BESTpower} \cr is recommended: see \code{\link{makeData}}. 8 | } 9 | \usage{ 10 | BESTpower(BESTobj, N1, N2, credMass=0.95, 11 | ROPEm, ROPEsd, ROPEeff, 12 | maxHDIWm, maxHDIWsd, maxHDIWeff, 13 | compValm = 0, nRep = 200, mcmcLength = 10000, 14 | saveName = NULL, showFirstNrep = 0, verbose = 2, rnd.seed=NULL, parallel=NULL) 15 | } 16 | \arguments{ 17 | \item{BESTobj}{ 18 | an object of class \code{BEST} produced by \code{BESTmcmc}. 19 | } 20 | \item{N1}{ 21 | planned sample size for the first (or only) group of observations; may be a scalar if sample size is fixed, or a vector if sample size varies; values will be recycled if necessary. 22 | } 23 | \item{N2}{ 24 | planned sample size for the second group of observations; ignored if \code{BESTobj} concerns only one group. 25 | } 26 | \item{credMass}{ 27 | the probability mass to include in HDIs when checking criteria. 28 | } 29 | \item{ROPEm}{ 30 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the difference of means (for 2 groups) or the mean (for 1 group). 31 | } 32 | \item{ROPEsd}{ 33 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the (difference of) standard deviations. 34 | } 35 | \item{ROPEeff}{ 36 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the effect size. 37 | } 38 | \item{maxHDIWm}{ 39 | the maximum acceptable width for the HDI for the difference in means (for 2 groups) or for the mean (for a single group). 40 | } 41 | \item{maxHDIWsd}{ 42 | the maximum acceptable width for the HDI for the (difference of) standard deviation. 43 | } 44 | \item{maxHDIWeff}{ 45 | the maximum acceptable width for the HDI for the effect size. 46 | } 47 | \item{compValm}{ 48 | for a single group, the value of the mean which represents no effect; used to calculate the effect size. Ignored for 2 groups. 49 | } 50 | \item{nRep}{ 51 | number of simulations to carry out. 52 | } 53 | \item{mcmcLength}{ 54 | length of the MCMC chains to use for each simulation. 55 | } 56 | \item{saveName}{ 57 | if required, the results may saved to a file after each iteration and \code{saveName} specifies the file name (or path relative to the current working directory) to use. The \code{power} object can be loaded with \code{\link{load}}. Set to NULL (the default) to disable saving. 58 | } 59 | \item{showFirstNrep}{ 60 | the number of results to display as plots at the beginning of the simulation run. (This uses dev.new(), which does not work in Rstudio. The plots will appear sequentially in the plot window and you will have to use the back arrow to review them.) 61 | } 62 | \item{verbose}{ 63 | controls output to the R Console: 0 suppresses all output; 1 gives just a progress bar; 2 gives maximum detail. 64 | } 65 | \item{rnd.seed}{ 66 | a positive integer (or NULL): the seed for the random number generator, used to obtain reproducible samples if required. 67 | } 68 | \item{parallel}{ 69 | if NULL or TRUE and > 3 cores are available, the MCMC chains are run in parallel. (If TRUE and < 4 cores are available, a warning is given.) 70 | } 71 | } 72 | \details{ 73 | For each of the parameters of interest - (difference in) mean, (difference in) standard deviation and effect size - we consider 4 criteria and the probability that each will be met: 74 | 75 | 1. The HDI of the posterior density of the parameter lies entirely outside the ROPE and is greater than the ROPE. 76 | 77 | 2. The HDI of the posterior density of the parameter lies entirely outside the ROPE and is less than the ROPE. 78 | 79 | 3. The HDI of the posterior density of the parameter lies entirely inside the ROPE. 80 | 81 | 4. The width of the HDI is less than the specified \code{maxHDIWx}. 82 | 83 | The mass inside the above HDIs depends on the \code{credMass} argument. 84 | 85 | A uniform beta prior is used for each of these probabilities and combined with the results of the simulations to give a conjugate beta posterior distribution. The means and 95\% HDI credible intervals are returned. 86 | } 87 | \value{ 88 | A matrix with a row for each criterion and columns for the mean and lower and upper limits of a 95\% credible interval for the posterior probability of meeting the criterion. 89 | 90 | Note that this matrix always has 12 rows. Rows corresponding to criteria which are not specified will have NAs. 91 | } 92 | \references{ 93 | Kruschke, J. K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 94 | 95 | Kruschke, J. K. 2011. \emph{Doing Bayesian data analysis: a tutorial with R and BUGS.} Elsevier, Amsterdam, Chapter 13. 96 | } 97 | \author{ 98 | Original code by John Kruschke, modified by Mike Meredith. 99 | } 100 | \note{ 101 | At least 1000 simulations are needed to get good estimates of power and these can take a long time. If the run is interrupted, the results so far can be recovered from the file specified in \code{saveName}. 102 | 103 | The chains in \code{BESTobj} must have at least nRep values. To allow for some degree of autocorrelation among values, it would be prudent to make these chains at least 10 * nRep in length. 104 | } 105 | 106 | \seealso{ 107 | \code{\link{makeData}} for details of preparing a \code{BESTobj} for a prospective power analysis. 108 | } 109 | \examples{ 110 | 111 | ## For retrospective power analysis, see the example in BEST-package. 112 | 113 | # 1. Generate idealized data set: 114 | proData <- makeData(mu1=108, sd1=17, mu2=100, sd2=15, nPerGrp=20, 115 | pcntOut=10, sdOutMult=2.0, rnd.seed=NULL) 116 | \donttest{ 117 | # 2. Generate credible parameter values from the idealized data: 118 | proMCMC <- BESTmcmc(proData$y1, proData$y2, numSavedSteps=2000, parallel=FALSE) 119 | 120 | # 3. Compute the prospective power for planned sample sizes: 121 | # We'll do just 5 simulations to show it works; should be several hundred. 122 | N1plan <- N2plan <- 50 123 | powerPro <- BESTpower(proMCMC, N1=N1plan, N2=N2plan, 124 | ROPEm=c(-1.5,1.5), ROPEsd=c(-2,2), ROPEeff=c(-0.5,0.5), 125 | maxHDIWm=15.0, maxHDIWsd=10.0, maxHDIWeff=1.0, nRep=5, parallel=FALSE) 126 | powerPro 127 | } 128 | } 129 | -------------------------------------------------------------------------------- /man/figures/BESTmodel.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/man/figures/BESTmodel.jpg -------------------------------------------------------------------------------- /man/figures/HDIbimodal.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/man/figures/HDIbimodal.jpg -------------------------------------------------------------------------------- /man/figures/HDIskew.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/man/figures/HDIskew.jpg -------------------------------------------------------------------------------- /man/figures/makeData.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/man/figures/makeData.jpg -------------------------------------------------------------------------------- /man/figures/plotPost1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/man/figures/plotPost1.jpg -------------------------------------------------------------------------------- /man/figures/plotPost2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/man/figures/plotPost2.jpg -------------------------------------------------------------------------------- /man/makeData.Rd: -------------------------------------------------------------------------------- 1 | \name{makeData} 2 | \alias{makeData} 3 | \title{ 4 | Population parameter specification for a power analysis 5 | } 6 | \description{ 7 | The function allows the analyst to prepare an idealized data set which exactly matches selected point values, and incorporates uncertainty in these values in terms of sample size. 8 | } 9 | \usage{ 10 | makeData(mu1, sd1, mu2 = NULL, sd2 = NULL, nPerGrp, 11 | pcntOut = 0, sdOutMult = 2, rnd.seed = NULL, showPlot = TRUE) 12 | } 13 | \arguments{ 14 | \item{mu1}{ 15 | the mean for the first (or only) population. 16 | } 17 | \item{sd1}{ 18 | the standard deviation for the main part of the first population, excluding outliers. 19 | } 20 | \item{mu2}{ 21 | the mean for the second population; NULL if only one population is involved. 22 | } 23 | \item{sd2}{ 24 | the standard deviation for the main part of the second population; NULL if only one population is involved. 25 | } 26 | \item{nPerGrp}{ 27 | sample size per group; large sample size reflects a high degree of precision in the values for the means and standard deviations. 28 | } 29 | \item{pcntOut}{ 30 | the percentage of outliers in each population. 31 | } 32 | \item{sdOutMult}{ 33 | the standard deviation of the outliers as a multiple of the standard deviation of the main part of the population. 34 | } 35 | \item{rnd.seed}{ 36 | a seed for the random number generator, used to obtain reproducible samples if required. 37 | } 38 | \item{showPlot}{ 39 | if TRUE, displays the results as a plot (see Details). 40 | } 41 | } 42 | \details{ 43 | The arguments to this function provide a framework to specify the hypothesized values of the parameters of the populations under study, while the sample size is chosen to reflect the confidence in the values specified. 44 | 45 | The function produces idealized samples, ie. samples which exactly match the specified means and standard deviations. If showPlot = TRUE, the results are displayed as a plot: 46 | 47 | \figure{makeData.jpg} 48 | 49 | \emph{Histograms: actual sample values; red dashed line: distribution of the outliers; blue dashed line: distribution of the non-outliers; black line: combined distribution.} 50 | 51 | These idealized samples are passed to \code{\link{BESTmcmc}}, which generates a series of sets of credible values for the parameters, including the normality parameter, taking account of correlations among them. 52 | 53 | The sets of credible parameter values which constitute the \code{BESTmcmc} output are used by \code{\link{BESTpower}} to simulate new data sets which might arise during a subsequent experiment. 54 | } 55 | \value{ 56 | A list with two components: 57 | \item{y1}{A vector of simulated values for the first (or only) group.} 58 | \item{y2}{A vector of simulated values for the second group or NULL.} 59 | 60 | } 61 | \references{ 62 | Kruschke, J. K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 63 | } 64 | \author{ 65 | John Kruschke 66 | } 67 | 68 | \seealso{ 69 | \code{\link{BESTpower}} for examples. 70 | } 71 | \examples{ 72 | ## See examples for BESTpower. 73 | } 74 | -------------------------------------------------------------------------------- /man/pairs.BEST.Rd: -------------------------------------------------------------------------------- 1 | \name{pairs.BEST} 2 | \alias{pairs.BEST} 3 | \title{ 4 | Scatterplot matrix for a \code{BEST} object 5 | } 6 | \description{ 7 | Function to produce a scatterplot matrix of a \code{BEST} object produced by \code{\link{BESTmcmc}}, with correlation coefficients in the lower triangle. 8 | } 9 | \usage{ 10 | \method{pairs}{BEST}(x, nPtToPlot = 1000, col = "skyblue", ...) 11 | } 12 | \arguments{ 13 | \item{x}{ 14 | an object of class \code{BEST} 15 | } 16 | \item{nPtToPlot}{ 17 | number of points to plot 18 | } 19 | \item{col}{ 20 | color to use for the points plotted. 21 | } 22 | \item{\dots}{ 23 | other graphical parameters passed to \code{plot.default}. 24 | } 25 | } 26 | 27 | \value{ 28 | None; used for its side effect. 29 | } 30 | 31 | \author{ 32 | Original code by John Kruschke, adapted as a \code{pairs} method by Mike Meredith 33 | } 34 | 35 | \seealso{ 36 | \code{\link{pairs}} in package \code{graphics}. 37 | } 38 | \examples{ 39 | # See examples in BEST-package 40 | } 41 | -------------------------------------------------------------------------------- /man/plot.BEST.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.BEST} 2 | \alias{plot.BEST} 3 | \title{ 4 | A plot method for objects of class 'BEST' 5 | } 6 | \description{ 7 | Displays a plot showing the posterior probability distribution of one of the parameters of interest, the difference in means by default. 8 | } 9 | \usage{ 10 | \method{plot}{BEST}(x, which = c("mean", "sd", "effect", "nu"), credMass = 0.95, 11 | ROPE = NULL, compVal = 0, showCurve = FALSE, 12 | mainColor="skyblue", dataColor="red", comparisonColor="darkgreen", 13 | ROPEColor = "darkred", ...) 14 | } 15 | \arguments{ 16 | \item{x}{ 17 | an object of class \code{BEST}, as produced by the function \code{\link{BESTmcmc}}. 18 | } 19 | \item{which}{ 20 | one of "mean", "sd", "effect" or "nu" or an abbreviation of one of these; indicates which estimate to plot. For a comparison of two groups, "mean" and "sd" display the difference in means or standard deviation. 21 | } 22 | \item{credMass}{ 23 | the probability mass to include in credible intervals, or NULL to suppress plotting of the credible interval. 24 | } 25 | \item{ROPE}{ 26 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the estimate; see Details. 27 | } 28 | \item{showCurve}{ 29 | logical: if TRUE, the posterior density will be represented by a kernel density function instead of a histogram. 30 | } 31 | \item{compVal}{ 32 | a value for comparison with the (difference of) parameters. 33 | } 34 | \item{mainColor}{ 35 | an optional color name such as \code{"skyblue"} or a RGB specification such as \code{"#87CEEB"} that controls the color of the bar charts and posterior prediction lines. 36 | } 37 | \item{dataColor}{ 38 | an optional color name such as \code{"red"} or a RGB specification such as \code{"#FF0000"} that controls the color of the data histogram. 39 | } 40 | \item{comparisonColor}{ 41 | a optional color name such as \code{"darkgreen"} or a RGB specification such as \code{"#013220"} that controls the color used to display the \code{compVal}. 42 | } 43 | \item{ROPEColor}{ 44 | a optional color name such as \code{"darkred"} or a RGB specification such as \code{"#8B0000"} that controls the color used to display the ROPE. 45 | } 46 | \item{...}{ 47 | other graphical parameters. 48 | } 49 | } 50 | \details{ 51 | The posterior distribution is shown as a histogram or density curve (if \code{showCurve = TRUE}), together with the Highest Density Interval. A ROPE and comparison value are also shown if appropriate. 52 | 53 | The probability that the difference in means (or effect size, etc.) is precisely zero is zero. More interesting is the probability that the difference may be too small to matter. We can define a region of practical equivalence (ROPE) around zero, and obtain the posterior probability that the true value lies therein. 54 | } 55 | \value{ 56 | Returns an object of class \code{histogram} invisibly. Used mainly for the side effect. 57 | } 58 | \references{ 59 | Kruschke, J. K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 60 | } 61 | \author{ 62 | Mike Meredith, adapted from code by John Kruschke. 63 | } 64 | 65 | \seealso{ 66 | \code{\link{plotAll}} for a single plot showing all the parameters, \code{\link[=summary.BEST]{summary}} for values of the corresponding summary statistics and \code{\link[=pairs.BEST]{pairs}} for a scatterplot matrix plot and correlation coefficients. 67 | } 68 | \examples{ 69 | # See examples in BEST-package. 70 | } 71 | 72 | -------------------------------------------------------------------------------- /man/plotAll.Rd: -------------------------------------------------------------------------------- 1 | \name{plotAll} 2 | \alias{plotAll} 3 | \title{ 4 | A series of plots displaying the results of 'BEST' analysis. 5 | } 6 | \description{ 7 | Displays a series of plots showing the posterior probability distributions of the parameters of interest. 8 | } 9 | \usage{ 10 | plotAll(BESTobj, credMass = 0.95, 11 | ROPEm = NULL, ROPEsd = NULL, ROPEeff = NULL, 12 | compValm = 0, compValsd = NULL, compValeff = 0, 13 | showCurve = FALSE, 14 | mainColor="skyblue", dataColor="red", comparisonColor="darkgreen", 15 | ROPEColor = "darkred",...) 16 | } 17 | \arguments{ 18 | \item{BESTobj}{ 19 | an object of class \code{BEST}, as produced by the function \code{\link{BESTmcmc}}. 20 | } 21 | \item{credMass}{ 22 | the probability mass to include in credible intervals, or NULL to suppress plotting of the credible interval. 23 | } 24 | \item{ROPEm}{ 25 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the difference of means (for 2 groups) or the mean (for 1 group). 26 | } 27 | \item{ROPEsd}{ 28 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the (difference of) standard deviations. 29 | } 30 | \item{ROPEeff}{ 31 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the effect size. 32 | } 33 | \item{showCurve}{ 34 | logical: if TRUE, the posterior density will be represented by a kernel density function instead of a histogram. 35 | } 36 | \item{compValm}{ 37 | a value for comparison with the (difference of) means. 38 | } 39 | \item{compValsd}{ 40 | a value for comparison with the (difference of) standard deviations. 41 | } 42 | \item{compValeff}{ 43 | a value for comparison with the effect size. 44 | } 45 | \item{mainColor}{ 46 | an optional color name such as \code{"skyblue"} or a RGB specification such as \code{"#87CEEB"} that controls the color of the histograms and posterior prediction lines. 47 | } 48 | \item{dataColor}{ 49 | an optional color name such as \code{"red"} or a RGB specification such as \code{"#FF0000"} that controls the color of the data histogram. 50 | } 51 | \item{comparisonColor}{ 52 | an optional color name such as \code{"darkgreen"} or a RGB specification such as \code{"#013220"} that controls the color used to display \code{compVal}. 53 | } 54 | \item{ROPEColor}{ 55 | an optional color name such as \code{"darkred"} or a RGB specification such as \code{"#8B0000"} that controls the color used to display the ROPE. 56 | } 57 | \item{...}{ 58 | other graphical parameters (currently ignored). 59 | } 60 | } 61 | \details{ 62 | The display has a series of panels displaying the posterior distributions of each of the parameters (and differences between groups) together with summary statistics; see \code{\link{plotPost}} for details. 63 | Also a chart showing approx. 30 plots of posterior predictive distributions, together with histograms of the original data. 64 | } 65 | \value{ 66 | Returns NULL invisibly. Used for the side effect. 67 | } 68 | \references{ 69 | Kruschke, J. K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 70 | } 71 | \author{ 72 | Code by John Kruschke, modified by Mike Meredith. 73 | } 74 | 75 | \seealso{ 76 | \code{\link[=plot.BEST]{plot}} for plots of individual parameters, \code{\link[=summary.BEST]{summary}} for values of the corresponding summary statistics and \code{\link[=pairs.BEST]{pairs}} for a scatterplot matrix plot and correlation coefficients. 77 | } 78 | \examples{ 79 | # See examples in BEST-package. 80 | } 81 | 82 | -------------------------------------------------------------------------------- /man/plotAreaInROPE.Rd: -------------------------------------------------------------------------------- 1 | \name{plotAreaInROPE} 2 | \alias{plotAreaInROPE} 3 | 4 | \title{ 5 | Area of the posterior density in the ROPE as a function of its width. 6 | } 7 | \description{ 8 | Calculates and (optionally) plots the posterior probability mass included in the Region of Practical Equivalence (ROPE: see \code{\link{plot.BEST}}) as a function of the width of the ROPE. 9 | } 10 | 11 | \usage{ 12 | plotAreaInROPE(paramSampleVec, credMass = 0.95, compVal = 0, maxROPEradius, 13 | n = 201, plot = TRUE, ROPEColor = "darkred", ...) 14 | } 15 | 16 | \arguments{ 17 | \item{paramSampleVec}{ 18 | A vector of samples drawn from the target distribution; see Examples. 19 | } 20 | \item{credMass}{ 21 | The probability mass to include in credible intervals. 22 | } 23 | \item{compVal}{ 24 | a value for comparison with those plotted. 25 | } 26 | \item{maxROPEradius}{ 27 | The maximum value of the ROPE radius (ie. half-width) to include in the plot. 28 | } 29 | \item{n}{ 30 | The number of equally spaced points at which the area in the ROPE is to be estimated. 31 | } 32 | \item{plot}{ 33 | If FALSE, the plot will be suppressed but the values will be returned. 34 | } 35 | \item{ROPEColor}{ 36 | an optional color name such as \code{"darkred"} or a RGB specification such as \code{"#8B0000"} that controls the color used to plot the ROPE. 37 | } 38 | \item{\dots}{ 39 | Other graphical parameters. 40 | } 41 | } 42 | 43 | \details{ 44 | Defining a Region of Practical Equivalence (ROPE) allows decisions on whether a parameter is, for practical purposes, equivalent to a hypothetical null value, given a posterior probability density for the parameter. The null value may be considered credible if (A) 95\% (say) of the probability mass lies within the ROPE, or (B) the 95\% highest density interval (95\% HDI) lies entirely within the ROPE. 45 | 46 | How wide should the ROPE be? Different people at different times will have different ideas on the range of values equivalent to the null. The function \code{plotAreaInROPE} plots the probability mass lying within the ROPE for a range of widths (or rather radii or half-widths). It also shows the radius at which the HDI falls entirely within the ROPE. 47 | } 48 | \value{ 49 | Returns invisibly a list with elements: 50 | \item{x }{A vector of ROPE radii from 0 to \code{maxROPEradius}.} 51 | \item{y }{The corresponding proportion of the posterior density included in the ROPE.} 52 | } 53 | \references{ 54 | \url{http://doingbayesiandataanalysis.blogspot.com/2013/08/how-much-of-bayesian-posterior.html} 55 | } 56 | \author{ 57 | John K. Kruschke, with minor modifications by Mike Meredith. 58 | } 59 | 60 | \examples{ 61 | # Generate a fake MCMC posterior for effect size and plot it: 62 | mcmcChain <- rnorm(50000,0.03,0.025) 63 | plotPost(mcmcChain, compVal=0, ROPE=c(-0.1, 0.1)) 64 | 65 | # How does the mass within the ROPE vary with ROPE radius? 66 | plotAreaInROPE(mcmcChain, credMass = 0.95, compVal = 0, 67 | maxROPEradius = 0.15) 68 | 69 | \donttest{ 70 | # Generate real MCMC chains, takes up to 1 min: 71 | y1 <- c(4.77, 4.33, 3.59, 3.33, 2.66, 3.48) 72 | y2 <- c(3.88, 3.55, 3.29, 2.59, 2.33, 3.59) 73 | BESTout <- BESTmcmc(y1, y2, parallel=FALSE) 74 | plot(BESTout) 75 | 76 | meanDiff <- BESTout$mu1 - BESTout$mu2 77 | plotAreaInROPE(meanDiff, credMass = 0.95, compVal = 0, 78 | maxROPEradius = 3) 79 | } 80 | } 81 | \keyword{hplot} 82 | -------------------------------------------------------------------------------- /man/plotPost.Rd: -------------------------------------------------------------------------------- 1 | \name{plotPost} 2 | \alias{plotPost} 3 | \title{ 4 | Graphic display of a posterior probability distribution 5 | } 6 | \description{ 7 | Plot the posterior probability distribution for a single parameter from a vector of samples, typically from an MCMC process, with appropriate summary statistics. 8 | } 9 | \usage{ 10 | plotPost(paramSampleVec, credMass = 0.95, compVal = NULL, ROPE = NULL, 11 | HDItextPlace = 0.7, showMode = FALSE, showCurve = FALSE, 12 | mainColor="skyblue", comparisonColor="darkgreen", ROPEColor = "darkred", 13 | ...) 14 | } 15 | \arguments{ 16 | \item{paramSampleVec}{ 17 | A vector of samples drawn from the target distribution. 18 | } 19 | \item{credMass}{ 20 | the probability mass to include in credible intervals, or NULL to suppress plotting of credible intervals. 21 | } 22 | \item{compVal}{ 23 | a value for comparison with those plotted. 24 | } 25 | \item{ROPE}{ 26 | a two element vector, such as \code{c(-1, 1)}, specifying the limits of the Region Of Practical Equivalence. 27 | } 28 | \item{HDItextPlace}{ 29 | a value in [0,1] that controls the horizontal position of the labels at the ends of the HDI bar. 30 | } 31 | \item{showMode}{ 32 | logical: if TRUE, the mode is displayed instead of the mean. 33 | } 34 | \item{showCurve}{ 35 | logical: if TRUE, the posterior density will be represented by a kernel density function instead of a histogram. 36 | } 37 | \item{mainColor}{ 38 | an optional color name such as \code{"skyblue"} or a RGB specification such as \code{"#87CEEB"} that controls the color of the histograms and posterior prediction lines. 39 | } 40 | \item{comparisonColor}{ 41 | an optional color name such as \code{"darkgreen"} or a RGB specification such as \code{"#013220"} that controls the color used to display \code{compVal}. 42 | } 43 | \item{ROPEColor}{ 44 | an optional color name such as \code{"darkred"} or a RGB specification such as \code{"#8B0000"} that controls the color used to display the ROPE. 45 | } 46 | \item{\dots}{ 47 | graphical parameters and the \code{breaks} parameter for the histogram. 48 | } 49 | } 50 | \details{ 51 | The data are plotted either as a histogram (above) or, if \code{showCurve = TRUE}, as a fitted kernel density curve (below). Either the mean or the mode of the distribution is displayed, depending on the parameter \code{showMode.} The Highest Density Interval (HDI) is shown as a horizontal bar, with labels for the ends of the interval. 52 | 53 | \figure{plotPost1.jpg} \cr 54 | \cr 55 | \figure{plotPost2.jpg} 56 | 57 | If values for a ROPE are supplied, these are shown as vertical dashed lines (dark red by default), together with the percentage of probability mass within the ROPE. If a comparison value (\code{compVal}) is supplied, this is shown as a vertical dotted line (green by default), together with the probability mass below and above this value. 58 | } 59 | \value{ 60 | Returns an object of class \code{histogram} invisibly. Used for its plotting side-effect. 61 | } 62 | \author{ 63 | John Kruschke, modified by Mike Meredith 64 | } 65 | 66 | \seealso{ 67 | For details of the HDI calculation, see \code{\link{hdi}}. 68 | } 69 | \examples{ 70 | # Generate some data 71 | tst <- rnorm(1e5, 3, 1) 72 | plotPost(tst) 73 | plotPost(tst, credMass=0.8, ROPE=c(-1,1), xlab="Response variable") 74 | plotPost(tst, showMode=TRUE, showCurve=TRUE, compVal=5.5) 75 | 76 | # Custom colors 77 | plotPost(tst, mainColor='wheat', border='magenta') 78 | plotPost(tst, credMass=0.8, compVal=0, ROPE=c(-1,1), xlab="Response variable", 79 | comparisonColor="#880088", ROPEColor = "darkblue") 80 | plotPost(tst, showMode=TRUE, showCurve=TRUE, compVal=5.5, 81 | mainColor=2, comparisonColor=4) 82 | 83 | # For integers: 84 | tst <- rpois(1e5, 12) 85 | plotPost(tst) 86 | 87 | # A severely bimodal distribution: 88 | tst2 <- c(rnorm(1e5), rnorm(5e4, 7)) 89 | plotPost(tst2) # A valid 95% CrI, but not HDI 90 | plotPost(tst2, showCurve=TRUE) # Correct 95% HDI 91 | 92 | } 93 | \keyword{hplot} -------------------------------------------------------------------------------- /man/plotPostPred.Rd: -------------------------------------------------------------------------------- 1 | \name{plotPostPred} 2 | \alias{plotPostPred} 3 | \title{ 4 | Plots for Posterior Predictive checks. 5 | } 6 | \description{ 7 | Plots a number (default 30) of credible t-distributions based on posterior values of the mean, standard deviation, and normality for each group, together with histograms of the data. 8 | } 9 | \usage{ 10 | plotPostPred(BESTobj, nCurvesToPlot = 30, mainColor="skyblue", dataColor="red") 11 | } 12 | \arguments{ 13 | \item{BESTobj}{ 14 | an object of class \code{BEST}, as produced by the function \code{\link{BESTmcmc}}. 15 | } 16 | \item{nCurvesToPlot}{ 17 | the number of posterior predictive curves to plot. 18 | } 19 | \item{mainColor}{ 20 | an optional color name such as \code{"skyblue"} or a RGB specification such as \code{"#87CEEB"} that controls the color of the posterior prediction lines. 21 | } 22 | \item{dataColor}{ 23 | an optional color name such as \code{"red"} or a RGB specification such as \code{"#FF0000"} that controls the color of the data histogram. 24 | } 25 | } 26 | 27 | \value{ 28 | Nothing, used for its side effect. 29 | } 30 | \references{ 31 | Kruschke, J. K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 32 | } 33 | \author{ 34 | John Kruschke, modified by Mike Meredith. 35 | } 36 | 37 | \examples{ 38 | ## See examples in BEST-package. 39 | } 40 | 41 | \keyword{hplot} 42 | -------------------------------------------------------------------------------- /man/postPriorOverlap.Rd: -------------------------------------------------------------------------------- 1 | \name{postPriorOverlap} 2 | \alias{postPriorOverlap} 3 | \title{ 4 | Overlap between posterior and prior probability distributions. 5 | } 6 | \description{ 7 | Calculates and displays the overlap between a posterior distribution (as a vector of samples, typically from an MCMC process) and a prior distribution (as a vector of samples or as a function). Unidentifiable parameters will have high overlap: Gimenez et al (2009) suggest that overlap greater than 35\% indicates weak identifiability. 8 | } 9 | \usage{ 10 | postPriorOverlap(paramSampleVec, prior, ..., yaxt="n", ylab="", 11 | xlab="Parameter", main="", cex.lab=1.5, cex=1.4, 12 | xlim=range(paramSampleVec), breaks=NULL, 13 | mainColor="skyblue", priorColor="yellow", overlapColor="green") 14 | } 15 | \arguments{ 16 | \item{paramSampleVec}{ 17 | a vector of samples drawn from the target distribution. 18 | } 19 | \item{prior}{ 20 | \emph{either} a vector of samples drawn from the prior distribution \emph{or} the name for the density function of the distribution; standard R functions for this have a \code{d-} prefix, eg. \code{dbeta}. Arguments required by the function must be specified by their (abbreviated) names in the \code{\dots} argument; see the examples. 21 | } 22 | \item{...}{ 23 | named parameters to be passed to \code{prior} when it is a function. 24 | } 25 | \item{yaxt}{ 26 | a character which specifies the y axis type; the default, "n", suppresses plotting. 27 | } 28 | \item{ylab}{ 29 | text to use as the label of the y axis. 30 | } 31 | \item{xlab}{ 32 | text to use as the label of the x axis. 33 | } 34 | \item{cex.lab}{ 35 | the magnification to be used for x and y labels relative to the current setting of \code{cex} 36 | } 37 | \item{cex}{ 38 | a numerical value giving the amount by which plotting text and symbols should be magnified relative to the default 39 | } 40 | \item{xlim}{ 41 | a vector of length 2 giving the limits for the x axis. 42 | } 43 | \item{main}{ 44 | text to use as the main title of the plot 45 | } 46 | \item{breaks}{ 47 | controls the histogram break points or the number of bars; see \code{\link{hist}}. 48 | } 49 | \item{mainColor}{ 50 | an optional color name such as \code{"skyblue"} or a RGB specification such as \code{"#87CEEB"} that controls the color of the histogram representing the posterior. 51 | } 52 | \item{priorColor}{ 53 | an optional color name such as \code{"yellow"} or a RGB specification such as \code{"#FFFF00"} that controls the color of prior, both if it is data and when it is a function. 54 | } 55 | \item{overlapColor}{ 56 | an optional color name such as \code{"green"} or a RGB specification such as \code{"#00FF00"} that controls the color of the overlap area. 57 | } 58 | } 59 | \value{ 60 | Returns the overlap, the area lying under the lower of the two density curves. 61 | } 62 | \references{ 63 | Gimenez, Morgan and Brooks (2009) Weak identifiability in models for mark-recapture-recovery data. pp.1055-1068 in Thomson, Cooch and Conroy (eds) \emph{Modeling demographic processes in marked populations} Springer 64 | } 65 | \author{ 66 | Mike Meredith 67 | } 68 | 69 | \examples{ 70 | # Generate some data 71 | tst <- rbeta(1e6, 5, 7) 72 | 73 | # check overlap with a Beta(0.2, 0.2) prior: 74 | postPriorOverlap(tst, dbeta, shape1=0.2, shape2=0.2) 75 | 76 | # check overlap with a Uniform(0, 1) prior: 77 | postPriorOverlap(tst, runif(1e6)) 78 | 79 | } 80 | -------------------------------------------------------------------------------- /man/print.BEST.Rd: -------------------------------------------------------------------------------- 1 | \name{print.BEST} 2 | \alias{print.BEST} 3 | \title{ 4 | Printing a BEST object 5 | } 6 | \description{ 7 | Print method for objects of class \code{BEST}, such as produced by \code{\link{BESTmcmc}}. 8 | } 9 | \usage{ 10 | \method{print}{BEST}(x, digits = 4, ...) 11 | } 12 | \arguments{ 13 | \item{x}{ 14 | an object of class \code{BEST}, as produced by \code{BESTmcmc}. 15 | } 16 | \item{digits}{ 17 | the number of digits to print. 18 | } 19 | \item{\dots}{ 20 | further arguments for the print function. 21 | } 22 | } 23 | \details{ 24 | The print method displays summary statistics for the parameters and two MCMC diagnostic measures: 25 | 26 | \code{Rhat} is the 'potential scale reduction factor', which is 1 on convergence; if any parameter has a value > 1.05, rerun with increased \code{burnInSteps}. See \code{\link[coda]{gelman.diag}}. 27 | 28 | \code{n.eff} is the sample size adjusted for autocorrelation; for stable estimates of credible intervals this should be > 10,000. Rerun with increased \code{numSavedSteps} or increased \code{thinSteps}. See \code{\link[coda]{effectiveSize}}. 29 | } 30 | \value{ 31 | Returns \code{x} invisibly. 32 | } 33 | \author{ 34 | Mike Meredith 35 | } 36 | 37 | \seealso{ 38 | \code{\link{BESTmcmc}}. 39 | } 40 | \examples{ 41 | ## See examples in BEST-package help. 42 | } 43 | \keyword{print} 44 | -------------------------------------------------------------------------------- /man/summary.BEST.Rd: -------------------------------------------------------------------------------- 1 | \name{summary.BEST} 2 | \alias{summary.BEST} 3 | 4 | \title{ 5 | Extract summary statistics from an object of class BEST. 6 | } 7 | \description{ 8 | Provides summary statistics for each of the parameters (mean and standard deviation) of the group(s) of observations and their differences. 9 | } 10 | \usage{ 11 | \method{summary}{BEST}(object, credMass = 0.95, 12 | ROPEm = NULL, ROPEsd = NULL, ROPEeff = NULL, 13 | compValm = 0, compValsd = NULL, compValeff = 0, ...) 14 | 15 | } 16 | \arguments{ 17 | \item{object}{ 18 | an object of class \code{BEST}, as produced by the function \code{\link{BESTmcmc}}. 19 | } 20 | \item{credMass}{ 21 | the probability mass to include in credible intervals. 22 | } 23 | \item{ROPEm}{ 24 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the difference of means (for 2 groups) or the mean (for 1 group). See \code{\link{plot.BEST}} for an explanation of ROPE. 25 | } 26 | \item{ROPEsd}{ 27 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the (difference of) standard deviations. 28 | } 29 | \item{ROPEeff}{ 30 | a two element vector, such as \code{c(-1, 1)}, specifying the limit of the ROPE on the effect size. 31 | } 32 | \item{compValm}{ 33 | a value for comparison with the (difference of) means. 34 | } 35 | \item{compValsd}{ 36 | a value for comparison with the (difference of) standard deviations. 37 | } 38 | \item{compValeff}{ 39 | a value for comparison with the effect size. 40 | } 41 | \item{\dots}{ 42 | additional arguments for the summary or print function. 43 | } 44 | 45 | } 46 | \value{ 47 | Returns a matrix with the parameters in rows and the following columns: 48 | \item{mean, median, mode}{ the mean, median and mode of the MCMC samples for the corresponding parameter.} 49 | \item{hdi\%, hdiLow, hdiHigh}{the percentage of posterior probability mass included in the highest density interval and the lower and upper limits.} 50 | \item{compVal, \%>compVal}{the value for comparison and the percentage of the posterior probability mass above that value.} 51 | \item{ROPElow, ROPEhigh, \%InROPE}{the lower and upper limits of the Region Of Practical Equivalence (ROPE) and the percentage of the posterior probability mass within the region.} 52 | 53 | If the analysis concerns a comparison of two groups, the matrix will have rows for: 54 | \item{mu1, mu2, muDiff}{the means of each group and the difference in means} 55 | \item{sigma1, sigma2, sigmaDiff}{the standard deviations of each group and the difference in standard deviations} 56 | \item{nu, log10nu}{the normality parameter and its log} 57 | \item{effSz}{the effect size; \eqn{d[a]} from Macmillan & Creelman (1991).} 58 | 59 | For a single group, the rows will be: 60 | \item{mu}{the mean} 61 | \item{sigma}{the standard deviation} 62 | \item{nu, log10nu}{the normality parameter and its log} 63 | \item{effSz}{the effect size.} 64 | 65 | Many of the elements of the matrix will be NA. The print method for the summary attempts to print this nicely. 66 | } 67 | \references{ 68 | Kruschke, J K. 2013. Bayesian estimation supersedes the \emph{t} test. \emph{Journal of Experimental Psychology: General} 142(2):573-603. doi: 10.1037/a0029146 69 | 70 | Macmillan, N. A., & Creelman, C. D. (1991). \emph{Detection Theory: A User's Guide}. New York, Cambridge University Press 71 | } 72 | \author{ 73 | Mike Meredith, based on code by John K. Kruschke. 74 | } 75 | 76 | \seealso{ 77 | Use the \code{\link{plotAll}} function for a graphical display of these same values. 78 | } 79 | \examples{ 80 | ## see "BEST-package" 81 | } 82 | 83 | \keyword{methods} -------------------------------------------------------------------------------- /vignettes/BEST.Rnw: -------------------------------------------------------------------------------- 1 | 2 | \documentclass[a4paper]{article} 3 | 4 | %\VignetteIndexEntry{Introduction to BEST} 5 | 6 | \title{Bayesian Estimation Supersedes the t-Test} 7 | \author{Mike Meredith and John Kruschke} 8 | 9 | \usepackage[section]{placeins} % Forces figs to be placed in current section 10 | \usepackage[usenames,dvipsnames,svgnames]{xcolor} 11 | \usepackage[authoryear,round]{natbib} % Format for in-text citations 12 | \usepackage[pdfstartview=]{hyperref} % hypertext links 13 | \usepackage{graphicx, Rd} 14 | \usepackage{float} 15 | \usepackage{Sweave} 16 | 17 | \begin{document} 18 | 19 | \maketitle 20 | 21 | <>= 22 | options(continue=" ") 23 | @ 24 | 25 | \section{Introduction} 26 | \label{sec:intro} 27 | 28 | The BEST package provides a Bayesian alternative to a \emph{t} test, providing much richer information about the samples and the difference in means than a simple \emph{p} value. 29 | 30 | Bayesian estimation for two groups provides complete distributions of credible values for the effect size, group means and their difference, standard deviations and their difference, and the normality of the data. For a single group, distributions for the mean, standard deviation and normality are provided. The method handles outliers. 31 | 32 | The decision rule can accept the null value (unlike traditional \emph{t} tests) when certainty in the estimate is high (unlike Bayesian model comparison using Bayes factors). 33 | 34 | The package also provides methods to estimate statistical power for various research goals. 35 | 36 | \section{The Model} 37 | \label{sec:model} 38 | 39 | \begin{figure} 40 | \centering 41 | \includegraphics{BESTmodel.jpg} 42 | \caption{\it Hierarchical diagram of the descriptive model for robust Bayesian estimation.} 43 | \label{fig:model} 44 | \end{figure} 45 | 46 | To accommodate outliers we describe the data with a distribution that has fatter tails than the normal distribution, namely the \emph{t} distribution. (Note that we are using this as a convenient description of the data, not as a sampling distribution from which \emph{p} values are derived.) The relative height of the tails of the \emph{t} distribution is governed by the shape parameter $\nu$: when $\nu$ is small, the distribution has heavy tails, and when it is large (e.g., 100), it is nearly normal. Here we refer to $\nu$ as the normality parameter. 47 | 48 | The data (\emph{y}) are assumed to be independent and identically distributed (i.i.d.) draws from a \emph{t} distribution with different mean ($\mu$) and standard deviation ($\sigma$) for each population, and with a common normality parameter ($\nu$), as indicated in the lower portion of Figure~\ref{fig:model}. 49 | 50 | The default priors, with \verb@priors = NULL@, are minimally informative: normal priors with large standard deviation for ($\mu$), broad uniform priors for ($\sigma$), and a shifted-exponential prior for ($\nu$), as described by \citet{Kruschke2013BEST}. 51 | You can specify your own priors by providing a list: population means ($\mu$) have separate normal priors, with mean \verb@muM@ and standard deviation \verb@muSD@; population standard deviations ($\sigma$) have separate gamma priors, with \emph{mode} \verb@sigmaMode@ and standard deviation \verb@sigmaSD@; the normality parameter ($\nu$) has a gamma prior with \emph{mean} \verb@nuMean@ and standard deviation \verb@nuSD@. 52 | These priors are indicated in the upper portion of Figure~\ref{fig:model}. 53 | 54 | For a general discussion see chapters 11 and 12 of \citet{Kruschke2015book}. 55 | 56 | \section{Preparing to run BEST} 57 | \label{sec:prepare} 58 | 59 | BEST uses the JAGS package \citep{Plummer2003} to produce samples from the posterior distribution of each parameter of interest. You will need to download JAGS from \url{http://sourceforge.net/projects/mcmc-jags/} and install it before running BEST. 60 | 61 | BEST also requires the packages \verb@rjags@ and \verb@coda@, which should normally be installed at the same time as package BEST if you use the \verb@install.packages@ function in \R{}. 62 | 63 | Once installed, we need to load the BEST package at the start of each \R{} session, which will also load rjags and coda and link to JAGS: 64 | <>= 65 | library(BEST) 66 | @ 67 | 68 | \section{An example with two groups} 69 | \label{sec:grps2} 70 | 71 | \subsection{Some example data} 72 | \label{subsec:data2g} 73 | 74 | We will use hypothetical data for reaction times for two groups ($N_1 = N_2 = 6$), Group 1 consumes a drug which may increase reaction times while Group 2 is a control group that consumes a placebo. 75 | 76 | <>= 77 | y1 <- c(5.77, 5.33, 4.59, 4.33, 3.66, 4.48) 78 | y2 <- c(3.88, 3.55, 3.29, 2.59, 2.33, 3.59) 79 | @ 80 | 81 | Based on previous experience with these sort of trials, we expect reaction times to be approximately 6 secs, but they vary a lot, so we'll set \verb@muM = 6@ and \verb@muSD = 2@. We'll use the default priors for the other parameters: \verb@sigmaMode = sd(y), sigmaSD = sd(y)*5, nuMean = 30, nuSD = 30)@, where \verb@y = c(y1, y2)@. 82 | 83 | <>= 84 | priors <- list(muM = 6, muSD = 2) 85 | @ 86 | 87 | 88 | 89 | \subsection{Running the model} 90 | \label{subsec:run2g} 91 | 92 | We run BESTmcmc and save the result in BESTout. We do not use parallel processing here, but if your machine has at least 4 cores, parallel processing cuts the time by 50\%. 93 | 94 | % reduce numSavedSteps = 1e+03 for trial runs. 95 | % hide results as rjags output does not format properly 96 | <>= 97 | BESTout <- BESTmcmc(y1, y2, priors=priors, parallel=FALSE) 98 | @ 99 | 100 | \begin{verbatim} 101 | Compiling model graph 102 | Resolving undeclared variables 103 | Allocating nodes 104 | Graph information: 105 | Observed stochastic nodes: 12 106 | Unobserved stochastic nodes: 5 107 | Total graph size: 51 108 | 109 | Initializing model 110 | 111 | |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% 112 | 113 | Sampling from the posterior distributions: 114 | |**************************************************| 100% 115 | \end{verbatim} 116 | 117 | \subsection{Basic inferences} 118 | \label{subsec:infer2g} 119 | 120 | The default plot (Figure~\ref{fig:means2g}) is a histogram of the posterior distribution of the difference in means. 121 | <>= 122 | plot(BESTout) 123 | @ 124 | 125 | \begin{figure}[H] 126 | \centering 127 | \includegraphics{BEST-meanDiff2grps} 128 | \caption{\it Default plot: posterior probability of the difference in means.} 129 | \label{fig:means2g} 130 | \end{figure} 131 | 132 | <>= 133 | meanDiff <- (BESTout$mu1 - BESTout$mu2) 134 | meanDiffGTzero <- mean(meanDiff > 0) 135 | @ 136 | Also shown is the mean of the posterior probability, which is an appropriate point estimate of the true difference in means, the 95\% Highest Density Interval (HDI), and the posterior probability that the difference is greater than zero. The 95\% HDI does not include zero, and the probability that the true value is greater than zero is shown as \Sexpr{round(meanDiffGTzero*100, 1)}\%. Compare this with the output from a \emph{t} test: 137 | 138 | <>= 139 | t.test(y1, y2) 140 | @ 141 | 142 | Because we are dealing with a Bayesian posterior probability distribution, we can extract much more information: 143 | 144 | \begin{itemize} 145 | \item We can estimate the probability that the true difference in means is above (or below) an arbitrary \emph{comparison value}. For example, an increase reaction time of 1 unit may indicate that users of the drug should not drive or operate equipment. 146 | \item The probability that the difference in reaction times is precisely zero is zero. More interesting is the probability that the difference may be too small to matter. We can define a \emph{region of practical equivalence} (ROPE) around zero, and obtain the probability that the true value lies therein. For the reaction time example, a difference of $\pm$~0.1 may be too small to matter. 147 | \end{itemize} 148 | 149 | <>= 150 | plot(BESTout, compVal=1, ROPE=c(-0.1,0.1)) 151 | @ 152 | \begin{figure} 153 | \centering 154 | \includegraphics{BEST-meanDiff2grpsMore} 155 | \caption{\it Posterior probability of the difference in means with compVal=1.0 and ROPE $\pm$~0.1.} 156 | \label{fig:means2gMore} 157 | \end{figure} 158 | 159 | The annotations in (Figure~\ref{fig:means2gMore}) show a high probability that the reaction time increase is >~1. In this case it's clear that the effect is large, but if most of the probability mass (say, 95\%) lay within the ROPE, we would accept the null value for practical purposes. 160 | 161 | \bigskip 162 | BEST deals appropriately with differences in standard deviations between the samples and departures from normality due to outliers. We can check the difference in standard deviations or the normality parameter with \texttt{plot} (Figure~\ref{fig:sd2g}). 163 | 164 | <>= %Split into separate plots? 165 | plot(BESTout, which="sd") 166 | @ 167 | 168 | \begin{figure} 169 | \centering 170 | \includegraphics{BEST-sd2grps} 171 | \caption{\it Posterior plots for difference in standard deviation.} 172 | \label{fig:sd2g} 173 | \end{figure} 174 | 175 | The \texttt{summary} method gives us more information on the parameters of interest, including derived parameters: 176 | 177 | <>= 178 | summary(BESTout) 179 | @ 180 | 181 | Here we have summaries of posterior distributions for the derived parameters: difference in means (\texttt{muDiff}), difference in standard deviations (\texttt{sigmaDiff}) and effect size (\texttt{effSz}). As with the plot command, we can set values for \texttt{compVal} and \texttt{ROPE} for each of the parameters of interest: 182 | 183 | <>= 184 | summary(BESTout, credMass=0.8, ROPEm=c(-0.1,0.1), ROPEsd=c(-0.15,0.15), 185 | compValeff=1) 186 | @ 187 | 188 | 189 | 190 | \subsection{Checking convergence and fit} 191 | \label{subsec:checks2g} 192 | 193 | The output from \texttt{BESTmcmc} has class BEST, which has a \texttt{print} method: 194 | 195 | <>= 196 | class(BESTout) 197 | print(BESTout) 198 | @ 199 | 200 | The print function displays the mean, standard deviation and median of the posterior distributions of the parameters in the model, together with a 95\% Highest Density Interval: see the help page for the \texttt{hdi} function for details. 201 | Two convergence diagnostic measures are also displayed: 202 | 203 | \begin{itemize} 204 | \item \texttt{Rhat} is the Brooks-Gelman-Rubin scale reduction factor, which is 1 on convergence. \citet{Gelman&Shirley2011} consider values below 1.1 to be acceptable. Increase the \texttt{burnInSteps} argument to \texttt{BESTmcmc} if any of the \texttt{Rhat}s are too big. 205 | \item \texttt{n.eff} is the effective sample size, which is less than the number of simulations because of autocorrelation between successive values in the sample. Values of \texttt{n.eff} around 10,000 are needed for stable estimates of 95\% credible intervals.\footnote{See \url{http://doingbayesiandataanalysis.blogspot.com/2011/07/how-long-should-mcmc-chain-be-to-get.html} for some simulation results.} If any of the values is too small, you can increase the \texttt{numSavedSteps} or \texttt{thinSteps} arguments. 206 | \end{itemize} 207 | 208 | See the help pages for the \texttt{coda} package for more information on these measures. 209 | 210 | \bigskip 211 | As a further check, we can compare \emph{posterior predictive distributions} with the original data: 212 | 213 | <>= 214 | plotPostPred(BESTout) 215 | @ 216 | \begin{figure} 217 | \centering 218 | \includegraphics{BEST-ppd2grps} 219 | \caption{\it Posterior predictive plots together with a histogram of the data.} 220 | \label{fig:ppd2g} 221 | \end{figure} 222 | 223 | Each panel of Figure~\ref{fig:ppd2g} corresponds to one of the samples, and shows curves produced by selecting 30 random steps in the MCMC chain and plotting the \emph{t} distribution with the values of $\mu$, $\sigma$ and $\nu$ for that step. Also shown is a histogram of the actual data. We can visually assess whether the model is a reasonably good fit to the sample data (though this is easier for large samples then when $n=6$ as here). 224 | 225 | The function \texttt{plotAll} puts histograms of all the posterior distributions and the posterior predictive plots onto a single page (Figure~\ref{fig:plotAll2g}). 226 | 227 | <>= 228 | plotAll(BESTout) 229 | @ 230 | \begin{figure} 231 | \centering 232 | \includegraphics[width=0.9\textwidth]{BEST-plotAll2grps} 233 | \caption{\it All the posterior distributions and the posterior predictive plots.} 234 | \label{fig:plotAll2g} 235 | \end{figure} 236 | 237 | 238 | 239 | \subsection{Working with individual parameters} 240 | \label{subsec:attach2g} 241 | 242 | Objects of class \texttt{BEST} contain long vectors of simulated draws from the posterior distribution of each of the parameters in the model. Since \texttt{BEST} objects are also data frames, we can use the \$ operator to extract the columns we want: 243 | <>= 244 | names(BESTout) 245 | meanDiff <- (BESTout$mu1 - BESTout$mu2) 246 | meanDiffGTzero <- mean(meanDiff > 0) 247 | meanDiffGTzero 248 | @ 249 | For example, you may wish to look at the ratio of the variances rather than the difference in the standard deviations. You can calculate a vector of draws from the posterior distribution, calculate summary statistics, and plot the distribution with \texttt{plotPost} (Figure~\ref{fig:vars2g}): 250 | <>= 251 | varRatio <- BESTout$sigma1^2 / BESTout$sigma2^2 252 | median(varRatio) 253 | hdi(varRatio) 254 | mean(varRatio > 1) 255 | plotPost(varRatio, xlim=c(0, 30)) 256 | @ 257 | \begin{figure} 258 | \centering 259 | \includegraphics[width=0.6\textwidth]{BEST-vars2grps} 260 | \caption{\it Posterior distribution of the ratio of the sample variances.} 261 | \label{fig:vars2g} 262 | \end{figure} 263 | 264 | 265 | 266 | \section{An example with a single group} 267 | \label{sec:1grp} 268 | 269 | Applying BEST to a single sample, or for differences in paired observations, works in much the same way as the two-sample method and uses the same function calls. To run the model, simply use \texttt{BESTmcmc} with only one vector of observations. For this example, we'll use the broad priors described in \citet{Kruschke2013BEST}. 270 | 271 | % reduce numSavedSteps = 1e+03 for trial runs. 272 | % hide results as rjags output does not format properly 273 | <>= 274 | y0 <- c(1.89, 1.78, 1.30, 1.74, 1.33, 0.89) 275 | BESTout1g <- BESTmcmc(y0, priors=NULL, parallel=FALSE) 276 | @ 277 | \begin{verbatim} 278 | Compiling model graph 279 | Resolving undeclared variables 280 | Allocating nodes 281 | Graph information: 282 | Observed stochastic nodes: 6 283 | Unobserved stochastic nodes: 3 284 | Total graph size: 23 285 | 286 | Initializing model 287 | 288 | |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% 289 | 290 | Sampling from the posterior distributions: 291 | |**************************************************| 100% 292 | \end{verbatim} 293 | 294 | This time we have a single mean and standard deviation. The default plot (Figure~\ref{fig:mean1g}) shows the posterior distribution of the mean. 295 | <>= 296 | BESTout1g 297 | plot(BESTout1g) 298 | @ 299 | \begin{figure} 300 | \centering 301 | \includegraphics{BEST-mean1grp} 302 | \caption{\it Default plot: posterior probability distribution for the mean.} 303 | \label{fig:mean1g} 304 | \end{figure} 305 | 306 | Standard deviation, the normality parameter and effect size can be plotted individually, or on a single page with \texttt{plotAll} (Figure~\ref{fig:plotAll1g}). 307 | 308 | <>= 309 | plotAll(BESTout1g) 310 | @ 311 | \begin{figure} 312 | \centering 313 | \includegraphics[width=0.9\textwidth]{BEST-plotAll1grp} 314 | \caption{\it All the posterior distributions and the posterior predictive plots.} 315 | \label{fig:plotAll1g} 316 | \end{figure} 317 | 318 | And we can access the draws from the posterior distributions with the \$ operator: 319 | 320 | <>= 321 | names(BESTout1g) 322 | length(BESTout1g$nu) 323 | variance <- BESTout1g$sigma^2 324 | plotPost(variance, xlim=c(0, 3)) 325 | @ 326 | \begin{figure} 327 | \centering 328 | \includegraphics[width=0.6\textwidth]{BEST-attach1grp} 329 | \caption{\it Posterior distribution of the sample variance.} 330 | \label{fig:var1g} 331 | \end{figure} 332 | 333 | 334 | \section{What next?} 335 | \label{sec:whatNext} 336 | 337 | The package includes functions to estimate the power of experimental designs: see the help pages for \code{BESTpower} and \code{makeData} for details on implementation and \citet{Kruschke2013BEST} for background. 338 | 339 | 340 | If you want to know how the functions in the \code{BEST} package work, you can download the \R{} source code from CRAN or from GitHub \url{https://github.com/mikemeredith/BEST}. 341 | 342 | Bayesian analysis with computations performed by JAGS is a powerful approach to analysis. For a practical introduction see \citet{Kruschke2015book}. 343 | 344 | 345 | 346 | \renewcommand{\refname}{\section{References}} % Make "References" a proper, numbered section. 347 | \bibliographystyle{jss} 348 | 349 | \bibliography{BEST} 350 | 351 | \end{document} 352 | 353 | -------------------------------------------------------------------------------- /vignettes/BEST.bib: -------------------------------------------------------------------------------- 1 | 2 | @book{Gelman+04, 3 | Author = {Gelman, Andrew and Carlin, John B. and Stern, Hal S. and Rubin, Donald B.}, 4 | Title = "{B}ayesian data analysis", 5 | Publisher = {Chapman \& Hall/CRC}, 6 | Address = {Boca Raton}, 7 | Edition = {2}, 8 | Year = {2004} } 9 | 10 | @incollection{Gelman&Shirley2011, 11 | Author = {Gelman, Andrew and Shirley, Kenneth}, 12 | Title = "Inference from simulations and monitoring convergence", 13 | BookTitle = "Handbook of {M}arkov chain {M}onte {C}arlo", 14 | Editor = {Brooks, Steve and Gelman, Andrew and Jones, Galin and Meng, Xiao-Li}, 15 | Publisher = {Chapman \& Hall}, 16 | Pages = {163--174}, 17 | Year = {2011} } 18 | 19 | @book{Kruschke2015book, 20 | Author = {Kruschke, John K.}, 21 | Title = {Doing Bayesian data analysis: a tutorial with R, JAGS and Stan}, 22 | Publisher = {Elsevier}, 23 | Address = {Amsterdam etc}, 24 | Year = "2015" } 25 | 26 | @article{Kruschke2013BEST, 27 | Author = {Kruschke, John K.}, 28 | Title = "Bayesian estimation supersedes the \emph{t} test", 29 | Journal = "Journal of Experimental Psychology: General", 30 | Volume = "142", 31 | Number = "2", 32 | Pages = "573-603", 33 | Year = "2013" } 34 | 35 | @inproceedings{Plummer2003, 36 | Author = {Plummer, Martyn}, 37 | Title = "{JAGS}: A Program for Analysis of {B}ayesian Graphical Models Using {G}ibbs Sampling", 38 | BookTitle = {3rd International Workshop on Distributed Statistical Computing (DSC 2003)}, 39 | Address= {Vienna, Austria}, 40 | Year = {2003} } 41 | 42 | -------------------------------------------------------------------------------- /vignettes/BESTmodel.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mikemeredith/BEST/1c878c73cec13d3fc631700a912d3dbd27b8a03f/vignettes/BESTmodel.jpg --------------------------------------------------------------------------------