From 60beffc79ea2809b11cd043ae87152525fa7e133 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Wed, 3 Jul 2024 13:34:18 -0400 Subject: [PATCH 01/15] Deprecate old simulate and powerAnalysis methods --- DESCRIPTION | 1 + NAMESPACE | 2 +- R/deprecated_sim_power.R | 1087 +++++++++++++++++ R/power.R | 442 +------ R/simulate.R | 641 +--------- man/powerAnalysis.Rd | 3 +- man/unmarkedPower-class.Rd | 4 + man/unmarkedPowerList.Rd | 4 + tests/testthat/test_IDS.R | 12 +- tests/testthat/test_occuCOP.R | 20 +- ...ysis.R => test_powerAnalysis_deprecated.R} | 13 +- tests/testthat/test_predict.R | 2 +- ..._simulate.R => test_simulate_deprecated.R} | 4 +- 13 files changed, 1133 insertions(+), 1102 deletions(-) create mode 100644 R/deprecated_sim_power.R rename tests/testthat/{test_powerAnalysis.R => test_powerAnalysis_deprecated.R} (93%) rename tests/testthat/{test_simulate.R => test_simulate_deprecated.R} (99%) diff --git a/DESCRIPTION b/DESCRIPTION index de315131..dc3cd7c5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -58,6 +58,7 @@ Collate: 'classes.R' 'unmarkedEstimate.R' 'mapInfo.R' 'unmarkedFrame.R' 'mixedModelTools.R' 'power.R' 'simulate.R' + 'deprecated_sim_power.R' 'predict.R' 'goccu.R' 'occuCOP.R' diff --git a/NAMESPACE b/NAMESPACE index c4bbc636..b1f0e70c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,7 +40,7 @@ exportClasses(unmarkedFit, unmarkedFitOccu, unmarkedFitOccuFP, unmarkedFitDS, unmarkedFrameGPC, unmarkedEstimate, unmarkedFitList, unmarkedModSel, unmarkedRanef, unmarkedFrameOccuMulti, unmarkedFrameOccuMS, unmarkedFrameGDR, unmarkedCrossVal, - unmarkedPostSamples, unmarkedPower, unmarkedPowerList) + unmarkedPostSamples, unmarkedPower_old, unmarkedPowerList_old) # Methods exportMethods(backTransform, coef, confint, coordinates, fitted, getData, diff --git a/R/deprecated_sim_power.R b/R/deprecated_sim_power.R new file mode 100644 index 00000000..8b18f729 --- /dev/null +++ b/R/deprecated_sim_power.R @@ -0,0 +1,1087 @@ +get_vars <- function(inp){ + if(is.list(inp)){ + out <- unique(unlist(lapply(inp, all.vars))) + } else { + out <- all.vars(inp) + } + names(out) <- out + out +} + +var_data <- function(var, guide, n){ + out <- rep(NA, n) + gv <- guide[[var]] + if(is.null(gv)){ + out <- stats::rnorm(n, 0, 1) + } else if(inherits(gv, "factor")){ + levs <- levels(gv) + out <- factor(sample(levs, n, replace=TRUE), levels=levs) + } else{ + gv$n <- n + out <- do.call(gv$dist, gv[!names(gv)=="dist"]) + } + out +} + +generate_data <- function(formulas, guide, n){ + vars <- get_vars(formulas) + if(length(vars)==0) return(NULL) + as.data.frame(lapply(vars, var_data, guide=guide, n=n)) +} + +capitalize <- function(inp){ + paste0(toupper(substring(inp,1,1)), + substring(inp,2,nchar(inp))) +} + +parse_func_name <- function(inp){ + if(!is.character(inp)){ + stop("Argument must be a character string", call.=FALSE) + } + capitalize(inp) +} + +blank_umFit <- function(fit_function){ + type <- parse_func_name(fit_function) + type <- ifelse(type=="Pcount", "PCount", type) + type <- ifelse(type=="MultinomPois", "MPois", type) + type <- ifelse(type=="Distsamp", "DS", type) + type <- ifelse(type=="Colext", "ColExt", type) + type <- ifelse(type=="Gdistsamp", "GDS", type) + type <- ifelse(type=="Gpcount", "GPC", type) + type <- ifelse(type=="Gmultmix", "GMM", type) + type <- ifelse(type=="PcountOpen", "PCO", type) + type <- ifelse(type=="DistsampOpen", "DSO", type) + type <- ifelse(type=="MultmixOpen", "MMO", type) + type <- ifelse(type=="Gdistremoval", "GDR", type) + type <- paste0("unmarkedFit", type) + new(type) +} + + +setMethod("simulate", "character", + function(object, nsim=1, seed=NULL, formulas, coefs=NULL, design, guide=NULL, ...){ + + .Deprecated("simulate", package=NULL, + msg = paste("Supplying the name of an unmarked fitting function to simulate will soon be removed from unmarked.\n", + "Use the simulate method for an unmarkedFrame instead. See the simulation vignette for more."), + old = as.character(sys.call(sys.parent()))[1L]) + model <- blank_umFit(object) + fit <- suppressWarnings(simulate_fit(model, formulas, guide, design, ...)) + coefs <- check_coefs_old(coefs, fit) + #fit <- replace_sigma(coefs, fit) + coefs <- generate_random_effects(coefs, fit) + fit <- replace_estimates(fit, coefs) + ysims <- suppressWarnings(simulate(fit, nsim)) + umf <- fit@data + # fix this + umfs <- lapply(ysims, function(x){ + if(object=="occuMulti"){ + umf@ylist <- x + } else if(object=="gdistremoval"){ + umf@yDistance=x$yDistance + umf@yRemoval=x$yRemoval + } else if(object == "IDS"){ + out <- list() + out$ds <- fit@data + out$ds@y <- x$ds + if("pc" %in% names(fit)){ + out$pc <- fit@dataPC + out$pc@y <- x$pc + } + if("oc" %in% names(fit)){ + out$oc <- fit@dataOC + out$oc@y <- x$oc + } + umf <- out + } else { + umf@y <- x + } + umf + }) + if(length(umfs)==1) umfs <- umfs[[1]] + umfs +}) + +# Insert specified random effects SD into proper S4 slot in model object +# This is mostly needed by GDR which uses the SD to calculate +# N with E_loglam (this is currently disabled so the function is not needed) +#replace_sigma <- function(coefs, fit){ +# required_subs <- names(fit@estimates@estimates) +# formulas <- sapply(names(fit), function(x) get_formula(fit, x)) +# rand <- lapply(formulas, lme4::findbars) +# if(!all(sapply(rand, is.null))){ +# rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars))) +# for (i in required_subs){ +# if(!is.null(rand[[i]][[1]])){ +# signame <- rvar[[i]] +# old_coefs <- coefs[[i]] +# fit@estimates@estimates[[i]]@randomVarInfo$estimates <- coefs[[i]][[signame]] +# } +# } +# } +# fit +#} + + + +setGeneric("get_umf_components", function(object, ...) standardGeneric("get_umf_components")) + +setMethod("get_umf_components", "unmarkedFit", + function(object, formulas, guide, design, ...){ + sc <- generate_data(formulas$state, guide, design$M) + oc <- generate_data(formulas$det, guide, design$J*design$M) + yblank <- matrix(0, design$M, design$J) + list(y=yblank, siteCovs=sc, obsCovs=oc) +}) + + +setGeneric("simulate_fit", function(object, ...) standardGeneric("simulate_fit")) + +setMethod("simulate_fit", "unmarkedFitOccu", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + umf <- unmarkedFrameOccu(y=parts$y, siteCovs=parts$siteCovs, + obsCovs=parts$obsCovs) + occu(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), + data=umf, se=FALSE, control=list(maxit=1)) +}) + +setMethod("simulate_fit", "unmarkedFitPCount", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + umf <- unmarkedFramePCount(y=parts$y, siteCovs=parts$siteCovs, + obsCovs=parts$obsCovs) + args <- list(...) + K <- ifelse(is.null(args$K), 100, args$K) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + pcount(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), + data=umf, mixture=mixture, K=K, se=FALSE, control=list(maxit=1)) +}) + +setMethod("simulate_fit", "unmarkedFitOccuRN", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + umf <- unmarkedFrameOccu(y=parts$y, siteCovs=parts$siteCovs, + obsCovs=parts$obsCovs) + occuRN(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), + data=umf, se=FALSE, control=list(maxit=1)) +}) + +setMethod("get_umf_components", "unmarkedFitMPois", + function(object, formulas, guide, design, ...){ + args <- list(...) + sc <- generate_data(formulas$state, guide, design$M) + oc <- generate_data(formulas$det, guide, design$J*design$M) + J <- ifelse(args$type=="double", 3, design$J) + yblank <- matrix(0, design$M, design$J) + list(y=yblank, siteCovs=sc, obsCovs=oc) +}) + +setMethod("simulate_fit", "unmarkedFitMPois", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + type <- ifelse(is.null(args$type), "removal", args$type) + umf <- unmarkedFrameMPois(y=parts$y, siteCovs=parts$siteCovs, + obsCovs=parts$obsCovs, type=type) + multinomPois(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), + data=umf, se=FALSE, control=list(maxit=1)) +}) + +setMethod("get_umf_components", "unmarkedFitDS", + function(object, formulas, guide, design, ...){ + #args <- list(...) + sc <- generate_data(formulas$state, guide, design$M) + sc2 <- generate_data(formulas$det, guide, design$M) + dat <- list(sc, sc2) + keep <- sapply(dat, function(x) !is.null(x)) + dat <- dat[keep] + sc <- do.call(cbind, dat) + yblank <- matrix(0, design$M, design$J) + list(y=yblank, siteCovs=sc) +}) + +setMethod("simulate_fit", "unmarkedFitDS", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + if(is.null(args$tlength)) args$tlength <- 0 + umf <- unmarkedFrameDS(y=parts$y, siteCovs=parts$siteCovs, + tlength=args$tlength, survey=args$survey, unitsIn=args$unitsIn, + dist.breaks=args$dist.breaks) + keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) + output <- ifelse(is.null(args$output), "density", args$output) + unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) + + distsamp(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), + data=umf, se=FALSE, control=list(maxit=1), keyfun=keyfun, + output=output, unitsOut=unitsOut) +}) + + +setMethod("get_umf_components", "unmarkedFitColExt", + function(object, formulas, guide, design, ...){ + sc <- generate_data(formulas$psi, guide, design$M) + ysc <- generate_data(list(formulas$col, formulas$ext), guide, design$M*design$T) + oc <- generate_data(formulas$det, guide, design$J*design$M*design$T) + yblank <- matrix(0, design$M, design$T*design$J) + list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) +}) + + +setMethod("simulate_fit", "unmarkedFitColExt", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + umf <- unmarkedMultFrame(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + obsCovs=parts$obsCovs, numPrimary=design$T) + colext(psiformula=formulas$psi, gammaformula=formulas$col, + epsilonformula=formulas$ext,pformula=formulas$det, + data=umf, se=FALSE, control=list(maxit=1)) +}) + +setMethod("get_umf_components", "unmarkedFitOccuTTD", + function(object, formulas, guide, design, ...){ + sc <- generate_data(formulas$psi, guide, design$M) + ysc <- NULL + if(design$T>1){ + ysc <- generate_data(list(formulas$col, formulas$ext), guide, design$M*design$T) + } + oc <- generate_data(formulas$det, guide, design$J*design$M*design$T) + yblank <- matrix(0, design$M, design$T*design$J) + list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) +}) + + +setMethod("simulate_fit", "unmarkedFitOccuTTD", + function(object, formulas, guide, design, ...){ + if(is.null(design$T)) design$T <- 1 + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + umf <- unmarkedFrameOccuTTD(y=parts$y, + surveyLength=args$surveyLength, + siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + obsCovs=parts$obsCovs, numPrimary=design$T) + linkPsi <- ifelse(is.null(args$linkPsi), "logit", args$linkPsi) + ttdDist <- ifelse(is.null(args$ttdDist), "exp", args$ttdDist) + occuTTD(psiformula=formulas$psi, gammaformula=formulas$col, + epsilonformula=formulas$ext,detformula=formulas$det, + linkPsi=linkPsi, ttdDist=ttdDist, + data=umf, se=FALSE, control=list(maxit=1)) +}) + + +setMethod("get_umf_components", "unmarkedFitGMM", + function(object, formulas, guide, design, ...){ + sc <- generate_data(formulas$lambda, guide, design$M) + ysc <- generate_data(formulas$phi, guide, design$M*design$T) + yblank <- matrix(0, design$M, design$T*design$J) + list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc) +}) + + +setMethod("simulate_fit", "unmarkedFitGDS", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + if(args$survey=="line"){ + umf <- unmarkedFrameGDS(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + numPrimary=design$T, + tlength=args$tlength, survey=args$survey, + unitsIn=args$unitsIn, dist.breaks=args$dist.breaks) + } else if(args$survey=="point"){ + umf <- unmarkedFrameGDS(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + numPrimary=design$T, survey=args$survey, + unitsIn=args$unitsIn, dist.breaks=args$dist.breaks) + } + + keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) + output <- ifelse(is.null(args$output), "density", args$output) + unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + K <- ifelse(is.null(args$K), 100, args$K) + + gdistsamp(lambdaformula=formulas$lambda, phiformula=formulas$phi, + pformula=formulas$det, data=umf, keyfun=keyfun, output=output, + unitsOut=unitsOut, mixture=mixture, K=K, + se=FALSE, control=list(maxit=1)) +}) + +setMethod("simulate_fit", "unmarkedFitGPC", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + umf <- unmarkedFrameGPC(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + numPrimary=design$T) + K <- ifelse(is.null(args$K), 100, args$K) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + + gpcount(lambdaformula=formulas$lambda, phiformula=formulas$phi, + pformula=formulas$det, data=umf, mixture=mixture, K=K, + se=FALSE, control=list(maxit=1)) +}) + + +setMethod("simulate_fit", "unmarkedFitGMM", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + umf <- unmarkedFrameGMM(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + numPrimary=design$T, type=args$type) + K <- ifelse(is.null(args$K), 100, args$K) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + + gmultmix(lambdaformula=formulas$lambda, phiformula=formulas$phi, + pformula=formulas$det, data=umf, mixture=mixture, K=K, + se=FALSE, control=list(maxit=1)) +}) + + +setMethod("get_umf_components", "unmarkedFitDailMadsen", + function(object, formulas, guide, design, ...){ + sc <- generate_data(formulas$lambda, guide, design$M) + ysc <- generate_data(list(formulas$gamma, formulas$omega), guide, design$M*design$T) + oc <- generate_data(formulas$det, guide, design$M*design$T*design$J) + yblank <- matrix(0, design$M, design$T*design$J) + list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) +}) + +setMethod("simulate_fit", "unmarkedFitPCO", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + if(is.null(args$primaryPeriod)){ + args$primaryPeriod <- matrix(1:design$T, design$M, design$T, byrow=TRUE) + } + umf <- unmarkedFramePCO(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + numPrimary=design$T, primaryPeriod=args$primaryPeriod) + K <- ifelse(is.null(args$K), 100, args$K) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + dynamics <- ifelse(is.null(args$dynamics), "constant", args$dynamics) + fix <- ifelse(is.null(args$fix), "none", args$fix) + immigration <- ifelse(is.null(args$immigration), FALSE, args$immigration) + iotaformula <- args$iotaformula + if(is.null(iotaformula)) iotaformula <- ~1 + + pcountOpen(lambdaformula=formulas$lambda, gammaformula=formulas$gamma, + omegaformula=formulas$omega, pformula=formulas$det, + data=umf, mixture=mixture, K=K, dynamics=dynamics, fix=fix, + se=FALSE, method='SANN', control=list(maxit=1), immigration=immigration, + iotaformula=iotaformula) +}) + +setMethod("simulate_fit", "unmarkedFitMMO", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + if(is.null(args$primaryPeriod)){ + args$primaryPeriod <- matrix(1:design$T, design$M, design$T, byrow=TRUE) + } + umf <- unmarkedFrameMMO(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + type=args$type, + numPrimary=design$T, primaryPeriod=args$primaryPeriod) + K <- ifelse(is.null(args$K), 100, args$K) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + dynamics <- ifelse(is.null(args$dynamics), "constant", args$dynamics) + fix <- ifelse(is.null(args$fix), "none", args$fix) + immigration <- ifelse(is.null(args$immigration), FALSE, args$immigration) + iotaformula <- args$iotaformula + if(is.null(iotaformula)) iotaformula <- ~1 + + multmixOpen(lambdaformula=formulas$lambda, gammaformula=formulas$gamma, + omegaformula=formulas$omega, pformula=formulas$det, + data=umf, mixture=mixture, K=K, dynamics=dynamics, fix=fix, + se=FALSE, method='SANN', control=list(maxit=1), immigration=immigration, + iotaformula=iotaformula) +}) + +setMethod("get_umf_components", "unmarkedFitDSO", + function(object, formulas, guide, design, ...){ + sc <- generate_data(formulas$lambda, guide, design$M) + ysc <- generate_data(list(formulas$gamma, formulas$omega, formulas$det), + guide, design$M*design$T) + yblank <- matrix(0, design$M, design$T*design$J) + list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc) +}) + +setMethod("simulate_fit", "unmarkedFitDSO", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + if(is.null(args$primaryPeriod)){ + args$primaryPeriod <- matrix(1:design$T, design$M, design$T, byrow=TRUE) + } + if(args$survey=="line"){ + umf <- unmarkedFrameDSO(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + tlength=args$tlength, survey=args$survey, + unitsIn=args$unitsIn, dist.breaks=args$dist.breaks, + numPrimary=design$T, primaryPeriod=args$primaryPeriod) + } else if(args$survey == "point"){ + umf <- unmarkedFrameDSO(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs,survey=args$survey, + unitsIn=args$unitsIn, dist.breaks=args$dist.breaks, + numPrimary=design$T, primaryPeriod=args$primaryPeriod) + } + K <- ifelse(is.null(args$K), 100, args$K) + keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) + output <- ifelse(is.null(args$output), "density", args$output) + unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + dynamics <- ifelse(is.null(args$dynamics), "constant", args$dynamics) + fix <- ifelse(is.null(args$fix), "none", args$fix) + immigration <- ifelse(is.null(args$immigration), FALSE, args$immigration) + iotaformula <- args$iotaformula + if(is.null(iotaformula)) iotaformula <- ~1 + distsampOpen(lambdaformula=formulas$lambda, gammaformula=formulas$gamma, + omegaformula=formulas$omega, pformula=formulas$det, + keyfun=keyfun, unitsOut=unitsOut, output=output, + data=umf, mixture=mixture, K=K, dynamics=dynamics, fix=fix, + se=FALSE, method='SANN', control=list(maxit=1), immigration=immigration, + iotaformula=iotaformula) +}) + + +setMethod("get_umf_components", "unmarkedFitOccuMulti", + function(object, formulas, guide, design, ...){ + sc <- generate_data(lapply(formulas$state, as.formula), guide, design$M) + oc <- generate_data(lapply(formulas$det, as.formula), guide, design$J*design$M) + nspecies <- length(formulas$det) + yblank <- lapply(1:nspecies, function(x) matrix(0, design$M, design$J)) + list(y=yblank, siteCovs=sc, obsCovs=oc) +}) + +setMethod("simulate_fit", "unmarkedFitOccuMulti", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + if(is.null(args$maxOrder)) args$maxOrder <- length(parts$y) + umf <- unmarkedFrameOccuMulti(y=parts$y, siteCovs=parts$siteCovs, + obsCovs=parts$obsCovs, maxOrder=args$maxOrder) + occuMulti(formulas$det, formulas$state, data=umf, maxOrder=args$maxOrder, + se=FALSE, control=list(maxit=1)) +}) + +setMethod("get_umf_components", "unmarkedFitOccuMS", + function(object, formulas, guide, design, ...){ + sc <- generate_data(lapply(formulas$state, as.formula), guide, design$M) + ysc <- NULL + if(!is.null(formulas$phi)){ + ysc <- generate_data(lapply(formulas$phi, as.formula), guide, design$M*design$T*design$J) + } + oc <- generate_data(lapply(formulas$det, as.formula), guide, design$J*design$M) + nspecies <- length(formulas$det) + yblank <- matrix(0, design$M, design$T*design$J) + yblank[1,1] <- 2 # To bypass sanity checker in unmarkedFrameOccuMS + list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) +}) + +setMethod("simulate_fit", "unmarkedFitOccuMS", + function(object, formulas, guide, design, ...){ + if(is.null(design$T)) design$T <- 1 + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + umf <- unmarkedFrameOccuMS(y=parts$y, siteCovs=parts$siteCovs, + yearlySiteCovs=parts$yearlySiteCovs, + obsCovs=parts$obsCovs, numPrimary=design$T) + if(is.null(args$parameterization)) args$parameterization <- "multinomial" + occuMS(formulas$det, formulas$state, formulas$phi, data=umf, + parameterization=args$parameterization, + se=FALSE, control=list(maxit=1)) +}) + +setMethod("get_umf_components", "unmarkedFitGDR", + function(object, formulas, guide, design, ...){ + if(any(! c("M","Jdist","Jrem") %in% names(design))){ + stop("Required design components are M, Jdist, and Jrem") + } + sc <- generate_data(list(formulas$lambda, formulas$dist), guide, design$M) + ysc <- NULL + if(design$T > 1){ + ysc <- generate_data(formulas$phi, guide, design$M*design$T) + } + oc <- generate_data(formulas$rem, guide, design$M*design$T*design$Jrem) + + list(yDistance=matrix(0, design$M, design$T*design$Jdist), + yRemoval=matrix(0, design$M, design$T*design$Jrem), + siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) +}) + +setMethod("simulate_fit", "unmarkedFitGDR", + function(object, formulas, guide, design, ...){ + if(is.null(design$T)) design$T <- 1 + if(is.null(formulas$phi)) formulas$phi <- ~1 + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + umf <- unmarkedFrameGDR(yDistance=parts$yDistance, yRemoval=parts$yRemoval, + numPrimary=design$T, siteCovs=parts$siteCovs, + obsCovs=parts$obsCovs, yearlySiteCovs=parts$yearlySiteCovs, + dist.breaks=args$dist.breaks, unitsIn=args$unitsIn, + period.lengths=args$period.lengths) + + keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) + output <- ifelse(is.null(args$output), "density", args$output) + unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) + mixture <- ifelse(is.null(args$mixture), "P", args$mixture) + K <- ifelse(is.null(args$K), 100, args$K) + + gdistremoval(lambdaformula=formulas$lambda, phiformula=formulas$phi, + removalformula=formulas$rem, distanceformula=formulas$dist, + data=umf, keyfun=keyfun, output=output, unitsOut=unitsOut, + mixture=mixture, K=K, se=FALSE, control=list(maxit=1), method='L-BFGS-B') +}) + +# For simulating entirely new datasets +setMethod("get_umf_components", "unmarkedFitIDS", + function(object, formulas, guide, design, ...){ + + # Distance sampling dataset + sc_ds_lam <- generate_data(formulas$lam, guide, design$Mds) + sc_ds_det <- generate_data(formulas$ds, guide, design$Mds) + dat_ds <- list(sc_ds_lam, sc_ds_det) + if(!is.null(formulas$phi)){ + sc_ds_phi <- generate_data(formulas$phi, guide, design$Mds) + dat_ds <- c(dat_ds, list(sc_ds_phi)) + } + keep <- sapply(dat_ds, function(x) !is.null(x)) + dat_ds <- dat_ds[keep] + sc_ds <- do.call(cbind, dat_ds) + yblank_ds <- matrix(1, design$Mds, design$J) + + # Point count dataset + sc_pc <- yblank_pc <- NULL + if(!is.null(design$Mpc) && design$Mpc > 0){ + if(is.null(formulas$pc)) form_pc <- formulas$ds + sc_pc_lam <- generate_data(formulas$lam, guide, design$Mpc) + sc_pc_det <- generate_data(form_pc, guide, design$Mpc) + sc_pc <- list(sc_pc_lam, sc_pc_det) + if(!is.null(formulas$phi)){ + sc_pc_phi <- generate_data(formulas$phi, guide, design$Mpc) + sc_pc <- c(sc_pc, list(sc_pc_phi)) + } + keep <- sapply(sc_pc, function(x) !is.null(x)) + sc_pc <- sc_pc[keep] + sc_pc <- do.call(cbind, sc_pc) + yblank_pc <- matrix(1, design$Mpc, 1) + } + + # Presence/absence dataset + sc_oc <- yblank_oc <- NULL + if(!is.null(design$Moc) && design$Moc > 0){ + if(is.null(formulas$oc)){ + form_oc <- formulas$ds + } else { + form_oc <- formulas$oc + } + sc_oc_lam <- generate_data(formulas$lam, guide, design$Moc) + sc_oc_det <- generate_data(form_oc, guide, design$Moc) + sc_oc <- list(sc_oc_lam, sc_oc_det) + if(!is.null(formulas$phi)){ + sc_oc_phi <- generate_data(formulas$phi, guide, design$Moc) + sc_oc <- c(sc_oc, list(sc_oc_phi)) + } + keep <- sapply(sc_oc, function(x) !is.null(x)) + sc_oc <- sc_oc[keep] + sc_oc <- do.call(cbind, sc_oc) + yblank_oc <- matrix(1, design$Moc, 1) + } + + mget(c("yblank_ds", "sc_ds", "yblank_pc", "sc_pc", "yblank_oc", "sc_oc")) +}) + + +setMethod("simulate_fit", "unmarkedFitIDS", + function(object, formulas, guide, design, ...){ + parts <- get_umf_components(object, formulas, guide, design, ...) + args <- list(...) + + args$tlength <- 0 + args$survey <- "point" + + # Distance sampling dataset + umf_ds <- unmarkedFrameDS(y=parts$yblank_ds, siteCovs=parts$sc_ds, + tlength=args$tlength, survey=args$survey, + unitsIn=args$unitsIn, + dist.breaks=args$dist.breaks) + # Point count dataset + umf_pc <- NULL + if(!is.null(design$Mpc) && design$Mpc > 0){ + umf_pc <- unmarkedFramePCount(y=parts$yblank_pc, siteCovs=parts$sc_pc) + } + + # Occupancy dataset + umf_oc <- NULL + if(!is.null(design$Moc) && design$Moc > 0){ + umf_oc <- unmarkedFrameOccu(y=parts$yblank_oc, siteCovs=parts$sc_oc) + } + + keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) + unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) + K <- ifelse(is.null(args$K), 300, args$K) + if(is.null(args$maxDistPC)) args$maxDistPC <- max(args$dist.breaks) + if(is.null(args$maxDistOC)) args$maxDistOC <- max(args$dist.breaks) + + IDS(lambdaformula = formulas$lam, + detformulaDS = formulas$ds, + detformulaPC = formulas$pc, detformulaOC = formulas$oc, + dataDS = umf_ds, dataPC = umf_pc, dataOC = umf_oc, + availformula = formulas$phi, + durationDS = args$durationDS, durationPC = args$durationPC, + durationOC = args$durationOC, + maxDistPC = args$maxDistPC, maxDistOC = args$maxDistOC, + keyfun=keyfun, unitsOut=unitsOut, K=K ,control=list(maxit=1)) +}) + + +# power ----------------------------------------------------------------------- + +setClass("unmarkedPower_old", + representation(call="call", data="unmarkedFrame", M="numeric", + J="numeric", T="numeric", coefs="list", estimates="list", + alpha="numeric", nulls="list") +) + +setMethod("powerAnalysis", "unmarkedFit", + function(object, coefs=NULL, design=NULL, alpha=0.05, nulls=list(), + datalist=NULL, + nsim=ifelse(is.null(datalist), 100, length(datalist)), + parallel=FALSE){ + + .Deprecated("powerAnalysis", package=NULL, + msg = paste("Using an unmarkedFit object to run a power analysis will soon be removed from unmarked.\n", + "Use an unmarkedFrame instead. See the power analysis vignette for more."), + old = as.character(sys.call(sys.parent()))[1L]) + + submodels <- names(object@estimates@estimates) + coefs <- check_coefs_old(coefs, object) + coefs <- generate_random_effects(coefs, object) + fit_temp <- replace_estimates(object, coefs) + + T <- 1 + bdata <- NULL + if(!is.null(datalist)){ + if(length(datalist) != nsim){ + stop("Length of data list must equal value of nsim", call.=FALSE) + } + tryCatch({test <- update(object, data=datalist[[1]], se=FALSE, + control=list(maxit=1)) + }, error=function(e){ + stop("Incorrect format of entries in datalist", call.=FALSE) + }) + bdata <- datalist + M <- numSites(bdata[[1]]) + sims <- lapply(bdata, function(x){ + #fit_temp@data <- x + #temporary workaround - not necessary?? + #if(methods::.hasSlot(fit_temp, "knownOcc")){ + # fit_temp@knownOcc <- rep(FALSE, M) + #} + #simulate(fit_temp, 1)[[1]] + if(inherits(x, "unmarkedFrameOccuMulti")){ + return(x@ylist) + } else if(inherits(x, "unmarkedFrameGDR")){ + return(list(yDistance=x@yDistance, yRemoval=x@yRemoval)) + } else { + return(x@y) + } + }) + if(methods::.hasSlot(bdata[[1]], "numPrimary")){ + T <- bdata[[1]]@numPrimary + } + J <- obsNum(bdata[[1]]) / T + } else if(is.null(design)){ + sims <- simulate(fit_temp, nsim) + M <- numSites(object@data) + if(methods::.hasSlot(object@data, "numPrimary")){ + T <- object@data@numPrimary + } + J <- obsNum(object@data) / T + } else { + bdata <- bootstrap_data(fit_temp@data, nsim, design) + sims <- lapply(bdata, function(x){ + fit_temp@data <- x + #temporary workaround + if(methods::.hasSlot(fit_temp, "knownOcc")){ + fit_temp@knownOcc <- rep(FALSE, design$M) + } + simulate(fit_temp, 1)[[1]] + }) + M <- design$M + if(methods::.hasSlot(fit_temp@data, "numPrimary")){ + T <- fit_temp@data@numPrimary + } + J <- design$J + } + + cl <- NULL + if(parallel){ + cl <- parallel::makeCluster(parallel::detectCores()-1) + on.exit(parallel::stopCluster(cl)) + parallel::clusterEvalQ(cl, library(unmarked)) + } + + if(!is.null(options()$unmarked_shiny)&&options()$unmarked_shiny){ + ses <- options()$unmarked_shiny_session + ses <- shiny::getDefaultReactiveDomain() + pb <- shiny::Progress$new(ses, min=0, max=1) + pb$set(message="Running simulations") + if(!requireNamespace("pbapply", quietly=TRUE)){ + stop("You need to install the pbapply package", call.=FALSE) + } + fits <- pbapply::pblapply(1:nsim, function(i, sims, fit, bdata=NULL){ + if(!is.null(design)) fit@data <- bdata[[i]] + if(inherits(fit, "unmarkedFitOccuMulti")){ + fit@data@ylist <- sims[[i]] + } else{ + fit@data@y <- sims[[i]] + } + out <- update(fit, data=fit@data, se=TRUE) + pb$set(value=i/nsim, message=NULL, detail=NULL) + out + }, sims=sims, fit=object, bdata=bdata, cl=NULL) + pb$close() + + } else { + + fits <- lapply2(1:nsim, function(i, sims, fit, bdata=NULL){ + if(!is.null(design)) fit@data <- bdata[[i]] + if(inherits(fit, "unmarkedFitOccuMulti")){ + fit@data@ylist <- sims[[i]] + } else if(inherits(fit, "unmarkedFitGDR")){ + fit@data@yDistance <- sims[[i]]$yDistance + fit@data@yRemoval <- sims[[i]]$yRemoval + } else { + fit@data@y <- sims[[i]] + } + update(fit, data=fit@data, se=TRUE) + }, sims=sims, fit=object, bdata=bdata, cl=cl) + + } + + sum_dfs <- lapply(fits, get_summary_df_old) + + new("unmarkedPower_old", call=object@call, data=object@data, M=M, + J=J, T=T, coefs=coefs, estimates=sum_dfs, alpha=alpha, nulls=nulls) +}) + +bootstrap_data <- function(data, nsims, design){ + M <- design$M + J <- design$J + sites <- 1:numSites(data) + if(!is.null(J) & methods::.hasSlot(data, "numPrimary")){ + stop("Can't automatically bootstrap observations with > 1 primary period", call.=FALSE) + } + if(J > obsNum(data)){ + stop("Can't currently bootstrap more than the actual number of observations", call.=FALSE) + } + obs <- 1:obsNum(data) + + if(M > numSites(data)){ + M_samps <- lapply(1:nsims, function(i) sample(sites, M, replace=TRUE)) + } else if(M < numSites(data)){ + M_samps <- lapply(1:nsims, function(i) sample(sites, M, replace=FALSE)) + } else { + M_samps <- replicate(nsims, sites, simplify=FALSE) + } + + if(J > obsNum(data)){ + J_samps <- lapply(1:nsims, function(i) sample(obs, J, replace=TRUE)) + } else if(J < obsNum(data)){ + J_samps <- lapply(1:nsims, function(i) sample(obs, J, replace=FALSE)) + } else { + J_samps <- replicate(nsims, obs, simplify=FALSE) + } + + lapply(1:nsims, function(i) data[M_samps[[i]], J_samps[[i]]]) +} + +check_coefs_old <- function(coefs, fit, template=FALSE){ + required_subs <- names(fit@estimates@estimates) + required_coefs <- lapply(fit@estimates@estimates, function(x) names(x@estimates)) + required_lens <- lapply(required_coefs, length) + + formulas <- sapply(names(fit), function(x) get_formula(fit, x)) + + # If there are random effects, adjust the expected coefficient names + # to remove the b vector and add the grouping covariate name + rand <- lapply(formulas, lme4::findbars) + if(!all(sapply(rand, is.null))){ + stopifnot(all(required_subs %in% names(formulas))) + rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars))) + if(!all(sapply(rvar, length)<2)){ + stop("Only 1 random effect per parameter is supported", call.=FALSE) + } + for (i in required_subs){ + if(!is.null(rand[[i]][[1]])){ + signame <- rvar[[i]] + old_coefs <- required_coefs[[i]] + new_coefs <- old_coefs[!grepl("b_", old_coefs, fixed=TRUE)] + new_coefs <- c(new_coefs, signame) + required_coefs[[i]] <- new_coefs + } + } + } + + dummy_coefs <- lapply(required_coefs, function(x){ + out <- rep(0, length(x)) + x <- gsub("(Intercept)", "intercept", x, fixed=TRUE) + names(out) <- x + out + }) + + if(template) return(dummy_coefs) + + if(is.null(coefs)){ + cat("coefs argument should be a named list of named vectors, with the following structure + (replacing 0s with your desired coefficient values):\n\n") + print(dummy_coefs) + stop("Supply coefs argument as specified above", call.=FALSE) + } + + for (i in 1:length(required_subs)){ + if(!required_subs[i] %in% names(coefs)){ + stop(paste0("Missing required list element '",required_subs[i], "' in coefs list"), call.=FALSE) + } + + sub_coefs <- coefs[[required_subs[i]]] + + if(is.null(sub_coefs)){ + stop(paste("Required coefficients for the", required_subs[i], "submodel are:", + paste(required_coefs[[i]],collapse=", "))) + } + + is_named <- !is.null(names(sub_coefs)) & !any(names(sub_coefs)=="") + + if(!is_named){ + warning(paste("At least one coefficient in vector for submodel",required_subs[i], + "is unnamed; assuming the following order:\n", + paste(required_coefs[[i]], collapse=", "))) + if(length(sub_coefs) != required_lens[i]){ + stop(paste0("Entry '",required_subs[[i]], "' in coefs list must be length ", + required_lens[[i]]), call.=FALSE) + } + } else { + rsi <- required_subs[i] + change_int <- names(coefs[[rsi]])%in%c("intercept","Intercept") + names(coefs[[rsi]])[change_int] <- "(Intercept)" + change_int <- names(coefs[[rsi]])%in%c("sigmaintercept","sigmaIntercept") + names(coefs[[rsi]])[change_int] <- "sigma(Intercept)" + change_int <- names(coefs[[rsi]])%in%c("shapeintercept","shapeIntercept") + names(coefs[[rsi]])[change_int] <- "shape(Intercept)" + change_int <- names(coefs[[rsi]])%in%c("rateintercept","rateIntercept") + names(coefs[[rsi]])[change_int] <- "rate(Intercept)" + change_int <- grepl(" intercept", names(coefs[[rsi]])) + names(coefs[[rsi]])[change_int] <- gsub(" intercept", " (Intercept)", + names(coefs[[rsi]])[change_int]) + change_int <- grepl(" Intercept", names(coefs[[rsi]])) + names(coefs[[rsi]])[change_int] <- gsub(" Intercept", " (Intercept)", + names(coefs[[rsi]])[change_int]) + sub_coefs <- coefs[[rsi]] + + not_inc <- !required_coefs[[i]] %in% names(sub_coefs) + extra <- !names(sub_coefs) %in% required_coefs[[i]] + + if(any(not_inc)){ + stop(paste("The following required coefficients in the", required_subs[i], "submodel were not found:", + paste(required_coefs[[i]][not_inc], collapse=", "))) + } + if(any(extra)){ + warning(paste("Ignoring extra coefficients in the", required_subs[i], "submodel:", + paste(names(sub_coefs)[extra], collapse=", "))) + } + coefs[[rsi]] <- coefs[[rsi]][required_coefs[[i]]] + } + } + coefs[required_subs] +} + +wald <- function(est, se, null_hyp=NULL){ + if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 + Z <- (est-null_hyp)/se + 2*pnorm(abs(Z), lower.tail = FALSE) +} + +diff_dir <- function(est, hyp, null_hyp=NULL){ + if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 + dif <- est - null_hyp + dif_hyp <- hyp - null_hyp + dif * dif_hyp > 0 +} + +setMethod("summary", "unmarkedPower_old", function(object, ...){ + sum_dfs <- object@estimates + npar <- nrow(sum_dfs[[1]]) + + nulls <- object@nulls + nulls <- lapply(nulls, function(x){ + nm <- names(x) + nm[nm %in% c("Intercept","intercept")] <- "(Intercept)" + names(x) <- nm + x + }) + + coefs_no_rand <- unlist(object@coefs)[!grepl("b_", names(unlist(object@coefs)))] + + pow <- sapply(1:npar, function(ind){ + submod <- sum_dfs[[1]]$submodel[ind] + param <- sum_dfs[[1]]$param[ind] + ni <- nulls[[submod]][param] + + pcrit <- sapply(sum_dfs, function(x) wald(x$Estimate[ind], x$SE[ind], ni)) < object@alpha + direct <- sapply(sum_dfs, function(x) diff_dir(x$Estimate[ind], coefs_no_rand[ind], ni)) + mean(pcrit & direct, na.rm=T) + }) + + all_nulls <- sapply(1:npar, function(ind){ + submod <- sum_dfs[[1]]$submodel[ind] + param <- sum_dfs[[1]]$param[ind] + ni <- nulls[[submod]][param] + if(is.null(ni) || is.na(ni)) ni <- 0 + ni + }) + + effect_no_random <- unlist(object@coefs)[!grepl("b_",names(unlist(object@coefs)))] + + out <- cbind(sum_dfs[[1]][,1:2], effect=effect_no_random, null=all_nulls, power=pow) + rownames(out) <- NULL + names(out) <- c("Submodel", "Parameter", "Effect", "Null", "Power") + out +}) + +setMethod("show", "unmarkedPower_old", function(object){ + cat("\nModel:\n") + print(object@call) + cat("\n") + + cat("Power Statistics:\n") + sumtab <- summary(object) + sumtab$Power <- round(sumtab$Power, 3) + print(sumtab, row.names=FALSE) +}) + + + +get_summary_df_old <- function(fit){ + n_est <- length(fit@estimates@estimates) + #est_names <- unname(sapply(fit@estimates@estimates, function(x) x@name)) + est_names <- names(fit@estimates@estimates) + all_est <- lapply(1:n_est, function(i){ + utils::capture.output(out <- summary(fit@estimates@estimates[[i]])) + out <- cbind(submodel=est_names[i], param=rownames(out), out) + rownames(out) <- NULL + out + }) + do.call(rbind, all_est) +} + +setClass("unmarkedPowerList_old", representation(powerAnalyses="list")) + +setMethod("unmarkedPowerList", "list", function(object, ...){ + new("unmarkedPowerList_old", powerAnalyses=object) +}) + +setMethod("unmarkedPowerList", "unmarkedFit", + function(object, coefs, design, alpha=0.05, nulls=list(), + nsim=100, parallel=FALSE, ...){ + + ndesigns <- nrow(design) + out <- lapply(1:ndesigns, function(i){ + cat(paste0("M = ",design$M[i],", J = ",design$J[i],"\n")) + powerAnalysis(object, coefs, as.list(design[i,]), alpha=alpha, nsim=nsim, + nulls=nulls, parallel=FALSE) + }) + new("unmarkedPowerList_old", powerAnalyses=out) +}) + +setMethod("summary", "unmarkedPowerList_old", function(object, ...){ + out <- lapply(object@powerAnalyses, function(x){ + stats <- summary(x) + cbind(M=x@M, T=x@T, J=x@J, stats) + }) + out <- do.call(rbind, out) + out$M <- factor(out$M) + out$T <- factor(out$T) + out$J <- factor(out$J) + out +}) + +setMethod("show", "unmarkedPowerList_old", function(object){ + print(summary(object)) +}) + +setMethod("plot", "unmarkedPowerList_old", function(x, power=NULL, param=NULL, ...){ + dat <- summary(x) + if(is.null(param)) param <- dat$Parameter[1] + dat <- dat[dat$Parameter==param,,drop=FALSE] + ylim <- range(dat$Power, na.rm=T) + if(!is.null(power)) ylim[2] <- max(power, ylim[2]) + xlim <- range(as.numeric(as.character(dat$M)), na.rm=T) + cols <- palette.colors(length(levels(dat$J)), palette="Dark 2") + old_par <- graphics::par()[c("mfrow","mar")] + nT <- length(levels(dat$T)) + mar <- old_par$mar + if(nT == 1) mar <- c(5.1, 4.1, 2.1, 2.1) + graphics::par(mfrow=c(length(levels(dat$T)),1), mar=mar) + for (i in levels(dat$T)){ + plot_title <- "" + if(nT > 1) plot_title <- paste0("T = ", i) + tsub <- dat[dat$T==i,,drop=FALSE] + Jlev <- levels(tsub$J) + jsub <- tsub[tsub$J==Jlev[1],,drop=FALSE] + plot(as.numeric(as.character(jsub$M)), jsub$Power, type="o", + col=cols[1], ylim=ylim, xlim=xlim, xlab="Sites", + ylab="Power", pch=19, main=plot_title) + if(!is.null(power)) abline(h=power, lty=2) + for (j in 2:length(Jlev)){ + jsub <- tsub[tsub$J==Jlev[j],,drop=FALSE] + graphics::lines(as.numeric(as.character(jsub$M)), jsub$Power, type="o", + col=cols[j], pch=19) + } + graphics::legend('bottomright', lwd=1, pch=19, col=cols, legend=Jlev, title="Observations") + } + graphics::par(mfrow=old_par) +}) + +setMethod("update", "unmarkedPower_old", function(object, ...){ + args <- list(...) + if(!is.null(args$alpha)) object@alpha <- args$alpha + if(!is.null(args$coefs)){ + if(!is.list(args$coefs) || all(names(args$coefs) == names(object@coefs))){ + stop("coefs list structure is incorrect", call.=FALSE) + object@coefs <- args$coefs + } + } + if(!is.null(args$nulls)) object@nulls <- args$nulls + object +}) + +shinyPower <- function(object, ...){ + + if(!inherits(object, "unmarkedFit")){ + stop("Requires unmarkedFit object", call.=FALSE) + } + + .Deprecated("shinyPower", package=NULL, + msg = paste("shinyPower used on an unmarkedFit object will soon be removed from unmarked."), + old = as.character(sys.call(sys.parent()))[1L]) + if(!requireNamespace("shiny")){ + stop("Install the shiny library to use this function", call.=FALSE) + } + if(!requireNamespace("pbapply")){ + stop("Install the pbapply library to use this function", call.=FALSE) + } + options(unmarked_shiny=TRUE) + on.exit(options(unmarked_shiny=FALSE)) + .shiny_env$.SHINY_MODEL <- object + + shiny::runApp(system.file("shinyPower", package="unmarked")) + +} diff --git a/R/power.R b/R/power.R index 3240e8e2..e00e8097 100644 --- a/R/power.R +++ b/R/power.R @@ -1,444 +1,6 @@ -setClass("unmarkedPower", - representation(call="call", data="unmarkedFrame", M="numeric", - J="numeric", T="numeric", coefs="list", estimates="list", - alpha="numeric", nulls="list") -) - -powerAnalysis <- function(object, coefs=NULL, design=NULL, alpha=0.05, nulls=list(), - datalist=NULL, - nsim=ifelse(is.null(datalist), 100, length(datalist)), - parallel=FALSE){ - - stopifnot(inherits(object, "unmarkedFit")) - - submodels <- names(object@estimates@estimates) - coefs <- check_coefs(coefs, object) - coefs <- generate_random_effects(coefs, object) - fit_temp <- replace_estimates(object, coefs) - - T <- 1 - bdata <- NULL - if(!is.null(datalist)){ - if(length(datalist) != nsim){ - stop("Length of data list must equal value of nsim", call.=FALSE) - } - tryCatch({test <- update(object, data=datalist[[1]], se=FALSE, - control=list(maxit=1)) - }, error=function(e){ - stop("Incorrect format of entries in datalist", call.=FALSE) - }) - bdata <- datalist - M <- numSites(bdata[[1]]) - sims <- lapply(bdata, function(x){ - #fit_temp@data <- x - #temporary workaround - not necessary?? - #if(methods::.hasSlot(fit_temp, "knownOcc")){ - # fit_temp@knownOcc <- rep(FALSE, M) - #} - #simulate(fit_temp, 1)[[1]] - if(inherits(x, "unmarkedFrameOccuMulti")){ - return(x@ylist) - } else if(inherits(x, "unmarkedFrameGDR")){ - return(list(yDistance=x@yDistance, yRemoval=x@yRemoval)) - } else { - return(x@y) - } - }) - if(methods::.hasSlot(bdata[[1]], "numPrimary")){ - T <- bdata[[1]]@numPrimary - } - J <- obsNum(bdata[[1]]) / T - } else if(is.null(design)){ - sims <- simulate(fit_temp, nsim) - M <- numSites(object@data) - if(methods::.hasSlot(object@data, "numPrimary")){ - T <- object@data@numPrimary - } - J <- obsNum(object@data) / T - } else { - bdata <- bootstrap_data(fit_temp@data, nsim, design) - sims <- lapply(bdata, function(x){ - fit_temp@data <- x - #temporary workaround - if(methods::.hasSlot(fit_temp, "knownOcc")){ - fit_temp@knownOcc <- rep(FALSE, design$M) - } - simulate(fit_temp, 1)[[1]] - }) - M <- design$M - if(methods::.hasSlot(fit_temp@data, "numPrimary")){ - T <- fit_temp@data@numPrimary - } - J <- design$J - } - - cl <- NULL - if(parallel){ - cl <- parallel::makeCluster(parallel::detectCores()-1) - on.exit(parallel::stopCluster(cl)) - parallel::clusterEvalQ(cl, library(unmarked)) - } - - if(!is.null(options()$unmarked_shiny)&&options()$unmarked_shiny){ - ses <- options()$unmarked_shiny_session - ses <- shiny::getDefaultReactiveDomain() - pb <- shiny::Progress$new(ses, min=0, max=1) - pb$set(message="Running simulations") - if(!requireNamespace("pbapply", quietly=TRUE)){ - stop("You need to install the pbapply package", call.=FALSE) - } - fits <- pbapply::pblapply(1:nsim, function(i, sims, fit, bdata=NULL){ - if(!is.null(design)) fit@data <- bdata[[i]] - if(inherits(fit, "unmarkedFitOccuMulti")){ - fit@data@ylist <- sims[[i]] - } else{ - fit@data@y <- sims[[i]] - } - out <- update(fit, data=fit@data, se=TRUE) - pb$set(value=i/nsim, message=NULL, detail=NULL) - out - }, sims=sims, fit=object, bdata=bdata, cl=NULL) - pb$close() - - } else { - - fits <- lapply2(1:nsim, function(i, sims, fit, bdata=NULL){ - if(!is.null(design)) fit@data <- bdata[[i]] - if(inherits(fit, "unmarkedFitOccuMulti")){ - fit@data@ylist <- sims[[i]] - } else if(inherits(fit, "unmarkedFitGDR")){ - fit@data@yDistance <- sims[[i]]$yDistance - fit@data@yRemoval <- sims[[i]]$yRemoval - } else { - fit@data@y <- sims[[i]] - } - update(fit, data=fit@data, se=TRUE) - }, sims=sims, fit=object, bdata=bdata, cl=cl) - - } - - sum_dfs <- lapply(fits, get_summary_df) - - new("unmarkedPower", call=object@call, data=object@data, M=M, - J=J, T=T, coefs=coefs, estimates=sum_dfs, alpha=alpha, nulls=nulls) -} - -bootstrap_data <- function(data, nsims, design){ - M <- design$M - J <- design$J - sites <- 1:numSites(data) - if(!is.null(J) & methods::.hasSlot(data, "numPrimary")){ - stop("Can't automatically bootstrap observations with > 1 primary period", call.=FALSE) - } - if(J > obsNum(data)){ - stop("Can't currently bootstrap more than the actual number of observations", call.=FALSE) - } - obs <- 1:obsNum(data) - - if(M > numSites(data)){ - M_samps <- lapply(1:nsims, function(i) sample(sites, M, replace=TRUE)) - } else if(M < numSites(data)){ - M_samps <- lapply(1:nsims, function(i) sample(sites, M, replace=FALSE)) - } else { - M_samps <- replicate(nsims, sites, simplify=FALSE) - } - - if(J > obsNum(data)){ - J_samps <- lapply(1:nsims, function(i) sample(obs, J, replace=TRUE)) - } else if(J < obsNum(data)){ - J_samps <- lapply(1:nsims, function(i) sample(obs, J, replace=FALSE)) - } else { - J_samps <- replicate(nsims, obs, simplify=FALSE) - } - - lapply(1:nsims, function(i) data[M_samps[[i]], J_samps[[i]]]) -} - -check_coefs <- function(coefs, fit, template=FALSE){ - required_subs <- names(fit@estimates@estimates) - required_coefs <- lapply(fit@estimates@estimates, function(x) names(x@estimates)) - required_lens <- lapply(required_coefs, length) - - formulas <- sapply(names(fit), function(x) get_formula(fit, x)) - - # If there are random effects, adjust the expected coefficient names - # to remove the b vector and add the grouping covariate name - rand <- lapply(formulas, lme4::findbars) - if(!all(sapply(rand, is.null))){ - stopifnot(all(required_subs %in% names(formulas))) - rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars))) - if(!all(sapply(rvar, length)<2)){ - stop("Only 1 random effect per parameter is supported", call.=FALSE) - } - for (i in required_subs){ - if(!is.null(rand[[i]][[1]])){ - signame <- rvar[[i]] - old_coefs <- required_coefs[[i]] - new_coefs <- old_coefs[!grepl("b_", old_coefs, fixed=TRUE)] - new_coefs <- c(new_coefs, signame) - required_coefs[[i]] <- new_coefs - } - } - } - - dummy_coefs <- lapply(required_coefs, function(x){ - out <- rep(0, length(x)) - x <- gsub("(Intercept)", "intercept", x, fixed=TRUE) - names(out) <- x - out - }) - - if(template) return(dummy_coefs) - - if(is.null(coefs)){ - cat("coefs argument should be a named list of named vectors, with the following structure - (replacing 0s with your desired coefficient values):\n\n") - print(dummy_coefs) - stop("Supply coefs argument as specified above", call.=FALSE) - } - - for (i in 1:length(required_subs)){ - if(!required_subs[i] %in% names(coefs)){ - stop(paste0("Missing required list element '",required_subs[i], "' in coefs list"), call.=FALSE) - } - - sub_coefs <- coefs[[required_subs[i]]] - - if(is.null(sub_coefs)){ - stop(paste("Required coefficients for the", required_subs[i], "submodel are:", - paste(required_coefs[[i]],collapse=", "))) - } - - is_named <- !is.null(names(sub_coefs)) & !any(names(sub_coefs)=="") - - if(!is_named){ - warning(paste("At least one coefficient in vector for submodel",required_subs[i], - "is unnamed; assuming the following order:\n", - paste(required_coefs[[i]], collapse=", "))) - if(length(sub_coefs) != required_lens[i]){ - stop(paste0("Entry '",required_subs[[i]], "' in coefs list must be length ", - required_lens[[i]]), call.=FALSE) - } - } else { - rsi <- required_subs[i] - change_int <- names(coefs[[rsi]])%in%c("intercept","Intercept") - names(coefs[[rsi]])[change_int] <- "(Intercept)" - change_int <- names(coefs[[rsi]])%in%c("sigmaintercept","sigmaIntercept") - names(coefs[[rsi]])[change_int] <- "sigma(Intercept)" - change_int <- names(coefs[[rsi]])%in%c("shapeintercept","shapeIntercept") - names(coefs[[rsi]])[change_int] <- "shape(Intercept)" - change_int <- names(coefs[[rsi]])%in%c("rateintercept","rateIntercept") - names(coefs[[rsi]])[change_int] <- "rate(Intercept)" - change_int <- grepl(" intercept", names(coefs[[rsi]])) - names(coefs[[rsi]])[change_int] <- gsub(" intercept", " (Intercept)", - names(coefs[[rsi]])[change_int]) - change_int <- grepl(" Intercept", names(coefs[[rsi]])) - names(coefs[[rsi]])[change_int] <- gsub(" Intercept", " (Intercept)", - names(coefs[[rsi]])[change_int]) - sub_coefs <- coefs[[rsi]] - - not_inc <- !required_coefs[[i]] %in% names(sub_coefs) - extra <- !names(sub_coefs) %in% required_coefs[[i]] - - if(any(not_inc)){ - stop(paste("The following required coefficients in the", required_subs[i], "submodel were not found:", - paste(required_coefs[[i]][not_inc], collapse=", "))) - } - if(any(extra)){ - warning(paste("Ignoring extra coefficients in the", required_subs[i], "submodel:", - paste(names(sub_coefs)[extra], collapse=", "))) - } - coefs[[rsi]] <- coefs[[rsi]][required_coefs[[i]]] - } - } - coefs[required_subs] -} - -wald <- function(est, se, null_hyp=NULL){ - if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 - Z <- (est-null_hyp)/se - 2*pnorm(abs(Z), lower.tail = FALSE) -} - -diff_dir <- function(est, hyp, null_hyp=NULL){ - if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 - dif <- est - null_hyp - dif_hyp <- hyp - null_hyp - dif * dif_hyp > 0 -} - -setMethod("summary", "unmarkedPower", function(object, ...){ - sum_dfs <- object@estimates - npar <- nrow(sum_dfs[[1]]) - - nulls <- object@nulls - nulls <- lapply(nulls, function(x){ - nm <- names(x) - nm[nm %in% c("Intercept","intercept")] <- "(Intercept)" - names(x) <- nm - x - }) - - coefs_no_rand <- unlist(object@coefs)[!grepl("b_", names(unlist(object@coefs)))] - - pow <- sapply(1:npar, function(ind){ - submod <- sum_dfs[[1]]$submodel[ind] - param <- sum_dfs[[1]]$param[ind] - ni <- nulls[[submod]][param] - - pcrit <- sapply(sum_dfs, function(x) wald(x$Estimate[ind], x$SE[ind], ni)) < object@alpha - direct <- sapply(sum_dfs, function(x) diff_dir(x$Estimate[ind], coefs_no_rand[ind], ni)) - mean(pcrit & direct, na.rm=T) - }) - - all_nulls <- sapply(1:npar, function(ind){ - submod <- sum_dfs[[1]]$submodel[ind] - param <- sum_dfs[[1]]$param[ind] - ni <- nulls[[submod]][param] - if(is.null(ni) || is.na(ni)) ni <- 0 - ni - }) - - effect_no_random <- unlist(object@coefs)[!grepl("b_",names(unlist(object@coefs)))] - - out <- cbind(sum_dfs[[1]][,1:2], effect=effect_no_random, null=all_nulls, power=pow) - rownames(out) <- NULL - names(out) <- c("Submodel", "Parameter", "Effect", "Null", "Power") - out +setGeneric("powerAnalysis", function(object, ...){ + standardGeneric("powerAnalysis") }) -setMethod("show", "unmarkedPower", function(object){ - cat("\nModel:\n") - print(object@call) - cat("\n") - - cat("Power Statistics:\n") - sumtab <- summary(object) - sumtab$Power <- round(sumtab$Power, 3) - print(sumtab, row.names=FALSE) -}) - -replace_estimates <- function(object, new_ests){ - for (i in 1:length(new_ests)){ - est <- object@estimates@estimates[[names(new_ests)[i]]]@estimates - stopifnot(length(est) == length(new_ests[[i]])) - object@estimates@estimates[[names(new_ests)[i]]]@estimates <- new_ests[[i]] - } - object -} - -get_summary_df <- function(fit){ - n_est <- length(fit@estimates@estimates) - #est_names <- unname(sapply(fit@estimates@estimates, function(x) x@name)) - est_names <- names(fit@estimates@estimates) - all_est <- lapply(1:n_est, function(i){ - utils::capture.output(out <- summary(fit@estimates@estimates[[i]])) - out <- cbind(submodel=est_names[i], param=rownames(out), out) - rownames(out) <- NULL - out - }) - do.call(rbind, all_est) -} - -setClass("unmarkedPowerList", representation(powerAnalyses="list")) - setGeneric("unmarkedPowerList", function(object, ...){ standardGeneric("unmarkedPowerList")}) - -setMethod("unmarkedPowerList", "list", function(object, ...){ - new("unmarkedPowerList", powerAnalyses=object) -}) - -setMethod("unmarkedPowerList", "unmarkedFit", - function(object, coefs, design, alpha=0.05, nulls=list(), - nsim=100, parallel=FALSE, ...){ - - ndesigns <- nrow(design) - out <- lapply(1:ndesigns, function(i){ - cat(paste0("M = ",design$M[i],", J = ",design$J[i],"\n")) - powerAnalysis(object, coefs, as.list(design[i,]), alpha=alpha, nsim=nsim, - nulls=nulls, parallel=FALSE) - }) - unmarkedPowerList(out) -}) - -setMethod("summary", "unmarkedPowerList", function(object, ...){ - out <- lapply(object@powerAnalyses, function(x){ - stats <- summary(x) - cbind(M=x@M, T=x@T, J=x@J, stats) - }) - out <- do.call(rbind, out) - out$M <- factor(out$M) - out$T <- factor(out$T) - out$J <- factor(out$J) - out -}) - -setMethod("show", "unmarkedPowerList", function(object){ - print(summary(object)) -}) - -setMethod("plot", "unmarkedPowerList", function(x, power=NULL, param=NULL, ...){ - dat <- summary(x) - if(is.null(param)) param <- dat$Parameter[1] - dat <- dat[dat$Parameter==param,,drop=FALSE] - ylim <- range(dat$Power, na.rm=T) - if(!is.null(power)) ylim[2] <- max(power, ylim[2]) - xlim <- range(as.numeric(as.character(dat$M)), na.rm=T) - cols <- palette.colors(length(levels(dat$J)), palette="Dark 2") - old_par <- graphics::par()[c("mfrow","mar")] - nT <- length(levels(dat$T)) - mar <- old_par$mar - if(nT == 1) mar <- c(5.1, 4.1, 2.1, 2.1) - graphics::par(mfrow=c(length(levels(dat$T)),1), mar=mar) - for (i in levels(dat$T)){ - plot_title <- "" - if(nT > 1) plot_title <- paste0("T = ", i) - tsub <- dat[dat$T==i,,drop=FALSE] - Jlev <- levels(tsub$J) - jsub <- tsub[tsub$J==Jlev[1],,drop=FALSE] - plot(as.numeric(as.character(jsub$M)), jsub$Power, type="o", - col=cols[1], ylim=ylim, xlim=xlim, xlab="Sites", - ylab="Power", pch=19, main=plot_title) - if(!is.null(power)) abline(h=power, lty=2) - for (j in 2:length(Jlev)){ - jsub <- tsub[tsub$J==Jlev[j],,drop=FALSE] - graphics::lines(as.numeric(as.character(jsub$M)), jsub$Power, type="o", - col=cols[j], pch=19) - } - graphics::legend('bottomright', lwd=1, pch=19, col=cols, legend=Jlev, title="Observations") - } - graphics::par(mfrow=old_par) -}) - -setMethod("update", "unmarkedPower", function(object, ...){ - args <- list(...) - if(!is.null(args$alpha)) object@alpha <- args$alpha - if(!is.null(args$coefs)){ - if(!is.list(args$coefs) || all(names(args$coefs) == names(object@coefs))){ - stop("coefs list structure is incorrect", call.=FALSE) - object@coefs <- args$coefs - } - } - if(!is.null(args$nulls)) object@nulls <- args$nulls - object -}) - -shinyPower <- function(object, ...){ - - if(!inherits(object, "unmarkedFit")){ - stop("Requires unmarkedFit object", call.=FALSE) - } - if(!requireNamespace("shiny")){ - stop("Install the shiny library to use this function", call.=FALSE) - } - if(!requireNamespace("pbapply")){ - stop("Install the pbapply library to use this function", call.=FALSE) - } - options(unmarked_shiny=TRUE) - on.exit(options(unmarked_shiny=FALSE)) - .shiny_env$.SHINY_MODEL <- object - - shiny::runApp(system.file("shinyPower", package="unmarked")) - -} diff --git a/R/simulate.R b/R/simulate.R index 3868a72b..0668c097 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -1,123 +1,12 @@ -get_vars <- function(inp){ - if(is.list(inp)){ - out <- unique(unlist(lapply(inp, all.vars))) - } else { - out <- all.vars(inp) +replace_estimates <- function(object, new_ests){ + for (i in 1:length(new_ests)){ + est <- object@estimates@estimates[[names(new_ests)[i]]]@estimates + stopifnot(length(est) == length(new_ests[[i]])) + object@estimates@estimates[[names(new_ests)[i]]]@estimates <- new_ests[[i]] } - names(out) <- out - out + object } -var_data <- function(var, guide, n){ - out <- rep(NA, n) - gv <- guide[[var]] - if(is.null(gv)){ - out <- stats::rnorm(n, 0, 1) - } else if(inherits(gv, "factor")){ - levs <- levels(gv) - out <- factor(sample(levs, n, replace=TRUE), levels=levs) - } else{ - gv$n <- n - out <- do.call(gv$dist, gv[!names(gv)=="dist"]) - } - out -} - -generate_data <- function(formulas, guide, n){ - vars <- get_vars(formulas) - if(length(vars)==0) return(NULL) - as.data.frame(lapply(vars, var_data, guide=guide, n=n)) -} - -capitalize <- function(inp){ - paste0(toupper(substring(inp,1,1)), - substring(inp,2,nchar(inp))) -} - -parse_func_name <- function(inp){ - if(!is.character(inp)){ - stop("Argument must be a character string", call.=FALSE) - } - capitalize(inp) -} - -blank_umFit <- function(fit_function){ - type <- parse_func_name(fit_function) - type <- ifelse(type=="Pcount", "PCount", type) - type <- ifelse(type=="MultinomPois", "MPois", type) - type <- ifelse(type=="Distsamp", "DS", type) - type <- ifelse(type=="Colext", "ColExt", type) - type <- ifelse(type=="Gdistsamp", "GDS", type) - type <- ifelse(type=="Gpcount", "GPC", type) - type <- ifelse(type=="Gmultmix", "GMM", type) - type <- ifelse(type=="PcountOpen", "PCO", type) - type <- ifelse(type=="DistsampOpen", "DSO", type) - type <- ifelse(type=="MultmixOpen", "MMO", type) - type <- ifelse(type=="Gdistremoval", "GDR", type) - type <- paste0("unmarkedFit", type) - new(type) -} - - -setMethod("simulate", "character", - function(object, nsim=1, seed=NULL, formulas, coefs=NULL, design, guide=NULL, ...){ - model <- blank_umFit(object) - fit <- suppressWarnings(simulate_fit(model, formulas, guide, design, ...)) - coefs <- check_coefs(coefs, fit) - #fit <- replace_sigma(coefs, fit) - coefs <- generate_random_effects(coefs, fit) - fit <- replace_estimates(fit, coefs) - ysims <- suppressWarnings(simulate(fit, nsim)) - umf <- fit@data - # fix this - umfs <- lapply(ysims, function(x){ - if(object=="occuMulti"){ - umf@ylist <- x - } else if(object=="gdistremoval"){ - umf@yDistance=x$yDistance - umf@yRemoval=x$yRemoval - } else if(object == "IDS"){ - out <- list() - out$ds <- fit@data - out$ds@y <- x$ds - if("pc" %in% names(fit)){ - out$pc <- fit@dataPC - out$pc@y <- x$pc - } - if("oc" %in% names(fit)){ - out$oc <- fit@dataOC - out$oc@y <- x$oc - } - umf <- out - } else { - umf@y <- x - } - umf - }) - if(length(umfs)==1) umfs <- umfs[[1]] - umfs -}) - -# Insert specified random effects SD into proper S4 slot in model object -# This is mostly needed by GDR which uses the SD to calculate -# N with E_loglam (this is currently disabled so the function is not needed) -#replace_sigma <- function(coefs, fit){ -# required_subs <- names(fit@estimates@estimates) -# formulas <- sapply(names(fit), function(x) get_formula(fit, x)) -# rand <- lapply(formulas, lme4::findbars) -# if(!all(sapply(rand, is.null))){ -# rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars))) -# for (i in required_subs){ -# if(!is.null(rand[[i]][[1]])){ -# signame <- rvar[[i]] -# old_coefs <- coefs[[i]] -# fit@estimates@estimates[[i]]@randomVarInfo$estimates <- coefs[[i]][[signame]] -# } -# } -# } -# fit -#} - generate_random_effects <- function(coefs, fit){ required_subs <- names(fit@estimates@estimates) formulas <- sapply(names(fit), function(x) get_formula(fit, x)) @@ -154,521 +43,3 @@ generate_random_effects <- function(coefs, fit){ coefs } - -setGeneric("get_umf_components", function(object, ...) standardGeneric("get_umf_components")) - -setMethod("get_umf_components", "unmarkedFit", - function(object, formulas, guide, design, ...){ - sc <- generate_data(formulas$state, guide, design$M) - oc <- generate_data(formulas$det, guide, design$J*design$M) - yblank <- matrix(0, design$M, design$J) - list(y=yblank, siteCovs=sc, obsCovs=oc) -}) - - -setGeneric("simulate_fit", function(object, ...) standardGeneric("simulate_fit")) - -setMethod("simulate_fit", "unmarkedFitOccu", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - umf <- unmarkedFrameOccu(y=parts$y, siteCovs=parts$siteCovs, - obsCovs=parts$obsCovs) - occu(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), - data=umf, se=FALSE, control=list(maxit=1)) -}) - -setMethod("simulate_fit", "unmarkedFitPCount", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - umf <- unmarkedFramePCount(y=parts$y, siteCovs=parts$siteCovs, - obsCovs=parts$obsCovs) - args <- list(...) - K <- ifelse(is.null(args$K), 100, args$K) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - pcount(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), - data=umf, mixture=mixture, K=K, se=FALSE, control=list(maxit=1)) -}) - -setMethod("simulate_fit", "unmarkedFitOccuRN", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - umf <- unmarkedFrameOccu(y=parts$y, siteCovs=parts$siteCovs, - obsCovs=parts$obsCovs) - occuRN(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), - data=umf, se=FALSE, control=list(maxit=1)) -}) - -setMethod("get_umf_components", "unmarkedFitMPois", - function(object, formulas, guide, design, ...){ - args <- list(...) - sc <- generate_data(formulas$state, guide, design$M) - oc <- generate_data(formulas$det, guide, design$J*design$M) - J <- ifelse(args$type=="double", 3, design$J) - yblank <- matrix(0, design$M, design$J) - list(y=yblank, siteCovs=sc, obsCovs=oc) -}) - -setMethod("simulate_fit", "unmarkedFitMPois", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - type <- ifelse(is.null(args$type), "removal", args$type) - umf <- unmarkedFrameMPois(y=parts$y, siteCovs=parts$siteCovs, - obsCovs=parts$obsCovs, type=type) - multinomPois(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), - data=umf, se=FALSE, control=list(maxit=1)) -}) - -setMethod("get_umf_components", "unmarkedFitDS", - function(object, formulas, guide, design, ...){ - #args <- list(...) - sc <- generate_data(formulas$state, guide, design$M) - sc2 <- generate_data(formulas$det, guide, design$M) - dat <- list(sc, sc2) - keep <- sapply(dat, function(x) !is.null(x)) - dat <- dat[keep] - sc <- do.call(cbind, dat) - yblank <- matrix(0, design$M, design$J) - list(y=yblank, siteCovs=sc) -}) - -setMethod("simulate_fit", "unmarkedFitDS", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - if(is.null(args$tlength)) args$tlength <- 0 - umf <- unmarkedFrameDS(y=parts$y, siteCovs=parts$siteCovs, - tlength=args$tlength, survey=args$survey, unitsIn=args$unitsIn, - dist.breaks=args$dist.breaks) - keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) - output <- ifelse(is.null(args$output), "density", args$output) - unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) - - distsamp(as.formula(paste(deparse(formulas$det), deparse(formulas$state))), - data=umf, se=FALSE, control=list(maxit=1), keyfun=keyfun, - output=output, unitsOut=unitsOut) -}) - - -setMethod("get_umf_components", "unmarkedFitColExt", - function(object, formulas, guide, design, ...){ - sc <- generate_data(formulas$psi, guide, design$M) - ysc <- generate_data(list(formulas$col, formulas$ext), guide, design$M*design$T) - oc <- generate_data(formulas$det, guide, design$J*design$M*design$T) - yblank <- matrix(0, design$M, design$T*design$J) - list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) -}) - - -setMethod("simulate_fit", "unmarkedFitColExt", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - umf <- unmarkedMultFrame(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - obsCovs=parts$obsCovs, numPrimary=design$T) - colext(psiformula=formulas$psi, gammaformula=formulas$col, - epsilonformula=formulas$ext,pformula=formulas$det, - data=umf, se=FALSE, control=list(maxit=1)) -}) - -setMethod("get_umf_components", "unmarkedFitOccuTTD", - function(object, formulas, guide, design, ...){ - sc <- generate_data(formulas$psi, guide, design$M) - ysc <- NULL - if(design$T>1){ - ysc <- generate_data(list(formulas$col, formulas$ext), guide, design$M*design$T) - } - oc <- generate_data(formulas$det, guide, design$J*design$M*design$T) - yblank <- matrix(0, design$M, design$T*design$J) - list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) -}) - - -setMethod("simulate_fit", "unmarkedFitOccuTTD", - function(object, formulas, guide, design, ...){ - if(is.null(design$T)) design$T <- 1 - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - umf <- unmarkedFrameOccuTTD(y=parts$y, - surveyLength=args$surveyLength, - siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - obsCovs=parts$obsCovs, numPrimary=design$T) - linkPsi <- ifelse(is.null(args$linkPsi), "logit", args$linkPsi) - ttdDist <- ifelse(is.null(args$ttdDist), "exp", args$ttdDist) - occuTTD(psiformula=formulas$psi, gammaformula=formulas$col, - epsilonformula=formulas$ext,detformula=formulas$det, - linkPsi=linkPsi, ttdDist=ttdDist, - data=umf, se=FALSE, control=list(maxit=1)) -}) - - -setMethod("get_umf_components", "unmarkedFitGMM", - function(object, formulas, guide, design, ...){ - sc <- generate_data(formulas$lambda, guide, design$M) - ysc <- generate_data(formulas$phi, guide, design$M*design$T) - yblank <- matrix(0, design$M, design$T*design$J) - list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc) -}) - - -setMethod("simulate_fit", "unmarkedFitGDS", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - if(args$survey=="line"){ - umf <- unmarkedFrameGDS(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - numPrimary=design$T, - tlength=args$tlength, survey=args$survey, - unitsIn=args$unitsIn, dist.breaks=args$dist.breaks) - } else if(args$survey=="point"){ - umf <- unmarkedFrameGDS(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - numPrimary=design$T, survey=args$survey, - unitsIn=args$unitsIn, dist.breaks=args$dist.breaks) - } - - keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) - output <- ifelse(is.null(args$output), "density", args$output) - unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - K <- ifelse(is.null(args$K), 100, args$K) - - gdistsamp(lambdaformula=formulas$lambda, phiformula=formulas$phi, - pformula=formulas$det, data=umf, keyfun=keyfun, output=output, - unitsOut=unitsOut, mixture=mixture, K=K, - se=FALSE, control=list(maxit=1)) -}) - -setMethod("simulate_fit", "unmarkedFitGPC", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - umf <- unmarkedFrameGPC(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - numPrimary=design$T) - K <- ifelse(is.null(args$K), 100, args$K) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - - gpcount(lambdaformula=formulas$lambda, phiformula=formulas$phi, - pformula=formulas$det, data=umf, mixture=mixture, K=K, - se=FALSE, control=list(maxit=1)) -}) - - -setMethod("simulate_fit", "unmarkedFitGMM", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - umf <- unmarkedFrameGMM(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - numPrimary=design$T, type=args$type) - K <- ifelse(is.null(args$K), 100, args$K) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - - gmultmix(lambdaformula=formulas$lambda, phiformula=formulas$phi, - pformula=formulas$det, data=umf, mixture=mixture, K=K, - se=FALSE, control=list(maxit=1)) -}) - - -setMethod("get_umf_components", "unmarkedFitDailMadsen", - function(object, formulas, guide, design, ...){ - sc <- generate_data(formulas$lambda, guide, design$M) - ysc <- generate_data(list(formulas$gamma, formulas$omega), guide, design$M*design$T) - oc <- generate_data(formulas$det, guide, design$M*design$T*design$J) - yblank <- matrix(0, design$M, design$T*design$J) - list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) -}) - -setMethod("simulate_fit", "unmarkedFitPCO", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - if(is.null(args$primaryPeriod)){ - args$primaryPeriod <- matrix(1:design$T, design$M, design$T, byrow=TRUE) - } - umf <- unmarkedFramePCO(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - numPrimary=design$T, primaryPeriod=args$primaryPeriod) - K <- ifelse(is.null(args$K), 100, args$K) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - dynamics <- ifelse(is.null(args$dynamics), "constant", args$dynamics) - fix <- ifelse(is.null(args$fix), "none", args$fix) - immigration <- ifelse(is.null(args$immigration), FALSE, args$immigration) - iotaformula <- args$iotaformula - if(is.null(iotaformula)) iotaformula <- ~1 - - pcountOpen(lambdaformula=formulas$lambda, gammaformula=formulas$gamma, - omegaformula=formulas$omega, pformula=formulas$det, - data=umf, mixture=mixture, K=K, dynamics=dynamics, fix=fix, - se=FALSE, method='SANN', control=list(maxit=1), immigration=immigration, - iotaformula=iotaformula) -}) - -setMethod("simulate_fit", "unmarkedFitMMO", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - if(is.null(args$primaryPeriod)){ - args$primaryPeriod <- matrix(1:design$T, design$M, design$T, byrow=TRUE) - } - umf <- unmarkedFrameMMO(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - type=args$type, - numPrimary=design$T, primaryPeriod=args$primaryPeriod) - K <- ifelse(is.null(args$K), 100, args$K) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - dynamics <- ifelse(is.null(args$dynamics), "constant", args$dynamics) - fix <- ifelse(is.null(args$fix), "none", args$fix) - immigration <- ifelse(is.null(args$immigration), FALSE, args$immigration) - iotaformula <- args$iotaformula - if(is.null(iotaformula)) iotaformula <- ~1 - - multmixOpen(lambdaformula=formulas$lambda, gammaformula=formulas$gamma, - omegaformula=formulas$omega, pformula=formulas$det, - data=umf, mixture=mixture, K=K, dynamics=dynamics, fix=fix, - se=FALSE, method='SANN', control=list(maxit=1), immigration=immigration, - iotaformula=iotaformula) -}) - -setMethod("get_umf_components", "unmarkedFitDSO", - function(object, formulas, guide, design, ...){ - sc <- generate_data(formulas$lambda, guide, design$M) - ysc <- generate_data(list(formulas$gamma, formulas$omega, formulas$det), - guide, design$M*design$T) - yblank <- matrix(0, design$M, design$T*design$J) - list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc) -}) - -setMethod("simulate_fit", "unmarkedFitDSO", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - if(is.null(args$primaryPeriod)){ - args$primaryPeriod <- matrix(1:design$T, design$M, design$T, byrow=TRUE) - } - if(args$survey=="line"){ - umf <- unmarkedFrameDSO(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - tlength=args$tlength, survey=args$survey, - unitsIn=args$unitsIn, dist.breaks=args$dist.breaks, - numPrimary=design$T, primaryPeriod=args$primaryPeriod) - } else if(args$survey == "point"){ - umf <- unmarkedFrameDSO(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs,survey=args$survey, - unitsIn=args$unitsIn, dist.breaks=args$dist.breaks, - numPrimary=design$T, primaryPeriod=args$primaryPeriod) - } - K <- ifelse(is.null(args$K), 100, args$K) - keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) - output <- ifelse(is.null(args$output), "density", args$output) - unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - dynamics <- ifelse(is.null(args$dynamics), "constant", args$dynamics) - fix <- ifelse(is.null(args$fix), "none", args$fix) - immigration <- ifelse(is.null(args$immigration), FALSE, args$immigration) - iotaformula <- args$iotaformula - if(is.null(iotaformula)) iotaformula <- ~1 - distsampOpen(lambdaformula=formulas$lambda, gammaformula=formulas$gamma, - omegaformula=formulas$omega, pformula=formulas$det, - keyfun=keyfun, unitsOut=unitsOut, output=output, - data=umf, mixture=mixture, K=K, dynamics=dynamics, fix=fix, - se=FALSE, method='SANN', control=list(maxit=1), immigration=immigration, - iotaformula=iotaformula) -}) - - -setMethod("get_umf_components", "unmarkedFitOccuMulti", - function(object, formulas, guide, design, ...){ - sc <- generate_data(lapply(formulas$state, as.formula), guide, design$M) - oc <- generate_data(lapply(formulas$det, as.formula), guide, design$J*design$M) - nspecies <- length(formulas$det) - yblank <- lapply(1:nspecies, function(x) matrix(0, design$M, design$J)) - list(y=yblank, siteCovs=sc, obsCovs=oc) -}) - -setMethod("simulate_fit", "unmarkedFitOccuMulti", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - if(is.null(args$maxOrder)) args$maxOrder <- length(parts$y) - umf <- unmarkedFrameOccuMulti(y=parts$y, siteCovs=parts$siteCovs, - obsCovs=parts$obsCovs, maxOrder=args$maxOrder) - occuMulti(formulas$det, formulas$state, data=umf, maxOrder=args$maxOrder, - se=FALSE, control=list(maxit=1)) -}) - -setMethod("get_umf_components", "unmarkedFitOccuMS", - function(object, formulas, guide, design, ...){ - sc <- generate_data(lapply(formulas$state, as.formula), guide, design$M) - ysc <- NULL - if(!is.null(formulas$phi)){ - ysc <- generate_data(lapply(formulas$phi, as.formula), guide, design$M*design$T*design$J) - } - oc <- generate_data(lapply(formulas$det, as.formula), guide, design$J*design$M) - nspecies <- length(formulas$det) - yblank <- matrix(0, design$M, design$T*design$J) - yblank[1,1] <- 2 # To bypass sanity checker in unmarkedFrameOccuMS - list(y=yblank, siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) -}) - -setMethod("simulate_fit", "unmarkedFitOccuMS", - function(object, formulas, guide, design, ...){ - if(is.null(design$T)) design$T <- 1 - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - umf <- unmarkedFrameOccuMS(y=parts$y, siteCovs=parts$siteCovs, - yearlySiteCovs=parts$yearlySiteCovs, - obsCovs=parts$obsCovs, numPrimary=design$T) - if(is.null(args$parameterization)) args$parameterization <- "multinomial" - occuMS(formulas$det, formulas$state, formulas$phi, data=umf, - parameterization=args$parameterization, - se=FALSE, control=list(maxit=1)) -}) - -setMethod("get_umf_components", "unmarkedFitGDR", - function(object, formulas, guide, design, ...){ - if(any(! c("M","Jdist","Jrem") %in% names(design))){ - stop("Required design components are M, Jdist, and Jrem") - } - sc <- generate_data(list(formulas$lambda, formulas$dist), guide, design$M) - ysc <- NULL - if(design$T > 1){ - ysc <- generate_data(formulas$phi, guide, design$M*design$T) - } - oc <- generate_data(formulas$rem, guide, design$M*design$T*design$Jrem) - - list(yDistance=matrix(0, design$M, design$T*design$Jdist), - yRemoval=matrix(0, design$M, design$T*design$Jrem), - siteCovs=sc, yearlySiteCovs=ysc, obsCovs=oc) -}) - -setMethod("simulate_fit", "unmarkedFitGDR", - function(object, formulas, guide, design, ...){ - if(is.null(design$T)) design$T <- 1 - if(is.null(formulas$phi)) formulas$phi <- ~1 - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - umf <- unmarkedFrameGDR(yDistance=parts$yDistance, yRemoval=parts$yRemoval, - numPrimary=design$T, siteCovs=parts$siteCovs, - obsCovs=parts$obsCovs, yearlySiteCovs=parts$yearlySiteCovs, - dist.breaks=args$dist.breaks, unitsIn=args$unitsIn, - period.lengths=args$period.lengths) - - keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) - output <- ifelse(is.null(args$output), "density", args$output) - unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) - mixture <- ifelse(is.null(args$mixture), "P", args$mixture) - K <- ifelse(is.null(args$K), 100, args$K) - - gdistremoval(lambdaformula=formulas$lambda, phiformula=formulas$phi, - removalformula=formulas$rem, distanceformula=formulas$dist, - data=umf, keyfun=keyfun, output=output, unitsOut=unitsOut, - mixture=mixture, K=K, se=FALSE, control=list(maxit=1), method='L-BFGS-B') -}) - -# For simulating entirely new datasets -setMethod("get_umf_components", "unmarkedFitIDS", - function(object, formulas, guide, design, ...){ - - # Distance sampling dataset - sc_ds_lam <- generate_data(formulas$lam, guide, design$Mds) - sc_ds_det <- generate_data(formulas$ds, guide, design$Mds) - dat_ds <- list(sc_ds_lam, sc_ds_det) - if(!is.null(formulas$phi)){ - sc_ds_phi <- generate_data(formulas$phi, guide, design$Mds) - dat_ds <- c(dat_ds, list(sc_ds_phi)) - } - keep <- sapply(dat_ds, function(x) !is.null(x)) - dat_ds <- dat_ds[keep] - sc_ds <- do.call(cbind, dat_ds) - yblank_ds <- matrix(1, design$Mds, design$J) - - # Point count dataset - sc_pc <- yblank_pc <- NULL - if(!is.null(design$Mpc) && design$Mpc > 0){ - if(is.null(formulas$pc)) form_pc <- formulas$ds - sc_pc_lam <- generate_data(formulas$lam, guide, design$Mpc) - sc_pc_det <- generate_data(form_pc, guide, design$Mpc) - sc_pc <- list(sc_pc_lam, sc_pc_det) - if(!is.null(formulas$phi)){ - sc_pc_phi <- generate_data(formulas$phi, guide, design$Mpc) - sc_pc <- c(sc_pc, list(sc_pc_phi)) - } - keep <- sapply(sc_pc, function(x) !is.null(x)) - sc_pc <- sc_pc[keep] - sc_pc <- do.call(cbind, sc_pc) - yblank_pc <- matrix(1, design$Mpc, 1) - } - - # Presence/absence dataset - sc_oc <- yblank_oc <- NULL - if(!is.null(design$Moc) && design$Moc > 0){ - if(is.null(formulas$oc)){ - form_oc <- formulas$ds - } else { - form_oc <- formulas$oc - } - sc_oc_lam <- generate_data(formulas$lam, guide, design$Moc) - sc_oc_det <- generate_data(form_oc, guide, design$Moc) - sc_oc <- list(sc_oc_lam, sc_oc_det) - if(!is.null(formulas$phi)){ - sc_oc_phi <- generate_data(formulas$phi, guide, design$Moc) - sc_oc <- c(sc_oc, list(sc_oc_phi)) - } - keep <- sapply(sc_oc, function(x) !is.null(x)) - sc_oc <- sc_oc[keep] - sc_oc <- do.call(cbind, sc_oc) - yblank_oc <- matrix(1, design$Moc, 1) - } - - mget(c("yblank_ds", "sc_ds", "yblank_pc", "sc_pc", "yblank_oc", "sc_oc")) -}) - - -setMethod("simulate_fit", "unmarkedFitIDS", - function(object, formulas, guide, design, ...){ - parts <- get_umf_components(object, formulas, guide, design, ...) - args <- list(...) - - args$tlength <- 0 - args$survey <- "point" - - # Distance sampling dataset - umf_ds <- unmarkedFrameDS(y=parts$yblank_ds, siteCovs=parts$sc_ds, - tlength=args$tlength, survey=args$survey, - unitsIn=args$unitsIn, - dist.breaks=args$dist.breaks) - # Point count dataset - umf_pc <- NULL - if(!is.null(design$Mpc) && design$Mpc > 0){ - umf_pc <- unmarkedFramePCount(y=parts$yblank_pc, siteCovs=parts$sc_pc) - } - - # Occupancy dataset - umf_oc <- NULL - if(!is.null(design$Moc) && design$Moc > 0){ - umf_oc <- unmarkedFrameOccu(y=parts$yblank_oc, siteCovs=parts$sc_oc) - } - - keyfun <- ifelse(is.null(args$keyfun), "halfnorm", args$keyfun) - unitsOut <- ifelse(is.null(args$unitsOut), "ha", args$unitsOut) - K <- ifelse(is.null(args$K), 300, args$K) - if(is.null(args$maxDistPC)) args$maxDistPC <- max(args$dist.breaks) - if(is.null(args$maxDistOC)) args$maxDistOC <- max(args$dist.breaks) - - IDS(lambdaformula = formulas$lam, - detformulaDS = formulas$ds, - detformulaPC = formulas$pc, detformulaOC = formulas$oc, - dataDS = umf_ds, dataPC = umf_pc, dataOC = umf_oc, - availformula = formulas$phi, - durationDS = args$durationDS, durationPC = args$durationPC, - durationOC = args$durationOC, - maxDistPC = args$maxDistPC, maxDistOC = args$maxDistOC, - keyfun=keyfun, unitsOut=unitsOut, K=K ,control=list(maxit=1)) -}) - - - diff --git a/man/powerAnalysis.Rd b/man/powerAnalysis.Rd index c5c672fe..43dd10a7 100644 --- a/man/powerAnalysis.Rd +++ b/man/powerAnalysis.Rd @@ -1,5 +1,6 @@ \name{powerAnalysis} \alias{powerAnalysis} +\alias{powerAnalysis,unmarkedFit-method} \title{Conduct a power analysis on an unmarked model} @@ -16,7 +17,7 @@ examples. } \usage{ - powerAnalysis(object, coefs=NULL, design=NULL, alpha=0.05, nulls=list(), + \S4method{powerAnalysis}{unmarkedFit}(object, coefs=NULL, design=NULL, alpha=0.05, nulls=list(), datalist=NULL, nsim=ifelse(is.null(datalist), 100, length(datalist)), parallel=FALSE) diff --git a/man/unmarkedPower-class.Rd b/man/unmarkedPower-class.Rd index 3df4d770..3d7110a0 100644 --- a/man/unmarkedPower-class.Rd +++ b/man/unmarkedPower-class.Rd @@ -1,9 +1,13 @@ \name{unmarkedPower-methods} \alias{unmarkedPower-methods} \alias{unmarkedPower-class} +\alias{unmarkedPower_old-class} \alias{show,unmarkedPower-method} \alias{summary,unmarkedPower-method} \alias{update,unmarkedPower-method} +\alias{show,unmarkedPower_old-method} +\alias{summary,unmarkedPower_old-method} +\alias{update,unmarkedPower_old-method} \title{Methods for unmarkedPower objects} diff --git a/man/unmarkedPowerList.Rd b/man/unmarkedPowerList.Rd index 3dbbcf13..136e9b78 100644 --- a/man/unmarkedPowerList.Rd +++ b/man/unmarkedPowerList.Rd @@ -3,10 +3,14 @@ \alias{unmarkedPowerList,list-method} \alias{unmarkedPowerList,unmarkedFit-method} \alias{unmarkedPowerList-class} +\alias{unmarkedPowerList_old-class} \alias{unmarkedPowerList-methods} \alias{show,unmarkedPowerList-method} \alias{summary,unmarkedPowerList-method} \alias{plot,unmarkedPowerList,ANY-method} +\alias{show,unmarkedPowerList_old-method} +\alias{summary,unmarkedPowerList_old-method} +\alias{plot,unmarkedPowerList_old,ANY-method} \title{Create or summarize a series of unmarked power analyses} diff --git a/tests/testthat/test_IDS.R b/tests/testthat/test_IDS.R index 61d348db..fa045dce 100644 --- a/tests/testthat/test_IDS.R +++ b/tests/testthat/test_IDS.R @@ -13,7 +13,7 @@ test_that("IDS can fit models with covariates", { # Survey durations, loosely based on real data durs <- list(ds = rep(5, design$Mds), pc=runif(design$Mpc, 3, 30)) - sim_umf <- simulate("IDS", # name of model we are simulating for + sim_umf <- expect_warning(simulate("IDS", # name of model we are simulating for nsim=1, # number of replicates formulas=formulas, coefs=coefs, @@ -25,7 +25,7 @@ test_that("IDS can fit models with covariates", { # could also have e.g. keyfun here durationDS=durs$ds, durationPC=durs$pc, durationOC=durs$oc, maxDistPC=0.5, maxDistOC=0.5, - unitsOut="kmsq") + unitsOut="kmsq")) set.seed(123) mod_sim <- IDS(lambdaformula = ~elev, detformulaDS = ~1, dataDS=sim_umf$ds, dataPC=sim_umf$pc, @@ -85,7 +85,7 @@ test_that("IDS can fit models with occupancy data", { ds = c(intercept=-2.5), oc = c(intercept = -2)) - sim_umf <- simulate("IDS", # name of model we are simulating for + sim_umf <- expect_warning(simulate("IDS", # name of model we are simulating for nsim=1, # number of replicates formulas=formulas, coefs=coefs, @@ -96,7 +96,7 @@ test_that("IDS can fit models with occupancy data", { # arguments used by IDS # could also have e.g. keyfun here maxDistPC=0.5, maxDistOC=0.5, - unitsOut="kmsq") + unitsOut="kmsq")) mod_oc <- IDS(lambdaformula = ~elev, detformulaDS = ~1, detformulaOC = ~1, dataDS=sim_umf$ds, dataPC=sim_umf$pc, dataOC=sim_umf$oc, @@ -146,7 +146,7 @@ test_that("IDS handles missing values", { # Survey durations, loosely based on real data durs <- list(ds = rep(5, design$Mds), pc=runif(design$Mpc, 3, 30)) - sim_umf <- simulate("IDS", # name of model we are simulating for + sim_umf <- expect_warning(simulate("IDS", # name of model we are simulating for nsim=1, # number of replicates formulas=formulas, coefs=coefs, @@ -157,7 +157,7 @@ test_that("IDS handles missing values", { # arguments used by IDS # could also have e.g. keyfun here maxDistPC=0.5, maxDistOC=0.5, - unitsOut="kmsq") + unitsOut="kmsq")) sim_umf$pc@y[1,1] <- NA sim_umf$pc@y[2,] <- NA diff --git a/tests/testthat/test_occuCOP.R b/tests/testthat/test_occuCOP.R index ca880bda..0d5d9afd 100644 --- a/tests/testthat/test_occuCOP.R +++ b/tests/testthat/test_occuCOP.R @@ -363,7 +363,7 @@ test_that("We can simulate COP data", { # From scratch ---- # With no covariates - expect_no_error(simulate( + expect_no_error(expect_warning(simulate( "occuCOP", formulas = list(psi = ~ 1, lambda = ~ 1), coefs = list( @@ -371,10 +371,10 @@ test_that("We can simulate COP data", { lambda = c(intercept = 0) ), design = list(M = 100, J = 100) - )) + ))) # With quantitative covariates - expect_no_error(simulate( + expect_no_error(expect_warning(simulate( "occuCOP", formulas = list(psi = ~ elev, lambda = ~ rain), coefs = list( @@ -382,10 +382,10 @@ test_that("We can simulate COP data", { lambda = c(intercept = log(3), rain = -1) ), design = list(M = 100, J = 5) - )) + ))) # With guides - expect_no_error(simulate( + expect_no_error(expect_warning(simulate( "occuCOP", formulas = list(psi = ~ elev, lambda = ~ rain), coefs = list( @@ -394,10 +394,10 @@ test_that("We can simulate COP data", { ), design = list(M = 100, J = 5), guide = list(elev=list(dist=rnorm, mean=12, sd=0.5)) - )) + ))) # With qualitative covariates - expect_no_error(umf <- simulate( + expect_no_error(umf <- expect_warning(simulate( "occuCOP", formulas = list(psi = ~ elev + habitat, lambda = ~ 1), coefs = list( @@ -411,7 +411,7 @@ test_that("We can simulate COP data", { ), design = list(M = 100, J = 5), guide = list(habitat = factor(levels = c("A", "B", "C"))) - )) + ))) # From unmarkedFitOccuCOP ---- expect_no_error(umfit <- occuCOP( @@ -427,7 +427,7 @@ test_that("We can simulate COP data", { test_that("occuCOP can fit and predict models with covariates", { # Simulate data with covariates ---- set.seed(123) - expect_no_error(umf <- simulate( + expect_no_error(umf <- expect_warning(simulate( "occuCOP", formulas = list(psi = ~ elev + habitat, lambda = ~ rain), coefs = list( @@ -441,7 +441,7 @@ test_that("occuCOP can fit and predict models with covariates", { ), design = list(M = 100, J = 5), guide = list(habitat = factor(levels = c("A", "B", "C"))) - )) + ))) # Fit ---- expect_no_error(umfit <- occuCOP( diff --git a/tests/testthat/test_powerAnalysis.R b/tests/testthat/test_powerAnalysis_deprecated.R similarity index 93% rename from tests/testthat/test_powerAnalysis.R rename to tests/testthat/test_powerAnalysis_deprecated.R index d316a64f..975e1ce5 100644 --- a/tests/testthat/test_powerAnalysis.R +++ b/tests/testthat/test_powerAnalysis_deprecated.R @@ -1,6 +1,7 @@ -context("powerAnalysis method") +context("old powerAnalysis method") skip_on_cran() +skip("Skip old powerAnalysis method tests") test_that("powerAnalysis method works",{ forms <- list(state=~elev, det=~1) coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) @@ -16,7 +17,7 @@ test_that("powerAnalysis method works",{ set.seed(123) pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05, nsim=10) - expect_is(pa, "unmarkedPower") + expect_is(pa, "unmarkedPower_old") s <- summary(pa)$Power expect_true(s[2]>0.7) @@ -26,7 +27,7 @@ test_that("powerAnalysis method works",{ # update pa_up <- update(pa, alpha=0.5) - expect_is(pa_up, "unmarkedPower") + expect_is(pa_up, "unmarkedPower_old") # fewer sites set.seed(123) @@ -47,7 +48,7 @@ test_that("powerAnalysis method works",{ # list pl <- unmarkedPowerList(list(pa, pa2, pa3, pa4)) - expect_is(pl, "unmarkedPowerList") + expect_is(pl, "unmarkedPowerList_old") s <- summary(pl) expect_is(s, "data.frame") @@ -59,7 +60,7 @@ test_that("powerAnalysis method works",{ # generate list scenarios <- expand.grid(M=c(50,100), J=c(2,3)) pl <- unmarkedPowerList(template_model, effect_sizes, design=scenarios, nsim=10) - expect_is(pl, "unmarkedPowerList") + expect_is(pl, "unmarkedPowerList_old") # With random effect set.seed(123) @@ -121,7 +122,7 @@ test_that("powerAnalysis can be run in parallel",{ set.seed(123) pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05, nsim=3, parallel=TRUE) - expect_is(pa, "unmarkedPower") + expect_is(pa, "unmarkedPower_old") }) diff --git a/tests/testthat/test_predict.R b/tests/testthat/test_predict.R index 9c8bcc71..41e3b504 100644 --- a/tests/testthat/test_predict.R +++ b/tests/testthat/test_predict.R @@ -9,7 +9,7 @@ des <- list(M=100, J=5) guide <- list(group=factor(levels=c("A","B","C"))) forms <- list(state=~elev+group, det=~1) -umf <- simulate("occu", design=des, formulas=forms, coefs=cf, guide=guide) +umf <- expect_warning(simulate("occu", design=des, formulas=forms, coefs=cf, guide=guide)) mod <- occu(~1~elev+group, umf) test_that("clean_up_covs works with dynamic model data",{ diff --git a/tests/testthat/test_simulate.R b/tests/testthat/test_simulate_deprecated.R similarity index 99% rename from tests/testthat/test_simulate.R rename to tests/testthat/test_simulate_deprecated.R index 32885f14..9f906a02 100644 --- a/tests/testthat/test_simulate.R +++ b/tests/testthat/test_simulate_deprecated.R @@ -1,6 +1,6 @@ -context("simulate method") +context("old simulate method") skip_on_cran() - +skip("Skip old simulation method tests") test_that("simulate can generate new datasets from scratch",{ set.seed(123) From 57df915d0e012c9362461ff26b8501ed85dbe999 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Wed, 3 Jul 2024 16:16:41 -0400 Subject: [PATCH 02/15] Basic new simulation and power analysis functionality --- R/deprecated_sim_power.R | 13 --- R/power.R | 232 +++++++++++++++++++++++++++++++++++++++ R/simulate.R | 145 +++++++++++++++++++++++- 3 files changed, 371 insertions(+), 19 deletions(-) diff --git a/R/deprecated_sim_power.R b/R/deprecated_sim_power.R index 8b18f729..0a8b3702 100644 --- a/R/deprecated_sim_power.R +++ b/R/deprecated_sim_power.R @@ -903,19 +903,6 @@ check_coefs_old <- function(coefs, fit, template=FALSE){ coefs[required_subs] } -wald <- function(est, se, null_hyp=NULL){ - if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 - Z <- (est-null_hyp)/se - 2*pnorm(abs(Z), lower.tail = FALSE) -} - -diff_dir <- function(est, hyp, null_hyp=NULL){ - if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 - dif <- est - null_hyp - dif_hyp <- hyp - null_hyp - dif * dif_hyp > 0 -} - setMethod("summary", "unmarkedPower_old", function(object, ...){ sum_dfs <- object@estimates npar <- nrow(sum_dfs[[1]]) diff --git a/R/power.R b/R/power.R index e00e8097..0a282f8f 100644 --- a/R/power.R +++ b/R/power.R @@ -1,6 +1,238 @@ +setClass("unmarkedPower", + representation(call="call", data="unmarkedFrame", M="numeric", + J="numeric", T="numeric", coefs="list", estimates="list", + alpha="numeric", nulls="list") +) + setGeneric("powerAnalysis", function(object, ...){ standardGeneric("powerAnalysis") }) +# unmarkedFrame method +# TODO: random effects handling +# TODO: parallel processing +setMethod("powerAnalysis", "unmarkedFrame", + function(object, model = NULL, effects = NULL, alpha = 0.05, + nsim = 100, nulls = NULL, ...){ + + test_data <- y_to_zeros(object) + test_fit <- get_fit(test_data, model, ...) + effects <- check_coefs(effects, test_fit, name = "effects") + + data_sims <- simulate(object, nsim = nsim, model = model, coefs = effects, + quiet = TRUE, ...) + + powerAnalysis_internal(object, model, data_sims, effects, alpha, nulls, ...) +}) + +# list of unmarkedFrames (pre-simulated) method +setMethod("powerAnalysis", "list", + function(object, model = NULL, effects = NULL, alpha = 0.05, + nsim = length(object), nulls = NULL, ...){ + + data1 <- object[[1]] + stopifnot(inherits(data1, "unmarkedFrame")) + stopifnot(all(sapply(object, function(x) identical(class(data1), class(x))))) + stopifnot(nsim <= length(object)) + object <- object[1:nsim] + + test_data <- y_to_zeros(data1) + fit <- get_fit(test_data, model, ...) + effects <- check_coefs(effects, fit, name = "effects") + + powerAnalysis_internal(data1, model, object, effects, alpha, nulls, ...) +}) + +powerAnalysis_internal <- function(object, model, data_sims, + effects, alpha, nulls, ...){ + + fun <- get_fitting_function(object, model) + test_fit <- get_fit(data_sims[[1]], model, ...) + modname <- test_fit@fitType + modname <- "test" + + if(is.null(nulls)){ + nulls <- effects + nulls <- lapply(nulls, function(x){ + x[] <- 0 + x + }) + } else { + nulls <- check_coefs(nulls, test_fit, name = "nulls") + } + + sum_dfs <- pbapply::pblapply(data_sims, function(x){ + fit <- fun(..., data = x) + get_summary_df(fit, effects, nulls) + }) + + sites <- numSites(object) + primaryPeriods <- ifelse(methods::.hasSlot(object, "numPrimary"), + object@numPrimary, 1) + occasions <- ncol(object@y) / primaryPeriods + + new("unmarkedPower", call=call(modname), data=object, + M=sites, J=occasions, T=primaryPeriods, + coefs=effects, estimates=sum_dfs, alpha=alpha, nulls=nulls) +} + +get_summary_df <- function(fit, effects, nulls){ + n_est <- length(fit@estimates@estimates) + est_names <- names(fit@estimates@estimates) + all_est <- lapply(1:n_est, function(i){ + utils::capture.output(out <- summary(fit@estimates@estimates[[i]])) + out <- out[,1:2] + out <- cbind(submodel=est_names[i], param=rownames(out), out) + rownames(out) <- NULL + out + }) + all_est <- do.call(rbind, all_est) + # TODO: Remove random effects + all_est$Effect <- unlist(effects[est_names]) + all_est$Null <- unlist(nulls[est_names]) + + for (i in 1:nrow(all_est)){ + # wald and diff_dir in utils.R + all_est$P[i] <- wald(all_est$Estimate[i], all_est$SE[i], all_est$Null[i]) + all_est$Direct[i] <- diff_dir(all_est$Estimate[i], all_est$Effect[i], + all_est$Null[i]) + } + all_est +} + +wald <- function(est, se, null_hyp=NULL){ + if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 + Z <- (est-null_hyp)/se + 2*pnorm(abs(Z), lower.tail = FALSE) +} + +diff_dir <- function(est, hyp, null_hyp=NULL){ + if(is.null(null_hyp) || is.na(null_hyp)) null_hyp <- 0 + dif <- est - null_hyp + dif_hyp <- hyp - null_hyp + dif * dif_hyp > 0 +} + +setMethod("summary", "unmarkedPower", + function(object, alpha, showIntercepts=FALSE, ...){ + + out <- object@estimates[[1]][,c(1,2,5,6)] + names(out)[1:2] <- c("Submodel", "Parameter") + + if(missing(alpha)){ + alpha <- object@alpha + } + stopifnot(alpha >= 0 & alpha <= 1) + + for (i in 1:nrow(out)){ + pcrit <- sapply(object@estimates, function(x) x$P[i]) < alpha + direct <- sapply(object@estimates, function(x) x$Direct[i]) + ests <- sapply(object@estimates, function(x) x$Estimate[i]) + + out$Power[i] <- mean(pcrit & direct, na.rm=TRUE) + out$`Type S`[i] <- sum(pcrit & !direct, na.rm=TRUE) / sum(pcrit, na.rm=TRUE) + out$`Type M`[i] <- NA + + # Calculate Type M + # Adjust for null != 0 + diff_null <- out$Effect[i] - out$Null[i] + # Don't calculate if effect size is 0 + if(diff_null != 0){ + diffs <- ests - out$Null[i] + out$`Type M`[i] <- mean(abs(diffs[pcrit]), na.rm=TRUE) / abs(diff_null) + } + } + + if(!showIntercepts){ + no_int <- !grepl("(Intercept)",out$Parameter, fixed=TRUE) + multi_interact <- grepl("\\[.*:.*\\]", out$Parameter) + keep <- no_int | multi_interact + if(sum(keep) > 0) out <- out[keep,,drop=FALSE] + } + + out +}) + +setMethod("show", "unmarkedPower", function(object){ + cat("Model:", deparse(object@call[[1]])) + cat("\nSites:", object@M) + cat("\nPrimary Periods:", object@T) + cat("\nOccasions:", object@J) + cat("\nalpha:", object@alpha) + cat("\n\n") + + cat("Power Statistics:\n") + sumtab <- summary(object) + sumtab$Power <- round(sumtab$Power, 3) + sumtab$`Type M` <- round(sumtab$`Type M`, 3) + sumtab$`Type S` <- round(sumtab$`Type S`, 3) + + if(all(sumtab$Null == 0)){ + sumtab$Null <- NULL + } + + print(sumtab, row.names=FALSE) +}) + +setMethod("plot", c(x="unmarkedPower", y="missing"), + function(x, y, alpha, showIntercepts = FALSE, ...){ + if(missing(alpha)) alpha <- x@alpha + stopifnot(alpha >= 0 & alpha <= 1) + pars <- x@estimates[[1]]$param + inds <- 1:length(pars) + if(!showIntercepts){ + no_int <- !grepl("(Intercept)", pars, fixed=TRUE) + multi_interact <- grepl("\\[.*:.*\\]", pars) + keep <- no_int | multi_interact + if(sum(keep) > 0) inds <- which(keep) + #inds <- which(pars != "(Intercept)") + } + + if(length(inds) > 1){ + old_ask <- devAskNewPage() + devAskNewPage(TRUE) + } + sapply(inds, function(i) plot_power(x, i, alpha=alpha, ...)) + if(length(inds) > 1) devAskNewPage(old_ask) + invisible() +}) + +plot_power <- function(object, ind, alpha, ...){ + + submod <- object@estimates[[1]]$submodel[ind] + param <- object@estimates[[1]]$param[ind] + parname <- paste(submod, param, sep=" / ") + effect <- object@estimates[[1]]$Effect[ind] + + ests <- sapply(object@estimates, function(x) x$Estimate[ind]) + pval <- sapply(object@estimates, function(x) x$P[ind]) + direct <- sapply(object@estimates, function(x) x$Direct[ind]) + + if(missing(alpha)){ + alpha <- object@alpha + } + stopifnot(alpha >= 0 & alpha <= 1) + + idx <- 1:length(ests) + plot(idx, ests, pch=19, col="gray", + xlab="Simulation", ylab="Estimated effect size", main=parname, ...) + points(idx[pval < alpha & direct], ests[pval < alpha & direct], pch=19, col='red') + points(idx[pval < alpha & !direct], ests[pval < alpha & !direct], pch=19, col='blue') + abline(h = effect, lty=2, lwd=1.3) + + sig_direct <- ests[pval < alpha & direct] + if(length(sig_direct > 0)){ + abline(h = mean(sig_direct), lty=2, lwd=1.3, col='red') + } + + legend('bottomright', pch=19, col=c("gray", "red", "blue"), + legend=c("Non-significant", "Significant", "Sig & wrong sign")) + legend('bottomleft', lty=2, col=c("black", "red"), + legend=c("True effect size", "Avg significant effect")) + invisible() +} + +# unmarkedPowerlist stuff------------------------------------------------------ + setGeneric("unmarkedPowerList", function(object, ...){ standardGeneric("unmarkedPowerList")}) diff --git a/R/simulate.R b/R/simulate.R index 0668c097..f456785b 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -1,10 +1,105 @@ -replace_estimates <- function(object, new_ests){ - for (i in 1:length(new_ests)){ - est <- object@estimates@estimates[[names(new_ests)[i]]]@estimates - stopifnot(length(est) == length(new_ests[[i]])) - object@estimates@estimates[[names(new_ests)[i]]]@estimates <- new_ests[[i]] - } +setMethod("simulate", "unmarkedFrame", + function(object, nsim = 1, seed = NULL, model = NULL, coefs = NULL, + quiet = FALSE, ...){ + object <- y_to_zeros(object) + fit <- get_fit(object, model, ...) + coefs <- check_coefs(coefs, fit, quiet = quiet) + #coefs <- unmarked:::generate_random_effects(coefs, fit) + fit <- replace_estimates(fit, coefs) + sims <- simulate(fit, nsim) + lapply(sims, function(x) replaceY(object, x)) +}) + +setGeneric("y_to_zeros", function(object, ...){ + standardGeneric("y_to_zeros") +}) + +# Other fit-specific methods at the bottom of the file +setMethod("y_to_zeros", "unmarkedFrame", function(object, ...){ + object@y[] <- 0 object +}) + +get_fit <- function(object, model, ...){ + fun <- get_fitting_function(object, model) + fun(..., data = object, method = "SANN", + control=list(maxit=0), se=FALSE) +} + +setGeneric("get_fitting_function", function(object, model, ...){ + standardGeneric("get_fitting_function") +}) + +# Other fit-specific methods at the bottom of the file +setMethod("get_fitting_function", "unmarkedFrameOccu", + function(object, model, ...){ + + if(!(identical(model, occuRN) | identical(model, occu))){ + stop("model argument must be occu or occuRN", call.=FALSE) + } + model +}) + +check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){ + required_subs <- names(fit@estimates@estimates) + required_coefs <- lapply(fit@estimates@estimates, function(x) names(x@estimates)) + required_lens <- lapply(required_coefs, length) + + formulas <- sapply(names(fit), function(x) get_formula(fit, x)) + + # If there are random effects, adjust the expected coefficient names + # to remove the b vector and add the grouping covariate name + rand <- lapply(formulas, lme4::findbars) + if(!all(sapply(rand, is.null))){ + stopifnot(all(required_subs %in% names(formulas))) + rvar <- lapply(rand, function(x) unlist(lapply(x, all.vars))) + if(!all(sapply(rvar, length)<2)){ + stop("Only 1 random effect per parameter is supported", call.=FALSE) + } + for (i in required_subs){ + if(!is.null(rand[[i]][[1]])){ + signame <- rvar[[i]] + old_coefs <- required_coefs[[i]] + new_coefs <- old_coefs[!grepl("b_", old_coefs, fixed=TRUE)] + new_coefs <- c(new_coefs, signame) + required_coefs[[i]] <- new_coefs + } + } + } + + dummy_coefs <- lapply(required_coefs, function(x){ + out <- rep(0, length(x)) + names(out) <- x + out + }) + + if(is.null(coefs)){ + cat(name, "should be a named list of vectors, with the following structure + (replace 0s with your values):\n\n") + print(dummy_coefs) + stop(paste("Specify", name, "argument as shown above", call.=FALSE)) + } + + for (i in 1:length(required_subs)){ + if(!required_subs[i] %in% names(coefs)){ + stop(paste0("Missing required list element '", + required_subs[i], "' in ", name, " list"), call.=FALSE) + } + + sub_coefs <- coefs[[required_subs[i]]] + + if(!quiet){ + message(paste0("Assumed parameter order for ", required_subs[i], ":\n", + paste(required_coefs[[i]], collapse=", "))) + } + + if(length(sub_coefs) != required_lens[i]){ + stop(paste0("Entry '",required_subs[[i]], "' in ", name, " list must be length ", + required_lens[[i]]), call.=FALSE) + } + + } + coefs[required_subs] } generate_random_effects <- function(coefs, fit){ @@ -43,3 +138,41 @@ generate_random_effects <- function(coefs, fit){ coefs } +replace_estimates <- function(object, new_ests){ + for (i in 1:length(new_ests)){ + est <- object@estimates@estimates[[names(new_ests)[i]]]@estimates + stopifnot(length(est) == length(new_ests[[i]])) + object@estimates@estimates[[names(new_ests)[i]]]@estimates <- new_ests[[i]] + } + object +} + + +# y_to_zeros------------------------------------------------------------------- + +setMethod("y_to_zeros", "unmarkedFrameOccuMulti", function(object, ...){ + newy <- lapply(object@ylist, function(x){ + x[] <- 0 + x + }) + object@ylist <- newy + object +}) + +# get_fitting_function--------------------------------------------------------- + +setMethod("get_fitting_function", "unmarkedFrameGDS", + function(object, model, ...){ + gdistsamp +}) + +setMethod("get_fitting_function", "unmarkedFramePCount", + function(object, model, ...){ + pcount +}) + +setMethod("get_fitting_function", "unmarkedFrameOccuMulti", + function(object, model, ...){ + occuMulti +}) + From 4a8e6d17ab1f6f9618962828dddd9fe55bfd3efc Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Fri, 5 Jul 2024 11:26:52 -0400 Subject: [PATCH 03/15] Re-enable random effects support --- R/simulate.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/simulate.R b/R/simulate.R index f456785b..458ff7f4 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -4,7 +4,7 @@ setMethod("simulate", "unmarkedFrame", object <- y_to_zeros(object) fit <- get_fit(object, model, ...) coefs <- check_coefs(coefs, fit, quiet = quiet) - #coefs <- unmarked:::generate_random_effects(coefs, fit) + coefs <- generate_random_effects(coefs, fit) fit <- replace_estimates(fit, coefs) sims <- simulate(fit, nsim) lapply(sims, function(x) replaceY(object, x)) @@ -43,7 +43,6 @@ setMethod("get_fitting_function", "unmarkedFrameOccu", check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){ required_subs <- names(fit@estimates@estimates) required_coefs <- lapply(fit@estimates@estimates, function(x) names(x@estimates)) - required_lens <- lapply(required_coefs, length) formulas <- sapply(names(fit), function(x) get_formula(fit, x)) @@ -66,6 +65,7 @@ check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){ } } } + required_lens <- lapply(required_coefs, length) dummy_coefs <- lapply(required_coefs, function(x){ out <- rep(0, length(x)) @@ -97,6 +97,7 @@ check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){ stop(paste0("Entry '",required_subs[[i]], "' in ", name, " list must be length ", required_lens[[i]]), call.=FALSE) } + names(coefs[[required_subs[i]]]) <- required_coefs[[i]] } coefs[required_subs] @@ -128,7 +129,12 @@ generate_random_effects <- function(coefs, fit){ if(!is.factor(lvldata)){ stop("Random effect covariates must be specified as factors with guide argument", call.=FALSE) } - b <- stats::rnorm(length(levels(lvldata)), 0, old_coefs[signame]) + sigma <- old_coefs[signame] + if(sigma <= 0){ + stop("estimate for random effect represents sigma and must be positive", + call.=FALSE) + } + b <- stats::rnorm(length(levels(lvldata)), 0, sigma) names(b) <- rep(paste0("b_",i), length(b)) new_coefs <- c(new_coefs, b) coefs[[i]] <- new_coefs From c60df99c3a64e9bd3e77a36aace4abee35524f18 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Fri, 5 Jul 2024 11:50:39 -0400 Subject: [PATCH 04/15] Handle random effects in power analysis --- R/power.R | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/R/power.R b/R/power.R index 0a282f8f..036d2c13 100644 --- a/R/power.R +++ b/R/power.R @@ -87,7 +87,21 @@ get_summary_df <- function(fit, effects, nulls){ out }) all_est <- do.call(rbind, all_est) - # TODO: Remove random effects + + # Remove random effects from output list + effects <- unmarked:::check_coefs(effects, fit, quiet=TRUE) + rvars <- sapply(names(fit), function(x){ + bars <- lme4::findbars(unmarked:::get_formula(fit, x)) + all.vars(bars[[1]]) + }) + + for (i in names(effects)){ + ef <- effects[[i]] + keep <- which(!names(ef) %in% rvars[[i]]) + effects[[i]] <- ef[keep] + nulls[[i]] <- nulls[[i]][keep] + } + all_est$Effect <- unlist(effects[est_names]) all_est$Null <- unlist(nulls[est_names]) From bc7f21ea70ed654ba109b752e97341c2fe83e502 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Fri, 5 Jul 2024 13:13:06 -0400 Subject: [PATCH 05/15] Update docs for simulate methods --- R/power.R | 8 +- man/simulate-methods.Rd | 160 +++++++++++++++++++--------------------- 2 files changed, 79 insertions(+), 89 deletions(-) diff --git a/R/power.R b/R/power.R index 036d2c13..164357df 100644 --- a/R/power.R +++ b/R/power.R @@ -89,9 +89,9 @@ get_summary_df <- function(fit, effects, nulls){ all_est <- do.call(rbind, all_est) # Remove random effects from output list - effects <- unmarked:::check_coefs(effects, fit, quiet=TRUE) + effects <- check_coefs(effects, fit, quiet=TRUE) rvars <- sapply(names(fit), function(x){ - bars <- lme4::findbars(unmarked:::get_formula(fit, x)) + bars <- lme4::findbars(get_formula(fit, x)) all.vars(bars[[1]]) }) @@ -239,9 +239,9 @@ plot_power <- function(object, ind, alpha, ...){ abline(h = mean(sig_direct), lty=2, lwd=1.3, col='red') } - legend('bottomright', pch=19, col=c("gray", "red", "blue"), + graphics::legend('bottomright', pch=19, col=c("gray", "red", "blue"), legend=c("Non-significant", "Significant", "Sig & wrong sign")) - legend('bottomleft', lty=2, col=c("black", "red"), + graphics::legend('bottomleft', lty=2, col=c("black", "red"), legend=c("True effect size", "Avg significant effect")) invisible() } diff --git a/man/simulate-methods.Rd b/man/simulate-methods.Rd index 5d37dad3..073686cb 100644 --- a/man/simulate-methods.Rd +++ b/man/simulate-methods.Rd @@ -1,6 +1,8 @@ \name{simulate-methods} \docType{methods} \alias{simulate-methods} +\alias{simulate,unmarkedFit-method} +\alias{simulate,unmarkedFrame-method} \alias{simulate,unmarkedFitColExt-method} \alias{simulate,unmarkedFitDS-method} \alias{simulate,unmarkedFitMPois-method} @@ -25,69 +27,37 @@ \title{Methods for Function simulate in Package `unmarked'} \description{ -Simulate data from a fitted model. +Simulate data from a fitted model or an \code{unmarkedFrame}. } \usage{ -\S4method{simulate}{unmarkedFitColExt}(object, nsim, seed, na.rm) -\S4method{simulate}{unmarkedFitDS}(object, nsim, seed, na.rm) -\S4method{simulate}{unmarkedFitMPois}(object, nsim, seed, na.rm) -\S4method{simulate}{unmarkedFitOccu}(object, nsim, seed, na.rm) -\S4method{simulate}{unmarkedFitOccuRN}(object, nsim, seed, na.rm) -\S4method{simulate}{unmarkedFitPCount}(object, nsim, seed, na.rm) -\S4method{simulate}{character}(object, nsim=1, seed=NULL, formulas, coefs=NULL, - design, guide=NULL, ...) +\S4method{simulate}{unmarkedFit}(object, nsim, seed, na.rm) +\S4method{simulate}{unmarkedFrame}(object, nsim=1, seed=NULL, model = NULL, + coefs = NULL, quiet = FALSE, ...) } \arguments{ -\item{object}{Fitted model of appropriate S4 class} +\item{object}{Fitted model or \code{unmarkedFrame}.} \item{nsim}{Number of simulations} \item{seed}{Seed for random number generator. Not currently implemented} \item{na.rm}{Logical, should missing values be removed?} -\item{formulas}{ - A named list of formulas, one per submodel (e.g. a formula for occupancy - \code{"state"} and a formula for detection \code{"det"}). To get the correct - submodel names for a given model, fit an example for that model, and then - call \code{names(fitted_model)} +\item{model}{The model to use when \code{object} is an \code{unmarkedFrame} + used for multiple model types. For example, if the \code{object} is an + \code{unmarkedFrameOccu}, model should be set to \code{occu} or \code{occuRN}.} +\item{coefs}{List with one element per submodel. Each list element should be + named with the corresponding submodel, and should be a numeric vector of + parameter values to use for that submodel when simulating the dataset. + Note that parameter values should be on the inverse link scale. + The number of parameter values in the vector depends on the model specified, + covariates, etc. If you are not sure how to specify this list, set + \code{coefs = NULL} and the function will return the correct structure.} +\item{quiet}{If TRUE, don't print informational messages.} +\item{...}{Used only for the \code{unmarkedFrame} method. Arguments to send to + the corresponding fitting function. Most importantly this will include + formula arguments, but could also include distributions, key functions, etc. + For example, for simulating occupancy data, you must also supply the argument + \code{formula = ~1~1} for a no-covariate model, \code{formula=~1~x} for a + covariate effect of \code{x} on occupancy, etc. See examples below.} } -\item{coefs}{ - A named list of vectors of coefficients associated with the regression - intercepts and slopes for each submodel. List should be named as with - \code{formulas} above. Each element of the list should be a named vector, - where the names correspond to the names of the parameters in the model - (intercept and covariates). If you are not sure how to structure this list, - just run \code{simulate} with \code{coefs=NULL}; this will generate - a template list you can copy and fill in. -} -\item{design}{ - A named list of components of the study design. Must include at least \code{M}, - the number of sites, and \code{J} the number of observations per site. If you - are fitting a model with multiple primary periods you must also provide - \code{T}, the number of primary periods. -} -\item{guide}{ - An optional list defining the format (continuous or categorical/factor) and distribution, - if continuous, of covariates you want to simulate. By default all covariates - are simulated from a standard normal. See example below for an example of - how to specify entries in the \code{guide} list. -} -\item{...}{ - Additional arguments that are needed to fully specify the simulated dataset - for a particular model. For example, \code{mixture} for \code{pcount} models - or \code{keyfun} for \code{distsamp} models. -} -} - -\section{Methods}{ -\describe{ -\item{object = "unmarkedFitColExt"}{A model fit by \code{\link{colext}}} -\item{object = "unmarkedFitDS"}{A model fit by \code{\link{distsamp}}} -\item{object = "unmarkedFitMPois"}{A model fit by \code{\link{multinomPois}}} -\item{object = "unmarkedFitOccu"}{A model fit by \code{\link{occu}}} -\item{object = "unmarkedFitOccuRN"}{A model fit by \code{\link{occuRN}}} -\item{object = "unmarkedFitPCount"}{A model fit by \code{\link{pcount}}} -\item{object = "character"}{An \code{unmarkedFrame} of the appropriate type} -}} -\keyword{methods} \examples{ @@ -95,47 +65,67 @@ Simulate data from a fitted model. # Simulation of an occupancy dataset from scratch -# Formulas for each submodel -# occupancy is a function of elevation, detection is intercept-only -forms <- list(state=~elev, det=~1) +# First create an unmarkedFrame with the correct design + +M <- 300 # number of sites +J <- 5 # number of occasions -# Specify list of coefficients - there must be a value for each -# covariate plus an intercept for each submodel -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) +# The values in the y-matrix don't matter as they will be simulated +# We can supply them as all NAs +y <- matrix(NA, M, J) -# Study design -design <- list(M=300, J=8) # 300 sites, 8 occasions per site +# Site covariate +x <- rnorm(M) +# Create unmarkedFrame +umf <- unmarkedFrameOccu(y = y, siteCovs = data.frame(x = x)) + +# Must specify model = occu since unmarkedFrameOccu is also used for occuRN +# the formula species the specific model structure we want to simulate # If we don't specify coefs, unmarked will generate a template you can copy and use -simulate("occu", formulas=forms, design=design) +simulate(umf, model = occu, formula = ~1~x) + +# Now set coefs +# Here we imply a mean occupancy and mean detection of 0.5 +# (corresponding to values of 0 on the inverse link scale) and a positive effect of x +s <- simulate(umf, model = occu, formula = ~1~x, + coefs = list(state = c(0,0.3), det = 0)) + +head(s[[1]]) + +occu(~1~x, s[[1]]) + +# For some models we can also include a random effect +# add a factor covariate +umf@siteCovs$x2 <- factor(sample(letters[1:10], M, replace=TRUE)) + +# The final value in coefs now represents the random effect SD for x2 +s <- simulate(umf, model = occu, formula = ~1~x+(1|x2), + coefs = list(state = c(0,0.3, 1), det = 0)) -# Generate unmarkedFrameOccu -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) -head(occu_umf) # note one covariate, elev +head(s[[1]]) -# What if we wanted to add a categorical/factor covariate or -# customize the distribution of elev? -# Use the guide argument +occu(~1~x+(1|x2), s[[1]]) -# Updated formulas with new covariate -forms2 <- list(state=~elev+landcover, det=~1) +# Here's a more complicated example simulating a gdistsamp dataset +# using a negative binomial distribution +M <- 100 +J <- 3 +T <- 2 +y <- matrix(NA, M, J*T) +umf2 <- unmarkedFrameGDS(y=y, + siteCovs=data.frame(x=rnorm(M)), + dist.breaks = c(0, 10, 20, 30), unitsIn='m', + numPrimary = T, survey="point") -# Guide -# landcover is factor, you must provide the levels -guide <- list(landcover=factor(levels=c("forest","grass")), - elev=list(dist=rnorm, mean=2, sd=0.5)) # custom distribution +cf <- list(lambda=c(1, 0.3), phi=0, det=c(log(20), 0), alpha=log(1)) -# Updated coefficients list -coefs2 <- list(state=c(intercept=0, elev=-0.4, landcovergrass=0.2), det=c(intercept=0)) +# Note we now also supply another argument mixture="NB" to ... +s2 <- simulate(umf2, coefs=cf, lambdaformula=~x, phiformula=~1, pformula=~x, + mixture="NB") +head(s2[[1]]) -# Simulate new dataset -head(simulate("occu", formulas=forms2, coefs=coefs2, design=design, guide=guide)) -# Note new categorical covariate +gdistsamp(~x, ~1, ~x, s2[[1]], mixture="NB") -# For some models you may want to specify other arguments, such as 'mixture' -# for pcount or 'keyfun' for distsamp -# See the documentation for the associated fitting function and unmarkedFrame -# for what arguments are possible to include for a given model -head(simulate("pcount", formulas=forms, coefs=coefs, design=design, mixture="NB")) } } From 2c5c4564b9ef21c3908ac9fcd3f0842f9870127e Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Fri, 5 Jul 2024 13:55:54 -0400 Subject: [PATCH 06/15] Fix power analysis docs --- man/powerAnalysis.Rd | 128 +++++++++++++++++-------------------- man/unmarkedPower-class.Rd | 48 ++++---------- 2 files changed, 69 insertions(+), 107 deletions(-) diff --git a/man/powerAnalysis.Rd b/man/powerAnalysis.Rd index 43dd10a7..172c0ece 100644 --- a/man/powerAnalysis.Rd +++ b/man/powerAnalysis.Rd @@ -1,65 +1,60 @@ \name{powerAnalysis} \alias{powerAnalysis} +\alias{powerAnalysis,unmarkedFrame-method} +\alias{powerAnalysis,list-method} \alias{powerAnalysis,unmarkedFit-method} -\title{Conduct a power analysis on an unmarked model} +\title{Conduct a power analysis for an unmarked model} \description{ This function uses a simulation-based approach to estimate power for parameters -in unmarked models. At a minimum, users must provide a fitted \code{unmarked} model object -(preferably fit with simulated data) which ensures the model has been properly -specified, a list of effect sizes for each parameter in the model (\code{coefs}), -and the desired Type I error (\code{alpha}). It is also possible to get power -for a range of other sample sizes besides the sample size in the fitted -model object using the \code{design} argument to subsample within the -provided dataset. See the \code{unmarkedPower} vignette for more details and +in unmarked models. At a minimum, users must provide an \code{unmarkedFrame} +object describing the experimental design and a list of effect sizes for each +parameter in the model. See the \code{unmarkedPower} vignette for more details and examples. } \usage{ - \S4method{powerAnalysis}{unmarkedFit}(object, coefs=NULL, design=NULL, alpha=0.05, nulls=list(), - datalist=NULL, - nsim=ifelse(is.null(datalist), 100, length(datalist)), - parallel=FALSE) + \S4method{powerAnalysis}{unmarkedFrame}(object, model = NULL, effects = NULL, + alpha=0.05, nsim = 100, nulls=NULL, ...) + \S4method{powerAnalysis}{list}(object, model = NULL, effects = NULL, + alpha=0.05, nsim = length(object), nulls=NULL, ...) } \arguments{ - \item{object}{A fitted model inheriting class \code{unmarkedFit}. This - could potentially be fit using real data, but ideally you would simulate - an appropriate dataset using \code{simulate}} - \item{coefs}{A list containing the desired effect sizes for which you want - to estimate power. This list must follow a specific format. There is one - named entry in the list per submodel (e.g., occupancy, detection). To - get the required submodel names call \code{names(object)} on your fitted model. - Then, each list entry is a named vector with the names corresponding to the - parameter names for that submodel, and the values corresponding to the - desired effect sizes. It may be easier to leave \code{coefs=NULL}, which - will generate an error message with a template that you can fill in. + \item{object}{An \code{unmarkedFrame} object representing the desired study + design. The values in the response (\code{y}) don't matter and can be missing. + Alternatively, you can provide a list of such objects with the + response data already simulated (such as the output from \code{simulate}). + } + \item{model}{The model to use when the \code{unmarkedFrame} type is used for + multiple model types. For example, if the \code{object} is an + \code{unmarkedFrameOccu}, model should be set to \code{occu} or \code{occuRN}. } - \item{design}{An optional list of design/sample size parameters containing - at a minimum two named elements: \code{M}, the number of sites, and \code{J} - the number of observations per site. If this list is provided, \code{unmarked} - will subsample the provided dataset to the specified number of sites and - observations, allowing you to test power for different designs. If - your model has multiple primary periods you must also include \code{T}, - the number of periods, in the list. + \item{effects}{A list containing the desired effect sizes/parameter values + for which you want to estimate power. This list must follow a specific format. + There is one named entry in the list per submodel (e.g., occupancy, detection). + Each list element should be a numeric vector with length equal to the number + of parameters in that submodel. Parameter values are on the inverse link + scale. You can leave \code{effects=NULL}, which + will generate an error message with a template that you can fill in. } - \item{alpha}{Desired Type I error rate} - \item{nulls}{If provided, a list matching the structure of \code{coefs} which + \item{alpha}{Desired Type I error rate.} + \item{nsim}{Number of simulations to conduct.} + \item{nulls}{If provided, a list matching the structure of \code{effects} which defines the null hypothesis value for each parameter. By default the null is 0 for all parameters. } - \item{datalist}{An optional list of previously-simulated datasets, in the form - of \code{unmarkedFrames} matching the model type of \code{object}, which - will be used for the power analysis simulations. - } - \item{nsim}{Number of simulations to conduct} - \item{parallel}{If \code{TRUE}, run folds in parallel. This may speed up - the power analysis in some situations - } + \item{...}{Arguments to send to the fitting function for the model. + Most importantly this will include formula argument(s), but could also include + distributions, key functions, etc. For example, for simulating occupancy data, + you must also supply the argument \code{formula = ~1~1} for a no-covariate model, + \code{formula=~1~x} for a covariate effect of \code{x} on occupancy, etc.} } -\value{\code{unmarkedPower} object containing the results of the power analysis} +\value{\code{unmarkedPower} object containing the results of the power analysis. + For information on interpretation of the output, see the power analysis + vignette.} \author{Ken Kellner \email{contact@kenkellner.com}} @@ -71,36 +66,27 @@ examples. \dontrun{ -# Simulate an occupancy dataset -# Covariates to include in simulation -forms <- list(state=~elev, det=~1) - -# Covariate effects and intercept values -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) - -# Study design -design <- list(M=300, J=8) # 300 sites, 8 occasions per site - -# Simulate an unmarkedFrameOccu -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) - -# Fit occupancy model to simulated data -# This will contain all the model structure info powerAnalysis needs -# The estimates from the model aren't used -template_model <- occu(~1~elev, occu_umf) - -# If we run powerAnalysis without specifying coefs we'll get a template list -powerAnalysis(template_model) - -# Set desired effect sizes to pass to coefs -effect_sizes <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) - -# Run power analysis and look at summary -(pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05)) - -# Try a smaller sample size in the study design -(pa2 <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05, - design=list(M=100, J=2))) +# Create experimental design +M <- 50 +J <- 3 +y <- matrix(NA, M, J) +sc <- data.frame(x=rnorm(M)) +umf <- unmarkedFrameOccu(y, siteCovs=sc) + +# Power analysis +p <- powerAnalysis(umf, model=occu, formula=~1~x, + effects = list(state = c(-0.2, 0.3), det = 0)) + +p +summary(p, alpha=0.3) +plot(p, ylim=c(-3, 3)) +plot(p, ylim=c(-3, 3)) + +# Simulate your own datasets first and pass to power analysis +cf <- list(state=c(0,1), det=0) +s <- simulate(umf, model = occu, formula=~1~x, coefs=cf, nsim = 100) +p2 <- powerAnalysis(s, model=occu, formula=~1~x, effects=cf) +p2 } } diff --git a/man/unmarkedPower-class.Rd b/man/unmarkedPower-class.Rd index 3d7110a0..9030ce94 100644 --- a/man/unmarkedPower-class.Rd +++ b/man/unmarkedPower-class.Rd @@ -8,28 +8,32 @@ \alias{show,unmarkedPower_old-method} \alias{summary,unmarkedPower_old-method} \alias{update,unmarkedPower_old-method} +\alias{plot,unmarkedPower,missing-method} \title{Methods for unmarkedPower objects} -\description{Various functions to summarize and update unmarkedPower objects} +\description{Various functions to summarize unmarkedPower objects} \usage{ \S4method{show}{unmarkedPower}(object) -\S4method{summary}{unmarkedPower}(object, ...) -\S4method{update}{unmarkedPower}(object, ...) +\S4method{summary}{unmarkedPower}(object, alpha, showIntercepts = FALSE, ...) +\S4method{plot}{unmarkedPower,missing}(x, y, alpha, showIntercepts = FALSE, ...) } \arguments{ - \item{object}{An object of class \code{unmarkedPower} created with the + \item{object,x}{An object of class \code{unmarkedPower} created with the \code{powerAnalysis} function} - \item{...}{For \code{update}, arguments to change in the updated power analysis. - Not used by \code{summary}} + \item{alpha}{Desired Type I error rate. If not provided, defaults to the value + specified when calling \code{powerAnalysis}.} + \item{showIntercepts}{Show intercepts output? This is + rarely useful.} + \item{y}{Not currently used.} + \item{...}{Not currently used.} } \value{ For \code{show} and \code{summary}, summary output is printed to the console. - For \code{update}, a new \code{powerAnalysis} object corresponding to the - new arguments provided. + For \code{plot}, a visualization of the summary output is created. } \author{Ken Kellner \email{contact@kenkellner.com}} @@ -37,31 +41,3 @@ \seealso{ \code{\link{powerAnalysis}} } - -\examples{ - -\dontrun{ - -# Simulate an occupancy dataset -forms <- list(state=~elev, det=~1) -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) -design <- list(M=300, J=8) # 300 sites, 8 occasions per site -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) - -# Fit occupancy model to simulated data -template_model <- occu(~1~elev, occu_umf) - -# Set desired effect sizes to pass to coefs -effect_sizes <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) - -# Run power analysis -pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05) - -# Look at summary -summary(pa) - -# Update the analysis with new arguments -(pa2 <- update(pa, alpha=0.01)) - -} -} From cb876e4e52f7eeaaa0f29b554c697aeb1c84ac2e Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Sun, 7 Jul 2024 15:21:20 -0400 Subject: [PATCH 07/15] New simulate vignette --- R/simulate.R | 11 ++ vignettes/simulate.Rmd | 271 ++++++++++++++++++++--------------------- 2 files changed, 144 insertions(+), 138 deletions(-) diff --git a/R/simulate.R b/R/simulate.R index 458ff7f4..2fee1a32 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -165,6 +165,13 @@ setMethod("y_to_zeros", "unmarkedFrameOccuMulti", function(object, ...){ object }) +setMethod("y_to_zeros", "unmarkedFrameGDR", function(object, ...){ + object@yDistance[] <- 0 + object@yRemoval[] <- 0 + object +}) + + # get_fitting_function--------------------------------------------------------- setMethod("get_fitting_function", "unmarkedFrameGDS", @@ -182,3 +189,7 @@ setMethod("get_fitting_function", "unmarkedFrameOccuMulti", occuMulti }) +setMethod("get_fitting_function", "unmarkedFrameGDR", + function(object, model, ...){ + gdistremoval +}) diff --git a/vignettes/simulate.Rmd b/vignettes/simulate.Rmd index 5b7decf6..b7b317d1 100644 --- a/vignettes/simulate.Rmd +++ b/vignettes/simulate.Rmd @@ -1,7 +1,7 @@ --- title: Simulating datasets author: Ken Kellner -date: September 10, 2021 +date: July 7, 2024 bibliography: unmarked.bib csl: ecology.csl output: @@ -35,232 +35,227 @@ In this vignette we will focus on (2), a more flexible approach to simulation, a # Components of a call to simulate -We will need to provide, at a minimum, four pieces of information to `simulate` in order to simulate a dataset from scratch in `unmarked`. +We will need to provide several pieces of information to `simulate` in order to simulate a dataset from scratch in `unmarked`. -1. The name of the fitting function for the model we want to simulate from, as a character string -2. A list of formulas, one per submodel, containing the names of the covariates we want to include in each -3. A list of vectors of regression coefficients (intercepts and slopes), one per submodel, matching the formulas -4. A list of design components; for example, the number of sites and number of observations per site - -A number of other arguments are available, e.g. for how to customize how the covariates are randomly generated or for distributions to use when simulating abundances. -We'll show those later. -The easiest way to demonstrate how to use `simulate` is to look at an example: we'll start with a simple one for occupancy. +1. An `unmarkedFrame` of the appropriate type defining the desired experimental design +2. The model to use (`model`), if the `unmarkedFrame` is used for multiple model types +3. Other arguments required by the fitting function for which we are simulating. Most importantly this will include formulas for each submodel. +4. A named list of parameter or coefficient values (`coefs`) controlling the simulation, which correspond to the formula(s) specified earlier. # Simulating an occupancy dataset -Suppose we want to simulate an occupancy dataset in which site occupancy is affected by elevation. -The first piece of information needed is the name of model to use: the fitting function for occupancy is `occu`, so the first argument to `simulate` and the name of the model will be `"occu"`. +The easiest way to demonstrate how to use `simulate` is to look at an example: we'll start with a simple one for occupancy. -## Formulas +## 1. The `unmarkedFrame` -Second we must define the desired model structure as a list of formulas, one per submodel. -"Submodels" here are the hierarchical components of the model; for example, an occupancy model has a state (occupancy) submodel and an observation (detection) submodel. -These submodels are identified by short names: `state` and `det`. -We will use these short names repeatedly. -In order to identify which submodels are needed and what their short names are, we can simply fit any model of that type (e.g. from the example) and call `names(model)`. +Suppose we want to simulate a single-season occupancy dataset in which site occupancy is affected by elevation. +The first step is to create an `unmarkedFrame` object of the appropriate type, which defines the experimental design and includes any covariates we want to use in the simulation. +Since we want to simulate an occupancy dataset, we'll create an `unmarkedFrameOccu`. + +The `unmarkedFrameOccu` function takes three arguments: the observation matrix `y`, the site covariates `siteCovs`, and the observation-level covariates `obsCovs`. +The dimensions of `y` define how many sites and replicate samples the study includes. +We'll create a blank `y` matrix (i.e., filled with `NA`s) of dimension 300 x 8, indicating we want our study to have 300 sites and 8 sampling occasions. +The values you put in this `y` matrix don't matter, you can put anything in there you want as they'll be overwritten with the simulated values later. +It's only used to define the number of sites and occasions. ```{r} set.seed(123) -library(unmarked) -umf <- unmarkedFrameOccu(y=matrix(c(0,1,0,1,1,0,0,0,1), nrow=3)) -mod <- occu(~1~1, umf) -names(mod) +M <- 300 +J <- 8 +y <- matrix(NA, M, J) ``` -Formulas are supplied as a named list. -The list has one element per submodel, and the names of the elements are the short names defined above. -Each list element is a formula, containing the desired number of covariates to use, and the names of these covariates. -Below we define our list of formulas, including an effect of elevation on occupancy (note we could name this whatever we want, here we call it `elev`). -We don't want any covariates on detection probability, so the formula defines the model as intercept only: `~1`. +Earlier we said we want to include an elevation covariate, so we'll simulate the covariate now and add it to a data frame. +We could create several covariates here, including factors, etc. ```{r} -forms <- list(state=~elev, det=~1) +site_covs <- data.frame(elev = rnorm(M)) ``` -## Regression coefficients - -Next we must tell `unmarked` what the values for the intercept and regression coefficients in each submodel should be. -Once again, this is a named list, one element for each submodel. -Each list element is a numeric vector. -The components of each numeric vector must also be named, matching the covariate names in our list of formulas. -Don't forget we also must specify a value for the intercept in each submodel (can be named `Intercept` or `intercept`). -If we are not sure exactly how to structure this list, just skip it for now: `unmarked` can generate a template for us to fill in later. +We're not using any observation covariates, so we can now make the complete `unmarkedFrameOccu`: ```{r} -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) +umf <- unmarkedFrameOccu(y = y, siteCovs = site_covs) +head(umf) ``` -We have a list with two elements, each a numeric vector. -Both contain intercept values, and the `state` vector also contains a value corresponding to the desired effect of our covariate `elev`. - -## Study design information +## 2. Specify the model type -Finally, we need to give `unmarked` information about the study design. -This is pretty simple: we just need a list containing values for `M`, the number of sites, and `J` the number of surveys per site. -For models with multiple primary periods, we'd also need a value of `T`, the number of primary periods. +Since `unmarkedFrameOccu` is used by both the single-season occupancy model (`occu`) and the Royle-Nichols occupancy model (`occuRN`), we need to tell `unmarked` which one to use. ```{r} -design <- list(M=300, J=8) # 300 sites, 8 occasions per site +model <- occu ``` -## Put it all together +Most `unmarkedFrame` types in `unmarked` are used by only one model fitting function, so this step is often unnecessary. + +## 3. Specify other arguments to the fitting function + +Take a look at the help file for `occu`. +When fitting a single-season occupancy model we need to provide, in addition to the data, the `formula` argument defining the model structure. +We'll need to provide these same argument(s) to `simulate`. +Many fitting functions will have multiple required arguments, such as the mixture distribution to use, key functions, etc. -We're now ready to simulate a dataset. -To do this we use the `simulate` function, providing as arguments the name of the model `"occu"` and the three lists we constructed above. -Actually, first, let's not supply the `coefs` list, to show how `unmarked` will generate a template for us to use: +Here we specify a double right-hand-side formula as required by `occu`, specifying an effect of elevation on occupancy. -```{r, eval=FALSE} -simulate("occu", formulas=forms, design=design) +```{r} +form <- ~1~elev ``` -```{r, echo=FALSE} -try(simulate("occu", formulas=forms, design=design)) +## 4. Specify the corresponding parameter values + +The model structure, as defined by the formula above, implies a certain set of parameter/coefficient values (intercepts, slopes) we need to supply to `simulate`. +These need to be supplied as a named list, where each list element corresponds to one submodel (such as `state` for occupancy and `det` for detection). +Each list element is a numeric vector of the required parameter values. +It can be tricky to figure out the structure of this list, so `simulate` allows you to not include it at first, in which case the function will return a template for you to fill in. + +```{r, error = TRUE} +simulate(umf, model = model, formula = form) ``` -We can replicate this provided list structure and fill in our own numeric values. -Once we have our coefficients set up properly, add them to the function call: +We need to supply a list with two elements `state` and `det`. +The `state` element contains two values, the intercept and the slope corresponding to elevation. +The `det` element contains only the intercept since we have no covariates on detection. +Note that all values supplied in this list *must* be on the inverse link scale, which will depend on the specific submodel used. +So for example, a value of 0 for `det` implies a detection probability of 0.5, because we're using the logit link function. ```{r} -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) -head(occu_umf) +plogis(0) ``` -`unmarked` has generated a presence-absence dataset as well as values for covariate `elev`. -We can check that it worked as expected by fitting the corresponding model to the dataset, and making sure the estimated values are similar: +Now let's make our own `coefs` list: ```{r} -(occu(~1 ~elev, occu_umf)) +cf <- list(state = c(0, -0.4), det = 0) ``` -## Customizing the covariates +Here we're setting a negative effect of elevation on occupancy. -By default, a covariate will be continuous and come from a standard normal distribution (mean 0, SD 1). -However, we can control this using the `guide` argument. -For example, suppose we want elevation to come from a random normal, but with a mean of 2 and a standard deviation of 0.5. -We can provide a named list to the `guide` argument as follows: +## Run simulate + +We now have all the pieces to simulate a dataset. ```{r} -guide <- list(elev=list(dist=rnorm, mean=2, sd=0.5)) +out <- simulate(umf, model = occu, formula = ~1~elev, coefs = cf) ``` -`guide` contains one element, called `elev`, which is also a list and contains three components: - -1. The random distribution function to use, `rnorm` -2. The mean of the distribution -3. The SD of the distribution +The result is always a list of `unmarkedFrame`s. +By default, we just get one, but we can get more with the `nsim` argument. ```{r} -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design, guide=guide) -head(occu_umf) +head(out[[1]]) ``` -You can see the `elev` covariate now has values corresponding to the desired distribution. -Note that the elements of the list will depend on the arguments required by the random distribution function. -For example, to use a uniform distribution instead: +The simulated `unmarkedFrame` now contains `y` values and is ready to use. + +## Fit a model to the simulated dataset + +As a quick check, let's fit a model to our simulated dataset. ```{r} -guide <- list(elev=list(dist=runif, min=0, max=1)) -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design, guide=guide) -head(occu_umf) +occu(~1~elev, data = out[[1]]) ``` -It is also possible to define a categorical (factor) covariate. -We specify an entry in the `guide` list, but instead of a list, we supply a call to `factor` which defines the desired factor levels. -For example, suppose we want to add a new `landcover` covariate to our simulated model. -First, define the new formulas: +We get out roughly the same parameters that we put in, as expected. + +# Simulating a more complex dataset: gdistremoval + +The `gdistremoval` function fits the model of @Amundson_2014, which estimates abundance using a combination of distance sampling and removal sampling data. +When simulating a dataset based on this model, we have to provide several additional pieces of information related to the structure of the distance and removal sampling analyses. + +## 1. The `unmarkedFrame` + +First create the appropriate type of `unmarkedFrame`, which is `unmarkedFrameGDR`. +There's two y-matrices: one for distance sampling and one for removal sampling. +We'll create a dataset with 4 distance bins and 5 removal periods. ```{r} -forms2 <- list(state=~elev+landcover, det=~1) +set.seed(123) +M <- 100 +Jdist <- 4 +Jrem <- 5 + +y_dist <- matrix(NA, M, Jdist) +y_rem <- matrix(NA, M, Jrem) ``` -And then the new guide, including the information about factor levels: +We'll create an elevation site covariate and a wind observation covariate. +Observation-level covariates are only used by the removal part of the model, so they should have the same number of values as `y_rem`. ```{r} -guide <- list(landcover=factor(levels=c("forest","grass","urban"))) +site_covs <- data.frame(elev = rnorm(M)) +obs_covs <- data.frame(wind = rnorm(M * Jrem)) ``` -We'd also need an updated `coefs` since we have a new covariate. -Defining the `coefs` when you have factors in your model is a little trickier, since R names the effects as a combination of the factor name and the level name. -There is no coefficient for the reference level (`"forest"` in our example), but we need to provide coefficients for both `"grass"` and `"urban"`. -When combined with the factor name the complete coefficient names for these two will be `landcovergrass` and `landcoverurban`. -The easiest way to make sure we get these names right is to let `unmarked` generate a template `coefs` for you as shown above, and then fill it in. +Finally we can create the `unmarkedFrameGDR`. +We'll also need to specify the distance bins and the units for the distance part of the model here. +See `?unmarkedFrameGDR` for more information. ```{r} -# forest is the reference level for landcover since it was listed first -coefs2 <- list(state=c(intercept=0, elev=-0.4, landcovergrass=0.2, - landcoverurban=-0.7), det=c(intercept=0)) +umf <- unmarkedFrameGDR(yRem = y_rem, yDist = y_dist, siteCovs = site_covs, obsCovs = obs_covs, + dist.breaks = c(0,25,50,75,100), unitsIn = 'm') ``` ```{r} -head(simulate("occu", formulas=forms2, coefs=coefs2, design=design, guide=guide)) +head(umf) ``` -Our output dataset now includes a new categorical covariate. +## 2. Arguments sent to `gdistremoval` -## Models that require more information - -More complex models might require more information for simulation. -Nearly any argument provided to either the fitting function for the model, or the corresponding `unmarkedFrame` constructor, can be provided as an optional argument to `simulate` to customize the simulation. -For example, we may want to specify that abundance should be simulated as a negative binomial, instead of a Poisson, for `pcount`. -This information is simply added as additional arguments to `simulate`. -For example, we can simulate a `pcount` dataset using the negative binomial (`"NB"`) distribution. -The negative binomial has an additional parameter to estimate (`alpha`) so we must also add an element to `coefs`. +Looking at `?gdistremoval`, required arguments include `lambdaformula`, `removalformula`, and `distanceformula`. +We need to set these formula values to control the simulation. +We'll also use the negative binomial distribution for abundance. ```{r} -coefs$alpha <- c(alpha=0.5) -head(simulate("pcount", formulas=forms, coefs=coefs, design=design, mixture="NB")) +lambdaformula <- ~elev # elevation effect on abundance +removalformula <- ~wind # wind effect on removal p +distanceformula <- ~1 +mixture <- "NB" ``` -In the next section we will show a more detailed example involving these additional arguments. +## 3. Coefficient values -## Simulating a more complex dataset: gdistremoval +As in the previous section, we'll leave the `coefs` argument blank at first and get the correct output structure. -The `gdistremoval` function fits the model of @Amundson_2014, which estimates abundance using a combination of distance sampling and removal sampling data. -When simulating a dataset based on this model, we have to provide several additional pieces of information related to the structure of the distance and removal sampling analyses. +```{r, error=TRUE} +simulate(umf, lambdaformula=~elev, removalformula=~wind, distanceformula=~1, + mixture="NB") +``` -To begin, we will define the list of formulas. -A `gdistremoval` model, when there is only one primary period, has three submodels: abundance (`"lambda"`), distance sampling (`"dist"`), and removal sampling (`"rem"`). -We will fit a model with an effect of elevation `elev` on abundance and an effect of wind `wind` on removal probability. +We need to set two values for the abundance (`lambda`) model on the log scale, one for `dist` which represents the distance function sigma parameter (log scale), one for the negative binomial dispersion parameter `alpha` (log scale), and two for the removal detection probability model (logit scale). + +We'll pick the (relatively arbitrary) values below: ```{r} -forms <- list(lambda=~elev, dist=~1, rem=~wind) +cf <- list(lambda = c(log(5), 0.7), + dist = log(50), + alpha = 0.1, + rem = c(-1, -0.3)) ``` -Next we will define the corresponding coefficients. -We will set mean abundance at 5. -The intercept is on the log scale, thus the intercept for `lambda` will be `log(5)`. -The scale parameter for the detection function will be 50, and again it is on the log scale. -The intercept for the removal probability is on the logit scale, so we will set the intercept at -1 (equivalent to a mean removal probability of about 0.27). -Don't forget the covariate effects on `lambda` and removal. +## 4. Run simulation -```{r} -coefs <- list(lambda=c(intercept=log(5), elev=0.7), - dist=c(intercept=log(50)), rem=c(intercept=-1, wind=-0.3)) -``` +Now provide everything to `simulate`. +Note we don't need to provide the `model` argument because `unmarkedFrameGDR` is used for only one fitting function (`gdistremoval`). -Our study will have 300 sites. -This model is unique in that we have to specify the number of two different types of observations: (1) the number of distance sampling bins (`Jdist`), and the number of removal intervals (`Jrem`). +We'll simulate 2 datasets. ```{r} -design <- list(M = 300, Jdist=4, Jrem=5) +out <- simulate(umf, lambdaformula=~elev, removalformula=~wind, distanceformula=~1, + coefs=cf, mixture="NB", nsim=2) ``` -Finally we are ready to simulate the dataset. -In addition to the name of the model, `forms`, `coefs` and `design`, we also need to provide some additional information. -We need to define the distance breaks for the distance sampling part of the model (there should be `Jdist+1` of these), and also the key function to use when simulating the detection process. - ```{r} -umf <- simulate("gdistremoval", formulas=forms, coefs=coefs, design=design, - dist.breaks=c(0,25,50,75,100), keyfun="halfnorm", unitsIn="m") -head(umf) +lapply(out, head) ``` -The result is a dataset containing a combination of distance, removal, and covariate data. -We can check to see if fitting a model to this dataset recovers our specified coefficient values: +## Fit model to simulated dataset + +As a check, we'll fit the same model used for simulation to one of the datasets. ```{r} -(fit <- gdistremoval(lambdaformula=~elev, removalformula=~wind, - distanceformula=~1, data=umf)) +gdistremoval(lambdaformula=~elev, removalformula=~wind, distanceformula=~1, data=out[[1]], + mixture="NB") ``` Looks good. From 27afa2ad066cae24190dd4379c234a39d8374f3d Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Mon, 8 Jul 2024 14:44:52 -0400 Subject: [PATCH 08/15] Update unmarkedPowerList stuff --- R/power.R | 72 +++++++++++++++++++++++++++++++++++++ man/unmarkedPowerList.Rd | 77 ++++++++++++++-------------------------- vignettes/simulate.Rmd | 1 + 3 files changed, 99 insertions(+), 51 deletions(-) diff --git a/R/power.R b/R/power.R index 164357df..dba0a939 100644 --- a/R/power.R +++ b/R/power.R @@ -248,5 +248,77 @@ plot_power <- function(object, ind, alpha, ...){ # unmarkedPowerlist stuff------------------------------------------------------ +setClass("unmarkedPowerList", representation(powerAnalyses="list")) + setGeneric("unmarkedPowerList", function(object, ...){ standardGeneric("unmarkedPowerList")}) + +setMethod("unmarkedPowerList", "unmarkedPower", function(object, ...){ + + all_objs <- c(object, list(...)) + stopifnot(all(sapply(all_objs, inherits, "unmarkedPower"))) + stopifnot(all(sapply(all_objs, function(x) x@alpha) == object@alpha)) + + new("unmarkedPowerList", powerAnalyses = all_objs) +}) + +setMethod("summary", "unmarkedPowerList", function(object, showIntercepts=FALSE, ...){ + out <- lapply(object@powerAnalyses, function(x){ + stats <- summary(x, showIntercepts=showIntercepts) + cbind(M=x@M, T=x@T, J=x@J, stats) + }) + out <- do.call(rbind, out) + ord <- order(out$M, out$T, out$J) + out <- out[ord,,drop=FALSE] + out$M <- factor(out$M) + out$T <- factor(out$T) + out$J <- factor(out$J) + rownames(out) <- NULL + out +}) + +setMethod("show", "unmarkedPowerList", function(object){ + cat("Model:", deparse(object@powerAnalyses[[1]]@call[[1]]), "\n") + Ms <- sort(sapply(object@powerAnalyses, function(x) x@M)) + cat("Number of sites (M): ", paste(Ms, collapse=", "), "\n") + Ts <- sort(sapply(object@powerAnalyses, function(x) x@T)) + cat("Number of primary periods (T):", paste(Ts, collapse=", "), "\n") + Js <- sort(sapply(object@powerAnalyses, function(x) x@J)) + cat("Number of occasions (J): ", paste(Js, collapse=", "), "\n") + cat("alpha: ", paste(object@powerAnalyses[[1]]@alpha, "\n")) + cat("\n") + print(summary(object)) +}) + +setMethod("plot", "unmarkedPowerList", function(x, power=NULL, param=NULL, ...){ + dat <- summary(x, showIntercepts=TRUE) + if(is.null(param)) param <- dat$Parameter[dat$Parameter != "(Intercept)"][1] + dat <- dat[dat$Parameter==param,,drop=FALSE] + ylim <- range(dat$Power, na.rm=T) + if(!is.null(power)) ylim[2] <- max(power, ylim[2]) + xlim <- range(as.numeric(as.character(dat$M)), na.rm=T) + cols <- palette.colors(length(levels(dat$J)), palette="Dark 2") + old_par <- graphics::par()[c("mfrow","mar")] + nT <- length(levels(dat$T)) + mar <- old_par$mar + if(nT == 1) mar <- c(5.1, 4.1, 2.1, 2.1) + graphics::par(mfrow=c(length(levels(dat$T)),1), mar=mar) + for (i in levels(dat$T)){ + plot_title <- "" + if(nT > 1) plot_title <- paste0("T = ", i) + tsub <- dat[dat$T==i,,drop=FALSE] + Jlev <- levels(tsub$J) + jsub <- tsub[tsub$J==Jlev[1],,drop=FALSE] + plot(as.numeric(as.character(jsub$M)), jsub$Power, type="o", + col=cols[1], ylim=ylim, xlim=xlim, xlab="Sites", + ylab="Power", pch=19, main=plot_title) + if(!is.null(power)) abline(h=power, lty=2) + for (j in 2:length(Jlev)){ + jsub <- tsub[tsub$J==Jlev[j],,drop=FALSE] + graphics::lines(as.numeric(as.character(jsub$M)), jsub$Power, type="o", + col=cols[j], pch=19) + } + graphics::legend('bottomright', lwd=1, pch=19, col=cols, legend=Jlev, title="Observations") + } + graphics::par(mfrow=old_par) +}) diff --git a/man/unmarkedPowerList.Rd b/man/unmarkedPowerList.Rd index 136e9b78..18e03b13 100644 --- a/man/unmarkedPowerList.Rd +++ b/man/unmarkedPowerList.Rd @@ -1,62 +1,45 @@ \name{unmarkedPowerList} \alias{unmarkedPowerList} -\alias{unmarkedPowerList,list-method} -\alias{unmarkedPowerList,unmarkedFit-method} +\alias{unmarkedPowerList,unmarkedPower-method} \alias{unmarkedPowerList-class} -\alias{unmarkedPowerList_old-class} \alias{unmarkedPowerList-methods} \alias{show,unmarkedPowerList-method} \alias{summary,unmarkedPowerList-method} \alias{plot,unmarkedPowerList,ANY-method} + +\alias{unmarkedPowerList_old-class} +\alias{unmarkedPowerList,list-method} +\alias{unmarkedPowerList,unmarkedFit-method} \alias{show,unmarkedPowerList_old-method} \alias{summary,unmarkedPowerList_old-method} \alias{plot,unmarkedPowerList_old,ANY-method} -\title{Create or summarize a series of unmarked power analyses} +\title{Summarize a series of unmarked power analyses} \description{ A list of power analyses created with \code{powerAnalysis} can be combined using \code{unmarkedPowerList}, allowing comparison e.g. between different - study designs/sample sizes. Additionally an \code{unmarkedPowerList} can be - created directly from an \code{unmarkedFit} template model by specifying - a series of study designs (number of sites, number of observations) - as a \code{data.frame}. A series of methods for \code{unmarkedPowerList} + study designs/sample sizes. A series of methods for \code{unmarkedPowerList} objects are available including a \code{plot} method. } \usage{ -\S4method{unmarkedPowerList}{list}(object, ...) -\S4method{unmarkedPowerList}{unmarkedFit}(object, coefs, design, alpha=0.05, - nulls=list(), nsim=100, parallel=FALSE, ...) +\S4method{unmarkedPowerList}{unmarkedPower}(object, ...) \S4method{show}{unmarkedPowerList}(object) -\S4method{summary}{unmarkedPowerList}(object, ...) +\S4method{summary}{unmarkedPowerList}(object, showIntercepts = FALSE, ...) \S4method{plot}{unmarkedPowerList,ANY}(x, power=NULL, param=NULL, ...) } \arguments{ - \item{object,x}{A \code{list} of \code{unmarkedPower} objects, a fitted model - inheriting class \code{unmarkedFit}, or an \code{unmarkedPowerList} object, - depending on the method + \item{object,x}{For \code{unmarkedPowerList}, an \code{unmarkedPower} object. + For \code{show}, \code{summary}, \code{plot}, an \code{unmarkedPowerList} object. } - \item{coefs}{A named list of effect sizes, see documentation for - \code{powerAnalysis}} - \item{design}{A \code{data.frame} with one row per study design to test, and - at least 2 named columns: \code{M} for number of sites and \code{J} for - number of observations. If you have >1 primary period a \code{T} column - must also be provided} - \item{alpha}{Type I error rate} - \item{nulls}{If provided, a list matching the structure of \code{coefs} which - defines the null hypothesis value for each parameter. By default the null - is 0 for all parameters. - } - \item{nsim}{The number of simulations to run for each scenario/study design} - \item{parallel}{If \code{TRUE}, run simulations in parallel} - \item{power}{When plotting, the target power. Draws a horizontal line - at a given value of power on the plot} + \item{showIntercepts}{Show intercepts output? This is rarely useful.} + \item{power}{If specified, adds a dotted line to the plot at this target power value.} \item{param}{When plotting, the model parameter to plot power vs. sample size for. - By default this is the first parameter (which is usually an intercept, - so not very interesting)} - \item{...}{Not used} + By default this is the first parameter.} + \item{...}{For \code{unmarkedPowerList}, other \code{unmarkedPower} objects + to combine into the list.} } \value{A \code{unmarkedPowerList} object, a summary of the object in the console, @@ -72,28 +55,20 @@ \dontrun{ -# Simulate an occupancy dataset and build template model -forms <- list(state=~elev, det=~1) -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) -design <- list(M=300, J=8) # 300 sites, 8 occasions per site -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) -template_model <- occu(~1~elev, occu_umf) - -# Generate two power analysis -effect_sizes <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) -pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05) -pa2 <- powerAnalysis(template_model, effect_sizes, design=list(M=100,J=2)) +# Build unmarkedFrame +umf <- unmarkedFrameOccu(y = matrix(NA, 300, 8), + siteCovs = data.frame(elev=rnorm(300))) -# Build unmarkedPowerList and look at summary -(pl <- unmarkedPowerList(list(pa,pa2))) +# Run power analyses +cf <- list(state = c(0, -0.4), det = 0) +pa1 <- powerAnalysis(umf, model=occu, formula=~1~elev, effects=cf) +pa2 <- powerAnalysis(umf[1:100,], model=occu, formula=~1~elev, effects=cf) -# Run a bunch of power analyses for different scenarios all at once -scenarios <- expand.grid(M=c(50,200,400), - J=c(3,5,8)) -(pl2 <- unmarkedPowerList(template_model, effect_sizes, design=scenarios, nsim=20)) +# Combine them into a list +(pl <- unmarkedPowerList(pa1, pa2)) # Look at summary plot for elev effect -plot(pl2, power=0.8, param='elev') +plot(pl, power=0.8, param='elev') } } diff --git a/vignettes/simulate.Rmd b/vignettes/simulate.Rmd index b7b317d1..e4f4f7d1 100644 --- a/vignettes/simulate.Rmd +++ b/vignettes/simulate.Rmd @@ -59,6 +59,7 @@ The values you put in this `y` matrix don't matter, you can put anything in ther It's only used to define the number of sites and occasions. ```{r} +library(unmarked) set.seed(123) M <- 300 J <- 8 From 9ea26cf09b79f5052e88abbad13033eda5db7d43 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Mon, 8 Jul 2024 15:20:09 -0400 Subject: [PATCH 09/15] Add back parallel functionality --- R/power.R | 23 ++++++++++++++++------- man/powerAnalysis.Rd | 5 +++-- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/R/power.R b/R/power.R index dba0a939..0c55c1f5 100644 --- a/R/power.R +++ b/R/power.R @@ -13,7 +13,7 @@ setGeneric("powerAnalysis", function(object, ...){ # TODO: parallel processing setMethod("powerAnalysis", "unmarkedFrame", function(object, model = NULL, effects = NULL, alpha = 0.05, - nsim = 100, nulls = NULL, ...){ + nsim = 100, parallel = FALSE, nulls = NULL, ...){ test_data <- y_to_zeros(object) test_fit <- get_fit(test_data, model, ...) @@ -22,13 +22,14 @@ setMethod("powerAnalysis", "unmarkedFrame", data_sims <- simulate(object, nsim = nsim, model = model, coefs = effects, quiet = TRUE, ...) - powerAnalysis_internal(object, model, data_sims, effects, alpha, nulls, ...) + powerAnalysis_internal(object, model, data_sims, effects, alpha, + parallel, nulls, ...) }) # list of unmarkedFrames (pre-simulated) method setMethod("powerAnalysis", "list", function(object, model = NULL, effects = NULL, alpha = 0.05, - nsim = length(object), nulls = NULL, ...){ + nsim = length(object), parallel = FALSE, nulls = NULL, ...){ data1 <- object[[1]] stopifnot(inherits(data1, "unmarkedFrame")) @@ -40,11 +41,12 @@ setMethod("powerAnalysis", "list", fit <- get_fit(test_data, model, ...) effects <- check_coefs(effects, fit, name = "effects") - powerAnalysis_internal(data1, model, object, effects, alpha, nulls, ...) + powerAnalysis_internal(data1, model, object, effects, alpha, + parallel, nulls, ...) }) powerAnalysis_internal <- function(object, model, data_sims, - effects, alpha, nulls, ...){ + effects, alpha, parallel, nulls, ...){ fun <- get_fitting_function(object, model) test_fit <- get_fit(data_sims[[1]], model, ...) @@ -61,10 +63,17 @@ powerAnalysis_internal <- function(object, model, data_sims, nulls <- check_coefs(nulls, test_fit, name = "nulls") } + cl <- NULL + if(parallel){ + cl <- parallel::makeCluster(parallel::detectCores()-1) + on.exit(parallel::stopCluster(cl)) + parallel::clusterEvalQ(cl, library(unmarked)) + } + sum_dfs <- pbapply::pblapply(data_sims, function(x){ fit <- fun(..., data = x) - get_summary_df(fit, effects, nulls) - }) + }, cl=cl) + sum_dfs <- lapply(sum_dfs, get_summary_df, effects=effects, nulls=nulls) sites <- numSites(object) primaryPeriods <- ifelse(methods::.hasSlot(object, "numPrimary"), diff --git a/man/powerAnalysis.Rd b/man/powerAnalysis.Rd index 172c0ece..dc9f0a1b 100644 --- a/man/powerAnalysis.Rd +++ b/man/powerAnalysis.Rd @@ -16,9 +16,9 @@ examples. \usage{ \S4method{powerAnalysis}{unmarkedFrame}(object, model = NULL, effects = NULL, - alpha=0.05, nsim = 100, nulls=NULL, ...) + alpha=0.05, nsim = 100, parallel = FALSE, nulls=NULL, ...) \S4method{powerAnalysis}{list}(object, model = NULL, effects = NULL, - alpha=0.05, nsim = length(object), nulls=NULL, ...) + alpha=0.05, nsim = length(object), parallel = FALSE, nulls=NULL, ...) } \arguments{ @@ -41,6 +41,7 @@ examples. } \item{alpha}{Desired Type I error rate.} \item{nsim}{Number of simulations to conduct.} + \item{parallel}{Logical; run simulations in parallel?} \item{nulls}{If provided, a list matching the structure of \code{effects} which defines the null hypothesis value for each parameter. By default the null is 0 for all parameters. From 15849f882b0900e1f22b35fbbc9b44bddc1d3a79 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Mon, 8 Jul 2024 15:39:25 -0400 Subject: [PATCH 10/15] Add support for the rest of the fitting function types --- R/simulate.R | 81 ++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 75 insertions(+), 6 deletions(-) diff --git a/R/simulate.R b/R/simulate.R index 2fee1a32..797b4d63 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -34,8 +34,8 @@ setGeneric("get_fitting_function", function(object, model, ...){ setMethod("get_fitting_function", "unmarkedFrameOccu", function(object, model, ...){ - if(!(identical(model, occuRN) | identical(model, occu))){ - stop("model argument must be occu or occuRN", call.=FALSE) + if(!(identical(model, occuRN) | identical(model, occu) | identical(model, occuPEN))){ + stop("model argument must be occu, occuRN, or occuPEN", call.=FALSE) } model }) @@ -174,14 +174,63 @@ setMethod("y_to_zeros", "unmarkedFrameGDR", function(object, ...){ # get_fitting_function--------------------------------------------------------- +setMethod("get_fitting_function", "unmarkedFrameDS", + function(object, model, ...){ + if(!missing(model) && identical(model, IDS)) stop("IDS not supported", call.=FALSE) + distsamp +}) + +setMethod("get_fitting_function", "unmarkedFrameDSO", + function(object, model, ...){ + distsampOpen +}) + +setMethod("get_fitting_function", "unmarkedFrameGDR", + function(object, model, ...){ + gdistremoval +}) + setMethod("get_fitting_function", "unmarkedFrameGDS", function(object, model, ...){ gdistsamp }) -setMethod("get_fitting_function", "unmarkedFramePCount", +setMethod("get_fitting_function", "unmarkedFrameGMM", function(object, model, ...){ - pcount + gmultmix +}) + +setMethod("get_fitting_function", "unmarkedFrameGPC", + function(object, model, ...){ + gpcount +}) + +setMethod("get_fitting_function", "unmarkedFrameGOccu", + function(object, model, ...){ + goccu +}) + +setMethod("get_fitting_function", "unmarkedFrameOccuCOP", + function(object, model, ...){ + occuCOP +}) + +setMethod("get_fitting_function", "unmarkedFrameOccuFP", + function(object, model, ...){ + occuFP +}) + +setMethod("get_fitting_function", "unmarkedFrameOccuMS", + function(object, model, ...){ + occuMS +}) + +setMethod("get_fitting_function", "unmarkedFrameOccuTTD", + function(object, model, ...){ + if(!(identical(model, occuTTD) | identical(model, nmixTTD))){ + stop("model argument must be occuTTD or nmixTTD", call.=FALSE) + } + model }) setMethod("get_fitting_function", "unmarkedFrameOccuMulti", @@ -189,7 +238,27 @@ setMethod("get_fitting_function", "unmarkedFrameOccuMulti", occuMulti }) -setMethod("get_fitting_function", "unmarkedFrameGDR", +setMethod("get_fitting_function", "unmarkedFrameMPois", function(object, model, ...){ - gdistremoval + multinomPois +}) + +setMethod("get_fitting_function", "unmarkedFrameMMO", + function(object, model, ...){ + multmixOpen +}) + +setMethod("get_fitting_function", "unmarkedFramePCount", + function(object, model, ...){ + pcount +}) + +setMethod("get_fitting_function", "unmarkedFramePCO", + function(object, model, ...){ + pcountOpen +}) + +setMethod("get_fitting_function", "unmarkedMultFrame", + function(object, model, ...){ + colext }) From f54a8c5c81626903c5890111296d8d09d145de0d Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Tue, 9 Jul 2024 13:57:01 -0400 Subject: [PATCH 11/15] New power analysis vignette --- R/simulate.R | 2 +- vignettes/figures/COP-model.png | Bin 24595 -> 0 bytes vignettes/figures/poweranalysis-acfl-1.png | Bin 15254 -> 0 bytes vignettes/figures/poweranalysis-acfl-2.png | Bin 15030 -> 0 bytes vignettes/figures/poweranalysis-alpha.png | Bin 5565 -> 0 bytes .../figures/poweranalysis-effectsizes.png | Bin 13945 -> 0 bytes vignettes/figures/poweranalysis-list-1.png | Bin 17491 -> 0 bytes vignettes/figures/poweranalysis-modinfo.png | Bin 5269 -> 0 bytes vignettes/figures/poweranalysis-nulls.png | Bin 11175 -> 0 bytes vignettes/figures/poweranalysis-run.png | Bin 1913 -> 0 bytes vignettes/figures/poweranalysis-scenarios.png | Bin 9995 -> 0 bytes .../figures/poweranalysis-summaryplot.png | Bin 23021 -> 0 bytes .../figures/poweranalysis-summarytable.png | Bin 43549 -> 0 bytes vignettes/powerAnalysis-figures/pa50-1.png | Bin 0 -> 24324 bytes vignettes/powerAnalysis-figures/pl-1.png | Bin 0 -> 14005 bytes vignettes/powerAnalysis-figures/pl2-1.png | Bin 0 -> 18291 bytes vignettes/powerAnalysis.Rmd | 866 ++++-------------- vignettes/powerAnalysis.Rmd.orig | 553 +++-------- vignettes/unmarked.bib | 10 + 19 files changed, 325 insertions(+), 1106 deletions(-) delete mode 100644 vignettes/figures/COP-model.png delete mode 100644 vignettes/figures/poweranalysis-acfl-1.png delete mode 100644 vignettes/figures/poweranalysis-acfl-2.png delete mode 100755 vignettes/figures/poweranalysis-alpha.png delete mode 100644 vignettes/figures/poweranalysis-effectsizes.png delete mode 100644 vignettes/figures/poweranalysis-list-1.png delete mode 100755 vignettes/figures/poweranalysis-modinfo.png delete mode 100755 vignettes/figures/poweranalysis-nulls.png delete mode 100755 vignettes/figures/poweranalysis-run.png delete mode 100755 vignettes/figures/poweranalysis-scenarios.png delete mode 100755 vignettes/figures/poweranalysis-summaryplot.png delete mode 100755 vignettes/figures/poweranalysis-summarytable.png create mode 100644 vignettes/powerAnalysis-figures/pa50-1.png create mode 100644 vignettes/powerAnalysis-figures/pl-1.png create mode 100644 vignettes/powerAnalysis-figures/pl2-1.png diff --git a/R/simulate.R b/R/simulate.R index 797b4d63..fc10f16e 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -77,7 +77,7 @@ check_coefs <- function(coefs, fit, name = "coefs", quiet = FALSE){ cat(name, "should be a named list of vectors, with the following structure (replace 0s with your values):\n\n") print(dummy_coefs) - stop(paste("Specify", name, "argument as shown above", call.=FALSE)) + stop(paste("Specify", name, "argument as shown above"), call.=FALSE) } for (i in 1:length(required_subs)){ diff --git a/vignettes/figures/COP-model.png b/vignettes/figures/COP-model.png deleted file mode 100644 index 5728dc9819e16e619d14d624eca9311351c5eee7..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 24595 zcmX_obyOQ))NMk5;6aPKyB2qMC=SJ?NNIr-%j|*q7EYUwT)Ev_xB$j9+p>Du&}UD$2vMX6crVpo}RYG#>TeB z`1p8BN=hIQ$cGOfva_>qZ*R`d&Mq!4nwy(RNl8&ZiHV6}VPRolV5qLH*3{HIJvkW~ z8ZtCAR8>`th=`Cg*O{K4{+8C@y1UcUKUaR$b~J{hMxJeNA6y)) z3=Sqg*#89p7yuf|3Pw=ip;e6iMr*@&1%wn2W2k(gc~0P3B;mW}LN9BaIpD~(dO8unX_Qk_(A6&XV1(T@2;xd-t+>}hqRX_o#K{d@jc_UU0z z!S%m$9!#NhDShu!gGLnY>d{98W{;M`Nn*^FUcUy?K|dM6$<-0*#MjTfQEjn=bd0A9bFN+`A0FcXH>>T(k$XCR5>%Ad_56=kl zZP-*-@Hh>(FhvSOWpCfGUg{>oVb}7a>e{LYDtGUJbO)Jw`c&$OF&5i?m;^_V^)y~S z&vV}Av;7rwhoX4QwM&O;>PuSg`8ABhP1wDhv9+1ISdG3R;4+RdWronJPa*h_jS#S~ zPBl?#NYn#)-wIHy>l>1P5tQC9r@D^Kb!Zv9&qL2L6Dcfe>gu&*0Hm8AAaX>*?);4I zDBa57c!R$j+D_L!K-b%emhfKW5AzbMNl&?ZUQusO$pAnN{N0szy7zRc@}#ae{3R9= zt|J7LNrqEv$@js;J9|Q^A%B$16Xmlk9ifD*j$b)T+O6z;O%kvny;fNWo>I|@S%89w z4y}zF1V7D7jR_8;Rm4_DP1_RfyS<>Q`WGz5&k;;l?a9wE1iaLT%Mpq$n~jbs_@?(6!;G509xoi$ zwSkQT!VbX14rkMl)t*0=oj{Ym#>{3s&SqLGwrdCvd`3 z>$j=v$4ArnxvMLYeGc6l-bcAb9FM#|tIMx9^IR-Rzq~deNdR90$t;j44<2JFd_1|} zmYIK;`%Fw&pKhr zb0k~Cf%eoJ)g_`ZjQY1WbTnz``xG!3j|B;2MILVJL4&#AFbLE&j1PlYoB{a#=4$Qx zn%VWmaZm1ysb}H%qy6T-DKi}QAcUidS|4fbiZPquyFtpJyNf+1nXb;B9y}z%NeIsk zObmUEE%I8IL*T6E@nK^eeKUeQPQZmBIfNctDhjr97+uxZ*GgYXM*&mvZV@ZMU(QAdeQBo-=Ec2fa2wOA(dK3oj! z{hJP7PAH&^)4>VA#{7fXFaHqj2^S^2Mlw+|!ePvO+WLbn=%>G{8@eHWi#TKD ze)fh^hk_-44DZx%(C`Hw@qP6qh0vj%C5SLLS(ZXR;+x+Xmj=LWL0$4}{D>-Myz6RQ!qf-$6fMLX$U3>XwW9g5<##b5`xafapJi0s1xqV)v zLlG}M6)<{;cUCBZs`K!JrB5*R%jqb%@AV?lGA?CasjsZ|tyTl+^2YK%G}GcoB%OBT zkKFvZ$tYz%IMSU14g#>TN?26F*LKE#2KkdALTzF&?t@qbvTwh7>E7E2$y#CQNa|mC z#p>Mb9)|s-kf9v%;);3{2QxD5XSX8K4Agb_&}kkzqw=3A2V zne}0m(Nbo8f%YA1`xj99{XbBpL6Ioj$d*12X@RNp1)WVvOyYc>;yN>GR#Prp`!enA zDBFXdC6~921FgQla1fb}^~u-KF}m(oeWH^b)BsVnFiVCz!T^Axz}j_ACa=pcW3&kW zmf~IXZUuELaQNdZm3O6;)QuX!Tv6CXQusM68Tyje2cB`bvY)Bmi+CA{`YK8%XE1u@ zw^Tn`p8;^X__c8^<;3?kz@P3l3kg4bBVx2G&YezaIe0yAbkJGSL=8DT!2JQPdTA-4 zC4jg(&lc&LZPh1!x=c3Mm0tld*JT;v>ORl(3?r8iSN<~`4eTIAgtp+4c+&EQ zK0qgq;L(i3Z~ON`lfW^2+P;h6%2IOab-{BnBSaFzkTp$U4~hFMip7 z6ll`OcjjmXulU@llM2yepk*BELErJ=u3Y{llNSb-kp3` z=XphOk7m_)nr^~}f0VfixBIoS9g`?*f=V9`pIAHzAx20Dv1N%T7KBN{pfy@gSWDKr z;-7jGiAHK}Rat@-w)`jJY0ozK>3?>C#J@8&{!I>j!U(n}|1BuO6ruY%1DAbL(|mcy zujjq+k0fj#XJw&jlM3;P%pdK-*G&-L=K467TIGgHF_%u^9-TU1Or|-xPRH#dt*#s# zW@XA$*j0>9uo0ROmMw=?O-g`Jh}-cwFvS(2-=;p!VDZIRlcPy?Hu_7=G=zH@Ce3Kb zaYQWC=;dmP2dRClPHOxre3yO7BgYpMi5U$x zROAzQN+8T*Zxwt1H-~A}u_09F8vHO1g9UK-82gg#an|NseaysFb^_Q%hVOH*Qvpqr zBZSp!moE8Ma^($>(GiTIJ%0yma9%)%WS0tV_izJiYKSKeHWUteli%xvMFU|9pCFUP zxA#9Q!Z;(W2^Ne5Qz{m4*p+U&^fy4l zn5zOCoo}znyLPgFVP^;G!?v$0;usac=w*Sn{2^{aHCZSqy0atK3VW5c>G?w(2zk3B zNJ-b!TO5+SUd^H6QG&Am2=N)L@ zVALA9**ugR69A>)U#^qBq7QL13>qIOxc@ERKqmkECc-f;ZV7Cm%C53F5Rxp&LUY-B zK;Tjo7cYw#UWi2*3bN}1Kj!@>{a0%D&&k==pS}#pWdaO;2a8kG)L`RTCl2d!!(m^4 zQ4?C5qS2km>)=SY>g^EiD0b+%%LaPm6~A>`jJ<(yg(F)S)5r>kux>DAfpE}E1(Jin zf3LE>sJ^u93$A03^anNa+{ZKoCQmI0p5CHCy14&yj_36{hArguSQn2u47j!Dawd3` z0^G5@(gKFx4==4afOM@`Yz#da=$GpXIUT1+Gp_5amop8t^;bEHzS0v+bqFlVG=U~K zQP1K8iT7W62nY+|-JfjEN_B;AFs%!V2&#vkp@G?sgA1-7;!~6ynhW$zjn3 z6GoX!PkhkAQjZ^h?dK^%i;(f(`O?;r;!-XGHa1d9CZA}=Mdop5?Bkcu8#mFZ zh;jy>1N<3YU^|OP9zPt_Lb&r^y2W$7x z`XvlJ?LVeY1~+UF#SuIjWUcJACJ=TWyOXFTOMF6KK4Hi`9P|H#dj?;Nyw3Y0A|^eN zlmD|R)dalh7pyBWchl>g?EGECL6$7H+NC+n$nhE}Z%QQ3n#Qf0MAzrLc=8u2SUt%` zDN*dh)xTbsI+uFr<0L)a?nh#WHC04rb2Z!?Q}spwx&7Pb8H*|-BABNE5z-eG&nSJ^ z8%h{({NTfHJCPHInh3l!3=V5{=tK-XzH5&f-Y$T3<^;-{%G810@ai^sKki@IJeH^V zvn)RmI#Pnrbz)@@K&iI~x%u}+u;RJo5D#gNf9G_onYvHCuf6|~zCl?9!vB~rF86dn zt1)=#NV#ZLP(5I_BkMuog#xL#Jtb3+@RCe23fqK)gl%MM!o}#)adJ7v0R^~psB3MX zK>aFZY1%3bVOzT16%wtGpqnj-qGygE+kR)B@5~J=97G-i{wtP=8W~O}%1(9>Q?uIH zI7~B99$2^Sf1D{HV`#TZ7zwV}RQ&xB4^QtDVvYFwLLH?>w)#iLLY_5P*Br z>qpDCyK)Gy?O)aLq|@8jeK$qOiSty3Y^o58<3Ma*q)=$|>>xZ|e0;9R8dM5+{gu)2 zEw6EN`C}5l#B~}=P|QNyV`FTVi9c&c$>M+jPurw5i_nZT9!cK0HigW zeFr$jJ~fo@5BrG!cy(6pNpE(){N!ntqjO8y2ABPRBVt0jBMNpDi^yrA)eU~+T(vC~ z{A``YPlb^l28nh=%{RVZL<|ZwAC0vI`OeYb)8F5pITOS^9`Dl!M@kS*SQr>XE`cOU zAz=P)+Az#ZEd-V{G`xlIrdqRO>G4m}G2gsaS5Vnf!{JtM->+7$WHo!FM31Kmc+Vh^ zyRxtBEy=BBWObmtG5z<);P9^+w>|Vd_l2M+`r!Lhc5%uNkpKt}Be?SF6PyTI=z8-2 z6<}}wl~eGrEjjRp3KEI2OZzv40u}g<)@(xZ86>FGZS0HMlWz4$-5XeyQ@{^w5pFL-hstu zu20X22=?tYPar2k)4%HwFJrOQ3Ba#V;EHpe;bfdx9D|O=Uvm`+-xev?yMuQf3*kJx z**on;=aDqiSH6}L4V!ly_UFy6q`v6|G zxC#aT{VkVeg)AS($FSqi`hfsK!fsSO$k`BnMd*orFwka1mz6AQE;y!h#@y z#QV8+R_aR&sJ0DIEI$ywDfGWEE}OJ;&)_|jZN`H+y)<{~v+$Fq)5$9RYAu5ECCa-} z?MjQ7eTFL@JUx~33J94h)v$xzak{SU#jV;}?oAV)Z5JCAKo_6pYrKf>MFqTF zA9B3B&}X9Hr%Bb=k)d9oXw-QSuW?|f^-K7=qYq*3v1^aE6@gt%(5i` zll_z9Fp!>DB!$>A8w28g1rhl*D@X%AmD%Wr{sZRE`6Tr6bH^yW2N7-uJ6+NgmxY_BHSu7)&4RltdZ*5vDmZYh7=g7C z_x$$2?a?B3V#*(=#2cpt{h?fH(!L?K?#w9U%==fXv>?pf)4N|#dOq|`49J|6?Z*`K zdjv4REy1-jE-;x;M(_kd#7S}+5n<$x0qJ8|qR$t8b|YpvL#4nYm?<+fK`@epI4okl z6NkA_Y*63a@e;4_?oJ0I{=}zsI}A;Vkd6-U+0JvFi&(k@JrUSKhb|SWR$@EtT)r>l z?{&IA{S0V?+6C7hrG(K-t4CljrxPajg1)Y~oR_slFK2$QgDn1~++m}WPHV=wdPEtD zT(`Zk#s289?F)huR6GD%G{(MZf6LXDT}O622BqSI2W)=Zjsu%sZ3&pOtqSm5C^H^u zH2fi3$u!8d=?;uXZV7GS?oDmw(d8bKsg(E6P+=gzkS3xhZ6?!YF5$enmKb z>(6uJI)&-a;^3?FPGWsPyj z`P>fv2BMJCH?6;CxX*=pRp$ekNBIv1VMfrgM2;uxWO14Ak{CJC*%Qk$I{{JwsC?dc z$LXe{Q(js~6Rqb&FOam+o2_a(K!~B^_Ymr`*@Si2uO z%TJ08AeL1utn>Z=u=3}IJ`W!MU9n@<-xyfDM;iI>3r^7B06Cq@1-dSKb3vtDVbw39 zzizCTF|T|oZBCSYdg-x>6m~us;2iYpPAYo~XJ4K*8*(~LY?bR)D zgtCc&A^G*LlYg+QEP_<}jIf{c=C5#lAT~m-DnV<@AJ#*k{npu@cBKh;@^U$IHEyTS zUX;|pYl^aDN}>E7Vqwlo{42%;*eCSo!0xRPEJiW#<{nQf^`E<5+nsTxLE$U_qUqKU zlwvtnm~wdo0x1A1ptftY`TYGOz@M!)H3Dfe2_Pr za0>CyYKi@$q9PnyBz2kfwq-GA(T$pCIH;uxj-#B#?mkl|pMCONht2dWhet*-mw_m6 zsmoY7d-+SFgj|zk^C$Vf@<7j<_X=PxutkLZF0)Qq5EQ+_GM^ z@bE!hy6YOL14N_$B`eU1);`jdN)R!E!F%YFr|l~fQ7(0WhNb70x_eE-FHU_~&{Jv? zqxM+v8(V2fkWKfg_^Y?+PwPQ&KoT?{JOCT(?cJxt z?opf!yD3e2t6_{zfMp5YHk$_zt-e%?@aa=ZHQW5i?iJ6E@!g(2+*AW9!Uv-9UVm}$ zzLVkkKEL_&S*K#~*0(Z*Zc?lT@4?;aZ4+c*vU5P{55oZ(*eDPe%bliR4E8?X28t*A z{&$?XUZ0`A9k^Eeg1i;EDtMS|PjNS9HviA?4Pn)_VLKP0>Xn{l9}&&$O9lMO#TN8Q zZgJm0Zt01JY%E_!pI-ZFDQm+QQ*E(B0dhNlj>&OwQ=0v4!+|%6T zq{Ay3T{AmTiSA;n6=JCk)x9sJ*qb0Cuc^`b7d?7GdLN@ehn788vb4|+&GJo6+0KeL zAt1WdB|gI8@|9leLs|h5&-tZkuYrjzW`q`B^h`74rG|U!tBVzdO_g`c=55&2d7TX6 zU2z3DKe4z+NLuvR%5i~YD+d0r(8YsFH@e8ZP4xn()jFs?8d@+vmPIXj)y4G@6g#K7 z1?b-a+F8&2w@2cWahNg1?;`UVSCVuONOhG) zK8<9Nh3K86`*qqxwwH6DEFB8E+n}B77zU7ui}zn;kJCfOr)AZ>NDoq!6J$=dZ&>h2Jx0|4KkyRrWm3Jcyx(9E&F^?!foBW!d! zyCM{*v)3~%D{$>VsEU_>Pv&gp00oT0KE6r{iHjMQDc!c7iR=2|u)cNv0f08`Z+_Qu z0CPYf@D5>bJdV7HBPx$h9ffxJuw$NeMbDEYO)Y$^w21|8yV4sCTfP#o&$2goO@Uv~J|FnvN2oB}(bxd&JJ2I;rgY1KOMf%b_Cj7Yo^791|Rm|PQaGB1Z@b&fbU z38!7hc`kBGccKhNU62Xz?c0ZlH+QIR*St#_ORe>8G2V~yrEB3Ouv>>=_C!)*qgVp3 zhA$V>SJ4KZ1-4oJBsTUt@(ZgB2M;7E*@J(F_;bC{wH+6KfZcG#dP{!f;c9K!TaR9L zJhr~|C0uO196KCK7KdI~3_iOlY>&M-4oDYr0M;DmoQOb?|F(DaY7?>t|(H~X4&d>T`pi6~k zZ~x5+uFr5v;L`=@KLHD;$dNrPs?&BQY)25HHGDfMuI;{Jqj$Z-uf(pxCV2@iGS}ap z3rA46jt0EkVklsvt>_qWg{-_{D!kOfVt_Cu3J{EbDWIpLse`13fB}mmx2>e@HR;!j zv-(cc^XCgy{-CMJpd^{elCb~J8OFqSVKy1r@U*^h*Tl1KT$3`(p!mRMvnN+^p)LI} z+se-Iqf(!lVEnIuMJF!XywR54yk)YgFRy~Wzqj2&bSK(4%IWNkO{wiA4j=Q2hew(J zQ<;xI3&T9|7`9FSSjYT(q~_@|=HXJoO=ZX0-wJxyO;(+W9Tcggv$t-|O*c(Gv7-KJ z5r+(XOFY#aHi$oYm!GQ;q-~YDNjyJZsxfk-k1h>e_hT{qoREX1%_?)xweONw?^8uL zf7M{=?$(soixdAW{+EOHt%D^%WnnRIzx)zVUMS#-M`PVmCTovWfX_Jvj?b<)ehu!JEb<(D?_(Q+y4BDyAXH!|(km3cXMT2UWzy#ne77Jr z>!wpO?$bRvCfnK*ZoAMC0=6e`ACDw#&1DnE@)F_|%MJ!g%;OS5ym9J~Gpd{`JA97= zrswo{>giQqrU;^@+4KeQ-)xC0no}wWDq>UcBDFs`x-oSLi^fyGt8WbdZp(4?`?dB| z$cqrLqLi$6O`on?@Y7{(3{KC(?bVvVb)fm@-#$+u@;mvYr9mK+LG@8UFL~EKnrQxI z2Yx>Qi!w{MksLsW^mvb|jX`&|@;@zUe~ml0p;5(Zaz*`YOkcCeHvNBEfPLa4&19E% z25qb*TqHEEDwV9Z=eY>ZoY-{Pq!QGc-|~XtFdTA2`U9AL z?&JE>NoFIyb~Vv_<e`VVUpF^v&LE~3Lqe)LXt~0#@qF$i`=`|usjO4 zxz{k_IKP}195;eQZ>PhTeuu}i`buSnAqxjCGIj`tfOJ`zyWTOI+thku($aU z)z)^Sl>B2ehYPuQ_w2h*>(7vGZq=Z)n)qSLJZ<&8=SAH=1R2wb(xjdWibhsg!`j(e zu|hH9(WH~VoyAPip?t0Q3%$$bJrX`9J1=NWxJ}U92TG((S2cQ_I>0;SUjkYqOTi(8 z96W+N`K4X;?m>UeqM{uB&=16n6DfQ*A{EiUhPXMTq9=5YUxZ%IM~9Vr;?r}6Z3j!X zU>bz$K2Nt#Zcot&A<(t8lIyDEfKt+}Ns8e!u_a^!h2DECNHAur*5Ue+bLqOucp` zRJDZPZ8JpJ>q@_Te)r(#YMfZ8>g!SA*Q`OmDTD|WI<%kKiA1#YvN1CZKE6FKRwu_V za5GiewQT8txUrp0Q)O`mgDjkZn{e4=zOx>lj~5S8Jj)Vt((}!bhEE5c;s?e9*8qN& zRKHJ6tz~Ynt-skw+lek%I}dO2JSRr71~oG1Rx3B@Vpvocw%LuA`$R2-@(!qdd}4gW z%Zi9D#2Hk5s&Ym-@rPod1-Gn1dr_cdF z7;!F_h#lOs??{%y5vsr;-QVB)`GvItSw{F80D`=IlmgYr35*j#nh!x|x9eF5jNaE5 z;^NN|vFvKT%z1VA&@l+YFVxiwpXj|W-=T?p{6u3@Gx?)s&i4!Re%=cb#1Ar9ykRtQjR`=V=6u@UvH& zYB!KYWEQ(sR)_a3L{*!*Qn4=_`0JDHi{~8Ni(v6|XwEkPCn+;~SDYsiCPyoSK$w2~ zuyv9-M$%dDb1tz*^CQ?Wroalp5t)VlS3D&gEh^0~S|2&7&@V$j#^`0MPln!dCLzO` ze?uUahp_nW!`mfR%HHz2xz8W!8FT{w%ys-q?1gbtI51E#(COnV&xRYN_VmC>g}Cp5 z%$DTv`xt6%%6(^VS`qnrbN$E=3VGe|buzHi6qhtdGX5tE^1A436#rT{1I96{CGIF+Iy20 zVu5lq6GTu#=VoAYP4ON!YxotlhdiWGs93R#1cH3Yy$t67jsi~|DRKpc;XM< zVUf|W+eQ}#5(!NSoL~XnBLx2n!s9^>wTal{W|8TC8_MK?$eO)m09B`n#;M4N6yY_5 z!0PU|bx;r##WP=b8oB8fd_Ff^c)C@-Sah?wq>s;tQD!0m8IwnQzNF(Vs|KHAvY6KS zD`;@?(hYSzM%Rke?2Upa*b=A=T^y8UVp-1#ZK*YDbxAgl84 zuRE#EucU3j1HY`%*C+I=ak2r&qINFnkV=C-j|=9ds=^t749^)lAGZdD(w;{myCykN=4ERWe{9KqqZU zj(-qjh@k)y+f)0aF>}t!fCK3Pdl&Sr|s5 zNRzX}$iv7T6m03;Z4QDdw@7XvwVbFPdA2k{h36MP6KCsoLm8QulJPh>`DTRpQ56=y z`0mubgZU(z@=sm!t~3$}=K#sOkUefL?#E5dpDx#0F*h{b^Ntu9 zWrMJKL9K}x?4ej~{Sc>rHXqfU8C<$)wH!uq1qtrKwT1M9!isgBUO)c7E0{?-%6MD zX`5FH36&~Gkp9Hx95pi^bR5kr40k%oEM-L7?~yv}>vOzhXZjfu5Z_6asfopL-J-$G z(|Z>B1ozF>`*iZqb!F(|X!_qh(;dLnq^Gf;`ncux@3B_xtv9F>M`iUR0w@vK z5#rnlIN{AqY09^yQ1~pwI~_wEE_eTXChZ}I@`bzvgVLHYX3#UzcxVD)jnWVgdc@-t zu?ZIXeYw#b92VTl63RBf@5nd2Y3;~6{$9^Ak8}u@^!nmx_oIH3Dcb)|;ElBYy7V`T z!1lEm32O>C^%#+kU2e5hi4pS)@ZisanP7${64Ga|A5-YB%n2Pw9V~EaqEm`O9vwtZ zxLue;&EvHKM#5OAAZLG8shM+k;QkB}V&FK|Dh3}>V(~9GL%%)_3vBtN2Tr{5|7Js2 z2h^5EDFlq+;m$1f74^}NCbn`zYJ1M<(b69!?*QPtjEu0yoT}LN_$P#%j$$kZ2D55< z9EUlntxAlFrUh#}qg2e~Tmz6yXmU^`g`lpPWrETBOSW|)L2Gj?s82%E78f!zGrOxK z>~l@$R&4Bn`<>_`--Sh{y7W(3m#AGu7~w$+AF@!zR!|Ywgm%Er*%;5uH8AxLmW?Zn ztJLG6lN8cgYa#iwiTEr`_4{;z5^oueeA%EnfcQy;3tuR^bddj@L(U^sF>f52$0L2|~#kOlP>-lilf{)kDSBJ2EIr)WLs$Xd$ z9>n-mHLnNeDUG=rEbMr5F6!CtqBt*||M5!Omiym`>}T4svNN7exE4>Zhy7t|X0=HT zZ%*AExb}*JUZQ_b%4wf}zjrtEZ@ zwWzzc=2;rOF@dbViKIG?s6n9LyZFdlm1#y3Zb{?y`W?5SydhZuW0G2o2lgi80rf$q z`$jY!+-KETKSUfp+46F?NNtg#rEOd77h8W)_V4HY#^kC#6F71=kobn<%2+(Jq1x;1 zVavC=M}%pQ&uaYV4F#OH-&VwaR8|~?09qV}?@x;fVK_F*42T_^;j3#1`q{{4<_6H% zjm%tUf+Q*M);Ni-J8x|tWqlqhAV@+RKdS83=av-2BN{4p3YeQrK zr4g1K+z)NBBc~l}mhVMBj@)gD87Op0V@WVaJT?v%rw{&9Df0O$RD(TR17FYy>W#Hz zdXvQ4z%CsfS4xTD8gZ3Dx-pqkh~NH96l-xiX30+0D)3*qW6-fxsaUL!QkRa~=g?#p z0sI{-UYVh{br@$r$=EfayX1h$Ngk)assBzhce2tiGGEuIG}ICaFjZd+$C_C)<)Tkw z@i(gI@Uxo`;dW%6;wAq1=B=2zTHS{C;k-nMh<~hr_jhY>vsI?l+gdr7jjw$kxW03p zgWnieq~5g%&@QaE7LZ=|bN9S!=<$&q_Bdxwx{GkFDH+m!?D*FAC!*;4SMGt@yakqD zTojWzJgaY&iAs4wdypQ#pV#Y(YR&uMN9>qByTI8F?)&1(Z{RQ>%^2v0u3Erb`#VcB zxaAj*9Y+yuIi78YBL+;A4 z#K;vCrd$i+hA!cW@VeP)!?bN(dFl;m%{i8x8_n58ncZ*MJ?_Mtr;?^(G~^?+TY@Ir z4IRScJ<-bhG9t|I0~(CD?sxX%jZjiaj4JGlC}`#$pAeL-@ic8qw?-gQWH zVPzxOQ1Js|S8#8Ueb(}ZwS;HC>eK2UQ(a&J`E!L4S1Kl=nqn(XLH6&rW_kU39I-47B2I(#*CKiAn}O-9XUvM{Gmvhj&RO8!>k>rR=;p5jGB`D`bXd zwS9#ZMuKk^ca2=NV(JHQM0kbiU0&a*&(nw?CC&s)9_a*srtd5@3@FiRJeBy#< z*#$?#ErexwmK9qDNS0fykhWVRD<1C#i!%B1dVK@Gym~SZuABOIb!_VW(2Ih^MGN6= zh4wF#meCgW`;#0+cPjnP^b=k+xBD5f8_Yy8%w)Z0iPIO`{hUo0p6>`dSp@Vsh6|n1 zGfM`K!4CS@4h=hBue~90`st9klfcuZZjEFhaEQ~6ey%?&Gcu0>;p?|X!Z+MhHTw7E zHDnbyA5aRBERXw7o4_vD8mT>AgV+}xlaqy`GJnZ5nx!Qs94`7CbNM)aDz&~GQCk)H z3r_HS3ZaUAq)p64Vp2kq>#8}Y?KFKWgq=yBGh*`j`;6Or5WPR3Pf$@sa`~?bNCgPJ zq&YO^Y00*MBL5i*M*hPo7`G6#j*kZ~W@pu7ivo*LP+HCQpAJ zK3S~Qs;_l?2RXT@WlHlE%N;0K-&gf`R^YICttAul>R7O-%)KZ^;=Ty`@--{tpir}9 zE#+UIM>VuJ{kKFcFMF(+4L_A}p|rA+V0o8`m}To6y z?6#^nO8wX&uwAxUJEfh zv85zjMhK;toBOr0>-pMozS}JQ*7cVxma%Ap4*f#aG`f3gy%|qcQ@;uD74w54vqjQ; zTlWS15bKcD{-^d*7XM?Wncyt<919k6s$od2=!q*m{A%@^%a!Z~WDq1kAF*})s{VNo zl4y|leD{I{K?Ip02B0mX#C3|y20Kl!+B~PqQr7nT*s{M3poq2{mj5N2k+0lc(QUr+ z=xFLqBw7M;*Ps7rm}`S8{jgL8Nt4gmq~Nnhrg-NMOnftsz&2drP4)iOIqt-qYY^CLO&?+?DcX#iyv52QA|`jwRy!%o zD4ea#O+7koU~tFBGji-uXw&-jUmr6HkKjrvzjNR%z4tBC`RN93U-NML>#}G03qK{V z@!tz`sB%0Le4mAN086u3OnL|S4K4gC+=>^v1QsB(DlJcD-H6Z}_05(D>G+50s3D8w z7Z4AXTIQ%32qYH%Vwj;4dRbBAsu2qoRupZb#2BL&H6>2L*}v_TE7Z^0M!3A0(&OJ}N%3(baz4UF|Q2H-KYP-a~yoZ$P~G1mH$ zOCJf9Z#NmE!gcL9ZT<$(y(t&PEWeOx7FjVVRP3jn3b7tuT@Go52oL> z7I(D?K!j#Q5-EjkgxYN=Bqe9fD%94N1p+qj6s44(ko9lZL%ZPNM2o3|tV6gEQX}&*gyTbh@39&q9PP`Xgwc?rE7* z4jS@S=IHqM&Oz?7I6QMTt9b}_R2DFMq&}szKZsh9Jtu_!6ahpg@%AU%{+KY=e{ki8wp^; zmZ0OoTKm)Ge#TCKeSzhM?6txn!MUcHpLkCT+p?F(h*}3Q^jQNQf&X5$#-W;Yq2PV= z4_dOl4IG_xvPgJ&AYje^DNOA;IdlWa!R;RnWBU>aNGUSvo%{7eu8FcfZ$(^Mq^U$;gx`BwHp9`gLSGFu)9MKL zn!4IOGHe5s!JWWy-}mo#;Z=kr%OOSx7cD~-Nr2YNjg2#0D!>rlFD-BDDf0g-h6E*^ z3&L^(3n_4gs(`u_s?|bt2zLbzSsH1|MumZj!R=3pUNSVJ6j3RlwUDsRed|&j&QiQ5 zsnd8+x@?MgL*0KneHJ9H@Qq--w=9M6*N_p71gmJj;Qy7fx-UI{5p*SAz}*;xNoq+? z7P=UlGS48Tla8=1^Ro>8Q8?(q->SJ+VnkVEkHvOnm+B**W->K>QIs|w&j)$8n* z>}wWv;2(e0ehCU5+lqZ6j+mVtLW)I>>3=)X+A>`MMeO{Q<4?{_=A zOiJi3FVtEM=p{4sh&suFEOou^O(HfAJ+ z0XdV)8Q>nQdl!;O4$xwftl=s2JjEiw7zBJ#s3eOOFqbg7m9Q-=9eSskcFtZ0k?ore zPLs_;gCridib*3E{A!9exn5(njTOE}EF8-fnaMW2pLVU1yrzGX?eu_q65 zR=$Qz3Dg6CL%3#Uxa?#<)}JQd;a5ZOSVeZ_MU6xX?tTDW%}Vv{G;;9o!LrBgjZShn zkl4Fn++mze5oogR_p?t1@n8BHEH&m54-t2>S`mw!uE9=KRdd2n?)dIw%a~LSADo%n z7&{Kqq*boNxG=i?P&s+?HN78aon{@M_p;-j70QEn(V~H3@3u^&@5Gl7RTvBdK4xF# zwc@2~^n_6U)4BF3c$4{V5N1(M{G|E-9`g>E54})Dsh8Gdf`0yXws3)Zm3}=VCleT7 zB6M|Q@mI)X1r8gt`}dffO~-TsQx<>fMj87~g@EC59mcMrGg^N(X9>88drTYYoS&sD z)o0nL%Z$-eA^ljsld^TO>wgo*`FFKCDXXuaN%jR~^D|8Dz6~rQFN8;#x@F+|m17R3 zP%88T&4weU@;*mZz(~Lk+tCOad|3QwSupDI%na9wwL6mH6jxFu#x)${&u^WeP4;MS92O*gL$Sny zrXFL$lTgjfe_*#QKjW@LzMLN^><=UN%_O{=AZZ)uOwKM|=MziB1zWzD96s~p70cln z?xA@PZU?XYL)nK(ItHhSF1jElaHs z!%V3%V*9mZ1KRJsUQ zUkrfec{RQ{(0uv4-2HNcT1P31#;kE$?w#eTwqSegzAZh_ZSl?F_Dne(Q6>>&p3-{uu1kMAA)uh`TB=EGn8)}=H#pUSDw_7Ptr#je}^Z)?F%4{{>+k9Rh~ zR$atASx^Sj`Lf1z4p%W}p^pk*6}Hzs0zuYlIcS-{&gFp$d4WYU+E}-0|It`f4pv(M zZ<~#f(+yzd?(ZKAftYAOY;*|f#JVjvGXGNXBhi>H$Kv3@re$W32ydFd0RUNGa z5!7&kC94!t@;cLgHKAW=IT9USJM;(#9u;}GAsX5fZ`%hZ^HpTP1`nBON4%x=;`zqr zUmOS+9Pr=Y|9TBOgyR8MWv0?hnYl_c5-mpx`^U>zM1LbURV+fj2bgHYnE&x8IZ*@! z~i;%NJ07yCd|x=JtT*de@`*O2zI@4csXf&n)a{@OYh(Fw1yX&=bS zD$)kkWv1n*!-9^nJp(I`8f#9QD~ykGKy?Tgg&M6zGw>7G2VSqx+4K3q1BDRwz|QZs z5BS4g({|wjd^;hnu2=M{4MJ*9^m_}Cdn93KnK!FxD?Ne}7s+Ut?!zwFF;0bJa`td~ zk9{C2uP-*#$Jm`4f^<}T^d@)A24Gdw0J)rY$DUbIJNf@1^Ci1O{$%xZq!2igJqfH!>AdB~uHF?u1!JmwL-CYsK1!av)9@Soq0 zv=Oepe}^d;zyrn7Q>NUOR?`&E3NA;Mt2bZ)*LbV8(0q&y{Erb2fqmfhCOCUOUwH7K z<4ObE4V4b`LktgKyA4X+j|Zt7WwQU2xj%78os9wys;~)bo0$PmdevT|;_vMRK&iC7 z0oPnA(uZB%NVpI`<|&@~%clJ%7SM#51D^jLg$S_z0H7G~;7&nJlNk|-c=gV&PxKm@Zj6Bi+8hHW)lHl^bMZugl~Rq;X#4f z5oP9nWc~v!(=Xn(*TQedq_j@J3I-SijAGbso~-CyH-yB2WRzjwJ&GVk4FOqQ}YrhE+645RKZ-=mbk45OYd(03((sPqQX`uByw&_1InRIMi z1h5Zc;b`RvjY3CI^WlEGT^~CxlamX!bu35UFqEg2;*Q=rx)o%%B;X4Vv}&wW)7GU4 z$9dFz9h*OMDTU@yjqPvlZOuI`3xSu5LV2@;2kOE z9@^^lCR)RMK9in2YG3L(n3iahQ97lCx;E}3+y~z61J)xoJw{)`XyylY)c=}#Z%arZ zAk+VQ?464C0aaM>gE~w9q4qKjwq*s`E#|ePV%o@78}QNtUb{qT>)Y-f_GlQ_`32n- zrRK}!I2*rs!w|2GGdHti<-F@8{v|Yjc%U_B(@DMEDo+-mvznTpOvaJRXsMpp;&d;= zHc&g+-Y`3(QLmDURB!{vZ(6ncaB+X1t>5quKXUmtFQ$clhh?fQ*cx$Kzd$3QmQ^oG z1@^u7>pH&aP)K`v zz+BO1zoqSvwPj?}K%|cuGnn%WRCP`L6?$zWpe~C7E9N9Qk{RW+RS8pUeWH?ofc>ud zhj^H{D*W@_ZMq-6khv{xC6aHA2K@M`e&)&6l^}Ca0&j%}Puz0|-(bb5#Uny9eFfgZ zrQdtYm;V5sDvQP6*tyGj3~v1!cs=V-_#$+i#k-)uq?w8T{B@|=UFBdOD6*n51%_Yw zj}a}3Sx6IR&SKb=5{;Plf#^^`F>_GfFgwi1#>^WY_-qgL zR(PP^j2R4k8BrIae}PT)3z*n&_!AB{Is$ir9k&$7-?fr#Yo%?&|d}*m9K9+2*+<;<>^%R8U zN=C0!9O09-S$He-u9X|{wo)Cg>PKFo(h{~6_upHe_JQs4w)@~l3-@a_qCMlV4oo1R z>hHt=EH!Dqh79KX!Z)tO+gfWC?1K!mjIztE@cK3w0N}vjy8fU-=nRvlO?5sTq|%X$ zsv(^@vdioZbE(+y4UhH-4mEx|d4(>L4}SN&fTcVeIWREwDx-;k*b@T!LwH72O(+7g&*PBaRg zm&OCu$Us5|0R@!wyWg&X|3GCr49dD!rx};YE3yuKw>4qQU=!I8mVAkl z&Rf`ECvNBd>r?Uy@H++!4#l-8zR0-naI#(VDF|33OhIrNF0=&`G8c%LB z_j!u1&OV&HdXt~J!H3dkKD}Dv$=~V0{s+d68mSqK8WNRDm@c(u+Aq0=+aCH3truk? zwpa1xQ>5z;&_JL%YiYAh-Gx3=E=#XX9#L+#fhFS4Ob7yx-M+U~V=u61%>>=zLdY#U zC=Ot*76)pLjv&5QeBXVqBcJDSjYRr9JMO91CBIJx*YCYI(X+UmrP6w0%?`~*3tZ7@ zAUIotk90;s;_h<7sd5Y}2J8(U79JxDvTw*QNe&lcD%1iMmH&GZ9U8 zRvn4Fm5k|O$$49XX&f0Jw%GR&imq2Wz=J(vb18Zn!R7?7Xj!`)<_*cI$M`1PzkKZ@ zwioQd*HvB21Fq^0rc*0WQ)PUFJ(FVR;|k` zmvsl0T-92n=zxsN32bCvzpvt`YOj4zgoPdQvc}Hwc(CeQU9zVFJh02dTP{6@8MV(8 z!lS|3+o^lzQX>UZLUZlE4&|m<7scnSQmK{n<3TtJ$iB=DEri(XPn>`_bBG!|qyZ14 ztRQ=cFT?J55cm%~2yh3>l@j_iVZCqAyW`v~($$ZzE{kupyJ94NKd&So#+ztYfu%@P zskvsG3N8{NcEW~({?C67K7y^zodq6P-G$UX`@qoA=_olI5f5y&J!j_p%N;u^1opuW zp#&ta5`gswzk1=7Cl?$lE+YUIxfBbs4+G)+@L->PFwl!IVN-XOOD{DPZ3k?^s#9|}aGXMGAd;iW45BAsx>aqY^Zxa5A9~1)M!JyU~ zmj--0C8M%wMEku5Dxg$;8jX(c(V7bNVJf1jMUtg)9DEnmX@cmn#bQyVjESvIy{=9qNp3*ttD`W{jY4z=J9L&+ty3Dox{%VOv~$`#SbuPW+dpX1 zApys>2bP-i6h;MYb=#8wGSZ6O2a zv)H{XL9nksc%O4V=BV!WL6vTuFoTr}Gtn^M!I-AOY#3>(PKE|#Z*fX;N(f!#@Qu(N zvK9nB(E(vdXe$98pfG~)eiFbJoh^;t0Rc$*=O2khN;+$L88FaOJ-_jSyM6FLmmOWw3(1c+`4Q&TKH<^FKQ-_%dHX2yb&wB$N(ASvfEDrGC{WRf|A6caX^+P9_ zav*@n%1Ymfb|<5fOxXb;wAk~ES9QcDR2WG#Ie%c10DqH54d=P=m-gTn{O1`q%m!`>paJXe4+=b@lv)C1Z=R_ ztmegmKu_iT@W9nR7?Lszpy?BSoh&?nQ3SjgaW&iE3I+XE`vSk|b_oAM=x*?X2f_P| zN2ozig-gKO_ul2z2UNLHx4C|^=$};s3;s!z%yOC#Tr9(WKQSJ-*#~M)JhoxYr}&nO zi3eAJ0(aUB7lwr{GCB+m;ME44au8uB9t;bjSdN4FMp+s``XmwnJP=QJ5z7h=={Ols zN9Q70~RGOigQ&@GT0ar*~jxv7smEHXU)w;lKlMFMw@Os3W^G z1nUo+5()CJE&+xImi9{;4oRfPNS+dt`k2Q1emvj-%s2jej(D)sf6(c!Z~+m$D&z7J z41`8G3%N9D#Fr1VN{$pj_W=(Q_50yer)qwg42Q?rK?A*u)$%i}Tq-w}GPHA34pDod z{*Zaxb)5tIV3$+^+N(;yVINRnu%knUbSMN=^e6)eR*b)PMj&{=1M_<&keXrA7jjuJeQGApZqYkF&a zEWm?95(>)qNC3X~juTo3f{6zXJ-4!iFl4BZm`M~^VG-!=l&SJ_)yIe@IVM2#iSfYIK6rL~!NpDH zg0E=4<*<`eO<1o**%<;nu*)OJy^aJ_*N(la0S}=i;AX3vKMsip>;_@y<|OJ?Z6&Ml+U=x zkZG&fqUPCEKDoHJ`*^NqJ=bZ701qs&2B}w-z#Z(*MMGKI9!Y`#NyY#3pH4Ul`Et&! zTw-<``fhdJ^`_tA{3rxB`(Tu`0_>cKc%W%ry^bgs%Sig1N?c>n4Ddkk#l?7` zme^p~=0>=3Ak$B4N!tgekwb*Qe;_0g#79T~_CGLe)$UsJX@h@`P>0uU3H=^6PB3ii zxT)<>gg~%|L$Csi=jnwr!~-|`K)dC5P@o&0X(ef!W!U|shnL_n2|t|A#Dfxh@42JX z{ZQzYYL+!^q`Mhe@y7XCRrIuipN}8`>3i>~YCK7e0<;O1<^KJ36E^Z4g|M3r2ZE{i zWEuEdjV3QsUdhB7|VvFD4h1@!`Ydts+ zOnpCOCU|fs^6s7=9(b@1=v#>szC9v4(JH*RND@695->bag?(^K!VegxBWgm3%a|k` zk#xp!c%Pbv=W=}*kr$CTIfHy4fh`Ht(!B@Rq>qJ6v_E^22DYPcUR1EO-AZxeV2_Pp z@nVWIiYE8P=Q`i$!9Li52b!8rM#FSOVcG|W&5!u01V?gj#f>7LvN=ZXhM z*#`=pY%roa3=L%apqkWD;jrXL6xSyWn=YrSB4>~J{6e#uuW*x3Cwh1^?FF`iT~I+z zNB|uLo1CuG0YW%7?xjPf-U}X#XIECvzN4!Bxi6mmG8PE<5V2Kb$Ng;`Mx;L7_nG)} zUn`Jp`=Gs|r~QOJ1~WHSYr*;2@TC?t4=QhDy7UT-Tha;MEMW#x8rMlh zc06DOYA9WqjOd^c9s>Gmlbp2-xlWM&*Gb^=DV}6c3Vd2T!|cH=efl@Q{_v)CwiyN) z0OYi+`z~qk-o$gGf)Jt+wkncVfA#Rb0%2J?}5nBE4xBcWVQmv92d@gjoC6=|OP9&0DY;(Z58^ zM({dc6yM~WeDE!XY5woh&w^}^b+_|yzdus;?ggp^?A#@2gS+5_ukFtl%Va7(Lk{4`|cd2;*b0v zvMl&956*Bsl8b$?TcRhS9>N25P;fV9#|`RD#v#PAF{$LQrN_icx)wD0P7+A9JHvVu zO+y3&J-12TKW!m_@4j&Z!Hxn#&%MST&4bh}`n}H2K8U4#i}jT&c*6sJP^CCaZcKk8 z3?u6ok(yVJ(kpj7Xzm0OxVjZ?0ssQ)C$KFjc+nAU9t5ucJ8ghH*x=PXIM?~cM&2Xf zz358pt2`_3E8STJj}P!Hh^c3IeiZt%*806qWM@|cqDKj&Lg^uRi_rK(AV@T(U;w`I zxX|(-?6wgERm2u92-x`Du5pr?)>ne8h*K-Mx6ao@wc#JtCgc#(X`YfJZAV(ChCN`iGs!XbbeRl$n!s= zYU&y;)g+c+6Nrf5;09{djvMb?dY*3t38_vO!Y&(t0>CbG_{T3CoS{Ea>%Q}Vp%Q)7 zI~nh_eqkk6u)#nSMiGIz@TxLCx-m5rnfEu+#aVVAh7rEj_&7MwynXLobXlb?gk8$+ ziULr;`G5D_#WQ>wMG`e3toMi?6Y@I7SL=aVYsClS23yR8#;Bf)K4jyq;6}Uj8rXzdh;GI{1}t<93dC zpnWN?VCC_9gr`;cZJ~&HvKr>-Sht@M1;DWDQXQhHwPL=v*o@2-VmN0&{WY~iRo|oB1ca?20UJgLdjar4Bz;;3;;hcn zK7h`zlS@6;jlN;%#`K${A>{UMG2F<*zC4fs3l~h=MK51`d|T7y-9&KwfiGcHP&Z)Jh_+VO&$+tE*zslo2AVb@2Yv`j7cg_{B)=!;#kd-uT2*a*SqtqXEuHPQv z{mnND!Ask#nl^x?{tl%0-S@f!ahUVP191lb_83jyVZQ{fF!X|n5MD(m{mQIUT>BhG zej0J6YQ^|4IW4d;0e{H=Mg`!No#$KcC>EFRu^bXSA2V!Yz&6GIvIFzr0Uns5IQK-V zR!z?abr~68ECFv?$Ixhqr>|?D-)d;Ci=A0zG3l<*Ghj^?WLDs7nMJC`JGp;e<=(oo z-fnW(1D4wW3VwgdWe)J*RW8*BYs9EVW|cbE3P~*p=*47FndKwbHUDGS4|bBgJL+BN zDNQjTmV*uJBr8dOZfvH5VZIgmEa&={6A`v-gMW@5DxCBD!pFQbKVq+NG%-h`0d>V5 z!kJjKG)?y6oz`vW?u;IsYOVd0hO>H@6dKeHKuf^H0SbB9`_7XX5}eVQ9lnDQ5fB8# ze}|!PG#bD*qUXE*;IP;Nj%^8~YS(G_`1N8ET|JxNz|;t}DUoXwCJ)K%MLb=6s;=Mp zr7@}d>fPPrZL1TXSNhXZbd;0k2nE1pR$b^ijESmmH%%b*@J*8`hmjy5!(T7)6`k+; z#5WcH=Q^1AtZV`}#D|ss!={nT$cq{*i#zcQ6S{>-J&72RPq(U}$Ga1o5#R3Cp=vRm zk6%=hNqGE68?hzZv|4Dsh!eS3ck?h9g2yzZyhIJo@%lO;0i6cF|8?~mrxN%NUPFrK z-bTu(w(_&yU@_iAM>iSM_7>VF$BD%9CN~;IqovY#x=0SP5H0{P^7&4Lh9{TMqNQnI z%wJsepw=MSpH52<%F)JZnJ{e@`Dh{?&g4dA7~NFnFuXZ$E8xia1;;(6{`J>izyI|+ z;K1*H{dM(fh#263L(V}KByd#=wVxt@5LpTlu~F{EVMI_pwFd1%ZGFW6JG)v4XKr$_ z5x6#{3wZwLBTu1_@oM+`2e`bj|AFxVy0NTV9gJ+V9!q< zrVo?SCfXgvMzP$@%?&)_F}PV5tTY3RH&9{Jh!#o{Y@?s7RE8I`Jk$KU&oURVB|kxs zzV|LjA14m*;Nx72peKO@-dh3z9=!Jz2#)_Rl)(DO1GR(xnEs?^Km75Xx_TEs{)c(@ z;wl#Zcgkv~A6V`AkMBs<7C&flXn*6|#ed+jgZV}(!{8^7z}rjU@$1)1JnHwa3yjo1 zzs@n%zJ7he=x{NeOyIS(pZ41A{f+<6UJSMG@tCP#{Q-(02!RCNUIKrA|4v<`?eG6b z58nDt?E>wO@4sT+XK~S9``7)A-#LoS+JAt_5{wt#{$>b{7)aowO5pzisRvnJWieQR P00000NkvXXu0mjf)8g2W diff --git a/vignettes/figures/poweranalysis-acfl-1.png b/vignettes/figures/poweranalysis-acfl-1.png deleted file mode 100644 index 57446741be6bca1a37f80a64aba3a7c246d62d2d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 15254 zcmch;1yGi4*Did~k0M|oh@=7n(jXu=Ez%$$Al)UY!i{t&0!o9@(jZ8PfPi!n{_hz_=k&Z{t#ie(jrtKUh7#y^axt4w1Vrq3-g2<+rPN@WB+pdRF|y1+LrY zq=x0Ew4&vkc@9K z@3bGE#-8jjmRq}t@^)4kdMkx-C-3!ctoHKqCWpP0Wk^F1pK?+;0{E-LFO2{(x=Sj8 zAdRW>SjaVEDH5daDYF}b_)B)|G>FfH$~J;r2>AbHYp4{eF2Ks#`u6SHHxscD z@dnbXSC4j<2IWXNOr>ZkD9SyLo)ZU1qW(gB7#JBC?#swfQc^lM`L=3x3kV1($KSC! zJwC|rMG)DZ<>6w#d&W#6cR&4qlElpR94>+^lzh@8PPb*@~Y^V5cEnX*Pdn} zKM_UGiQE3amsULqN>P`MQ14|U$uMe{%kk>&l9DT*Y4nq%lG(j;BQ~HR*B(I_9@|Lk znT_S^UePQj)pq5Zp`ym=dBc1jb6=L`wXD+(xRA!ylKxF+wri8)Hax-T=rReo>lXq;=BMZW zTrxtL)Q@*(6jx#HI_`UpCDn20xw~)JfR0;a$EH1q=tIKK@8B%P{@X73@GbGC0mis! zZ_!!QMy5?BbM(p)xElVw>ofDl{f(`h*M)|W#G6={U28U`ZfFOq)jwkjSIu*T3kQgh zI`?6BrUk7BIz?+`IcyX*53~<6aS?HO*#{%L3D3Bv$gDqR!*lD+miNHjP9o)33o2=@ zt_s$c;U}P@ck6=TCGG5^$UAG$)5?PsI75dS#b2&qUOmLY<|k9r>RCafSuV{9s7VYX z`!AY7F-r0h_sq{yjZo<4-v8P2*Tlx(cb(Nj#1F>BR5aa>HWMxJSW?LbQm_ z^Sj|uRPPfVeptRiDfpque!#K&R0+i-m+v%v*IFw;Yw*chE|7keCP5t7%Nd-tHy2d) zT>Xp6jfRiJVe4^)+QH+d%<+>4YJw>IjAHanj5P^r=xDCc7JI+VFOcL^1JTJrP1D`I zO>QwQ)U9IAX5u{*Q3_d@XN_8st|vB>De)A)H#Sy45mLkH(HY|2o0$KcZ+aM8Kr3YBU#GvoQ0(f}sMX( zp?JyJ+-cFIo@g{$LgGbE&TT1G0%EGq#l=Un2~Qp*2@9IFT!bS>(->%vHGI3$tY;Z- zwe+^*-eu|-`!6LWjt&mr%4mgM>P!lm1KqagRV5{Hh|+OH$8~*i6NJuE?ej2=!duNh}hK2?)F|pX`K0W3ts@wVAvrf-Dl}q)qL}xRK z!)0W;m1DV#yHX_PI+N$N4r~TLolL(~zD`Nm+uQ5DvnbU#kI+5IIoRQt_*FwS{kMCQ zeH8Cy4Y^B29MEWWpaKuj*B9aEA82n6Ndn=S_V2w=7$WxWy%Z!$ql60jLbn^)lb6TF z5pxvXx?T3<&+LXvKJl$vw-y%`oE+{T;Trek=c!76*9^*>6>c*mN(EkIb<@@TRVGG} z`{6^AMcLSJZbd~!X=y31BbLtvaJ9;U=#En56FGti4m7!^on5}azyHgZ4MJ;>B&@AR z+d|AS2PRm-!LYV}Kme5HP&3IeLCs(yZc@H&$u!?vX%At6ywQE%RygEK&i zSE}El*_hae_jEO)g*mi#Md$ZdEFV9MUF1fPjy zEhC=a(eHWq@S(%==N~ND5TmNm_|0?NM`c4tx;yhSsGtjVynP6rX%hc{doqy@UxR1f zhEb2U878`$$yNKTk=EFCh*x&9OGkFx9o)ONeK~bQ!NW zCWHtUwhy~Ug3x3Xm>@S?C$d*rQ!)F3yH}PVLImU2SdLR+16v0-lG|@k-@i3M-H6bw zJj#6a=aa{~JExRA5@uH+@zV8swSIlNYdkAe@SRO+TSI8#3IWoyG+*7;+BCXl#5W|p&+8Q3M(LrStw+OdE+*us` z=y6Ac!)0w=Jd~J>?Ja^?tavw|an!tg)<4i(7$&&DcHsrQH_OBJ0_Tv?a*x>DupeAK z+Oas01A5X_>zsv)ozjM1Q&8#lXkWvF#fK8I=k#wrzk8inOQgXUP4)pYrH}gh>(Sqa zy570fvUcn7FkJI-)7QQ19GOaIqfO$d#nVzV@VbyGKGkJzD7ny+!3Br&+A+<>} z$8^M@`K_wBcbu0H`L_H+F}STVZoF7M%1_Rcsey?cX}RkvX6I~i%*a8;wuHvy2rTkI zOnADm^**cMlN5?@3lh7JJ;luTpvw=aoZ_rL72E(TJK$NE$r~e0ehi`b4rops~zL>I6A&T{9-m5G)N9Ht?LCR>DN~)>%7!8 zPhZn7usINb1`;2D1{$1)c6biLGMN_GHvhsbcCcE9rQ*9EWnpFbwy{* zb7bh~)OT0T`j_V4KsfQu4&kqbGZuQmgOjT{iy6fTh{3@Aar)HS;QrS+VM!wX1vYV2 zjJf5t{gf%@q!wI0K0r#b7TDG~;ay}Ez3eg#x5xf0dtmTaBHk%RkjRZMgDZ3kIWJm6_3o>gu(%{AT-^hFm8wEFUAbU(dBDI{yOmW~>C4F8D|zRz7{uO38-e@NM1`w4`IXkCBNXhGz?(DIJe+)POnVHHO1s)G0N&Ad~mqe7^s zu?Dm~+T%EokH@RQ1;F)39=AFzn?67hdR)Wo)x{Wq!(3V8drw9Ghz@Mp3n2Jf7xTDK z((v{5?$>ct?mgNmA`lSP`61$8E_6iGZt*>$$tV^VieNc}z;ts8yDnfec+@;Czj8&* zyGJ7BWS;pDqHWuI!QP)g7c19lAWQEfFf4$jykyd#k@YIyydm`UJq?!?+r12_Ob*xKCGR8d}Dy-+LceR{kx)tpZ}(AU>DFc8Rjx()D0A%;UqNl8jdYSR1r zC93*}P%1h0cEgK%gCD{~)N_(*RlFsH!}O>>78GQmhzbdxYHMr5o28~sC^^f@%bzDC zv~l8MXV0&wI2<(e&SbXUT^@!EOhP04*!3Z~%u`&M5zkk415Y*&Jjn!-zO9FTla-)x z6^cwqP;k1A7a`l{8piQVA)1Yaon7SFB<=zo68uo-%vN!JKqGop4TGQ~)QT-T4ayzN z&rVN-rs@~GCe$JG+n!is8C3z+7IBz^(DT^!1LSMU>(}{hhm7p)KLG&D%*;$nGqJGP zZ6py}Kk&e4tZbYRFI}?CAtZo&Dj0F!`6lVm6PfnEwJP(-5X}M03M8uQ{&^~_a*rg>`YBf&CShCOzweI zuHPE7+}j?QFYUCty+GGhJ|Ei+?*(>Jii(Ym&CbnLz?klbkK`nL=Wzk_MG#{rhK5pj zs;Gq5)}B>3E#0LG{qVs;Utj*K~9*e0PApE6XjDS%kksn)&V;E z2%=@)MGiyoV}~2Xo87?*^+$;x9MBhFXT?Mh5wbNi_~=k-?YHgRQdjFcG#MQtMN;=v znR2OFYUR*=-_oFo_H75Y83dBpJk>hdE2T~!{C-~`gaqk>i6f@xUNv;5>Na1~VWajZ z7ii_fthq{`IHx>VYu~MbI^G!Kw8eGrQ)i{C{bEf<^*oTNxVo$MP5X}zdsiLh2(Ui- zq!Ad!^Hsh6vKatkz={=wW}|oc6we}D%Qzfka+oJq!q+)HSP`z~jiZm=$8SC2D*qKF z!*4>0u8(GP*W+Gn3r9c|-(x?Fq$IjE!x9o!-F(8316V%0%7jL+Bx!kn=B7xysW4M0%9$bIB zMrHhR4SgN@+spcNIZLdM{%Hi^a{q$FW8>*1(MhoL3nYh@jKYY@BdZ1bqrPPH#c(Xp z!tj-g#fEaK8_F>Y8NNQYpof-NsW(i4$(mBZCy}s;0yb$Eaf_hJ@9aHU%M9F~@Z0k* zu}93B#)RaW9eN@?Yc7U%l*9X&x>m2{1Hs0_(7uk1swD3KMoL)Nk;$OJ;dytlV9PJ?_%xyReas$6VSM8cT=zzRLZ8!p(UlI9IUKIlR=y}>FG(R?uvW!Akv#bW4|=Y zTkE-#-x6axWQ3&Ainwk25|F?aJ3G6bot?o?`ZkXr%fjB-1D**j^QkSDFGO;vxegm?Kp!2GpogMp0 zA#%+^*}}x^bOkp#^LC&X583>HbT<HDhW zQX$^cCu@w?Z|8tT3R|boC&b6wk5$D*Mm9`sxCke~FD{Pa+^+{$5REe?Ck77FIe?{Py!kfE;yqF{C!ur@{B^uK^hNX`@K0Ff15KF;PihWkw-QVGY`-QE4;#}Ca< zdOuoPuJM?)6q&a+1yl6a8}9-nF!_ES2gkR>W{~(ASBh^KKHbcJ&;UNAfnGa{{SO{I zV11N#jn7&g1Z3p75YSkTUU(=g`?|K)JB&sI8wUrH*wOX^eFOnP_-&xT7;OV;7hX%z zh5=^wNgH81q!h4MA!WS$CP~yY2kL9)a?d~}#n|z=IdW=hYAUKKmkksC1a<@ZD?Z#9 zvdp&9vmor$bU_Y9SXVp3ys^2t`Qt4Uc;C)KuZ)rsI~`q0Rh6E}6w7T;xBshG>KYn} zcc0yRNJ2=**d(`o+aXU{c^r zoTekNGMYE1dHtM}-+I*EpvFxp;Sa2F-&+MHgofMX)qbOp^Xli}$UpBzSy_WxXZY{j zsahbuapOh;zn!(y=dWK~fSb8Yg3~2I*_%EUSX^-UNyT=lzzit@w@&sx9q#XUI^N%q zmX-#PkeZq*At7;@c4%N=mz`Z%weQurE4LJ5yB5bI85QIe6c}mnQ|Ncc}_i)plnVh zBV)s{>UYDAjEZtP+O>mg_&M{+lz~+#wfptb*O&18d4npKdXvK7kdQ3JxXs_rf2vOz z*nKX@{U2(=f12|Nw(L(<-a{}|A{t?r{u~V;Wqy^|#AGySeKwM?wq69ttDv9&-j*cn zdYOvqeN+^m_o;^*5tewZ?#y?n(GGf@nh<_|4g8P0KZCudnnJu!b_O%#-rl=+ujX(u z*N>1~-YhsfJG-Ib9v>gyMu08;Gj&%=!E z>=KicX=!NR-rO>21d2zY9=^b7q%;fLUADZSpJr zyZ*G0v%f-vpe88E$L&JL6hz)fVOVGU=pw8*KLr8g390_mxvVdaK*TTPSci9DcX~QI)%vjHmy<^;g}FAJlz+sReaW1nxsp|O25Rr?bOiD zlj9K70*j!2(Y7zWgX=f?rh@{QPq6#qo(yL_ZpUegEN0iiAda=2v>nC9??1S_G^lW zmG2Y#a6_iGtd)-7+Hc=qn%6yz?e=|Nq4KU|SH~=NPT13ly+<3tkmu8?(ykk6udc}G zTl`G|V|Oj6Y|}aa2MdGD1HL_g`skl53|7iHxL)?(Ss0`Xh>A_Hkbkl;$d`NFzIqoQ z-iukMeqOEkuRx0Yh6j;XrR`p`{#@pLT^zb;pjM-re~>VLArvl_Y+R!d%ntaJuXx5l z$s&HiV!O`l9~{iLGE@tv#~zO9O6^7-!giHQEI2duAl=&Be0CvKHMoO%| z2E=SMW42y`t@r=sTV&0rjzJNaMIfWNUWhZJFZ`agzH9WOiyN~@jamFB1w$7CI@tO; z_wtK|I!SPxH0m#(cc3cU1WNBOr5`um9Rc-*$Z}TkQJD=b<{Fo=(lUme`J*o)AN?sr zT5{Sc$kS*n47PQG@mi5FVqUj!x&L5b5G&Bb@Rk4L03U6@0qAhn1vpz`bIr>Q8U3gn z6Mz5h0LU;LvUa4}mW#z`vbzicaqkk)GCpnM-M($i`MJBIlwZ1|mxh|(gRNr-)nS#t zDaeBrE=yWWb%C@%HPzxHjrC`vZNMi?x@~$0<16kU;tC{DMw7XD(OH{3VSo|ga?Ebw z&yyl56~8!@c`ho0+<73kdID4zQgVVrt|$lwJV594*!+_>5ih;Od?ZhCqz09GcZtjS3eD8#k5kAAU>+iF{kS zWpOOEI;aEDNBr`9EQh(JrD2Un+;@}THJ(S%j=6sQI;oW1=vP%kL*VBnO7)n3>Ntw< z^fU9`lnXRx{n!HDX){m5DH#@zq#S@v#0^Ft-z7$k)Fo>rwF{5 zqNG~?ZD!_R8bHGH-Rv?sxx)2saR@>wjF|<3dM#3$2uxs3>I}RkNKE&$6 zxz>q)o9+7tC-c?gz(G+_G1nKcU3Yi=^DDs(}Rf%=->So0XAcC^U*f+RGwJ5 z2B!I6ph)}pad^>4RrOMG=USVdI4e|L=l*c3m+kFgnvz&XY!yK@rKOJmBS}b1BQVYH=@&Xb zFQu>$)}Ie{bvqt@dufgUw?fMc7-eW^=n=t{D_5Ypf>XZDDy|6@y}RXYJ1f~LxFNeHu04Gu&6g}SWnXS>`S+t=FR27^G7ARC9~W| zw8S{92b~+mws=kfdLXW^VnoEVwA|S@+fFE9>|przBDVb908_EXhG;Z1A_&tQKZM>n z?WhcBY^>b&5|L7+Il;fIgiAO0bOE1X?Vl3~2(aQPiQ?=yH>cqW@|PC(v=N|g62;3D zmINg6Vu_g|aS>=^%MS2*rQ3Y#m^{3Flyv4!G1G7(l-}J$pB^z;H)E4+%bav4OWI@I86|{Ip=%rgr!sgpWoMMTk^U2GWR% z^VNFY+kP?kvWcPgNud;}PagD#TnwQ#V*9|ZXu&FSxsr;VgiewxJ;3?O!-n#hP{x>9 zn(MqoYtQh)1)1Gk0tonKuB7el3=UKZT9pLetT9H+NWAPP?7V6dKCd)oYS530m0g1x z1;I=Yj0`YeRIGMcpD6x$H@Sd_Zzy955kH#vq4l_NhlwO0`M6w{e5cPR3e=$;Kq2y_ z^rqk);kAJdRV;f?L5Su)xGD1!-ttSy2T8wjQ+pUij57TLZ!g?M=z!zdA6y_1c(m0p zM@&_Mj^zatqJxmWzh}NVNHdrGELli4O8~PKm^0TH{T&yRWh^zjYD%nJ?LZd?8lM*` z+YWYvEBj|-6~`wng>Mzv!Q*{8UZ%yUb?%3Fbsr@WUN6}9%FPP(vq54nc;~dHe@$DC zxKXRMNO9|kL#7pni^gKxL8dBb4{PpYsmKx7ID!`MZjFf6uX=);_wYN%7~+5<#mV_O zNWf?GUN>*Di!0CaBoSR1SWIJP40-5Z2NabqI4!(w^Kr{rOLJkfM&wTr*MKz34{(dO zCy&sY8cfs#h-^b9C4L}#OVPOljjA949U6oy-I8=;(+nUO)99>6-e3UOP560cx7o+T z--Ses7@u$8`;cYh_}9TJtlwgGiwn@N!Wv&$H_Nk~ikdNor??2U&6^JePIqMo#7Ts{ zrFM&pgxBvOl;V5~>JAY*tNc*3=yY~<=sP83btz8wZZH*e&CA>VH~ zIobnKYk@-F+Hb}@_`-pcBCX@!`vO8KPO??gsi>%Oa&xuW2B1gNktpOm^Yf~q;U7Mm zfiA8JwDs`!BY`6!GT2>edX$Y2l=sqU|zowXSDJYS|-m+ZFj zRANO9BMkZyn+s)o zN{aZ_SF<Ry^1%1fw$S% z)Ya6kc(+&-+kuAi@&G|RzLxmcM(cEeDR@daHo9#d-U!+py43K0ef|BJ#^}S}w>fDX zmYWyJcNVa6yEhSWDr(-t|8`CxYq)89e%#xob|`cXGa>}A*2dl*&;r%nr*sQ+iJzbw zmAE&KCane<)XU4u!@~n;4RdqGg!Uv}%TQlm-^j?zMCrZw;4QN6Wf`vDeL4;-t{lMv zy7qWeVNT?(5@&(>|C(U9$w6xFo%qz`SfRU4giHvcw{~;cvh{#ZjsA zLer}H{rg+BHqHz2qQ;oGfh@dAdr}L%WPZzUo&uwG_|4JaY(4@FpPW{@nJ@0kto=%e zB5l+UjwVRy1sJrlybSX?f>a$nnF`5b-W;NLofg$mrY>%74@sR?M)&{#p_=VzNlyqA zJdahXf}BTQX+Ti%c>rAH35nS8`c#-0^vwMI{9smOcxXu0nmdY|)1c}skyG!hxavDU zzwf}xG4i-&-Rt&_rB&-xs&tWsD2PD}jGUZLmIm^H&jU6N$R~h_z`XYM^^KO;kV~n8 z$%7hEC=@?Gzw_EyCNs=MxsFx20zU>nxbTXY?7e#pU8#~p7cO99V*?QXkWq*c|;%ou{c|7>ehS3THcyaoaodTe|*1ab*Daee*Y1vQ8A z9>Rix!#{uKwpBjMn`NU-8W7(``E>yy1tldk03gm6U94OBsB_9TFC5!ltMs6K>JpQ{ zquOlcgsNyG=TlD*>Jy@MiieY0LNfLIWPdPu6FrNu1TGdg+<^`NNdAt^a|XFMOP zfWRK~Y2@VOzyP3k0VE$Z`{4&tfz|SHaiuWJk8Ya4`dmjMAqh$H9jnVys#y;b1H-~P zTUx$C@fJ+MJN7Ogat@|h{tJ%sUTS!|g&OJ3;Vp%Nti^rH*+iA?CtsL&pXp5}6$GG? z9nS7aUGhFeE?QVyS3K^%NkS5qk&ywOJv}$)eR?nl!(l<>oFAB>yKe(yWA{>@f?^ z(qZI5x6EEgM+ZnxusipItD>B>^3AQStat8g!!d#4S4K+oIQC`?X*k_QqF#w9*-3Pl zrK;BLg^fAyC+Eg^)FfGqx&6^W=w{}Uy$xzS4mM|6-M8l_rl&LV^F3Eb1<8V>RNrM~ z&B5(p{Sqam`|=QXVA^a)B8===7#njN)gcNBt#x(cP;$ZSq3LW}9H?8EW(`720SS=p zsUJSf&de~@4Dmpa1Wm%eLepk12rilh21JB}>CD#4Lxr@S+o}p{V0;+k#>L%+vxBU3 zd@qF`Y?fD4HJ|x)GI#jZ$@Y37C!3u8N%yTQp_SJho`=SFxuzp^N6^%RqTQj$EfabX zXQzop24tUPt0w>GS5e~>)iGiy|ons1!EOI89KdHH8}q9Bl&tl0tQHN#U6Le7s5YU&bhK3 z0&p$Z_sq==gaqR=F}>Q;?w4k}q*kl7u&1!A9~w=7xY8N&x@~Zb1vDvA4);#~-ore^X;>Y;!W0MLuK}6?%K&`RCW2jE1#6Aki7xVK#%7`!ytHciZ;WjI}=OIep2{l&os;Zo#qbxs9y*8KOh=I z>;y|6tE)4DfB;QI(Wm1+X1(&~d4s%MHz}UA2F-}&?vGis0nUCtTJeRC{(;Alj`r!) z;YeaS_Q;+J#74CbiiMv)r!ZSjetQFPIzmfc&eWp&kITcpMOing3EP{hFnoMd{@u=( zFXj1HDLKhbw>AS(%PG_df|t|!q_60FcE8PfyV{(T6Z3;$k^{yIhpqJfZlQ0X5D9Nk zQvOJk+oO%m2vPmYi1RqeohyI&K@pxH)i8L*QoN~}OAkGLplJ*K6lcXhB5`VW4vmV4 zD6}0ef@Gnkqf^SsP86%X{pW&X66ujlYkYLek3 z;}#;W+UK3u6nc0j)snw`bYeU8do^GLdTDS@-^u_=L4yhx`vvaJ=hzk<^DKc5ORdkA zT5lv`BN;(S@w2LBaZ)839>&Fm(V>y|j+iQ;O9A-{LOvf4&q$SPG2lp-0#+7=%t8b~ zy}`~j${4Pm3gh)U-iL9Or{$xdG)Tb!Z8N6AhUI{|MphWc>Y~ws&Ze_`@BzVN%v{?4 z{gV#T`*!)$EF~tUrkZ(LsaaWr_02z8TVdiVd}NQ+`(mm}%iI?5I52h_e0b;vkfMi$ zA-%A$5WpHFlMG*3aR84}sy~0)~OgG)88K-`r{VpKv@P%CiTac8&8hx~EG8we|<=hdWD+ z0VIRHy$O6az^pau63Zt5u!Z~pIPcf+Ff{aEll+`txPSkCY(j$b(m?yKUq_G;CVh)s zIG}6D#=>HCuzsQ}alSLRzZ|}MA)!X8LwPqgb_x~Lq%V&fhe`0qm%A6af0G+}q{8TV z4g1BvE)Wp`i?_72R9#(-Nk0PA@Ax6-z;v@r7>(z~`JnkqE6DF7=A|l|} z0YCCuv|ao$UVev<@B8=fR*xT>Sy~2#Rh_ZO{&KDM;(#EoU-=x88K~=I_tz6as!&;r z&P+VsoD|P%2HTKuVUUU4@HgZ-Vj5vBkE5SatQHm)Pf*NulT%XxB(xkgzx(>sA#Fzv z_fBlM04^Z?1DX2^OmNBKcbYHueFS)8QmDo5w|SaHXE(QVSWYG8HQL{=;Za#pp(7yy z63R<=N(FOkbcrg~pkYG4)NN-G;$<{FL=-Aw8IOd~0aVcTAgt4ZRLBG4~>1Wo6ZU#M9H)=dm#< z1+xta1m_sMa=~q3r0sBjf3(7>wXMw-BIvueq)>nVCYb&L-rU66`sdU}&B?B=yhZ1X zIp)dU2B6}Vv1%bHRX7!(%10`kSQ(2A>HRe%j<`za_W+WWJuy^P?u;RU3{g>m+E@X4 zo-8OcHMM(IqGGBhsI+t!kS@%F!!gFNX~Pf$yocE~`jcMy=2oW|Otpipv*}m#egEzk zIm4+Gv?qoaceemW+~nTg%GWBK1m_zY8++I06>{wn-b&+8+T4Z`o4Mu2g^N$bR_}JLr34cki2^AV(*slFy%2 zR8_S<8`VS2ahsLZd|S_87Y_Mk4sJU=J39dQ5r$^KC*FWVlyl{sA9*v+i;HGvWpzLJ zxC>;oVFg-_?jkNOZk}Q7sS-gZQF7FMdR7RpSwZb>UEbJEjK z!I;I;U;(+<3}gCS4;({`q0?4U7G2`p&Sv?0l#?~^3L%`Aek_-NF_OOeCCuY$wJZZP z(4iQQjfm)Oi{mwfsf1|X9{=VkBJesG!f9+w&(4No?8km<}eC493P2?*$!)Y@f$)=s)_T2S#xW zRs&aaYJK)eV}?ZkLY&KG-AFV!IXs*TJ+A_DCO$qsS<1-|N&81fg`v{}Fc(-B_|73h zl+wo;nqI<-&`YU%fdk8(?*-M=)Ii%Vi+wB@uN1m3EnTFQ2cL0(vHwT)r$%~}jO;m> z9b|McO=_X%)6>%zg|7JQL4Qp!Dl&3%b+yKI%fi$1L^WMnzuY0Sy%L5k0XRUd%F4px z2}1=?3*Pz4abs80M)~8P$|GRn`?C;mFa^X(y%n}i;BfyAxo|xF)RW$_M z6aa*DC{^6MciV>|Fb(DD;lTqVW$@$S0jA5w$Vf#`PuON4Z*+7Na_TKcMtJQmO4{*8 z%$Wf+%go5Y#lwRzsz`V7y_mPCkkAo)A7tlL2Bim(64LkYue%6~CPNW%2sE1tsnh24 z513SndiQRAX{lH%50d<4Cam=u=op5%?JobA+DJ=FQ&dvg+1`fn+NUsd0#{ahBx7(p zd^rX9-url?8C(Ni76zG8B?FiP<6*i6LI+S6K3F&~Sqq8f$9w#`Bh`y>~&RA}e+0zFXq&(I*n>bKg#`5 zm9_4aZTJl4`t?f=jJ-PMpO;mGD|K@Ic<8xVmw(ojuhl6%hI#cFEpf%~)hoszKO2*# zppdg~R>E*<===8^$EK%u4le33eaJr$M5_NpOSfTZv##E%(`M!yIM(ACkAo2sA5#U{kZ@9*!&aOmFq z`z?n~u?#CpZob|jYsy*z?sq>+&8nsW*J_0+dmcRA)-Z&Av(r zREep@iSuILgldN-Y&l+wlcH@3WVVK{ zVG|Y?u3Qxf_u4Sg$>prH{_-lW&Qm8+sYeqI=SP0_)QbQ$+jk1V0=-MFw);k&-WR$8 zhloI7R+T;Bd3*rQ-)>X6sVO1yMB+R-OS4dl-ZdTOK!sI?}P47(hs>z~tQ*-!xZ|Nru1c$m*J9 zw$3N-Idwz(MO`k#Exet#><#89ymF+wRjl|rz04)EOqUE%h*nwmvVLgMne(&U`>34q z6(j!FPS58=MxxK^|M0DEa#5zm>%_I~P1*g4Jt4NBArX^rI5B_O#t07BU$|ZC;ybc3 zMf%59^1`7v?sgLTJ>2yi?Vh?BneV|OGE1i7_pcdlZS1y6=AxYR6#u-Fz-<@1 zu1(=PQx$iN&4-2Ggfea6*O2^2^-zIQ!vXG!g;Y|)WRfXZ0*Pz;;Z)xI0&3D4Opm^| zOo-;mHX5QpgTk5hx14!7`tBDEYqz8S>|RT|z;hO4+vMgws{Vbt*NnuK@2oKXW^B_x zSGA5jT5FY9R@hp}$ap10n0f)8#71gsRPg*+KlrpyeCf}Y`D0b%LRl8IQ^l9O)z#Hq zTt1hSlmrElByAi+9AwkW6O8=-t#u$rXN)nyU2pG$+13Ql&4qfiqDq&=2D73)+`QAT zF9Z=XQgus+gr<$dY*{!{^60i{Zu#ict=mU4f)_cI`Gjjmvn!sg z=s$SSuloMp?}5Vi6%`(HZAtvc5rpw>k@}yj|BdQ8bgJSeCMIs(x@Bc$g+kMc`;4@< z{%+=~74iIIb98v1ibFzry!gVC>Z%&w4n~B&$6{GMXlau&m6QLhj3;A0n76+x)VdLb zAt51ISXi)lON&@Ar9CHlV+SU@n4jw2V%&CC(y1%Z4})dfwW~eo8y)p-dCS8Xfo&H* z+MfuZzkdDty-=ER>wZouGa`hl=k&HgW55aXbS;ZTgUd&^q{rVnGj0>nqQ#wN6+Aun zto!rVcJ?0+myptll-1OTv9V>r7WiAp5ViWL{uQ~ZOK*}UQ|#9JqXe#LZ83XV>@FqL zP1xT|oaO56>EY++XJlj)5fz;$Mv(Jcm=X_mq5D z+*0seo2)-N+^Xd`nJntrFkuhw|JsZ*vMQ#Wqi+*P>V98;yU_G#uc#!e(7qx~f$7hm zvWkkDqq+gh?hM5Q!MyrkL!YgKgM!lHP9tM1sna`sWhx_Qq-r|!Z~_7X@$vC;a&r9b zr;#L7L}Urygw@rfUa!!_mv^RQ8lSqRyvHssERfL(qfn@*$jI)FjxR=qH#j)vTH=Zv zrtS$+Kd3;$U1E#g)K+>{t1^%Lhv`0beg7UC%VnUis_HQLotP}(eR{fvx_achcXVgZ zezY0}UP9JIy)rDvh~LlSi|T zefd3ab6#k_?`A-NI#+tr+SBWDpC}sy5+HebA#;pG_#ozY2K)@+LG?1*?Rx!jW}|g0KG23j@F|zmi(^XTsBhFzHYLp;j`rB| zot5Y$?Q~E)(l~ zAwTX%6U@;za?ba2_=6qFMoJ;Vr%7moGEJbY` zMQAM^QOy*!X{pCLGpgKxyJfqcoi}z^>!K`MlknMr?<@lW2=n6nMXnMDNw^6U0-tS! zIYc+{v#40^sz$xJx8C1TnA9lWEOWWWGpS!|tM_dCt&%#KMuKf>_~O{V!<8dq3I$@^vhn_1JvU(r+IDDz<=~?;OBNU!H$2jj$dE>CG+K1wL1Sm zMAI(EE(Zh;w>s3cTo<0m_AefPZ9qo3X#QJ9m`uVPZtL(I?k)A|FJ+gQg?@-7aS%%g z87M)Tax%o^%;O?)mvWkycatZIMm+w2UP-)B!KHK@zdNyRy|x;=9Bb5U^*6QCpx)a=L3Go)+M;&qHmiBhG6C(q_v)jxUU;K)oWV&2 z$4~%Zsr1NhRQ=70+2fHj$A8hnpzk})>VfmrfP#?6&&SV(v;2412u3kPJ7?c**gv@I zcD2^E_lv6h-fL!BB8hh?*gJhEL}yQ??X#T^ED=^p>@(+{zlp2^!v4gL<=GO?@-2+M zPhO@>5AhJ81pphju~m`T=x|MMQ^^Mx=U+oSFNLgw|KLs2{4!2Se+|6WXIb_e#f8hn z633cQ-tO+@HDW#i6ZC(9(l6Z;%1NGDV{yylillJf@XNw&O6+WG+8-Z1g|OD}n!5St z&y(bIBh{WybajVuIA?$Xl(E_x!c6;b7wf%I=&L)nhqZ+po$JUOv~(wzPVt9~jE3=X zaSo2xbrajWyPBGsZSO=qXMRQl3gBh0##lh!BWoy~S4>LRI(8V@NRw-OBK)K<*{Bp6 zJu^GIfW_Xtb!%{7AXl$4rq!&#p!RTeq7MIC?23zW)z9{uZCYE$86G>Msv{y)6%<<1 zWFs*c%);Vg(Wg&KOH1#>yt6YirR$a$)c>9R>^nATiCas95ulFIqHFEOYvTCKVWC%2 znD^3Qp_F`PBV`VThK9FYmmoqi7}=?9AEh@w*jOa(5vX-tk2eyK0Thy+yPg-kb(4>5 z-VY&p9*WsoTl>-6?D=OYuDaU0KVNTeYsGhCwsqWR@A1gZkuQ;PKAz`&ad)D&9kglf zOnU|u3%`z5Sey)bd#fr_V9*93d6m)4zPY)X(4Oi11pg_>%?)|=Y88j`>i2zY3y`PHjeh3v-CSgn42d3y5XNevB+z`(#s-}+Y}AvCR_wri2~mP?K{`(A^xug--u z4asP0Q(hJLen}xcJ$+|;yQjCedXf0Vi4(H2vK%Mn<>Y?;{P}(A+O=yiRdjT8t8yL8 zb6++3{+5tZL@w)f4i1j!r018vzRG=lUqeGx?LG7Pz_hJ}^QEr8hd|7H=566*$5x8A zmN(yLmFm;qS}Y&PGq=0zfJ}eEpo0Y;5A{@*-uF?&isj{HWZbJcES4a$p%NZb8&272 zuK!a9YI3~O0h^JZzub{3dFRd@fVQNhq&F@#cXc_oCElVIvNb6h1T?&>v1Z*KW{``) z@OFHO$_tUdP7p5DNO!P4(|qB=1?9w>s`u~r3=C+gshtM|786rqGsp|7x$Awz@X7pv zD8B@xC2U*V)xI zx#l)MKW}PkdgaO$&{OC0YTpdHrtV(zz5{H;zJDl&UeHF%)z#I+#6(F+3GDCPyRpgo zVChhrEDYvu-I7G+Xy8PmZG)ijKoU{-6@G7(3^=t}%Vm$*V`|`I=UD>JiRH)=5%>xH zTK~wvW8fsYOC29?If+R_KAk|5zxhf*!f856epxIMc4z@H_Dvz1;6P_nmyBe>zedih zaQ!mye&=zyas%OoC(f_V{FaBrekx-O`2_z@0(3s!q`X(Ucfacnk^%`ZHrJ)JJ&bP# z`>F6YIm3GuTnAh4{_clwA>R01LavRCx~OVi<+0iSXu`1@`2-0&?E{@=dAEq_#=!ts z){Pz|>O7MDmajYaWOku_y*m>35)(jneNtnL{m0(Wjxj9sixB3$!*0~(V>I`iT85xW z41Oc!s_3rcJ`r=}f()FQT(VPAIyXp|ub_Zko>E*KaYSlAblA3M%kky>6g)#I4?->` z4x$@+jP8j`Cu53Qt0QD!S*;}b9jU1wWuRV|ePn?@QXZ@%mV;@}r}K*;3TI*Uun0)& z8kwxf2Cc-))>WcY@^)_Uty&)jG5-_ceDFZdz+}t9%ZeSE2lxrRVFFF+<%c6TokiwR zNC)6Zi%5`%$I~zU9<1{W{~9TLIvke`(fB7w;EDM!2h>EPX5siJ zUSI3}jvh8b;Tt=ZKG+5I_H>PDvav;_!(SaVlOnw1JP2(If36NuXczQyP7D_F|DJa-iSI5M{5^!iDQRG1&j&mo8 z`F4z3nH^p0Jg)|Et*S~S2m?;xp`IQEm%f50cgpa~0eL3Rq03elZ{SwW_x(&wz+$n_ zo*lb*@nR50>qcM6<6(OwU=4uItC8a8an$&ge^{G_jWso~a&qSHG^eF8qeQ3jD!qMj zEe-TaPJ)IoxaTc(5*_Dy?G`LjmG`G96<9&3n z_44IQT;nk+)arG*>KnpSfxY&~nSQy>m7&kU%`^Iyt{iM^KX!auT3hGIiPSdHJ@f5L z54C=l?VLgCKC9sje0I{e@0gj*cD|RU;C$FLwPx?`@$yIRb#F~=s-@3S;C#X>G=s!M zME2W~ZkO7PgWFvmuRYq`Tom8MGVMk_y`T3=xVp#iIq&jS;uJ)OZI?s0#LdlZdv7o7 zG7knw44nBfOL=y#pE+3%dwu!gv=RZDL5E}2o+xyn6b6(lJ12+z$?oOlq}xwGZy;3O z-VtVC%Q0@trvd+>g360>v$ULNN%q3z=i6FYWkbMQTm-^;DDKwC=qNsC4iE2$qacu# zz23@^ou^|Yo(S7ckp-1B`Ema72d)nv9@LGEK$A%xQZBq<3oF&igmNm0?1V|ia+Us9YgkXw_4 zcM8-sG+dmV7F(L{dhU$ZY=4fVz#q0W2Av!e^XJ!B{~GVTe1lqjHK*cTHGnf~YisY` zy?YaXVvLKCMN#Hoeix~zR>d`j((X+LbKSUcVb@4xPDOjCzKjveX%?%#Lsw~)AatV%yE-OjLG?aZ26mwf$wAb$q0-{6ub0(a}@Cln;c#bpNqLZKDocuoH- z4R*aP0E7hOqpa+_fBVwV=bY$hjo>@L-VF`uSROYnv70QQqY?9mNWw7nx|=;ZDyqVH z{;q0NcJ_67N1^v0a&m@?%)|2X@_?(_Hrf&t6dd>3AWd$M?Ln>5QM?<40>x{=&sV`~ zHo3iTMKh|ZslC}QRAII8QBds(zal9t(gs?(iom>L^LfyTDl2* zv~D6niFVtBl2TgrG;96EW8oKBJ?>>utV$+l(m2<3x+9QezEiCUBBe7NX;hKKgShZ3 ztRAya!(eixU#1sJ!jAywKda@rR}~PK#Hs85uaTD@X8Xr~`mWo>X5qtT%biZX@7Y+V z3mi23gI51Baz|SkCV@**_+f#nRkT;O63k&hH!IKrsv zDjixU*BQS~Ffu&L)tnBn4D+B@eklNtha3?!S8QMXLoJ~uyd~f%k)24D^{R?gSAxdB zg29gzaqjLnq)y3ZA_%Zyv3xu)C_gKD87!vaw=n{f#*seZoZK}xs(MPPx$`EqCx+fC{fiTWr@+b*)8jzoEhMxz@h2eF3DAu3{wi7KJMoV zhYC2|zHIra!VOpj{0u~;SKpA2GwX{AdI*AhVu<}H%|!&1(PnRjFqG}^bDaN!o%wRO z=esX#CWe2c03KNk%^2hD>!8GQ5FiS6RCVs&6@dl6J$}eWBtlcMrbCC*)G<1{WKi#b zbI{cBcnn@md(J}NsP{+b?{9>bI-B#WpA-yZsRpr^@kjttf3EkCG-TnP*Ddn_=tRl` zFtMt)&wpDYRREp_4^!|XXs^^?lSOHM=W1YT5}6 z5g|YD0|iF@0o1zGhEM1aW{{gMur9Ag0*GE3;|ET{07RrM?xJo}YrJS%;3}>_(f}O8 z;cwn((Ah^QRP`C{i{7@F7yj3vtn|-FE>xo&g88;8e&v5e7$CLKE)?F)RbC;mx*-TE z`-Pv?BMuKe_86Z8ycfccNWjR)>$4*_sHFui^jDZ4^f=%1?K+^sqacfi}~-IOdVh)MTeQwab{osED{zrF3Itc(`%70KX!UlO>2rx#Bl ztjCS^dj6@}xVX5iczgpG2t|f|BW`i=@v$-epPgy8bxFYq0SXL|hoDXrVxG9Tcq=!n zqXe7)dhnT-Tz**T`dC#pg5ODY6j;D(sTLl|UqKjtn3TOU%klA4P=MP=<27}9xJs5O zi{INZs7t_gL6kMNw$91O$jHlUH7j~-V^gy;OD&eHT(`tKnUiV3WGE1 ze?u+AvH^$w+qI$f7=fRrGtK*2#~C?W+k8L{+w!8Kq7)PqEG#VS?Cex#v9uJ)ql-Tm zCJq0lYpj>x9{#Ds=$yGHElqv-atC+i()P8rh1$`-2^>j4sOavOFJFL%vKg;Qs++K| zv|Mwm!r^eAK79%gKMPZyg968B54aPR+@nAOL|a0-lbl-c#_ij;d3kwRSTd`s9x5x_ zK}C#7I`qD(YO0|trNgho*HiSZSMfqUr#RP{^Wg(Pz?bjJO*+W4I`1tA13`lK7(u5V z+|8`(>}m3^%Z!95PeOv`av_Se)3KVrjZMJYF^QZ*0lh5wm8<(ZYe~)eK|Wj@2*W8) zT-RnnrBJR*#W0o?S6z(w-9S~NAmKAewkLd9TE$NdtqLkQwPHS=mOJDBijOK5tR9vS zALn?N=^Pt>2qM7A>g$x$zYum^F~wv_A6ldkul5tw9 zB0PZv>63uxSxuBaa!tVJHwZcvn{N2HWvBC+>u3)@-s`2XqN=}ZY%D^BU@&a4jnJ<} zqEmh#{%z5}VKy(5y zE4k6CbDB8%*Lb&~{UKAyT}xl(q3-7v!{guvk(K9|m8grI=6z&1yzTq~ih?#44Ej^5 z?LWcMZ|hFylaUJS2HxdCaNI^v-bD2%vmRoqgIrqtasG}#6~VH*V+{{;y)FmUFxgJ0 z3lP8fTeCTi{HlXl3$JocTmQ8!JlRq+`pt>%Q!lXdsc&OZtt0V>u(20wtlhN^e*FP+HQ@rNBEK#!B{t)Q3cmPL>z zYLvI`K{(apwEU@_Y6|>OfBR$Xa=!HF5(WIFMN&ppaE~3ahsm=#9{+?#q?kI`8QHNH z`TfVVART`c=i`5{;x;Rzi+#eQkDWvCQU^-rfanz4M1gV{L7n;Et=(bWB_E*lZPl;M zd{H8XUyAlQ#+M#ghigm|ANS7SHwUGYBeCJhy8*7H+?_p45YSVmRB$WbDM;>qQYSNl z;5SVZbeOci^3YYFgtx2X8vY4&6e{Mznz zmSW-!=(WRr5Q^;M$UTY9QX^1f;!6kr;5R%6Q5&*VHPz$S0`$4Do|SueJzHPDMglopozJryRNUr>b~=Aj-wX#ceM3hdH0kTI@;>#_1>aDbq&2c>@_; zn^7SvJ_OpezZ0ELJP_?-5BikdEJ@^!*EhSffl>#%n|rWD8KQ`am6|;z4=$x{vfOP} z;FL7LE4wi>F-b~G2fP~;w=nG~hyE!%Lb)6mYDEn(tto=(b8#{FR?Yl}vZ_75hf9Hr zW%E%Osat=B8Tx5T#)Q|EaFTy&5~?T-1A`+tz`}ynU*-q$aO~8SWZe>dG4JkD{8M8Y zu&nS)yP=&qSy_XFgMswmmLF(p-jk97F05v8hmw+V3s@IV6=+*~mUZ4hq`=~X-gk${ zU)INvCX|tMdUsdXSgo{yuCDIdB|SYoh$6%dT2J;M(mpvX1aI%O(8DGqBt%O~OBPUM zJ1V?}NmS2N@`l*%+_1X7j$yqnCN|dD8PVo``{jU+FEp1xSlSXX{NhJIc=C(|52T8^ znwrUK^VwdV>tD!U>OUGGJL8R3n_Ml)br24&`@?(mL;CBvZ1CcG} z-(Eg@b`>|@4H+sB4j>vafIlN6USn16lN7QF3O${jfx*EEyryzmT5sLBnVC)ca9t1b8 zjFeAJPv3v|P{d(U$|0{dDd?pgEtI~zcGkat|9*i*2?fAcP%tJc>iCHhP$>fbE9B+i zxT(BNQ@>J~52fFT+u=UcOx%O-oIV|#n+q*O0Ejb`lCq(H$$ew?+qZ8mEefz&P*4yM zweblF4>UBOX!rd2^P9rL6_u5MHgdI#W*2&M0AHifg@a3A={eciyW89QYmM|?Vzp&u z+w zxO??#I`r^pXlkmVHeIjJ`}DI0VdgF${F{cTH&~dTFE1;DI-=|!<6c+dcJ~jMT#+AL zPwyj$1s5Esl)Q0nZVv1%_(((Kn^7S!jRsY2JdV>%=-^AO2|@)Jj1g3$prY5_+$^u8 z!hiydE}nb*Vwa59Y&c_la?(-u>DWU6PG-)qi;rso<|ztOc+i zRAzR)ePtbXNi31^w21H{AeVS}ct9Hp$lr;$JL0gND6~L9g`Jhvbyikx0fE-`c7rl| zLo+io;MWxt6l7#xMMQK)v8lsS@QI9!^xa>RHa0d6!bBNVn*D}v^7X5!XlRz^=A>17 zb~fgin3&)xP}bS@WGQ;B0_s)78>S6!mmn9w~qE;>Ept z_ikLuDJkh|Zf0j@e%?H@zOxU^tL{g%&Z?x9efZ?nSu;`7A(mS*iBEGkypVunp{kx6H8?v!N<3=4_T~9YR z$eMnEX#9yHcNm=eN3D+>6XZ;+5Nrt0oxYpB4-C9FHMW*VMMXrMot;6R*K3q8v9bM! z2YZ!IR_M;1TiaWyRY!dWKG(%%6PU`O!NFU?!cYw#ZfRMXOZL@=B6~!{x!7h=_x0&v zb=>da2YPy=!^65>A7{Fi#X-RZ`S=p}ExRZTyv|Wmd+w~824Su##`i#b-|SdvNeS7R zGq}yo-@phvI23M6rD#?s$x)4exD;hFXVO@5^U3l<=-@IJt3QAi()O@rDMdY&ulEs# ztDvXfo)eQeZvKRn1GhY?OU0FM-)}wQ%Qb0`&+G7-7C}5%H9L>CRPU3!(9Y3)Z~Fs? zI@##rL1)wl!hg~P3HB4$cO|!u_`7?YpuYuBho9zmPOE#hQ;qqk*L&Ma}%q{RKwQg(AoD-iI z&1wsIr9S%p;$WxXdcA=#D;=b+QBi9XbOOHM!{$52`;0!ehibYSj{^@*J#$C=l(K(b zhde>|AoJUU=mPpCmwCg_&4ZPEPVR1Q%q%R>W$6kb2{$rdN%+=1#K%o}Fsy+&oX`IFkeAon(ZP^(mlsH)O6Pe@TAGybtKm00X zZ1Y&G%pZZs>WTK1e zZiVL{>f&t-0->yIpqmO^=?oxxh!U*^CEgcI>??I_}cN!K*^f%Q;A1rX0G#H=|e+9KO$LH#;W)9{6F1eMG4=$nJDa%otkP0 zs#j#*e(A^WS&&m!P7WYj&HMKipw@c0zr%QIB&MOEAwdY@uvJE8X0Y^74e_TEJv%#j zsChw05ECOKd?RQx@MXeY%CVB8^{wg&+PYN?IWe(=lasa2lcVh^av~z4wW;A!yWxR> zDr=QKseAXxD0!v!%L)s5goGY2mnPKBIC|o+SA4u6qmq`Ej-at^&P?{Pva@S9DvUp! z{yTxedU*3sNurpy2edIwHo|>E>oPE#jujk6Az9Bt4cAi>pkEj;9yk)gu<7Y(`ANsL7Xr0s=%uGoHIzn$TTfARZy(3?(agwXucU|T~;%VJB{2WSb)KhJk{AHt+bKR7@7rlb5%KlK4Z; zQs~D~62h~S5WtmSi`m&arM9C3g~n{|KGyM{y)R4~RRXX8f$Sd~a6K&Jc3(GEx#i9vZwYQbLntb z2&F~`Pml%<-VT7Pgt9HKkdVR0M|UJ8>%dw`W1DG#W`6qgE70*T$;UQkt)i1`3yHdx!*g{rEmS0|5$Lr*CyW2y>v zW=6nuX&@vdq%n+sczD>;!-M3-H@GxNQ}6F5!g0b$i5b{fJyal@MMDM^Ou^OH-3|Ok zGrV;GZwMIFc*R9T6ngDA{?}xcFu6S}D2NKAS6EmGDROfx7h4c`4xI|;EU=Q))Co{Y zSv%4%M9?34F7EAH++sf@CX0Z&!9ByC=h~Bnz#@I_T3E0K*UKp?LT?Au!gmh$RyH;^ zT3cJ^S`z^0|BvaYx{>a&j+3xk6)4+=$ho?=GOXbbuqa;Q&ddiHvX8Db*JtPD zT`fF^JceFdbkBQfa?V(2X1xdw3Dh3=0&u$(V9EvJ=3QyB-n%#+Uf$iExnznPT8~Uj zzRx%+zY_tD>CIJn=)~On^V=Fu0v)dK`VMabL5H9mW5g@xlRzIaF2UBf>nDRAnAB$BQ#(HQmSgd3h=A?#Fe^ zO4PY}E*k18g5fXUuIrT$FL(7aj+>Y;APIQX5rQhCe?$=ACp$nG(Df;o>P|Ab5+}iP zmRQ|;Z{#1NA9X}38c0Xe##976;%BzOmA3l-F3iyz;4!XyfK(oyGf`GncB(8liiwFS z(0+QfH9h$?bJ7GgY|BC2{+VIW%W3XcF!-V2Vz1Nq{Nmqot87h_wYBwXW$!9!lzekr z6n!$(SB$su;=9J=06pcI%I4BiYtzTuI32%#OQUrcHa8>DXl}^M5Mn+!Q843py^pY; zpWnqIn-rhB*4fnI#;B7OSOs@74 z@tl%&7UGe}n6xw%b@k}7)PWUSTU*EjC|qQJxtrg`ju=*wi|raN)I05V@(a{NE%s%< zOiD@7G%)zH-z$YEFXul$!m>Pm98_B?CiC*;c#SKYpr9alwFF)h9xS<9CR9~M<`yn4 zu86q!{*-GkpX+iLV+8y%o+3>C7kruUy}N|L0df)4d~bUmrdwu;I0v+}$gZ!i@9ghe zjDNRer|eEOc)N>rWLjQczE4m8N>`UUKR^HE?;#TW;2j_w?!0B!CLr%9M@{MX++8q5Pelcbb}-J4Z)W2dn+Ld3j~#t%P*+ z^m#Up)3tJM-aL+qiW&&P-TBdY8AU|HV`^y`ET3c6og(;9)a8zyon0G(srTk=o0+cq zmW9nbPa`=*M8NUV-KU`N5%70#;Fgn{dFAW* z+ytReXx+iUD~P9$Pr3KuIwRWO->R>?9Y7cYzdBuc;TjEr`}(@&6A=+DpnuHF*B{R` z|N0dGkO0uBsH}X;6g;lTpfVh6#0N$PPrYKpxm2eHv#DxlSvk2fo53gfD#esli((o8Q;^(Jua&iLfkdu|YQ&P95jB&6N z&Ez{hKVMi|Q*v>6F6=n9y6Xam!xa@3O*<2~Ap(Me`E0ztgc#{o0}655M%-5H;0m0*x7X^@mYLW zcI84yU3nr#>l@cAa~*7L=jU4^09E+mC-2hNo~WkW`2cv1kk}(oRaK>=rjAWbC2IPE z}LRBivt}?RE0z@qe?iv4IS%Kt#mEo}0IP655AlNYL{0^QW(| zsim=Fqja89L9Wkduf@`Ole)UP^sDS?Nk~XG$IHLAchX9F3w(J0-MKGI`r_cL)UcOo zPCr^d7fbH|r>CQ1XJ=n^2j}|I!QW2mrMPeB@s^Gp6BoXtLqkJz@V28C3fRt=1tJC@Eica!GiW`EovHW1Hk25_xP2R=D}3F-uK)KQ z+w)RST)%Fg_p{td<;+)2#d`sVOY|M}J@_kieM$yFB9ZXR!%=ohLO{pdW-WYt{3o!C zuAsXV1!#0$LxVA)r-x1Aa9>~3;_tX*39si>RaHYHBkLFLSW*uU56HmaU>?arS291u z)6;XcvZ$fz{hFo#9m%Z!b$!pqL`&b+WyJ~;akd*=RYm0;K(-=$dTI(H;&W7VkYZ?V z#*Q~VDB~KtHB%Z6tVxNx#9jvr5EaGF^6%ec9Ys#srLOvyql@_gazp@@*f=>O5>5PQ zX=rGG+>!{)R`g{?Jrun!B_##DJkUxX4JBhz10n>lO;}u94Bzh-#yjuwnDGidICx)d zgpoHgV&J#xdV$iWd)xq2pG8zO`SSc&OJ85n!h(gCmX;lz2;0;t!Uw{Q7v1|HvhA>sKBG0DUBq+a9L^YZKvel-4e zbEcjiNWt3S$S5AJbYG@48G?wAP*F|oiKHY03j2~c7UuASIiO7PXw0Izx;i>K+H^DjKpgl{QflhPWs|H4zp(J=IZh0I*o>0T z#fh`yRCRwzSL5vi%E+6<7tfn-qAtBX^WRH3M*rWZ55$42R~Jlw%SLH8&rTax+T>Q}$} z2RQy5Kz)8gLqm533Wd7K9$z#4QqZq|D8rV4V0`)VB}v?a=j!T;%dk2cc%$NecM{+2 zV40r{zUK!gky-rip&uJ489^TR0oA`|ulAD`bYSB)*zOezM8aV1+um4rt;^LxvV!uv0JNnNb z5Q!zkEX_Lo&>;QOj;9z~j{mf>NYryl!R1w}=R zF#j`(@$qq$bTOn^bBHrIM@ucKr=j|CuwREx809>Mu?(Wu+k%Y9g zhhU4nr}BHu-4;8@8&2klAhEHr@Bct-+;k`iQ#RmKR8+eoubnh>bwiLyDp65USy|bv ze(Qs+#4ELu++k{ayMIsT&bJ%it`DK?r>bK{jeVkMOyK0!SIe6!3T|I2Qc_YtVq@Xq zQTyiSe7LTYRWlJ(Qo=h~<*)!=yjV z2?2?txz20^X-ELSCNaYV za>u|eGEVnbek3;*rl@lR&)z?7yiNxxt*g5mRZx&sS6A15IbgEpCjaHzH$v-TiL5-M zQwlbc0nH(6r-lwoXQidj)G{P~Cvd;+=;?XF z#)jX=E&S!u97Nao>`=ymw}O_PgM$>DoSfgkf4_k*;IY+wOITNiBt~^SDZya$Bb}fv zrInQx@k5b&;4;VAhUtYUjCk3)ih^J^h;NfaLEd}6*>FlrOPfF#1c;-fqw}8Py+j&w zJC;CU=H|>Gtuq7dVPeV@5_~5B?aHF zs;^xHfV^;hx$Peo6=k_Q-y1D-~e1E4Rw=B;Bf`TfS%8vKQI0Mof!(v`1|*-JK4vGh=`B) zb_KD(JphW5o|)Y`Ki*~&5~B9;@d*zP&&{Nk3OUl$FgDJJf0jO+u_adB}0cV?B4NCQf~cI?{O z%f-WEwc3|W)|JgCuzd)gD&oHR0B9%1V_VbM_;XE7jke-d`#X2{wuy-pP!FiN4T6%B z|NUzD3PZu^@UaF&|GA~5;e5*Ie{5ykhIw6bMl(jn$8RjN;p)t8t+KCAy{^8VgPlFA zwl<}pfc@dahwR+k*n_^D95D?e4R*?)(9nGl;Ny~$!+_C%bNTi2r}SC9wvLXRpC1$^ zu^R*}Wb=u8qG}G(_1O5h^WLITPnu|Rfkw`!$Vh<>^3dR5TzVnp?525fR4z2u8K~!6>yxGt) z*`_}OaMQ%xzP%YRY~bC zBO{}O5HUH^!unHa$d}QKs=B&|;KF!iR=|*?q@+(IIS6Y3Isv+|-%3xjN-?T3el zb;mP4h7E99P{wZEx|JmAY85(|n2_+@bwzD$`8b$}28iJ87eFN=sJU(VVJa$-Jx!)< z@klqLiANQohF4c{B3^r3!NIJTN6(6iiXuUIECabJeN;Rm^x6g}D1>Rz*d; z+s249P+s6OA)v>vNL_oS+N1*A{`AQdq$)1sx}?ZRVj-uQE+BcO<>fgQ6_mh&H%c0d zUCAdw%;MF}d)*dE`#Xt`#m$&sn5n7g-v)VGjTKOcJG#0S7Z6g8`^I{^(JVEsUn`Aa z6M%<3>Ea5YRRM*s#$fm@+KAQCMEV^EjO#pOz|6(idySQn5EtadgJdy#gl0r`c-;&WdAzofGEiEme?YX1!QFN`l3++S&>l6$J<+V9qds;dEh2mGXyzPR+*6jqW!6 zYt;I3)u-N%dHo1GNlYi8xS~GN))oSCmf}KpRYt>M^)n$Mp@Fe#5DqzyLj>WL#;$ zO%gbkqKUHSpR!a{jS{F$2I~-z_>vG2L4-tx)U*%XlaJgPstM}byWd=D_PNb5!?-pa zoV_HpKBEHUeb83dA}vxt^1)zyFoQmxp6{>|g6Z`;9<#n|s!ZhM(gp@8JrdxqB4S6G zJwn1vS+3ZUCBdIpexlix#q<9txFBF9Y}mg)1HFJhM@{_eO&E)R zuT7XJfPF~=obX1fUmi_5(Tcls5eCa>E1pQ3NR^=at#1GWx^*O-pz?|&d1lp_7Mxga z%7+V#02#Z_W6reXZfB#<`Jm>o|92`lqg2?74wcz{HiXWW*hGgjtOpJ}a1A=Yr z6yL`OCVBu06H_f@%+O2ew>L`F!#FuU9upTA2*y01bDGyBLES-c10x=GF0Pj5=A71+D(4Gg1ABXO^|dSXEXh-Df`Hwy1-Ab*iTn>E%P4l~=(|z!f$}*w!%dfL p22Op6B^H9`&MQ3(o12>_Qe;W4A~lmR2QZd}D9NeG7R#6h{1<@k9i;#O diff --git a/vignettes/figures/poweranalysis-effectsizes.png b/vignettes/figures/poweranalysis-effectsizes.png deleted file mode 100644 index 6435daebff4226b9d9004e000cc9542c7b939ca2..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 13945 zcmb`tbxot>F4zMb9K ziT$IZD&m||nN@M(|ssYZD@8cY6~e6E_P}Ffg~(tW>Lbx-vxZk0Y8+s93OGM?t|L!1lol zRmZdZ)^F_4^YYU2Gq0=IJHC0~(~`jDEwa8LJ71BuT|v`8MI?){`$q~;aL*|= zY0j6~33o&JY47qWZQG}LxiWdNirBe0dDKk8i#OZv~8k=if3PvOWno`E6RVf zH+4f(>ACXwmMRX1i@__$moqnK zHRb*A&+{7A+njH=uO$HFYdG!yaFkJ%ZtbC$7mLr0>QPCzHZJOfk&lc z@(0Bgso#(NLT}vroSRXx+)Xw)k44Q`p!>|Z$vz&Ry`nY~;E>(u?dUz1{ zR=S*MxFo-_+qV71tG3L$tkvZJ<$Y)yGA9NM?bGYWr$b%W`Y|X6V9sPU9{buP^mQw; zk-MR5Bf<{~iXhzWt<(KsnN2VWwgTsurG}V?R~KfQ6VJ|gZVhQO~|+up)h4o0%lcAM1Rne|=CKVu6>Q(WdSb!tAWNZ%>m`s!nD3fQ~kx6B~;Zj|Wx8 zrX>ER7!$2Sd8DZObEbVR*N7a=1C!ixtLXYiyp?KvTJ|V{ z5wpIv*1iqTE8tqO*?2$Brw%xmz_~}4w^VhKB!x|u^DS^mQfL}o&AMJJ4LaYeq-VV% z;5$97w%~UKjy#TrWuXA?USimV)jL#dML#rqCYq7Nnr<^=&P=P$9YG`$VwU*3%IXF# z1||=^S;IW&Wc_lXTMiO-ud$iyOS@J%w`^;oixJE7=>mINe>aIWyQ*yxgHV0f&iSISzHBA|E?wB6{3oTU23tPl9+{Hp-JAR$Wye38Lb< z7q6)3kaikr$~UbqU~nj<5|xK5hr-K`4tJY>7WuTbz4(hOkr$AaP#-kpxTeS~k(`E$ zCp&HEi%)t!{TQF&3GHmm?6yg9daZZQV!21SYK;Wv6FB8W?XVn7;oR;TGqHjTUn=bf zjnbX69pA`pzF{w%Q-};Og4Ic{ z0e!AI4|+at&M<7FfK>F@uRbw_+9O-iLO6_3LIwyu)TA(#o`qRZ@;|PU73nNq zRFX$Ki_x)1p>ZfMW|@qB^9;uk;3iZ8=a{Dn7@i-}sb}Slt^7N%Z^=L4UsndOH!rvl zc}0*?!={`nYZ^xeX6=QkMG)YJ3G_`-XlGqq7A=iB zP#?fYtBI|E5DSOBaDY~MmNo?*0QD+o-Py>ny(l z`Pr1_04fFr^RENyI({pxPbs{TLQ)y+fmysv5$0L)=Z}zDLgZvNk=?5vl*D1L^KXgc z(VRtqtf<_KI9QgrQj2-q%fnVbmHdFb59VJ;;{4_WjuV)$h5}jy>#e=bGjL$CfA^kC z8-B<}L*)Jo)7 z0Jb@jWM+DQH}qKR;t|TW;(jz{m*gdQ#3`0UKV913pU4i4#3T|%X#6f~8hOsI@!-ZI zyg|$iPxLR!^xx_8W%IJ4PV?9cr@9t@BX()REIa47xHl5{ap5*0D8**b^UU_{p+()p zn1vDu9V1Co2Ak*dsX*DY5WyT!J8SDu>D7u7?AV_%s3IfpwJ+%oGHbK%^A7U&^2dcS zn)!1Hs}V&Ne~;%KVSS+GfhQ6$hAq~ooV3xf^z5S?B`%7*%-Kc?Vw}UO#og`Uuocg0 z1A1-D>q}A=8HE&$6~pM?qnfBB((GV*B=PV-5C#R6fPXl|bGwY=!`NZudbEB)`w`q( zbHyq7=Iy-jD`EF0=rR5w9k~W8Q@2_V7WFbzDl58JRhQmNN3(yZdI!hldkt}FSj3`| z*eXJcAx3VJ%d~VQ`9QRgP$B1=)b~gj>beoQ>qPx$FuA73t3_bm)mIae5jvXhapX&{ ziKWmuV@gNIp`aFN@Wg~lDT5f2JpLT4WVU17`vJn(G?LA?AkVm=Y zmBMR7t3uy`iN&iS;g4vSF=)f=bvcmdjKXZ8$VK?vPMTq;?1`7pCdPa^=!8y)K!H3o zUvjmf7<5(s&=3Ix32`(^8^quC)^nle5ggr08CcRs@yKSrF^E~U!`Iz*0j`4Ra53lI zkiZBVJyNw>i*%-yUxB2ndz1yS2@?t<{^P+UA$+CAI8YPcacz$B?f$0v3%J+8y#NcW z7q4d%j5V7=t+ua+3hfh1z~dF>C6FN?lv*h3T26knjJhCPVW2<^@MP)S+6 z%$~TE>$pLUv|<~jM`)-p`;Z%xh}1|fIq8J9f;~*Au~`zRs8gPpbsQo*lE{q*RTe_w z*fg&KJSw1*U@S$E zUkIyU#f1jH4NX?a6odx`^VdKKr#o#LD+Rx8z+#p%@abk*^qzR!f(p@Nuy|*%q7as& zaO%>Ztr_gFmS4W(i=o5MpBzxr+~*}&%^`teIBXMvf@o%hU#^ZWB$xebAH&0Bl^pzFsrrNSYqXmzH=5OLHda?Hvuvsw zY;6`S@m(~O(4oZy(J@p-1x=Sd$tHq2JU_tbr3FQUB;LH=1IEb#PuBR_{NLQISUE-CnsaZ41;35pZ&r_^ZWXQZES2tjy*{Vpy?SI zL!Fxy^^(TM#~0@3xjhW{ve7A|d{-^d~ss7;nt9ukLmc=do z$xziE8^gq74Ug=jIA!iJM1_`!Wd6?GTGrF8S>^Cjp=^|hQ z%zM*kJ=aV#7Y*J(nyjsEdj->&;9{`E%KdK{7^L(#g#n85u_9rk9iHUEy@3A5{-}}i zTC1gjt`zGG^B46KQQ5^{jI9!cwVn~N_b8CEI70zU#Z8{kU(H4}!MM!uWPg950@H}3 zc}dvr>}(RTTIJtRWhbX)_M1jtlKuMqh+A9Zfe(wO;7P%w?SJRSZn4?Vrm!On`R*>( z-LypnbbipDuWcCc#0AeBMQ0;=CM$)r(dmhMF>h{&f)fW>vWUbGb~%5z%O}N`C0y=P z^N;mfsb|VpnF74qME~|P?(w`m3J^`U0ZvEKrd!u(qSYx=fTlh>l@d~ym#OzLQ{@H{ zb02i?JHnW6hI+zHA2;3&9ZG6ty~EK4QPN`-$}Fd+?6&nekU652KZv(S>imuym9+;; zLEF@OIdV$*h5s*~$|fVQ8#*Q2(6+?Ep%KHbMabx?0rgGeYl>wPbid+uAj z+AO`#!!K1r&OMtV%x>+@)-dwk2Lp0CZlo{Ynq0Ps=NQJnl+FuCYelX(J0tXy1X;4a za#kX8oRQ})$6sv-+PcjaDkxrlL!T1k}Ya6RW; za$mzzX9^h<)`3o>Zf~-AuL@yYH@SIO5NR^0p?AmmPIk)YxhUxA9u&JdP}V15Wh<8S zc=1HVllaqyqPw0CzjB;uPRO(@N}9 z03Pg1B`DD6xK_Xa(pHwEO01)ahRg(B{&n%m&ngJa3REGaq~&MJX?3eHnx=4Q#T#>; z4?!eFG~m+D&tXL%8O0kS-M$kAVMzbG6mR2%ZkUy|(PCmd@v!|AdLYUzgypM=B8 z9_jjk%UG9G+%^mfHp5GFN0|yT|iqVB(nGZ}zs5gH85gd`46Nx6|c7JiVRZ<#C zxT1W5^LXw|smdn1@0&v7l4mV$yV45z^*zKyD`07^1aRN9@lrEva$v^K-*R~ws*C1? zpv%Y8uF|AN9ve}oRq}bMtY^u9 zft-!!F{{Zqvx!$&vgs(&1T6-ytJcASxXN_VX*d5XQh3;Oqa)Le0JpFEN_x~D6k~pW z9RZ)2^Qgh_5+i!U*y`bi1Y`EJN?NJiQ)*|aCw0=(@1Du_C&P#UAZHcfjM3_ig)d>( z%?q-GRbpg2k`9}RABPZ8%t^y6a^_~+t1M!Qo%tU35w3yJkGYty*jo|6$;qbL+T+-+ zC&8k^!sC+@mpgs0%-kZd|6hRl4+s4JD*pWIu$;Ky!otFuuK>TfV%?*}5cD|MHe|b- zANzl8`9GrDA|`l|jL#Y-_wi-r1k4;@w#~x8+6zZQ2F5;A;J&8hqu#ShT__x#*IMQl4v286WdJIuFdHXC2D>GLCHn8&UcL=s+)xn zq}oiH?LN02jMZv$$8t1YmvX}5OnUPIe^M0(ipEONwrxpw{e2ScI)SokQT|T327a9C zAW;y?En9c%tZYXMiE!BO&I~;(vo`Paeqk$gFY1S%n1Qiuca~=tvV*^k+6gnM?5oG# zuXU4AsG~FXf2hSc;x8V>hSK~-AsypGFJW?0u0cbSyJJxS2vnP*&_v2} zwlmcKdIR#l(WVGBk-q@pS)=Hhr_SmoWz@dM+p{Hzm2%v8Oqk}qeuMz{ehfbQN)O`7 z7xPvMIol4cTA9GSS%0J+v{pKur^%F|#y6LZl@!x|RH#7}v(lH#LmeD8%ZW-+V)ddx zy1TG9p+4}6>#78xXY$a(qeVDr2AL~Kl5EU{)P$o5ODg?r9?&XCC=Qp|nqr+G(;!Td zq6vS^L4*9_dc&^HGP9Jm2SbQWGRi21&O|dEYyg|SOk!Y!QqHhu`Xt{e@w_0 zlwfZSYR~Bh=Q>r?7pWn~NWAL!`l6~U_j9XHt72^sm)GGw@US%y3%hM zEBB;lF!MdxtK*bSSMt(Y#>)*N#IFYlRb6g&9>ckD9G7k*Q{HqTwQU_2Nt~@R-)O6V z@Cizq^e;oY^rBSlnl$_oX!^3o&&#E>U2bm^bPif?z}e*q8fZjv8$@!_{9Ub!2*ij1 zhXY--D9la+<+22h7v9^!_l5-xM!uD7q9U2__ijC^#W|dlMT_%90s&1ayMgfU>?TgO zVzRDpo`$p$J_5=1Md%nMrubgUMO#uI@Hq@?W-HH1V*X{bkB-WZMvnyI;=1>vZ|vjo z;SJw|P)INino4hSkLv?0EwsH(yO+}eFFdHl$vE77ojQ%;zH=WqCu7Dt#hyhLgURx-F~(<*qj-GuCQ;Y(qOvNn#d9Y8a8rl+eg9F9SkhM+ zTGD>BM~XNIJ|rQj{0s8SNGf@Z1!EJ85EE9IbU5@-feC$vzm~6~iQ#9v^-kcU;L1e| zyaQFJS;*4-cm~;|tttHauX_ON9*xa=2z=pHfG-wVB;a)r?ruz>$tQ0mZ2`M zleJF_L74OKk`bQ?P@vRN*Y`55QUt17V_ zB>ffis1#6U2ez170QG+pW?8CD$0jFjKHk6tDO%G%QS84KS6A0y5~-tk-(RN2fkk%u z75WQA=p0;lgaN6+yc>jt9YhAt> z)(5XMH4Ae?Zsu+V;5M7hvpgeDcPALys6}+){-W?bbt`7lDb{H4s|FH&Hwq>xUAZwv z)5ICy&{X=NNi|VdljYS|hD%E`QDWzk!ShT~AlV8){?+|#^=$y+cYJeh$Kx{f-i9nX zjvb+&$9y;jt-isKakdTz;6-nBY|U=jFPq}*c3TFE)Y9{r8~a%2zScN9q$E{gaw2=*cgR)a#l1dtT!7_(zDkEAFO_fzEWlJ~262w1DO0Y0b0FNx6d~ zq)&RoqJU0COihjgqm%8>`R#|U&ydq~qk5<-9-GjoY?1XDm@Hw(MAN9rpvgrMCVjTl zVB|`|OX*)uOr~SidxtG4utsP5 zSw5S}%j@lMV|o9svU1|CG4eHBd#wCAJd%pDC4P$MCF*EpiC`!BHyNyupucSWr$|aX z?^$;3M{aO@{gox|n4?DW)3*mVIBh>=%K!6di7%4i)Yj>+oPWOUXztjLx;txY@b!u6* zMYjvV4N`mBO-=t8yq|a&HD6}!Df*7*pKi0Vw1||R;+E#4Yd1A?y^R-Z#$#aMP%72A zJ>t^(#Uw@U9j#J+Ig-n1V{R>cf8~}Km(CTdpT!yVrCbO37>-GgnJWV)RO@`0Rh$_~ z@*Wmaj6k-RLv;=pMd}_ecL$MJF-xXTcKUU$8j=L-g0O5-LlzXuA`G|M+f_Vq7DWex zT%$8WzL)&hx%G3Y?r8YzlFhGLf1bXyCANp~hT2(=$+da#kv+SUhf<;OBXKnt&8?sh zs3sC4!pk_3y0DP{RW+yCJ)yE!i$dTAD9geA@Z{glu9Z|xyr$az^RO4AS+cSv*Syzj zK`{-54Nl%V#OHx6U7x*y+~GpY#=;OodMseFGCQL#4J8~Dj}u3LL4bpPlX=A5*8#T(o$o995Zf);C)z=c1h>`-4XNvId5c4h=%x-Ka85!D}=1{sKhXInx*%Wo>!UL z(P9_OFN=EH9{u_dYUdT%hJQ2E8w%cyg>AtgvhA`%pI-m1Q(7H6TMGI{hN#11=n@9S{AvA*FQ5vq?%*1W)BEL#iSV+wpqPHmg|rEWIA}m4#k1W# za?_FYbvqn;4j?LnT8;^GuFYYxFL>$ilLOTHP;ge#W1LLnKBNFU$I&8KZDT&GMRT&ApqUtMU;5uA|Vi&-8z90|^0QyId z4PolUQZQdyJCOC9I=&IB8aT$x=oFBhzr!%i=LeE$yLsGh33nF>>c!vg&nAD?0KaAc zy9uqvg@PP`Wwewo8Y5lxuGg3!qV5t~ar&4GGbM}kf1ku>BESvZ|7PDy^r;N8jfeNO zFz9=p>id_A2$-=_Fxx-YtCh@Qt7bUvz7%=d8sBEUy*{5{gc80x>_op{+~11M4`pq7 zSItjv3iE$RZNDD~WKDY6fWqZ2+&T=?=^=z+^G+#WQeLk#M9boa!+yzk-u>Z|Nx=(G zvHa1oGF}ia5eFoLt;-))8f7axSqCC@$3z(eC+A^_x2)d%?*p3@9|W8z&%@;+6-*?! zA5Zhehyp6CK-LAsyv`iTvMZAtwH}fDTA(Tp@5Q)j-)duo@BS#lvh2TlUXL9KjiB?7 zXLq-~3NPBMmtt(oWl!teouUgj+cH@DZnm5p*rmO(>~wefNy|M|(69{Peqi$!>6Eme z!&BI7JO%ryVAi{imE+cF1hR^I&-?_fx=mz?l)#KI^tGl`sETHGCCXbN>fL~5H{mKr zw7Fevj-TcL0tP#0wm|Qzt6#>3RS85K&uKx^_O1<~UL^BNsS=k~#_*WGHey zu2*z&3X?xIPZIEr_*^?R#f{-uK@`8p)I5V<|v*$QKczOuNT236K{asNMWnetV zm{0Z_6bX8V+_R5tO3Ea5nTc557g%C4MqrgErVgh9+S6(T3X~LysO3XO)6d$`2<9)u zHFm;M7oFWCN7)Dv)Mxfhcc%|a`2a%sM4s0Vviz(YQ$U-Q<#p3 zEz!R@vHa&-nAFIY;R-kUKXVODEx+z>Q&WQs(`AU18)`c6TR7fVcVgMZyJ9j(W!DXA zOz2DL5(DyidlMycK5j!ER0#!2R5C8`^_zKtVw8+5$F}Xdz+j)K!+VM*KJiw3cRc64 zl(t<(nUlFSWYQe}V zDe`z2I_#2vY|T&9Ij~CM_S;V;eNwqiO{hVA(va_4+!(D6sCy=XyTZ0Z$)_=&T`W1i=aaA^iG_gW z(_&5tHiwT*z-8TjiwUWxd9wHxf?Qsuch5$nWh?k^s)%b4hb({-Q=rwEnN6l?X<$Jo zrTrT8(dfug(1Vwo`9RezTmiZ&($R3Uh^w*1PjI^5&xpv~X0qB-$az!(c6s*-)Qc_| z9Wv^e0xB}JlI9&9S`JXc_U~Ooz23ioM*ELjy%T!)lZ`&kuWbsPcgp=0zP+x1FKP?G z*nA19j}xic95VH|`9aVe_~7S)g$(9={m&xBf06_;_KhctlZ1nV6D3jNxtt6Q7~Zq6 zvT|yxF%X4zvC>y@u?mS)h$s6d<>*-7-QE3J;mEky92TL&Jlfxfg$f913Tf|(n`mcO z5EpEyuTM-$`rH=O;Uu-4Ze2!obTV_!78Vv_V!?TNJL3n6Er;xCEr+AWyJ949d3nU4 z{rQIi;D{p9`ThrXM-{R7)8;M&H_~ThH`0ka5}||y zai=4TPa!|&(w;(ofd2V?l{KYyXirarRc^`A(c&4GqoL3V?LzS3oXvEHH>1-C&y!X@ zg_~ucnW+TGm{)Il8o5g2-DAFAH?dPR_CeDS^wqdJ=+DE^1qx?aQKx2+!w9P97x>zW z>gZ2LLukSc%;Sq*oSQ616UC4K=@pK(xIS(tUa7<~IWt=iWgLnIFSc`&q^{0qclWkt zUvV9E&a$iBP1>6RGk1{DY!g6rLz{3KCr&bdK*d{0KsmTXnHE!RXETU`jBH6Q4XCl_ z$mP;BH8Ek)f^ROhVHrPl{&hDd=Oiy`Qpj3jq3RwIFInvPek$~rJ&>}#<)@b9 zm%(f#_WisK(ym%Zt}o5|S4hI*!vfJXu5IJ24|n;etECVz!(}KMOt4Cy%&8hiD@mY$ zngWj2ys62lo|qV$gw^A&empMLBNtYi-sv)_xS>$f{<$i%ELiHi$&GlU04*3LD=k*l zXm$%B&>e;Oai|?NU0=qPO9r&6%DpoX-lewZn{iQC{BTl));0b;aoYLeR2|i8cekOh zzVFA!9_JWdr>-;qC`oq`1&CrYtkaQ;qzWhQrraya!%NLQK2~GrR_&k;JG!|7;I+^v1_vJS-+{Mivs^F=^LPOhnZCF)Cb1|}t4~)Twmo5F{ z^nFXoCBZ?=TUR%;tBWtR|LI3Hp65BM$!}4QJ#kGFlcJK6iu(H5aTQ9hZtebs^bgrI z6Rk2;95gf|8=E&r;(5fTa@)z5{pYBZ63KvozVvby^U8wLhf!#B_EPr3+bU9T=-(@k|5SN5Zk_S*@$EcjkZGF9 z^wiWl*KUYd!W)~CrW@&$dsO;5Iy_ulZ5N?2dqxM%gZ0)zLPDmd#eziUt$3%4oyDh% zyeok8z~7n~U(lAD<=13?!h`Yu7we7xJ!SfjYGqY0coP3QZ~aH=dCaDl-Q2&Cv5L8W z^YkJ;l}^HE>b38DUmBLm9DaHbvXb2a4Z4`_q0b-kNO;e&0{zZbUeD@8R zkeBdV0&($tq_u9SFSC0qeoo@1HoMz_+*e`qm(=$!|AgN;q)TwG0plrK4g8nkb!dr% zeV#|c`I-db_rO0^U)jfIm7_14(YCn9^2R7%4(a*h%Jz8YOEL(?Je~J$vaIQQ?mLbi zg|X|HHC$ia%3b#rwvd=O8<-D!+0wSNM$CoM)@ff9$Q?2dFJ9dnsj-OJd|LNT8J9Lh zS6z_df#AoJ176v6J$;})gG*HCswe<}P!8?#{W>F#o z$$XJvN#-6t{OgTA*-FZ5Mz257$}g}eC`ov~y5MsS$)60eqT7TbpU4`Eiybka*8{iF zW?P|6;2du(#wKR-d#{wH`c{>}`GjDJxfv;Q;xMfVPP(5Kj+7{hNH9-&mb##G@UZnd zE1wp=a#ibYChWLE|o>s@TY8BVvCd@t!nQ1#ka$>J32cmm!n@BOps6Q!_S=p zt>ZmHJka$9XX=_bz2YQ_$%tQnHMdtI;(hbySZtjnRrUC><^&%ouPdLjNdHSLj&f>v z;Y0ZJ&aqka8tdctw}l*c!$GA`jhfek3D%SGB|pzPKMsFk&~Ojz~JWo(F>5skMx(5Z0p!J zA_ONEwk|OfPpE_!wzF($u6Ixym)rYFz7&I2olTpnC?Y}eJ?*y}6sse;{U zGW#93{}FpbB8IH>S)L%evwonoR)-i>!6~lnW&W}|V_7Xq6c!cFKe?Q;_Cb|Nbyk;EZwLG1_EWA^C*0xnEA~&S#4{BLBu} zvz#?LG4#&>|B{U1BhT!aONU{5iVElh^VBu2WgToP&KLUK(`_|=0!VS&aBKIrHN|1u zE*IGBx~i_OsyZ4ko{j@!x%J##7PAhSm&-8;g{fa-hgmAz9*q1ES6VMD@4e`sILup|8`g%gweWNAV@ zjOo0F+qpANfc2>t)t3hkdTz=5;1bRc`h6X^d2%iV2AdUEu9VuRvzNMNJW;C0%yvg* zK=3-P6_(w#LL%S}|Ff8k?`^pekYk75^_?g=^is>0j8{#zp_0lAwA)m2fl zV>MW7-}Nk?)FDRfa9Juz&20T^7=lSbrdAg=DlJ+0vq$%q^Gs1m)Iy~8dB>BII zKbJji3=kg$+{QionRIYezgmm~6Ks-x&+`DBEDhiJurvzh0aHU5PDgZWtzNYp3HbIb zt^0#_WC2n-k9M1_pg(X5a{1g3mi8eY{Z&?b*BhSYDgX)g0C|sODpYa`V^a2ROB-dc zdNPo^As4M3$hcXLCpqrTd(3Yo%wW_twr*@(g*Lxz$CEpqnn<%NJS#d$Wh& z$b_4)M}?_nv|Is-#3=a_lxN*6;KT#ynF_Qfnij|029GX`Eosyf`8>oyC?<<7Ib2x8 zg^R=eO2kw@NV)XF_vk!y*9efp-}8Wb%HO2pHJx&LS5xFE`4v2~W97$PPIpQvjHEeS zWN5wNhzlzVDx`D2rJGtN?0qW=TU*!&Rv;O`aJysWdFE|<+d|;bMxTa3+Z;`OLLv?z zgB7K6&A59@Wnlc+k)o%C;}e7>c6YbkXjpFN${1PF4k;!t`o|QjkWL>r-UAQ4tf4W zyJndKd%LD0_zX$>(puRyxH1}*e@4dWbwQaBZudlwsW$#2QymO3FHhvd%rmBHHK?{u z9wt2a@vVQ(>OSQC3e+i-?0j|rFZ8?ct@J?07sqt@Z`0TA;rOlOsIxpR9B)>(;QEI* z*SYc?7_xl2p_(N8)%_{9dOJm8 z-R&-3Qw#sH=j2I*%Nm-f#ct?%tP;Yu$M^*;Ar{`rOxNW!gYhn(TeLcO_s9MSUOTNCJfmvxj68<|z=G;)7&4v8;F%nm=;_H8(BI8{y z|0>{**R#o`Bqyt@s(#18>DER1S450t&?ozbjf3O(1COdvmTo+rtgN~^J0W4NcKUyE zCPAPw`X@$8^${l`xa=fwog>XxVNZTu^)gZ@P>tY|=H>jKbDQ${uX>RFC3^Qihd*<~ z&1NxvM@Im}#f-j=6+88X`u`u}nw?&$-EHlbqkU)!H#Eg$<|ryz_X zHup;0sKuZ+sb5iO=;I^<1Nz3sX%iC@KOte2t3a`(W%k)`5e{u`pL=Z{m>`U>yC zS+v7CE`g@6zA|2slagZfVupVDp#Jal$4re`)~8a25m9b$2lwq;Jg9u)sKTKwvt8TF z^ssRaNpNFR8iX9L*?e88ju7aX71!mB<@v(E=zHMEB@%LH2gLVl?@C&1$%W%3C=u4Z z-c3*|7S<8RVP%%7vK@0c?;vm@ zzJl=3&~jp9&rVLpjwPYXD?S+VFA+JABzw82W#2t^5b-B%mr1#AqlhD+7+K ziO|OD$;rui32JtPOV@BmD|K#-@dmA|tSBidm)^k8+SrEv`>6Gf%=L0A*Tymj`0RWI OlM<5`trq?n@IL@=8#w_0 diff --git a/vignettes/figures/poweranalysis-list-1.png b/vignettes/figures/poweranalysis-list-1.png deleted file mode 100644 index 8d30a982ecca6cf7dddbc249da87ea743c7088f8..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 17491 zcmch9byQSc`0gkOC@Co*4bq{~J#>R~qjYz-ARyf!-CfcRD%}mzA`B@Y4MW|{_x)dtMkX2eWroJP;#G>f-j~#Wh@p1BCN-7%mQZOi61};@&Ao=3W4B;WFteexe)~* zkRFQdM-Vy;C?-VM0mTyn2@@ShfGEBE|MS-1Hq`AGABB~al*kVmAdr@nu&}U-3L8w4 zw&W+bJ>dkHFS&p1?lK&TfWN6YJD<*!XURME&LeeU^9%F9hSw|(V(SE<*Uo}NBEGvngy{6(%XFK<1HgpY`bNa_U% zM0gdY2khQwl+7HlAk~Q;Z6O?7nc;*YN2X=W>kD$9&;ix$OZTE~Y6I#k283ASvAR^5Ku^CVF>V#*a16(J)dpIqI{x;8oQ zOpXcNFIlhGnvE?jE&Xl6fY6oS@MA!?*_V%xEt2Ap+LM##_>?orQOL-$lCu17cgw0Q zEiFB3SRnoi*eGIzB|TN8E@?J%A9nheve?5GALl4$2{LDOf@QC$s7RCrruOD((C>0H zm?9}&LdS4zdF$bv#>qu_PUI?w2J_2be2P)9=V32_b%x0?C2eduW(v~#CK`O87}y;{ z&)VjI+AU$EmbN%JPVWEpst#~{_GT!5aRC^zj<9d>?le#^6@YwlGsT7o*K?`fWlq ziJ_3+k07}6G_B_rjt<(Ep&xTLzg-M_-@N>s>UgmKH5WB@p=(RCvR%T+vcI(#qf3Pg z0zpjfQk173kYb%0e~(6J%Hvs1n^8$g=kr~#wl#-N&+Shi5>y8zab=292b}$X49L)p-s~Vk|JMF)YK)RXbb-gul`ML>o_-yGJqgKLS>ya`Q-3yx zc3wX|z4vi}4*~{}DQYOBplbhP;rLuWXp?i?dP1^mdin(-6bsuy{+MR8-UrQxG0FINLMK^-e>S}wvaK2{`(+MzOlu~4rm!~gTM_nN{eC@V| z<#NVFNcVjDh%~({>@Fv|EP9@HYg-#BgA^7`5S`|GmCeotS5wcf&`Fj#Bm(hGNmnm} zjk$pO%tBf(BfB$gCqm0sTl;>vO1x^QsjrTJcJo=iBEz#ZoAUB_rx2Eh zPsR(AduFP|9_N3#Xjz$`afdT;+3Yt~W}yt$@NnHNDkbFbxmpk$)|)!W+Tj}u(v9Fr zcQc&{j&$sOFkIZBazlL>B&@FI=hVjU;~Gmd0wW8ao5VVo+h=RfmKl@$Cs@! z_)12Dubwc+%|m>pV9&-rY26VorhBsSjMh;o(8L1khG%NHxhqeKx+GEDL7Wv^)+q?P zx~OE?yJ!soohkJ|l*;^`%dvOx<9e87)46AF@UFI=hr#k=Fn+tH5$Zs$M%DE^@#W<_ zG4T+Jdg#|oxBCmO3vCTxkz9wZXSR{?7h6kjkOkH!HZkrU&!<&QI@Tr2>(46c@nBQ6 zAdhVOq&CFVHGDvSX^hWa(K#$2-sX5vk>|H+)h=Vi*%>jFS{U#4QFFs&)~%P!}{#-HNs=qGCg2E0QRunwG0fAvMdynon_4ghj4T%WZBTOy9 zmXXcoX1bF%y72}4dg)yZQ!cfenH)$4{=nkhQs^#|AlZ#p^CEEyb^@#S&2#X);J~7t znk+)k&5C{cxX)7z;p<`gOU%AdtWVJeCt%T;>NS_|NpYWoEQ>2{get8TJQ(vKX-McO ze@boTmWoneTx~csbwgJB;83TseR82)eP`oV!nfDSwj?d*Nf7Pf8~UMZL`cw#HtK*I zPQsRbC0X2xRsE8E+AL*#LHtG96`@;r?aX$>k^1OfutJO%m2|W4ID)@--GWFB^O;99 zFkr^Yib-O!$zy#haXlB20ok1mpD&>mS&2im2z?A=8+xw_d`}?49bC-RSxM6~9Cj4* zNTE%e19%7fM$R^(xBf12PIJA7H*Y;y2WCwyBO0Ccg{D_^RT_&{MC}3rym-TIN5OMl zfggAH>N)4%gDlvJV4>}n?eTw%7FODUx76y{BRq~Y$qDJ}h}G85`&-rQ-|e9#h>S|~;7JLpT3(Y9Aydad1TeS*@x zak~tV&G;>mj+Az;SZ=9`fEvoO64!rfrkngpym%ulbRHh`5D0(pL?6 zBP47dc0#~UozqkDc-4-G>mmR`Dol%k*^<};VhI|cBr#tc_F5LI9_=G zN!z8a4Kdb%V#;a0X~Zt&AHU0y;Ch!-<}?+*Z~FXtVd=wi%u_VEmDY!Fm@)lRAD-a@$Rd)Ms80G{ z7p=iVT){lFV((4(+tUqaJ4gL)Q5G*S($0G}+82S*X1Ax-$E4%_nhf=>B6v!cuqo(? zUzFxP+VVz`-Fnl%!mW>Cn203dQ#P_cr*nCbG2^jEVzoHy0e;m;L+v!u&}Yh_yw=5x(hwiRiWs=Z)aUjj$`MfE^BuEcYJS7u_8!JNQ&`K~mVc%_h29 z6T%QOOTPWcpByE(w3G!V?I59D!VrJJ`L&&ynwUdjg)DK4xWp=w)9t6Aci1C}lCaxQ zH;-2Paq1yO){@hAy`!;VU|qAP^O>oqret~y2OwNi=Z!H5aSAJkcxK7R9- zXc@&Kc~6^r)MBsoO(gcB?#3-;nIbC}oa`PgfaOqG;`D<7JU@ont*^>k}j@Po-CtKUUPDvi%GybiEi@B&DMLs5vt2zN}RqxIV@D0qhC zWn0^sd-LNj7K2g}T{sS2H2_;74w27)e!syj#2AI+;V)tK^;J;mh09@z8zh4wE8DDg z9tjD_k&sCEskDxipghZ_qa`vLyOkfRbcfR4uS|y$(B8Znen#e`s>Gp=iMPbGhsxNo z*>DH7ajW;q~;)XLnbII*v**>JkoD_`hvf z?cuwiF+{`I#vr4#_zN!T->I}3+_A`Ck`N-c$c$fTx~=O#9AloJe*gac$&)9n`fV@R z-uo98ZhrfSV7JnCHN@H}_l4~vUe&xjB3%~qNErA!EBR+Y5yXE*A@xveY!Dr7 z(Uu~mhq+xV#-ob670N_pwZ^?_(UkVlV=?}sGgLp>(T=Qaq$zKmXUuYnB-OI@j?Mo^ z+#+(}= z$KSPS&WgFYb@Mxa*N7cv=|hXAeK+tWBBGA9q00J7MWp(Ro`wxaPnumpmBzprug{E> zXj)G0@yhNUKqm`4@S`dbNw%6ZHOmOv5R7GeJ`QG^z8mo{Cr-LH*wK2QSagmwbzCN& zrv?gQ!0zs@DKQto@5;)@0Lfz`=H%sx7ESdSI;g27p0@rBU{07nhP(Kz45gZ-;Gyx3 z%&V=g#P+-|?!PIq*6)dIJ8flsD~4U&T3u1q_3a{}g73AbsH-<@rad4SNxoB&kW&s4ck|!w$1IC6Xs4K)%a1`r5T=I^gOH1;Lt*Gzu9h%QY212 zAIx!j*(9dEC@Sa>>k9XP2QEB432l55rCQWzmz0TVvkJ{wc(EYGwlsRbNQ zN(v>Ui^t*jr?RrLh6c{)zM!tfY(Gqb-}x52~de~NingFtt~6_wyUhr9zzdLPfvIE zpY!vvY`p%t7PUe7nv~KNOks?kv6`ujSmABMaAsE$Sh3mCSq`yGmXjT+1)Yr9RmG1j z?L=fksGW%k9w8y&%a=>eMsjiyIXM)-+vq-TGE=XTW#?Vb8ij+%dm-Zpa+H~a42jk& zkl62Fe@aRg1d_Q5vaD#Rv2VYj@7_u{553N51kA1L#}Cud^k$ny&YglZU_ise!$5iX z`_~>@0y(D2tue+ry{!+gJ$vGFtm(O|t|X6h-^MLEz@o$=-7yOLM|D}+J%_#;d%R*TPnq#w$+DeB< zzAXXV9J(iE+NiKX{8Yxk-j>vsZg8BWb(-89H7CH29RUh5bc@tNz-G_MGgR5-Ui>)9 z&`bJjHQkBu)*e=BY{Rz16Eo2pCa?F$E1$FQ`r2K@D2u1E+7y;oYPXOAR#2drV zF-%mIEZ zPEz$?bpVGJde{C=Da&LEF&^d(I1?LhuA7ZLpMI6l#!pI+(ZlS*Ree_LsKsNR&Okrc z{XZ#5gH^kok|~O(zq&*7&2$kBp+!MysdFRL)QJFnw3MYaDXZqpvw=m$sIA}xo^!XE z+LAv*MK`p$bZO_KUsHKuxX0|!H1}*DAPe)#!a|BOi-GtJN(+&n(SX z3tio=b&m79q7l46VW)C9zLSXes(`C-z8Og$V1dv*f?^IvjS=J*by!eXtPd+Y(f(%C z*Jbi!*DW{%Va7%D72AeG(8i%xg^(q;dn(IyP>z{|FS;-xil>q?fIyauZ%{J^r!2#q zcZl-7oExBJ87@dl>Ia3o?ywrx(s;O&+!^66l z)?WGaec>zTN*vp0kIm)}ak`B;)i0arrCYKJIta){E+8Mdpp_Q)=t-+EPLhgKp=fw`Joq=k|4?48U2eT0VWIZ|Q%mA2PabhlZ0F3i-mo#l=aMJq z6j_oGnOsQMClAG4dn!HwO-msWKkMsr5Bb`Y+T%9|dCaTI#L|cLAor;>I&oe7& zUBP>l_%Mo|fQ%l43B_zrdlotSp5c8`F{kb8GvzPg6xh->a2wm{ z*LWQA|L`vj4+2CPpp>*P=5!ivJ8O47EgznKLj)y$GwuB`I;1U}lKKbI%5CjZ@%pY$ z2;rE}xA$88t&~cZD4yFr82U}|SwqXUreO>j3UYC796+J@^yR*V;k;vUY_c6D9{R=}}Zj*-jQE6NcNwp3cYe)H$LB~PfkU0sRp((k!vLDkrj zVe;IcJ8Grp;F*L{oNPM3*7$QAsdS~Z!t^kNoxq)a&Tm}v;`CbijKh{xGC}YN<`A>zNrgeK@Dav=Zgcvk)vx_K?C*s)cD_j7Kw0qSh4vXUOzo+#7g%Ag*utBG82V!w zkDYe)e^INJucvf@Vl?YxjByum4-VHG=ZYNt%QIT2Bca~6(XtjFInSz@e;L5}7=#W9 z+yi4#Q6KMFw*fOMwcj>8fHuACdS%JV$B%%bQ&s|!5ttpK|0^6vqlfY+nG89G-xm0t z)eO_J6e&q|EBQ8b!sl)suUhOFrhKfdPl^2(dsJ22r)bs<=nS_&;+hOb+I|Y0OxG~f zc<*S40c{~!R!YXhfuxFIGavX!PtkJ_FsA*pk)O~cNj1D|EuRRfJ~P0PexabLri|y( z#`%`$Li?j9)@kCIcoDUWgI1keO%~A zfdke3d~a@Sc-VTTR1H8+&$C^%4jCPB0sjrbx_1|BSR>M%bi76$>#Qv{hX>e)}x}f_{-$o%u9Ed1rhy!P#Q@H8Fqg@ z*&4$^T!X<}Zs9IFy@0>yXy@YLwozb(a^7+MSgN^J>F8i9I4y$F^bwRUV$?6#>$v?< z&gZ8ieq(yN>UV#eFCE`;d#?KDXFR=$elk^jM8E( z)0sD8CLlGneARN>W*0F4{hAVv$+n|BDBIoEE%fX>V(R7JS<#E$@F?ecL5QUV=_w$j zcXxNl7%$DuUN$0Ujjh&OCCA6dgXN5h!iXOLly9lpNK#Z()D8VnyOfPjSFleq9P^DH zuZQs#W}Iu;FRRsH4U42KaqaSUOZ?;3^S|@FnI}xMV%t~00^K2Yu?{<%EA3vOBn0U6 zo40RO-g%rPlhe=?Oc{Op^vRw(9fww-sinoz%Id_u4M4|0WK2+d`W-^%yM6j0hwJyu zjLp28$xoEBAi<13yx;tM8;^f$Sk4}%RPig$8B23nwvLUvW=;5*JXQkb2O;}k!WU7` zpFfYy%Blj;_BQT+;ANLX;p|`fbF(%A_B}qIU;zpR-aa2>UY(9^RqHJv?sU0z;JNks*STbgY|Xy|Kp_CN6NIgK%eZ6QTxHx6CA z@LF^lt;A$kSwt74DK|Fxzd!MW`+!dm4h~`pUj70O3`lujG}&s6$)*&XYF2q+^j$M%T+^5!a5jYlD(`w4EFPZNl8KQkxgc?`SWh-X;%oQ-_@~+s;a8KK55#BX|*Q!%h~yP;nWdY zy7I5t<3^IEU7kTxTS;YoRh5C}V?USqi?brz{q@OPn^8zYNJMsYXsE~8ZX$aSAzJTj zg-)yQqY#CnYdGBXhZrN@>R$CG53~NL!K&i4cFIF9{!c_ zuk(c5{{pq)*Wa}+Ss59@yUX=(0@mLYQrn+u7*;ewDz7hj5Tnf{2W6?-LbiD3&aKc> zEbCuC%lP!DB{m}ap&kU@&!XS94TG5&8rHb%sWUP%9y12&%cmZ9;JgeBZmn;2vRPmT z3rd8MnPgQ}Y`z_*MCz{$1fU|ttn;IztL?n#{wk#6oP?pptJOW6SG-6qjj_jIff(;@ zbZ5qAnKsZw=MvJ7AqkPd=v@E&jH8i-pY3t^-nbhWtiCqtHMg>gHy}J!4zfPr3bB)a zdT_|qe?`*Dfot-$%MA-Vbf7b;lxQu_2_hf`_?@IADq=u>etxUl;oa$!A}Rrkvx`e) zcsNxj_qNONeB!;^#_05~M;(Fb+KZC?qh^wSuxn1x%=X{a5{a35KnA5H#=!s^8yjGy zfmeO{gh)k21x9^%Xvx&$?<&{Pb~G^Ywr8XDc6*N4=mCuu+>sQ`{Ez|~s_g>wR|L%3 z>~053z+{LC31bcLPkB9HiC$d?a;T)g-YWIh3F~T%w7b;3q8Ayv7Ycss7H>f6|0e$V zse$j6iHOLLL`Dr#0Z;bdcC)jy8wAMh;&A@uMwGVtB_{7Kgelx%79QBwC@uO>O*v418l)pnJByXVEha#K@N{vSx_{D1ZW`%!UH#2NvdcbNLz+;6n3jYLrDq^BiL7{R<~i zWqd7zBmjMn+(t0rlM^5py?Yn?@#FVnn5GTk zUF=N_+n?*p0xF`e>nImaUDAo|2ON+K-^GU)hcs z5yVf}`0lsvX;=s~%TMD3B6GL;?a4 zSlSp`ySF^H6eaw+FMDK0l7qm+JQFveS(%x4r#mVH1j*y$O3k>4&$d_UPu|Ui6JU74 z-t4`^M|!mFvhoam*l~TZdVkj#87XgTdypdE* zF9MHb1W3lw?8wjMR=4}(Ayyt99-ubOH#-%zSw0pYS4w#IlJjCBXnhNDiXd1)auDHE z-|mSI6#D&iXXi7wFb!|7NMPqt`{5r%Tx}X-V18z`}3`<1Vs(^MIyrfRu;&1T;rrJWh}qvsT5qB z37@Ou6^h~ZcuxN8lMTxTHmQyEh@s@nN*$gRWdp^Pf=9v{?Rck5_*TEWLnr5Wd3htN zo(2fF5|>&wv-QvP?P#!?SZnTBjs8I3gsA>iAEz2g3@;CYRtm~>deY#~V+zwWVO8Z@ z0vEVns9fW&+4(`9Ojana@6q5;P(>&!*#Ubb%q23;nBj+yq(!pg{2@j*)MBnmaItN0 zObioM|0R7N5qYp7c2e10XVAeY8cEyn#J&_MAO+czLv&KML#|-6KLqIhR(TsamyFw6ti$13pb8hKW%Zx19KV z&pdLLPdY0!x4F2`k-bvkI-p$|xn*#EqfF|5-2Y|baG^eYY^$iC0DyQxVqzS`4`yZn z8HxTFml2~}6W||fZZNRwS1oJ6N8)ig@ty3_;1fchRyB%KCx`T-5<*u&Dgkg5fLw=_ zHV?1!KTlCml-|92{rWY<2XmTtX|CZUcLkuf30q*aVL@~J?fGL$Qe4Ud0)wt_z_YW- zF)^coNXkY@8BhnMuVT3tyslz>fy8M_VfLb>(B{C8^39rs<3yz*!ZkVUQ36s4myx`@ ze3fpq=c2h@Vu(<_)^`@0>8}(JI_|3XDj6tfoqhNS>b&CexOrX7 z!-e%IuQi+x!UqM)0>7YnVkRO(!Xo}; zZymX7Yirl3lO6;ot!Te6o+1$`F#6!LUG=5Sdejy~CTyy81Ql;Vzqv|Ks89fMB=8cs zS5p%c4glSwqoY$ttb|Md1BP9r@n-DHIhQ9$TI=%Y{r>*QXiEooD|%QPLP97RHg?>X zFYdt8e*ZQEZB^>(uDjDEr>CcQjOsCLo~&wVu4V7%e!`a|0r=fTE{|uqpQgBXJD)B4 zF$Z|Pasd?>hX`oSl$4YpgcB2!e$`|G#*K-I$=B*CfLm;xj~ZB<%9~Qft2oEGy9DhJ zbSld&_Z*{D*=8`lVMd0COGu3CXla38oL;Vi|Je=Y6$}3{Jt*4>K&uW5+9ZXS!fJ7O zvG^c@KQ5RwK0c?@=CI9TL-RkFT0=v_%+yp}RrOOyNIaWo)!(rn zf2kiohynq8D-dBUL>{P+_vPPYRs#ufaTp9%J#UR4Uhll4Y-eZ3TS?LgydGozb`PB; zq?6D1nKCJaDE8EyCPU%k?2N{&d__dHYfblRa~bSie^gc_$24l^9d+?u$YTh@_bqBz zcE-aW&f_(npyyU4J#oENf(XAx@l=);3z(}GYQH+2>g8kiyhy)iRnW(K+5;RR<|$M$ zDT)a^V%EL8I8&^5GkbO`1_}f>Fq>911Ru#l2r%=rOA|b#{UI9gesjEl4l@@Jv(9m3 zsdb|CCb#oifCSKb^c5m3fCA4v2G5R)Sw?iRw-Ojm6F2f98E*c%kwrw*4`PlG&~fcz z`|n57qV*@IKiF!0PC)i=pxACzDI)myUOW9XBm(vSa_>j}KucK8V?+(C%aUT!_oMsK zEw@)YzwTv@0?8&t^wDr}co^-oSlXS}z_hN_K2ttF#2FIMfl6(-(uJCCbzK*XsAJPI z6`FLkPYZ}NX&77M^sTcg7rQJ3QV@`Rn7>e`^QW`HiaVxY79+;cuc@2S zdrLx(2_Xs2K4iNK_exwdaQ%eE#GIIx^+U zbaV|lLir!|5MgN)xa&@D5OkqRf&8cYuekW|iQ{kYHX=|UpuBAt_*rALxuL3qyg=t+ zoh=6WF1WNg3F$EhWts4!iMgT%j0am|NHtVdr=5@`#~Wo@*ieM7JHAg>2wa%A$+Wq5HqYOIMW@gT&6oo2EN@8tw0f$d9K}1BvLUaJ_e{L80fBDMV-oi=sUgV25)!*14 zS9(U(r0faEMVUb8I#@d{e*<{%;ll?ii3mD6x}P0Btwlv!08qEWex042Sz7MzYd**) z0pz;6y5M$`%y}1dCg~HXjHohx+WNk5m0SNapau1F!5G~+7SHua_+~NaG5^{EbOO3G zTRqQ8qoY9+pbu!i^u6Bava#6*gX18+)6=`XyFMg-@xtBHv#_AxIU)siXcDV|t?|QE z_fV99=H}(CdL0UYX36c`v(VQUV z3&TJxo5!fv^(zZW^4pC8+%+mNR?zqSJ5`HcGZeBrFfvl#&|upz(cAlqmNtYO1!Vl4 zsiLydQrm^PlHy`IKE6fJ|Jt>dUs$NEqobjw#>2}S91_yn+8Ry75vEWC=noty3;d+f zI1s}k2;Vm8vOuwz%Xa5$C9n|HswPehmKb^2GssZ_ zvS;|4l}|RpT1MV4I}CY(h>JmA_S?s0yX6qEFMG}QxbjK1+t=!93lE--uV2T%e}}^L zcJPq`KLDDbt-ZUy-)=k*2V@cdt~DmjukR06+JSN^EiG+pYv;S8tEUHQs80jf9;Bjo z6evHyH84Q`>eVJ_%A9@2 zC8xvZ+S0<}IU=;EQ#vzAEq46Z$JDp*U1UG@#azBMp%$ZL2C2bhM-Ky%mV>>+PYKB8 zofCPIeZ9S#Fc`$+Kt^I+ro;|?umTGUEltfP_oLr{uXSS@3xpd%lhyZ`-rvxnJV|5<8wT5bU!t9Z-F2_%<^ znVEL)t2cq)$x$fD$sdfOx3@PoHn#KjoEVBVl*BwWK5p;e;Na@&>gJXuG28AutV1*Olp`gNKyT7`JK!tP0$aro=+FQE$mm_63Bp!iqv%5evY;6s1rsw6Yd z3pYnJ0Shm*oyodMiP0GzZ=~$x(vk%V%PML6Tbl())<^0JoyQPz@s$GNojh^*`txjM zx15sFGNLoJPYGkpW`16$qjftEkO<*TfFRIL{qFDJa5!k5uxjhkH87|uDw6!M?Re2v ze6yJ6W;*6+mre}u*@l0_`~e6M2#+6wz?Gbk05l$5QPHkgD#alLjBaMcye_j9lnAEM+64hW>MTPOo3($!6`o2$*t)CU<8 zXa#OAvFhvttf+oBJKrZUCDH2YW5Apt#sZRd78VZ-zL!-^P0h#0r@p>^fG|TY+5kTj zh!;DOnFuz+Fg;WV1loUupt7^G1EPqxZ+IcQ-}UXq>VtEb5{HL{Az_j(brra*%uhwpYE1~*kGnCSoHyOX@>y$U|=;lv>yE+V8Q}(@dqfDeIv> zR;zDKT)N?%v2Q{1u1!=TX!$21(pFdBJUCcswv-nB@0J&HsZQf+O%Q-U-W|ce+KXdA;UdM4Ud}6?TPmU2rAIJ$&pHoX4GguuNdjO=S$PuRovq;%(NUSz z4B_4aVn)WY{{DVbVk1LCG<0<77wubOMFK*82Ro@SBd}ZTJ%u?qpzXa={f@K_z!Kl< zWw%vn120d{&5aF|pdT!Fb4EZI2nh-rN#}6_-Aj|QTr)E>DJdyU<+cY!`_W7F<-s1F3f z9c_(gpCf95G0E(l)2o*}XUO|05htKKM0cAJ7l~AM-TZ4(z6{7f9pMSc*-6J!Ig#{=SYlW6XBmR3wze#R-(PTAzXaLya)478mNKb5mR-fecMic*#w5O|U9qj+)9LUF6>0XOfXb z;#i+bOF=t=hD!VqvgmX2?N!HrH6sPEBjVLJ>XX;oM+aH4pT$#c?>v1O`Fx52HZd7W z5|@ zH<&PAkFA^SC!ptfD6J^*ZwVj3vS7$JQd z{AP#xkqO9KbXM2-ofK^GE-K%oP|gUdz3x(qpK?; zJsqewg$fxU(7ZZy)Gmm4-MDoc8FsuNkR=BNVj*$0rsJ0D`4QDoAI56y%h(Ae)<35? zKdsLJQ~_m%w6wG#<2PK^KgT0oTv-cRoolZfiC?tYpd5FykjN5Mao`FMaKqV@cr=$oA*AMTB zOIjV2Vzhz7)YpKP^C!W>hjXL`cGz_ z7_{?xj(DaGUM2K2&W!>xUfXSWG_^rlEhaHefUnB2cuakj$e_~ee$Nr-P1=I#561{wp*haAe#adve;;sm6f#$)J{Gv2h2R{@p~-7d-fcuj52kzpV@`t z8i!q%mW0Zr!t?S^T`Ni~-0#ZM$x(FpZhwJ14KzT&^mu@t3t9pK$VEg%!1=LZ(^_;i zw3dq51JRM}&V(;XE|C=q#m^CQ^uJRxeC|o(ZDyi|D1|mOEX0{~@g&xZ#Qq#tQV}mW zY1{(`3ZqE{Qq$A_Y;QOD-TQiZdG&ysltyc;cwN@aC-rxuHLE^`gau1boub2E5L>y> zfSUf_i;Mf4lQFa5FMz{8$HBoNC0)_ObLF!f-3HCCwVfXxf7I0Pfk4y%`2|-$FyMDi z5<=$w9<|Iy$csY-;7Dq7p6U458EN6+-I&umgg`kYO|EEP2!sYYBFlvcwf?d-$0n=V zzqyb?x4r)y0&!Gwl3?vI9tW8RqKW}di;_Q_CQbMsr%5NMYlzzD%R$Zp=mS*d>YeU^ zK+aL`c9s>-7b>Owqt z@tL)$4;dEhPc}zL_*}s=bG`({Rgf6t-SBKQTU|jXNp4%2xv0H8TS!+dcuncXz$TOu zuVnl!fLq(V;4H}hek3-}eVp;K%M}zx0LA_1ALBdDJ$?xl8o2X}cTN{!lz8_VX-fH& zUh__;Bt4)pxV|2yCr*spDOIicaIUaOk<5eOm<2E%1_lQ3h{r4&dZlG$92^`Lbu7%* z(^I(jeo~LcU9oxsNx|vdTQYNS0#O{CH2J?C$9>1J-QM1A;g|NtB+PjobRh&|kXQl* z#r?=oFpG8d872uYD5Xzd77QV7Z;m~7d)8~DdIA?JM5sletKFJ)ZkA~oiRe*`oK@YN#I6xFcKvLnFCEz3wf2tW+`1DVTz+Y}tG-F_&#qbF;KTUr!H^9pd!oh{23rvb~1{ zem5UhN~s@c{FNlmFs&s3h6Gi>{HkVMmPm|=3^@5fSzDIh9S;pn&-nOPhj6e7I`%^ko1l>L1_p$T$vGe(_*|dQOiiiOP0`g# z1@T5ALJ^-l*$2$0YYjwjS|%oI5P&OY^327-(o>`4=I0v&%Le`)sRO2lt=b}S4;U4I z_2ArYQeq-d&}Hr$-`CDZ$_D`(+}qpp;Lp?@x(OLxz^!;6#9IcI9VF*}lp}|OrDnjM zt^Q->8Ky0)6A}{Y05br@r@6KDpA~=Deacwx%e4?t4SLPVX}eVHZ>IdN#oRR`B%}|> z8wFLM&&I~unt_o~i%H$ZrQVq;y3dI11*mu&mmM*`u~MlEz}qiZS5sp)=-}t!xdH_E z1&Xg_+wAI}`FTKCrDbo(7Kahkusf3H{1Cy_fL z=?p?25NZL(It7BzKPW+^wzd{bEXCOfkS~Bx@rp#t|MO8FfBd$(YG7b+4{+urga-GJ z9qeR|0u>YspyYiZ3()%P@9d<+$5Y`x!~2hIHU^ymRh@UG;0(H%87M>)RaB6WkyV+S z#gWsUPLF`?w6L~LkBtR_C1@_;a`-I<1Ss5R%uGzSs~ya^&%nyH`&_$T;agZ*E}WL6 zCDqf5e3uVbEw1$hs|~=`EXRcQYe)XbH{i7?x>%{vETO~Q-PAa?;2k{(1Y!T-djaB< zf#T%|8wBFcf9^reJ76kPMYg!Rax%rI(~)A7Jnnz9f%8{a9|7G92ub6=xXLTK@V$wASKT@(^$~kBr{gFxB)ay0f!6gNwa6 zMFRsrpvp8iHy;*DPK1Hwr=MZp)+v*W5;t4}fj=y7lmkQ~P~Z4}{yhPKaUk@hv0KCe zIGK^L4BTMeniGn3ak%Q{=9YYbg@r{v_xMo@dH`uctR@o%3d-M;6E7eIN=WqjKSH>< zz3nlq4i6s!ib4LhZl|wahxlV>0z?72JfMo)+}sq%Cf8^(ad6ZFX&-!*064jSe08z~ zz5(DL*8?eui>nbxk=xtb7b{*5osH*z<^iNdgnkyw1@;b78n^%ykzYAP%0>tMof7!? z__x;=m?$Wqr05OKoP>o90s;!y8nGLY-Y5gVOG!(w9k~MvAA(87!o*b9&~W!F5ECWf z@?=bijNd&53=gVye}8=k*5BNY#}#ddomfdrl?M-P_x+G}Ya03?xJPe=cC6pk0jX?OR4BCZJ3M+3URB>%!2;sH>}M zfSD}Y2z0VWfc;rtUkB$e^gDfl!+_#%TuKUH|J$amGjnsuh=?En(^6Bjv$Iik8?>@L4bW_`P63-79v%(?2t+dq|+Eij3c_j+BIhh4rgr#XiFqocEUFT662b+B0OFk`ybebRM&7~=QcyIVbRpjwf zb*2THmQzV1)N0unUW$4vpU2aAH$|mw_=tV#oLvwhM_|U)Rw_xOv($M7=#c<5?1UfrJcDE)U!OT>cn(JtoB-Mc*8+^NdpEOBvh>t!`3 zp`Y#soPVgT-Ml(lsiLN)_~Z$#iOHPPl9bynUw3zRR8&-IZf;0qBz5l>wIv%petv!t zF|o9a428lMKZm}Hi;EjzFlrAUQU;JSr)6aYZcH~%FE3+b(Vi{sAH}=-`;E6|+esNk zh`ifk1xrjiS%O1CE(;qH2?z*0NS40r{pHIw4h{|pm(8n)-b{_Th2Bh*hZMfNRYjGF zn2^w9Qz#QWPV@0&1$%qswQJXeJy>Mje{cS4D}TMg!KoakprH}|?VCu9AX*(ZjyQMj z+*K~F?o16<2L}ftQqm|LB_$<->gsA~_kBtxCMI)p^MMLSULGDE<}hAC!Ehd}FJEmY z>te&?xVZe8Z#hx2u&Cd^PYgHg@9$GmQ{P3Qk{mj8pFV9$5VhD}uctUz%q@&Vnvi>X zdg_(i;d`GP?b#pi+xF+_)Q2(O;^yO#Xt=ve zfB*hnLPCO)hNfXI#Vaf+i8-8AZWeuZNKZ>kn<(va>B*BP9GsjNNl6V`K5z-QNjS_? zB49&#sLGgp-LmtrtKNJv4AO1a(sg$^C@hTp?c28xlB8%I9UTvMmYRRqPG{xi;XS{; zi^XDX9371YzUpHWL`igYb*qn7Zy|6Wr-y%Qg!Sw2NJ&Z8H#Vp;nd+=_+5!eKZj&P; zdYfBY-FJx=g)d7vmOC+EILeSQ7s zQ;bJdRh3~3N>lTWfq_B5^nEookAM5a{e)f6iTL48mgLx|sGH_}-0{r`2?-zGzpn*= z!|iog>;rQxEiHrn^~plL8n!APlz=e?gZcLD+wacK%+yo_H8nLL(C`qh%rZ;6c@3|% zx3~9{|0`LMasAD5^&4$WVWFVM(eBFPO|-76s%quRVs|>BMv5#(ykD$ykKPZh6-!YP z4Nn&mV&~-znVOn%auYuC)Ss;zZ0Y z(b3WM_4jL{(c_bN+N!D~WMpK_tKTc9SIWk%_DXfFtOV``kmDu>Zj4u{Nl0J>bpI>1 zlAjL~Sd0I(^S(5HKUoeb#>>_Xf%LLSx@f@p!P?3dC{xJ;8oIct;dfaGf3K9MO0K&;NjuHz{pL^ z&NhjUyZeTRQ>^{mV?h)Y6buXv6?+^x0cIG)EE!1X_-><6C!wJllrNN2@D4BfyrQIk zPUPc5*~mvke21oljhpBZ)+d!sL5Spkxj5fvQZhO^%5&p}t9~UsNGnr4dN}pel$=?r zAzbcsKp^!~B^)*A-8%&|IwhJ{yZWXGyR0k=2D73qAc#ap{`et5OicXn>C@RH=P`Yt z-P2a;m9y1h7Q5V$Y^clS7%XDQnGaOjpE(AzM)Lw znlD~-jQw8e?A@TsY!fx84&(HfbZ(_FnBSJ((1c;`k zF@!!|#?7g6WDTl(d~#yz>>L}sJkt`%2O9W7Cv1_uXgm*V5&Q(d~mQL?O4VyvQLacAzQlMu*8dTwqTFcvpAH{y9`5n@3R zkfH=-)Gf7?S5_wE;^KlM9vp9VzR?cYa}>*4a~!GhO2M6+hDO1`L1b`n5M)VZW!&pb z2K>YER?1le7E3B9D0sNLqWbI^LvnJmpTECKBRw5m6G+O&-rjWyi8z2#ncFYWWqMZD z6sLe}x7}s->(>KPQ`rvp);fVP_NPJwpM5i>0(|1c)Y{s5A*CK9GdnAbjhj30N$%5) zKicT-krBQU?Bb&NeN|N>&*YP4f}6no0Gx*P$$AwPl~3pz&yfnp5Zmb{$9?ym`EFlm zy4_MgKjK4VWKd{mV{dO{ZS8Gy3yZ;Ok0ah;yn~1~ODEl9OWoSrpsrm~R9k!i==0~# z2L=YFT8~#>k@HLhb`z%?`%4RI#`pXi5dzeSkB@JEAu}bz2^jxfXy_wN%~w+mLEDRe zNC*iD5wgeYcavp3TA|Je263w^V`F1+A3qvcTD}92P_Rh9*BP&J*#dU^P<|>YCKfX@ zW9Z}Kli?C*U48J@pM?Gu2Gc%lUDJ;Hr>|cp>ikJYs$3$W2UAN+Aw@+(22JlKBQ<2r z$}r90tj&XiIZYjZzn;&kBVgsC zCq0tLmfV;@^s09Hb$eFkBE?cDPTiLB%QE=B&K(U647`txRetq~0|#AL^7Q1WZM*yL z-`MgbxUR3y4x=vZc^n5!e<8n9{_$fPwAYDf7vu0_ZS8=H3MsIEin_W?C=|*}a;^Hv zsuE*wXIIzTThiO9_z}e5zS(DHm;H5i*no(rsO{RAOnetHCnu-V%Fs@an0)n&CYFGJ zV18jC0v_k;Dg|PMO_r%d)r6ftohZAwW?^djzI?RAM5CPF4Ma9k&WnYYmlvm3^WEu^ zHWS_tQs&CER8)ds{y1+)a zAVZSc8+g3PVL=n<{>4DQ)7a_qfg9kY=6Ew?q;xV|!K!iOX%z;|wROxc_N|)8!`=N^ zg#!;Pi`oZT$;ve^gq zv8d?ig~5{Re+y9QfO1yP{Wpa*rwK5(@q?rEIM1xEt`02m2#pR0JFXmdg&j=mhYy#) zElS!>;emBvU|@J@Wz_*32`-QTFtt4PvvOGf`2PL-02nP4imVp;7B6nivech%aCUlP zXkuc2uxSK}50qmvSZqYfBu45jX+KMO`LYUl6h%cvKR>^&Tx~%DQik;&G4N(Ry}dX) z0*G|qXr%8kVe~7AXww&~{ilQf4hPfz^v1v@givZ4mOYh+{u z*e-HhdTRE{9C8R~95s+GZWNrI=lZg>03n&Z2G&SW2hesK2ZyUXJVCI2vHO9YQaFnm zOy`9 zot>dxY{V5zGmP_P`t<~wT3TQ}qBI50EqJscO*($>j6A0FJBw&bF3-q-3gbalgqQo*vCG7Mb8rpFVA8-+*f<4sl&bm_L&L@0^KpO_Aj156#H9T7as23w{(> z?^k=fT7{l9Gp9l z?LKe+ayK&iXXW+#Ozr6OXl<~_K)Lb=9DvSub6QAhIIyftnRlefb$;Mdjg$3|0!T$( zv1dv zSXUjbR+3&8_Jc@ziJ6%nbz@;>rU6=s$jZ&-l$K8H>wBD&o7?^8PvhX=W$+!TqRRzE zMN}a5JY5q{WRI4St7AWTnPsGxjt{l~J6|EH;~p4D#d%Lvb$Wke`bR~@hr~qeK#_s1 zg9F~nlfxab`#3>*Wo0#%y+cx0_*u)%7#wx#j*q9Co15&x40T;y9WG%R8yojXZk2%i z;y9~|aWgp~;jne0IxCBNYI?f6tE;xPH5izq*r<(;r{U+VzoKhH-$Nj>k_)!+adX!~ z&1YGC%gZGX4h|4BbacYTScdF;ud`DIM#fe>Q$eB{`lKObIHM>rJv}}76^YvruC)vF zB0Bg%00v7jOifKq!r>d++Zmrey@8YsvrS-$!RY*S1?`~_aaw+6HCEL!)ff^K6!fd3 zBP=oTN~&l{Ykz;tyLY4=$udVxAFe|)jn40+ielFm|K#4bXnLZ&BG}e=$#49Arb$Vx z0IGGQ+`gr?l><^Zq(E3t#mI;YS`V?I%IMt-nQiQE7{u?wd@oqI z;Ne!E!-6pEA03t0&#A}HG?Y%ci!FZV#JJVQ;_t~XS-zH+KQ~-veO*W>;$Um;f(?$) zB{zw7Ees3|6<)kZ#wPDWTGIUC1Lt#?r^u&v00eTl%kQHW`;rIYeNS8*gPpy7{4Hkz zcwYgawt+V_kbB`xgL*)?g(FcP`3wN*bfl(4*PiJS8DbWW`=4<>Pz zS;P4T(qdl%qPjxCotHlU0VN1XHUIzs diff --git a/vignettes/figures/poweranalysis-nulls.png b/vignettes/figures/poweranalysis-nulls.png deleted file mode 100755 index 0994edb54377d4c507eb1e755206706badb0a1ef..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 11175 zcmeHtXHb>fw&g}tlpq+$Q4vr;g5;b*L{LFNa?Uxk$qI^qh>GN>B$1pmsN|e;&N;&- z!<+lOb8pq{uKVh}uKv~4{y187)?VMY=9+WNF~N+H8$)Wm+^ag@BHp2~5T&ofzzDf5CH6dqjl4I9nXAox zP$%khmxj~FqZYS{1(%BZsUOK21f}miRx@*@uoHcp^yo>~6O8L`4G0X)%1QMPPJbI} zUnMNc8=5>4qzf0#XbzFOsmiyd|D>qVR-8m)WXTMGh@w65E zpg4cYuf;+rOhU+pvy#9&U|EgG;_xk>{t+8(3B%GMnXrG$>HO*EeV`EU7m{7sa z0V7{{EW`FamUJT>Yk~1N8){tf%AfB_yy0$@O$D^;E6v+Wrx?7uEid&#SVGhl z#i$opTHO-xB?KuDkJ`%Hmn9-K?se*z8`c*jP_$(0-`|{PJy=F2yImRfw4I|^G zjO&&6(le%_QljcYDllBOXYPhQLDBshi!&ccM|$*_#!=6;zwtk9tWcA#A&2wXO{pxcY`r-S%zN2Cr>d(I z^i$=idd_V$b@uXoeq>v_uy?$4BxLpS49Kl&7p-AU^`dH>jg>jJi%-Y%UkE(t2{%4; zK+#laSiCA&WB#qBiCpM9=8aA_nybRSyq~*JWyNh-8t~TS4~^Kwxjn|Q7mEqE`|-+e z-jS#Yr{VLMR{dwz0!G)YuV{BO1=6l;rWve~3!8>^Ecw#A zy_dbDZJxHz{y5wczdE*-d9OlC{(bOGEf&p9yQMdQnU_$St!ft01kN=yV)5JsSlL3; zjxs%3ELoGOa&*4ZCkXHB(kEK#e)*YvT#kFQw^SwvB$7|vtF5@*IqgN$=T8R{tTKeZ zHVuug;BJf%Xr+#vO#44>OnIf$b}l$pEqna^hNt1oet6+p`bi~`n>j~Dn>-Xl=v(br z!yxI4?uHTwekrbc$@Qdhd@`A7L&`hNC>C%k0^vax+{i2zq6-YacUHZ4V

WXQlpoDR zoEKomr;H3>;luM!uwjeuonNGx{G}6pf%CB~YS2!V8f+Tc%H=z}%Y*H0RILELrUL1o zotry87;~iLw;cC=fbf!Pw#x!F4{H!UCwq*XoShXP@z2iB zQIjcv6Isv+U|U*fN-?Hkdr?F%ManM?(u7Nj}57G>ei5h9nCD&&dw%?TLqJfTmK%SRdXe-@BD%lp*m#6gJFdnkZPE<0!V|FiQ+F{j=9pJ zppJngKyALy&*y~gKyktdY=&SwN@-uL!FsOeg{!$gAUOLhwj3;n7Wp+5q!cSo$!KWXMUy?pr> z)NjG>V$tuY$M2%4{$ig;)NMog#S4Blsq+^B9t1SPM6rq%;z#KF)r2M{CIEIahgT^< zdi;(%jKVWB{x?T+JDs{bH$qKSpFSl8Mm0BH>2d`do7!s{)OH76kC=$)9(ZCHRW1CD zH-Z`AHGj4zUwFZ8qdeF*3tVtfovC8+@7}#*;c5j(bR81k&dv@h4sFl=e6czd0qvP0 zWNks49G9Hi9LC=;Cj#DntG&IQLdb!}?`)1fnV-=1-QsQ;AMk(g%kx7Pk?BPQ0;>ge zEr8u*O{K!3XZ`7hSRA)OJJieIyaD>Q@jGB_iKw~E+qZAAs(BAllcr!odhQ=j8Lm41 zV?F{d0l3|T)70U=;k9%3ZR2Q@QW)H4WOj+BMuK~q!$dTGOG!<2a&h4^{CkT|6*$C8 zQCiSycX#*c`T2qQ-ItBxFuRAmapT5~>D5&ZG~YJ@)r(y0>_C+yyw?y}DZE%@-ENke0NHqk10W_ITdQi)_eaIePx7t#36&NaZH z3JM~f`>R<)+)CfCqmY)>b8wPZ3F%qT$Sf_kx5&uINN8#8mq&E! z;XU{DeT7QP{yz^qI5;>&ybd@4k;WxuJ;lV_XS|&g)nI@fv&+t4^r7gmhPL4-G+Yw=5>(JB1; z)v`6xCq*>YR+?9v%L#-j7xP!fwp)JG#C}%Umu8OC(ZwG21>UTkKoOd^9Bk$?D-GZa%5}`4Gtz& z6Z9&3)`}~1*fz#s}2EySoL63?uf3jdL9DutE{|}dy{CCM0xs+}6 z*Vl0M{iz4$_i10lR8@IZRRWlc3yX-Dn3?r!B17et_B|nWvE9DiFg&bL+M@?0 z31USRfttI+2%yaAvzMWxyXR2weGN;9% zJcP2`d85X6o0Id7lGsj;dN0lYXsMQ%?820Gq|83K%@%}@A549z##OS|#6)|%LX#XC zI>~SeFM^nKBZelcUK=u8M}Xr!lBb+72o|av`UmcvoPGWJgy_aV>%0K4HYO(N0*z>E zM<8t=T96K2r>Cc9S+dDgTSlX*1J&;jHYSu{z77N*rO1$@U=C>Q48je zPB34K)iV6_`Ewx54P91;xFA1rJ$g;F9w{3sSY1^`LQmfV8E*UF;0p|8z+8pG1tDo) zzp^WRFn0Pc$yV`0cNk$()1<8QW@3BRrcnzyXlGmr!^K&$aJE_Mej-0PNjJo;_8o)l z>Lv_H>cgCT&d+y;1pANGLu$ z9Ix(dM@cSK#KfFU<0pY%}@0@Ai!fL zh&){C%NO&wI%ahkMZmR2Z85CNW93CU3tS&sP1|7dX7%GWW?WJ#(YoO&ZRxe%ZZ^Np z6U4j!E11&L(z4nRmEl|7?-Ffd9sOh(GCVSp2%q>DeH7{PzGtCPePn5A>Ay}x{v)BX zt*(<^xeu909-`gx@iFja-D(;W*{-_AYyZQb`}Xm&7UK;$Ak@RF%mB?*?CrT=J|2_2 l9i*NFv)#Fcg_cW61X^II0%B^NLcs4L3>BFV(iPvP!x}b{28q@(uA`-%4~uXTFrokfuG2W*%KVwLd!{#t+gxE|X=P59-sQB4~Wzv@Ft?+s}}{OK&6 zWm-Gkm*>Q=4#|kJIuG}zg0@GUS7Y;;85yM{B_+w&^xiQO`~7K;%j@b=9C2Q)#7;Sj z)R1}+C0)~9?JH>Y-ijo@+QZ8wDv^^CUE~sUB5=yzda9Jj{Ni(|j+&mn{`Oo_kW?rm z6H}4%u0`c`pXSEqW_L%z!*)|$%gXHtMn*;si{a9;_c(}1CA%5Dc~kw{gYHw?jv5v= zlWQw^Ekj<5x=H1x?f9QwQL=C__Bm#~g;;+@;Rh^z>Ym;pdFm9&n&jMfbD7kY)HmZPyU&6UR;mrV!$ zymguhWU~GGMVWy$#Z>dv>(Pp|5|=wVWj22_D&s;@gz;ABBnLm4s)?mMv8YssgVnvb)4R`c>gt=)jrPM?Jd<+XS@FgQ7u!AupU z&>3?f$He7;Jp0AKtjTTfwpPMx(@f6BDaEsd>86W!CA-{9C_C3ib4CtZZ3;6p8J7nN zC79H5l@%4c^7^O+os^Z*WP8DWwrkGd(cinLbb7K|O+-eP$);bQUQiI4z=4P)J^Rfm zj)ym&4aQxh=bSsL?J9D5uyl?SZ?l^^&sR8)oh@6;-nWH8KAFRy0lVvYkIt|f>$I%OkMLTJd!RmW zFT!rI?=h{o|6XsguKRHjpWTA8>#~BGS+?8JxKA~Xy}r`I#B1BF8FOTD3P9ZRx&iN&ZXXzdi5S_0?tlh;}Y5IMt+PI z$*cN9_tBG$;)#QK(R`t?mye=^)r(%pjphZ82;G|V?>{DpUR>UCb$Tj)+qH7}eXf6y zyl8wouWR6e?Ll3CDB;zsiShCAWF>+wdtdl$=d9`rE>rT&wXjxacS9H@{T}R>hc`_$ zU(_>V$h_Dg@T9O|TQTcBk~83%UB4Ty!m~j8na+4V^)1=)V2MWM;zzy)FQbLE-0H#l z{vnt8#Vpo9)tz-318UYj^w8sTXH{1ghUQ6h8|v#%UND5xdDq?uoBws~jgF4aOP+<* zQwYG@b;0+i=_?JP51wYpWMHnz|e1>(p*scAPoYBv`Ds&Tf7M_Pu5*xSr9f8mhNs2XX12Ndny^)^jz`&{nyPcEx58cNR8*cB_Z+lORJgW zWhFfo;m&rm{zXpDzu#IG(n`Ok@64EBkWObj8QjL0Woy(^UENzP)Y3EksZ2SKp9DjQ z*v{hG%eEm2?*j%Fc9GDnxqu6(BR5OWJKeF1tlz1AWUtjLdwNoLWt?^UF^^+}kyStO ztjn-hw&UiXXaUE9zFh4r$*^1Vh3!J!$Gc;BEZSv{LUSuNq)^{%7u=2cE{TDZTHQ+P zp6B2b)i1coq`TWb6rUGIO7Bj+IWT5LwX-~wwzua{vQn5}^eYY*8RvC)pH05ZXVx9_ zwX!VL^kPXQ4T8w;(u-SgoSf#U89RnkQ49~v(L>@UzEl~cpkH{@^jcg3&DS3H{(bWP zzmsB7+2(eY>)~+hnc3^i%)jQ&+udSj_7_$|kcTlRS8T$%=WWS8f_=q*e@c%FP~bn^ z&4g21H}qh8@pk!$&hcPNi!>x4NR*wF_QN+=S^3noHH%EbZ#|AqzVXltjlgVtml1?2 zudid6lWb!B<9Jw%l21JO?jt$+GvgttUf?)3A-A^7Q18 zjN2lH&bZE(h=d}$%4NG(ZJ{&CJ5@Gzq3>Ae^k@_PSJmF+#gdiX2e{;1GJ;N99i2%M z0fCr^$lIyD_1qSga+%N%k&(COrzs0ot54mwSI2Z+4|jTh=j#_4v=B>nP1Jh#CQ0B0 zkg`3PpPwh=vrUI{f)~p*jB{0edk#-kPcP96mpoNY`1tDqsr|6Ex1yrrSF-{35!>#^ zWE@7pFIuBhmWN7Ae|=;tJ6Oo#bUSjOrnbNv5dR=1qf%C}jUQje{v{+z1 zd(~(6ll^-_i>x+rD`9d%oza}8bdnc|ndLP!qBk}+Z2PtCja#ER7lywT4i=fFsbs0n z=a#Q1!o>k&?QozA@H$;ea)K$pe?M__beyln6Ydc{-ESu=5guaGaapfhxF?1l_RE(q z+ZIn*5hP#)izKP~c-gXSchs5Fq=&vWhF2-nwicH=Jw9F}mfyY)&T_k++|uY^YaYd6 z&z>c`w6Vz=vn!j#3d!!h z@E>(Qbw#h})3p4{4WsTEnluLADA33`0E=|rbrvx0qN@ah*7)-D_0iGM)_`GL(~H7m zlk!5!DcG-|!D4eJ$%CWKcDwaDlG7Dy48+KUWp8p3j9=M(q`*KrfPz=?_;5FpPH^Y9 zzDBWG)X7FId-+bmU4y`)ckgnXD^c$>nEu$?6>^Xm0?ecGvEvf zq^^4t-o1u5WYwNLNe`iwU=$YCMPa|7(^p~^ttYOPtqfIFRfZKpoJV~r(j>T~cSYFP z*fc7gw)1w}GoQq6XqKE?+u4b*-S7{IiyKoHZqIm@U%pZ%tzBlztFJv&Y_6iNuCBjQ z$h)1b6V{|$xzy8N&FosO-0eKr(s;a8m(aCYrbs3?vtE+iX z17zq{yRk>f6bvoTDrdXR_qa_>P2H3P6q&7Kzpw~F?sP>+HAmy-{B+&qnEPoZGqLpc zEZ@jJ#gsA&f~*x@6w=?)q@ks~DM`*{)&ZWDp%UH2jh zi?Xb2AQV#Qu6+6OrEqj}9(ATnm8>mrp|y0e0jE-fticcw(@WD1|G2SH35EVIk9D4oDYGr%2u#s~=r zk|0nraB->139P@<_-dr!n$x*2B_q=VIcf&>+4CX^BR97ilv~~KcxFj7A)Tyw3(oVqUclyw`!_NbBLCXZM4$a6s!iqSLDIYauy&E1`dub``zu|`a#D1x!RfO=^gL!X*rC$lF3ToHT}sr zrOXGvcK-0Z_$?AD`Rb=H*;BioYTNayFfuT7mf0zuWQ2pPMZI7T||i(0OOo!Uka6+-K*Nj5JZO ze79n&wPx2pt3+3bmVbRtk9p=yZ?U;1 zc*xwFl7RQ`gR85nQFG4DX5L;I(VUo=SP8roPbL2z;h@`o6`)Z5YWYK0SQ2E81p{(! ziyp{IuA@WItuN3_4oFKQU(XX8k4me59Rm>|khiQ$x0!7#n+}!cFlZ(OJSB(5_|(Ur zQfq2zG|c&*)*$GsLB3QNt8!gj)CaywJXPXf7gwLBfCweROl zi_D>xnX%$Q;TOa8>+w}WKolAMlxfqIy}*ACT@jI*mI8?*SlOOB*0{_1qbvV|2>WLn z`WwO2Q%2gW7a@%FkfU}Oph1+>(b1tRxJQJLg+llO!zQCV+0(_O0OfcIejP_ z7oY!3mF&N%x&OVQ|C7o4|L@0%lg@BF2lUe1)WpUIfi2*3WMm`&5>wktzMZS;1BriWtIhw=M&92|LPaH9Jdh$|eX4={uTLzml&?nAPTb|g z?nkM_nE#trOkF&Kcx=wvHbnzn7MR?-!_wC^V)bRvGc{5ncjT8(a0yQwss zY+7wEPExC8(pXkUj|sNdD3b&NKLfw^<+^jyTkxaTvPHp!`+C43dX_c&)_f`zHUey^0s=&fxbtCRojnTYTl75iN`;jv3rQmEgK=X87SUh@&!!-9PHs(-p@5p6MVT?BW_lxgjHM2 zx%{=7voS;|1(y5pu+?UDh1Bs;TB5^_tB(8FWR$H*=qJ{cWxb_#vK1zxu^3whQsY;+ z84iN(J-=XXVapyQ1`n*M{Xl(izj)hExkCS&%g`&eC#TLcLw{Z->2ux?Rx2L$%g{q+_IV~}Ci-6_EVZa12- zz7fJu9`Vj3T`oS=u!rahuLn+I4sf%Eo7bKTmBEoL)3y%lHeh!qr_5U4$}2U_A_{|3qTv zaa=QZ?qbuTm-yq^P6}L7)Z(~bet2Rq_Ei-2<@p9X6OXn3OETd#(s|b9^bV#0=V8ogYjRj$+|mi!)N}fEwh$~xQag%o;P%L zb+NEF=$;`WBk9aMbVCPtDqrW7)M+LOLv6hiy&g}MC5ZoMnL~=~&|(a*U+7o+Rh{jn z0i}?T5FA|G-ryS#KYaRRYV`mS(Vt*u4Kc6v=G$6mZ9aClZ=oQ~jlgqH{j>W^O(gR5 zheYw8`hJ~I^rr&fD%n-JJDTKE}0mJRv5|LUjeO7=ycuRnZ2t;=$gpOo|ANIL6 z?>C63P>iH~|o2*+}f(*;!-g=H5DEkn*)52WY=dwXF@VE6DvR~ zY3Yo7Hx9jmo)4`h{K9yK9&`w|5QAe>K%ke?pZvNxsLE9#L8{2hU-zp^JV)gq0_eMY zp*M@uc1~V!e>zND;w-}Pw9QwMXmu|Sr@tzT(KPpsbCB}V8S17M*2X!byTJ{_Nl-OQ zh5{F7H(rAQ9UG}o=zpLH1{ez3DGY>+Chg%(=f1|`iP{AT8_|)2Hx;x)q_LN9-@&y? zkn?-K*~~8VS32*i0)eNfq=YgSXTsn@-woRG=PeF$bx};y;6V@?SgJc&$tf@51~-r- zML&P>g7M}}v70w<8jkEF1qpTiin?d2RRX7KH{T^T)evNFFA8><#n>F_TI*e4z9;gh z=Da6epu$hwFavh(W?fgSF!B8~S~j-z7^x6CTuMG=6b)IA{PZEP11`m0{0!1_<8RLB zx>1(!BME24?$csf!qcRr?+-bm^_~|F5E2s75pWM+dfZCesu3r0J8Wz3$HjG)9c`Tq z2*kph&aX>PP8RJ>lj}d)-vnMH1$t%b%*24s#cSvb%Oa)w+c%-J3AgZm;sq;n^90$2(^fAC9{Bl zmg~Wm0sx;Z%boMcnpGep(didO&#|f;-wI}|?NYJ7oZjj~XH&;{M>95Hg_KN8OagY9 zq~zq(lnLFRAvIy))WZosI4>&4M5TJXJMpcUXK-xz%FRbi#v61;{N9US9cvS{oCeJw z77{psB?J0{k(E`>kA#(rj|LeRQ29gs!Ms+Y!16$O6yF-`^Pxg*>iU*b4>?>76?50g z@nLvGL@K~WN?|uGfQ=}{2UQMJVbtspIEPh4WMh?Gl$q%%t)Z9?Sf*l@xA4^b_FXV7 zT1oa#tpLWkAm@*}e4}brD1Gs|xuAp*q6?ADtW4Cy!~j{ZTWv{x_()CR2kPM)5Rg?M zW*_n2VsKd#-RD?+Zp$1`2GK`8jq&2;mg18$MCLlo(hf{$j%xgrYBh3&3{7=4%l|oP z;O=Qd(D!hTaT}3uko0W^!kjqeRJ`OE0JMtu;r%~qP|m| z{o-%Kb5BHa&{#g3lS!|;gG&u5@=Vm3A86R1vG~Xw7NyIyW_EM|8;K$KKhgzKf`U;u zwf~SVuzD`Q`p4D&L%JZApG8BnWN1>U$WE)Y!O+@ky08bK7HY%Owo$)Ep=r2)3)>UT zE)nkQ{v_jv<(R6NPQ)9h;lw}o?P0w1U31SpZonNn&i)TOk%^*No%8b##3BuZEqE+C z;}fS`x+9DlLY1{P5u_{B5R5L5bHL^q{iL|*SzxKbJaiz&?ifWB!y|6(uFViu*Dz-! z@>Y}$)1&^+)}q({%o`o!3jRoZ$lgC^e@p=!Sg*hngYP#6`rOkKAyZw&PYX`wFSR&d ziomnh?zU}Q9VlT5GhZ%$srrGTboWu6tQI5dm`G9*22~I&_H)g=eA8!6My)~-1Ku&F zbZ1|^l^6z_NB*5n9^xp7#(lD%K#c;cI{t{35_5Y`+)}x!9M*e$#2rTHie6{@cT|4; z3u6L}%J|$e5lz2>%;Iy`OD-W~h@n`9ulGI0_g#?HZbS*l{ zL^CZ_6AuUaSVMW~715YuT}!|oRT&V7{ny^7)3!CU6Iq@fz=J&{h=v!r>V(!pDvlod z!w0y*K5JUt>_$4i%ubImkIp?o+Av^E!|@xUfjIpvA6&cB01;*e|77!};*6EBL8!c7 zgNpullsdLcks+prcS^qri;ltj_x8loJog-K-bs`M;WJY%PDs1~>1YJc{kI_q;Wo9c zn~OHh4QYLGj}O~JJf8hD-i%yGu`^Z9z~{Zvqb^EcGOmC{FAwowkjx+A2_^&4aBSiT zrR~x2@l8p{E8CP8J-luHE69w67beO8{LGxGjcb}FcxuamY}df0z`a7VH4(T>qk8{q zP^CxEL8ILiGAnl4nQ?`f%i&AvNobUes8qSHHk=Izpo!wDxh*@g4Nq1O5%EB?qDR|)Bqc>Ul8o}4$M=|UgUo_I%~wYiH`q^2Tn)ZI1A~vBT-I%(Aj}y5TubCQ z6~<|CF@Ao1PmfL#1Qz|XaqhX?qYe*&Bo=SLcp5w_!=2z(9%1 zD@cURFR^yZ9^biD!3vIXrW@1fJ((C=C_wh)3k0`}e!RQDNKfAZL=p!i@+5tX^xHcD zai0}@>E_oKOPWVbe>NTB{v!~+y^6VZHXxNWmIZp#@bFmX~O( zcQGBN`y%~P&>M5SslxxVye61JG?#fabe-vd%=CQst`US3aNa%l+69s}HeM#tVy4pu zUd`I5c2XHoI*so-L*5I!Rur@KO^^EM2}bOpR48USuEM8k%W)l1q|LA4GaK5+0c8g# zQ29`M((~{bZB?Rm+5na zf(Hgkv=~Oo0>z|2*fDT&7S$gT11-b^T$+b6GF+#weru>qtRS^D!m^yH$84)*BhXCW zmKh0%0nB#o-V39>wTWnU1F3EK=n;#4fFj|Mk!jGCC8xv}xudKR)ELbrEjFZx28<$? z>5Gp0Sl1{oiV#cy90JZ|u-d)4tE=k+z#%|sOn^jy6IB9#G2pUscCQKhU|_Czf6xrj za#qL5?#9QSJ5H=sQY8DtUE7#N=6Wa7MtN+jgIEF^}?X<}`9d)%!7^griRlc z%d;L%P%p~QO1;Wc{l3vZlTEMmyXJx~*-1rb2of(2m)iYMS7#Y2+cnVMPj%6_MbAEC zxnbNn0Dibu4q0v(E!MKfDpC@2S_pqH^VJD`ee$Qq3LKz@7qYOGUqMU`;}fBWGv03U zMq}l@3;8qbQTzC3Y6{nsE{ZJkqE)QYci(I5QFm~tw}OvY7R+rKk#tU9e2>jP^hGTZ z`SPBoqv7t}LcUbT1yS6V1#NeD$Y-L8R!jdQ`e z4OP$_adH@)nf(oioJR+8tK_Y)&U^qauxyj*Z01PU&8zB>)iJV%RlJTUu&Pssyn7`q#!f~Q%EO)TZbk?eo^^ygo_rUMq~NDpJG_T28Q6t z@_F>)B1(U3GkI)0aU!a3rPU_9U!+pmnu`pO#X`JbLmmegCMp+iQ>Vi*9u02GZ_TMa z_c1evTZ0npywL;39Es4;bG_YkjFP^4evwp5WTv2@!N zh zE@6?2Lq-MW5A>M<*l<(CK>d?SFqbq@!w$pOF+udEd|-%VnM&QuYQH{2TE_o4C(K;! z=X5O=2O$G%=&0e5GA}TwNc+LL+FbpRx^9?LI$|vX-J4tJOI(3FHI;2V4qwtv3m&EI zT?k=)zOfFV9N}PqZomxQ_>+e$T}rOMGK+qiI=(lvy}GMXmtw;$>@ zkE!a;r%R|5>ldW9haHy(5&d4)DEhco_3Jf0JQXP|%^`)-24c75wQJW3p3G_1%r^%u zDSqF$#@I5L-BD%Fw9?cIw(g9H;06r2u^%2Bm~_P7ciNwcd3k-G zm$!ZqjidT2xXDamkJCMZI%pB`z;4aK)q^(e;Fo7_QI?nZjz(ikOP13}vH8%jBmK;u zKPDT~O@rn3c_>duCFnF)JY>-g9dSqx>Gq?J6439kUSxZ1Gx0Y!>g(N{>Cg2}l#q+O zNz(?#>R~h9r?<7yvb~!(0ZoSH{(dzGO#S}X?rrT>pK71(x}T;AxgN~vo*qP^rTrc4 zvah2X2#`ny+Ps>74|H{c2jOT%4?7Zbu7o(rVx&wm)Qs!X(yMZ422He$#7zuYR`)_p z14VKwqi_UnVC&M==D6dfeOd6Bm7X>Wc%FJd0UNo@5Dg3Z?M%LtY49BL2 zV|lC}K#orO@#BYWD`&qE>{1^X=rFTp4K3eT}uOnoO(as^YPvqr_X0R%~A^&+{R;s z_20S0thnj?rzOpR1TY;kT$A(A7+8Ehhqd@$f5POBi$NR!ZHa~FkIbQZT^K6K+gTZL zu73$~&V|ABG;#!dOIL#ESfH~s}wjF zZB)BRzT_i{IPyr0vcN+EqBZ?G(d3IZ-O%b2y1TZ}n#8!5NX0_I>P&>Oq$-(=3|K0IJ4KZ3TQJC^@fOG|g?O=+~<0dD}1 z&Cb_v^Otj}Obm~LHy(8#2u2NU347j3E#j+pzsNAs%zRUpMsHSAxv_!AiTdybIHr;l z5CJSC`mwNccx$$k-q9+RKZAX#p@HV~NqDVH+-cc4VD ztroMtLL;A1NJs~owY@-kfDpG}tio;fLHLIcMuT5bvkU`%22^b{(2KQO`mN9|u;~vH ztHtS3Bf6N&s6m}e8;d{6(^2_dvu?6I*N;>6k~9TM!n<%nzzb!7=)vaCF9lGWLQC2* zD1+=X2UhM@6&0e#rz-3y&^0yqmT8K=?Vv;?yiu zYR4t(WBH4W{n8QuzP)os5E4+Eg3AUA4E#{F6||8Jo86!l#wRCbzo8jmK+<#T{{Q#Yfxys4xobH5ZLq79}mM_E_?HI+b7DPu)^dQW%(+q#J^$)f^m3 z!I9G-AgYeJl0TMEnNU!#c9a&=jAZySWasN@l>h6sz&$*~YGqi%AC*YC9xj9Y(5Z;a zax@$CL?&Iyl4Lwq@%(s7t!7+kQ&4sXw_PEkPz9^SF#V_l4`sF!WsnHoE z`h3aB&PUL}VP7JRZ=iCPQPXuTf}Y^WH|KFfS#RHa-O69|ykuVZ{WvE`2bql=GTZnB zJe$jWkPcijmd|?f9n@emGc$esnDIU~9|jFto}~Xh--!jesYkq5MdK{TRSWYw&@1as zS4f(M4m(H`n#RU-K_}V)8v-$r<31!qrq#FA3uz>IAxRaYIaK>va7Jl_5SE&A>gGVY zt@7y6dtk*>po9Y_W?*Mm+#Rux5fs$+zDyY!6cj{4cc{ld56exC(6 zh(se`W$)jgcRfAc1rdP6b^-J-nFL}Ox_S8j6WkIZn1mEHY|}muC2i-OlHtU@98D&m zo2lK8@*xaOpig8FF3`kk8I%8C5!2`m?5-CcbuLIzwSa%?gV+YNt0C$$Xyg*OM0O@k z33yiJFGrlbl$XV{cGD9js?7j^iV(~e>wN&xB`D%_P}vt~^`>)25<{$2KQyD9SaNHq zZaEcTQeWnf6<4iG2vRf?p~vC8V|F|*=dSpP%iI=-VN@Md1|q$Yd{d6A;eE7FTPSuG zE2D*E&PgaEtF8rtgBU#-X4gL5pN;E(gLM&YE(5dfjLO7@^EEjz0rM?1E(tF*`YUW0 z4~XU5c28O}rAmgQB%>>dVT1l2x-T@6X!D-aY0JodiTHE#ynJV0JBqJR?iX+0&qY&P z58euCYrX>-Z}uig^`XIl1dPnaV}<=w*T(?jP}<7c{c%{+P&+^hB!;_$FbM`BaH#}J z59}U2YP^42Q6C!4JZ78QbaVz5HcMv3KHbPHy-k1-H_JSNuy2WPhnW5tH zL@#01)%0T2&THjoPWaCB3*j+^!(kMd_w3`tI z#EvR`qTOkes9#5x=aBeYM_y+Bka`SLGoIF6iuy(Dsk>>ozg`NW(KcVbp7%Ub%TV`y zu-kUoFIr5P>+A-u2e>zol)lyLIj>Ai5n(rDhC*?xydlEfIkmr>`68UbL$-~l|5Q~> zyrov1eysEnfI$sbJgFlYa8gyL5B4*<4K7%wKq(V0*TN#61`S4qwLLv$dHMJ+Uv!0M zMnI6l!O`O(YFDeE7ry;zA1y+k_J22Fdlmwp1TQJPk?-UW%kJ-uX^x}=NtM%|5*q{4jP3o0?-hR z%FzBceIhPlsPKa$^PS9(g>SmJs}NJD zwn)Y?L@PowuyXVFJ#p5GwKo=3`!9e!F`oG0>HGeD2XttlyAzMi8KY_}m{_osQ}B*6 z(o(DBUf;jPDfdAp?Ey;%>8~nEjX-N^W^s{866fMYv`tk6>QYw-*4Vc{Ksu+lAFT|f zOG_Sav6S~)zlc)#I9)GLzH99}UJG|_R{njs8yy~tcxX?i3e(7|A#+3K&7B=ot@GyX zTU;qS#TlQN1w}f^Tav(b7oFy};mqHYVzX}zy~*5H>Hz~pY64}X#}NQgQj(LQuQQ!J z5L*I>VknLv$0T-~5pf|e>iaQ26I#D4ZArugO zcKmYrwU_UAjQeupFsM}v|$rKNFi@+dO<f)UF06x!0wFw0rUF*(r!w)*7_RX zgljU+>jfxbX4`-U?Mjh`F613|_tOP~e=tz{pK3vVgH+e)dv{GvPJW1v)|e{W+OicB z6YI4B3H$iGz>a?>R9YOMhyo>GiW7aSMTsdWKLKZUPu4*J3hiS7f3N}o<;JHc$G{9K zsj5bx0!Rq20p#4WpwSK=_?5(oN+Q<(n<#1mdKlCm?;3RU(cv!(pez1mc&$f6Cqr9! zU^5_af{O|?W3Y!_MHQlWDXd-nyuyz{ow$SgzX~xdkP@3)6uaUx4WW~2Yr1yeBB0~Jl$Y5P zGWlScv9b5_o22Ff%KikJEJjKd_NL_0aVxt^ew`^HckEn;qHf3yyKBh$VFrEjJmudzYTxVa=f08H|m~8o~O;NYA8@(w#tGErMS0 zY5dX62JLLW+D}Zs8`|d@A7et3!h`Q+?!Bs9f8(rY%jIhAdvC1Kg=%?>eOkYn;q-ga z<%P?49`w#_iB*Pw|6e*4J_F>Qd>;yNMG2vm+fi~yBZM}bxk(_?T2+F z$C%fv!8+|O1$AyK{Ms||g?oF5dtcK{N97wew6QvFZ3gvfuyaYYwP(;aA1?8|D)}*V z2@h3xGHrizPMO+&Z+e#Zb_Y|1mvVzW>f^en6Dlw1`4;`c1-3FXsm^m_cSqr{<3;bx zZ1czBUwdz!q1Tr@t0xhlgk^w+GJ4(M4y(eqB&pV;Hy_urg2dqlN6nV4d*}xFiM()0 zSO?-qgg`|{CF4x4sjF;wT&n9P_BMn;sSq&CoBWjd12tckL)1&xd9$@)99(|CF#$eg=B(np0&k`@vp_ zYb4^!*jzOA^M*OUn>_hTJR{v_pC=zC+8W4cYWMFbE{}#DX6@3IESQNXa@cLowyS~S zyOT{o3iOPf_;j3!|1F!4bHgSJ0RPTu7mQyGqVB=FeYxdETCP!_hFbmC-q!U#fmDNZ&G3k&_Mw{TUwzswy32HeU8I)}A#EA+F|0z*=g!w0XItM@@Ofc9x%zyakE zKr;ZGWRqTgI=~flh5@Cp_V@0Zo?Rm>_GLHcjYz`%cJ3>@2GNJ`bQSs1GV!9GFFPZ4 zlA_raZ5w!T)!P+1c(2Ig!2^pf`Y6V83!i!F50niqwb1Y!DU|_K^WqZ0)8FgRh8H?~ zGW^XZJUBQWW|Lt|WqJ6U5?Tw^2T|w2d<7{bfe3D9%;n`Gs_tFKb43$#7|Xwe6Gi;; zoJ31HQxxuS7E6ada6K|DTD2NOJZT0F7Q4E; z-8b28APcG~wF$1C4PS3?OE22s%^6819Q_(C<0weUJvv<;aa2}1H;BD<`-%t`hUEG8 z*#(3gs>&4=_a|{3In3%* z>si9yr)$3;_Xh{{0#Dc5Ug$kgGL}lYiiL%ho{@3i$*C+~n$C$unTvC>V1*@rc!52= zh^+DE@!iH=0zYgq+D7#kOILklet-;WZM}hd3dRH1wzhtP;P(sQv)@BQ`XG4OJ2_lk zhboi2{1+EslHib#*I=hp_SJ`!Kz{mbD@NWMdb-sm%{l=!cH^&KqLPvqOiWEDCMVzQ zZ_d*4@sUMDMAWl{q&FBVmW)d+za5%k?H?A;PsC>7+Ib(mujj9JUa?khKjv=YtE2sP z_j=$zJOM&KgRU8j!q>tS(v@r1d|*JqcD`7Jk;u&KvxV;=p70TZoWF44J3JIuJ)((y zu|YsnLqiW{#U4pYe&;9aHDW-JYcc5e0<2cNg_Y=U&2?T96U9~>=y^|D=lI0+hi zU%p%q^0NyP5)!}xVj=O$jBFsSE-fpgVQ0SzSQ3Dg_*)oYc)%DA|NV6?ajqNFl9#9i zNU5l(K606pEi5b`NFFM+U>#*ZoccM;gpfB41;2#6|#BJ#n7f0>1 zyAlA?bW^T*@A`f2O9U$*HN(XTXG%`J~E)S3^TXUQNyW z$Bzg8Q6=tGy5%p4pX;xjX)sD0f+;TOPW6A}~a&3C0B9x(nx2DaYV+Ul8= z#RP+_HZEXBu`5C4<@_+qu$2c#mC$Q~1}9%%-^L2yj`B?kw`Qz-l3!^WH6ys5qTp*2XsV}+2g>b%p)sfVep;Nal3M^~JmNE|*harpVZ z(LcRNLo27+FQ!>fEBD)RLbQLKR>V^^1CoPe2IeRimu!KP2}nKH&{Hb2OMB49a(CubT@C_;N`sr&I!|4 z7hv$ruiSoB4~Axc7n!PgbH01`uBNY#7^ayIl(h1y4jAEFCuU|mVf?OQy`KEhSGVG3cl;om7A!=Wpu4}F@svFd7t z#c_OE8iLNzHBmhN+wT^=ZdXwfUo>sIKtr>jc%&B5_=xcnS%}j1xTBsJZm+y4=lNIG z67PPIWYOrnOD35;i;r)|jZK?q5pSk4VKSnv)q#}|eJHiHdZ+HX&+S_W&1|9zSov7D ziwW?rk-x(CzrUm% zwY0Rb!Pi%yrVWjX8ff@=8+WJP5EdSbA7UfAB>sGdkNh*w&8O$FcjjA$W_;2m7?t{_ za+I7ywAHh9Ul~n)BBj~p`ppIUptq1?D~>i=5Dy|I)u&+4rS_{-;7+*3luF;9ioQsx zobXX4CMIRveyugxG~pwrIvF@ z+}~F1$Ofr+S5^uxEiYpr&=&atH2xQ0XBrN&dG+qngssC}n^VPq`{rD?-=2nDcUpO( z>ARjPK&EkjZcR{akug|P`=D`S437-gv?VaEdd{N%(8t8s$fyR!6|L7N#g@jZsUd00 zZ8_Tfcq%Hs*}c3$i7R*MWyG~|Q5u@0h1v10`Gd2kB-9tg^D6IBV6-W|?d=#G^aa9A z55DuI)McMNJKJeT01SPB7!Oa5S*7PkQ~hQ9vI!qQ>|-*n3hmGD=X`$QQobJTs|G!jGAEYQ^AZBJ}m&#zT$3%N>qRy36E}fm8fJ2t! zah>EE_BW@=pz6^Y^`(BD9W+F|pUb#Qs*pyQ!>DyQu=aD|1r}z^FpmKI!if%>w(D?z z?PpA;9$}AK&G%+;VFBwG@;ouTfBpI{cGBz#$5Ija z6XIY|P*7Z-G>(0R1|_XOe%#ZY*zRlB@$o~xu?;=#86NfrK2C3UWdw5KYpIksPnc1# z2VAqKFf@a{6c=;7ih@If1vKkTt47|ZHDc@NC3veP_}BA4KeDyukd5U_aTm0n6ooYN z`#q5zWg)IOV8RCwFolk{l-_xH{pjq($MHnd=_6_B+E12MKJG_T)b%WdngRj>`JxIJ z4M)~~vgzD-gzGnhdiLi>S@%bFsT1Zm6adZXoZwrg~!>N|MULjLgOO}__EP74dQw6svL4(+nFJWhh^Ps=AU+#Xl70F8VaoYD{G2fm$! z=hYG^G=8bn?H76&9?@N;RW@({bF3J6a^`gO>SZ}PnuYnZ7?}mqSH4DH9@`l63;Nt< za`0vBcA-TYrm=Z{m$TX$*xsB=45#9?^ERjnp-MIz^9}% zzd9>CR&7N{JsaCoec68VdoEkvq9F!@hDzxZZ7ie$AK)X?%HiWVN{8bXW90pdOwVo?*WWEUS4*IT zE&9D_u=s79xTxqB{k(tm{iO8!N+%c2BTH|@e=PT&vdwXU4ksS6Gn6TaM|e09^PM}- z^!4>S(C1zjr~Kx$%?L-{F+6sC2AFLz5WyK6bcsb$PW@!{*|fGOWG=k(!$RSXE`^zwnCV2Hl%CZ@$3P@BdTG zl}AIp_u;WN8Dxt=wjr0BZCqPrVvsrrFRl<8OZKfh;U?L)%94~K$&#e9%r%zMZ7kK5 z+d{9hycBJ!%edXpGRgZ)_ni0r=Xt)*=ecp~R`28M zq5k7TnwdkG_*UH@CtwZqbnMu%aX)mUTZV^+Ex(uWFPu~J&p-N+Du=9{&a-PdmN1z; zh%R48Uw>WMYFu^Hi5aY42TQt^wpKKME`C80Ei|?< z1;}uTg<}QawJ7H7S&$tpTh>lcL$u3x43g5UJ7;c87j$wrOS1^sirBQeT2Mh^6@H-7XF7R zAW*zoD=jeCprjcI*`JJ_3+Y3mg8$yd3iY_ zbmVQx;Onsq9^ZO-d-wF#@Crrj?CrO_o0nv25Cvf@HU*&IWL1Cd+B&qYufUY0e|un) zxc#KMuI}p872cBr&)xHO^gtjxJvEgEwT)8Oan%MkTMot(z1+#J0zZeMwX(9AI8s7M z4+2R;LCa~IBTh}wr9FTOxcJPO0_^SNF1gI91`{kBMMV_x{U0y2F^qtKp~j9wTVfG@ z8(&`|z2*I5(ITQI^6ln{wxn@R&ow`evW}dX1prl7zN%xL8(mALXMB8ov~I!cvt*+F zQb(lj2?sDG%u-*4p)eDy2rWcj0Vo^mDOsd1gX?P}GXLd&cTx00Rkx!Qe{sR6T8dvn zf?1BFidcikVZb62b8}^u+q-=;_f!CE1u&3A_wbMdW4Z9#=#$WQz`~7p6W`Zch2F0e z>HebRkd(9uM|IP)v-!76zNrOZ;uO+S5_s?Dx5dR71sf{@yJzCnZzC+u{Se^APUejB z={;u_hogAu=J)eY46|}`Ng3U$%DoUW?$n@C{|1w{vDOTT zSMX2GxBdvvq-?B%SRku&htZqM^)Dx4D;>V80=bZPGf-UFOx(c0Ag`d{CgueM2p}|w z7@Opno0zcghO2+t1H+ND+}u_09Gae=FVb~CZ#_sG%2_tOj5^oT*C&LCA>fV_jTi)B zdN&w4J~oDSj!$C|MuTjD{DxLe69}*;0kF@suMJ2&+XMF)m*+2D&?&`i@5kOQcdtAV zw-+5A9Yuk&XMlsfaPgu|SeVXvm$Q-@Rh0D)PdARH|(zqmqr^Yp1;om)d{ zvrTmxdZ5hAOz90~hG2$>BvRjTUH7S1uktXeLD{f@w79r9+bp0$OOlI;i2?mLWEhkx z@eI${t0P8*k6d$dL_bfjNwtoO(jzR5O67TRIQ*V363p(Mgg(DFzL7 zYT2}k|3HvN(WNX-&R%$0@bLw1E4{7F6uR3i_)t{0x0lk)(vWAGK-4>%d?6_i2n-CI znweSU=;*lALE87ooyj%NEEf3Q!-HQ5(W(tbw2iXEW#MQL5F1;B_#5FrxsVWT6D0}E z0vJU;(hE8na0*X-+W=G9_9oyXpmISp} z)WH8*9`ZJ7qEi~ip>gr?dx|8gnsA(0UCrN?P{mu|AH#>_gbylQF|5#KUi3sH=RhT! zZK45O9>-+LVvo!Mxwd>2oGcOUPZ=E@9Yzo*((Bw5QJ*lWupUgO*U{}-Ap2#rFvPjM zY3cpg8QK9)(92PYD!fQCrb(nBS`!Hk4V^aUd@P8Y8#l$fK8*3t0>CyYfL6+aCUUh; zqbH|u`Jfq>%Z=tb$Y$L;5Yeto>O|MjA62tpQhC)bXW z&f!==W|lra?t@eIcQev3t4WRZ^{rqHXw|5u_2lI_m3v;=>g&4>j~K!d3E!>+3Al*d zz>@?$B`qVvkJ>j+R$zTYX8BNz6TtumKj1$8`3PF=J7=xbP+MA9tR8rKA&_#fUfnd& zxmO6CzaYV>++=k`n-ajczP`Q%Iv#j|h=b>II&CHqA0Pi$Zu-{5R*JF4*FRuMqfr^% z1dvhFKniqQTOmC?z26r{cH5$&?4Pf;%~h8_Qhf5{s%)F|zYw|tgjH))?XY8k@hvVX z$wb6}ms1Lu&+8w?7Fc{6qLg(w;wgfkoV9kz^iIyFwaClAzYax*jTI_{GN<>!0~yCs zJvu@a`03viEa=)=P_W3INw&FN@BleKumAZ*3k$~BPkZ?MG5RU${y&1jkyUkecJ|#z z3~HF0D_{}ujd>YcRK4R4>uYLjsi3d#RMPltF{FL=NWu4WQqpC5XcUaYkxVhn`m&M| zS!kiD&{$O9fUNKS?OHC1?prN3lqwma$L526o>wv)E4r>A_v+_(tAtA!yD6&=lwF$Mo0 z1;9UVcXsB!q-j#zwfqCJVp0aOH|3PEkHsJwAB);^9NRaACpN>{e&HCL2b^KLI>6{(=Ai diff --git a/vignettes/figures/poweranalysis-summarytable.png b/vignettes/figures/poweranalysis-summarytable.png deleted file mode 100755 index 02b6477e47360d05340f0b9af457a24dbfb09351..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 43549 zcmd?Rc{rEtyDxl8Nm7Oi4JgrsBt@AMp%M+IOd(}fLS`yLrYH&_O_EuWnPey_8q8!a znIdDx{kiJ-t^KaO_u6akckko<=UvA-j^`J?!+qb^b)KK;y!_OTDXw5x$3Rik3S}kv z6BM;*2}RMoqo>19w8HyOQPf6CS^mH&$9n^80G_`o|s)H8SY>w$;kfEh<;~-*y^frr|R#yDau!b%Vp^|dEG3MRM1{Z{ulFa zS!EjhM~+fE@#i<^Zm(vRqu;cc;#-2B(wiOnZ+>0bn)x6%SNzneQ}=UobMrKm_3uA< zLMJFFI5yaKD&SR;6X4}JU%Qkr_U2EZ8!otGh z8yHx2V-5eVb5$I-!@@eMB1Guv>1AbQsoS@2pXKbdIHIb<=@QOCL&+Om|1!(4SieeE zW{pWwcHAo_OML7_ZJdl2?ayOeG&&DEeDfyd>*84C z=tFpN?ruL55QhgG%q117mGb1t^#Yek+jyqBWF4Q$uP#itwyM%mc(!L=Uth7$ZF%jC{1>((7* zb#un2)Ndbe-e~=N;MlSK6MBWg_ZAq0b&sszKR>(T`4+}k^V~ySN9CkBJbn1&yz*@X zTJPgI&2G01S-oxBwlfn0jZ>3F3xQ)}c6TEp3`@M0)zsFOr5V1?eUZ}8pyfLKBYqn{ z|F!t|tr-~^Y4-gZPoF+L^ZAKNw(IZR;R4!=?r%>pH8m~9tz%(l_n}?7viQrF)$Z=@ z+XMx@@7!UpdjH<=>{+ku?0vd9wo77SVmQR@wx#IhU7wqo>}p6iR@1OHFZcDOZ)j|M z_2vzIWMm{ZMESL)OuHNgv?y6QxkcxyV_FLW>)*=_Q15zG7{ztDK#k?}}Qj!#-r9?(VzD6C>@mJA0*UHo$?9_T6rjF!`s^Wj~}nRd@1HA$wi&{n(vft_k;D>vuC?5w98VSAt5Z^ z-bYm=yWn%P-DX6~gE;*kJm6WqW{qLrmjsVAZ|7s*y3V&R^e^=@Ik}J$n5p4mqdwW< z@oS{|`018Rx`!`nM_df~j&1FJZ8|2KP3j7U7@@j+#`} zDEraFiH7^+P8v0Ou|)2RzFGfJm{pGchm-BaxQ>U4!54mYEBl!|JQP?GE~vBX>>K9U z>Hbu!!j!nU1M50yDC?GN8Uq6Z-mP1W$9g{w|N3RF9?zF<`s(}Wab4YjieT=|n>Nur zdGh2F!^lxgn#!H&l!HyAv#L&hy{q6|9U)2&*)ZTt33yLYpG`}Pg% zwI`f^#||SDR@SzO#Kgp$qS0TECI`nl%lx&nFKikZ7@(+NZkeIsy;yZVSFX@}h?NP( z=NVVt-Y&&?E_i*TYi_&3<>fns59{b1VnL1gvC~%g}Fq?DHWS z(_GUR1KOPC>(`lV*p3RA66*hmq9i3HH!{;-7;4!++i$Q?!fxPtrKLr8>i6#s8xM=z zr&d2cJ${;+T2UUj9*g|?WSd7Ue}91c+_YiUUE$~y8Pl4LjB9ro?8uJg%?GX%{vmyLW?Dd4;N3aK{TFuC3NRM*R<#weK}J zYbvb2^zw54jvIhHia9wsQ}Z)F4b9D)1ecK({pr@W?Y#$@v#bv4>2d1n>6vgcke_bK$)0Jq zU$buAj(%ozx|_!yM*QDsdA&~z_I&yBWgw{b=CPVDU*sJevXWk-cm7(}7rqdxL_X#-l7JKEblQ;X);0d+*{lYWQ4bN}6Qhb!QP zaeay&ZESS~cAB`l$Iq_??W4baZ`|l>ERM{4@!3B(=hF9*wl;2cb@dZ|9jUxxVv}L9 zBW><8E2!cA)S{B|a=P;Ja$kS{gDNU3>XNjtp|6%ySF4u0j8tT2XTSKZjebqx{p$@p zS`)_Uz2$~~yH-VsrM~|zB`6~DT)ikFGP0z$b`6Tj?Zb=(>Mv)1UX$s^nyYwv{2@jC z`0-Yd7)pFAoU`d76;$YGSb2gtN&) z`M?31g{cae(}J3snoB7x;zea;Wz6)8Q56()bvF#P%n>QuItriWe^IdZH3_9d%Q;JVd#=XkpIg(UT`eZ$tTpCno5q z+u`9Qjg4!?tXpKAoc7bL+_0@{n}N)caDi9A5;T;uva(j5gCNjNO+y2{g2Hc^RazPv zbQTsCy?uQ=yLX?c>#$Q&S6{Pf)26|28J7u0s{Pxy>)2eI_wQdz?Q)y8)6&+S`!Q&M z_8KK>brpC+)aL7Ke0}|z0O1Y$E>JTQgSYw|@|rzqXtSkP`Ew!+KXw>U^Z^v zOzSGmov4xAsn5Q4?K0`u;Ns$9js8pa_TI7^i?6R(uZC-&-c(on;QNrgwuV=qT|XvM9E$*{!2)V89foMjxl*RP&;4KK`Ai4}0JU%wpd#d>3N_QlOHl1_^#-=H7@ z)mCyz(sOfjlh4!1V%)!fe?x(bSW;5buFFHZ_oQ6Hn~#~8@MT#xUd8q@BG9S(ma5w6 z(+nX>UZth-l&qDNp!@vq^OVZczMD6h^Jj+g($dn3`)U(&x@f3|rY4kw&3pH*!Ho-T z2p7o7&Tjt@EkSwqyt{J^zuCBvqL^7&XoQ4>sA6EC;SL{exsA-lU%zrKUAaN_;6d7# zF)v>1NzyM^x9AG>GkiYHTS9^cIKc|GlnfBr;~HA;>xv4j+nO5By%u%tcMROGq@?UDH4?@n z-o{cbR5W`P3-JLs+okUx%ATLECfHUt*DhiG=~S0Tj~~;RMpn9mxiNEa_yW9}nwyuj zv}{m~k-UO?C6@MLsxLA1=H0vWD^{!^y|lib9j%Rk$LlLOZ}iuvlKML+MQI#2%_{_m zUTIO66yiABwlK#{wLc7&E@_*e5TiT+%9nu%9P$jxLgw)5OFC z)kgMN^PqBIVBi$KIt>N-L~G2budh!Y;PvZtPmV?30MBrAbliyIb@Itk8fvGqm2%Zk zYn~72(Al$RDJmc^kmkk0S9U*nUB;fCo`wvQEOAGOzlZPB7d8(IC* zTz}i*lQs$qv)B~=-a_36SR>yL^dDP5?Zkeo9VmUZhYOgYY;EOEoM1)G^uKy_k)-n&J-*Sm&aq#=LbDslja)*ZtYJfUy}Gvaf`h{$ zEiI0(PT!+tTHQUqVAEabsa*4=zP@XIZib31RHl_}D|9n7G4Te*#BQL~$+CO}o)Quk z#wR=~3L3O{@nTtJu7mzU!;UOqk#@874Evk7==36!TB zSKN<}uUO%XMdvs>CH(2rr!(MS_wR3{JX2GJ2>WV&Y137~?QwgbTa9hHd6E0vh3+>j z*ipu0`E~jWUFa-bw(}wt`SsGyojavkOIbmIa~eI_1nXCh{C34=SVV#MFs@jUV-pL( zgm5JgksIHuV~xlAYPFu9TY-m$+llhL#C7=9(myPE-MZ{wXrVw6Ofs{>w4@ARFTWWW zBRi9Ar>^hM!kLwtsrq4kS$QW>X8}uI>zy3#{kVDPdFb7{zIm5_lI^k2VSs1~Ea)K~ z9v)ua-iFv}=r`X&ueNzCaDqZQPLFLzvB(~&1fAZ#efwbHq_L4vwoqd zOCz6*5gKS{NORvT?VhxoI1djGitGEl;#Za~3f% zF%3nj9?{7%jj**c>&K$Ibgj#OF!t6hT1x5IF}m35J6aW_?W35c4**!SWF8cpt9`&X z&(?Y|s4x-j)(41CW_CJ!VxMidQliZ?`eKVq`eV1u7cZE(xtXXImy_Wd$*0inO${?1(Y75s zK7KRqBf)38cb5dq%+ueWn{qe%v*0m0NrENl0`767I9_TMaVD&bVHbv9YnS#YVI$Mru7R9it~& zC2)6|=|>)vj*FiYgl4eIhuaqB*{fq^Dxg*FGAgA<|5l!Ts(xM&z<9l=Wij-oP0aMe z?XPINzkf&bF^2TSA>kkZyyNTTwV2@N8#it!si=f$`S|-U$1QIMWYB(oZWABh66`>9 zwX2z#)~pW`1h({QP8*F(B&&w0988U=*p%A|k7_ zwY4Fx^jJGtuXQ|m;>7T1wan|%(nl_r(^ipM1v$p}`-f=Ocj%D8`1)PNS7@O|hh-Z- zdbvwf^g7ti?%lfyiNbp5#49LIU|z~}T`;i2@Ys)&NAK-pLFM6)ahJ4i%`Ho&?VTzR zdRLl~cvku(wP&xX|I4q=N3MsAt(4?qf^PA;_v6Fk$B)y1WjZ=LA0A}i2$pT-<>e*2 zk(rnX&_J#OCgAb-0Q53)Npj%X5`pAR$mZjxPv3|;=wpNeNpw*yhne_^g@VJWEUET9t6 zKj9hp620Q!b;c`L#B4(P0i@qtcFoSqGln04<^1Z$=XmtiAXK2&pFaI!vMQ3u)HR*@ z^^kAbPv7uxHp2b$$Ln@zAA+Es{w8KUHZKun(0qyw-rKdXooZP~YB=&e0F=2iPLmT|# zGBrN@>%UNc{TC&XzxK=`&%gG}p8w$2_oLjuW%m?SLTB9cXeM(u^?J-9kw3l^jjYV2 zqeO%{x99ICP=D2=M{EE3Ry4AIeXGdhe{3!0|BYXdu?`IlkrG6(sWBGZ?x3eG%e>_X z&*ceGg2(mi4&U=f8@Fwvca=8iOvfTf$p`(ytDvT6<=Slzy>-iEjd>o2aawx%DFyUctYsWjfua(jC!+H_kR#}B{u z_A|N#&YACX2``0sXK7`1ajf?^0X?r@Km6QNpsd-X5OYt)gR9MTbcL&%Tl(dn`e@us zuUxreRX1pw)E74Q_H5~^S6B3k+zZ}k+`Y?j&f59|z-f+&wYBvC3dkphpJAPyoeg+Z zBYcdt!4<}UekWSp@h!SW9FwxM@9KnyhnEAaCnhBgj12mh8L_QiU5cj_0j8`2<%wTF z;4DPEv+#6`CAorCVx^oK zz5zT^6TE-br%$1SEjhPpzkC^+l79Ofg6BCatM`O7n8bR_?}r+}iT41-D(@Q60&X6i zm^erD3jji6^gev`^HpEI+#Ye1JZElRNy;vV@c`tSs<&_bAT(z19SKi^z+&A>t{YvY z3e+bjFHfYLXbxcuI|dkv^qO>-+6X)E8oi%3rwK62zpSNLFCQEamI^C$18 z!8*=yadEX=ic@<7a+)(S@HGEruX)~^RX~_*Y;5IHMfUw{A|fIdqx-&K-L0QFxkY3N zI52^<0AB;5QJ4*j>^VLyJgpNtX;cFN=lEdBWpL5Jb6XM&61M3 zTbg0t{4pa5q5VH$7?n5R;3Uo zNOeybjFQZSUxiY8|Ni~qN@vK9*b@@imP=JsREVC44Ms=@wP!pE`Wm3l6{283(JBE1 z+vPH0nWXblX7Pu;|H=ZaWa5%+uNz0ks?eE|44I5-H8A+8^4 z$}qfv*Dw&b9=qoW_Ym^J)t^NRF*@~VBjg1~?(BTk+`OK=%eiys66bB=;^TcDJ$htq zT^0kvyhK4kfi$R=4CPx}Hf`Sg@cs1UQ0q0gag(qXIDtcY`YxaPs$-X_*X^yuE2p6m zF3*i;5SN>~4(KiplIF4<{4Rs zJ97KZop(ICIU=r87a%O#R{Q(=lU)pov(zSkrVzNfkqw2c+{w#Y9b|h$Z{s!w1SUTH|b@uMvyA*Zw=uzT5 zO$=!JS@`Pj0RYXBHZ6Rbl*9?IWEEe`MAdFT8N&u-HDGYsJHlL+kqZ@uQNe zY6aBbmLX?UnoX-2a$Yf*=H7i?SjhGG@ngr)_hNZ&2F}-h{jvo&ihJ#h2h};Ras0U1 zONdrnE4ihs+$1#B)FA67m%d8m+fR9dw8BfcR1H<#AN8G*g|@@GY88-ow*B5cdz5%x zyUGJ^H53A6c6N0&2dZjnvI7CS*QQhkP6Vk#p*1~kZ)e$WRZ%!(&Ti(S-eNWWikmaB zJ4ePOl$e^Cl__K6j2k!CgyOj)9c%WBsXCSON{QMe-6?w#}nLujC z5uTj}g#o~W#Qi`;vihn(bQcuWrEpVs2@Aij1DjBf#d0eB7uEF- z^2ypwuw=l!l&j9F1G1y|K;N`@J`c3W7hd3K+5fL6e&8A%jp+^hQePIz6Aj=?U0qh= zQqDm2f^-=ZTa^Pxk1}c`X@lJVussi)7L8Fjx2`Bw$H zt$bpa*(cuaZ{Lg{ZaEIO)0{YQf*=uOL=Hd;MDc^}Ppl^h0nF$PkX4arFktJbj0V}m z>q_eC*nm5ra?nlQEN3ceDe~Y(D=#5BDcUn>7#<7ruyqJIA&g|8QG`jxTWIHwp*}vaDY11&ohA z&<@kIWt<%-57FWofe#&7>N^+&1>?u%C9OS9qz{xo> z__D1Nwsnh3b9wpos1DLbA;!|&f1UnJb0Xf-+WCyY-o0UPkpcilcBAw<^ww;utEnjt z`~Lm=bNCCpP+q?E^;N=d+?=S^JPyq=q9v3A=)h4@KPniP#?|Hy5;ZzLZX$B7>J0X! z5*C`H~l4??MljkTF6G-7z!M z)4QR)OuQ2++Evam17RoP;ls_B{S6^!Yu3Mi9~dp;q0e(2K+{i$!yx~0AKI>EPi2@T zC|1>n4?)rUFJ0%qbougmFtW4Qj#VWkSNDsHXQ1|^%=XNmPx=uq?=+kLG9HmCm~{k7 zowKp22Jb8j1E>_?3a%)e8IrKphNz;G?NO~ck?riw##Y>jJ=Q|=PYSmO42GgmewUrY} z832=lt!+kg1V9+ghOk>f#(KZ>L$xE42L4`2;NLN`v$n23R(ib9>ptM< zxNl%^(9p^%(9@HGoA*NJ<=;nG6$;;S(Y}5AHcCp~bAdKMOQEaPrRez^zP`R`&z{xf zdqLs8;qPyBJ%5-Q~07(@e{+1lEo ziV)KnmNSvrI16{~+LcyIjSP1joSK>{MqNah&O0)49pW_3JI1)i6`K|6NJWAjL|0f? z*pPQw2>bXNv_#Q<2LQs#`Lnw_+uMs%42r&<(?-J*5feKP2;M@rrvr==Gw;d6@B}RJ zDodDa0To^8C`Sp_GF!L$fYNB_>Q)J2D-e2xUO6!}QD!8(oPogz`7^?LlJ)Y!*RZi= zfSqKReSRX0UGhXV_QSKpM83XbQKEqmVSM%S90E}(V8P!7MTy#N!l095%Lh&c>v!Tu zeC%$r)ezNm7;1Tomg(#o+pP^RY5B^P=d!Z0K!*aHTwI=`wx+m_be0K-i%*By_xJZl zczZ9&Ly~V&JYA~_m9!DY)8j(bRDVFCbC#Cib)T|LVCbHQndsEh52|?=l^VF!7!<1I z7g&P`@fUK`ww;B*F0g-pPP6e(W%Bf|Jbx~-eEIUOn6_Mde;6W}P8<5bXancA--@^j zvkx8!(M7QlOR*`_E`2{n)GX>|NXV6CtF{nRuEioCAmC<9%ufFcIuYa2W86iQ&T6u7MT| zdesF`L_GTovr`w3MvJe(EkA_Y1VMqQtqsl1o58NY-4ISAOSEvhj~{Q<2`JK#YoGXK zLWK*RrvtH_hAgY~u&GDN*V`0hr=jRZr|`4+3xma>wO+J`FbOycbx7t;Tel*2wFbr8uxtGehtW~>a$m$PtklKAZG z>}d613Q7Vy?!JbGM$7JU4rnz*<3+agdGn;gSM=)xysQ`Nn_mzq0H}aB^lDHa!{SBA zLIAyxj0#Zr376{plqLxc8WoWTLU|Xv=!k!V*yv8H_?MhBMDprXzxc9tsfS%s==XU* z#ruyQec6%sslI-xF(d99K%KSyv-=qtzl8R0dlCQW(PC+7X&7=O%d$l^Mj+E_{knCX z;GJk7yN!&EFT(8A($ae2#Qq8v9zmIRk?n$P49V*?LOIR4sQ~Vf1TFvu#C-MECz&w{ z8J@;Ikx@lbqE?{#VYy!eKlbxeo}`;)e+X|5d3V2vBs7+>{`%nlU^Z+LBz~8=y1J_A z>4908?-3R4MB@d)DMdPo*m+3I9nMb?N=n(;+ZM(qG6GdH{d?L1wG%)=1(>UY}$5wgA*$B zR68!8=-pSBEN2FK1ncZXudw>+M{Y*a=}ZPvIsyY%plvnj{Uj2%7`Ju89a{&&Vx&5&yyFl=8=!rvZMb&~w zR8+jLTse@KivqAsNT>qou`^ayD*)@TzztE^{^Z6$fi?nkx~O2`qsh6nrl;}`@~Fc3 zj)Rglvi30E1$P)xmgPrPR3eg-1tsiynJr9B+bc&$M;jye zTHMXa*^l&_$>pJz5cQ{n&SSkHN3E3^moG=tPkpb5_YSrxf(Q9~dO8ED^RAO8Pi7&A z5*`{_0;Ln4h$YlH0tO(VrUC7I8yKh}9~Bj~o+zA<8;p+~I~E{Z4q|o}kWDAkd=0uk zR^$Z4zO)FD^BJ)6(($;`VUBXOZFSnh>em4MFap;@@CufdF~%J_D-H7b(jVpq2!HG8 zDI+qlmOyx)dwvQ)!`;|e?&mLFoQ0S^@Fn4-uC~4XUWmv82nbt@W$yQg3d|? zSRP)pCN&HHujW~LpDef`D$&ZBh={P9()#j%wVT5RYl7K{ld_nK{`02)t1ircV$$H( zpH$=y9_;Av=kMR8Z}I=3dm=-GQq2_I5POb-N>!P;#c-hz+fbq#|z@_T6O{a4=1 z-zzSbMKp*a(E5IAYA|waZ}&Y*Nk~pE!$LiSKoP1r!X=$y<6T`{X!^u?7ZOU2+B)Z98w>CCYMtKbaA?CXYnr{`acH+>>9 zCqTcFeH7q3^7!F>qMRExptEfsd$REP8zLe1?rk7JQFz5DR1gZxqwKk*T}dJn*~v~+ zVbWxLd=%r~x!g*5;V-!#CLzh9O-)Z5Ap)I!>HEq>w6x7h#Q))+x%Jlf+BMod_c`Y% z6TsD~mX>?9_4SwDwY0P}!25l)<|{vfzv+l_W}piZath@Wi4lAYVpCkaDEtzTIFKNC zZSC!096R-LOJOG6mECxTL_o02xd}1VbpQR!DX#y z-YVe-J!ZAAxpU`E1#Y#rvGL}Y18}YX?8yLO4Nc7o_%rX`yg36(JrI5Qt07zt0SSpH zRIopS1HKt~?_`~q9L9r_OvWm)nTXo#Lcu2928XeLuy6=QH(Ye*y1UP&xH~(G>l8Te zB`6(}MdvY%r5ll#C*dCua2E82gg~o4eheuqErkX^ET%>KSa$wH+t!?;Yal0jw#&QcltATrbgsU8u< zd;CQ}OodaO%SjiHKNekrRhVwwDlX|bOd)kOHPf~bgzwk+nn~vN>8gT87|}2hmM&T1 zty#Bx*)kF=zlaG7WZXKD96)}w7y=;mC%fwB_m+Pqz6@E?WzZ5Vn_iH}44U+vDO2fB61g2(_$MN8}crs_x<`+0ttvD z`>=6R3c*@X>2q_|xE#{ZU;|kifl_$s-4>NdFR&uf{x&qMLx&Evpy${Ja7u(HwjFn} z`B>`^LbR{{h%IbUCfXqhw1i5 zk+xV)^uNnP8?Z~TcS-n#EFdgbk|oc!SBa5aiw~my#EKR#LQXrYbq+>`moE1n0~pfR zX=v$`crB5fBd8lHU&|zPdl_?lCB7Chn zG<)e^mcq=*KbC@3BGb|z_x?xT!})1NB&TLDl(Qa5v6fM=ex7~%I4EXJ^}q#1I^9|i zxnq*4>kD2lcFbr7pf~j>GuFaIAO+3AXDy~bwU+F8@9UtUSdsPBVW2<7AtXz)tW|@1 z_G9|t7+93bS3*NiBn})#jwwJGpb}U%uQuT-(0cywZ&9BZPo^NmQ;Y~TE({iEIYPjX zv#b;p$}~NFZ!VUkvk%@+cZFlT#DtM9jZz^P@FD^_HF; zJ~(vR=T5!-^q83|T%?v!_O|uZ&CpOD;lz;)s4R>d_N9HE*?eSrdKxjjY>x%$mr#(` z;4xX%iS62T(=@fI=`>OWwiQ|b^x}L3Pp+dpmyQVH4(a7t za|gr7Tg}GS2`)y;k9F!PYzS@bh*GC-pba_PlBaS1n6W=e?iLjb-Uq0s**L(?3)k5sDT-@R%Gv96DVZ^HE{=%5MJc3uC6AcmmxM_Rc&n;JR?Po zxU7CSrn__agarfwMjZ1+;mWVUcojIZC4^C;hFi5{hs;fN1w*ZL)BTO)>KphAIXVp} z=GhteGT}h<&ynI+=BxX<^FNj7^;=~~-~mYnR$(l3rIwPZPC<3ht@9{;XJH$h$4wr9 zsPd=5OE?a1B*6;Q&p!>myxg`2q4BDwrpV;enKyKRQF!mfPEH`_whLMekqe>EHo~^g z&Hx(+=4n7>uMmWXZ49yJ&-;A-{JeJL;lp2FJJknyegY2@@T7Ay17wrABfZ?!P}VXSGW7z4VPBGQ{1a^sP!FZ2dpDCbF;rusKJMV>f6P_E-O<^3 z6^r4GctCv+bOAC&*uQJu_P>+t9Zg6Qnhd`oCHwAO;@_wGAQ6%Rfi5;SOwb=dCom}- z*P2VpPBNlB2+yvDA3)R5(b4i6IwwU2C`hyrnN|ED34TFESJTxMNW8%3TV{m88AEiS z-F^ue$450o@gprUM#|-8M1&tawIfn&JTl)tL@x(#*Y+8?)AfIh`WLFd7AWque>_LK zut=ZTa>)^^imMM^YduNMV&*^G{owx7HDxzE8E>dd99F2&WT=Z3Z@OxG!>S%s(jQfl+P$Oi7oYmp)vY5Irxm zpS{5s{t`ChQ>#R?luz$Qcm+o$CZ1q`=vgwf!Oeg%=BB31mEa*}xD(N9^b;Yqm_Y#D zgHaAvKlxMI+KmY_3&_JL@v?pd`t;7g5HIa=rQbbQb@#xXoq9Yx55V|8qF$K+sbRLVetUY~b2xFQ)6QH;+pu=6GRn+j zfX!7bA3-AJQT^kgj5lGRCRr=}s;@7`*yI*wzsr!Xi4Y%m2($*oQ&bv`f%oGxZy{`_ z0{h{_$&+RcX@+*l41SQ3mD1GHQ$ghIc2pGqZL6>O5paRxv+%qA?fdp=X{974ZU$@2 zMSlHKZNGokg#XTw(b0$Sqz!)qrz12jk4<1%r}0_$ad1~c82=K4Xow_**b7OuLa^He zw-}irib9Ur7_rperp&~&Akb8_mlrJ7BA8hBlIJ;KWb{B|qAk-xQvey&)PjjfH4v$K zvzh9us#5eLVf(&Qyu7^RBnBv8EPd6{5l47%W$30jJH*W@$@1a$W3h(TP#UIe~XgeL_08-(UX z$-?!*)*PwTG$2`hGA4Ha)DDTC#rn)3o4fYxDaC-0;BENln=sd5HG|i{c3A!nIz7i8 z)0;K=CkqNqEsA;>yydQ7o-0h4M7E&sqv1wo*6-2$(dB5)w;htHJbVk#({wl|B+yIr zY0z^TYIg)9(g8dALBJ4eI=#N5@1EFKM_L*hnv!2wZRr=g4h5_iTZwyN>+^E~6o&+z z;Xy!x3?!3JNVSKn6_E@R(&$h<$P58;m1tuC4<9?y3rxSd{FK6-K?i>T98ZM$z2>Vk zo2~@md4~l0FChP~f@s zwkAx2J$As{{8>!|5=kVNL*mB}h&_G3q*Sz>J+*x`11}$+A;#M{#H@AWqZ_bY zF^7_RVgeULM9wvRFJXFMB#ELB-Pm~NU6k9tyXWvhj+3pI34kFP3QP)t&eH;t+*jLn zVX$d0Vp3{@x!3?FwTJ4G*W*lIP9LlyV7Nf;;+fj~n76fh_`cAuq3#u;H( zI_&d>1IPgwT394H6ztUd;*lR15D*y{8@H(_de#N>cujXZIxXafK_ObC5FwerB} z1z{QItF0pY#uapC6g2aHRq|6@73L-;ODJOgblc`M3D^8xl|4sq;`9?JDVY8|0F8?O z;7jY);U3kQzI5`zT2V_5EVGd4=)g?}uNOBpt&?&dlSOpltH;8esA?}f z7w|ULlmY5lS4B)LgwNZD`G7sWGmxENTeTN@Nm%uD-JOcZkB3~a{(LG`sHsUP_W>+& zB$|)!FY4*;E^cVZZVVHn)_vdMwm~(ScL@Qp2(9PZ_g|Qsw#OL{#t178kB@sJQ;2sx zV{U!}XPc0zLulAIlH;zVQ-)|s?S5=Wc_3Gu^@57F0+npJj4HQMzY?4n3>A?Ho<}FP zBO#_PJqx3bhy%Q=%OIGiAw!M6K=5yIS0b6hNG_atH(zbAFs->Q>@W!;t6pGz(&1Zbr5i0FI2$Vx&58acd&6jdYn~YRGV}WNWdD)#Dd3ovB*rm#FG5Kq zh9q?cJ{Ad(K}jcujActU3t%_AqH6V2p*`dNJ4Z)GUcvqR$Nhk{NlsEJS+mkl{wfFt zt!H`8VWEnXI;m2q>@^5&C<(CL!icF=Yi=0i9`9)wdyxp;?w61_i6VkpVaET3tu@#F z2!AT?7G7T5ixV>t9zOqVd=SeHBiOK-i|ZJan+NDV%f|6Pc)++j!b+j<$5{i+cMl94 zh3+$WTgzZE@Mj#8^pva?R=1mHk3A;56)XEIb_Y!H(>&!PCUl)U6>(@)&q!t|Sc{QdDKFt5DLk=w>k{%$+G1rI@@Fyak37lisHPt_+%1q# zr9@wozuOx#f2bj-yeQxI&u^zD{{3J7eba_j_f|vMGiIdzzNyRATZ{0|0GfZ^RQ2z7 z5T^eA*}$^D-+|5(e>QeVO^un1NKqJxErrgXx#9Q>f(WniXi@K8a55NsXq`U70M}61 zu2(HA7Aohm@e>KFVah-(Dgza{2sPBoyNQRVq||TKadq|DA2W4dJeq8wsUb-#b9n~o zq9nb%EZWV^!mc>`Vb|WhWf)!g`pv$-uWuLL^v&6fmA(T-qXScu1C6Ud+Ys%08vf9H zeU5IBdZNZFz)%cTDWC!;4vOsF&CJY9VU{1k&^;0!rqAlxtp?fkFfK}uDSAvApBZe* zG{q!pdh(N;!)@g!abg6HVF1DkxqElpEGQ`rg_`=UIyRW7EYi|k$bf>grVR@!H=}&m zUb@7xX3gWwyQlkQCOR8m+89KICQqQFkKj8y^hp;K6r_7Bxc7c;GlRZbO2*1j4@h(t zmMDg;)SD;Z=+ZA=PEJrlIAa;&SCF`6E*D6f9VzM!MI@PwuflOI#@`{r?2X%#X|?yg zy7T^+M|=>3?O>s2+9MN2mOWG-Ic+2gt=b9;o|jmtL+TCWmWjdfLPvN)e1SV8q^{RZ zr#{>scKAkMARn?Bto~(t;PZtZerz{C>$DDDDt5`b{kFW2!V_N*Zo&V<;A`mFy4O+4`aS*OWXiP*zYU& zv$3$CZv>-w9Y>DS`}*}yOSxTTG0I>!`b{Ml3W#5s5l}8KoBt00L3#Pxp`mhM2>7=d zHVx9Le1^^BuaV67H8%DL)5<(NxtJ-M!=WInnhXkEwM}F1+)?EAm=(tS=||{MfW*pA zk)wG4lo15s&=iMPb$4|g#J!S#Sm~9_y3*m$)8wpUiO-xL4TXVjX2&jmv z)eM5qC-JP)bdjY5rj_$B|7ZPle*dlr*RbRlEEJsgr99}Q^nVAirY0(BB4Nbm^T5zaveeEY?ms*0nmLFk3|U-AASyD_2#EkW7nSkp2g!2}__1%15K}KF=VJiv z;7gg+>Hm35jSA}}5DxzbA`_eeryNCx4GJll^*_4h8Z`GxaR6lu9@HJm7FRsEVE+P( zdhBN#_vS+Zp3o1a7iKRZj{MYW1|gp_us$#$xrjO%E6oYQL?RGq2@gL_pwVPw00bfM zkB{GVEkq)NUyN!gE5B}Q8M`{1a)9)`S@259(G(O33*qG_o2`kYF6AQn2POlYzxnV1 zdOjU06-B`w!wG7XCl2JpQt16*1C9wqcsk8-#3)HC{XyA` z-{Hp@BCo$_M^2}@Ob&78dO*`4{s*`F)FvR2_MxF5B>WPrEY6=_nsAB%AOfMIS;%FA z)-M5@@pMYgE|GM<`yA(o0R6v8Of760s(8SJ4nz*Z3mnABY(lenX#Rp({DOjI2q}5l ze21!vE7`F%HU2FPg>JbDvkoP;017yfZYf2=zt}?UeSJGD6M^&iI$WUGs!!NhSfFAD zuyw)mCVFp6Q(Rv__y_gkE`I0gBcF3r+CI1q)(S-@XJ*$1zWN!RXy+uE8M+z?t-bG3 z@R(%fZ@xW?0~t&m67OeaO)yDppACO9-w#90XJ`Q?-YcB+07dvJuAK%q!yBqv(@T1i zQ-DWAV$vT!vS1FV7%j8bx*ii6*roe$kv`?AHm48G`|X(*7{#W}hu4vc%=t55HXIqmdhqoCjl2pUMn zU4tsEaUJtm9hvp|*C73&v^)t_0aD&GQ$C{j7}czaTxV32|Mrtl$jKW}&*eeFn#6=B zhFbkmPmHj0?&5q1XCxy#9RTY+A=Uyg)0@Di(#kYfSKM&@YcHVcqZ4L%RyM_+G$^>o zxBCYLS&!^E2G>#jm@6~_F!L+JNv~~Q+7GuM7--5oqV?hZd-a6s4<9sgo{i{WUm!^0 zKGgMb%lh@}ft0~c8BEY9AbhJgf32(2cwE$NOCncZ|Mf2D<=R~VOTgH`j@y61KL>c6 z#Xm(PA?#7{hYu@}xYok>8scd|82%u~%%E%GSc0nv)xed-8uLMx6o=Yv#-tBa@_(x) zumOl)NjNV8^}vuLpNeED%%sh{*u{jtu>wAmMzRMZ;4Ec-u!_%0(Qd z%h6p4%0iAE)B-pq2kig>qqH2#R-IQgv9M^~seAwi3{cAK+#D&g=)G`q43Vh=u0}Tg ze$zO@R!FYg0L&oAlVanLBo9_EnJz$a+qiS*O58fct`1?3SBjAI4|4riPwgnf;VR@n z8irI&X^DB&use79XS+vEp=xztbQ&@fj5Qt@R7e@Ejww>xwwi=-aeFBWRx&xi6rcm;gxh=HI~Tw-`yErBvXhF#Vu-jjv7{ zAHao2u7(Y$fxrPcwkM2@AF3H>XdFT;jmT^a^z`>3#Q|$Rz;&4ohRLhU)rWwrD8h)_ z1G5Iuhv-_zajpalOKXA49R#foK|te@c2xq@2Psp;zaZ2>r#XW8tS!IB$N6|3;3gAj zgQd&LavWt|P%rm3q$w3lFvQ_Br4ZenKW}$^QpdWe9zSg4oTk$580+sVVwY4zw8tD+H>4!0^~142?7)zhr8FUmdpQ9^@|x8dHhfozoyLXwobiHIEoQTfThMWBK-|-my z;y-$`|BP~hL>>M4duC=c=6jkAca`f?|F`&#QIhf79$OMifUHJlGhqtFSQH>zNlxa# z*wM-D)ob?YXZ&_5QBWOU=~JPtBvo-YE*5a=~2UYYa-_EZWtT&f|ScDD2R?G9J=+qQi)bcjBZkpX zdODkyql`dcy?O6m09u#@A816daGetdXOSEZ0;g#ybX))Kj*!n^X-`K_Xv>x-jf;u8 zK?1%Am6H<;hzg3axDAqyX`7ki4$gjc|CseJigV*e3Fb}$JZ8JNef|7iVb4WnCO>;t z0+!iPMor8la06gkCcf!LDp|5|bso8jY2_4-h;7SSp ze2vHP@t-m2YKAq&%j)+OXViW+Hceg-k35m^2t^7Td1JcPQAibA6HXmQiHS!r0mbnF z@;@is+zJjiS^P+@5#qTS@;J#UcVc3WA-l%zS!yC^ z%waoWxnjr_2%%)b(dd}C0?^MH`iT}RB&52&LsSF@{Gf~ANDp(91)#Wxd|S76A^-OpG>ROW zgQ(fYEnDbdJCie>5M~OAiNP9jmgNa)N3xt86M!~d+iF~*y4kK~b~M%ksq8pR`` zMI#3(0L`Nzu`LKy?a-{X3Y_iZH{3}9V=V*U8vgw~b~8@r0+-&65I%I+*u3Nu38ff! z$EWRl@&3bya+nziv^DuDjv8&pAEVMLVs@#wE;;J3 z9&k9kPHz)vO^oaIJgpu4@u2OqP_As88cylfGGW9oj~f^SV@IAFOhz1T!-k|2@DsMq z>Tp+_7Z1*4 z^jjP^Tj9&H`3!3~h@#0cI8`(&7`vc4~+p5K;(3Wp+H(V+ln_BwFl2q}A{|XIre0PzfX-22==q z^9p(_j$m1g>rUR#>@U0JRvb>)+OZ(^{{4Hh5Z?6I;t)PDo$~-b9B?({d5%BN1%@kz zC-oSKxedD`lIE`clr4%k_%H39d0dbA`u}e-DEn^gvP>dbhfzcdMWV73Su2t)k|kTz zSd$nTQY6Wm79x=)vP4=aR1&2^WGmJ0c@^i(oSE}I+xPo@{C>*mvUMow1C(zFU0m+_?-+e#xSwoTyBj0HZj}ZUT~*A%148Kncqxplr_k zbDXoB9_D9X3^9$;8a43PGyC&wBaGZZ~}Jdq3+`HY8tIR6ngyladtZzs%wyA zqUBMq$g1kpbQWGD$`Z&2U_EZT{xyHkaW7dpB zm(cK*lUfKAOpSf}cqJ&=Rj#eLSK>quJ{6|SUSKe#)$Ljyd)5dsItZ2%GGeG&hmDpfahkw2uNW0xD zHU3*4&8gFh%S$0R0COIwmm3b(5c{dQoxDALzi9!GYX}!djn`%VQ-cE3ELZbtHtwPj z`bR=WofwH5w@o;*rFZoR$)$us7MY3uI4UxFPOtYL-vv7?TzDDJ`Fs#EOk};z`QJ_! zG~C#)E|r!3I5IHMn(YaRpxEZYJcT(0K#;%>6?((VycocMnnHtMIDGh)lUvG(fhT*5 zlH;_)4}N6@K36Yq493m~ayHiVoXR=(iGKAImuIFOyc0{F=yLMhD~TfsJW1FI8axSv zWWhwOxWggwM|wcERxDprLBd6u&XzA5=`KqrRT?<3nv1L(iR@DP!=a2op~EBDs(bf( zm~WI8dajie>3MHVr|lJCkIw7!YpDmHa+=^WzQQFfx%=@vSfQM&NaO?z7by0eS#|GJQK0ZKQ3&L~n+!A}KkXSAaT6F2Ctvwk30%>^n@N{*u zJU=$G!|+LEp~mQj>$)9$IB;Qe6X2YKJl<`vn3V!Zv3IY+h%Vkjp(Ig9F1DuN3PwbH-jXKdAzR5ZHOPtK*UOD}=7P#Hx_QU-F;FX%|uLjr-{u#A$^ zV~w)9`I)(ihY(y+`a6yk{AyeDinC3X7NvtOBm19%44_F$#r|Mta5b&nhfJ})9vNQ{ z*>2a(Q>ZE?o|#ucJEEX2xFvV4isJa`O>2$`K>!x(FIuuBT1bs2%8l#SFH*E^rt7hS z3>tf3`BH!H$;ks}7yIVm<(Nlp&bE%!<0#C6JV?O4(uy#6mSN%ogFFd2pn+MV?{jyt#-?H`8?6p9j)KEr)Jl}`?c;~~ znQ>@bLZ2%3LrSZV2DTertFkf;Al&?4PcSdd?nbsGF$v>Stg<|bAZY>S;)pCd<@{VW zV=`XVb`MLe;9k50YRN`H`4t7+5Lg00&AbR^XMW+vE116D_w5TRYWkmP;@zX0^n zNEw1joqo6BD;U#`Y&hVYH5)cm5eqCkSi=9ZATL$uC`21GSI}y4lqg3$_7lLJx>|ukN!rSzBo_w=rly-;H-A*Qf^U0v+IyseAu&i z_RGjEJ5gmxU>>9>YjTyJUpvb8Hu2s%OKK81*AAi9Mrzn;l=9TWD?v1m(tiqjuhBLHJKhqUF zN|J#WG~=e|SJ9t}zLixj#~I8l(K}m#?7uM3Wdn(}kh}E5YpAd?_ykd*5^6-qOFASF z0nAtBRWKGnf=E^#Vta6w4R@cwqyVbrJ=)k@re5G~aV*LUbLmEn$#D~CHyMKqA>>vM z!Cp~y)J>lKmHhD;p@E|9Xt&B3p@h^xLwWjx*YmH60PuF|P`Ol6*l_VOXkeov3<2zL zTzER*mBrq8Z1X&aEx^In5Xcv4P-Q=-%o8NVG3Qv=xV|i090zOkF_a?SzV>BvmzxzMjo^@k-Hv||%+gafk zi)Iyx0wyF9PYt6kM#bi^Vg4=`)n085D8g$I0ZTv&nh} z;ao92Q#ui!Eb=qe)RMo5Zyvl0prSyu&@(hAH8S$eYc52{gI7zhMMHvp`Ur=Ifv{7j zC9j`IB(JiHwMl}vDjzH=6!n3GR{Ipgi3J2XqpcfV&wz_6F5P3zkKD1&p7@>a1>cY7 zd+be-4#2WF?&0{26COAI^5m@XE_yzr)$Z;iPv^!^P#RR?=2ok=ab}pBR1UNsUq48B z&2MjQ{UF!u!|9t~?FFJQT&fgDFM^eoDsV(zDh8(8#km#*IQxv|dyo#vebvzoZ8Va*)!NfI#cr8hb8oQ5 zz+XS%5;-~LQpNOf8&c=yaDPyx?>hMr*Y%&`@tb2lYyI#;70y92D<}Wv$@_P; zI8tl_#D2vnwi){&*&FluO;J&i>?WW=h?OowCAD%NQZ~J3YozMvQKLc%UuhTVanbU& z*9Ys?53sOp=AHUBKOc>mrj*UFg>xQS zW~N#Z@B4Fedw?f!@(B=31?k75ed_T^}=*Gf`?PEzEi1#Kr2JFct6Y2kgMT-t%pmTE_-_n~+s?Xxw zUyQ3m+H0QZ(yz#Pl$BL$Q6GS8vc;SDf-jUGwJ0h_QaCd-VH*rWG0=hj3KD)e`tQP@ zxO8Kv$6m5$o&i1ulTgTd2Gr6{j&zP3F=p~)Q}huvoAqwBLl8rHl^dXQL`y!%{o)f~ zIXO5{JG^the*4&PZO~YA!TsLGq;LAZyM<+BBFAltW0Tt1_v}@za%5; zaOPTAw}g}K^Dgj$jy{DY1WKRcq@TK9E2)**uUsK?;lEZ4-5u^+l*YZwJN3PYd;;#p z**CMZ|5C0DQr-a0|7Tb@?Z9sZMMw9RM>6TBSe+~tAtV8S)ZvY%jXxN2Q20M?*Qn3q zLg(xrq3vm02aP-09C2&y(w>|+`mmO|y2R^JW$(RUZ&K`kQ18M@TrL<)pH5OJ}6 zMnK5H{pZg&LqaoT*s%I5ff5x3Pz)@1Fy;)gp^Q8*s5QPS^4StcpV9nVwNG@9m0ui5 zjIq|)r1vZ6w1nI;Fz2$^4I%vm(y+59{t(9_Fws=-dx2`^&3m&jDaRwUU}NW>h^!JL zK1*JNbv#wz-Xl}w-R=4hpzX^z0&b+F?13c6J{{Zd0Q#MgI3!1S|3Ofrt}YB(4Pt(4*&Sun#0V!W*cBCtOCb3g z&7-2g9{-FSbw8)|?L-qJqt&?cr9UN|f_hcPGAK0gTToz1)}|ojk}9L&8FNSHWFrG$ zTg2sJ?yNS0^Noo)V^S{gGnAfDK?p`F*J#o{RuGt8rg_N=2g0JPt)fUSqcp0#vH6H+MU;$$T*_au zxgwnyu5+l7Te&C&h`g1^Prk}hZYQTgi6aKr6h$~lm*`PNt@|{)*}L4vK-QOGck;d* zC@Xq$eK+s@P!2rn&k_s~%idVx#RwLxpl)`qg|o-fVSiS2)&cCBrg{ShuGIPbk;^XNVt)gDZv-d*W{tV~pHYbX z4iW}0O{Zo2b8+{E=nv{5I{be{-2E>XlqWPvb}26?r4#nC&~&HqX4g<0m!E?M=&sez z^e!DsQ@MwdlTIirV=PFxY4gZ(O6&Q3Vge;xL|KLW zMlx-BGpjd%t5NCM?QH)H)Wi{jkV@IF&?OEusY!1&c^^ z;AHR^;mjW>n(J5^(HPf%iSWaODwCH@9KLZ(s@Axmb^Si2saP$g?-2sm*H>SoD6gX% zpv#ztgCGwZ)URLrUdEVf{fZ0B7dSZhQ4hr7elQi`H+=Q*-d>Gvf{NI{^a(>t^B>Gs z?sJ?}ATs5eGm=PSsHv$x2`e7>TeT*hIr;GOK=Ifdo4jb!^5wcqot)yZu>p@8XL<@o zd-(jyW9%wn`8`_MX5LVf@~PPB&3(gv7Z;t!3Haebb&++)I~F#z(rHrqR$X4TLRv}{ zdC`AGpZyPNx%*B38920E2VtjxLla8Apyg0j@u_Y%dzG0Lt^9Z~q>qj*`cVvL1F znsdnu=PtmEFehnbRuIEw=O3Lvfof-MSlGvfVOyc{;c#`j_%^!CeUZe2^Cg8jc9vnF zuoQzX!`kPpx?Z9ayT!R2Aw96rd!Y$ZEC$AW2k$3mG62i5(BDZP;=Y#U6bDAcX`s_j zOHW_TBjHP1bv2ZBiVyl5!MUf?il)NRA>HhcF)YRuE)03*T0~4u70LYs3R{2ynU<&`6G9`%pMarCBLQCWmdVkA$d8?L!c=&rXFyZp z;YO}}l4lgst#$kMgX|`7tiWU)uur`}b1EYgId3}MswN_E6)u)&v?*fTTo0pTW?iFZ z8gtVTt%b+Sot#60pR3M5)DTQ! zu6kT-e!SZ(H9_Y&lnHiI=%>p-7*W2UA&x?O;|e&ReJgAOG8FC=v&cqvEP9y$k06XbVm&#SqV^{9kS1&$0#cdqgjS97FrDdlI^1c|i2~i? zm~TFKOS3wmA;ftK8cdWSjK7Aw3PFT3GfH<*r1B7?oNc5tsJw1=>G-QM<=@hY_xo$- zFe>>)W@d%EvH7{ac?ymP37zNmsLp_iru7h=CwpK?6`&K~_4Qco*p7l5ADb(K-Ep6^ z>O?zq{R z9wa(K-SwpVC=&Y!bVRhIAl(KNSnEHx1j&* z-+7l*<9@|#cT?uhJ#NO7iq5*P%WxGoa6|0G%Hd6`$t^`o?h-CIGv?H;<6k!TrUeMt z0Z^}M_Z~idU;X8v^yGYRimB8UUllZ_F9I-Sl~j=69G@6yIC;3*K0x|yOfi)`8{Pwh zP0o(u@PAcRQm=i-wEWAzf|N>hl;w)|35)d_u8?#>)bX?DBykJVQ(;YKpPB^81Vq?= zxeoCit0s0H^V8D4CN&j7UYPLLa3`geh~&zKBFeU<`+6FpAFwsg*mvI$=m~&Cdl=vGAyWgZbLFMg*#qsG0f9Nidqv%Hk3fji1xZ3f=`HE@t zkD@PETErq@nV8oY7i!fowS93P^W$H3|Bg{om*ktow)vK8OD;(ub*HBcy5Mu)G1K%E z@&^aA&i+F-Ouwy9Sn(pR`F{54a=znIX{fmuucyF&EacWg`_ zCMO>$*!9(c+SBl>)%#}_jEp%#nAIQ#LEn@zyTvJ(FbW=v3!h&+dzSUy(Y9v?GFHwf ztJ=}_MJ=o>kTNOjDAv+2F}r9u#M17MG&8G6^sxvjVF05{XMK6P>;LP}f1^XM-y$dx zH0Af!)>dCq_w}CdJI`exGDgBySV%woKnAKhm0i!CJ(-e7U(uqy>AvdyO{2|++V|aN z7SI-4)7Z#p@J<_OG8D@YPJxTjku^ zu#&T;@#3A(YVLl1Yxk#J)Mzz+s-w!YRpXt^>R&og>AAXzN=W@JySnxrTJd}Z%Wd^t z4p@6xzf^5-sZB4#XH(Pa);4VHu>Qrz4QIC2YqP87t*iTD$DeLkv?8@{(Zkm_bC=G1 zU3_O7C*jrT=xSi<4z!cjv>f{5FiA@N%$a7xFaVP+EwvJIetuqPm|{41um^%C7=;mR za&bFIEt*`$!{gPl!4fGlUGz^TB}*Labl6h!S!a_XUC7baW{+N zSFbfu`)ODqF{E!F{&>R02RHRQUhrSlHBnbuhLkYV`&Nrks(iR~^XA5S6|ePJhuwD3 zMOsfXQUl#jB#hpLV@HVT;+$W^BxP9 z+thLno*XP{LlieCgMSuY9z+5qFo9I)KYMma3PBn_*=SB6if@RD(E+*OQ7rl@5@(^v zfL(MVNY^?9XQzan=yQ2_>vE_s9e$HYyfH-|&~!_@IOwRz%2;8afNjNG$m$B{+u~XY z0Z>uM87c-?{EU`NvVY14@7zA#2y^VS8c)Rvtfm%~T3WJX?1Tx^fYOB=;stdUH0pDu zWnLqbq2)t01Tlv76%n;qgHc3Sgq|QKIg;V>LOKE!8$0x&IsA@-)nsoUPevNLy3)1( zEX^VM(97-tJEb|iw)p_5$D(*gEE_VnlzK&A7KlfUn`}Ke+}YroUs&OyKLGUp2R5~! zurPnTFJ@ecz5P~r4cgRr03DjJaeQK9yTSY&`?VipsoHh!ApyM3C@u^|*3e=G5^iH8 z!Vzj^0#oWSL2Eteq|S2h;D=bFhG=?53VX19d)%B99c1KrMT69$Q6_)^LCkF9{ZfA`)L&F$3OuLB}pM_0kT+* zS=;))SH4?I)I@(_C`yCsl z$Y!{R3P`(TNu#d&i6%v?uGApgc7BO@2Wjlidww=&L-?XskG`k(zcTwoMEf07JV)$` zD2T6+`{jx=UIOmPIUU5#%S#C0fqIv8v;!c>0>OYRpTgIPo2?q3bui7&KHa5j7?vQQ z2qiv#FxI3BOPqPm8=M)3D2sumeQN4ewUE3$KaP)F+4s)Az8evLs>8i;<2OL1Oz$=> zFa>OI6Bm;Zn3Yzy{q~0 z*E83?V9J3y3Vs+TeMn$cGO}fuD;t1_jPV1CeGUnDt;lOx>hb z&1<>5N@1H~-x>t^DgAA#^Zi!b=J*ho&RhJid5EHkaXE(BH6-#E6CAyUib7m^ElIqD zEdJrUSd@fFvm~-x-YT~EkU2>NZxYWZc4}PXmGHu$TRl8S2fSg&&YkMy67e)#1_yc@ z^+F5XFZ;9EH4_7w1ujF&v6qEB{%DxO`x`*(78`3C@P#Iit7~qoHr}?Q`w)~r0Mx1o zmVWKSGhfq`-cJO#m{cxf?_h9g9ULyl-!8=l1<&L2xL5k&-3W1&H2eYv9QdU# zLInoo)JIOm;hOU7nnvP}=r@UByb!nhC~nO~dC8+1Z=J;rl(E%ZQ_>S9laxkKctz>T zB?8CG>nTgoIEPH`tcm)Mkj}TKf~)+d$7sg=D5k0Yq!P7kqB5zO>E{1da1GeuHBr*^%mRGKi@2c{-aJV!j1W|nlBX-(o zXdE_j4m)&=-B&_g5G1IAx0@WdIURZm8>YTbe@n}KBglJAc=k(W-H2WL@v?A>T;SDV zb7giFR_=;`S&Bl056`P=&h_cts7o^NG-rR>Yctp`yOCX7fcX#b3z`w@k?Bvdw*Iu? ziSwfQx;?$>i)J>nsTVhAo_Cq=H7;)3wrvVEPz{5C6*6XpSr=!{o=s=_#pqk7#e%cv zFNcxrutB04zri4g;Y*7mOV`4H%G?3omBjZ7L$?YgLLJ%bByJkAX@M=1rTb`weE*$r4RJ zlnJTwlnz3sRq@DUr&SeE;K!EMr*{?_?m?>}b08UCYzQWZRIlvrrps9XK{4U|M2>VX zuMhC6L)6_hOx&F;iHb1!wYNJdPS@|>_dwZq!1gx7w=v0vg<-Xu82aau#C?Bd4sP%3yT{d)m1aY#Lk}qT1@q_oNOmO$%ZAq;KYHBE34{xa*2-qi+nxrE5V{xvTn9E~t{!mbd+_Z0rX*@LgewoMAMU-wcbiQPMC4S1w@kCduc1q@N zSvs4`E9!4KKL5g(Lp(@#AjreI&!$~o9NG*gsPHYH`gpo)@)+tE=`?WWXOC!HbU$v0 z8Afig3VBM>dj$oPz@B*Fx9X)|s9i@Utbk!{Ne-KYVV}$nq2&d=!??$AzXKn7msI5$ zY^Jk#*nO+49qhw!=o#A1pNH;A!tdq+v<7V_(AIKG!pHBo#ez}_RsPK z=Kc&b<+7oJZ$)*5>1H4gB2`jCi)!XusnCY)?q+x_#X_ULMEk~v-c*mwcG z^k+=qzU*BhNu;K5Iz`l{dy~PoPwHS%f^maWALHz64%qT z*B0__D8^jbSK`BqQGp9ZL;2$)neUXI95;vCttaO2?v4)TYy@`+95-Ub`+l6YKK+;p zf=W%EW{I~ci_+;q6j)Gb=phbq4-3svLyv}&L^t8t%a_KY0e#5ynSm6kYz34r?))yS z^-_RSrIv+BQfm}o1*Gto#4Ac-i5yaQ%Kucmj<7JCzc&~S$NfW9&+jWpiYysr?Mz^g zPcg@Lmc4V4l=Ov+RT8cGVJ2c6Af?BhYnF9jYd>{d%YBxKRmwTzVQB568Taq;*03`Vc!k>>HBpLPLtSM}=)&QYa4VQ4dL&k0@@j*UNxP znOIFT)dr(1yXKEF-V$yvP;2I-51iWch!vfjoNkA1q`D_85>etR)JRjAyChFs39ilx zO3fC!RdsaE&5VArTg)eD*hDylIuKv9cn3vkN1-7i7aaBT$ZuH=q)b#~G+m?2a^SPK zhE;Mr&U%|lE|Mh7k#ukhPa|h}8@K`rTo*QEsFige5T3|Lsuz~IjsMUc90*zgq>AH3 zvl9Y^Y2bZ@Q z5{euiSWSdsXeheQOY2V^E%El)nzheEL|qN-j$b$alfH86w<`z_R$*0K$_+w|!jM{u@V{*=0 zN8279Bt=pxd?-f0w*cY$`7OpX#L2+aE9&OafrP{2e1Zi3Iv_B>E~T)r&}8@wy~sIC zL}OFzt)mmDb!gYP+1h&?UdD&-S~&aKi_b~k6FW2g_@&3s+ZBW)DlG>Yo8H;)r5z!l)A+QJy9HBEnJjU9+7# zw`N*)(T-v5&3~#)@g3#2X4aw=x;>pfi|to(Y^XtZ#Q2$Y01!D~!R)_HFjoQHb&vUt z(2%E>x?&m$P_`yjSNYGHOWp2kv2*WUtuMs{W2$%TI5c1-4e}@Af#d6@-aG^+fT_qX z?8WSyPco;?xXJ|%KpFLVCMo@6YzR56bj$@7R8^54Bj&{n&c_Su&ypkGBqT{#%Qdz^bQE@CZdc*E}`%dwUQt~1b2)RN0 zSzpa?W5&B>Jfyvee~0v#hxCXBQ##$XFlsVAgse%l_wwX&WK+0D#PzKWP&j~mUn+g+ zy0DyD{$d#bn1USBFXtAjz44{b^M{d&CGl$rKM(l&R)mWb!U#pNqT9D)(CnnnY?&%b z`{BR3A|B4*#R1yHOba!>ZqLyPN0J(7z2EpFGf^(`#)(nx_{ARB$Flcj`Ak^+RTR!B zxKCUZ)aoMMdWvL5<`61bS&p{0$!qm}TDckMLsn_#czAf&&=JxY4n}{qs32=(&%qCZ zB$H#h@l?Xy&{BAAMPVCqWgd|~VnzeiHzUiVd0(d;49sX1-;zJ@=GS$Y6MJY+-8y-X z&UzqTw7$7h%hqjF5-#}=TjQxlMs6dVX<5ggp1JvCGjcM46xp(WQny{XTp9xkA7crl zHnUO7cxQeDsg)pnJ;;af>S9$9+`_c%pvQwFB!!S4_!q?qroV!&>uh*<92B!lH^``P z$NZ-)Uuip#sOb+VCb;0)bLY&LFF(&XhcSaGgv4`Jrpy0p2XObm$ zdBXK1+rXhzIWe6wkj`{S#l4x0Yl7gJTov9Rl9?ibP+x zs668H)7!ET&%Xfrf2Te9hWG!&FP~gomtqG&g~^6XB~`@qGe2Yfq03V?*=!rMeGRI0 zkmtbVqTf)`a&l4*zT%kks`}BzwJPOsG!%aPg*=`l3CAW1bB&bo$0xc0nuJ8>4<^A= z*1uQH48M9n;WVwY`)tx{{-3r7dTR{!D2nP~BZC1J|2?h37V7B``$%%+m=jAH1W;-e zXXZ8rQghCRL`MZjb6pUX`DAw~S;Wmjrf0(LA=AVGZ>S;1JSbU!&96otH?+v`Em+G3Dx8;4CG`? zVgK=OJI4Mml=Eb;i9#Ixi;6;r%3Q{+1d=H-Yg~rdgEEHP2xn7AbKM^xgVs^vozWgv zRItvV2wKhdISr8I0g0sb)m#b}=e8qhSz$1Idi5U^X1-P82-Qq^!5H|gyFO8*gLg%@ z&??wIp!~|YASDdpJqhn_*YXdBlL^BjIweSjv<pchF}%TCJ%_0rzO32=|;OUV&S; zDktxuqqVxD!Q186^HxHIq){OMs zH)7`0scXQ%_1k;&w2_!{^2#+l2~c6|Y0#+m;Svz4^*5k<-?GYl*#`^FoQJ3V?~ZO1 zecI!Y$^%C5Vxtuqmd~v}N8#ZV8Of9QJ0w0ZRHf**m9^l9^xPY(?nw+KjIkMUb}lIKj-AxqiUOx1Rstz5!il!tpRxF9 zyTnHiZ&H+v)-xSC%Vtqtr{T-qZw&9*DC|gA$C1m3r`g>8JLVVZgBCK?!Pnx6-_S-R z>KX>*9t(S-KYqMdpUd}cIru?Y)?lro_>eJvA$AkM(z5F*ir`aqe(&(D)lMQ5@ogm${QRZ#+gog`vk098c7(u$u-l-lQVv(;jkU378a?Ndfmd{ zLx(Ceh?0nO_m~gpy3I8i1Xq^jd88a7YWTM(`tF#n#6UOb+(7q0PDa4JHjNF zm7c&fsCG0w8#HRv>+`dBv;L%t_U?b;cU81n(s^%2W7JsrIkQp7m5)3%rv_jYq&k)m zQA9>k=u0dp!T8Bv)|2hEg?N>!vlc6v`O}Wgvaw;h+-hKEpH2)~baC^7CyARqu)PNZ z8(O|T|898T*X|dMyDDkv#?fIs^>lDYmX|V)I|_czv)|`gGiGELNP~kSKRBjW4|->w zK2elV0uLEFbRh7Ehk2s&XhO*dq_2auYMvy;KYLbn>#SY}9ohn$FcMf=OBw*fMT>&t zHl~v3M%@iuJOKS8JMqs{)sk3y@&0Kwh<2OBSXNJ9KWT(X34mOv%vJuoW)J_hcYain zsu%5?m=4m2RnYbW0V9OpV3fEFM`Zslp*75`j%^}%2&v<(al-gs5A zqbxK<5D38G%3VmuKUrb_feZ!()>3m>Lt_g8eB`L<@ZpD80^1prC;EKC4HBAJ-9*uR z%)Nsfnluhhi+-F{33V?6-CMtXcH>!A)({RsDVLK^TCE-7%pVAUt9__#zddt}4T71H zA=r@CgwVt75_esq%g-jxq2W%hnh_N!Z+Kl$s;LqD+$g6lFt9PVZ@2UHH@_x>1cB#z zEPXqj9^wEJD|0I6CLf+>n&By>q;7*$Xu*;t{tVZFK{~#L(>w3s>A_{D1BSV~!)a@c zJ^2kEofv6-4%}C~sfaSwYSkL!wIC}eC$L9x_?a`ma99r{I6^Y4sV6L)I!|h9+E-m` z_ls!C#;%*6p4%w@Ul!EPAO2a{MsjvoEl`4#3>*3BLs6&g*X3FNEv`M}fZpC)^7Y$o z)N9xAE{lUH$pv|3pis=mG6{5k8MkL!9}uh;8(N9ky(5a3edA`l3I+p3DX2*j16%Rks?@C}!m z9Vh&S12?Bvfdim!{|75@^0>Oy5tthAGm9{?V?ML?T7_lvCJHX!6$F6Do=IhF& zE@y6U|1%Rj<~+vAPtSOHvamn>c-wGK9LdA|Va+ECyP6)ah`}UYDcWR{n}^wrUqzj( zj>v96#5PgnQTH@MNEy>@qA?pAA@6#I^Vi;z9a3L95<4WfPHOR!JHz0KdMOjv;V;Ay zC94ktktMFWk3h&idA@uF5wytIhmJsW$-TuwAl`&15+M-6SW)x{gdHKNH2fm%|Epi< z4K*tswiEWK@z){T>m42adw#NYxX>OSPly>pLQU)4o@X4_^6*XU(e@Ybx=E zGYNT4QPIO6Nj%uucXE{J#9ReA3S~f^vP0pQiru$ zmETH#E@nvM(rpxj%x3!X$*y5$8?RaI>qd*(o$oXwf`LcP3{?2v_j+VxR2!HOwUr2L zS|=wb`RwN%*4?S1&i(IhV`qVzt?OhX-SYm3K0I5HE&EW(J*y%EXQx^>~#P1mULS%O{FHW(TUZ$m)7#pv-RhfA& zBqi|}hzJW;niP?+C^Lrgo7FD6RRx^xv`wEbif+}P6m>52+n3W4VlllNSdk+1J=v%r zk#D#-+bZR_!Obm?O^5UwnSVF_)#;?+;zS1ZeUpAIW4T81eL;abFGbm?W4czJZa%Sm zR8-XY(bFqI!9_I0s=Ir84~6bOeOj)Y|MSO>emmhF>BBVn>}@f}iAq<8;iAIALOPiM zKV97yT{a5X;(1_r=)5o z&tdk~rZ3J#<(G#W&JSb*_z?TCnjQ$mL`ZLM@9yrd|H+?gl$3#RC3v~bcsfaVy{&p>81_rE;2*SRCjUyAn<3p?(&meQYBy%Co#5CKUz+zwSv-&IF z)YNnnouTx~ZUhm7heW!1GQVk=O-8*%&BneQ z6%u*0V2i0*Zz7pf0gtxwckfyj+@z0YLa?*1-?TBQ@z_ZBoRY)F32Ryz$cqRIdr)=o zXJec`0){w6Q5DlR{gY~?E!ys!P~c%$NMX!QHuP@H|~GNI1zA3PDluzJUUq1 zE8UE$Us`H=%*ztWZ(1$f-T<%p-KEN;CEzlU$#O2|{C^Hq|8XdE{ES{HYF~c*yCczB zNlEMU3pSRQ8P97G2;#Iz)%`Ntp09?y*x9SA ztEZ=@?d_@ws=`*^V_&_ZKD)Y)`V z|Jx7sy6(f$ln6K#OYKs|cABidB_i^wy$l^8>%#m2MZcDNTTRX0&hDELHxG{zGl`%r zhc1LEUth^T1egfKhoDHF#!*gRpM#I{g3xg|L%!8j>vu+#j&aw zFE(!|8niE+gz%%vO6sNnudJx?_F^`Ifmog*Cby`lsIHEVsl}#D=6E@$>d6wRi$~M1 zU%zJV(=)j*{7AwfV;4vf2)c%l6`DI<_LeeJR>u4)4dJuSEO4$R>e0Y^5{jS(Z`AdT z^>uP=jCUB2(!~0s-y|g^b)`!VJBoOEehWs&^4OeM>4ONIoS0Z!_!Ms4;Pt^PfV=$R36`ukQl35Q|3GIx43XRR#$inEypFH@(og-%-SQ^fQ~Zbb8x7PMAD@ za_XyBU%mHi3I^4_jYg4QyOxxgn3$THnwExtCW1gjGcxxTo7EjRh2drT|G5uW?6Pri za+)l6Ft~sJ`mLHVNZB@#m8(*IM=lBq3U+p!UwIN#aq;l>_VyBAyucQdL?AH4nTwXM z;kHJRaY#`^wq#3E!}<5`Az|)pHxoIJec|Ha;gOP>uog;6PA(W+g`h;@0x=ZZO_BBZ z*|TS3V`GqOhlYn8gsGzxKU=m&!z`2-^8VYx$x2}2rEvK1lB*>R4}l1h{Llh(`u_(y z{Kq@;zeh8@p`8mtsa^U7N$awl5trEkA%GpLZ1wPAZli@P_U+vMPoH=xVw5~|^sX4} zBZ7jK+^V)=_H_#e;qyCOk?Zn`S9&Z5fBpKkq9P(Rw56q` zWb~IN0fYnwp6T?I_6|Y!kp|egdgo z^nB^*>F*T#RcHx0q%S||>#`rPi{KfN+kgE~uS!Y;beXT9UxK%p5Lw2^s3=$GC=`l= zhe|-U_bEDJn~#M>fj#j-&g0*1;y-0@P2lyg`L*%}R^0!%ezN}O^R7Vw?Hn_TKFDI$ zU4n<3`%P*pi9Bf(D<2<0^<)Ufejhq9uf2mqDGXEpio2-u6sst`EES+hjF>-vJPu9k z%(kS%Nqb2FnLP{hyodNeM$8Inl9-p3G^&js)yBd@CCgfQ9Z$9-5{2>G?cr(qF0uiC+G0!obR} zwS!GQpSmf@6x|3}#%;Ucg@O<0fTZuuDq~XG1_KcUCau5ySjs^dU>#+9GlObxsfozHqMZeF;#FQOjijd6;g4-LzyoQB^QO992 zkzc=#Q*iYPaTXxqjBPI|6iEy0ZFJZb)Iup51Ox;S5PFt4SXp)a9=OgpUyg2ScXu}+ zF^h4D^lob*0tRGSt7QVsHAa#?QL8xRoX!R2qjw05Ye{Mg^##Lg8xh1^XGd7`jznvzoGv1%3yVyUJk!Ji8C+qdsB zR7D&S$;~g{=N)>=1}43!C*IY>a1sxGz77ikwM5*4G`631+j{L{ig}lOrf6 zV4|Yqtp2w_4V}y1ucd_LGQ-0QYnqraiD;G!k-Gw=O{8Lj&w+iq*5Rma=7VOQIAtqu z@4ryFRM-!G)JFad4MKclge(IycVx&Cr+m}zXdCdLTh6Lzw6%BH=)|vI)@7qDmZc{A zdDDmTc>^650+?$T5GNr^K{!-ohWRVmzF%x%!&@l|S%&`F=QnTOpo#X~4eqdRiqRAi z6@@q{;ji+=sPNjgYf$K7XD=@=fBEv|N0ELOy5xwn{+IHf72 z^l|QQuG8o_ilnN1=Xsnzv;3$rE!scB1UUpK312TpU)*N?a$bgKfESwwC*9P zR6WCqXY>7;Z?jEV1Obh{uI{r9$O4AKenIjI3Qr}{eer%VuE_xac5o>0#UtNax%TL$ zmE6n=wcPnOlxT_uWK>?>*mW1Q4BdQ3d;2C&KvH%B)CA3zrSEj}Pn6ESB{OQ>zFlfm zc=YrPN<6Hi&_={7QjD`k%hIftzZSD@Rd6ALg29mwG;d71^YZd;rf95FOR=-Fi;H^) zX;YDs3R$*b=kzVROF%`GZIyKcBC{+K(8sWvqzS+0a&Pwi`}eW48>!7;Zf3fBr6Cm} zwk40d@UeLX`T)B8w{#2?K>>OC1I)z+fGhdduDTP@gBWhbZy~t8z|hS=n7i;%_R*EG*T1h?U;F;ZUn1q5@oY zyrk$+Djwu@PpV8rA5YjlderDKKR2g)_ihIPPEc?N(ubiF=|zr()tFOWeywL0JKMP8 zabpYu3hj!yHjYDjn6H7KjnZ`#Hi^44FRpY)`O-}K)7eSGXQ$HIai(ztCH zb3b42#Wj4!G>Tma)w7aeRh{Dj8mueXMo4-WXktWQBc!v1zyB#iHL~o zdev4|R&K_lVqzQ|9GX3Ib-B*M2ai?vx9Se3KHV?F#l_X*9wgJ2x?^H;+QE@Y%y6BG z+@t1fqUy=WSHLFr{IxPn>1>p=D8$%$i^C;vJm^YkQTzqOM*!$*8AL3&W zZxJp8y>`@i2Prc__4oN-%4^q@ET!~javYq2U4f55kx8TRl-E1~ngUu#$BD$%<7IT} z%$~y|yng52Lxf<;&)8Ueze+uO`;R949HOlKe=Faj;^O=_%7<-!zTTO5(o<+!LopPI zZ3j~eksluZo5wZWtF>^MkjC~OKRy-~-b(HIhc`^oQ1;MyNk%~-;y5DUW>qr20fZ9Z zJ-y0%o4(5024yNn8^%P627AFEH!=3H^lu&s2_yEzl&;0+&xt?K z-bOd!7rm?(IAyhAmC#UAmpE~2ly7*%x|oRaHmrc$ z++2d|Lhk~#0g_^%HO_=#+M(4vQ0S^c3oiJ#eMlqv7(1*93J+3+-5soey)MyG0`|nJ zfU{%svsD9zfFq{TJ6A%9tDmmDI@z8A9y2mBvbR@dot=aBx8ym6goLD} z>7u3aDYoRjeCjgXqRtak=v}AjZo;q$T17@ju$%B3+`UWo>OC82lzjHGicI=pNfi_v zs{0l?diwg7kjdZm*>Q7ot8V>zPq5{x^9~hT&C`dXm-adNvr%AB{0F%S1+`+BA{GF^ zTeohFeAUV;Gvqy6);rjIc{u&kF}X8$c+E*9RfjY5{=pZh1SbjvSwer=mqXf;X1EhP z`53rrt-QO;39!r_xc#W1yoSkALm55cp(VvAMr8;3#qe z^a#8f2eR@TTVlt=R!(&5-1&lLwvHIQKx0g21Ip&kuH+ z44SU^meOV8wv|JO%McaN7EfnTYzBGVJmBv_kIV&cVu#Spn@oMviBLzTc7>a=19Xly zP}mP3BNae2`^)|L`c)z#FU5SV~U%Ns~ZPoKOn#9>WPmHPg(*Gk~U)=rsa=@ASA)Wy=$b?}4$?Pf~Q z=umAmf|iOZDiOc|VPojMre5k=afjgM@$@MWKkGlJSrR+2D?@h-pVt)?@e2x;Mr^h7 zC#x6gd%C+rai^@LbX6@P=uou=MogEqZeV4-bFH@y)6LrYH)PWj*NCCIyVy*>AZBxV z`dq^eJIUllB9V+un@K3e28+gLAdRfKS94@|$>-|wnO3_4F&2tNu}y`KnY6??y7A}5 z3({H#GwvieG1}BFc8Zu2X}*FjzoL_Q7qRNps(H66HFfo!;=!)2uI31$w*FT}h4rv; zI~PE3fO=f7=6si*d&yk_CqBEro}LCBGDkvM+C+0_|Ex>pugD*FbH z^c^`M6o3p?%Z1w|BqV&v4_}=3F9%{i1dB*5w;#Bq35W|I`b6|6?LS!?;ya`%u`hqq z&VLp39}<#Tq{wYvibDaJyE%Q8o*Ap|)lfb{6};?Tefb`fmZh*-bXHFi4+{yOZS~y} z6`g1CFTINM9mOy`dGBLS&8;&r*g(8fPeX{KAueZiRDd`W5EFImrCwtA=_($DMw%FK z?wsV&OBufLKMdYy1=ddYPw@pTxE|i%;>wQ*sk2&JUsuG=*W*4^24bUb8KcTeD#Q2i zi*7#ak=?n8}Cu#?O`}a50_%JqpV$ zxpQ!DL24Cgv^922{^{$D#13|?w2{HV)&)1N1E*$V0LIqV@04>IjgKp0p&;l64ynCe z_U!BfBBZmerV~_!pWpT$UkT>t=P!csp9Y@8vh?)~71Rtc(&q6mJFGWNr7cUT)MX*w z%tt4^F|P)W|NdTFuI`HTSu~V=z!b+S!yw#dK0C{CDFUUKnVh^dwKY08m;_anV2)_}qw=xvaLjZq%Inu*WYAq7B0-e_ zJOqVpOe-@v?t+_mQd_A2RV-*$@B@y&Gy#zfb<$E&LV>eQmpWD_95)65$m^$Xf!ucJRqPSeUedFhsL9yOv_dTADCh~7s^K467TOys3`2)(=^l|u@ETBV( zi;vouhlhn-ZDzCX0r1;uIlJSvY5L%jGSVZo4$AShC48To%LaRM+O;2DM6jtYx2nop z2a}7Sx`y-&QY5kblf|E0{QT@(8HgF=Z(6wD@o*9j=GEj*f)=7Nx#8a4pq?26?j-ss zFUI*s$S5i?=38N}yKEeh+^uVC_Y3t=6hE}Ycl(}}fhy8)x^M${3xJI$hg;5ec7|m( z1hok+Q!F`k#t24G8(oSAbd8O9NTVNlXf7uE@;`j|wq(r4&i?0Ny*sFhP}n0? zybnipA9R;#BkNa@dp~c&)!NRVtL5&_G=^wPACS)m-$_0cv%}@Da4H)GCjW+cz2C;z zEtKw?pjWkP%ih{QHbk>^mXWj~NF=?vkFN`C<*J^K2b>j4T~Ibwxh?!mxhZqDe>u!` zH%iZzx#{QNXDG;D2c?d(2W6s6Zujtf%ZOZ)i( zG5F1V$*Az_+qchV-bw%(hO!+>EN-G7+dI10L`1_Y?ne{mA&s)5TP)VMH8k`%$pI!o zHStUop~;@uHfREtf~AkO)XzHlOu_4)ZLF*oYH4h9XPP_c7{yc7>(k_k_TAQ?e1dU(9sI>fiS zyo?R>`(6Jhz3I=NKL>tbcxVX7#(cdufW9J|8DK}4m0SrqBzX|yb4UmJ&cD0>S)&^s z**cN;gr6U{8whflN-R|=EDMNmRVL>k-uzx%BxSh%6hm!RI_=P)yVT^-NN6Q5Xtkr?B+x>$<7I4diwsHoe%96)t_hMB(p5JY4R_Pftf)IeiGo;GZF;O6F* z6)UmiA_nq69Z2b4V@#(Hc1i(G94V^RnVH|Y)7OUj3;Ff1rd}ew2sTf^=9d*l$@~XwdR%9+d z{*3w$f6_JH>qo@>{nQ9$7Q{6*HQZZEoOhy8&OODtF~_s>Fa3loz>Top-?8R9h8=qN+(Bo zwpj=O9XvHQ79Cd|6&?LdvXmY|c*X*WJb-i}JiHvoIt8@^RaO?2_*(yyual3HRasxA zCoA5E(i8|HQHP;V&z_+rsU5VCX_JE@zT3gkqM|JE4`Bt6I>dAq;@#gzB8<5Zu|q>c z&nI6z5TJ6oHjTd3Zvk{FsXqf~ysvu)oZ*5kQDg-lKSsyIz!3g+`};kP2CA2xgge1H zoV0?L7&~_bWS?jKTKn<10_cw;dS!J_w&NTXRQGGa`JT2KcBWZn&GxS$tzv6F0VBJ zB(*N>`3I0da!q8{e5+@h)n&8y!FlZ0FN~-Rn@zQS5L~^t8?iD2&;Nq@-D777=PJ`Zb<-o@;JYA9bx`ex(XQtDyj@?MhMube&+V{@oz8qsCBM?e0x8?Qy7>T{L zv3J*=DeBEY<*{@J$hO0WvL9l*Y<%%K@LuXNWNmF$zrCD1;8>t0ID9z=I}R-eEm)J6 z!uO@_@>4nHLj8h1yVn};P56mgNFr>?s)i{p5yXd2pIYi8THD$VAKu|0HiSoBgO$?| zaQ1>t-D7J?Q(v|Y%FeT+c~t2J_-GI{$CWO#XaUl#76SDC`*+qwhC#t9F(SlfLS{DD z^)Wm89&S!j#9STMQdNB|;zTXqZYLZ7;gLTX&!Go`e`luxHUtNMaFBQ*T>8zleE^06 zU~oJSHsKFkFKvU!;3KwTVD2Age*5>*l6Hy^n~=~8`-_3qRr`>}85gm4x+@>=6-a5V zx`@Rp&%;2G$O9$Gp`C$GKv3s0D~~wSEY-Dy8sKEJW-IdIKzC_Sedsn6wa=%Is1(B< zdIQ7NwVK49h*NABcgO`|-5jKUpzRoy zn3@I#!?2#Es5vy>D5?oea`EvUEZ6aJbMJmASa1=erl#KakxuN0jgQ~#WSxbI3h)&% zc9tTgVZGm9$V$ug*c*(`R+ECPryN?nZ!~C0Y$?^$*38`JeFc^qfbkt2E4MnW){Zkk z&xSX!?M`cK=tiF*(y1eT9@}VP{qSLx!O5yG+pQ+AVKv$rlROA-6);>iz_7qe2o&;W z0ons@rq1jJMGWlqTs14X12tJB_?77CLC**NN{@TvfwbLcPJn1?VO#Ity~B4oH}LfZ zUa`?4NRgpZLQ)ds>}V%|z;$LaKKpj7u?!)rNiP97QPa>ol`vIQR0II}TyGsHt{k^F zz(N6)>g?c9Hojq5>NVqRu|;$fH=s7Seve-hU?Erfa<&g!6fluU44{gD4{mCbH?#`I zg@Etw?#@88xw_hf=?u{fyjENH8$o8;Jlh3C?CW%cShiNB+^gbwyJwsP2oHliw`ZjV zHFNsD3E>5|uDHKSN}7$i4}0&E`j0azWTuS$uMeSNW-f4MlODx4WmZ3RU|0lyPezz_7zvUIcI;v5QFS_;-(;_KH} z1my_p`+R|!xn%gCCqZzNA&}k_-D*OXP5V`HPc6hNr-0g9X8C?G}jc&eBDxrQC` z8Dwe5f9|%=N1L%HdNVXy2psv+!rU)7n?v0 z4t=_hE~TliuCDvfM?nEygzo+4&o6YHwbURT32@X)PBjyA9o0Z3mnQH)9@vtI=4=Zu z#*vAn<BmlMC6Y_!|@=L%Mj8>x1Pi@$OM2H5J;sin@aL zWHvx~az&ZwnU01=?8%{esi8*xEP)sVjmgJB%zhKG<>MQ1adE)XjXYLRXhs;s9sL)t z3Sla7`@cI?2!B74bHT;I0kf3`$XcV06xbMmRK23)5JB3IGyzhvYiFFobZ{sAsIIOC zK4tmuQYOPuir0Th8`M3PNEU_807Hqu_q=_xFcl2b41Iq!`K@0kdJ0J|9M483}LE`#FZ?2dKysZK@|T zg#w8IB=Pbv{k4L@Xj|`C&!kB?&=-3$Wl&C5PtCz+cnfO;VFb>Qe{l3XfCZrMK#BlP zMyk^a9%`os^>Sf;{1AMBW`So<9Yx5#ZnuMMhvgOz<&Qb!N3h5_JbwIj)Db+4V6cON zs@cF0^RT6c(H@?WE8!^V(9dA2ND6V92Ll{PvU+d~T4(6(N4(l8Z}MZ@`|c6$|w>cE?dE*>GDE#^8Gsxl8Rz*+uFAF=bnDDCxY z)o=cNK!ntev$C^?2N6BmiW=y3CRF9zFBS^_=)`;u>Thc(!oP-A={PcQn5 z{Y?6R3isxf68c7+DCx281v>%8{bf?pHG2BTLMi{yxChw^5tzGQcg?oHj10ueCMc z6&0E9ms+-l;*eR$TQvZ3)#biQBK1y)nb{H?xlkK|#Z~zUrUclXT$2~T2dSsE58M`f zd$M>*I@R}PXt1*^qB)d6V1a!3ccWr@Y{LVkmWqDE9t((P-YGfv=>+Gr?P>YZZ^NWkYi-bTt1X<*wnc-Xj((Cc@G58{;z$^*5ex&3JAP(tUiHY?*U2CFl_(z>(^ht2!GhcyyOq2YrUUnX>|iLKiOGUXx@RmpFGV5^X#xZo-TW5c*~|UowRUv~lS#wdTl~D*>G5NmvQgk~!Igs+ ziBi1ClR4u8eioh?s))CEg8fCMlG2n)N<6b$TBDwWHXi>X}mojC*-Gh!642vtGrUBcr3EZG@XcLqkx(SdBk=^eCji2B>_P z`6`nl4feGvhTFNikc6zp0sB(Kuz~g(m?`Qg;#)$2h7SoE>34K#gPH`_9uNs~-ZtQx z*iBf5^s1dECJ4LzTip^kc;@=v4y=I5s`f&KKIyOqCL`F^J5&eQ`OF>$iwf;~_pa5a zse^c0@}SuV`@2;ukfFneD9#1|C!ytXr(p8-(Rdv++dY$Uq`EJW{umHWUtiy5)H)Q* z7|OSF2qT(vuF{w>CwERZpn=Yc^a%1Qc8((8T=xuxN@p|1<2rsg>m?p~Sa>;rRG?Gvf&mB2Z>VuYav}*_1(L1foZjqLAU_U2+mq(iiFJ1P6Sw z7x2_T_OK!28)20_6sFz@^9Sy9XVB@ln|E=dkGllj*WF?h{x<%dJ;}+-oEW>{yUMLu`}en>c5rc2s0_kIAJNy z&(GIXSA$!Fj!?zlzi!a}T1;yl`!ZyO>S_tc8i+PoS&ZP(Xq#VHTpSu4Tyd8uHTd5WYInA z2$28M?3~8GdheU~7O&C}gG*YZe{p@Z%&@c2xB?0i5GAX9BM0qU%cR}|g?SRqLJYQqAvA{ z(t-jWHn!HY?gth-ukpr!dFvwG_AWU*QorzT7o>^>Hx1BoGSY!132M2QCYP&28JLJC z1~OYfyo%Fmfp4KLPL`4CmOc6X9fGvOFE>76yw;w|zfzQi9@ZxN^62OY8J~VN=nwD& z0CKVA?Yh&%A+@l!-aGO0f`z|zlj z_dOM(H7W!fPjss#RRu0)7|Qq_TmlvW>^1#@13=ZVJYy*Ma3@lYz~a2Qw!uXnozc+8 z!Nzu*l{8(e&893TCnu`v?N+t-z;3_#r(>TyJs|%C9oG%fwA5rkzYaccTo?4ZGH67!jN` z_j%lj``YLo45{hF$1RpSP&%-Y-iFSQR?C&uRc5hIS#!J8l##W@vM$@_+}D3j?jJv0 zqXIV(`}dcr4pQ!sU@3b2@8aCWpNa<4dcP{QT%&6D6(G}ahg+etFZ>T z)ALAjlSf+^(_`6=lq!JCG4gfhN78oH6Q{?ba_(La>L42;y;{1)Me)8 zna`g?)k(o?7*zf*K@4)c|7AnT_1UX`ej*tb$Aizb)`pzw7s`SX9h~Ey5p;?2) z^_#R?6~1#r*F;V7tov9Sit_Q)&v)P6#0Pg*1~$z9xMriKcJx*We>sN1(UT42wxN`PCs_+3?)c?gCzZtMka#6GOdh%ED z)ia<8fkeIgUSnq}{OuH@*yy1B02V{mqRrxK!KPewl8|6x%W3I#?fsrWiLvqf+w?0p z<{Lx2Ua4S*Wl9%Zbegx&h`yjAJp%+;m;5+ObUqk8UfP#Ri(@`JA~c2)hA)d^ywI37 zY_5Bz3?(B%D;BiC(%2e9uOcB#t-61^^jBe~>D84FG|A1grbmNCecxnFgPy$4&E9J8be_d$h$o(7XLsvPUz76e9vr-8r1LFe zJRH4w#_jL4e_r4c-S={bqIax~)lX@?Xb8VDYVPAxbiU4H2sp3xWwG|2iEnUa8LJ|j zzV$Pe<2ZMOHl!7ohnty;pV~4!ENZwIJfsqM{fa1J%g2+^0S7#O!(Q8r8b1)5Vx^^o z>D`r9SoZdo@z+^=_V0jiJS+2=Xx|=(_SajYo&jgKK94uk`w5t2Z%2EAk)aKQvu*D864%ut805e@7>!u(U5HY;^Rt8Y`j~$9?iB-KFD2 z(W&3wu=!0fS{q%``KqN#gCfRI{F}DnTa$SAjwiz6={Nc;wbfbJND<2zMaxmdFA|sn zX0Of;Xx}ssxbL!nJH#pB_U?=*kWp0NBWip=V#fxvt-&MHa`U}w$X1gKa+XN9YS#94gwQ*N~z_6*Fk^fOwp$sX_aE# zZo^8*2g|Uw;vTTL4FS6R-tSj%yskL*%ebMMLLW+F}Ulrdxx@x<0}YZMhu+DS$qQzd+&48LJ_HLggU3SiZXQ@ zszTquYU5aRY9@}BD`17K@8dn*sCNamX%k{s7%^FWWEJSNkz5k4Xyb$zJ8ebNXM{|@ z1*lqX)XoIFz8d`_c!t<3DnP|mFgmhw4>Fo$VXEjwu^>0@?87bwpXI=f>(@QmjV04L z*%ksfpp+7?e2>{-ec>?uc|q$WTj9bXG!e7uw$jCE-iZVIX&Xa=V$;6Sh3U~oMew;y zSYrR;JMF*|zFnGdo-AC=PvC;C%Z4R_tSY-fI(a?7p^PbUMT;ddO7X4axXsPahMSI0 z#8kICWAzeoMjbuBdP|X0``8*6Uzjft1S1~MMQU*fQJqs_q`f@mh^s6xr)T>8q1e;I z!%gVsBu!jc*sMxC#-9svt+9wiiCfeT57{`78Eh1H{{&Xs9ITe7iU4M3k-@H2oSv9C z9W*dcpu^4*K64J_nX03i-gwceU}QurzxeWH??>+1y7?p5^DmEBTd=ULN2>1b|GGQ! zHQ>O02aDl3jkf2j8|LS8F*lC6`kFt`$SO1u$^2poT{tcR*L4!E15x2eAqol!D@zmk z2konar+0Ex3CNDpbH9*-ACYP2&qg>2i(+STA{8kY7;334cmK|r*7O#ccE`sPH=17i z-4u9!eRYm7t@Ck(=q*=r+~{KW>4W0Hoz2It>0-gpZuDVIbr~X#yB}5@o>_44Do%+W zC!5>2h^2*Mv{-)){BwPDc0ZJ9o146IDUk%b1MVSV6{WawIJq=sxqa_$tJh4>qu;9R znJ6m!X5TH6Yo@Y7^kR(X1DV^Vv!5TPQ}P?Gt*YXEP{}rPIB|K!+bFV59e1uB*nh)( z>U^h-KO$ti7yD`yJ@Lo+lPv-~N@|;KVaIXhpEWUu6%FMm29y)cd+ntfK4kn#wf9X( zEsYDEBSp)jwwfb4v@dLQP;gA^f+cY_8iNa>G3aEGO zp+EoKfz4!mm&};^TEpq*qXF$OZRDdg!H_9BA82BXw3?{6aXQ>kU-o4G!}+QA4iLRt ziEfE6DrHV*1gNNJa3Q>KXzx#T(`v)>kYLsSb1LrTU5q3C2ZqW@O&H5beVCmPj4rV$y`jlOpYM_ z?4zlnV8V|hI4NnM91cHm(=0PX6~+k3QL)&o6MP9ny@!GNz8Og;LAMoQmC zuRQ&NlT1kgtVzb@xd6UhT5}7(pOZ$_Jl}VpulIjHVd6Nvy;&oCjw{0%s-BF?Zw9Th z3!BAu@6*ys%+I1feb|he$xWW{Bq+1Rvy*-rABj8$*OsWTaOk;EB2YolMZCDQ1jroP zOJwPow(4UhqKT=Hr#hiMH#qJcJ-cexh-RyTmDodh5Fl2mP-z`ipBq+Zi<;S8_!C7Y z?p)VOdiDDjiZ4-oY+REeaQ$PkEd_Zbz5mPg$kUie#bO;!K+}SrnfsP;x+I-s=vQIewqJg7VQIR+5e2^NMF!()LDi_#0(X(Na8+&N%&uM zB+7E}X6qc)OefG?MKp#*Ub-N4jE#MPfdgeKP8k$;kn;r}G+}_79tIY{*iIrGpV4Zm znIhC$r&K(gDe3u`y3jcYO!U{Di`@MB>C?}gVL0F*NapfiA3n4@iX6JgDk-%B2P#bs zJ(1bX&|$oZ^HiM?{2u9AOMRRaF`)0OM#0x;qE}O_!@z zTI1xC^rhw0P1evxbUwB%!SOM!l8}@(qN2bP%)<;03*|X}*!hYiPP=E~0fjlw~4`SJ@wQzRFg9CcLS=*i$q_=eh>7-ZdJCFA= zqogE7#j7Tr1X2UKsQZ2-DPkhfu0C~`4DxNF5&4K!KCJ~o<>-Oksy}^I4?QXa8QO4G=(PL0n~dYNrC{KqhK(I3(5eW|E2Pqe zF66jw#r#(g|5vAOKyMBri*l(uy~gK&d-P7PiGo7NMFuT2=w(sDX$a;(PB0~R zb`XYkLpXy@^2=Vnx>TgUkDHqi{P=y~LEy)a;oJY?BR>Mb&eCKdfIQt+s9gXS05&{b z%iT2CSNqF-X94XXhtM!EY`KU*8*)#&r06#b8(<&4*-~A$m?F+VeF2>ZbQ#c_3iTa` zR6ZMif<80Y4kuhMz>fsA{^1sre!)|CIWQeTS1}wk0m>UX{^GcE1KrF`e12%I3<>}v zDG-l92}1u7Fp*$KyGvAs6c*mEXgJ#dovbeKOW?)%{=R#PhDhMKU%62naWz=c!DB)!lF>C;~Um*3sSM=qw2OpRuu%Uqc864}7KRgbbWXmGBZCl(RC6ucKis!Prs+&$6JxTh*G9+!uaKs0s*Sq_T*nGI>F zS)j}5NJ&9WZL%yac?JG$Dd;@}LAD+O4#c?%=V>!@^NTi_^Bo9gFrHOaRa>=tTAtd* zCMG{^%GA}=Doq|U1jHy}*S@vM^xN$K38Nz(?Wpr$Z5SF+b`EK>K7(L}qFDb?A&C|| z16;Rxx&1w$siuH`FqhfyRWLOF%TruS%D`}O*l+>8{R?i%e8$j!xCr8_=av~N54Z`i z@qGE>4oA2^`zVw9NU>3qruN8uMru5_-YUfaFGnm7 zvH%$AQBhH#DWIaG|2euO541Q2ZS_~*)c3*kB2}m*Bwv& z7-+S2d(zT;_t9=Zp~5N8oY3<9JE$ZNYJ^gFB_yhcRqCMsNL*ap56Lhd7az}m<3`(8 z5VQtXUaGQkCq*|}cuBd8f`0RgulXy?0F32VSln>di3+{~G9SI0(=rJpH#J%Q(Y&@Tf=^?=p{TKhvG-yZdgqc)jWy!ZQm{erDE>gWNQ z{Q2d{4fJ9zS?}M!ud6!)v)AVI#aea*{V_msPz!ERcR{Ea@9oX%vx9C#9Zq2?e1^bN z*J4qlx|4F%%bHAp5f1KQXNUHH!!xEHsXYyQd+x94Z{AeHVHvRMp*#Mg-ba|htQ$Ss zAgPCkhl7*B#@ad-T0Q#SDjlJq5#Um|0dJ5qEGy8izBNcpB!Y9de)k6t1gL zES4@Slr$WF0>>nPi8#Y&H6M({`z~cJ;6(rt*gnR#A1{^9*9*v}zFW0B)PQa^aEkJeozE_-h1NdC@L;~->tcq#B`($HO8l>Y1EKhC66g&yKUhmwmJ z952viV+E^intq?m3C@!MZz^z|(5nhmJ43}dWgSJ&no7P50&@=TK9HxKtd;M3>m|? zEuUEV@?{L8bORAbLnD#(XB77g4qYM#R^Wi8Mc7pUlps(hq^C=R2A?;8!^RPHB`Sc} zq|WClNUby?j#Qu(LkJ7K2aYi4jv<^r2L}aMf5CZL1~x9o@CwPTOyCO@3-z_%2(Q4N zgblC-y-dDvV$x_)k2e~ z>gz?5FrvM^C6=wYQHs#pybH^XJ4vljACHX#XAYP1a;YLATYS!`WDykHfz}O>)?q>W zAukU|fu7bp?aa&WIFE0mWwxbG(BMrG6L`9#0tXF2(^eNit26KF6EL%bFOxqRqRV~Q z*qWXyU>NFH*oEKuzHx~;lrl1QKZ0u*`(00_>)dg}Se4u%4u`8AGh8gWG`11pHb4!EgZ%}^HZ3QcDdqGR<*5@co8 zCpY)UX}&{lcJ}{N$(4swo$q0kHCxJBitH*|ib5x6YGO=CvL&)5WlOT}OVTp3M>&|# z6vD~U97niD5k*1=A*W1;gNP{{_dVTt?tSik=05kizyB=HS-#8X^L{>`_kEw}wbe#^ zks6@Uf@uiK=o?=%SQ5cHQs|rAFMb?&r~$`>neMDdQxTsUwo#zqqnCgfCFfw zdwXGX)s7X;F$nEFTlIMPQycD%Z=_KNVd}Hdv{opsk?~zri1Oz^j1dv|PJw>;he`eP zY}6_7_0ba(on*H&UGno|cYdkdsFJ>4==L73elW+Vh?fw^)ec4=)PrCX_6tW$N@@gG zV#E!%Z)C6{OvY7J&q8=?bBCD!$NVcZRwVw_K4M|gc6m*n`k(LKQXJ$URLHFM83xk> z0=_hsR051G_hFdeD9GoT?Kd2bOnSU5vhpcrQA}Dod||Q=b?DuqqGzsTq$r#~%mvpI z*jU?aS+=&Dqi4Iy<*12tb~`^mVUP(~)^n}K^)Vk6+1S41y)STV6#Wa^xg~WVKUnaL z`11E|;Bs!Ys_(Vn^4Dt6Y8FgzK}tr#LbQhfG(vEJbd<`_k^dS&37U1bwzfWVW{fq+ zu<4MztZ-t*&P39Dxa!2#?l@!ch+vJ8$}?1s6)jKsL^f4pcRzy>vGL1&>XncA{^cFqDGubG;i@#l zhNJh)O$GmUT1ML7%9EtSZf=j0CLOb!18Eyo6;nO5vZ&|$K<;-gtE(9b*^U|e>4*8N zKGO`B?0t*6QH0ULXL_7`JgK~!M23p4X*y}7Ma#Uk6Bco85!04CpZ)w^-1=Bv@xhE{ z&qQ&B0S3AJ+FPRGfj-~2Mr-r69&&ItYHF=_8_YWpoSM;fVO19+PxYJ&@$`3#8<@KK z2DkSU#^wqu6NY77ac?otq@4VXS9V)+%hRU`9Utx%6o3$Q!!09<`9;EY_Q8G8i7USn znUo{5Ga47>eqY^B^R7wS^K<6+cY-JG-38?7fgi)z*e@3MBrd6_s{UYX>=ei&AW-_? zfdhH&eg>(x@m#svN7Z?Y)A>hcr7G=j(N~wNa+N9$GKz|dT3Qw|!l3A@ zKN^SE8Bp;l30Pb-_x4tomL4gzu(h)TVjona*Drrsm-G~>f@7-bz$#^R3sMi;MQq}m zYa6aqs}wOL!vl3x)K`bO2g(;;em@T_rr(7NbDuvClHJzjc0gex6DO~r09ItNrE1oX z3oNBUf0fBVaQf4C()vNZjfRz_u?G73@NlXQSA6NwM|r#MVra2i-%mD~)o#TPAI>43 ztQQk|Qtc_g!*i2FLJW3a5+%HMs*+B@03JF9$aVDg?)@?oszz#e3{M)-)X=Q(ec$o4 zTLe=~jJY8(hqzrtQnK&Oo08CCW;2lowFEF22EV|Rz3}piQEEnQG0CnV()zKieyFQ! zTe1-;_;<>n6N`1Y_g*0c0O z3*jW_`Y`s##2=L$Iqbu6v4MS$>LJ=Jgzv*W3dJt;)en`PqKOAbM@K!|dZ8~WDJiMH zXj2_nVTq()D3bUdy_KF}li)_uRi(L^_=arJjR%=4)2or$@G+Qn2(UaAQFYH-#R?17~@>d=Bk>JHRqN7$m{uue;xIt;`>r-vL$Hxl!lTMu4Ggq zql%tyn$HDopI4mbvppuxy=nsb0AL1`)cj3Uu-d>cvl~}0V0%Hajm@ajeKb;1^>lec z-Qo7dxkn-IUlgC|<1@>yTDW=FbJilT_qpAtmK^JsWKoj#xhYMvK6>*mpz3F`XfY@! zEJ4HjoXwr~Kw{FC8 zP)JCKuWxyU5}Dp>DmGHM>A!u6qZ0F%_VIdN--Sc)tXauAH!-o*FO&V})(sYl!6~XI z^=uE0jI-S1OdKk+wV-Um=fy+YV0+%IMJP>QGu`ya5!i|t@P2q%ma|nk-VntFg>;#a z$Hqo-{ntAE<>DPa-Uh4Y@_Y%*UXjm!!ea}cQuNQjm7-~l^gon_SV+fxjC0J>U%*R zS^4^Ta!+{rS?%nGh6Yf-3oWv8b90lE8#`?jn>6I)j(d5xZe zz7=kMm7$qqAvocUjg6BFh{9;hN=mi4N}yH+b%{Ix+LOF|Tz)amOnX!m8z@s=o$9tZ z=S_+}6yA!CX2+Eb7=W46QjLZ*t!=zwKqT=uH~|a|k$O|ywECbqgtDqiZvJ@x>(@14 zr-Q4ju3iSk+$ATT>uw^%<&_o5OVEhap?P9#+=|``aqRwlaoJ<^Q4p>AlNE}0dAH85 zt+Q8qy&y!cs5q+1Ivh`OQrNKqdv$e%iMX_A4icDuxDY*B`I}IXh6Cy#I`CpY?1v2EdnFlWJ{I-ZnV|7$2XerOVv4OZkUESOly}en& zy2i%*hYxq@>))0xAiGxB*xT9RrQeN??$*;g=i>6JzyAlv!drX1oc*PqqJ@Zk`Sxbo z+GxOF`yrhG`UWc~%Rj+PssJL6co zU(~3~gztcV2PMD60?uIYtFgA$ArNwJ-9lb${&o)G6$2Z(ZOOnj_{!xz#4c-i1r#%E zb*}zns|=bn;DN-?$M4NV3JnRN89r0(5ePY*HF3>GOHH4H?ZDm;2YBK| zDg5^s`ImS9|No`(%fUfuw1APjM@Q31B(=;oURm@?!QTq5Tod5$zm}78yiXRz_tqiK zhKU26YXo4{qY2|<&BGBjg`O2y)w36$>m-fgWlo7^8Bc3oA-V16x|AB|g7dOH0AUSyi z*bVew8tu{9;SFp%*BW#-3=R$s4-=pn|M_QPzBxF#X_=XTfa45|roi(Ln;tT_| z5tzx^IuJ5a_z$gcZKqsLCsyeU?c!ruEEm!dV-$b5-{N7 z$koTGsju{=sZBqz#Cs@fAxQ)W4{bgB=m~ZvN6Z%Gm;L=xTen93-Yy9}M@vf!3==r@ z9#JTK@x*oOu1f0#6ciL7G_U32+P80?ppei?ML&;Jku@I0NoW!p_L$sPX{X@M;N!nD6g6>9A188%qa=AsS6N*$B81 zs^bj3nBwA(Z{Nz)?#yi4EhPX}aa?)*Nw#Y|hCEBdC9C!8nEF1H5B+6+}ct zz`;6^w^zJ`H%Nv7BOp>oy{We%QYB&B5 i4D|nB<$s4zjyjo2n!7G4EMNf1W_-x>-~-~Rn7;!ingMG7 literal 0 HcmV?d00001 diff --git a/vignettes/powerAnalysis-figures/pl-1.png b/vignettes/powerAnalysis-figures/pl-1.png new file mode 100644 index 0000000000000000000000000000000000000000..5a5b55acbb8d668af5afe668d4744b8123902e7b GIT binary patch literal 14005 zcmch;2T)c`(>8bz6%-{4B1se!$$|<=1;26#a|SJ?e3YAXgDtNij92&r74uqVM;n@K%+2!c$a@ z&PT|lGH7Br!pW~;!yfmA>P;UO=9W10b67YQxYaq>TQ`_5ago-78l8<`Tu7s#}Y!HmYd7L$rRfo?Auh=BD(|&|@)SAI zU;0$pB)zJb4WdPKqL}=IPx~#bS?Zab@+*P0-O}E z$bHnPxkDJI%T8*fDL6$P_2|MN0y|m7>6lGD;bgj>yeLa4@mpy*d31QV#Vv{=vNh!6 zP0+a4PUu0>tE1S5k?SYj{awf9569k3@bLe%<0b$j7!UL<>7Cel7A#cGl##V|d$#$# zzG-%}zmYr-5f!Pi^3F zILC54-)3^G3?XWPDb=O6s&bq2+2Pu6Pmxv$gVOUH zh7kgwi~I-41X|C1C~i%?$+kt;yXUkg-q(&R{@FR!^yV{Sn8I8TZnC$qtovl}KT~F| z*Mw}zD`F(&PrY!-UliAu+)sj{O5ucZ7eHwjUK42PoC5LBJ>+EH=bz~=NqSozQo@ApJ=%{zE9ec@0@mdh7!m#NzJ0(rE$&- zU!1)L&Y$Qo+pEAUftSrn62neUqt0!5pmA7a6w|G&>goJa)>=f{S+q9a9yg)e)*xIl zSXfzwosW;P_&K#t{(wZ3(f6}C#gPIRw~D5F6!F%*lkk)uT`SlP@Kq(@zh&p*^oE}> zoRE%|JJy`plmz6h{_1dIDT23S^58}-3 z&DZ3qI;bBUt$`797+HM9E#NHGVCJDy6!ScC-qai$gnI|1F>pia@x7()+Ax-{R`E(N zMV?-Tz1<@rTPw6kzh3Vnd1U|uL!y;fLCGIPsqq^8DdL8Da_UCIB*{w20 zI>f>5n{8wLJ2@9S~UZ3J&%W zoh>d~^3r(oYuoxwYN2Kq$KrHayvJvxh(yPfe#|myipywpl38>{{-e;;TkL6qi9 z+uG)QPo`>mWqCQ9US)AgN{Zvk@1>!VqO!8imKNpuMMQp8b=|rDxkb*_`;{OA|BrZQ zR3))*{rt|Ke$DjoV@i7Z#@^xh`1tzz`Z=;2ZBaZAaEfrdE@|#2%ue)D(wTe<()VT6 z^FA;2V)Wa$Z-O3&j|~jQzJLGT(P8!V^_l4CXaY)(k#d{lQ^t4+Qk9w?9vvIjJP66- zk9VL^*2C~6&8|7w*x2}neERh1@87?Ri!a1mjt+J%Uc7jTO8~ia(e-X7gF(`aH-{7r z_GEV|_<3_sZ-0NJ3}fBldO&b+a9-XDz31WDR=)x369?o>0IM4p@1J-6rTU9=Qi7I3 zLpBJx%BHusx3jY|5xwwYUye@9JL>a&@&J3(L>W&J~3dSv|d2W#$)mn2GUEpAys3qGFI#Qc}{>(_^F1R8y0w!;rjJ zrrF~-ZaZE~dAhWR*Q|(D?oWuryZ-a8il*iR?F%IYY27_NxVX4kU%vd_eBIK5o|5;9 zysRt<{^>HS(QCeK@gigG?d(EA?!8~syYrr%zOE+C80!=-wUpb|X78q^$6OnqGU{)3 z?smgr=&xUD-Oqk8lFGK$RE@Ad&QHk5m|LA_EcQW&#bul=XEq-m@U#Ya+8(rYlDgjQ zdX<=%*!q#ZsGz{ipI38}q(<~=7Z&?SRaJGh8nNwvSr>g>LW2K1zxTxiGxD`jEp_!0 z>ox85{UX-aeMe|5j3O?O$5ZDmDw>C&akmv`5nym*ma zP*4CCWm>yCnLVgUNL|)fL%K`PLyHRv7k+;YBP=NB*7oT(t7dMv)hPa(hWGE^hlPc` zdxw9fjj)Rbtja>~!JZC3_{}bI4D)`i`@x^-X~_orC6`UOCE}2}vps35=!b!!u-$FW(-P9`kje@uKie!i(t1*W8E*@XTk2iAOL| zyEOf~Ww{+Txn?Ogg!2yn?lE43m-Q=U^van?w=KU1r^CeT@}v$NH>aN88$ho?xCy2( zQn6%aL#@K${K>va|6&H4+Ze7zY6L}F$a3!mqDC0uCKt*V^Uhx!_hD4HyS3)vu25{B z;(AvzfG&4#O5`gYIHtd_fz53beS<5WD*LI33N~UgxO{g^G5!H75z;drZLMsj#9~mLk>%l>qJM4Pw<-*$8bZL&c1fMtEwRM` zq#E$a&p-*j+_XN<;0r~Ia;z5+o{4(A@VJWHuRiB#?He9Vg^*|n)!J^S$Krcw!B$2< zXdOb8j?Wjlg%sF_w2;f^b$AoLeUlViYgk^{50q@htv-XH3m>Q+NG{#Kv5Rl*RVIP; zDXd)E#HKb=xt>)@qdo044_^uguvz@@z{8fP`;U2d$Eo^P%r44uMY%LD@0hPx11Q4x zA{E8@tjn@>1hM`cnimRnAVy{YpfFu04Uphm8UE#&O>xf>`Ar1Nwf%bNdQe=nes{Kq z@KnMb_`E#FtjTYe=&E*CK}ckN!nx&=wHc#n?dCM|*2+z&>hZ*|KHZ;e&B{#hhH;iG z&G2xPxnT!{vm4wh56^qf(~H9n*1w8)i=9&oklc74ym)!@cBGF4nHP~CJ+<;FGLFMP z&zHxI%_U%-3Ph})*q@5d%Ezysp9Gu2$236ycb-~q74DK%xd~5tY6^!-f6bw$SXBMmG7@uRk;}tkG8^p^dD(Z@*DGm<33(oLb z{%H)|CnF2(&&p~WsYN0%XA$O{z4gVd;JD+BgoHRq;mIZVbW6ENnbQ2EajJ!+06vnH zFz0>CL$>DHN12aXR3H~*7)D4izB4f@9Q2!wQTGruLy*SDjL`L2dQ}85psT}G+6QMa zhRG7no4pG8;=nm6qVO4fIf(TFi*I=>5$*FBI%aCh3QGq^&Nx8fSCQ;DNqEtJ zGlkNdMbVeQMt=!rJCzCutzBI9$ zfZ>%hes#ZY87Z#uNrx{dh=U>VJ-Zg?^tAu4$Mvl{C8j1g$_y~=bN;7BhqKiQ9W|)k zu)|2mx5>p%)d#Nb!ilt}MQ6Ypk${1xV-NaWJyO2+ro^84chFdJWyR{3O@T%3p(YBsek2UL{-Ah0+apx)+;)uT$E3%n}FWTBY3s!$IKC zAypp+e+*vg>~lSfB|L?kz~vM?XOR`z96z+gb0+2<(&im69g=SINI-gMbIzz6y|25P zQ%QN5ne#pA!7_|VVQ0gKyxUTe>I|~&X%)bXs*`N6W#+vA9IU6B0!jUS<*q8Lpf=1D z%Rm0M6aVxR8mdUPrsn3GOiVdiMNMsO?;H1KtzSb-|9%#iiHF0ynNKH@!_OGDDEgcm z;{jj6bmGWaTL0PVHlN^ie+%va;cj8xrxS7^7C(K;TbcO|Pb1EiY6-xiTY+{ar;O3F z6#n2___Mb$i-Uu6_Uzf(+S;|Xwco#gS5#DBl+ONqCO=*3zwN%XiC!VE7qCpzd#dg2 zZ2(HX#FUhjyu4*_z*d`|g@xSSqF0-FPh(0)0y0T@^IlR(qo)jgpA;Mzs8{7+d9b~7 zjzO1Wr|#;7Em?kf7lC^XJz$HezFAP1-(T zKbM{P`}%rW`{KQNmCkpd4kv1=y7!~SW<3CaU@JPhx`*@W@o~cLF3mx-?NQgSU!VFJ z!3z6Z9<9P7qygZ=;OlmBv?EC8U>`ByHyz*`az+RbmDtMFsdpaZ_1=IKFAx&O3As9~ z{I2;B7UoA}-DhTZw7(_bamdH;t-XEeaBrjg>&9%Se?1GpYNV0vDT zA8aH&=eiiItyeNtXG+&9-4C`CCEn&5)cyYT>kcz>1|aZf1?7O)0Gh8ypCVsO7Afmo zUN*{o4)Fo0j(MLnR%rCl)HEY7usuP{$IZ=ce`h5xD{J^O|NU2UAz@*pWMmuTUww{` z4i**`9RL0@>q-#Q&JI6j+e z@tt)pTjq9Yfd8oZUcz~Csil9mw&oesEzi#OgM7cYesL;g6%xK@iu%0OT0?SoJ-yLb z0Y_4JfIA~2Q;?TmTwI(MwsCQBdGh3mx_WPnK3I+8_Tr$lPk*i+4|fAU-JLg*N2TA) zxRi8)(cKtuWAp(utE$>{r^qreFvRd$-@AR=%-@6HJu8{0H@{Qm&6uCuIwRNJ}&dCysN3RXNbklr900sMfhsDPl8hrr#@EK5mT3r01gGOCl-J&nM zpscLFyF2XI?knUlfW=EnO4^-ul=DL}XdfQz{_CFMJJQ$(($cw)3!Z@hyFbiPa_C;B zrUn%?G&BIzbXXqIQd3jY)Z76j3%PDX9@QEB=75$Z@OytyjM;*M&C6u4ec?~O>U4MizK~7)|yV;oKv-{IF)f}u-X2tGqZfZIQICOIInWg3EAurw;8CG__Si7C3 z0VC8ysDfOE%dE-78A*SDMZznis|>0N#{Xx$Y{N4~MJ_7;jjVHJKX**#U!aq4%aHu2 z$fWa6dyM1cw{v&z-Ys}cbNTW>o1Jw-V`KAssv_GNIpKIPK34McJlx!Ja&p(MU5gH- zAvg3`ylsK|A^83dU>_t}rU|=m67Qatp1!lYHudGpmxc!M>(`Twe;XHCkJa+?^Hbk@ zaaqtQKPM-rtZZk0Yk^+Kyq_RrFKdPiFyCcP&BmI=9>IObk2sfdO+BH9D*SPz#jjaE5Q$EBsFQeBz+ zt^UQ-cr%g1FHNkk2ECKUp*E7J(L-*EO@5&B`0@12Oe|alK|$TMA6~f-=E`5=l{K@c zqi1<2jSZ&aNz=^JCm|t$R93I@m8`scaY>1~8+U>XBZX33^@&Mmf%ZT#jBF%_C(`bSY3gYOj(VUqCJRzGppZ8fl!#@tQV91 zt^MliYB&U$xOCtZbrluyTcllgW+v$zi#l+JrpmaH#Wgu>R%T|2c`t@IDKXKzb5B(a z#eZ>^e2Hk3z{9lkuv&72%2_s$&}Zo_w*1#xlujnBnfz*^9$R+DdHf731k0SuS|vE7!#Cbz5i0W;H9I0?xl zgmYxCQCg4~z+%|$hXeO?Tfmo+KH?~dDV>8Jx zw%HVfmXMk-ryiYO>f(HuStG2PZ-!g{YQek8p`((SOGJXmjN_;7qC*E{eA(TCg*wIS-Go-xvWfF*-zcgFU|Hc@MUy|lI z{@2}0JGpdpuUnH*xTMeIdsyLa<;ckcjD;BDb&6c*0QKZqiFd22D8U7b;$h-u3R&Wo z%?JNRl zaq;?%Nq`CflT0G0mFR&49^i4}hELT4 zW4KN1|2;8s`*@lz1qk`rGsxxBQk`@>c{H!?{2l)%9YVMWFmX(z0Y!NfLWk|H*U%UF zm|gDu^Wu)>Ul9!g0AZ_F$c3ooYl_R11XvC1&>~K~B(qDZBfrQ-U(bl;?@SN>twbX}O*{8nd!%v^}bm{|7G=pHq zA+K2{>C@m05GiP#C3`W1)E|hdGRLpYdQv~_9sTj`HE2eeklBUFZca?4HvjO!4w^BD znkCFd{0JEOYn^-IJ=~6qCT*-A{>_9wBtODKr$oV&rvI7=A>kJ=`uyQ)1phM=N^pa- zG3<6O(L37AKWjl%98QGMKlef*Ad9@$eSQ(W>#LOqw%Yae^gHavwLimE2gMRD-i z4u^ACeRPpVv0tG$mS>1FQ+mJ3IiNPbbm!OI=AkkH0Vmgyt0n`LiGNxeV>m_JAL-EU@kMA{ zMxNXz7rJ}R#yvUoraET^BMt)99@U=jUD? z5+KDDC8*Ck&d4P7=QID@=#i-O<&4k$p{Z|jh$-Y9=EmP?Xe?%@v9&y?6l`JHDUa_T zTvOi|@Drh4X@E#dsX4p#t?|z4AKUz6q-%1HTtQs?RD?6twF17Xls_w4K}V?BM~J4+ zxx2e(wzU!i+2l6E{T|An%9nuE0_ch88Toe6EUUwU@2;no$dLqbavRCKoSYi_g}(0rl)>~O z#{d@u>4F<4R-NFVbgw}wqn_A@#+I9-@|LJ}E+v(3%;BCorK_u(CLd+{r;X~3!cS(% z|5|Ixp&p3tx;LrIpb6OFI045FEcP}RmvZO^_czLO=`NQYi+eOHJev_j4Apz8_j#*>``$^NCLy6(=MC&k6jftgI~X zqiifJU$U}X_c!MOslx6}+M`pw1~X$W*_nz3i_wgT5F*TvzR?{;@tDwwc#OPk#Fdbc z(A3m~#LU9N;!K;O<|~gsVf$&gm=)Qz@gD#GhKDqEzvpnV%S!_xctRGJtMtGYHNN6NWDC>3x5nrjikyNzRZbJc2)=wnj&MQz zCahJ!6!T1Pam}L{oYw{B{XbtQ{DTZ{91VHWpr0*FoQtuT=p7qv%Wi*l0hMaVMX511 zrrw4CXDTQhp-NnpX5KfBvY$~_p4Gn}t&N_%ngmlj4{<;BBSrRKYEk%hJ&;r}R??ea zxteiw3Hyj4cro=#`hOo(`od!DxRV5)W1LobQ{j%t@?4>?1ga1xUUGL;U`OQMX}`-s zy$!PBmt>8Z@lWrof;e^tsdp8_dgh;`>fW}@nf?9S547U7^IEC;fa}?{;y197aU7u?5!Y=Ib?6K+JAg?XQdi*q}p?2XXBX`dI7 zSCXdzP`2MF1nYm?LlRyoZ?0JUiSS`?=or#fK$R(c0drh4lIIkrb!=!f_7pw18yESJ z>)ztJHxxH*^L3E~-!9!13f0|&>PlPbejIeloimu@Q3^ewZS^sdVpaH=1anLq^t&!I zGndYE)CWDp4RLH;qa$zUM7SKHY|gx2rWNT{n;i61MAZUaH=2<5uIu&C$JIPS6EEst z{4;ds!KQWbonu4J4?!B0Xm~{K5McC6fx0xYT|Un9M6WW^{w68X(xGi4F?QFoq!=|U zQx5W)3sAYFRUMNyXXjm2 zO-uh}g^{aDd`2~{ zZR;f{_z45K(5<|j_djdO3PgnUAWof=Qi2;rV>UV}O18s^i#VukC3TX09KH49q{E&O z#I>qVNW(Y2yquet*Ezd!vJroBc(gOt{nelBCJVP;U7ZNSG~|OF9UYj@WoBwMb0Rg> zD?Pb!(KMgkPbZwNJ>Fk{%9H!SQkj&L)J>&0HVzI4dwa+uBU)qnfBmXH3FwR$QNp)* z`EqwA(qNj~H9%!PscvoaQEk4PSf?1Mu)fO3#Kd|apMjgZdw3XFhT-48kAXjd3Keh= zH+-Q!6fC?CCApT~-mTv?uD&7r`}O`o7_VLxWhCXl zfB!dxTQ)ZN{e3894h|2;eEM|y%$bPraAI*tB4;NiZa-}}O&2`-_wN;2+M_fzc7@ac z5B)`Ksv>%sy>@_qnOa`9va~!}e*(k+1mtrJ>58#eL_FMVY}UFGC478*m`H#8_;Ax2 z%C0BJM^N%rh`Bdf=UG==e20tc<;I`(y}dmO3W^Uml|I(Ws;Gq3)_RDGH)K3YKHi-o zntviG`K{b$3Yfb{HZ6$VQ6`;nTYq~OX5&3?_WznO4~NcG(=tfSUuXUyrXql@hp1 z!>3QNrd{3L+yVkI#FLYg+%B7@7cU0Rv_?`=P#7B-LHLS{h)7LM)q4CGxRimxK`BW| zJ^=w&C#Q_8EYSMN;$YD!Z!hAc%*=|H6XNi0eSJODn}7B7QBYE%xpYeigR!wOP@bce z_6Lw(-@S8(g@wh?Sit`8uQ_ZoP>Mi#)E#XPgVr80lFkb##oPk|i5*zF>gvzL>n>kD z>fIH8$3l5T*?%3if2L<N9+W2RgpB4d4h8vE+=_>rw8`T0)k(?7g$aK$Agz(!xZ zcp>PxJTf#i1iAY3wBZBvX=ae{TitU@RF=WN&BFujX}%$ZwD$*whnt(4;`r@u00vT3 z{m?jZ2-GR4N5b!d?8Aqys-++qzdB!_@6yxKZj4eEf?1&yCWzo+-M$OUUT&B?i}t2K zPu>-?lC|6a1gUCHC8f^t^74_9kw`qpr6IshQut6|EqIjzJTRahustvWpqg5L{=`5T zJs=?9-MjHMr)23sxqm1$1x3Z*mG)UtQBdg~T33Pb`>xxI&`2OIE{@MocXI3sSishH zJ&>9gAl`b~3$O{Gj=P&dUC#;zy1GJ$lhV@q<|6Xa&5wUpe_)}g`SgyL(cn0KmJeLt zIPSpEPzRu!f&8aX{s$!hMHKJ0E^BYU1?=8A2DmjMc7NVKW;({QqjQ~tkxA!OJ601hF@WUrh#=*68cXy|FdWJ(W_wwbr z`FV9UwHLq<&ET#^c6Oh`$LF(|{04-k^@RW_jGbQOyD94Sko&bDuz8^6%~ zv6+|qACj)^Z*LYQr+&55+N8tMkh7~R(5~@9t{+=xNW~A2j{0+Sfby)$$jI=)BO(U!4ghrLd(fHtqJ|y;+1R6~}v`RCGil?cmDUIp3 z?o80!?Dr$#gc^2jIz;WQ`K6;GxrvCw18Tu0l+;P!`=Y*C^o%g5z`h&%3xyVUG;ZMT3@0uj9l&w#>05idvFxbcI;&b8G`6!$}KQan22N@3$)o>MdKwVjYUd? zbGs#yqtO%qNrEU7=6JVpm?p?2`-@cbZhT0%;IKS z@z#jE&a?{;qHF|&9MmYFoN@g@klX&|ttCF|Zymv1S(gI#>2)Gc94j`>I6pM)XXfRF13iIb7uY4TiAIS*fkUwtcA@H{gscoW7(dZfTVrlW!ni*UVo2isak-ai}seHp6K>T^X(IIn0@0 zR-{|wVh>J#et!Pmy?g&sx2sFTWii_t?18bao4}@cZp0a8_G{FsFIY*_D(-gP>FZ9U zJ&(*C{4{bp*)HvF=BQQ#5Dk*z(663@3o|~RkeNwELGdvxOhsFpCH<3aQ^$1|@pth| zW1V4207JO~WGzNx)>fsh*^T!iG(INy11ArUX}S}y!!k5# zilS|@|M%U>={G{{Zz?rmFc|GZLw|q&AFj2+3=D~YM%b@pMnUt9f_$whXF#=}Yj6=76PfUIf$kND3ik+k_ zeKBaeIxYr-Pq9f-kWLn>R!cw)2AYzV$XDtQ=`GKF5a-@+foAP!BIs89zqVpO*5AA! zG8jbMF!A!TMWwi7=_{5@}21VQRIJri&c zQ6A{B`(O5jH-AZ@=X&BbbV7amneVGrXw`;f^Tv%E5TKx6Dk)~Q?&QcClIKR%sKE?8 zEAp^MSQnQvnGdu|DCbE3bY#Umyr8Z`~~72R44o~7*hPx@t(*0@tvNkmocr(JSo1i zt<0e^5Q3Zp^`Szhr8Nj(BV8e8J55lY;MUUtxqG{tJxV3T#VNtC6(|u4p=3g8a&nL9 zYQr0XprD}cW+(uZ6cwpD<$B70<|}}*jxI-8qJ)ugGWG6O$b0Qx@aB8_`*QS=k&(dm zM?^&2wxlxhGyKIZ#|Vv1?*Q7%(L<3%ZC^}AUPm^H0TxmL_X%kAqEu&bM0ox@SsH+_ zZ!@+BoAb|2P5GQw$Ir$(;m8`07_24Dd3RTH|JG_<2jE?nc3Mb%QHiAbFJWpiC#^( zvSGkobeo+kS)&A?tmSYi6ADD{Gcp=B`dzd>FJbfV!SBf^D(dGy5i>SUD=ONE`H#}C zg~~^98v!tfKNgn_$K|+ZIHKEUCns&U7q#Z6Ku+K$g*}f)y1JB^$>s3QoWhB0?Zsjf zBiAndvuck6TCk0f4dNy;=8M zWYTh`^XiVx&CKRkR>oGVo;9?r$ZpeMZ{E0}U*n>_{}{L&J-r(6BYk~+QBhIdU!gt@ zaOTelgNE_Fv@^!PzV!9>0zNCT9Nvbcp!*b4n~ro8169d;-;k|^ekgV+><{$z-W3qg zVI;k6$pmU2l7s6)$M;fHQ?q|)2%M(2rY0`~gSQ#0EPg;oCBO5!VU@!Y>PaEDfuwMck z05L;nD3s~IKl0oCadL5~y+za`&TYv=4cNcVt?y#8hDt+PkrmV>(-dOvgY*FP0QQ7J z=KOej3@_BejGjKd4M-e(N#!|%W#u2#g^!3vm>KOf?B}~v0|`~3Dm_N-*T-FZi_z}m zqrY$IJ@TQ25pZ1o(?+n}&5v-Met<2zRLqTqzkMd-wu%pay}$&1aRV`g?xp{)fB7UK z3Dm>;YEJq2^XEXFhJ=K4cdLlEfQ}%uNabAJ*-5`bEDFDdkbwF2te~#$1hP(gL8sMz z15W^c?VX)UY!rYK57%2cyZb+jc*a@DAkNUj1vv_f%i%8Cy9@1*Iwj^MF9x|;S+iy# zvN^3@Wn+6!OiE0AmDHbxmKLz@^JmXowinHejVWko4iES2#AV#wkKR-9$p7E zDB-R`AwpS-7CH!qO0r-pYg5gvEG&F99V>MwRxe(RtiJ9^SF)=ZfxGT4N__cpx%0-K z!$UU$f&j=R$;1`o1fAg~AMC6^+X}e7dFVd)b1I(*#PI;8yb?5k{UWX6u(a32t&i4T6j=UN1;(G^ccWe+_uv)oSb<; z&DITdd zI|*_`>S$@nP7&d()}kgLub=>}69DePRxF-9D>QD81}6^oKR?rdfnK=UZni^^Zl!F@ zBj&z6OK|f;dHInN3rdFRqE2Cp(aI7ZABji~z0a|+H|0Nx&IaSGdO!p4xupvT()Aj8 mqW+se56$`iZ~c1Kfr#`OvYyDN+rYFTh^&;NWUly=*Z&)ZfUaBs literal 0 HcmV?d00001 diff --git a/vignettes/powerAnalysis-figures/pl2-1.png b/vignettes/powerAnalysis-figures/pl2-1.png new file mode 100644 index 0000000000000000000000000000000000000000..8bb686128fa0db57fb609156275e9410105d4e2a GIT binary patch literal 18291 zcmch<1yq#p_b)n#h=PPt0s>+HlF~>BUl342kdOwIZjf$}Qc^)cx}>EWqy?lI5Rh&e zV(8Ah=llDg8)uz$?pgP)b!IJ>I`h8oJkQS0-uv^+N5vP?1b9?<2n2%Q`Lm}=2n5z4 z=Finj@XkXS6DIiUn$0r}I|Ks%Cgu;;z@+CX0&xfN{OLa`&I#yA7ctVs3*1fPHyZ2u z)zMlwSdyF^ii%I4Hwpcg>tXHVIWvkgiZ(UW>p6`!ZNMuZU=9D#dav~!nIf@@3gOnJ z$CnoZbkx=N56_CF0-R^L`qsKn_9%p`gsd4|ggpPgkxD_DTty&kVzAJ#l>QpUT?FEG zU>YuBMu1cVfoM-fVIc$vC5aG?woI-FM3@8;8)0)hh!){J|G($bYo@r)PY4JITwGkr zlo1HjS0A5$#w#qfmRt6|qljpQs~pjqqN1W>{~!?d%WI>h(&4n0BLzC0$-T$9=MH8v}C$_TWqNn4^(M51}ZR9hdu=>f>D+uq! z1^&1A>AH-5#CNmhMPuVV2ka(AQp-tNp9!SnBKjXJw|dA|{LW1N7V+%{$WP3eRFZ$C zl!I?H`z3R>pQ#^`0MQuyGH;=h#H@h!^RysGnIqTM3R^?s=4N5M!)-B^IC8ix<$($> zSvh5vnG)ecyn=XVTrGQ=H~g;Ejr|{p@0Qszj~=D&Te907P(Lo~oPU}`1GmgP=J{gK zp+q>6NjtDBkvV#N%jTt=Zx6(&jhX4=#Xz^hJ)$kKms87s{#dnH z8uhyMRa11ff%q1l#=!Pvu!2p2m1C--y}^NRli`HMyZD&L>ru&+m<=inX$$2>tBF_% zr0ZcU!!KLap<2zX;CA%1ptXsS{**)2;I8}?Bfc{I%XeMgnC(tBtN#7nu1dhY z;8$z7BU7|E65IQ{KYR6^(tlQKY{I~|A*jt|8JSxB)seLV^DX0V1a{tIR-iz?O-s{HdS6~-4KC{=&K}<9LJYN=nXVSLY1oXgSHcx3Odj;yr9+Wwz(cs5{ z6MK6hnaIN9D_;wwXJIZ7(|M(|ob;fa((8u!?KUqqT4B9fnifhAjK7OteL1AEz)oc5 zuCd)N9x9V+n%!a(fDN~aU8Q$$x*2bg6E?nf_&2LMV#BUQ7f}thPKCMwbTaHN&q;0suT#w-X z$a%z>c^<1JQS5zct|8}F%6 z8TNa2*!rPl`uD=Hi~N;t1#+yy8nz&pvO(nbgl`(|48DVh{LrZ0x97F2*m`z)H(4HW zr6yjz^&UQY;*j{A*>TV}NY7p74o@b$>ksd8IV6^CtElu0-5X9FoD>zj_vmM(Fx~8h zAc8;VTSiotXLgT(C5>Q@$ClpD#!rrSQ$Poeyv(N07jx*$xnGQ5KMtQ{>G~ihCUip) zG&n=3x_1`zwcKHpqIGs7buJaW-5Z~(^Br@TM;_BJVxl;6(S6x5TW=i@*l~X9{o1)h zK}pXz^oQ^shJp+l+&@<(iBbwlaVQr98i&u=;k@E|niLEoNim>tckQu$A?zl*hvUoV^Y_5_DU;U1xP$h^)K?(kGl@5TPA z#zqUID8LOCj181}H%f;ae>Qtgn0@{k?|8dk6s&ANVmgFF^fV*YzpkaKFywZfNjsJY zi0O6u*se0Hh_u=vT5gnyw00m2`N=Vf3HV!4hK=O}#$z&=ok4M+N_)}!eXxstW1W|WVvz8%HmEN}D&6c8 z!}->MuND#ISIxl}mnWWPp}IOd*Vfju*QmS+%KH8m2-h{GjsG&Do4`wvxN?0hy{gK2 z<#&#ck54cK2Rj=ZdaABAJw3g!(Avm|0ox7tH5r&h>(<8hEB_ob<_U_#BASY;Y()8? zAJdYbc+{vcpKZ1fadUB4hY*_yk4r z&A>jg4|1k~mvmphwYS?}8=aWYHaA~wY!suTOFr6J3Vxb~gHQflCs-@@5{C)h1aoaw zpP)Sz?F3%8{#=Oe-OoQ;TW^T>CW&aNsl`M^NnWjX*~wH78Nz9_W!BIb_37Klr(`d) z-B)+*t+}{fCj2P;qo`e;TA?SpeB^t6J}*@dk?83oo0-PV&CQlTBCq{X@G|m-gsoIgwxN;5cGtLi;II}V;?=9DCES)&%ZH{(bW;jSZOs$MN8Y;IE8g9 zGnc*K!_h0xodo$qZQ&}iKi;Wcl4GNzyaicnor6p!cfEN zsF>H;hNXz0-1d!>l$3$NH*I#W3F-o!+UT!e{}||7SXkKF7ArE{_q%>upnq_%G$mzb zbGBtnua(>)wfuqTS#wXmY_~c7yUBpvTcuM8jTg4eEXOl5GmK@z^gn<9 z-bLn>NB#R6L$|fH`4NA9_WO{}qKW)(Z8q(bE_O3Kf# z?)97SmSo+C>9S74|zGc z@87>az56*lyl;E4iwqA3Osv29_=mZqsKUeXN)=(0PE7Sl|Mq6lw-YDh#3{#Arg-9a zf){O@Euvq38QS0De7S4)xBK~v7gJ@X%5UDhk&uwEwcUzl(*lJV^(FOyYV5P0FlIb5 z6F*9gs*s?l?w$;9w`)lcn~=9Gc~CGz9(6zT>sKV5pgj{m|H$v%CIz?P*143F6fi>t z1%)g7gefGUL{{b0d)2=>0v&I^PS?!1yL>+Bm-d}ud{tG3*@X($u)e;|$;tWo^JgOK zkkHWb%1Yzc8wd_mGHzvkMd!1DB)E?vN-9xT_m-Z`iTf;#hJ;7TH*`N=B6lY~ou>kw zacAF&VHzquEv+q#rq*JV3t*V6tZb}YbZo4KrY02)4Q3~r-}%l|MpMb|GSYP{5QuB> zL%@=Jm$7JzQ#p@kwfL;7_D^jN$*bMLf3#3WFFp`>zitx6; zr&tfHvWaOTD_+Nqxzk=pOkNff({R!0IZFFp^ni3_3ZXOIH2rRgexBot%L;Oj;Lf1IMm%oSJ}&#w{9}hR>?hJ z%NO2j@x`rVKM&qKsZDI5D$I!<9UH=N;;L;BpsR;t6Jxq#`K(@*g!FY# z2)s`@Sd;R2RdG?;7Q^Q|l@WuJq{Tg=;(ITDtF%)PlJHq(MD%cGqK%7F_^IRj#>W1; zGpdmlA|`?FvzR`2u}@r#@D648v}pHOnk>z+!Xi0Cm0p(FMzkDW#5(Vlpg4mZZ#zfC zU1?pssjZxW4SW55cyOV<=Q8*+j{<$C|3_e94m0n{9mYPNbsAgwC>JKzezisESNQpf zY;FoEG?&jaw%XQXg6wk1942p1z!ieGUHfHuN5Y1t>lTFFaM5=*#XwTp8vYH5vS4yg zr^U3D4X?pU=p_GHHb|gHy|2o_8xm;rItmbkZcp^ox9o6q#*xM|+hIO6u527+? zkOVf!*xGQ`&gC5OQO$bnAA#($7sG$H{XP+x+A;*(wY!I`ZWbyh*u#pb0IwfBJN{rJ zuSzs~L5T|87QHYwVJpUSO>`u-s!>T8H;}d8AL_dlINP><+Z&XnXopt!a4gwb6E(q| z{VpB24I;y>ar$=iiamZXxfqd2%;>XB>o%_V;dwLqisOUy0cjV<3^Mq1ny=B3D0=iq z9Zr{prh@p(;WRt9VgIn;&CPp$yN=u1BOB$9`1QuB#rPl9V7(g5rV8SdYli2f)5m51 z{v+G^xPj2UOU6L(YAF?aGo?t8=GMlB<`wy$T=B2&nrC}0?e2FTk0m!VXv}7*SK}M+ zHtLc|H*l8O7vUv66S~T8s2bx*+~Bk>`zEzus;pFO6>1jQp>J)!4Rspf5$}Zg_4Qp( zE9vz`SS?MBeO^KRz^6p2%^|u?wr(^?r9!n=!{P;@-HVQ=RprmA2cftArq1Q>|IzTE zOIxA3QMw)3Ub*rME6y8K`Kt$1nn|KIQbcRpuVZ_v3jG{uLI3ia8chQ~Q4g>r+ypC9 z6LBzD-O;6}JJW+0eMh@=<3(rEcntq_=N4plgd_QDsvuhRZ*zaBB=Ch;OOb3DnsvwT zMNw9~fbuve`%~(PtJIO5!v-FB$io0SuTf^1lSo-oF zCrHBP8%}v$f7{WnwRXQg@g7vymJ!G^^`|qiRRs(tgkC@w*SQZXl2h z5E)NsZmP-I)4*bu;_kn#lE!*xXxF(h&%$c053tyMu#3T<%HDF+QLbsA;@CgC@%wF8 zTHh^Ke8^!4s3LkGe9dULF*|5}^?HxRcZn<{VcK-(s##{z*g)HWmE|vU6BlRZ1SGbd z+2D)cMyLLUd>kmv(K-bZB6fn?!;@G}?*fdWZVO<-X{bRk)y)g%{t6icXT1`;O0jq0R6IVRBENiEx$I)TTKk4qRH^(%@I8srm z4yv~=dK-TZ2-*vx@3=mf;ECtzWh6B^6WnBDnXtU2i6=>vpUsDUYT5RDr251Z7b(k2 z5ahqKU#0bdKcLR1mY^jV)?ogUbQ1iBysLmck*@ND=A!>9ktlq_27H5RwpnMeXIzjW zADbQ5#_@4k)y8q?PElD#B2E=TlBg!@B`;~dSBvKw9&4$K?pQ5>@hj4^CniBT#G>1H zH9lH*yw{^F;*F7ZWg3C!Wxl9baPSVsN@DT)RenM?B0)cH*Z$&8k_*O1eC=HEOHsPI zMTe*7ts++rY}-VA#o8g5%9bxPnhz*|3+{}0F&ZAAyF>%!BfidFIZJVaFi9zi3>`R2 zu4WT>Z^+m8!mViQ4*o&nr zk;4YghsdOE3iqsQJfK)|PqKHG+)&dkaY|3b!892K6-&?}!L;e!g8NxCPpvI#Kkpj9 zSSiGwF5z#Q3`iY%$#fhPgqNylVrtrPT9C@Cl63md9j?-KQC~;mGsQwB&xl)We0(RC z{iG6D!~EDJUk~k~BO`a(sI36F5}{kkB*N1`QzvBzqqu-UF2k#h7=`h-y5gqAxe16PY?2I6mux(;m71<~+Ng6oxGDbL*EgI_ zv|!Tt^w5@{pOvp)jVh`H{1R+|yd>aw)Y$R&LuyagBZ4wv#ipN>X9}WcJO;l$S=S%6 zb#$0^f90I4byCY4^7r@0C89NWz0pr4Q_)w7qWx&dr{Iv4Yk;iwu+ziCci78J#5oN9 znC9f*0GNAawA9#ovSz4IPZUbr3d`~O)9o&CdUB_gj80`yJioSK?5Ru|KXllVk%e6N z1)l-yI^T7BPL=XYJ}F)o=VvDe))Pt^8ZNWV{vSSkXg_0=$xvdB;u}@h)0>vLHcL5_ znVehg_#4Nm)a7oJ)Y(wR*OPK3aHl`sV~-vFZ`CCst?(@}vLS={o_PMcx-Es*X3!q& zOpB@Q4JN-er>7sTs;kB=>ggm(u@UY@2rlhS93)A1`}V0H;J6T45!YQ5Ql76jS+t?3 zsEF6DNk3g3^>gG57 zy7X6MXS>mp*?mRbf3NLNRsVq8(^kZPTW-sDy78_YYvGr!MHaP!-Mu|tPR`(_U8cR|gY@1ZAc7(-O`qc+@;IJ!phOWn#qanwJb zX)H0h#)Ou{_`j+^c|NGJ$HvFOC7f>%JkZE+ixF%%qmCZsF&_{87P@TPKo}PijmxJ$ zSIf`LY_|5NxGS1%XJ@Chtn5pN0T_5jMg|gzgxzY&)pkp9p^d>bRRDU;`(f`hkc;}u zb2ZLgdd<%eRIgU33qF{oklfqR@sNduB)FB^sQW4b0WZ%_p2${O*3u)D`%OgbJPwsL z7M>FYv56-HR)ZfM$-T4mQPcAQ0Rh;!ga$@>DI~4qOYuiUe5(T9j>N-{qhgLG%Ny#~ zcXBI3@1a={eV2XJOr%sNjC_1jd%R=Ie2ao1O;RrU3*F6(za|MDCd?u{eD-7v_?(RL|jMwBM%OUabG?k#?O zTWzoPQ-wqV%zT&3Xm?X=YyY4}Q2OhUKcE3}LkC`E1%OnB4SWl{Wx^<4NRIS=Dy^0b zmwe>^u#WxnXHL`fJd1*m4gdC3Pg5dDg#yyw-3Cg=+A1QVP_r^XBcE$?s9P8wf7R^o zy_AB@tHOl`6fDQlW-?kUVj=Y5`pSCwXG4@hb0{j}#a_!F}}H zllz6MEl2dI!GFW3*y1`KCSc5xJ)~!{9Cc5xewNALitQey?CY703y4@7n3UCaZs`8| zbZQSU{d7Rc-oIHj#esJxvKZ3BJ?XHr;^J#WM512j?&|95FJ2Jtbfoa|u$OZ3ENxh7 z0h*2b5*b)h2-#F@rKq~m{Lks< zl9C?iFOgbuep1tWFkATY%CpMzp|8tg zpbMWodHUjIcvDlaZdobfQC2Ls>&K@NpFZ^;ZVzP0GPx3FhfSxw$>4}++hqnyQ+e8v8S4kO#xX6E4U!2<9 z?7r(x4?m;a*UhtoX(0iDM|AkQAYgZgX2+4EKoi_I%^Z|VPwF;joQ}1O-fGF#%41J& z7u$Y|$MY76dw9%Ie|VRZa|^ce!+u$5qrt`5`4JtV=HFyPJ{TRb=D(2O31urZv^MjJ z#&uTbmTa(@6-QGztxp`y2GT*IV2JFnadY)(sx;&)xgr_K29>P}Re5Sk?5YCd^tT+6 z4pQDkwcXa%*29Mnb!zN2ie5JX-spDcGPxF7V=}MxL(@p#)L_Cumd==?Ot`TH*7QI& z8c>nP;cVd9@g6rnzwr~2GIh|sktfHFWo*xghn~)@hODi{=Ji?97DSOEx1`t6wxRe3 zsq}{&9Q?ezmhQhui?kh1tykh?;CZXKU>fm^X z-Ft;bfsG^+7jJ0@2i(TJWhEt@Jv~ufi#Rwqj*gC{Mq6hcX{;lPu9XYnL0OAvJf z(G8JrA96Lhx_C31pL_1YrFTDnAbx9X46Y)mrl!{B+f+I?4&j-fd3~eG!B$Jas`K(D zX-@)jd~8g&)-iv}P*XEby?eU7w>Z%;wr8{TRKqA;bui^{^R(XjxISo{5L;N4+jy7d z)%UAJL?HRHz(8qT-KlzyleDxn%zn}gM&81RY$qmQfUvnNoP@A@^|+)K=fyvWq=H!P z<6`}Gh6fKE*8aR?j&elx(}Q7@kLc<@p%hl7nRC_rZ(IP7teHl2Pvb>DJfvr&uU6yF zu2U=9S47hDLGI&_kPrxv@DSUk_c$t-nz#o5lO}q7btKNzVe1i%jX4@m=_vC>phCS8 zk=7Gc$m!{e`Eb$o;r#J~X)gs95@A&djTaqsbOL>2ZD3Zact-<2eW&+nf|EUPoE z694igeSLlL573%c{MC;8yi~8FAY9HvqNkQH9W3Ibq(+R)yXmbBX}JFUNG;x+Ck|q% zX~V0$p-?>%ae#YGChR6J_Nu3cO1QSF3c(gNp(I&s)rYo-tk`7;t*B%#vO0BET4Cp+ zeRCF;ytcw?^i`7t4%_2Pd3_hXErxt%p?}Y+CZR($8aJbxi(uO-Op}f;eT9)yn18`e z+EGP!0P(hb=SM87dJ&rOe!@#Bg+)^GMA@qblGIZRvs~2T&)jFxwL^x=f>#FNQz)^% zXXzMm+utCH86_Q7IosIYQuUC+d^D}NYoS(iqOUydDXeXju97zuK3$jQw2)4Of7yHK zeVTFk%8pjlz)jmjw=!SF&FNt2dm^=t6?UmKm&G>T6brj`SSJ^TP0t-a*@zw`76&~3 zWn?I12WqdY2#OSx#!9Lo-w$f-g=byES*=$1$x`sX^lSSTDR*5XG8=twCjVoN60MT-Atkwn+$X)W`n5RY{)C{my(-x*HVrUP$$UkQD$~qAHX9$r_9Y7E!T8_W?#V9Df!`;Lx9n~#y)l)ACF7=|Omq8c zUmdA^k-!3dDGq@N~O8Ab$4MSmg2tAD_;>oB;ln-c_vr0m6Aw1(T)5wO-I}0 z=O=gc)t<1Ib}(^-bjV*g%oqS)L;#;cKPN|EAKk*SYQ@NeS2&0#AzLnf{<8TT9GjV^ zkxtTk`27aEnaWVBd?E_F0V!qXiFQav=DK5= z%gCE(k@oCw4>G5kq{4K|NI0`f>i2`c-D~)9nwg5oqC(_{y+AVFzkeAA=jAA`Z1$q6 zA@0R$#f$Pw#R*di3ep{hJ>bmM=J$NUh_o4?4MM2`#^v?YR}#KH1=H zRx%J5!bdbba^iGc`1Kivy2_byP~s5l3mL}8nM>mYi0`obn&PI;>nn9Sf{$8%wvaSG0@H7hhpXbS;mc`}oik1@hrVZP)$L$vX)tel$1lv5)n~ zTN8yPNJ*pz5GD*Pho2jhyTYM@`YN*KF;awG4}+U*KvA}Fot(UE&*9vTPs=UyF?-_LUvheM(wW?SPbBib62>mJXjfG5fVCqIqu`fk3rCH zi!mrYH8mAV$m?r~;Sb%GWOL+TNcm1CfzB5vK zzd(t2qF!|3$pC^;c#Yayev|2+NtkaPJuW+XEHX7d#`$|F(2*E%NFiLTd?4evX=`Ga zaet$`E`Gy-Af4tiB2FB+s&0AwFb%nBX`-C*iKEsAHU6pC`42w=|BZdREQrVC!(U%J zx0uVxvmnOTzL&euY_-S*T13eL zFfl$t_*#%It{M0FfXQ!n>ap+j?x%*8ggR@OSni!AhHPMh0hj#-BjJ1lsQsna;`FbW zsD{y0e(;4&d!}OwRp1GYzoFYUGf`GlE?-~C;qaA)YzCFLI5S%RZUOJx*aG9wM;V10aYJ~!s6-)*F(-+>vxNM5s0Da>*j z`g#awLZ)N#+@3?(bS3yIJLn21w^jGKg~BunkwhfL&(_qEDi2U|W+G|GqwOo+R*^MA z#FzUxn(1gB8>IK-c}UV2XH{J}Hs&iP6nFdb`Q|x7bA8k#;;}WX?FP@fplPe6L64D7Rf)9m@a{=Z7L>lt$iqvx1(gh*^c{e6DOSN1SJ(j&?KaKy)& z^6DlCbiI-CEb_}~@h4FU>T;>lJDzoEvx1L!Z3JfEqCA{4TNtj#H0k0KOA(>9G82c^Q8ViLAIY+aknSC z&QnuauPZV&R4Lz6)bk){>T~p6638hjs;`ISmEE;WOSk8cYQp~ofe@Pby{LF*(Dv5M zkuc?0!mnCgB}VFv$w-XmB$SSO-nexzE_DG0z@X(sj$U(!!wYe(7~J zfHn|vVn`D44>k3f_I)=4uT29$_XFrNZhfDP;1(ttJ-RHZaFsqoh+>pb$HZh=Oz2r& zo+>kW+s2VzGUr_h?If%jd{Pluq?8WhVn@HxbMald3s2hUA60}{2u*j<{6RuX?W5uW zqt#G+!c6l2U>roq+zF)!n9WERK9QlG)^Cvn*zRkp!r=P-W6JU$aYPdFX8!KB&F2nh zZPy5{LrVvdx#eWvlAId)FNoPVEAUOg=vH@bgVJNUfXFhCb*81?NMF-kx>z|o598-z zxC;M1&cQNDQel1i?}Lo{90fDOwHyQ(@5`Q@NBwQ;|66xf=37<+0|$aAtKH2Pmy_8GUx^HtrnaQwU4qW4n)J+Q$qA4 z3kwP#PWA-5jU{mWh}3=cs7{#M6uTMb6 ztSz+4#4EeR;_#}Hcwl3!l6+PY*=3zL-_rkASAOwAN2reZ>q+H0miJQgB2wPtg^Ywo z!LvCCeRq3_0JIDNfc-bkb3x}E@y9=2vhd}@V7?#p@?-fPrj!EFI}-5<9JgubhbD1h z=ibsbcJ|6NwK>HA1b{>9;KcE=dvJ`kPs#QAaJOk25^1+ zRy?8UU@S&NyjJ8Q^iLP&mUui!(4_fHrD-N!!%;AyzzC{B-^yMY7;6Tys;XrAZcAT* zRWP@6GP3J2gvmPIS#Q!%%F4<@4l4#QJXl;LqoK*4gwDUUzJ5#N)Z^uJzq6g1`ZXi^ zOjy+}f+Rg&qtpn%;@aua4snvl51w0B%Tq3msgLbD?LonV*u^H1OpcBw zCn3>)^9I@AbpbcQgkyeXDDV1OOk}~Ag~ZN=t^bs}-c!KR8-&S)pWkKl2z2_^fCC3# zK>3H`K;_{=7yIqwiVby$r-&pP5|3iDp*($d2@mJz<74pq^XJdc_I7D$X}urLpMC1=+73o~fyT1& zz!a)f1d0+EMzz(|p>(44TN$4}BO86N+1Qfpjp7m$&rs8sp|HM*_qcZd;u`Q$U_A@j0KbEO}HQzA=t$7 zQNF&u$^F1z@c#G3K<$JcQ`OWQi>p?b&PTF-m_9R|vElsp;^y5sf*h4xq{*$R9Nm-Y z#d(feC)6zJAIy4L7=m=!V+ysa2S!Fle*XN~*(r1X=F#CHt6sf!sv?vNb&i4;QUztF z`Go&KTfv)FKMl3i9UGaD@B_MX&CSgKvgYRI*t9AP3=F!HMB;twRtw+9<(8`{xmh56H88fmzp{Y+KU~H(alqPNRcpJTGMw+nI0q28lU((C0&dkk;+0>Dk~i^A+icvvhOb7 z(y!MfTgHwt=qLfo`Cw|YgUZQg$M;_|VV1$`{)6Pc+cPo;+|okT-y`Z)m$i389l^ABd>vSHoFdz)P? zqa*7$*By8(Q=@Rb{lCa8@=v>$LZ5N$AI(JQTCaKt1SQ4Q4wNuxS*enzqp;$j9s`MG zB&H2bR@-ImJ-H2au`O4rRY^u-6iw89M585>t6)j4thL&t*QU6{ReI~geKY-!KpLNH zK?S^rZYhkzFNg)3eSm*R)*O9my$j9M}dpka5xtXwg-bp3NkWi^)0Vx zIP{f&*g4#q_xlt^BXkZtU%^qgJaHuVg2{`q6Wdxfoba$+cbG0A>b^upl^gZMrAvng z`1`{|>*)B{YPx=MU|{=Xqk+-ymqCe|p2tvcFFO+xlZZ$nahg&NT)qfhc>56g)@IYy5NJm9yb_7GC!MCt z%}07WJ9C{jrueNU?)Zh=eyo(E0yS(_R#smuxAe)mh}-_*@v)$QKnNvwCd}K2Ba)J) zU=IC}gi+>x1h75_vlK+xRm~-kl{Ia)Jz*b~pYVmjd<&IVYTUOEXI?rYmopWTJ+~L0 zL&pXiSJ&%o4_cE@h=x$}zeq=}O*e=>e7O9#C%&VjV|6&c)@8>?Lqo&BU;$c#;6od; zvz#v52I#>1jEq`ZTF`?Cq2gV^uzEvb`RMp~!@-o>7#c?E_}8zqGBZ;N+Gke`)5*6s zroui7)>Z~a^gWxZuFSMf*13(ew4`^m@mY=;7#iLXzl4pAIpkwtu)EbxM?p#oo$mIj zsrt0EyKHPdaAj_8XL~!NprGKLJ1H<9fJn6Sw@2vR!Uq-R2Yw&^%qQYd}GE#g=SQU z=aaufj8RERNd)n>N$#+SnIAE!N1k9@Bp(E>n5NISMi4)$VATstOZ=l>L6B&4{+TM8 zJXH}jJ8KIA^8WsQP>({A@aWW(=lVo7p8s7A4vq&8TBk8DFIW;3y^|3{N9uL1<$;0iGflpO0|T@%`PtdoTO9O|ihRUU67ezS z)!h7^c;GN0Lt1%xpNSV=a+;a+f@swyENA&}n+8bV;L3#o3c*($l9 zCI~FRbby_rdlQ9#N*x{?92^!F{p^0aRH%&nzpv-dM~mM0mX>nUKONuJg!cvCEntj{ zLGG*A)lm=@Y*1NADIy{wQ!aM9$^r-uwRzJP9^#(BUogh!x+S7SCtt2xF4J@z&&|q|jzcRaDo~60-PHghHWy{(R~$zI6m0qU{dG@bw2=T&v; z-X|d`^*8}0R(C8n2vEpz?N6#iAmnQB=9=2t3+S>dXT5*{)5nh=NnQrhBr8hX-oJ9jUWz7Qw1_od|-&S2!1*UCE zafx>osgiG-5=U%OcncM*Q|kzAcsPI%@A%1xNu~2bS6DOulNTiq9^*DbFja*)@H*wY zxu4e{TTJGv<^i=Ez}pZNU6|G#lvL99Ip4#&c@NjQr?iMaS0oFu+use0WVIHob5o7z zV0rs1?s9yy)h@mFR ztuLya2oS<+C}cWpsJxx7BerF*61$KXPuYnM4Y+qBZQ-r@@ups z;?=)AP~-dYYY99u9OSyUGIX#$iBCvK%WsuXaC7Ch6o2@TK*1<2XOA3H8VxSO{*J<{ zE#0+VAo7=U5D_L%PNpum$R)jWcXx+)-rUl1jb1jI_2_uD5DrRMT3FbVsRlw1;|CO( z)Qo)Q?Yt%~h~7itWgGo267lo+Q{!M!v!5SsfY$px6C)x93Uq`VD}my2Z5J$GZm7Qcy}a={=KN}D(yCp5Y)M%R(E(z98&y9e{SMh~2x zgvWM&kM~yfSRGizkr!PpdFD2EiBhtj1~iYJr>^{6Z%TTp`$Z|@WHZ{S*6-uFXYX`N zLihKi8VHuTfV*|7-x>BLi9iN6wVfFbNV|}(|2}tiD3UH*J6FTvU2j)P%wH=qu#*uO zeBMJ?H$E;CZ)E&)#-3iOa~2A=$!)tvt0X#yXAD($nGm2dG)sWie`Q?(LW@ZE(Et zE_0~s`e-6@RIQvt+Qp$KDjM^Ur}@mH6`A{EFGHpD=O|4MI+d_Vf}=fv4mApVGKf)> zH*a$3w}rF@!>pj}dF2}is2v-2hFja9QNPw;x7b+Z)W3~TbhMF#LqX+wUDiKybMX?V z&hriF98UHvp{BZVPl{N)Eu8LRNKJ2br!`Mc6A#$`HS;g@UGavP*UL*>d^2Aw=SNI16SdErEU}asyQLd!5 zBCo56!hAkUyRI!3j%I&c6M$LqmjIe1Rp8TtLoz58GDHE*6|yD0cSCIzZjW+!GqIqw|I7beKv-IWEaMyy4CMm z+uN4_zgSM!*Ci$<5~i;Z8wbN_T$f8epM95tz2u%g{h5{QDQMLFb$fdoC}&Tlr5g^7 zD{jKsP%-?TSQu9)JT6lfrs0QEj);CZ;rG9Ap!ymQ6#@EsA3X!Z-xeZKdm9_)wgW(4 zx2UNr&Aw55Lz)2omzRsHmSuL!R$e#+F+TVYN_^O}ytBdQeJv{0_iauC*3PlU= zs&jH4qDe2V;^DdOYUySuQBqZ$uH$sWfvLB}hm_L^$;k~c5T~Gs84hZG0{}XUX7=H` zckia$cjU(&Ce1B$L;{~JD{<~2RK*RDz~Ifd!0Q9V2)mMmB2Q8h2TiKbbZ%`)5HDVG z+&ER?M?YdX|Fq9xI2ioNb*n*(L%ifdE57LAx1{`Z zFI}aa-va{?jzL+ky`Gh8>Zqw18yQIn{fhiOGD3ap7Qi?p;r4xC`@ku@JH-9)@3jl; z=fvBO;XAMp-slT4Y=k$3A5<#;)8p(}K~H#iR5mNYqfGc=7{7-?wlp=p87nh=SDj$h zyitEr05E&YuyiyV*Xm}3sx(~if8`x(D6dJH6@^230t|-U-1mDbDOqkhD8))1ev5Ms zSda?8S}HzS2t{a?mzM()HFxi*xYv<`8(vji4fU2Z4B!m7s?5w0bE1Ok@;^Sc1}!QI_*=xC!-B*Cf4GlKXqGhN-J>S`A` zxez$aIO9tMCmCre0_NUW@O=xA4}6)9{FagN{C)(q5`uz)km=GGNN4Nvhg_+p zT{+Fi$%*vrskoPeG^tYFeOEov+?>|YM#A{w@Z`k2AuK%nU~B7*@CbG!gZ#=wb*Ung z#ajP=ef=w%AxNcufq~`?1>e7uUcF34MrI-OA7T79;eiqXpPaSdv(9{k9qs$+kK_G# z0uVqB^n)gW1lX2lJpTE&&GI#6D1gZD{Gr$(4Q}GaIfQcPr| z1j`hrvWSZ_v$meD${4k<#}=gmZ8-dQDV3U1Oa?RMU0kZwS))4)#zLVO zWFiG7YJb-uM~{)d*6RwIq5nQ<(|;EZ2@fzBfAbqCq_P0XtL>Jc=Cz*s(b0VG$mCfC zO$VLVX|a4fUrPXi`Hxp}>PN;ALdLs*F@YmARu~!*a-DzxQ&xzG068Re@@s7DC}5NQ z3Hpjr3k&@2-1M>je&QQ9-k6)ap~rYFeQxgmp8~E2v>i&#Z`J_JQ&1W(e8JYi6~;fy z$;nLs-5Gi?Sy{$9I*Az>hT`Iv#>4K@-_~>}^}6tsmTq4iDa=#J1=LJHE3BT5WQvke zQyXbGKbFl=38Us;-{}+0q8{kzSe{ko4>!`6m$-p`=#rOpp$+sMH$u*G)& zREJx16cHkUFIV#l>mlHml$X;8+M|GFo%|`#l77_jemO1sarHF~2yG zqVd1sCp4UyMMOM)eWKsr-%m3(Gw}?J67kJ9orR0-%}llHh6zHd+v zsEi=LPS!ZA0(ykXH|)a)#XO8Zp90gYY~!)#slenXL=7Cmc*4xe3V<__Q$IkRm5-0_ z9F-nER&K7QtLq6p1Aw2z7*_+T=-JsB8D1+;$7>zYD{E`QRufg*+wb7V0y4loqM<$M z>)TRd*ky8Ig-E(2N#wq;vN8trL0A}ivbGY6_r}K8fXZS0q1FPwCwHe#l*y*>;v$+)D!OnK9{2c;Y9D{%g@o#e`jZ3s;Vx|&$rk(V|X{XNhL)^ zhp^F`H*c;_H(YeG6kfmeXl8w~HoTtge^jZn^6=On?=D9&DpXWfCPO1ZJoUBklSVr@ z)I(=ET9RS=GPJyW?>!E_>%lq=1;qhM=)uj7?3d|E&;f;)k`mO3Giz&*jYTcT%7mQO zFSoyBn%_2J5`SLOMPRb=c$E zw`t<3hwzc;(E^G1FR0$9-FJH4zrXbH>0MGhb8~akQwBs5SrF~vFCbw9 @@ -32,8 +32,8 @@ We can then fit a model in `unmarked`, specifying in the formula that we are int For example, here is a simple model fit to the `crossbill` presence-absence dataset included with `unmarked`: -```r -set.seed(123) + +``` r library(unmarked) data(crossbill) @@ -42,6 +42,10 @@ umf <- unmarkedFrameOccu(y=crossbill[,11:13], (mod <- occu(~1~elev, umf)) ``` +``` +## Warning: 7 sites have been discarded because of missing data. +``` + ``` ## ## Call: @@ -78,7 +82,8 @@ Thus, we can calculate the probability that our observed statistic, $\sqrt{W} = In R, for a two-tailed test, this can be calculated as: -```r + +``` r z = sqrt_w = coef(mod)[2] / SE(mod)[2] 2*pnorm(abs(z), lower.tail=FALSE) ``` @@ -125,799 +130,310 @@ However, increasing the sample size requires additional effort and money - so ho For many statistical models, mathematical formulas have been developed so that power can be calculated for any combination of values for factors 1-3 above. This is not true for most occupancy and abundance models available in `unmarked` (but see @Guillera_2012 for one example with occupancy models). Thus, `unmarked` uses a simulation-based approach for estimating power under various combinations of values for effect size, sample size, and significance level. +Below, we illustrate this approach for a single-season occupancy model. ## Inputs -When conducting power analysis, `unmarked` needs three pieces of information corresponding to 1-3 above. -Of these, (1) the effect size and (3) the significance level are easy to set depending on our hypotheses and desired Type I error. -The sample size (2) is trickier: it isn't enough to just provide the number of sites, since datasets in `unmarked` also require a variety of other information such as number of surveys per site, number of distance bins, or number of primary periods. -Thus, power analysis in `unmarked` requires a complete dataset in the form of an appropriate `unmarkedFrame`. - -In some cases, we may want to calculate power using an already collected dataset. -Importantly, this step must be done \textit{before} running our final analysis. -If power analysis is done after the final model is fit, and the effect sizes are defined based on what was observed in that fitted model, we have done what is called a *post-hoc* power analysis, which is a bad idea (see [this post](https://statmodeling.stat.columbia.edu/2018/09/24/dont-calculate-post-hoc-power-using-observed-estimate-effect-size/) for an example of why this is so bad). -In most cases, the real value of power analysis comes before we actually go collect any data, because it helps us decide how much data to collect. -But how to get an `unmarkedFrame` of data before we've done our study? -Once again the solution is simulation: `unmarked` provides a set of tools for simulating datasets for any of its supported model types. - -## Simulating datasets - -To simulate a dataset for a given `unmarked` model, we need at a minimum four pieces of information: - -1. The type of model (the name of the corresponding fitting function) -2. The covariates affecting each submodel, such as occupancy or detection (supplied as formulas) -3. The effect size for each intercept and covariate -4. Study design parameters such as number of sites and number of surveys - -For example, suppose we want to simulate an occupancy dataset (`"occu"`) in which site occupancy is affected by elevation. -The first step is to organize the model structure as a list of formulas, one per submodel. -This list must be named in a specific way depending on the model type. -To get the required names for a given model, fit an example of that model (the documentation should have one) and call `names(model)`. -A single-season occupancy model requires a list with two named components: `state` and `det`. -We supply a formula for each including an effect of elevation on occupancy (note we could name this whatever we want, here we call it `elev`). - - -```r -forms <- list(state=~elev, det=~1) -``` - -Next we must tell `unmarked` what the values for the intercept and regression coefficients in each submodel should be. -Once again, this is a named list, one element for each submodel. -Within each element we need a named vector with names that match the covariates in our list of formulas above. -Note also that each must include a value for the intercept term (this can be named `intercept` or `Intercept`). -If we are not sure exactly how to structure this list, just skip it for now: `unmarked` can generate a template for us to fill in later. - - -```r -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) -``` - -Finally, we need to give `unmarked` information about the study design. -This is pretty simple: we just need a list containing values for `M`, the number of sites, and `J` the number of surveys per site. -For models with multiple primary periods, we'd also need a value of `T`, the number of primary periods. - - -```r -design <- list(M=300, J=8) # 300 sites, 8 occasions per site -``` - -We're now ready to simulate a dataset. -To do this we use the `simulate` function, providing as arguments the name of the model `"occu"` and the three lists we constructed above. -Actually, first, let's not supply the `coefs` list, to show how `unmarked` will generate a template for us to use: - - -```r -simulate("occu", formulas=forms, design=design) -``` +We can do power analysis in `unmarked` using the `powerAnalysis` function. +The `powerAnalysis` function requires several arguments. +1. `object`: Information about the study design, which is provided in the form of an `unmarkedFrame`. Different model types have different `unmarkedFrame` types. For example, occupancy models use `unmarkedFrameOccu` objects. +2. `model`: Type of model we are testing. This is provided as the name of the fitting function; in this case `occu` for single-season occupancy. For many model types, there is a one-to-one correspondence between `unmarkedFrame` type and model type; in these cases it is not necessary to also provide the name of the model. However, for single-season occupancy specifically, `unmarkedFrameOccu` objects are used for the `occu`, `occuRN`, and `occuPEN` model types, so we do need to provide the model name. +3. `...`: Other arguments required by the appropriate fitting function to fit the model of interest. In nearly all cases this will include formulas. In the case of `occu`, the only required additional argument is `formula`, which defines the detection and occupancy model structures. See the help file for the fitting function of interest to determine which arguments are required. +4. `effects`: The effect sizes. We'll talk about these more later. +5. `alpha`: The Type I error rate. We'll leave this at the default of 0.05. -``` -## coefs argument should be a named list of named vectors, with the following structure -## (replacing 0s with your desired coefficient values): -## -## $state -## intercept elev -## 0 0 -## -## $det -## intercept -## 0 -## -## Error : Supply coefs argument as specified above -``` - -Once we have our covariates set up properly, add them to the function call: - +### The `unmarkedFrame` -```r -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) -head(occu_umf) -``` - -``` -## Data frame representation of unmarkedFrame object. -## y.1 y.2 y.3 y.4 y.5 y.6 y.7 y.8 elev -## 1 0 0 0 0 0 0 0 0 -0.7152422 -## 2 0 0 0 0 0 0 0 0 -0.7526890 -## 3 0 0 0 0 1 0 1 0 -0.9385387 -## 4 0 0 0 0 0 0 0 0 -1.0525133 -## 5 1 0 0 0 0 0 1 0 -0.4371595 -## 6 0 1 0 1 1 0 0 0 0.3311792 -## 7 1 1 1 0 0 0 0 0 -2.0142105 -## 8 0 0 0 0 0 0 0 0 0.2119804 -## 9 1 0 0 1 0 1 0 0 1.2366750 -## 10 0 0 0 0 0 0 0 0 2.0375740 -``` - -`unmarked` has generated a presence-absence dataset as well as values for covariate `elev`. - -### Customizing the covariates - -By default, a covariate will be continuous and come from a standard normal distribution. -However, we can control this using the `guide` argument. -For example, suppose we want elevation to have a mean of 2 and a standard deviation of 0.5, and we also want a categorical covariate called `landcover`. -The corresponding formulas and list to supply to `guide` would look like this: - - -```r -forms2 <- list(state=~elev+landcover, det=~1) -guide <- list(landcover=factor(levels=c("forest","grass")), # landcover is factor - elev=list(dist=rnorm, mean=2, sd=0.5)) # custom distribution -``` - -We'd also need an updated `coefs`: - - -```r -coefs2 <- list(state=c(intercept=0, elev=-0.4, landcovergrass=0.2), det=c(intercept=0)) -``` +The `unmarkedFrame` is used to define the study design (such as number of sites, number of occasions, distance breaks in a distance sampling analysis, etc.) and covariate data (typically simulated). +Each model type has a specific kind of `unmarkedFrame`; for an occupancy analysis it is `unmarkedFrameOccu`. +The response data (i.e., the y-matrix) can be filled with missing or random values, as they are replaced later via simulation. +We only care about its dimensions. -```r -head(simulate("occu", formulas=forms2, coefs=coefs2, design=design, guide=guide)) -``` - -``` -## Data frame representation of unmarkedFrame object. -## y.1 y.2 y.3 y.4 y.5 y.6 y.7 y.8 elev landcover -## 1 0 0 0 0 0 0 0 0 2.063074 forest -## 2 0 0 0 0 0 0 0 0 2.236400 forest -## 3 0 0 0 0 0 0 0 0 1.829623 grass -## 4 0 0 0 0 0 0 0 0 1.879105 forest -## 5 0 0 0 0 0 0 0 0 2.689377 grass -## 6 0 0 0 0 0 0 0 0 1.830558 forest -## 7 0 0 0 0 0 0 0 0 2.010068 forest -## 8 0 0 0 0 0 0 0 0 2.188481 grass -## 9 1 0 1 1 1 0 0 0 1.784138 forest -## 10 0 0 0 0 0 0 0 0 2.979532 grass -``` - -Our output dataset now includes a new categorical covariate, and the elevation values are adjusted. - -### Models that require more information - -More complex models might require more information for simulation, such as the distribution to use for abundance with `pcount`. -This information is simply added as additional arguments to `simulate`. -For example, we can simulate a `pcount` dataset using the negative binomial (`"NB"`) distribution. -The negative binomial has an additional parameter to estimate (`alpha`) so we must also add an element to `coefs`. - +``` r +set.seed(123) +M <- 400 # number of sites +J <- 8 # number of occasions +y <- matrix(NA, M, J) # blank y matrix +elev <- rnorm(M) # site covariate -```r -coefs$alpha <- c(alpha=0.5) -head(simulate("pcount", formulas=forms, coefs=coefs, design=design, mixture="NB")) +umf <- unmarkedFrameOccu(y = y, siteCovs = data.frame(elev=elev)) +head(umf) ``` ``` ## Data frame representation of unmarkedFrame object. ## y.1 y.2 y.3 y.4 y.5 y.6 y.7 y.8 elev -## 1 0 0 0 0 0 0 0 0 -1.42329439 -## 2 0 0 0 0 0 0 0 0 1.02230366 -## 3 0 1 1 0 1 0 0 0 0.68781508 -## 4 0 0 0 0 0 0 0 0 -0.30745489 -## 5 0 0 1 0 0 1 0 1 -0.01974906 -## 6 0 1 1 1 0 0 1 0 0.48839839 -## 7 0 0 0 0 0 0 0 0 0.66050081 -## 8 0 1 0 1 1 1 0 1 -1.71404333 -## 9 0 0 0 0 0 0 0 0 1.45885698 -## 10 0 0 0 0 0 0 0 0 -1.40789548 +## 1 NA NA NA NA NA NA NA NA -0.56047565 +## 2 NA NA NA NA NA NA NA NA -0.23017749 +## 3 NA NA NA NA NA NA NA NA 1.55870831 +## 4 NA NA NA NA NA NA NA NA 0.07050839 +## 5 NA NA NA NA NA NA NA NA 0.12928774 +## 6 NA NA NA NA NA NA NA NA 1.71506499 +## 7 NA NA NA NA NA NA NA NA 0.46091621 +## 8 NA NA NA NA NA NA NA NA -1.26506123 +## 9 NA NA NA NA NA NA NA NA -0.68685285 +## 10 NA NA NA NA NA NA NA NA -0.44566197 ``` -## Conducting a power analysis +We now have an `unmarkedFrame` object which describes our study design, but which does not contain any actual detection/non-detection data. -Power analyses are conducted with the `powerAnalysis` function. -A `powerAnalysis` power analysis depends on the input dataset, as well as the covariates of interest and other settings depending on the model (e.g. the distribution used in an N-mixture model or the detection key function in a distance sampling analysis). -The easiest way combine all this information and send it to `powerAnalysis` is to actually fit a model with all the correct settings and our simulated dataset and send *that* to `powerAnalysis`. -This has the added benefit that it checks to make sure we have all the required information for a valid model. -Note that the actual parameter estimates from this model template don't matter - they aren't used in the power analysis. -Thus, there are two required arguments to `powerAnalysis`: a fitted model template, and a list of effect sizes. +### The model type -The first step is to fit a model: +As we discussed earlier, this will be simply `occu`, so that `powerAnalysis` knows we specifically want to test power in a single-season occupancy model. +### Other arguments -```r -template_model <- occu(~1~elev, occu_umf) -``` +After looking at the help page for `occu`, we see that the only other required argument to run an `occu` model is `formula`. +We'll specify an intercept-only formula for detection, and an effect of elevation on occupancy. +In the double-notation formula used by `unmarked`, this results in a formula `~1~elev`. +Other model types will have additional required arguments here, such as multiple separate arguments for formulas, `mixture` to control an abundance distribution, or `keyfun` to specify a distance sampling key function. -If we run `powerAnalysis` on `template_model` with no other arguments, `unmarked` will again give us a template for the list of effect sizes, which looks exactly like the one for simulation above. +### Call `powerAnalysis` +We can now try running `powerAnalysis`, even though we haven't yet discussed effect sizes. -```r -powerAnalysis(template_model) -``` +``` r +powerAnalysis(umf, model = occu, formula = ~1~elev) +``` ``` -## coefs argument should be a named list of named vectors, with the following structure -## (replacing 0s with your desired coefficient values): +## effects should be a named list of vectors, with the following structure +## (replace 0s with your values): ## ## $state -## intercept elev -## 0 0 +## (Intercept) elev +## 0 0 ## ## $det -## intercept -## 0 -## -## Error : Supply coefs argument as specified above +## (Intercept) +## 0 ``` -We will set our desired effect sizes to match what we used for simulation: - - -```r -effect_sizes <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) ``` - -It is also possible to set the significance level `alpha`; the default is 0.05. -We now have all the required information to conduct the power analysis. -Remember, `unmarked` does this by simulation, so you will see a progress bar as `unmarked` conducts simulations. -You can control how many with the `nsim` argument; we'll set `nsim=20` just to speed things up, but normally you should use more. - - -```r -(pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05, nsim=20)) +## Error: Specify effects argument as shown above ``` -``` -## -## Model: -## occu(formula = ~1 ~ elev, data = occu_umf) -## -## Power Statistics: -## Submodel Parameter Effect Null Power -## state (Intercept) 0.0 0 0.00 -## state elev -0.4 0 0.95 -## det (Intercept) 0.0 0 0.00 -``` +We get an error message indicating that we need to provide effect sizes as a list. +More importantly, we also are given a template for providing those effect sizes, which makes things a lot easier. +The structure of this template corresponds to the model structure we defined with our formulas. +Note that the list has two named components `state` and `det`, corresponding to the two submodels, and each contains a numeric vector of parameter values in a specific order. -The result is an object `pa` of class `unmarkedPower`. -If you look at `pa` in the console you will get a summary of power for each parameter in the model. -The summary includes the submodel, parameter name, supplied effect size, null hypothesis, and the calculated power based on simulation. -By default the null for each parameter is 0, you can change this by supplying a list to the `nulls` argument with the same structure as `coefs`. +### Effect sizes -We have power = 0.95 for the effect of elevation on occupancy probability. -This power is calculated by simulating a bunch of datasets based on the template model and supplied effect sizes, fitting a model to each simulated dataset, and then calculating the proportion of these models for which an effect of the covariate would have been detected at the given value of `alpha`. -You can see the raw results from each simulated model with +The effect size list is as crucial input to `powerAnalysis`. +In this list, we need to provide a value for every parameter in the model in order to simulate datasets. +Note that this will include both parameters we specifically want effect sizes for, such as covariate effects, but also other parameters such as intercepts, scale parameters, etc. +All parameter values, even ones we're not specifically interested in calculating power for, will ultimately have some impact on power calculations. +For example, even if we are only interested in the effect size of a covariate on occupancy, the value we choose for the detection intercept will control overall detection probability which will in turn influence power. +So, you should choose all values here carefully based on your study system. +Furthermore, all parameter values in this list need to be on the appropriate inverse link scale. +Remember that for an occupancy model, -```r -pa@estimates -``` +$$ \psi_i = \mathrm{ilogit}(\beta_0 + \beta_1 \cdot elev_i) $$ -### Varying the sample size +We need to provide values of $\beta_0$ and $\beta_1$ in our effect size list, which are on the inverse logit ($\mathrm{ilogit}$) scale. +So for example, a value of 0 for $\beta_0$ corresponds to an average probability of 0.5: -One approach to determining how sample size affects power for our model is to simulate a range of `unmarkedFrames` with varying number of sites, observations, etc. and do a power analysis for each. -However `powerAnalysis` also has a argument `design` which can help do this automatically. -The `design` argument will subsample within the original data to generate datasets which are smaller or larger than the original, and conduct power analyses for each scenario. -For example, to test power for a dataset with only 50 sites and 3 sample occasions at each: - - -```r -# 50 sites and 3 obs per site -(pa2 <- powerAnalysis(template_model, effect_sizes, design=list(M=50, J=3), nsim=20)) +``` r +plogis(0) ``` ``` -## -## Model: -## occu(formula = ~1 ~ elev, data = occu_umf) -## -## Power Statistics: -## Submodel Parameter Effect Null Power -## state (Intercept) 0.0 0 0.0 -## state elev -0.4 0 0.1 -## det (Intercept) 0.0 0 0.0 +## [1] 0.5 ``` -With fewer sites and sampling occasions, our power to detect the elevation effect is reduced. - -You can also get a larger number of sites via sampling the original sites with replacement: +We'll specify values of 0 for both the state and detection intercepts, and a value of -0.4 for the effect of elevation. +The elevation effect is the one we are specifically interested in estimating our power to detect. +We'd choose these values based on our hypotheses, understanding of our study system, etc. +Note that the list elements need to be named just as in the template we saw earlier, and each element is a numeric vector in a specific order. -```r -(pa3 <- powerAnalysis(template_model, effect_sizes, design=list(M=400, J=4), nsim=20)) -``` - -``` -## -## Model: -## occu(formula = ~1 ~ elev, data = occu_umf) -## -## Power Statistics: -## Submodel Parameter Effect Null Power -## state (Intercept) 0.0 0 0.00 -## state elev -0.4 0 0.95 -## det (Intercept) 0.0 0 0.00 +``` r +ef <- list(state = c(0, -0.4), det = 0) ``` -### Combining unmarkedPower objects +## Run the power analysis -The `unmarkedPowerList` function creates a `unmarkedPowerList` object for holding multiple `unmarkedPower` objects so they can be easily compared. -The summary of an `unmarkedPowerList` is a `data.frame` with all the outputs shown together, including relevant sample sizes. +We're now ready to run the analysis, adding our effect size list. -```r -unmarkedPowerList(list(pa, pa2, pa3)) +``` r +pa400 <- powerAnalysis(umf, model = occu, formula = ~1~elev, effects = ef) ``` ``` -## M T J Submodel Parameter Effect Null Power -## 1 300 1 8 state (Intercept) 0.0 0 0.00 -## 2 300 1 8 state elev -0.4 0 0.95 -## 3 300 1 8 det (Intercept) 0.0 0 0.00 -## 4 50 1 3 state (Intercept) 0.0 0 0.00 -## 5 50 1 3 state elev -0.4 0 0.10 -## 6 50 1 3 det (Intercept) 0.0 0 0.00 -## 7 400 1 4 state (Intercept) 0.0 0 0.00 -## 8 400 1 4 state elev -0.4 0 0.95 -## 9 400 1 4 det (Intercept) 0.0 0 0.00 -``` - -We can also create an `unmarkedPowerList` by providing a template model and a range of design scenarios in the `design` argument. -A power analysis will be run for each scenario (sampling the original dataset as shown above) and the results combined. - - -```r -scenarios <- expand.grid(M=c(50,200,400), - J=c(3,5,8)) -pl <- unmarkedPowerList(template_model, effect_sizes, design=scenarios, nsim=20) +## Assumed parameter order for state: +## (Intercept), elev ``` ``` -## M = 50, J = 3 -## M = 200, J = 3 -## M = 400, J = 3 -## M = 50, J = 5 -## M = 200, J = 5 -## M = 400, J = 5 -## M = 50, J = 8 -## M = 200, J = 8 -## M = 400, J = 8 +## Assumed parameter order for det: +## (Intercept) ``` -```r -head(summary(pl)) -``` +You'll see a progress bar as each simulation is run. +By default `unmarked` runs 100 simulations, but you can change this with the `nsim` argument. -``` -## M T J Submodel Parameter Effect Null Power -## 1 50 1 3 state (Intercept) 0.0 0 0.00 -## 2 50 1 3 state elev -0.4 0 0.05 -## 3 50 1 3 det (Intercept) 0.0 0 0.00 -## 4 200 1 3 state (Intercept) 0.0 0 0.00 -## 5 200 1 3 state elev -0.4 0 0.70 -## 6 200 1 3 det (Intercept) 0.0 0 0.00 -``` +Take a look at the output: -```r -tail(summary(pl)) -``` -``` -## M T J Submodel Parameter Effect Null Power -## 22 200 1 8 state (Intercept) 0.0 0 0.0 -## 23 200 1 8 state elev -0.4 0 0.7 -## 24 200 1 8 det (Intercept) 0.0 0 0.0 -## 25 400 1 8 state (Intercept) 0.0 0 0.0 -## 26 400 1 8 state elev -0.4 0 1.0 -## 27 400 1 8 det (Intercept) 0.0 0 0.0 +``` r +pa400 ``` -There is a built-in `plot` method for `unmarkedPowerList`. -You can specify a target power on the plot to the `power` argument. -You also need to specify the parameter of interest (`"elev"`). - - -```r -plot(pl, power=0.8, param="elev") ``` - -![plot of chunk poweranalysis-list](figures/poweranalysis-list-1.png) - -# A more realistic example: Acadian Flycatchers - -## Introduction - -Normally it is crucial to conduct a power analysis before designing the study or collecting data. -For this example, however, we will demonstrate a more complicated power analysis for a dataset that has already been collected. -The real data (not shown here) are observations of Acadian Flycatchers (ACFL; *Empidonax virescens*) at 50 locations in two habitats over 17 years (2005-2022). -We will assess our power to detect differences in ACFL abundance in between habitats, and our power to detect a trend over time. -We'll test power for three different sample sizes: 25 survey points, 50 survey points, and 100 survey points each sampled once per year for 15 years. - -## Simulation - -The main input for the `powerAnalysis` function is a fitted `unmarked` model with the desired sample sizes, covariates, and additional arguments included. -In typical situations, you won't have your real dataset collected yet, so you'll have to first generate a simulated dataset that is similar to what your final dataset will look like. -The `simulate` function in `unmarked` can do this for you. - -As a reminder the key arguments for `simulate` are `forms`, `coefs`, `design`, and `guide`. -The `forms` argument is a list of formulas, one per submodel. -The covariates named in the formulas will become the covariates included in the final simulated dataset. -We need three covariates associated with abundance (lambda): habitat type, year, and point ID (so that we can include point as a random effect). -For the other submodels we're not including covariates so they are just intercept-only formulas. - - -```r -forms <- list(lambda = ~Habitat+Year+(1|Point), dist=~1, rem=~1) -``` - -By default, the covariates we specify in the formulas will be generated randomly from standard normal distributions. -In many cases this is fine, but in our example we need to be more specific given our complex dataset structure. -We need to tell `unmarked` that `Habitat` should be a factor with two levels, and year should take on values 0 through 14 (since we want to have 15 years in the study). -In addition we need the covariates to be structured so that we have 15 rows for point 1 (years 0-14), 15 rows for point 2 (years 0-14) and so on, with each row getting the proper `Point` ID value. -Specifying all this information is the job of the `guide` argument. -We'll supply a custom function for each covariate to `guide`. - -First the function for `Point`, the covariate which identifies which survey point each row of the dataset belongs to. -If we have 10 points and we sample each point for 15 years, we'll need 150 total rows (10*15) in our dataset. -The first 15 rows will correspond to point 1, 16-30 for point 2, and so on. -The following function takes the total number of rows `n` as input, figures out how many points that corresponds to (`n/15`), creates a unique ID for each site, and repeats each ID 15 times. - - -```r -point_function <- function(n){ - stopifnot(n %% 15 == 0) - sites <- n/15 - factor(rep(1:sites, each=15)) -} -point_function(30) # example -``` - -``` -## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 -## Levels: 1 2 -``` - -Next, `Habitat`. -Since each point's `Habitat` value should stay same the same for all 15 years, we need to (1) sample a random `Habitat` value for each point out of two possible habitats, and (2) repeat this value 15 times for each point. -Given a dataset with a number of total rows `n`, the following function figures out how many unique points there should be (`n`/15), samples a habitat for each point, and repeats the value 15 times per point. - - -```r -hab_function <- function(n){ - stopifnot(n %% 15 == 0) - sites <- n/15 - hab <- sample(c("A","B"), sites, replace=TRUE) - factor(rep(hab, each=15)) -} -hab_function(30) # example -``` - -``` -## [1] B B B B B B B B B B B B B B B A A A A A A A A A A A A A A A -## Levels: A B +## Model: test +## Sites: 400 +## Primary Periods: 1 +## Occasions: 8 +## alpha: 0.05 +## +## Power Statistics: +## Submodel Parameter Effect Power Type S Type M +## state elev -0.4 0.96 0 1.054 ``` -Finally, `Year`. -This function works similarly to the two above, except that for each unique point, it assigns year values from 0-14. - +First we get some information about the study design and Type I error. +After that is a table of power statistics for each parameter of interest. +By default the intercepts are excluded from this table (since they are rarely of interest). +Thus we have a single row in the table for our elevation effect. -```r -yr_function <- function(n){ - stopifnot(n %% 15 == 0) - sites <- n/15 - rep(0:14, sites) # 15 years of surveys -} -yr_function(30) # example -``` +We have very high power to detect the effect in this case (0.96). +Also reported are the Type S (sign) and Type M (magnitude) errors (@gelman2014). +The Type S error is the proportion of significant effects which are the wrong sign. +The Type M error is the average absolute value of significant effect sizes, relative to the real effect size. +When your study is underpowered, you will often have high Type S and Type M errors, which indicate you risk getting the direction of the effect wrong, or overestimating the effect size, respectively. +In this case Type S error is close to 0 and Type M error is close to 1, indicating no problems. +We'll talk more about Type M errors in a minute. -``` -## [1] 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 1 2 3 4 5 6 7 8 9 -## [26] 10 11 12 13 14 -``` +## Run the power analysis for a smaller sample size -These functions are combined together in a named list of lists to supply to `guide`. +Usually you'll want to test a few sample sizes to compare power across them. +Let's test a much smaller sample size of only 50 sites. +We can do this quickly by just sub-setting our `unmarkedFrame` to only the first 50 sites; we could also simulate an entirely new one. -```r -guide <- list(Point = list(dist=point_function), - Year = list(dist=yr_function), - Habitat = list(dist=hab_function)) +``` r +umf50 <- umf[1:50,] ``` -Next, the sample sizes with `design`. -We'll first simulate a dataset with 25 unique points, so we'll need 25*15 site-years since each point is sampled 15 times. -To match the real dataset we'll specify 2 distance bins and 3 removal periods. +Now call `powerAnalysis` again using the new `unmarkedFrame`: -```r -design <- list(M = 25*15, Jdist=2, Jrem=3) +``` r +pa50 <- powerAnalysis(umf50, model = occu, formula = ~1~elev, effects = ef) +pa50 ``` -Since this dataset will have distance bin data in it, we also want to specify how the distance bins will look. -We want two bins, with breaks at 0, 25 m, and 50 m. - - -```r -db <- c(0,25,50) ``` - -Finally, we need to provide the parameter values used to actually simulate the response (`y`) according to our specifications (e.g., the intercepts and slopes). -These are provided as a list of vectors to the `coefs` argument. -At this point, we don't actually care what these values are. -We just want to simulate a dataset with the correct structure and covariate values (to use as a template), we don't care what the values in the output `y` matrix actually are since they will be discarded later. -Therefore, we'll just set most parameter values to 0. -However we need to set the distance function intercept to something slightly more realistic - e.g. the log of the median value of the distance breaks. - - -```r -coefs_temp <- list(lambda = c(intercept=0, HabitatB=0, Year=0, Point=0), - dist = c(intercept=log(median(db))), rem=c(intercept=0)) +## Model: test +## Sites: 50 +## Primary Periods: 1 +## Occasions: 8 +## alpha: 0.05 +## +## Power Statistics: +## Submodel Parameter Effect Power Type S Type M +## state elev -0.4 0.23 0 2.246 ``` -We're finally ready to simulate the template dataset with all the pieces created above. -We also need to add a bit more information - our units should be in meters, and we want the output on the abundance scale. +With a much smaller sample size, we also have much lower power. +Note we also have a Type M error ~2, indicating that any significant effect sizes we do get from a study of this sample size are likely to be overestimates. +We can visualize this using `plot`: -```r -set.seed(1) -umf25 <- simulate("gdistremoval", formulas=forms, design=design, coefs=coefs_temp, - guide=guide, unitsIn='m', dist.breaks=db, output='abund') -head(umf25) +``` r +plot(pa50) ``` -``` -## Data frame representation of unmarkedFrame object. -## yDist.1 yDist.2 yRem.1 yRem.2 yRem.3 Habitat Year Point -## 1 1 0 1 0 0 A 0 1 -## 2 0 0 0 0 0 A 1 1 -## 3 1 0 0 0 1 A 2 1 -## 4 0 0 0 0 0 A 3 1 -## 5 0 0 0 0 0 A 4 1 -## 6 1 0 1 0 0 A 5 1 -## 7 1 0 1 0 0 A 6 1 -## 8 0 1 0 1 0 A 7 1 -## 9 0 0 0 0 0 A 8 1 -## 10 1 0 1 0 0 A 9 1 -``` - -In the output you can see we have covariates for Habitat, Year, and Point which seem to be structured the way we want. -Remember we don't care what's actually *in* the `y` matrix, we just want it to be the right size. -We can double check that the number of rows in the dataset is correct - it should be 25*15 = 375. - - -```r -numSites(umf25) -``` +![](powerAnalysis-figures/pa50-1.png) -``` -## [1] 375 -``` +Note that the simulation replicates that were significant (red) tended to have much more negative estimated effect sizes than the truth. +If you conducted this study with only 50 sites and found a significant elevation effect, it's likely the estimate you obtain would be much stronger (i.e., larger absolute value) than the truth. +To read more about Type M and Type S errors, see @gelman2014. -## Creating the template model +## Compare power across several sample sizes -The final step is to fit the correct model to the dataset. -Again, we don't care at all about the *results* of this model, we just want to make sure all the relevant information and arguments are included so that `powerAnalysis` is working with the right information about our proposed study. +Let's run a few more power analyses at sample sizes between 50 and 400. +Note it would probably better to create new `unmarkedFrame`s for each instead of sub-sampling the same one, but we'll skip this for brevity. -```r -mod25 <- gdistremoval(lambdaformula=~Habitat+Year+(1|Point), distanceformula=~1, - removalformula=~1, data=umf25, output='abund') +``` r +pa100 <- powerAnalysis(umf[1:100,], model = occu, formula = ~1~elev, effects = ef) +pa200 <- powerAnalysis(umf[1:200,], model = occu, formula = ~1~elev, effects = ef) +pa300 <- powerAnalysis(umf[1:300,], model = occu, formula = ~1~elev, effects = ef) ``` -## Running the power analysis +We can combine all our power analyses into one `unmarkedPowerList` object: -With the template model for a 25 point study design in hand, we can now move on to the actual power analysis. -In addition to the template model, we now need to tell `unmarked` what the "true" values of the parameters in the model are. -These are essentially the effect sizes we want to test our ability to identify given our study design. -This is a step where you have to use your expert knowledge to make some guesses about the true state of the system you are studying. -Below are coefficients which describe a system where abundance in Habitat A is roughly 5, Habitat B is roughly 6, abundance declines about 2% per year, and the random variance among points is relatively small (0.1). -Furthermore, the value of the detection function parameter $\sigma$ is equal to the median of the distance breaks (25), and the removal probability of detection is about 0.27. -These are roughly based on our knowledge of the real study system. - - -```r -coefs <- list(lambda = c(intercept=log(5), HabitatB=0.18, - # 2% decline in abundance per year - Year=log(0.98), - # standard deviation on point random effect - Point=0.1), - # detection sigma = median distance - dist = c(intercept=log(median(db))), - # removal p = ~0.27 - rem = c(intercept=-1)) +``` r +pl <- unmarkedPowerList(pa50, pa100, pa200, pa300, pa400) ``` -By specifying the `coefs` this way, we will be testing our power to detect that Habitat B has significantly greater abundance than Habitat A, given that the true difference between Habitat B and A is 0.2 units (on the log scale) or 1 bird (on the real scale). -We are also testing our power to detect a significant declining trend in abundance, given that the "true" trend is a yearly decline of about 2%. - -Now, run the analysis. -We're using 50 simulations for speed but you should typically use more. +View a summary: -```r -(pa25 <- powerAnalysis(mod25, coefs=coefs, nsim=100)) +``` r +pl ``` ``` +## Model: test +## Number of sites (M): 50, 100, 200, 300, 400 +## Number of primary periods (T): 1, 1, 1, 1, 1 +## Number of occasions (J): 8, 8, 8, 8, 8 +## alpha: 0.05 ## -## Model: -## gdistremoval(lambdaformula = ~Habitat + Year + (1 | Point), removalformula = ~1, -## distanceformula = ~1, data = umf25, output = "abund") -## -## Power Statistics: -## Submodel Parameter Effect Null Power -## lambda (Intercept) 1.60943791 0 1.00 -## lambda HabitatB 0.18000000 0 0.45 -## lambda Year -0.02020271 0 0.47 -## dist (Intercept) 3.21887582 0 1.00 -## rem (Intercept) -1.00000000 0 1.00 +## M T J Submodel Parameter Effect Null Power Type S Type M +## 1 50 1 8 state elev -0.4 0 0.23 0 2.246006 +## 2 100 1 8 state elev -0.4 0 0.43 0 1.613682 +## 3 200 1 8 state elev -0.4 0 0.75 0 1.205985 +## 4 300 1 8 state elev -0.4 0 0.88 0 1.089148 +## 5 400 1 8 state elev -0.4 0 0.96 0 1.054162 ``` -In this case we only care about the `HabitatB` and `Year` rows in the output table, we're ignoring the intercepts. -We found we have weak power (<0.5) to detect both effects with this sample size. - -To test the other two sample sizes (50 and 100 sites x 15 years), we just simulate new datasets and repeat the process. -We only need to change the `design` argument to simulate. - +Plot the power curve: -```r -umf50 <- simulate("gdistremoval", formulas=forms, - design=list(M = 50*15, Jdist=2, Jrem=3), # change here - coefs=coefs_temp, - guide=guide, unitsIn='m', dist.breaks=db, output='abund') -mod50 <- gdistremoval(lambdaformula=~Habitat+Year+(1|Point), distanceformula=~1, - removalformula=~1, data=umf50, output='abund') -pa50 <- powerAnalysis(mod50, coefs=coefs, nsim=100) -umf100 <- simulate("gdistremoval", formulas=forms, - design=list(M = 100*15, Jdist=2, Jrem=3), # change here - coefs=coefs_temp, - guide=guide, unitsIn='m', dist.breaks=db, output='abund') -mod100 <- gdistremoval(lambdaformula=~Habitat+Year+(1|Point), distanceformula=~1, - removalformula=~1, data=umf100, output='abund') -pa100 <- powerAnalysis(mod100, coefs=coefs, nsim=100) +``` r +plot(pl, power = 0.8) ``` -## Examining the results +![](powerAnalysis-figures/pl-1.png) -In addition to looking at the summary table outputs of `pa25`, `pa50`, and `pa100`, they can also be combined into an `unmarkedPowerList` for easier comparison. +A sample size of 300 would be adequate to get to our target power of 0.8 +We could also vary the number of occasions: -```r -(pl <- unmarkedPowerList(list(pa25, pa50, pa100))) -``` +``` r +pa50_2 <- powerAnalysis(umf[1:50,1:2], model = occu, formula = ~1~elev, effects = ef) +pa100_2 <- powerAnalysis(umf[1:100,1:2], model = occu, formula = ~1~elev, effects = ef) +pa200_2 <- powerAnalysis(umf[1:200,1:2], model = occu, formula = ~1~elev, effects = ef) +pa300_2 <- powerAnalysis(umf[1:300,1:2], model = occu, formula = ~1~elev, effects = ef) +pa400_2 <- powerAnalysis(umf[,1:2], model = occu, formula = ~1~elev, effects = ef) ``` -## M T J Submodel Parameter Effect Null Power -## 1 375 1 3 lambda (Intercept) 1.60943791 0 1.00 -## 2 375 1 3 lambda HabitatB 0.18000000 0 0.45 -## 3 375 1 3 lambda Year -0.02020271 0 0.47 -## 4 375 1 3 dist (Intercept) 3.21887582 0 1.00 -## 5 375 1 3 rem (Intercept) -1.00000000 0 1.00 -## 6 750 1 3 lambda (Intercept) 1.60943791 0 1.00 -## 7 750 1 3 lambda HabitatB 0.18000000 0 0.58 -## 8 750 1 3 lambda Year -0.02020271 0 0.80 -## 9 750 1 3 dist (Intercept) 3.21887582 0 1.00 -## 10 750 1 3 rem (Intercept) -1.00000000 0 1.00 -## 11 1500 1 3 lambda (Intercept) 1.60943791 0 1.00 -## 12 1500 1 3 lambda HabitatB 0.18000000 0 0.97 -## 13 1500 1 3 lambda Year -0.02020271 0 0.96 -## 14 1500 1 3 dist (Intercept) 3.21887582 0 1.00 -## 15 1500 1 3 rem (Intercept) -1.00000000 0 1.00 -``` - -There's a default plotting method for `unmarkedPowerLists`. -You need to specify the parameter of interest, and you can optionally define a target power level to add to the plot: -```r -plot(pl, par="HabitatB", power=0.8) +``` r +pl2 <- unmarkedPowerList(pa50, pa100, pa200, pa300, pa400, + pa50_2, pa100_2, pa200_2, pa300_2, pa400_2) ``` -![plot of chunk poweranalysis-acfl](figures/poweranalysis-acfl-1.png) -```r -plot(pl, par="Year", power=0.8) +``` r +plot(pl2, power = 0.8) ``` -![plot of chunk poweranalysis-acfl](figures/poweranalysis-acfl-2.png) - -Note that the x-axis shows sites as the number of site-years (e.g., sites x years). -It looks like only the largest tested sample size (100 sites) has power > 0.8 to detect a significant effect of habitat type and year in the correct direction. - -# Shiny webapp - -`unmarked` now includes a [Shiny](https://shiny.posit.co/) webapp that can be used to conduct power analyses. -The Shiny app is launched with the `shinyPower()` function, which takes as a template model as an input argument (see above). -This function opens a window in your web browser. -Once the application is loaded, you can experiment with different settings and generate summaries and figures for the resulting power estimates. - -## Demonstration - -First, we simulate a template model for a single-species occupancy analysis, using the `simulate` function as described above. -We have one covariate of interest on occupancy (`elev`) and one on detection (`wind`). - - -```r -umf <- simulate("occu", formulas=list(state=~elev, det=~wind), - coefs=list(state=c(intercept=0, elev=0.3), - det=c(intercept=0.4, wind=-0.2)), - design=list(M=100, J=5)) - -(mod <- occu(~wind~elev, umf)) -``` - -``` -## -## Call: -## occu(formula = ~wind ~ elev, data = umf) -## -## Occupancy: -## Estimate SE z P(>|z|) -## (Intercept) -0.0624 0.203 -0.308 0.758 -## elev 0.1965 0.232 0.849 0.396 -## -## Detection: -## Estimate SE z P(>|z|) -## (Intercept) 0.4736 0.137 3.457 0.000546 -## wind -0.0599 0.125 -0.479 0.632033 -## -## AIC: 463.2808 -``` - -Next call the `shinyPower` function on our template model, which starts the Shiny app in your web browser. - - -```r -shinyPower(mod) -``` - -A demo version of the app you can experiment with can be found [here](https://kenkellner.shinyapps.io/unmarked-power/). -The next section provides a more detailed tutorial for the app using screenshots. - -## Tutorial - -### Inputs - -The shaded vertical bar on the left is where we set the options for the analysis -At the top left you will see the name and type of the model you provided to `shinyPower`. - -![](figures/poweranalysis-modinfo.png) - -Next you can set the value for $\alpha$, and the number of simulations to run in each power analysis. -The default is 10, but you should usually set it to something higher. - -![](figures/poweranalysis-alpha.png) - -After that you can, if you wish, specify one or more sample size scenarios by manipulating the number of sites and number of observations. -If you set a number of sites/observations smaller than what was in the original template model dataset, the dataset will be subsampled; if larger, the new dataset(s) will be bootstrapped. -It's a good idea to simulate the template model with the largest sample size you want to test here to avoid the bootstrapping. - -![](figures/poweranalysis-scenarios.png) - -Next you must set the effect sizes you want to test in the power analysis. -Each submodel has its own section. -In this case state = occupancy and det = detection. -Effect sizes for all parameters in the model default to 0; you'll want to change them to reflect your expectations about the study system. -Here we are simulating datasets with an elevation effect of 0.4 (on the logit scale), with occupancy and detection intercepts equal to 0 (equivalent to probabilities of 0.5). - -![](figures/poweranalysis-effectsizes.png) - -You can also set the null hypotheses manually if you want by clicking on the "Null hypotheses" tab. -By default they are all set at 0. - -![](figures/poweranalysis-nulls.png) - -Finally, click the run button. -You should see one or more progress bars in the lower right of the application. - -![](figures/poweranalysis-run.png) - -### Outputs - -To the right of the input sidebar is a set of tabs showing output. -The "Summary" tab shows a table with estimates of power for each parameter under each scenario you specified earlier. -The "Plot" tab shows a plot of how power changes for a given parameter based on sample size (it will not be useful if you only have one sample size scenario). -Here's the first few lines of a summary table with three scenarios for number of sites (100, 75, 50) and two for number of observations (2, 5), testing for an `elev` effect size of 0.4: - -![](figures/poweranalysis-summarytable.png) - -And the corresponding summary figure for `elev`: +![](powerAnalysis-figures/pl2-1.png) -![](figures/poweranalysis-summaryplot.png) +As you can see, reducing the number of replicate samples at each site also reduces power, but generally has less of an impact that number of sites. # Conclusion diff --git a/vignettes/powerAnalysis.Rmd.orig b/vignettes/powerAnalysis.Rmd.orig index 4c8fda86..ac174678 100644 --- a/vignettes/powerAnalysis.Rmd.orig +++ b/vignettes/powerAnalysis.Rmd.orig @@ -1,13 +1,13 @@ --- title: Power Analysis in unmarked author: Ken Kellner -date: November 7, 2022 +date: July 9, 2024 bibliography: unmarked.bib csl: ecology.csl output: rmarkdown::html_vignette: - fig_width: 5 - fig_height: 3.5 + fig_width: 6 + fig_height: 6 number_sections: true toc: true vignette: > @@ -17,7 +17,7 @@ vignette: > --- ```{r,echo=FALSE} -knitr::opts_chunk$set(fig.path="figures/") +knitr::opts_chunk$set(fig.path="powerAnalysis-figures/") ``` # Hypothesis Testing @@ -33,8 +33,8 @@ In order to test these hypotheses, we must collected appropriate data, perhaps b We can then fit a model in `unmarked`, specifying in the formula that we are interested in estimating the effect of elevation on occupancy. For example, here is a simple model fit to the `crossbill` presence-absence dataset included with `unmarked`: -```{r, warning=FALSE} -set.seed(123) + +```{r} library(unmarked) data(crossbill) @@ -61,6 +61,7 @@ It turns out that the square root of the Wald statistic, $\sqrt{W}$, follows a s Thus, we can calculate the probability that our observed statistic, $\sqrt{W} = 3.59$, occurred by chance assuming that the null hypothesis $\theta = 0$ is true. In R, for a two-tailed test, this can be calculated as: + ```{r} z = sqrt_w = coef(mod)[2] / SE(mod)[2] 2*pnorm(abs(z), lower.tail=FALSE) @@ -103,511 +104,203 @@ However, increasing the sample size requires additional effort and money - so ho For many statistical models, mathematical formulas have been developed so that power can be calculated for any combination of values for factors 1-3 above. This is not true for most occupancy and abundance models available in `unmarked` (but see @Guillera_2012 for one example with occupancy models). Thus, `unmarked` uses a simulation-based approach for estimating power under various combinations of values for effect size, sample size, and significance level. +Below, we illustrate this approach for a single-season occupancy model. ## Inputs -When conducting power analysis, `unmarked` needs three pieces of information corresponding to 1-3 above. -Of these, (1) the effect size and (3) the significance level are easy to set depending on our hypotheses and desired Type I error. -The sample size (2) is trickier: it isn't enough to just provide the number of sites, since datasets in `unmarked` also require a variety of other information such as number of surveys per site, number of distance bins, or number of primary periods. -Thus, power analysis in `unmarked` requires a complete dataset in the form of an appropriate `unmarkedFrame`. - -In some cases, we may want to calculate power using an already collected dataset. -Importantly, this step must be done \textit{before} running our final analysis. -If power analysis is done after the final model is fit, and the effect sizes are defined based on what was observed in that fitted model, we have done what is called a *post-hoc* power analysis, which is a bad idea (see [this post](https://statmodeling.stat.columbia.edu/2018/09/24/dont-calculate-post-hoc-power-using-observed-estimate-effect-size/) for an example of why this is so bad). -In most cases, the real value of power analysis comes before we actually go collect any data, because it helps us decide how much data to collect. -But how to get an `unmarkedFrame` of data before we've done our study? -Once again the solution is simulation: `unmarked` provides a set of tools for simulating datasets for any of its supported model types. - -## Simulating datasets - -To simulate a dataset for a given `unmarked` model, we need at a minimum four pieces of information: - -1. The type of model (the name of the corresponding fitting function) -2. The covariates affecting each submodel, such as occupancy or detection (supplied as formulas) -3. The effect size for each intercept and covariate -4. Study design parameters such as number of sites and number of surveys +We can do power analysis in `unmarked` using the `powerAnalysis` function. +The `powerAnalysis` function requires several arguments. -For example, suppose we want to simulate an occupancy dataset (`"occu"`) in which site occupancy is affected by elevation. -The first step is to organize the model structure as a list of formulas, one per submodel. -This list must be named in a specific way depending on the model type. -To get the required names for a given model, fit an example of that model (the documentation should have one) and call `names(model)`. -A single-season occupancy model requires a list with two named components: `state` and `det`. -We supply a formula for each including an effect of elevation on occupancy (note we could name this whatever we want, here we call it `elev`). +1. `object`: Information about the study design, which is provided in the form of an `unmarkedFrame`. Different model types have different `unmarkedFrame` types. For example, occupancy models use `unmarkedFrameOccu` objects. +2. `model`: Type of model we are testing. This is provided as the name of the fitting function; in this case `occu` for single-season occupancy. For many model types, there is a one-to-one correspondence between `unmarkedFrame` type and model type; in these cases it is not necessary to also provide the name of the model. However, for single-season occupancy specifically, `unmarkedFrameOccu` objects are used for the `occu`, `occuRN`, and `occuPEN` model types, so we do need to provide the model name. +3. `...`: Other arguments required by the appropriate fitting function to fit the model of interest. In nearly all cases this will include formulas. In the case of `occu`, the only required additional argument is `formula`, which defines the detection and occupancy model structures. See the help file for the fitting function of interest to determine which arguments are required. +4. `effects`: The effect sizes. We'll talk about these more later. +5. `alpha`: The Type I error rate. We'll leave this at the default of 0.05. -```{r} -forms <- list(state=~elev, det=~1) -``` +### The `unmarkedFrame` -Next we must tell `unmarked` what the values for the intercept and regression coefficients in each submodel should be. -Once again, this is a named list, one element for each submodel. -Within each element we need a named vector with names that match the covariates in our list of formulas above. -Note also that each must include a value for the intercept term (this can be named `intercept` or `Intercept`). -If we are not sure exactly how to structure this list, just skip it for now: `unmarked` can generate a template for us to fill in later. +The `unmarkedFrame` is used to define the study design (such as number of sites, number of occasions, distance breaks in a distance sampling analysis, etc.) and covariate data (typically simulated). +Each model type has a specific kind of `unmarkedFrame`; for an occupancy analysis it is `unmarkedFrameOccu`. +The response data (i.e., the y-matrix) can be filled with missing or random values, as they are replaced later via simulation. +We only care about its dimensions. ```{r} -coefs <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) -``` - -Finally, we need to give `unmarked` information about the study design. -This is pretty simple: we just need a list containing values for `M`, the number of sites, and `J` the number of surveys per site. -For models with multiple primary periods, we'd also need a value of `T`, the number of primary periods. +set.seed(123) +M <- 400 # number of sites +J <- 8 # number of occasions +y <- matrix(NA, M, J) # blank y matrix +elev <- rnorm(M) # site covariate -```{r} -design <- list(M=300, J=8) # 300 sites, 8 occasions per site +umf <- unmarkedFrameOccu(y = y, siteCovs = data.frame(elev=elev)) +head(umf) ``` -We're now ready to simulate a dataset. -To do this we use the `simulate` function, providing as arguments the name of the model `"occu"` and the three lists we constructed above. -Actually, first, let's not supply the `coefs` list, to show how `unmarked` will generate a template for us to use: - -```{r, eval=FALSE} -simulate("occu", formulas=forms, design=design) -``` +We now have an `unmarkedFrame` object which describes our study design, but which does not contain any actual detection/non-detection data. -```{r, echo=FALSE} -try(simulate("occu", formulas=forms, design=design)) -``` +### The model type -Once we have our covariates set up properly, add them to the function call: +As we discussed earlier, this will be simply `occu`, so that `powerAnalysis` knows we specifically want to test power in a single-season occupancy model. -```{r} -occu_umf <- simulate("occu", formulas=forms, coefs=coefs, design=design) -head(occu_umf) -``` +### Other arguments -`unmarked` has generated a presence-absence dataset as well as values for covariate `elev`. +After looking at the help page for `occu`, we see that the only other required argument to run an `occu` model is `formula`. +We'll specify an intercept-only formula for detection, and an effect of elevation on occupancy. +In the double-notation formula used by `unmarked`, this results in a formula `~1~elev`. +Other model types will have additional required arguments here, such as multiple separate arguments for formulas, `mixture` to control an abundance distribution, or `keyfun` to specify a distance sampling key function. -### Customizing the covariates +### Call `powerAnalysis` -By default, a covariate will be continuous and come from a standard normal distribution. -However, we can control this using the `guide` argument. -For example, suppose we want elevation to have a mean of 2 and a standard deviation of 0.5, and we also want a categorical covariate called `landcover`. -The corresponding formulas and list to supply to `guide` would look like this: +We can now try running `powerAnalysis`, even though we haven't yet discussed effect sizes. -```{r} -forms2 <- list(state=~elev+landcover, det=~1) -guide <- list(landcover=factor(levels=c("forest","grass")), # landcover is factor - elev=list(dist=rnorm, mean=2, sd=0.5)) # custom distribution +```{r, error=TRUE} +powerAnalysis(umf, model = occu, formula = ~1~elev) ``` -We'd also need an updated `coefs`: +We get an error message indicating that we need to provide effect sizes as a list. +More importantly, we also are given a template for providing those effect sizes, which makes things a lot easier. +The structure of this template corresponds to the model structure we defined with our formulas. +Note that the list has two named components `state` and `det`, corresponding to the two submodels, and each contains a numeric vector of parameter values in a specific order. -```{r} -coefs2 <- list(state=c(intercept=0, elev=-0.4, landcovergrass=0.2), det=c(intercept=0)) -``` +### Effect sizes -```{r} -head(simulate("occu", formulas=forms2, coefs=coefs2, design=design, guide=guide)) -``` +The effect size list is as crucial input to `powerAnalysis`. +In this list, we need to provide a value for every parameter in the model in order to simulate datasets. +Note that this will include both parameters we specifically want effect sizes for, such as covariate effects, but also other parameters such as intercepts, scale parameters, etc. +All parameter values, even ones we're not specifically interested in calculating power for, will ultimately have some impact on power calculations. +For example, even if we are only interested in the effect size of a covariate on occupancy, the value we choose for the detection intercept will control overall detection probability which will in turn influence power. +So, you should choose all values here carefully based on your study system. -Our output dataset now includes a new categorical covariate, and the elevation values are adjusted. +Furthermore, all parameter values in this list need to be on the appropriate inverse link scale. +Remember that for an occupancy model, -### Models that require more information +$$ \psi_i = \mathrm{ilogit}(\beta_0 + \beta_1 \cdot elev_i) $$ -More complex models might require more information for simulation, such as the distribution to use for abundance with `pcount`. -This information is simply added as additional arguments to `simulate`. -For example, we can simulate a `pcount` dataset using the negative binomial (`"NB"`) distribution. -The negative binomial has an additional parameter to estimate (`alpha`) so we must also add an element to `coefs`. +We need to provide values of $\beta_0$ and $\beta_1$ in our effect size list, which are on the inverse logit ($\mathrm{ilogit}$) scale. +So for example, a value of 0 for $\beta_0$ corresponds to an average probability of 0.5: ```{r} -coefs$alpha <- c(alpha=0.5) -head(simulate("pcount", formulas=forms, coefs=coefs, design=design, mixture="NB")) +plogis(0) ``` -## Conducting a power analysis - -Power analyses are conducted with the `powerAnalysis` function. -A `powerAnalysis` power analysis depends on the input dataset, as well as the covariates of interest and other settings depending on the model (e.g. the distribution used in an N-mixture model or the detection key function in a distance sampling analysis). -The easiest way combine all this information and send it to `powerAnalysis` is to actually fit a model with all the correct settings and our simulated dataset and send *that* to `powerAnalysis`. -This has the added benefit that it checks to make sure we have all the required information for a valid model. -Note that the actual parameter estimates from this model template don't matter - they aren't used in the power analysis. -Thus, there are two required arguments to `powerAnalysis`: a fitted model template, and a list of effect sizes. - -The first step is to fit a model: +We'll specify values of 0 for both the state and detection intercepts, and a value of -0.4 for the effect of elevation. +The elevation effect is the one we are specifically interested in estimating our power to detect. +We'd choose these values based on our hypotheses, understanding of our study system, etc. +Note that the list elements need to be named just as in the template we saw earlier, and each element is a numeric vector in a specific order. ```{r} -template_model <- occu(~1~elev, occu_umf) -``` - -If we run `powerAnalysis` on `template_model` with no other arguments, `unmarked` will again give us a template for the list of effect sizes, which looks exactly like the one for simulation above. - -```{r, eval=FALSE} -powerAnalysis(template_model) +ef <- list(state = c(0, -0.4), det = 0) ``` -```{r, echo=FALSE} -try(powerAnalysis(template_model)) -``` +## Run the power analysis -We will set our desired effect sizes to match what we used for simulation: +We're now ready to run the analysis, adding our effect size list. ```{r} -effect_sizes <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) +pa400 <- powerAnalysis(umf, model = occu, formula = ~1~elev, effects = ef) ``` -It is also possible to set the significance level `alpha`; the default is 0.05. -We now have all the required information to conduct the power analysis. -Remember, `unmarked` does this by simulation, so you will see a progress bar as `unmarked` conducts simulations. -You can control how many with the `nsim` argument; we'll set `nsim=20` just to speed things up, but normally you should use more. +You'll see a progress bar as each simulation is run. +By default `unmarked` runs 100 simulations, but you can change this with the `nsim` argument. -```{r} -(pa <- powerAnalysis(template_model, coefs=effect_sizes, alpha=0.05, nsim=20)) -``` - -The result is an object `pa` of class `unmarkedPower`. -If you look at `pa` in the console you will get a summary of power for each parameter in the model. -The summary includes the submodel, parameter name, supplied effect size, null hypothesis, and the calculated power based on simulation. -By default the null for each parameter is 0, you can change this by supplying a list to the `nulls` argument with the same structure as `coefs`. - -We have power = 0.95 for the effect of elevation on occupancy probability. -This power is calculated by simulating a bunch of datasets based on the template model and supplied effect sizes, fitting a model to each simulated dataset, and then calculating the proportion of these models for which an effect of the covariate would have been detected at the given value of `alpha`. -You can see the raw results from each simulated model with - -```{r, eval=FALSE} -pa@estimates -``` - -### Varying the sample size - -One approach to determining how sample size affects power for our model is to simulate a range of `unmarkedFrames` with varying number of sites, observations, etc. and do a power analysis for each. -However `powerAnalysis` also has a argument `design` which can help do this automatically. - -The `design` argument will subsample within the original data to generate datasets which are smaller or larger than the original, and conduct power analyses for each scenario. -For example, to test power for a dataset with only 50 sites and 3 sample occasions at each: +Take a look at the output: ```{r} -# 50 sites and 3 obs per site -(pa2 <- powerAnalysis(template_model, effect_sizes, design=list(M=50, J=3), nsim=20)) +pa400 ``` -With fewer sites and sampling occasions, our power to detect the elevation effect is reduced. - -You can also get a larger number of sites via sampling the original sites with replacement: +First we get some information about the study design and Type I error. +After that is a table of power statistics for each parameter of interest. +By default the intercepts are excluded from this table (since they are rarely of interest). +Thus we have a single row in the table for our elevation effect. -```{r} -(pa3 <- powerAnalysis(template_model, effect_sizes, design=list(M=400, J=4), nsim=20)) -``` +We have very high power to detect the effect in this case (0.96). +Also reported are the Type S (sign) and Type M (magnitude) errors (@gelman2014). +The Type S error is the proportion of significant effects which are the wrong sign. +The Type M error is the average absolute value of significant effect sizes, relative to the real effect size. +When your study is underpowered, you will often have high Type S and Type M errors, which indicate you risk getting the direction of the effect wrong, or overestimating the effect size, respectively. +In this case Type S error is close to 0 and Type M error is close to 1, indicating no problems. +We'll talk more about Type M errors in a minute. -### Combining unmarkedPower objects +## Run the power analysis for a smaller sample size -The `unmarkedPowerList` function creates a `unmarkedPowerList` object for holding multiple `unmarkedPower` objects so they can be easily compared. -The summary of an `unmarkedPowerList` is a `data.frame` with all the outputs shown together, including relevant sample sizes. +Usually you'll want to test a few sample sizes to compare power across them. +Let's test a much smaller sample size of only 50 sites. +We can do this quickly by just sub-setting our `unmarkedFrame` to only the first 50 sites; we could also simulate an entirely new one. ```{r} -unmarkedPowerList(list(pa, pa2, pa3)) +umf50 <- umf[1:50,] ``` -We can also create an `unmarkedPowerList` by providing a template model and a range of design scenarios in the `design` argument. -A power analysis will be run for each scenario (sampling the original dataset as shown above) and the results combined. +Now call `powerAnalysis` again using the new `unmarkedFrame`: -```{r} -scenarios <- expand.grid(M=c(50,200,400), - J=c(3,5,8)) -pl <- unmarkedPowerList(template_model, effect_sizes, design=scenarios, nsim=20) -head(summary(pl)) -tail(summary(pl)) +```{r, message=FALSE} +pa50 <- powerAnalysis(umf50, model = occu, formula = ~1~elev, effects = ef) +pa50 ``` -There is a built-in `plot` method for `unmarkedPowerList`. -You can specify a target power on the plot to the `power` argument. -You also need to specify the parameter of interest (`"elev"`). +With a much smaller sample size, we also have much lower power. +Note we also have a Type M error ~2, indicating that any significant effect sizes we do get from a study of this sample size are likely to be overestimates. +We can visualize this using `plot`: -```{r poweranalysis-list, fig.height=5} -plot(pl, power=0.8, param="elev") +```{r pa50, fig.cap=""} +plot(pa50) ``` -# A more realistic example: Acadian Flycatchers - -## Introduction - -Normally it is crucial to conduct a power analysis before designing the study or collecting data. -For this example, however, we will demonstrate a more complicated power analysis for a dataset that has already been collected. -The real data (not shown here) are observations of Acadian Flycatchers (ACFL; *Empidonax virescens*) at 50 locations in two habitats over 17 years (2005-2022). -We will assess our power to detect differences in ACFL abundance in between habitats, and our power to detect a trend over time. -We'll test power for three different sample sizes: 25 survey points, 50 survey points, and 100 survey points each sampled once per year for 15 years. +Note that the simulation replicates that were significant (red) tended to have much more negative estimated effect sizes than the truth. +If you conducted this study with only 50 sites and found a significant elevation effect, it's likely the estimate you obtain would be much stronger (i.e., larger absolute value) than the truth. +To read more about Type M and Type S errors, see @gelman2014. -## Simulation +## Compare power across several sample sizes -The main input for the `powerAnalysis` function is a fitted `unmarked` model with the desired sample sizes, covariates, and additional arguments included. -In typical situations, you won't have your real dataset collected yet, so you'll have to first generate a simulated dataset that is similar to what your final dataset will look like. -The `simulate` function in `unmarked` can do this for you. +Let's run a few more power analyses at sample sizes between 50 and 400. +Note it would probably better to create new `unmarkedFrame`s for each instead of sub-sampling the same one, but we'll skip this for brevity. -As a reminder the key arguments for `simulate` are `forms`, `coefs`, `design`, and `guide`. -The `forms` argument is a list of formulas, one per submodel. -The covariates named in the formulas will become the covariates included in the final simulated dataset. -We need three covariates associated with abundance (lambda): habitat type, year, and point ID (so that we can include point as a random effect). -For the other submodels we're not including covariates so they are just intercept-only formulas. - -```{r} -forms <- list(lambda = ~Habitat+Year+(1|Point), dist=~1, rem=~1) +```{r, message=FALSE} +pa100 <- powerAnalysis(umf[1:100,], model = occu, formula = ~1~elev, effects = ef) +pa200 <- powerAnalysis(umf[1:200,], model = occu, formula = ~1~elev, effects = ef) +pa300 <- powerAnalysis(umf[1:300,], model = occu, formula = ~1~elev, effects = ef) ``` -By default, the covariates we specify in the formulas will be generated randomly from standard normal distributions. -In many cases this is fine, but in our example we need to be more specific given our complex dataset structure. -We need to tell `unmarked` that `Habitat` should be a factor with two levels, and year should take on values 0 through 14 (since we want to have 15 years in the study). -In addition we need the covariates to be structured so that we have 15 rows for point 1 (years 0-14), 15 rows for point 2 (years 0-14) and so on, with each row getting the proper `Point` ID value. -Specifying all this information is the job of the `guide` argument. -We'll supply a custom function for each covariate to `guide`. - -First the function for `Point`, the covariate which identifies which survey point each row of the dataset belongs to. -If we have 10 points and we sample each point for 15 years, we'll need 150 total rows (10*15) in our dataset. -The first 15 rows will correspond to point 1, 16-30 for point 2, and so on. -The following function takes the total number of rows `n` as input, figures out how many points that corresponds to (`n/15`), creates a unique ID for each site, and repeats each ID 15 times. +We can combine all our power analyses into one `unmarkedPowerList` object: ```{r} -point_function <- function(n){ - stopifnot(n %% 15 == 0) - sites <- n/15 - factor(rep(1:sites, each=15)) -} -point_function(30) # example +pl <- unmarkedPowerList(pa50, pa100, pa200, pa300, pa400) ``` -Next, `Habitat`. -Since each point's `Habitat` value should stay same the same for all 15 years, we need to (1) sample a random `Habitat` value for each point out of two possible habitats, and (2) repeat this value 15 times for each point. -Given a dataset with a number of total rows `n`, the following function figures out how many unique points there should be (`n`/15), samples a habitat for each point, and repeats the value 15 times per point. +View a summary: ```{r} -hab_function <- function(n){ - stopifnot(n %% 15 == 0) - sites <- n/15 - hab <- sample(c("A","B"), sites, replace=TRUE) - factor(rep(hab, each=15)) -} -hab_function(30) # example +pl ``` -Finally, `Year`. -This function works similarly to the two above, except that for each unique point, it assigns year values from 0-14. +Plot the power curve: -```{r} -yr_function <- function(n){ - stopifnot(n %% 15 == 0) - sites <- n/15 - rep(0:14, sites) # 15 years of surveys -} -yr_function(30) # example +```{r pl, fig.cap=""} +plot(pl, power = 0.8) ``` -These functions are combined together in a named list of lists to supply to `guide`. - -```{r} -guide <- list(Point = list(dist=point_function), - Year = list(dist=yr_function), - Habitat = list(dist=hab_function)) -``` +A sample size of 300 would be adequate to get to our target power of 0.8 -Next, the sample sizes with `design`. -We'll first simulate a dataset with 25 unique points, so we'll need 25*15 site-years since each point is sampled 15 times. -To match the real dataset we'll specify 2 distance bins and 3 removal periods. +We could also vary the number of occasions: -```{r} -design <- list(M = 25*15, Jdist=2, Jrem=3) +```{r, message=FALSE} +pa50_2 <- powerAnalysis(umf[1:50,1:2], model = occu, formula = ~1~elev, effects = ef) +pa100_2 <- powerAnalysis(umf[1:100,1:2], model = occu, formula = ~1~elev, effects = ef) +pa200_2 <- powerAnalysis(umf[1:200,1:2], model = occu, formula = ~1~elev, effects = ef) +pa300_2 <- powerAnalysis(umf[1:300,1:2], model = occu, formula = ~1~elev, effects = ef) +pa400_2 <- powerAnalysis(umf[,1:2], model = occu, formula = ~1~elev, effects = ef) ``` -Since this dataset will have distance bin data in it, we also want to specify how the distance bins will look. -We want two bins, with breaks at 0, 25 m, and 50 m. - ```{r} -db <- c(0,25,50) +pl2 <- unmarkedPowerList(pa50, pa100, pa200, pa300, pa400, + pa50_2, pa100_2, pa200_2, pa300_2, pa400_2) ``` -Finally, we need to provide the parameter values used to actually simulate the response (`y`) according to our specifications (e.g., the intercepts and slopes). -These are provided as a list of vectors to the `coefs` argument. -At this point, we don't actually care what these values are. -We just want to simulate a dataset with the correct structure and covariate values (to use as a template), we don't care what the values in the output `y` matrix actually are since they will be discarded later. -Therefore, we'll just set most parameter values to 0. -However we need to set the distance function intercept to something slightly more realistic - e.g. the log of the median value of the distance breaks. - -```{r} -coefs_temp <- list(lambda = c(intercept=0, HabitatB=0, Year=0, Point=0), - dist = c(intercept=log(median(db))), rem=c(intercept=0)) +```{r pl2, fig.cap=""} +plot(pl2, power = 0.8) ``` -We're finally ready to simulate the template dataset with all the pieces created above. -We also need to add a bit more information - our units should be in meters, and we want the output on the abundance scale. - -```{r} -set.seed(1) -umf25 <- simulate("gdistremoval", formulas=forms, design=design, coefs=coefs_temp, - guide=guide, unitsIn='m', dist.breaks=db, output='abund') -head(umf25) -``` - -In the output you can see we have covariates for Habitat, Year, and Point which seem to be structured the way we want. -Remember we don't care what's actually *in* the `y` matrix, we just want it to be the right size. -We can double check that the number of rows in the dataset is correct - it should be 25*15 = 375. - -```{r} -numSites(umf25) -``` - -## Creating the template model - -The final step is to fit the correct model to the dataset. -Again, we don't care at all about the *results* of this model, we just want to make sure all the relevant information and arguments are included so that `powerAnalysis` is working with the right information about our proposed study. - -```{r} -mod25 <- gdistremoval(lambdaformula=~Habitat+Year+(1|Point), distanceformula=~1, - removalformula=~1, data=umf25, output='abund') -``` - -## Running the power analysis - -With the template model for a 25 point study design in hand, we can now move on to the actual power analysis. -In addition to the template model, we now need to tell `unmarked` what the "true" values of the parameters in the model are. -These are essentially the effect sizes we want to test our ability to identify given our study design. -This is a step where you have to use your expert knowledge to make some guesses about the true state of the system you are studying. - -Below are coefficients which describe a system where abundance in Habitat A is roughly 5, Habitat B is roughly 6, abundance declines about 2% per year, and the random variance among points is relatively small (0.1). -Furthermore, the value of the detection function parameter $\sigma$ is equal to the median of the distance breaks (25), and the removal probability of detection is about 0.27. -These are roughly based on our knowledge of the real study system. - -```{r} -coefs <- list(lambda = c(intercept=log(5), HabitatB=0.18, - # 2% decline in abundance per year - Year=log(0.98), - # standard deviation on point random effect - Point=0.1), - # detection sigma = median distance - dist = c(intercept=log(median(db))), - # removal p = ~0.27 - rem = c(intercept=-1)) -``` - -By specifying the `coefs` this way, we will be testing our power to detect that Habitat B has significantly greater abundance than Habitat A, given that the true difference between Habitat B and A is 0.2 units (on the log scale) or 1 bird (on the real scale). -We are also testing our power to detect a significant declining trend in abundance, given that the "true" trend is a yearly decline of about 2%. - -Now, run the analysis. -We're using 50 simulations for speed but you should typically use more. - -```{r} -(pa25 <- powerAnalysis(mod25, coefs=coefs, nsim=100)) -``` - -In this case we only care about the `HabitatB` and `Year` rows in the output table, we're ignoring the intercepts. -We found we have weak power (<0.5) to detect both effects with this sample size. - -To test the other two sample sizes (50 and 100 sites x 15 years), we just simulate new datasets and repeat the process. -We only need to change the `design` argument to simulate. - -```{r} -umf50 <- simulate("gdistremoval", formulas=forms, - design=list(M = 50*15, Jdist=2, Jrem=3), # change here - coefs=coefs_temp, - guide=guide, unitsIn='m', dist.breaks=db, output='abund') -mod50 <- gdistremoval(lambdaformula=~Habitat+Year+(1|Point), distanceformula=~1, - removalformula=~1, data=umf50, output='abund') -pa50 <- powerAnalysis(mod50, coefs=coefs, nsim=100) - -umf100 <- simulate("gdistremoval", formulas=forms, - design=list(M = 100*15, Jdist=2, Jrem=3), # change here - coefs=coefs_temp, - guide=guide, unitsIn='m', dist.breaks=db, output='abund') -mod100 <- gdistremoval(lambdaformula=~Habitat+Year+(1|Point), distanceformula=~1, - removalformula=~1, data=umf100, output='abund') -pa100 <- powerAnalysis(mod100, coefs=coefs, nsim=100) -``` - -## Examining the results - -In addition to looking at the summary table outputs of `pa25`, `pa50`, and `pa100`, they can also be combined into an `unmarkedPowerList` for easier comparison. - -```{r} -(pl <- unmarkedPowerList(list(pa25, pa50, pa100))) -``` - -There's a default plotting method for `unmarkedPowerLists`. -You need to specify the parameter of interest, and you can optionally define a target power level to add to the plot: - -```{r poweranalysis-acfl} -plot(pl, par="HabitatB", power=0.8) -plot(pl, par="Year", power=0.8) -``` - -Note that the x-axis shows sites as the number of site-years (e.g., sites x years). -It looks like only the largest tested sample size (100 sites) has power > 0.8 to detect a significant effect of habitat type and year in the correct direction. - -# Shiny webapp - -`unmarked` now includes a [Shiny](https://shiny.posit.co/) webapp that can be used to conduct power analyses. -The Shiny app is launched with the `shinyPower()` function, which takes as a template model as an input argument (see above). -This function opens a window in your web browser. -Once the application is loaded, you can experiment with different settings and generate summaries and figures for the resulting power estimates. - -## Demonstration - -First, we simulate a template model for a single-species occupancy analysis, using the `simulate` function as described above. -We have one covariate of interest on occupancy (`elev`) and one on detection (`wind`). - -```{r} -umf <- simulate("occu", formulas=list(state=~elev, det=~wind), - coefs=list(state=c(intercept=0, elev=0.3), - det=c(intercept=0.4, wind=-0.2)), - design=list(M=100, J=5)) - -(mod <- occu(~wind~elev, umf)) -``` - -Next call the `shinyPower` function on our template model, which starts the Shiny app in your web browser. - -```{r,eval=FALSE} -shinyPower(mod) -``` - -A demo version of the app you can experiment with can be found [here](https://kenkellner.shinyapps.io/unmarked-power/). -The next section provides a more detailed tutorial for the app using screenshots. - -## Tutorial - -### Inputs - -The shaded vertical bar on the left is where we set the options for the analysis -At the top left you will see the name and type of the model you provided to `shinyPower`. - -![](figures/poweranalysis-modinfo.png) - -Next you can set the value for $\alpha$, and the number of simulations to run in each power analysis. -The default is 10, but you should usually set it to something higher. - -![](figures/poweranalysis-alpha.png) - -After that you can, if you wish, specify one or more sample size scenarios by manipulating the number of sites and number of observations. -If you set a number of sites/observations smaller than what was in the original template model dataset, the dataset will be subsampled; if larger, the new dataset(s) will be bootstrapped. -It's a good idea to simulate the template model with the largest sample size you want to test here to avoid the bootstrapping. - -![](figures/poweranalysis-scenarios.png) - -Next you must set the effect sizes you want to test in the power analysis. -Each submodel has its own section. -In this case state = occupancy and det = detection. -Effect sizes for all parameters in the model default to 0; you'll want to change them to reflect your expectations about the study system. -Here we are simulating datasets with an elevation effect of 0.4 (on the logit scale), with occupancy and detection intercepts equal to 0 (equivalent to probabilities of 0.5). - -![](figures/poweranalysis-effectsizes.png) - -You can also set the null hypotheses manually if you want by clicking on the "Null hypotheses" tab. -By default they are all set at 0. - -![](figures/poweranalysis-nulls.png) - -Finally, click the run button. -You should see one or more progress bars in the lower right of the application. - -![](figures/poweranalysis-run.png) - -### Outputs - -To the right of the input sidebar is a set of tabs showing output. -The "Summary" tab shows a table with estimates of power for each parameter under each scenario you specified earlier. -The "Plot" tab shows a plot of how power changes for a given parameter based on sample size (it will not be useful if you only have one sample size scenario). -Here's the first few lines of a summary table with three scenarios for number of sites (100, 75, 50) and two for number of observations (2, 5), testing for an `elev` effect size of 0.4: - -![](figures/poweranalysis-summarytable.png) - -And the corresponding summary figure for `elev`: - -![](figures/poweranalysis-summaryplot.png) +As you can see, reducing the number of replicate samples at each site also reduces power, but generally has less of an impact that number of sites. # Conclusion diff --git a/vignettes/unmarked.bib b/vignettes/unmarked.bib index 82148aa4..c96690f2 100644 --- a/vignettes/unmarked.bib +++ b/vignettes/unmarked.bib @@ -483,3 +483,13 @@ @misc{pautrel2023 copyright = {{\textcopyright} 2023, Posted by Cold Spring Harbor Laboratory. This pre-print is available under a Creative Commons License (Attribution 4.0 International), CC BY 4.0, as described at http://creativecommons.org/licenses/by/4.0/}, langid = {english}, } + +@article{gelman2014, + title={Beyond power calculations: Assessing type {S} (sign) and type {M} (magnitude) errors}, + author={Gelman, Andrew and Carlin, John}, + journal={Perspectives on Psychological Science}, + volume={9}, + number={6}, + pages={641--651}, + year={2014}, +} From 7babecce5ce342382e863719fa0a50b598e756c7 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Tue, 9 Jul 2024 15:48:42 -0400 Subject: [PATCH 12/15] Progress on new simulate tests --- R/simulate.R | 2 +- tests/testthat/test_simulate.R | 201 +++++++++++++++++++++++++++++++++ 2 files changed, 202 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test_simulate.R diff --git a/R/simulate.R b/R/simulate.R index fc10f16e..b3968ce6 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -127,7 +127,7 @@ generate_random_effects <- function(coefs, fit){ } if(!is.factor(lvldata)){ - stop("Random effect covariates must be specified as factors with guide argument", call.=FALSE) + stop("Random effect covariates must be specified as factors", call.=FALSE) } sigma <- old_coefs[signame] if(sigma <= 0){ diff --git a/tests/testthat/test_simulate.R b/tests/testthat/test_simulate.R new file mode 100644 index 00000000..e26f9aac --- /dev/null +++ b/tests/testthat/test_simulate.R @@ -0,0 +1,201 @@ +context("simulate method") +skip_on_cran() + +test_that("simulate can generate new datasets from scratch",{ + + set.seed(123) + + y <- matrix(NA, 300, 5) + sc <- data.frame(elev=rnorm(300)) + + umf <- unmarkedFrameOccu(y=y, siteCovs=sc) + + # When no coefficients list provided + nul <- capture_output(expect_error(simulate(umf, model=occu, formula=~1~elev))) + + cf <- list(state=c(0, -0.4), det=0) + + # When model not provided + expect_error(simulate(umf, formula=~1~elev, coefs=cf)) + + s <- expect_message(simulate(umf, model=occu, formula=~1~elev, coefs=cf)[[1]]) + + expect_equivalent(dim(s@y), c(300,5)) + expect_equal(names(s@siteCovs), "elev") + + fm <- occu(~1~elev, s) + expect_equivalent(coef(fm), c(-0.1361,-0.5984,-0.002639), tol=1e-4) + + # With random effect + set.seed(123) + umf@siteCovs$group <- factor(sample(letters[1:20], 300, replace=TRUE)) + + cf2 <- list(state=c(0, -0.4, 1), det=0) + + s <- expect_message(simulate(umf, model=occu, formula=~1~elev+(1|group), coefs=cf2)[[1]]) + + fm <- occu(~1~elev+(1|group), s) + expect_equal(sigma(fm)$sigma, 1.04565, tol=1e-4) + + # pcount + set.seed(123) + temp <- unmarkedFramePCount(y=y, siteCovs=sc) + cf$alpha <- c(alpha=0.5) + s <- expect_message(simulate(temp, formula=~1~elev, K=10, mixture="NB", coefs=cf)[[1]]) + + fm2 <- pcount(~1~elev, s, mixture="NB", K=10) + expect_equivalent(coef(fm2), c(-0.0843,-0.3777,-0.0505,0.666), tol=1e-3) + + # distsamp + set.seed(123) + cf$alpha <- NULL + cf$det[1] <- log(30) + cf$state <- c(intercept=2, elev=0.5) + temp <- unmarkedFrameDS(y=y, siteCovs=sc, dist.breaks=c(0,10,20,30,40,50), survey='point', unitsIn='m') + s <- expect_message(simulate(temp, formula=~1~elev, coefs=cf)[[1]]) + fm <- distsamp(~1~elev, s) + expect_equivalent(coef(fm), c(1.9734, 0.5283, 3.403), tol=1e-4) + + # Mpois + set.seed(123) + cf$dist[1] <- 0 + cf$state <- c(intercept=1, elev=0.5) + cf$det <- 0 + temp <- unmarkedFrameMPois(y=y, siteCovs=sc, type='removal') + s <- expect_message(simulate(temp, formula=~1~elev, coefs=cf)[[1]]) + fm <- multinomPois(~1~elev, s) + expect_equivalent(coef(fm), c(0.975,0.513,0.112), tol=1e-3) + + #colext + set.seed(123) + cf_colext <- list(psi=c(intercept=0, elev=0.5), col=c(intercept=0), + ext=c(intercept=0), det=c(intercept=0)) + y_ce <- matrix(NA, 300, 15) + temp <- unmarkedMultFrame(y_ce, siteCovs=sc, numPrimary=3) + + s <- expect_message(simulate(temp, psiformula=~elev, coefs=cf_colext)[[1]]) + fm <- colext(~elev, ~1, ~1, ~1, s) + expect_equivalent(coef(fm), c(-0.132,0.381,0.0701,0.158,0.015), + tol=1e-3) + + #occuTTD + set.seed(123) + cf_ttd <- cf_colext + cf_ttd$det <- c(intercept=log(0.5)) + temp <- unmarkedFrameOccuTTD(y_ce, siteCovs=sc, numPrimary=3, surveyLength=3) + + s <- expect_message(simulate(temp, model=occuTTD, psiformula=~elev, coefs=cf_ttd)[[1]]) + fm <- occuTTD(~elev, ~1, ~1, ~1, s) + expect_equivalent(coef(fm), c(0.115,0.642,-0.065,-0.095,-0.693), + tol=1e-3) + + #gdistsamp + set.seed(123) + cf_gds <- list(det=c(intercept=log(30)), lambda=c(intercept=1, elev=0.5), + phi=c(intercept=0)) + + temp <- unmarkedFrameGDS(y_ce, siteCovs=sc, numPrimary=3, dist.breaks=c(0,10,20,30,40,50), survey='line', + tlength=rep(100,300), unitsIn='m') + + s <- expect_message(simulate(temp, lambdaformula=~elev, phiformula=~1, pformula=~1, coefs=cf_gds)[[1]]) + fm <- gdistsamp(~elev, ~1, ~1, data=s, K=15) + expect_equivalent(coef(fm), c(0.999, 0.451, -0.010, 3.37), + tol=1e-3) + + #gmultmix + set.seed(123) + cf_gmm <- list(det=c(0), lambda=c(intercept=1, elev=0.5), + phi=c(intercept=0)) + temp <- unmarkedFrameGMM(y_ce, siteCovs=sc, numPrimary=3, type='removal') + s <- expect_message(simulate(temp, lambdaformula=~elev, phiformula=~1, pformula=~1, coefs=cf_gmm, K=15)[[1]]) + fm <- gmultmix(~elev, ~1, ~1, data=s, K=15) + expect_equivalent(coef(fm), c(1.0025,0.4762,0.022,-0.04318), + tol=1e-3) + + #gpcount + set.seed(123) + cf_gmm$lambda <- c(0.5, 0.5) + temp <- unmarkedFrameGPC(y_ce, siteCovs=sc, numPrimary=3) + s <- expect_message(simulate(temp, lambdaformula=~elev, phiformula=~1, pformula=~1, coefs=cf_gmm, K=10)[[1]]) + fm <- gpcount(~elev, ~1, ~1, data=s, K=10) + expect_equivalent(coef(fm), c(0.428,0.525,0.0885,-0.040), + tol=1e-3) + + #pcountOpen + set.seed(123) + cf_pco <- list(lambda=c(intercept=2, elev=0.5), det=c(intercept=0), + gamma=c(intercept=0), omega=c(intercept=0)) + y_pco <- matrix(NA, 100, 15) + temp <- unmarkedFramePCO(y_pco, siteCovs=data.frame(elev=rnorm(100)), numPrimary=3) + + s <- expect_message(simulate(temp, lambdaformula=~elev, gammaformula=~1, + omegaformula=~1, pformula=~1, coefs=cf_pco, K=30)[[1]]) + + fm <- pcountOpen(~elev, ~1, ~1, ~1, data=s, K=30) + expect_equivalent(coef(fm), c(1.9802,0.4691,-0.0366,-0.0054,0.0323), tol=1e-4) + + #multmixOpen + set.seed(123) + umf12 <- simulate("multmixOpen", formulas=forms_pco, design=design_pco, + coefs=cf_pco, K=15, type='removal') + expect_is(umf12, "unmarkedFrameMMO") + #fm <- multmixOpen(~elev,~1,~1,~1, data=umf12, K=15) + #expect_equivalent(coef(fm), c(1.8128,0.0171,-0.4220,0.1921,-0.1122),tol=1e-4) + + #distsampOpen + set.seed(123) + cf_dso <- cf_pco + cf_pco$det <- c(intercept=log(30)) + design_dso <- list(M=200, J=5, T=5) + umf13 <- simulate("distsampOpen", formulas=forms_pco, design=design_dso, + coefs=cf_dso, K=20, unitsIn='m', + survey='point', dist.breaks=c(0,10,20,30,40,50)) + expect_is(umf13, "unmarkedFrameDSO") + #fm <- distsampOpen(~elev,~1,~1,~1, data=umf13, K=20) + #expect_equivalent(coef(fm), c(1.70195,0.00067,-0.1141,0.09816,3.4179), tol=1e-4) + + # occuMulti + set.seed(123) + occFormulas <- c('~occ_cov1','~occ_cov2','~occ_cov3','~1','~1','~1','~1') + detFormulas <- c('~1','~1','~1') + beta <- c(0.5,0.2,0.4,0.5,-0.1,-0.3,0.2,0.1,-1,0.1) + p_true <- c(0.6,0.7,0.5) + + cf <- list(state=beta, det=log(p_true/(1-p_true))) + names(cf$state) <- c("[sp1] intercept", "[sp1] occ_cov1", + "[sp2] intercept", "[sp2] occ_cov2", + "[sp3] intercept", "[sp3] occ_cov3", + "[sp1:sp2] intercept","[sp1:sp3] intercept", + "[sp2:sp3] intercept","[sp1:sp2:sp3] intercept") + names(cf$det) <- c("[sp1] intercept", "[sp2] intercept", "[sp3] intercept") + + umf14 <- simulate("occuMulti", formulas=list(state=occFormulas, det=detFormulas), + design=list(M=200, J=5), coefs=cf) + fm <- occuMulti(detFormulas, occFormulas, umf14) + expect_equivalent(coef(fm, 'det'), c(0.3650,0.8762,-0.04653), tol=1e-4) + + # occuMS + set.seed(123) + bstate <- c(-0.5, 1, -0.6, -0.7) + bdet <- c(-0.4, 0, -1.09, -0.84) + detformulas <- c('~V1','~1','~1') + stateformulas <- c('~V1','~V2') + forms <- list(det=detformulas, state=stateformulas) + cf <- list(state=bstate, det=bdet) + expect_warning(umf15 <- simulate("occuMS", formulas=forms, coefs=cf, design=list(M=500, J=5, T=1))) + fm <- occuMS(forms$det, forms$state, data=umf15, parameterization="multinomial") + expect_equivalent(coef(fm, 'state'), c(-0.657,1.033,-0.633,-0.582), tol=1e-3) + + # gdistremoval + set.seed(123) + formulas <- list(lambda=~sc1, rem=~oc1, dist=~1, phi=~1) + cf <- list(lambda=c(intercept=log(5), sc1=0.7), dist=c(intercept=log(50)), + rem=c(intercept=log(0.2/(1-0.2)), oc1=0.4)) + design <- list(M=500, Jdist=4, Jrem=5, T=1) + umf16 <- simulate("gdistremoval", design=design, formulas=formulas, coefs=cf, + dist.breaks=c(0,25,50,75,100), unitsIn='m', output='abund',K=15) + fm <- gdistremoval(~sc1, removalformula=~oc1, distanceformula=~1, + data=umf16,K=15) + expect_is(fm, "unmarkedFitGDS") + +}) From 1b81b0c4679f6e0e5ed6c210d6983c5b5f3a39de Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Tue, 9 Jul 2024 16:10:24 -0400 Subject: [PATCH 13/15] Finish simulate tests --- tests/testthat/test_simulate.R | 69 +++++++++++++++++----------------- 1 file changed, 34 insertions(+), 35 deletions(-) diff --git a/tests/testthat/test_simulate.R b/tests/testthat/test_simulate.R index e26f9aac..0a3a6071 100644 --- a/tests/testthat/test_simulate.R +++ b/tests/testthat/test_simulate.R @@ -136,23 +136,20 @@ test_that("simulate can generate new datasets from scratch",{ #multmixOpen set.seed(123) - umf12 <- simulate("multmixOpen", formulas=forms_pco, design=design_pco, - coefs=cf_pco, K=15, type='removal') - expect_is(umf12, "unmarkedFrameMMO") - #fm <- multmixOpen(~elev,~1,~1,~1, data=umf12, K=15) - #expect_equivalent(coef(fm), c(1.8128,0.0171,-0.4220,0.1921,-0.1122),tol=1e-4) + temp <- unmarkedFrameMMO(y_pco, siteCovs=data.frame(elev=rnorm(100)), numPrimary=3, type='removal') + s <- expect_message(simulate(temp, lambdaformula=~elev, gammaformula=~1, + omegaformula=~1, pformula=~1, coefs=cf_pco, K=15)[[1]]) + expect_is(s, "unmarkedFrameMMO") #distsampOpen set.seed(123) cf_dso <- cf_pco - cf_pco$det <- c(intercept=log(30)) - design_dso <- list(M=200, J=5, T=5) - umf13 <- simulate("distsampOpen", formulas=forms_pco, design=design_dso, - coefs=cf_dso, K=20, unitsIn='m', - survey='point', dist.breaks=c(0,10,20,30,40,50)) - expect_is(umf13, "unmarkedFrameDSO") - #fm <- distsampOpen(~elev,~1,~1,~1, data=umf13, K=20) - #expect_equivalent(coef(fm), c(1.70195,0.00067,-0.1141,0.09816,3.4179), tol=1e-4) + cf_dso$det <- c(intercept=log(30)) + temp <- unmarkedFrameDSO(y_pco, siteCovs=data.frame(elev=rnorm(100)), numPrimary=3, + dist.breaks=c(0,10,20,30,40,50),unitsIn='m', survey='point') + s <- expect_message(simulate(temp, lambdaformula=~elev, gammaformula=~1, + omegaformula=~1, pformula=~1, coefs=cf_dso, K=15)[[1]]) + expect_is(s, "unmarkedFrameDSO") # occuMulti set.seed(123) @@ -160,19 +157,13 @@ test_that("simulate can generate new datasets from scratch",{ detFormulas <- c('~1','~1','~1') beta <- c(0.5,0.2,0.4,0.5,-0.1,-0.3,0.2,0.1,-1,0.1) p_true <- c(0.6,0.7,0.5) - cf <- list(state=beta, det=log(p_true/(1-p_true))) - names(cf$state) <- c("[sp1] intercept", "[sp1] occ_cov1", - "[sp2] intercept", "[sp2] occ_cov2", - "[sp3] intercept", "[sp3] occ_cov3", - "[sp1:sp2] intercept","[sp1:sp3] intercept", - "[sp2:sp3] intercept","[sp1:sp2:sp3] intercept") - names(cf$det) <- c("[sp1] intercept", "[sp2] intercept", "[sp3] intercept") - - umf14 <- simulate("occuMulti", formulas=list(state=occFormulas, det=detFormulas), - design=list(M=200, J=5), coefs=cf) - fm <- occuMulti(detFormulas, occFormulas, umf14) - expect_equivalent(coef(fm, 'det'), c(0.3650,0.8762,-0.04653), tol=1e-4) + sc <- data.frame(occ_cov1=rnorm(300), occ_cov2=rnorm(300), occ_cov3=rnorm(300)) + temp <- unmarkedFrameOccuMulti(list(sp1=y, sp2=y, sp3=y), siteCovs=sc) + s <- expect_message(simulate(temp, stateformulas=occFormulas, detformulas=detFormulas, + coefs=cf)[[1]]) + fm <- occuMulti(stateformulas=occFormulas, detformulas=detFormulas, s) + expect_equivalent(coef(fm, 'det'), c(0.2982,0.8416,-0.01816), tol=1e-4) # occuMS set.seed(123) @@ -180,22 +171,30 @@ test_that("simulate can generate new datasets from scratch",{ bdet <- c(-0.4, 0, -1.09, -0.84) detformulas <- c('~V1','~1','~1') stateformulas <- c('~V1','~V2') - forms <- list(det=detformulas, state=stateformulas) cf <- list(state=bstate, det=bdet) - expect_warning(umf15 <- simulate("occuMS", formulas=forms, coefs=cf, design=list(M=500, J=5, T=1))) - fm <- occuMS(forms$det, forms$state, data=umf15, parameterization="multinomial") - expect_equivalent(coef(fm, 'state'), c(-0.657,1.033,-0.633,-0.582), tol=1e-3) + sc <- data.frame(V1=rnorm(300), V2=rnorm(300)) + y_ms <- y ## FIX THIS + y_ms[] <- 2 + temp <- unmarkedFrameOccuMS(y_ms, siteCovs=sc) + s <- expect_message(simulate(temp, psiformulas=stateformulas, detformulas=detformulas, + coefs=cf)[[1]]) + fm <- occuMS(detformulas, stateformulas, data=s, parameterization="multinomial") + expect_equivalent(coef(fm, 'state'), c(-0.3121,0.8289,-0.4710,-0.8786), tol=1e-3) # gdistremoval set.seed(123) - formulas <- list(lambda=~sc1, rem=~oc1, dist=~1, phi=~1) cf <- list(lambda=c(intercept=log(5), sc1=0.7), dist=c(intercept=log(50)), rem=c(intercept=log(0.2/(1-0.2)), oc1=0.4)) - design <- list(M=500, Jdist=4, Jrem=5, T=1) - umf16 <- simulate("gdistremoval", design=design, formulas=formulas, coefs=cf, - dist.breaks=c(0,25,50,75,100), unitsIn='m', output='abund',K=15) - fm <- gdistremoval(~sc1, removalformula=~oc1, distanceformula=~1, - data=umf16,K=15) + sc <- data.frame(sc1=rnorm(200)) + oc <- data.frame(oc1=rnorm(200*5)) + temp <- unmarkedFrameGDR(yDistance=matrix(NA, 200, 4), yRemoval=matrix(NA, 200, 5), + siteCovs=sc, obsCovs=oc, dist.breaks=c(0,25,50,75,100), + unitsIn='m') + s <- expect_message(simulate(temp, lambdaformula=~sc1, removalformula=~oc1, distanceformula=~1, + output='abund', coefs=cf)[[1]]) + + fm <- gdistremoval(lambdaformula=~sc1, removalformula=~oc1, distanceformula=~1, + output='abund', K=50, data=s) expect_is(fm, "unmarkedFitGDS") }) From d85700d5d0dd91cd0894e291e26526210d43b53d Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Tue, 9 Jul 2024 16:25:49 -0400 Subject: [PATCH 14/15] Fix file load order --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ea033057..ea656d03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,11 +57,11 @@ Collate: 'classes.R' 'unmarkedEstimate.R' 'mapInfo.R' 'unmarkedFrame.R' 'plotEffects.R' 'mixedModelTools.R' 'power.R' - 'simulate.R' 'deprecated_sim_power.R' 'predict.R' 'goccu.R' 'occuCOP.R' + 'simulate.R' 'RcppExports.R' 'zzz.R' LinkingTo: From 5dd3fb7dbaae75692040d81542dcbbc96a54aa54 Mon Sep 17 00:00:00 2001 From: Ken Kellner Date: Wed, 10 Jul 2024 08:50:02 -0400 Subject: [PATCH 15/15] Add power analysis tests --- DESCRIPTION | 4 +- R/power.R | 1 - tests/testthat/test_powerAnalysis.R | 81 +++++++++++++++++++++++++++++ 3 files changed, 83 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test_powerAnalysis.R diff --git a/DESCRIPTION b/DESCRIPTION index ea656d03..57dba16c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: unmarked -Version: 1.4.1.9004 -Date: 2024-07-09 +Version: 1.4.1.9005 +Date: 2024-07-10 Type: Package Title: Models for Data from Unmarked Animals Authors@R: c( diff --git a/R/power.R b/R/power.R index 0c55c1f5..58594c8a 100644 --- a/R/power.R +++ b/R/power.R @@ -51,7 +51,6 @@ powerAnalysis_internal <- function(object, model, data_sims, fun <- get_fitting_function(object, model) test_fit <- get_fit(data_sims[[1]], model, ...) modname <- test_fit@fitType - modname <- "test" if(is.null(nulls)){ nulls <- effects diff --git a/tests/testthat/test_powerAnalysis.R b/tests/testthat/test_powerAnalysis.R new file mode 100644 index 00000000..0c5a5228 --- /dev/null +++ b/tests/testthat/test_powerAnalysis.R @@ -0,0 +1,81 @@ +context("powerAnalysis method") +skip_on_cran() + +temp <- unmarkedFrameOccu(y=matrix(NA, 300, 8), + siteCovs=data.frame(elev=rnorm(300), + group=factor(sample(letters[1:20], 300, replace=TRUE)))) + +test_that("powerAnalysis method works",{ + + # When no effect sizes provided + nul <- capture.output(expect_error(powerAnalysis(temp, model=occu, formula=~1~elev))) + + ef <- list(state=c(intercept=0, elev=-0.4), det=c(intercept=0)) + + nul <- capture_output({ + + set.seed(123) + pa <- powerAnalysis(temp, model=occu, formula=~1~elev, effects=ef, nsim=10) + expect_is(pa, "unmarkedPower") + s <- summary(pa)$Power + expect_true(s>0.5) + + # output printout + out <- capture.output(pa) + expect_equal(out[7], "Power Statistics:") + + # set null + set.seed(123) + nul <- list(state=c(intercept=5, elev=0), det=c(intercept=0)) + pa2 <- powerAnalysis(temp, model=occu, formula=~1~elev, effects=ef, nulls=nul, nsim=10) + s <- summary(pa2, showIntercepts=TRUE) + expect_equivalent(s$Null, c(5,0,0)) + + # list + pl <- unmarkedPowerList(pa, pa2) + expect_is(pl, "unmarkedPowerList") + s <- summary(pl) + expect_is(s, "data.frame") + + pdf(NULL) + pl_plot <- plot(pl) + expect_is(pl_plot,"list") + dev.off() + + # With random effect + set.seed(123) + ef <- list(state=c(0, -0.4, 1), det=0) + pa3 <- powerAnalysis(temp, model=occu, formula=~1~elev+(1|group), effects=ef, nsim=10) + s <- summary(pa3, showIntercepts=TRUE) + expect_equal(nrow(s), 3) + + # Only one random effect allowed + expect_error(powerAnalysis(temp, model=occu, formula=~1~elev+(elev||group), effects=ef, nsim=10)) + }) +}) + +test_that("custom datasets can be passed to powerAnalysis",{ + set.seed(123) + ef <- list(state=c(0, -0.4), det=0) + s <- simulate(temp, model=occu, formula=~1~elev, nsim=10, coefs=ef, quiet=TRUE) + + nul <- capture_output({ + pa <- powerAnalysis(s, model=occu, formula=~1~elev, effects=ef) + expect_is(pa, "unmarkedPower") + expect_equal(length(pa@estimates), length(s)) + }) +}) + +test_that("powerAnalysis can be run in parallel",{ + skip_on_cran() + skip_on_ci() + + set.seed(123) + ef <- list(state=c(0, -0.4), det=0) + + nul <- capture_output({ + pa <- powerAnalysis(temp, model=occu, formula=~1~elev, effects=ef, parallel=TRUE, nsim=2) + expect_is(pa, "unmarkedPower") + expect_equal(length(pa@estimates), 2) + }) +})

)rIcbuG={? zy?9UL@FUPx>0Qazy!^E$>!iGg`hEGBhX=ndImI;Ad<*28!gqUE-*DA?sm4|DrBXw) z^}}Z>C+)w+otPt6aejGgF|KB`MwBhfobB{)8ZFcZ(jRVio#9m6@W8fL(!Vge=EAyL zMIV2dIqmFO_Ts`XA1{%gl+WUB&$=u;;B|-TJgi1n9>r0m59%TPdzo($fzzK zd4;&Yf81!Kug8t*pBG$QXe}VO!o&WCFWvpxhhV=-!TBSLZ)fcP4Br3h0Snby>1k=- zGBQ2{1k7)^-`wYBVqz+DSbCFYn(C(QKfUxKH!6w@8wbbM&hEQH1#FcaOe- z0sGSEGMu#Lyxg0n`BIZdyYEL!?4qpWBEeCCFZEma4dtL*~k^=0F$KK)+68=F!hR3M2)+ny@ zp@Z&j#rd{q83zZ>{{DUh1+R@awb#jKI=QgLii(&RivA2$2`4A+O1FKZvy;QY!9h0b zalt!x?ko=FGawe)WA%sf3^TN=;|Q6Q+3aQ?Da7(iNlRabty&}4eG(FA5I@t?{r&x? z4z^}`dwVB0Hab>^@^cFd4Y#K242+Gt& z{~RmeY&X|T=(@LD*BZ$|%BF)r5VL5|@bgDOpe!scuj1j&Z8cD1k!fx0^{HrYo$gO0 zDyMJl?99{=YuDD*UGnzzz38+$D5k4>J1Z+oaDUVumxA}%g5y1Y9-q~&w$|1NAvbQf z{dGDX9+i!jKnM(Kb%8XX`1m-5h^NMJX;RYN3z(R>1qBy%dQ#*C z4<>z1RkyE9@PSq>veT?l9G~$&4KDOLT6`ZI2Uq0 z(im~DRy^_O(IcI%?@|@}<8Cnm&L0mBTo7MELi_^)rqfd6^yZpFKajA$nQIB(S;?-x zkYhLZ*cG+flxNry!SBe(&d#n;<{&##|MlxF*i*I0f|Q$^n_08$>+-VM_V)I{Y{=6H zHr)$e=f@LUTU%2z!6GSDRazS>8V<~t%a?^sI%zIkxbQw8p!+y4Jf`7N1#mt}HL}I<1n>%6#lq7^wF0x{OD5QB+hEA>nszZt}O!3uWc)G3N<( z=XDKtclXWBO&USLnBLwOc6N4F!|#TN)wEof=wf1H3wJCn8pbQ#A_b8TfB*jNu+ksY zK;Dbf~rU$?;C-H;JJVTUt6gy4i&VCD>3@)Z3}T&rc@gaCfQ44+4sf zjr}7%eWvPoz2~F7o!y_`zh75W2(G353W9W78ZJynP0Y{F56AC7oVQz8hpIdTIycKw ze*R>9!AKYu7Ut{go1<5UeHovsH9^dWgv$(KN;Eq^uc)rx(w!_9&7A)I`>DH` zkM`Hckf(bCSFc?&+MN82OZre!3oBXlGG19=AWjIqyk5;ayo#-Q^5RnqN5?%%)`fbT zbKAr9_4OED+c&GL7VoZ64&U|m60FTkPp=sqJP7lvl9rb4?dx0Wy=>y5eH6oIf92Y> zs-=U?O&cn&6Wi&TnW0j9hTPoTic{2x!^SwJ_sewUvF)}BCgltoI=Z(T)#q_s=KYhC zlfS;u$<02|>n@FuP-Roj-pWA8moMT_jw3~ui7MGz zt#Lxp@D^R!+9Dq*_})}j3ITS+h#IeR1~h9PpgdowgNba$~U zv27r6agblqnH*{cmxRrm!?+!xqo?=hHiY5n{6f6fd<$!JZCBT4z?Y}wvwZgR1UGNi1Q0SsjcS?Sx^d%=infOo63GYH zR%|J8es&rOMKn@uotlu~tySr|b#}ZlGdp|nmw9$&eSfC+=2Ol+wIK6^$GEQBJ7_d4Sn$kuMCt9whV?f$vSG|QoBn}pFZ^{N*#kfx797jivGR*`RTs7-}%1RIggl_*pmph-`<%k5iD92 zkBY6vaK~`J`CQAD;rYs>l0`sG9b8#iiTXx#dtEBvn(LD%xO{wk6-UeIB;@2Lc5ew> z6AvVuzX|X;Y`7cn(Ery0@t-Pkara6F>{>N^oBz6-o10HHlXgN+k3YZA1t#CcnAy(% zk?j2Eu77FM%8MQ|^+A9P&(zgNvU;#@TPdLaA!R!c>u!<-y~88t{uB}M2-f` zS~cHD7jB%~x#HiCSG$`m< z;?REqb8sp7zrwvwPEXqnFp0f)i*5QY6?i5WewBztqtSW7qajDPhD5-L86FOM>KGZ- z|9XwNG>}bQSXc=47w2`h6AydbQdd{MM#1}Qd#+_`ch{ghNfwelFp!uv&wPMI`UA=9 z#Kf5gsbi2JUZ*SCQ0@9qASI=xwu_y&(Z4IPoyp0|>+V^;K0Th$BQWE6yv75a4taLC z5XoVD4FRb=+r~373+)}@f<&557|v~M1pE76MfhE#{4+Kd3&g_2Pv~^FNAPeqBq=GW zGh4elT0vb+t@&tgg;c~-Fp%g$cah;A->a?BJi&{LCV>5!&ROHklWGXH$?&8IZHYW$R znpJNI0+N(EEiEmP>!k~W&^w^@*Gx>rLkqip;|BCjmB1b&W8;udpF|<e*T9RgKUW9mFV#_^Al$+ zEh^}>qh9By^6gzS)6-V`V?i}Q4t#@x@YIVeOt(u%M>YQZ`NL~B`~E*qZHi{D`><5p zz~C<6EiXU6-Ps8eni0^np7l0z{9-8Z=1;dJ7JE|hHOrmo7#RcL6frR|ydFoK0N_A6 zO;V{J8a&E3g#txx)e)-}nh{!8?hye!NrH9?EOB~qv2nI3WW*)(itR?%l5kmMBqCmS0YT3VkPKm0_+v@6)yci7lIK?j4El9iLI z>FWzkmJ6R=TWc$|U&zVLMMLXQ!Ryzr0qUlfmYP_rPsH8b1&LX;3>rV(X4a}8F*Y{# z$RxkLPTEZu0zQ;Vp6|bPr2Z8e{*7(*uZv>eXgz-}_UO?SAO+njZoX7>^z=6X#3#;B zJQ6%o1st*a=oT0e8M&1BK>UhO*ZoChWo4khxgN(T<)`)so4VrS;s={G_>NW@ZUOJ# z)7-u5>w|?)R(4;!fG<|S<_aEO-Oy0v+DNhe+Ax=v*Qq0#ZZ>|VMfW#owe0%!o2U_M zpw@g|XMza0Mac50nHdQqBl^#uKPRQ6=ouR~M6l~eKuH@J8LduK#~ZeUu|r;$Ijud` z(4Zjau}Uf{i~8~79&~weTU&N`v$?r&?fQuc>dB&=(R^e4XdY{NPR_5u9RMGex)QOn zE4HyA=)iUT0re3!Q-3ZU?QaA}N2`-(FQaVB_cmn!t1N~K{NXHS14~TV6>s9>spZ01 z=vY`j0>r7f{VdY?eZli&OXh4lyqXP)0(E9K%`)0oR{|W>&fcEScKRY5fR~r|nX+;{ z5Y0g#1;!n5bAhZ?h)K{ak}@(%ii+YcF1*I=F}l4!o&!6*PEIZdygmd;E#UM)KAKzC z)buK+!z?tPz_hgc7#J83k34uTP)W6zRO!UqJUromOAjAD+(e=1g@j_^)xx1nKxx$E z>Nj}5%SwdXTsJBtd15|bnFthVXUI5SS6BBpCcfaWw>ZRC@bMWK82qrPTo9t=T4rWu z=)wSqzleoZJfL#JGD$wGY@omY1|_9D)L4h`F*Cx{)bs5rfOfvXT+0ygC1AT)@nQ6sP2$st(26P$J6#aq=WjbYie1Kcb%*+T94kKJ`kG+>6Td|tv0}n(!J*$eOgN2VwLTsUe zYrDI@Ox5_^q^9nGvi{Q{a*mrY))UyCEdRz+-^&aLb>`731Z#6|&+=hA^ds|uEDSuA zee%Bk{tKK-@_pbF2xN!NM}Gd?^|Q#)=|QF+d3l?X;-87B*(yjxaYj)|wTDHBYE$2mIDXTmvLxkk-}`Vkcu zrvN++II+b@QBX+L5GX8SwYN zO;3NhP)#1X3Xn?Z$m~|5CDH9QgcsoGN#w(1S%GTc?MJA!!0_moM|jW@hJ8kiu1gM552)0H#-fGiv_ps(o*Kpmb=Pfz~=alVB@%~PKr zV1XTg5ZrF01x)`O6VnQUV6RebSA4)x08SC-fl|%Vs%!??6I58pMeV*R79z@XW&w=s z{dL;mrReuXDeo1Cih*sRD^6&i0y;aFgT1eb^R~=`zo!(>YQL2eJZ5nFFXj~O9c3yn zUp{~J>b+WKzl@tC4v0t~fW;@6G-<)Qg)gWjpqIJ6d`SqInglilw8GIHFVs+1@4!G} zmkB71hMu1Mq58Xf>=|Lp`j7b6x^QrCmc}auP$*PHM1&5!9l4S~T6T77RTY&|&$};# zL_}ui?!}*b8*J2+s3m}u00-jX;c0DaW9Q}$3;GcYwwS)29$JZk)NbRx`}d1rFIex`yXPe%M*OZ%vGc92 zV=Y^wt?kk<{mylHSr4*Cs(&zRyTvS-zP@Vv1DiXBhI4|u zo%bjxR&mGf+G5i6$)FZpyGyQ{avHu;S4Xd)qpKz@Q=Rs@pDDbSCzJj2ryj^Qpocp8 z`Za*t(R=%jtfjWJt_M?H4oiCS8X9-}@EM#Mh5UL`^#@WP6tqyC_B<5<+b3Kqkci!W z{t4ux?BmB~!BXUsuC6Igw01T*HKU^+{HUqkLI&{h9lo>D;!uqLs2N|BurE}mmPvpA zzCW5KOijJ^^TWDH|6~%}g?$S@56sI4Y&zagLv-iojeOsInbK-H>iTZTp zuzFNLScx^(-u`iN5)`Q3Jx0bm4;};q!Ek{oI9lI@h%DK7te#MM(0=)A@3&6KhwXp=Qa;q^uTsha*80Pl?m|i*=|isefaRf#=+t1S>>>* zrY5D7l+^6(?BvqYkVQprLyp?d;M+^RBK({c+8H@H1chpu+1&mkuoEvI-&o#;%P&!DBYuF)APrVWOK*Aul^%DQ!Gm5v z%40==INskt8w+TQ*kx14^X$+V*nm8+05pg9INB9URxCU%z9l~8Fq{Z3OD=N92yIZl zfB&nuKzAEVWFl6rC%`fa<25T?xd6CNjwjCRySs0AFZHDEfPau{*2lS?4bR%YD)_X5>68WXje%Y8BYW%fL;Sv+y?5%6=|)hITl+4r@*EMd3==J?>X4q zjO`5%wgXiQ^kBkcpAwi%-N*=ekaW!lQVs<4bYqAys0OfUnhtjsR3X-2*f499e6kuV z!yq7zz3=-8fxyv2e+xh?18Ns6tRF8JVbao#nozv*wg&_*07EUvr-A}bptL`-vW(V8 zOD|r&tf-~cKA5YIVdLavG~4(YZLcND1lxfJ45s11PW<`ktj+lFa1WtmfEh}hob!SiQpQQpvhuNL7;BUJ6P$g;^xqWT-;sJNbDjY zBMZpS=K$Aj0W86av!j*W)uE8jv@&^)E6Q+1`t={CU{WBRsca8=83AhI5ol8&K5+YY zXlZ5TD^0!E1LM3qO3kXsmQ)xiaCcmzlSd0E-3Q&Ur5cfWg{ zD6MO3EMsB8eEs@$`FRguwcM64E=$^iAqYJ;HxW>8fR;z{@`k_PT)K7ZRsru*uu!b5 zSh~8p3=9k=*Vg1+UHLbvj#;1*!Nm2`Z}^Cj1Fp>93au4}9~ivO>lB@xj$ERyuC5{H zJf7>)pj^P?zd=sk0`~{4WfpGq1k(DhfB-of_cr6tPq2WQl{v1|H-|FqoyAIyn1rOS zgMLNJ8dB1x{0?CpQP4n87Di29=n#UaL49WJsu*CoN+3<4LeVib@6Y%Rt}eJZ@4zBi z6NE9%V38&HN`K}IxM8a!#rVMf0nr=4u8V|G(cIkJU3&T=*Ekjy7D*|otu7gAcFSQ- zkdT9g=ET{RD6*%5TNe>v=k+^@cMX9qz`zqzN$-Qh=viA&++D1%ujg6A&;FdA&IF0d z0M-o5Wz15`UH2HlpA%13+ycDGh56Kcdu;kSE8VbU^u|y7WFne+d9M+<|)ITJ>+f%Z{N{gPH4JpW?+yMt0K44 z3S*6zBm4po(95_azd#?Lbqx&K(4xU&ydo07R8d8x0kYjnAeh{(uF}?n3l;1VaC`gDtrIse=noDKI#ZugXJlj?0HuriFz|AQUqMz@EU^n=10w@& zlUx&g*J}Ua5@TWedEADNl(gWbL`0APXM2|32T=#~@qqO+P~gciYnL{v93v!&Z!##b>HfJ08qUh?-a)&-#%8b5 zQ@}DYJG+NfRaM}?bY`j-D|hTPF~kEBz0Ei7KwEYqXIuChnwl6cv!7+q$Km6P1czbS zt#C1@xVRW~tD&O};KZX`B)6;c<=z$zLd9>SEhp<2t&{wddL4diqx^j<1Bng9-^1zi% z6>^0U0boMI_&C+gn>Qh!4D`(y_V)Hb5SpLgOU}u8cDzs?1nYaEj!3>JpoySfj> zH8N$n742pHSCo#Y6VE}{72a~teMOmj+0LB-Ml22L&P&UE)7+84fpP=zUz5lG!q+97 zg??t8#e>pNVPVo1gU5q>k|-y+8TAG~qm%fsp#3M~U}qfB~Ra+&^sVY`bwTXS!z^ zE`(OU;7Bph(On`ZC$A5t?nn$49;OQ9eoxNx9n_h8I7@$R9i1I$5Wi9TM;`o69>e10 zt6eZoQv!z%J%@(|br-ZPs6*7N06yRSXcred0h^so`awa2??=Yoadt5TN>Om z#c`cTOz$%TPVlPC;XV}=71%52L}SLxzI!uHD#1JgYUmxG6gmeV2QwVH#u zV*F*wLSaj(4Yyrj)iCv28Y#|pipb7ph3-Sc_n z9R1I89{K!yp2yE|j$&eB!iyl>hBDk85F(ohh#*S@M35x{BFGW}5oC#g2(m;#1X&^= zf-DgbL6!)JAWH;9kR<{l$Pxh&WJz-=c8)e-8tTC&mCRRvggc;dbzn$0qDrXA{82F<9#6W$2&7Bvm1Xl?XOp=SF;s5oC#g2(m;# z1X&^=f-DgbL6!)JAWH;9kTs`!F?ZtGcM3V%qxIXSiFHwtX=nH9Yh-Ju=er9bb>@ne zSKiI$ov(Zp?yf9|c@GG{+7dHQRSy8*^(q*!#qf(W+3Y=T(hlOC+e=z|BwD$u1rHw{`N5UJb9G%Vby8AO|m{(mtZ5 zGTY8iHuMAxm&XgQHe_+UJsF!LifrvPPgf7{aIpn|oo|=09tzr}a$BdG-`z!eQ=Py&4 zGk&uVZF=m}QIuy)vUhDCSxHVTlM;Wtl){q_4BhH$fVxN!mPzW+cnp7NOk-o28Kok) zPto-;6&L#xd2MSKbvs*V8i?o5%_#wEkG1MK)Re+^AMWFKJKCtq9b@nDd}iDVU(Flu zWw7&sK@L9I$`{IS@Z%Htcs}mR_x@HuR+5w7KHkoYo4RT2PvGswv{}cgDYA0r%B}g; zx!xq=BsY~gc8+{x;P5{U{BT_#zxh%p({2SnJDokNjbQ7-WkIeWbxkSMHTj>+qLe9q zx%yhrZP*-9?5Y|BKpW>`dA^NddrZLEEbTNeZ0g~mf-wNL-#5bVFQ#Fclt@jS0iZh1 z<{S1lmfqm?vzbgzM-dzCVf(TXHkO&u#<>8f%Cj*vKKocT#a0e{kcQotnOq2(~U<7JQNl3Wmp{d7(a!U!Tw7*_Hi4wV_wL zNc?#C0f>=qKW|xeAwn?fs&c!vW%5R%}I?6Xm?Hq}_^)T1qW z(h_HQwA{p_b}h}aBPrqZWi9JVEWYg>qiS9{l}qFG1p3S>8oHB6jCEs(pYhv2*t&2D+ZDv9 zci?g>IMJbJL#de`t?%Vm4cVM%*HM)}&JWi0(a@cA+x-(&Zt^}ckNBkT)LiBH`aCwj zc`ro<2j5sRz&+`cym~f^6~?iE`z*q?ODA)v z@6@4FyZ!cyQo?7AR+-87(tc@h#*S@M36Oy zfOzqWJVmVeIyXVLs&RE<(rulWP6&6;q}z(d75ZQ21^q3?kZz<~+H>=@c>F`e`1j)< zuBPsxz!3U-H$ktYf_Q*Tq?*qM$jm7q!v7yJ>l9>(fC#cgKm=JLAc8Cr5J8r>n=1t5 z^?LDoy&@n&U~adYef#!_br2!2si`Rp1_S>BP=dQi+RJ@I00000NkvXXu0mjfx@fCB diff --git a/vignettes/figures/poweranalysis-scenarios.png b/vignettes/figures/poweranalysis-scenarios.png deleted file mode 100755 index ce4da1b6c4d40fa2594b6b08c33d2cdaac6ccf1c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9995 zcmd6tby(Elo9+jYP#UEh1*B2B6$xonq`M^rlrE)2N<_L8L_k^`x&#DiY3Y>iZuXhq zo;_!Gue19*f9xN}>l%rfVP@Xjy&^mHNHVKjJNaZ?)rG$$Z?e@nkHa zS%%sNT_;D4U(Sp-n_ahS^dP6g*qP~0bE*vocZIy}Bhzv8YcgoE#Og#JOp+G~yOn8w z{JPuezI}S4wAg*N;kNPD#jn1)3z?gf^ZRC?I*pz!IYXc|<<%mhYs@pG(w}bCNZuZ)O} zPE|*T^7L?1s4%a@tTm~|ak9pv<(X0(C!>S}ZGmP7JhW3c3OP~dLk&MU`tDNO#+$kp zta!}L&Gjz7SokXY=v!&&NUfI;t(dF%{IBS)i<*K0u7iVvoI#t?L5(L*nyOx|;^5=| z92prg*L8Bb6BHEGa%p95o}f(6YmAtvcC%U^MOx-9-Zyb{j7m*SMRxF3YX+4U7r*OD z7D~<|ldbgFWkFnAT!d2#6^^9S-!;eaI#|1NP{Yj3Y>m`qQBL?ho8-Da`g1T(i+b-a zyfWf!uV1ZYba!_*qKI1jaNLDP__=?&-$mt50dZ>@8k#?)R)ood_TOCDEQh~#`Nne_ zJbd_Ydbs}LWdN5%!>{O@l|H9}rw8i~vK~7v_c6mO+}oV2)hV^a7jxT~&nv29;^+Sm zM$WU-L@4z;Q=ZVWD@pe8V-hwtHu%hjKKoC7PsgT`zSnvkI*^c%OD z<2v1dHdJV!WN1idXlNKtFO}AtDUVV7d`9|xOw93C6QP2Nifn-iM@PIKJLXvURL!3rgoLLnC@IYm`W<0R`5YPq2u9LNb$@-D_p7b#)01pf z@#Faz8Cltxm6i6HrjX<507428=Ubcgmy*w(Jws?{YVM?8o`o*@{*@lc*?_me#P`a4YPZ`&vmW&b4cIJtkUPL)O;py3-^&wq}~zIyv4=!=hK zWpROlS75Vb6%?+*`mnIGzinu^hsemxtaM$c>h0}qZf%W8PggTGW+=7nn(dXR$DB@f ztTP!av)8Y7#gCACU~PRnIyyRMa7Au-J^f;jm5GUIX%v}vr=kA41OBS<&$pyB;_mN~ zg&b%9{{0zv^}74Ph!t8+US8&xFIcgPL5f*6FGO^t^E@XNVpyDZ7gS(}boY+mzP-k6 zP$eTRjb2$6)%Eo|-w@xt&BJ5Wn<2Y4UfDmtYvg;(+!{%n2|I$n(zm+bnIaOiK2|eDzlaG#&- z+wvAX2qD3h*5DYALoT_8l?6>CMTj~wSl#dd$&SaZf-uc@hBQNi=&`F7fN8z8E zN*fv)ny+1g?hj|`Iz7Ew2mvk5)vJsg9AV{CzR722-iSi|%Em0E_&1@UcL-dfXvO68 z^=S}oZEdJ$rK*N#=KUNRirZfu7NR&uT27$n>y!qoBn!^W&PqRgi1YL3PfqP(e|p~| zH2>yinZ~9jop0s}nH_D9bx9|;ww`gq&Lv-&mez4LrfH{NI4t@(zvNs+W--|WW(+dDcGl$EbAu&@ME@>v#J_cHlo zQ725+dX>Ih)%>E8JoGWmtToaJcKPh=OdDxKy1URdH{muVP&T)+VzV}(udh!b{M| z9y6mz+pY^$y)wH`RaHq^h8{tfxMan4BX`%<)=-)?I5=qcrx*o2uZ ziy7YY?4QE>ZG&uCj*_|%ZjGXc&(~8??|S&QqoX6Us%rG;a(a5&i@*cV9*8X)Tuj}QBE#CHf!ynfiHYH~VsXCbCwE>fsi*l}c-Yx*)_3vS<*TL$o17K84ZCIc z^*u&_0u5Pv`J5hDz~-Et?e>_PoAXoXQd2Y<>FO#D7aAn*r#id1yt*t@BPS;ZQNbKI zY!BwU5^O*bkdi_Zb4f@iPJu8oGD6JVf7BFgdblycX;e4vZhp2AVPZRMe|d2(;&Z}Z zQc}|V^XK-!6SX@w1Gi5OHwhb*cxs#BHeh`kH?Z;`6?V_E!5hbf|@$qvUYHDi4*Sx%lrhzwCmuM=9m&ooRIq zFWu43U}95@GI&>2RkfvuVkm3o)ZNo_XGqU6@%!r1lJ$;X)3>_Q>RY#N6+8b`9G{rD z3dfa~x472~zrdgzO6>|3*82}1WIR1Z$I2b8pt+&c=#E*-c&WV-UxzFeJY;GA1gq&< zlQh5GIv%z~=gjG5J@(3BlWMwTL_`F>gy-HzufvUdK7==DXgc39KFG<*xtHB9aQxy` zR1_gXK9c56;cpNcw99q;jYVjpw^&&2n*SmawENTW&7$MEo7*C^8hq7${+2C?uV267 z5D>5k3sY!mX|c1jQ%TgCQ=pUIxG`QTVFg`d>ulrPAfO|j2V=k1(xpD;)56}~i;ovM z2V$EwO?%7z%cDpR@Ef1=^TY24U=h>MgxA+gk&==gj!%!j z98M0WURii&r!pCjVdqeRUPSF$ozJQN3BDdUr5K@k`=6Ywl&5>k545!toMxzwPETXv z;##UV>y)DCB%qyzi&$beET;Q)N8gke_PY>|jg1Yb61Wy2*R<((>DAZQ_a-8O8C(Hq zy%VT_q5BLbs9N&CLBlJI?ZZP>KE4>CN%w$_iE056kl#06HC2?7=k4*yY7uoO4+8_@ z$nl7(KU5!Gj5|gWw10y<|yPI^VbS~zb_--oAm)_CkDeOJb({=lphmyjP*?Uw7?c0N=9 zJps=8BB)7V}EBjce#8p5&em<3w&{NKNi zG&NhGGb|4kP-_+HKik9cHcR^EK+diI3(P}>`!~?l`w;ISYhF5!6_gkJg%gV~SdwA$nvYT*q z5jaBbfOhz2Y|PBomg5JKx7IL9F-tnLS6yA5VaDeT(mGwMKojm8`;5C5}8Mtm6@2E z76dh)K2=d{H(_UY*zV+OdhX=WJjxvED(yKbXpZCH;ei<$8Tt7$&BDq4W7~M<(W_S- zsVn&^W@df_h7iUea7(|ryW`^GhDJt~?b&g0^YM*Q=#$6G7nhgwVF^psZ_|ff&k*4( z>(SHEX@jn+ps4t5fU|)8b`IhF`##EsrRC)}nV1F?Nkb1>OlKy*GC<^#&+hN7bg@$E z(tP9EVcN7nZsZ*e=El%#T|lYp@f%ka0`04i04D{VS2VDwg)aK%e>p#WDj?>%HaC!a zDs|`no73p6vS@#QLze8|4e^)r>+2@#J2GMnGxj&#(x?;_MC_cqwF(=Ks!Z;G?@npPYSSd=uZ~GJ%#+SXj7I z!-Sg$=DVUI0bHZEk57R?WO0V2R66^G=5SFN)H29%zJ6?RoMlLPemn%dg>dI=I4JFS}l zkIQ=esn`1U?c49RB%5`=_vC5jq3)wkFGX)^d7SlFr;^0Po=Y(uFSbA_uHIiWP)j>L zAA@lY73%4>pJ4?BF ztsI~7wVt8jtIW)sY-}NwzO@6R7Er^DV{#jK4({%}Gc!%M8XEIC=_a9bK&GOu@%`IQ z3QoH9vqB6iQCRh)2_(X)>xSOm1HaS$ZcWV0ydcszrg@jIG~&lgCyy&$USekcySupg z25HvVoMe;j?TUT<{W?`Io&`KZB9WcRLQ(ScJ|DoE^15#so0^%iv9qHyfXP*pJP!Q* zTYaG?T@7MSXhZ~3W0{NO#z4sSTx-JG-00XCF)^{Cx;j0FCd(*pSdiQ5Pys4Cg34g^ zLxNS6mBj=Z{V_I{3@Bpfk6Dxx^h(6z$B&nWi|8}uA~L{#$jHe#AMaTBo-DH}#qu;` zw3^QNKsE~v3!6g@8`|=6v9e-INlDEWI3Pgjn8n1#gli%4v^*mqAP_(JV>UlO|J`Rs zTKps38w^b$hw%o$67vF3&x%S)eoiM5)Iyw^nM8z1*i1EtkM;C$2d0`v6QKT;;`%wW zRV|90=A=|2IklcXEj4SER84I!Hnqs8b!TYIgF4{h5%O4v)vlsXcObgFJOtTseZ2vL*buyFce<2gUrd^q8v*oGgtxc1u-it8Q<7@- zTw@S!%Q9hxm>Pc8XBt6~MGh^Ut1j?Lr_cvyr>7gh9^dBRFax&(Ir};p8P+{_cVVfE zqnlvGK0%X&%uNNo038FPK>wJhny-OG-^78i8QH}i`xdCqH}Hv*9*eXf)<-}Hp1ZhU zp!}V3x@0OuGR;E$P_R^x&^|FaJQPY9BW)Z{I`1!%I^VkvF;l)klY>b-&UpFMW8YIk zKtLcx+@o*)Mv{AlI8l=&qs*=Ze94M2Y9Jb7kofmxOCzlDl))(OsJLR7IdgWVcWsNx z0q30*9jZg*vu>dgFW+YCh%Di0C z@n0@mB~_FZU>!iY<>h7g%Mh}xhK}{dfD!=FJ6jN{FL7nF|N2zI(c4>GG__kFd0Wxd zRj}G^^9!Wca2k=m(Z3W1HSW={B|^)DZV*ylY)+;kZHIL~-tG8SUfv42JZkYh_rKz4 z-R*;CS^zy#MPD*;a^@>+`fXG$3O}DlNL`+}P-|I=z^OqwDv0hn)gJ^0zb@{&F82ii z!|^>|H4-{miU2?Ce0pGius#NsauyuEasuxwRL-{Sq5^}}re)+K3&@6?$8bJ`-uI(? z6kTVMK-lNcx8PW-=MC0?eK|WQuNQa*wKoCrMO{Zn0f5n?M~`v__l*|8KIa=$$JNw` zgAh|l`HI5|Vj0gg20<9xoe80TpOo}gx4;roH@*!I2ggnDqTj#sL;45DYqB%nhDXK! z2J9fE6w1!iUu^MQ15&$(5TH2?sy@W9s=?`3 zx_1u&j-DBU)Q_`kxVX^S340_CX~47FwX>W5XZCeyH}WkAmdXi4SKq(@wfo>;?{aTK z$R+}k2U`a&BQPjv8ytN9rw7!Sjo-=R@a ztWr|xz=t4-|ICb%yw(5|qN&V&tO95mRYWkzEz`}LkMag13VWo^m(^rsWPT%UwaolC z%emP(ICM%(F|i5h=0TIdc-=8+yprZ~p!4xUffSA`_%jXmr!jH%dbUq{#Gduta+s`9 zkd~GXlQeqt=m)SJfT9dSLgZk_QQ&XBEk*&dXH!!Ebj7-(SzK5T70J`(?DX07b^L~4 zd}{5g7iNJXq<6w{e>QbGrhwaq zJ^`(0^IVivH2w&;i}u^D8C z)b*>od*M%snTD2@%f`3}xS`OuZ%tun0KgeOHF!bK01rz`OZ4gGWsh`bhxY#dnD_5V z0ALOokHW^GQHZ{{eR=42+4`PYiGt5EeESi{{{Zkp08>MZSG^2-_l^h*NDnxaX4qVU zdzzYYZHs!PlAC8~bFEQU2WumpiF_ddKAwa7u;fxwvKcJa$$CsoO8PULl25zTQYCEc z&fX2Mu80>KejQ{~YQkM$`C?Ha}DkrL4&u#+dKp=IyAf*24?7RgK6~!zlD1L#QBnmq*NlHqJ z?+-jtP7x+1B#gq^<>cbRa6oKc*anHj|V!UFoGK?rQx+9(n?XEPSx3KOrI3rj>qgyoW6+@05dd*)d%#;3WK zh$iq?Fm);QK6ajq-ma$S8ynppsrT~(&ZA;y#|hjX^=^P}yuCO-#n|do;@O7Vge|eI zY+fVoKCaJyLSe%$KAXOM#x93!V6zdZ^&qH)W8v#m-!nORk=Bp5Pc>Rw+A=yi$}%|6 zCy2Kxbk=*h?&xRM5yu5@HVg(-ySqJ7r5?MMaLiQ!68bu&0fkpi;=c;MtjrPee_G4J z$e$CBmE3IYT2BGsXfz_ufw0(4OTQTbeze2M&B@J0YXAU!MA>x0myZihebRH4E5?-; zi1>x0wxAm~PtGPKr0&q_YB31rpfZA<-k*@Ge0T4@2ZaUD@=#3;MaDpsQWN>C?gCHs zDzjIytbBO$?p=~v!ztr8CfXl^xqv<