diff options
author | Ken Kellner <ken@kenkellner.com> | 2023-12-07 13:17:56 -0500 |
---|---|---|
committer | Ken Kellner <ken@kenkellner.com> | 2023-12-07 13:17:56 -0500 |
commit | 73ba3afb173749b8eb6883c7a1599a50c8bf67ec (patch) | |
tree | 14621c686db2442bd537a6bcbbd103a3dd4a44a3 | |
parent | 1ade4ccaeac22c0e6e7e67e61f4eede19cdfdb25 (diff) |
Organize DESCRIPTION and explicitly identify all functions from dependencies
-rw-r--r-- | DESCRIPTION | 6 | ||||
-rw-r--r-- | NAMESPACE | 37 | ||||
-rw-r--r-- | R/autojags.R | 4 | ||||
-rw-r--r-- | R/densityplot.R | 2 | ||||
-rw-r--r-- | R/mcmc_tools.R | 6 | ||||
-rw-r--r-- | R/process_input.R | 2 | ||||
-rw-r--r-- | R/process_output.R | 4 | ||||
-rw-r--r-- | R/run_rjags.R | 73 | ||||
-rw-r--r-- | R/traceplot.R | 2 | ||||
-rw-r--r-- | R/update.R | 2 |
10 files changed, 69 insertions, 69 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 697cf71..0300ec0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,12 +9,12 @@ Authors@R: c( Depends: R (>= 2.14.0), Imports: - rjags (>= 3-13), coda (>= 0.13), + graphics, + grDevices, parallel, + rjags (>= 3-13), stats, - grDevices, - graphics, utils Suggests: tinytest SystemRequirements: JAGS (http://mcmc-jags.sourceforge.net) @@ -1,22 +1,15 @@ -# import(lattice) # no longer needed? - -importFrom(rjags, "jags.model", "adapt", "coda.samples", "list.modules", - "load.module","unload.module","list.factories","set.factory") -importFrom(coda, "gelman.diag", "as.mcmc.list", "thin", "mcmc", "as.mcmc") -importFrom(parallel, "detectCores", "makeCluster", "clusterExport", - "clusterSetRNGStream", "clusterApply", "stopCluster", "clusterEvalQ") -importFrom(stats, "runif", "time", "start", "end", "quantile", "var", "sd") -importFrom(grDevices, "devAskNewPage", "rainbow") -importFrom(graphics, "plot", "abline", "axis", "box", "segments", "lines", "par", "legend") -importFrom(utils, "capture.output") - -export("jags", "jagsUI","jags.basic","autojags","pp.check", "traceplot", - "densityplot", "whiskerplot", "jags.View") - -S3method("plot", "jagsUI") -# S3method("xyplot", "jagsUI") -S3method("print","jagsUI") -S3method("update","jagsUI") -S3method("update","jagsUIbasic") -S3method("summary","jagsUI") - +export(autojags) +export(densityplot) +export(jags) +export(jagsUI) +export(jags.basic) +export(jags.View) +export(pp.check) +export(traceplot) +export(whiskerplot) + +S3method(plot, "jagsUI") +S3method(print,"jagsUI") +S3method(summary,"jagsUI") +S3method(update,"jagsUI") +S3method(update,"jagsUIbasic") diff --git a/R/autojags.R b/R/autojags.R index 3b1f809..74da81d 100644 --- a/R/autojags.R +++ b/R/autojags.R @@ -86,7 +86,7 @@ autojags <- function(data,inits=NULL,parameters.to.save,model.file,n.chains,n.ad if(verbose){cat('Update ',index,' (',mcmc.info$n.iter + iter.increment,')',sep="")} if(save.all.iter){ - if(index==2){start.iter <- start(samples)} + if(index==2){start.iter <- stats::start(samples)} if (index > 1) { old.samples <- samples } @@ -192,7 +192,7 @@ test.Rhat <- function(samples,cutoff,params.omit,verbose=TRUE){ expand <- sapply(strsplit(params, "\\["), "[", 1) gd <- function(hold){ - r <- try(gelman.diag(hold, autoburnin=FALSE)$psrf[1], silent=TRUE) + r <- try(coda::gelman.diag(hold, autoburnin=FALSE)$psrf[1], silent=TRUE) if(inherits(r, "try-error") || !is.finite(r)) { r <- NA } diff --git a/R/densityplot.R b/R/densityplot.R index 2f7209b..1ca2f2f 100644 --- a/R/densityplot.R +++ b/R/densityplot.R @@ -26,7 +26,7 @@ param_density <- function(x, parameter, m_labels=FALSE){ vals <- mcmc_to_mat(x$samples[,parameter]) if(any(is.na(vals))){ - plot(1:nrow(vals), rep(0, nrow(vals)), type='n', + graphics::plot(1:nrow(vals), rep(0, nrow(vals)), type='n', xlab='Value', ylab='Density', main=paste('Density of',parameter)) } else { # Get bandwidth, one value for all chains diff --git a/R/mcmc_tools.R b/R/mcmc_tools.R index 1c867a1..4dabba8 100644 --- a/R/mcmc_tools.R +++ b/R/mcmc_tools.R @@ -94,11 +94,13 @@ bind.mcmc <- function(mcmc.list1,mcmc.list2,start,n.new.iter){ d <- rbind(mcmc.list1[[i]],mcmc.list2[[i]]) - samples[[i]] <- mcmc(data=d,start=start,end=(end(mcmc.list1[[i]])+n.new.iter),thin=thin(mcmc.list1[i])) + samples[[i]] <- coda::mcmc(data=d,start=start, + end=(stats::end(mcmc.list1[[i]])+n.new.iter), + thin=coda::thin(mcmc.list1[i])) } - return(as.mcmc.list(samples)) + return(coda::as.mcmc.list(samples)) } diff --git a/R/process_input.R b/R/process_input.R index 15991b2..8092750 100644 --- a/R/process_input.R +++ b/R/process_input.R @@ -150,7 +150,7 @@ check_inits <- function(inits, n_chains){ # If not add them if(!has_RNG){ # Generate random seeds for each chain - chain_seeds <- floor(runif(n_chains, 1, 100000)) + chain_seeds <- floor(stats::runif(n_chains, 1, 100000)) for (i in 1:n_chains){ inits[[i]]$.RNG.name="base::Mersenne-Twister" inits[[i]]$.RNG.seed=chain_seeds[i] diff --git a/R/process_output.R b/R/process_output.R index a17ff48..68b66fb 100644 --- a/R/process_output.R +++ b/R/process_output.R @@ -169,14 +169,14 @@ calc_neff <- function(mcmc_list){ mcmc_mat <- mcmc_to_mat(mcmc_list) xdot <- apply(mcmc_mat, 2, mean, na.rm=TRUE) - s2 <- apply(mcmc_mat, 2, var, na.rm=TRUE) + s2 <- apply(mcmc_mat, 2, stats::var, na.rm=TRUE) W <- mean(s2) #Non-degenerate case if(is.na(W)){ n_eff <- NA } else if ((W > 1.e-8) && (nchain > 1)) { - B <- niter * var(xdot) + B <- niter * stats::var(xdot) sig2hat <- ((niter-1)*W + B)/ niter n_eff <- round(nchain * niter * min(sig2hat/B,1),0) } else { diff --git a/R/run_rjags.R b/R/run_rjags.R index 2cbe51a..0b107f4 100644 --- a/R/run_rjags.R +++ b/R/run_rjags.R @@ -53,16 +53,18 @@ run.model <- function(model.file=NULL, data=NULL, inits=NULL, parameters.to.save if(verbose | parallel==TRUE){ m$recompile() } else { - null <- capture.output(m$recompile()) + null <- utils::capture.output(m$recompile()) } } else { #Compile model if(verbose | parallel==TRUE){ - m <- jags.model(file=model.file,data=data,inits=inits,n.chains=n.chains,n.adapt=0) + m <- rjags::jags.model(file=model.file,data=data, + inits=inits,n.chains=n.chains,n.adapt=0) } else { - null <- capture.output( - m <- jags.model(file=model.file,data=data,inits=inits,n.chains=n.chains,n.adapt=0,quiet=TRUE) + null <- utils::capture.output( + m <- rjags::jags.model(file=model.file,data=data,inits=inits, + n.chains=n.chains,n.adapt=0,quiet=TRUE) ) } } @@ -75,11 +77,14 @@ run.model <- function(model.file=NULL, data=NULL, inits=NULL, parameters.to.save if(verbose){ cat('Adaptive phase,',n.adapt,'iterations x',n.chains,'chains','\n') cat('If no progress bar appears JAGS has decided not to adapt','\n','\n') - sufficient.adapt <- adapt(object=m, n.iter=n.adapt, progress.bar=pb, end.adaptation=TRUE) + sufficient.adapt <- rjags::adapt(object=m, n.iter=n.adapt, + progress.bar=pb, end.adaptation=TRUE) } else { - null <- capture.output( - sufficient.adapt <- adapt(object=m, n.iter=n.adapt, progress.bar=pb, end.adaptation=TRUE) - )} + null <- utils::capture.output( + sufficient.adapt <- rjags::adapt(object=m, n.iter=n.adapt, + progress.bar=pb, end.adaptation=TRUE) + ) + } total.adapt <- total.adapt + n.adapt } else{ if(verbose){cat('No adaptive period specified','\n','\n')} @@ -87,10 +92,10 @@ run.model <- function(model.file=NULL, data=NULL, inits=NULL, parameters.to.save #Force JAGS to not adapt (you have to allow it to adapt at least 1 iteration) if(!update){ if(verbose){ - sufficient.adapt <- adapt(object=m, n.iter=1, end.adaptation=TRUE) + sufficient.adapt <- rjags::adapt(object=m, n.iter=1, end.adaptation=TRUE) } else { - null <- capture.output( - sufficient.adapt <- adapt(object=m, n.iter=1, end.adaptation=TRUE) + null <- utils::capture.output( + sufficient.adapt <- rjags::adapt(object=m, n.iter=1, end.adaptation=TRUE) )} } total.adapt <- 0 @@ -102,17 +107,17 @@ run.model <- function(model.file=NULL, data=NULL, inits=NULL, parameters.to.save for (i in 1:maxloops){ if(verbose) cat('Adaptive phase.....','\n') - sufficient.adapt <- adapt(object=m, n.iter=n.adapt.iter, progress.bar='none') + sufficient.adapt <- rjags::adapt(object=m, n.iter=n.adapt.iter, progress.bar='none') total.adapt <- total.adapt + n.adapt.iter if(i==maxloops){ if(verbose){ warning(paste("Reached max of",maxloops*n.adapt.iter,"adaption iterations; set n.adapt to > 10000")) } - null <- adapt(object=m,n.iter=1,end.adaptation = TRUE) + null <- rjags::adapt(object=m,n.iter=1,end.adaptation = TRUE) break } if(sufficient.adapt){ - null <- adapt(object=m,n.iter=1,end.adaptation = TRUE) + null <- rjags::adapt(object=m,n.iter=1,end.adaptation = TRUE) if(verbose) cat('Adaptive phase complete','\n','\n') break } @@ -130,7 +135,7 @@ run.model <- function(model.file=NULL, data=NULL, inits=NULL, parameters.to.save update(object=m,n.iter=n.burnin,progress.bar=pb) cat('\n') } else { - null <- capture.output( + null <- utils::capture.output( update(object=m,n.iter=n.burnin,progress.bar=pb) )} } else if(verbose){ @@ -141,15 +146,15 @@ run.model <- function(model.file=NULL, data=NULL, inits=NULL, parameters.to.save if(verbose){ cat('Sampling from joint posterior,',(n.iter-n.burnin), 'iterations x',n.chains,'chains','\n','\n') - samples <- coda.samples(model=m, variable.names=parameters.to.save, - n.iter=(n.iter-n.burnin), thin=n.thin, - na.rm=na.rm, progress.bar=pb) + samples <- rjags::coda.samples(model=m, variable.names=parameters.to.save, + n.iter=(n.iter-n.burnin), thin=n.thin, + na.rm=na.rm, progress.bar=pb) cat('\n') } else { - null <- capture.output( - samples <- coda.samples(model=m, variable.names=parameters.to.save, - n.iter=(n.iter-n.burnin), thin=n.thin, - na.rm=na.rm, progress.bar=pb) + null <- utils::capture.output( + samples <- rjags::coda.samples(model=m, variable.names=parameters.to.save, + n.iter=(n.iter-n.burnin), thin=n.thin, + na.rm=na.rm, progress.bar=pb) ) } @@ -169,10 +174,10 @@ run.parallel <- function(data=NULL, inits=NULL, parameters.to.save, model.file=N current.libpaths <- .libPaths() #Set up clusters - cl <- makeCluster(n.cores) - on.exit(stopCluster(cl)) - clusterExport(cl = cl, ls(), envir = environment()) - clusterEvalQ(cl,.libPaths(current.libpaths)) + cl <- parallel::makeCluster(n.cores) + on.exit(parallel::stopCluster(cl)) + parallel::clusterExport(cl = cl, ls(), envir = environment()) + parallel::clusterEvalQ(cl,.libPaths(current.libpaths)) if(verbose){ cat('Beginning parallel processing using',n.cores, @@ -210,7 +215,7 @@ run.parallel <- function(data=NULL, inits=NULL, parameters.to.save, model.file=N } #Do parallel analysis - par <- clusterApply(cl=cl, x=1:n.chains, fun=jags.clust) + par <- parallel::clusterApply(cl=cl, x=1:n.chains, fun=jags.clust) #Create empty lists out <- samples <- model <- list() @@ -229,7 +234,7 @@ run.parallel <- function(data=NULL, inits=NULL, parameters.to.save, model.file=N model[[i]] <- par[[i]]$m sufficient.adapt[i] <- par[[i]]$sufficient.adapt } - out$samples <- as.mcmc.list(samples) + out$samples <- coda::as.mcmc.list(samples) # Remove columns with all NA try({ @@ -260,10 +265,10 @@ set.factories <- function(factories){ split <- strsplit(factories[i],'\\s')[[1]] #Check if requested factory is available - faclist <- as.character(list.factories(split[2])[,1]) + faclist <- as.character(rjags::list.factories(split[2])[,1]) if(split[1]%in%faclist){ - null <- set.factory(split[1],split[2],split[3]) + null <- rjags::set.factory(split[1],split[2],split[3]) } else{stop(paste('Requested factory',split[1],'is not available. Check that appropriate modules are loaded.'))} @@ -277,22 +282,22 @@ set.modules <- function(modules,DIC){ #Load/unload appropriate modules (besides dic) called.set <- c('basemod','bugs',modules) - current.set <- list.modules() + current.set <- rjags::list.modules() load.set <- called.set[!called.set%in%current.set] unload.set <- current.set[!current.set%in%called.set] if(length(load.set)>0){ for (i in 1:length(load.set)){ - load.module(load.set[i],quiet=TRUE) + rjags::load.module(load.set[i],quiet=TRUE) } } if(length(unload.set)>0){ for (i in 1:length(unload.set)){ - unload.module(unload.set[i],quiet=TRUE) + rjags::unload.module(unload.set[i],quiet=TRUE) } } if(DIC){ - load.module("dic",quiet=TRUE) + rjags::load.module("dic",quiet=TRUE) } } diff --git a/R/traceplot.R b/R/traceplot.R index 66069fb..6ee9b4b 100644 --- a/R/traceplot.R +++ b/R/traceplot.R @@ -32,7 +32,7 @@ param_trace <- function(x, parameter, m_labels=FALSE){ cols <- grDevices::rainbow(ncol(vals)) if(all(is.na(vals))){ - plot(1:nrow(vals), rep(0, nrow(vals)), type='n', + graphics::plot(1:nrow(vals), rep(0, nrow(vals)), type='n', xlab="Iterations", ylab="Value", main=bquote(.(parameter)*","~hat(R) == .(Rhat))) } else { @@ -99,7 +99,7 @@ update.jagsUIbasic <- function(object, parameters.to.save=NULL, # Set up MCMC info mcmc.info <- list(n.chains = length(object$samples), n.adapt = n.adapt, n.iter = n.iter, n.burnin = 0, - n.thin = ifelse(is.null(n.thin), thin(object$samples), n.thin), + n.thin = ifelse(is.null(n.thin), coda::thin(object$samples), n.thin), n.cores = object$n.cores) parallel <- names(object$model[1]) == "cluster1" |