From bddc801333deff45c719245d446fb6707309db30 Mon Sep 17 00:00:00 2001 From: GidonFrischkorn Date: Thu, 8 Feb 2024 20:13:42 +0100 Subject: [PATCH] Remove gen_3p_data and gen_imm_data --- DESCRIPTION | 1 - NAMESPACE | 2 - R/bmm_model_mixture2p.R | 2 +- R/bmm_model_mixture3p.R | 11 +- R/fit_model.R | 9 +- R/get_model_prior.R | 14 +- R/random_data_generation.R | 203 ----------------------- README.Rmd | 31 ++-- README.md | 48 +++--- man/figures/README-unnamed-chunk-4-1.png | Bin 5590 -> 27194 bytes man/fit_model.Rd | 9 +- man/gen_3p_data.Rd | 60 ------- man/gen_imm_data.Rd | 33 ---- man/get_model_prior.Rd | 14 +- man/mixture2p.Rd | 2 +- man/mixture3p.Rd | 11 +- tests/testthat/test-fit_model.R | 30 ++-- tests/testthat/test-get_model_prior.R | 7 +- 18 files changed, 96 insertions(+), 391 deletions(-) delete mode 100644 R/random_data_generation.R delete mode 100644 man/gen_3p_data.Rd delete mode 100644 man/gen_imm_data.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 9a2c9657..b77bd240 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,6 @@ Imports: dplyr, withr, tidyr, - circular, stats, matrixStats, methods diff --git a/NAMESPACE b/NAMESPACE index ebc3ec4f..1c978211 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,8 +30,6 @@ export(dmixture2p) export(dmixture3p) export(dsdm) export(fit_model) -export(gen_3p_data) -export(gen_imm_data) export(get_model_prior) export(k2sd) export(mixture2p) diff --git a/R/bmm_model_mixture2p.R b/R/bmm_model_mixture2p.R index 6d1d48b0..9ce600fd 100644 --- a/R/bmm_model_mixture2p.R +++ b/R/bmm_model_mixture2p.R @@ -32,7 +32,7 @@ #' @examples #' \dontrun{ #' # generate artificial data -#' dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +#' dat <- data.frame(y = rmixture2p(n=2000)) #' #' # define formula #' ff <- brms::bf(y ~ 1, diff --git a/R/bmm_model_mixture3p.R b/R/bmm_model_mixture3p.R index 677e1acd..63fe7bf0 100644 --- a/R/bmm_model_mixture3p.R +++ b/R/bmm_model_mixture3p.R @@ -44,7 +44,12 @@ #' @examples #' \dontrun{ #' # generate artificial data from the Bays et al (2009) 3-parameter mixture model -#' dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +#' dat <- data.frame( +#' y = rmixture3p(n=2000, mu = c(0,1,-1.5,2)), +#' nt1_loc = 1, +#' nt2_loc = -1.5, +#' nt3_loc = 2 +#' ) #' #' # define formula #' ff <- brms::bf(y ~ 1, @@ -53,14 +58,14 @@ #' thetant ~ 1) #' #' # specify the 3-parameter model -#' model <- mixture3p(non_targets = paste0('nt',1:3,'_loc'), setsize=4) +#' model <- mixture3p(non_targets = paste0('nt',1:3,'_loc'), setsize = 4) #' #' # fit the model #' fit <- fit_model(formula = ff, #' data = dat, #' model = model, #' parallel=T, -#' iter=500, +#' iter = 500, #' backend='cmdstanr') #' } mixture3p <- .model_mixture3p diff --git a/R/fit_model.R b/R/fit_model.R index 56a91be1..7fd471fc 100644 --- a/R/fit_model.R +++ b/R/fit_model.R @@ -47,18 +47,17 @@ #' @examples #' \dontrun{ #' # generate artificial data from the Bays et al (2009) 3-parameter mixture model -#' dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +#' dat <- rsdm(n=2000) #' #' # define formula #' ff <- brms::bf(y ~ 1, -#' kappa ~ 1, -#' thetat ~ 1, -#' thetant ~ 1) +#' c ~ 1, +#' kappa ~ 1) #' #' # fit the model #' fit <- fit_model(formula = ff, #' data = dat, -#' model = mixture3p(non_targets = paste0('nt',1:3,'_loc'), setsize=4), +#' model = sdmSimple(), #' parallel=T, #' iter=500, #' backend='cmdstanr') diff --git a/R/get_model_prior.R b/R/get_model_prior.R index 80bc05c6..fa5ecfe2 100644 --- a/R/get_model_prior.R +++ b/R/get_model_prior.R @@ -34,22 +34,18 @@ #' #' @examples #' \dontrun{ -#' # generate artificial data from the Bays et al (2009) 3-parameter mixture model -#' dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +#' # generate artificial data from the Signal Discrimination Model +#' dat <- rsdm(n=2000) #' #' # define formula #' ff <- brms::bf(y ~ 1, -#' kappa ~ 1, -#' thetat ~ 1, -#' thetant ~ 1) -#' -#' # simulate data -#' dat <- gen_3p_data(N = 200) +#' c ~ 1, +#' kappa ~ 1) #' #' # fit the model #' get_model_prior(formula = ff, #' data = dat, -#' model = mixture3p(non_targets = paste0('nt',1,'_loc'), setsize = 2) +#' model = sdmSimple() #' ) #' } #' diff --git a/R/random_data_generation.R b/R/random_data_generation.R deleted file mode 100644 index 8e5c1e7d..00000000 --- a/R/random_data_generation.R +++ /dev/null @@ -1,203 +0,0 @@ -#' @title Generate artificial data from the Bays et al (2009) 3-parameter -#' mixture model -#' @description Given a set of parameters, and desired setsize, it generates -#' responses in a continuous reproduction task, with corresponding proportions -#' coming from memory, non-target location errors, or guessing. -#' -#' @param N Numeric. Number of samples -#' @param pmem Numeric. Probability of response coming from memory -#' @param pnt Numeric. Probability of response coming from a non-target item -#' @param kappa Numeric. Precision of the von mises distribution -#' @param setsize Numeric. Number of presented items -#' @param relative_resp Logical. if TRUE, returns response error relative to the -#' target and all non-target item locations are coded relative to the target. -#' If FALSE, returns actual response and the location of all items is absolute -#' @keywords simulation -#' -#' @return A data.frame object. y is the response (if relative_resp==F) or -#' response error (if relative_resp==T), t_loc is the value of the target -#' (only if relative_resp==F), nt1_loc to nti_loc, are values of the -#' non-targets, where i=setsize-1. -#' -#' @export -#' -#' @examples -#' # example code -#' nsub = 30 -#' df_3p_parms <- data.frame( -#' theta_pmem = rnorm(nsub, mean = 2, sd = 1), -#' theta_pnt = rnorm(nsub, mean = 1, sd = 0.5), -#' kappa = pmax(0,rnorm(nsub, mean = 5, sd = 1)), -#' pmem = numeric(nsub), -#' pnt = numeric(nsub), -#' pguess = numeric(nsub) -#' ) -#' -#' # transform continous mixture weights into probabilities using the softmax -#' df_3p_parms[,c("pmem","pnt","pguess")] <- apply(df_3p_parms[,c("theta_pmem","theta_pnt")], -#' 1,softmax) -#' -gen_3p_data <- function(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=2, relative_resp=T) { - t_loc <- NULL - resample <- function(x, ...) x[sample.int(length(x), ...)] - - # set parameters - pguess = 1-pmem-pnt # probability of guessing - - # uniformly distributed locations on the circle - locations <- matrix(0, nrow = N, ncol = setsize) - for (i in 1:setsize) { - locations[,i] <- brms::rvon_mises(N, 0, 0) - } - - idx_t <- 1:(round(pmem*N)) # which responses are target based - target_resp <- brms::rvon_mises(round(pmem*N), # vector of target reponses - locations[idx_t,1], - kappa) - if (pnt > 0) { - Npnt <- round(pnt*N) - idx_nt <- (round(pmem*N)+1):(round(pmem*N)+Npnt) # which responses are non-target - idx_loc <- resample(2:setsize, Npnt, replace=T) # which lure generated the response - idx_select <- cbind(idx_nt, idx_loc) - nontarget_resp <- brms::rvon_mises(round(pnt*N), # vector of nontarget responses - locations[idx_select], - kappa) - } else { - nontarget_resp <- c() - } - - if (pguess > 0) { - guess_resp <- brms::rvon_mises(N-round(pmem*N)-round(pnt*N), 0, 0) # vector of guessing responses - } else { - guess_resp <- c() - } - - # put the data together in a data.frame - dat <- data.frame(y = c(target_resp, nontarget_resp, guess_resp)) - dat <- do.call(cbind, list(dat, as.data.frame(locations))) - names(dat) <- c('y','t_loc', paste0('nt',1:(setsize-1),'_loc')) - - - # if a relative response is requested - # recode responses such that the response is the error relative to the target - # also recode nt_loc, such that it is relative to the target as well - if (relative_resp) { - dat <- bmm::wrap(dat-dat$t_loc) - dat <- dplyr::select(dat, -t_loc) - } - return(dat) -} - -#' @title Generate artificial data from the Interference measurement model -#' @description Given a set of parameters, and desired setsize, this function generates -#' data following the assumptions of the interference measurement models -#' -#' @param parms Matrix/DataFrame. Matrix or Data frame of IMM parameters, -#' must contain at least one row of values for: -#' c = context activation, -#' a = general activation, -#' s = spatial similarity gradient, -#' n = background noise, -#' kappa = precision of memory representations -#' @param ntrials Numeric. number of responses to simulate for each subject -#' @param setsize Numeric. Number of items in memory set -#' @keywords simulation -#' -#' @return A data.frame object. resp is the response, respErr is the relative -#' response to the target, Item1 to ItemN is the absolute location of the -#' N items from -pi to pi for the number of items N specified by the setsize -#' variable, D1 to DN is the spatial distance of the N items for the N items -#' specified by the setsize variable -#' -#' @export -gen_imm_data <- function(parms, - ntrials = 200, setsize=6){ - # pre-allocate & collect variables for the data simulation - nsubj <- nrow(parms) # number of subject - - # pre-allocate activation matrix - acts <- matrix(0, 1, setsize + 1) - - # switch off warnings -> rvonmises function throws a lot of information when - # generating random responses - options(warn = -1) - - # pre-allocate data frame for collecting all simulated data - simData <- data.frame( - ID = integer(), trial = integer(), setsize = integer(), - resp = numeric(), respErr = numeric(), - c = numeric(), a = numeric(), s = numeric(), n = numeric(), kappa = numeric() - ) - names <- colnames(simData) - - # pre-allocate item location & spatial distance variable - for (s in 1:(2*setsize)) { - simData[,ncol(simData) + 1] <- numeric() - } - - # update column names - newNames <- c(names,paste0("Item",1:setsize,"_abs"),paste0("spaD",1:setsize)) - colnames(simData) <- newNames - - # Loop through all subject - for (idx in 1:nsubj) { - x <- NULL - dev <- NaN - - memset <- matrix(0, ntrials, setsize) - colnames(memset) <- paste0("Item",1:setsize,"_abs") - - D <- matrix(0, ntrials, setsize) - colnames(D) <- paste0("spaD",1:setsize) - - # Loop through all trials - for (trial in 1:ntrials) { - # generate random memory set & distances for each trial - memset[trial,1:setsize] <- bmm::wrap(circular::rvonmises(setsize, 0, 0, control.circular = list(units = "radians"))) # draw items from uniform - D[trial,2:setsize] <- stats::runif(setsize - 1, 0.5, pi) # draw distances of non-targets from uniform range 0.5 to pi - - # compute activation for all items + random guessing - acts[1:setsize] <- parms[idx,"a"] + exp(-parms[idx,"s"]*D[trial,]) * parms[idx,"c"] - acts[setsize + 1] <- parms[idx,"n"] - - # convert activations into probabilities - P <- exp(acts)/sum(exp(acts)) - - # randomly select from which distribution the response will come from - cumP <- cumsum(P) - draw <- stats::runif(1,0,1) - aa <- draw < cumP - choice <- min(which(aa == TRUE)) - - # draw response dependent on choice - if (choice <= setsize) x[trial] <- bmm::wrap(circular::rvonmises(1, memset[trial,choice], parms[idx,"kappa"])) # response from a memory distribution - if (choice > setsize) x[trial] <- bmm::wrap(circular::rvonmises(1, 0, 0)) # response from noise distribution - - # compute response error as the deviation of the response from the target item - dev[trial] = bmm::wrap(x[trial] - memset[trial,1]) - } - - # collect subject data - subData <- data.frame(ID = idx, setsize = setsize, trial = 1:ntrials, resp = x, respErr = dev, - c = parms[idx,"c"], a = parms[idx,"a"], n = parms[idx, "n"], - s = parms[idx, "s"], kappa = parms[idx,"kappa"]) - - # bind all subject data together - subData <- cbind(subData,memset,D) - - # bind subject data to full data set - simData <- rbind(simData,subData) - } - - # switch warnings back on - options(warn = 0) - - # add relative locations to the simulated data - locData <- simData[,grepl("Item",colnames(simData))] - relLocData <- bmm::wrap(locData - locData$Item1_abs) - colnames(relLocData) <- paste0("Item",1:setsize,"_rel") - simData <- cbind(simData,relLocData) - - # return the simulated data - return(simData) -} diff --git a/README.Rmd b/README.Rmd index 93c84bf7..3fabd483 100644 --- a/README.Rmd +++ b/README.Rmd @@ -58,12 +58,17 @@ responses can come from three different sources - noisy representation of the target, confusion with noisy representation of non-target items, or guessing based on a uniform distribution. To estimate these parameters for a dataset, we can use the `fit_model()` function. First, let's generate a dataset with known -parameters. We can use the function `gen_3p_data()` +parameters. We can use the function `rmixture3p()` ```{r example, message=FALSE, warning=FALSE} library(bmm) library(tidyverse) -dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +dat <- data.frame( + y = rmixture3p(n = 2000, mu = c(0,1,-1.5,2)), + nt1_loc = 1, + nt2_loc = -1.5, + nt3_loc = 2 +) head(dat) ``` @@ -82,19 +87,12 @@ tails: hist(dat$y, breaks = 60, xlab = "Response error relative to target") ``` Another key property of the data is that some error responses are not random, -but that they are due to confusion of the target with one of the lures. We can -visualize this by centering the response error relative to each of the possible -non-target locations. We do this with the helper function -`calc_error_relative_to_nontargets()`: - -```{r} -dat %>% - calc_error_relative_to_nontargets('y', paste0('nt',1:3,'_loc')) %>% - ggplot(aes(y_nt)) + - geom_histogram() -``` +but that they are due to confusion of the target with one of the lures. This is already +visible by the additional peaks in the histogram. Typically these peaks are not immediately +visible as the non-target locations vary from trial to trial. Ok, so now let's fit the three-parameter model. We only need to do two things: + - Specify the model formula - Call fit_model() @@ -105,9 +103,9 @@ proportion for correct responses and mixing proportion for non-target swaps. ```{r} ff <- brms::bf(y ~ 1, - kappa ~ 1, - thetat ~ 1, - thetant ~ 1) + kappa ~ 1, + thetat ~ 1, + thetant ~ 1) ``` Then specify the model and give it information about the required arguments. In @@ -134,4 +132,3 @@ fit <- fit_model(formula = ff, iter=500, backend='cmdstanr') ``` - diff --git a/README.md b/README.md index 4005f931..27df3897 100644 --- a/README.md +++ b/README.md @@ -78,15 +78,20 @@ let’s generate a dataset with known parameters. We can use the function ``` r library(bmm) library(tidyverse) -dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +dat <- data.frame( + y = rmixture3p(n = 2000, mu = c(0,1,-1.5,2)), + nt1_loc = 1, + nt2_loc = -1.5, + nt3_loc = 2 +) head(dat) -#> y nt1_loc nt2_loc nt3_loc -#> 1 0.51775824 1.0020511 0.76339413 -1.2897954 -#> 2 0.03960327 -0.6206519 1.09208784 -0.8679937 -#> 3 -0.48213423 1.1447270 2.81885045 -1.4363374 -#> 4 -0.34510101 2.7482095 -0.06612305 2.0340003 -#> 5 0.09348744 -1.3952246 2.17738363 0.7796131 -#> 6 0.39001975 -0.8049496 2.07371921 -1.1887811 +#> y nt1_loc nt2_loc nt3_loc +#> 1 -0.21935776 1 -1.5 2 +#> 2 -0.09542148 1 -1.5 2 +#> 3 -0.46152746 1 -1.5 2 +#> 4 2.20892562 1 -1.5 2 +#> 5 -0.52996268 1 -1.5 2 +#> 6 -0.47483031 1 -1.5 2 ``` We have a dataset of 2000 observations of response error, of which 60% @@ -108,22 +113,15 @@ hist(dat$y, breaks = 60, xlab = "Response error relative to target") Another key property of the data is that some error responses are not random, but that they are due to confusion of the target with one of the -lures. We can visualize this by centering the response error relative to -each of the possible non-target locations. We do this with the helper -function `calc_error_relative_to_nontargets()`: - -``` r -dat %>% - calc_error_relative_to_nontargets('y', paste0('nt',1:3,'_loc')) %>% - ggplot(aes(y_nt)) + - geom_histogram() -#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`. -``` - - +lures. This is already visible by the additional peaks in the histogram. +Typically these peaks are not immediately visible as the non-target +locations vary from trial to trial. Ok, so now let’s fit the three-parameter model. We only need to do two -things: - Specify the model formula - Call fit_model() +things: + +- Specify the model formula +- Call fit_model() In this example the parameters don’t vary over conditions, so we have no predictors. `y` is the name of the response error variable, whereas @@ -133,9 +131,9 @@ for non-target swaps. ``` r ff <- brms::bf(y ~ 1, - kappa ~ 1, - thetat ~ 1, - thetant ~ 1) + kappa ~ 1, + thetat ~ 1, + thetant ~ 1) ``` Then specify the model and give it information about the required diff --git a/man/figures/README-unnamed-chunk-4-1.png b/man/figures/README-unnamed-chunk-4-1.png index 688ac2044052bfd1667bf50d4584ab11e268f84f..72dd9d8397ca628f8fe68dd1cae2163d03cd29e8 100644 GIT binary patch literal 27194 zcmeFZXH*njv@O~+AW0OJprC-FBt?{{U_%Qcf+Rsfi7GiOIYWyX0RCir|30sHmKwsJN)9k*S%&qX(MW;@T$KX8M});vy*2C3p8b zYI?`-PznX)q@6uo>)IR{>2+X>*C*XbzTs)-=$3YxarZfIqx7q9t0sGb^qIK_H^TMV zgeb34ltlM?_iw9|u$(lAn{wm$oG$m7z?Jn^{hIivMjDcd9PYF{?`*?@>h9Iyz!|5J zUi0Z*vbWjiR6g{cL7$^dm|_$)3P!Fk@;+w#}(e_1h!MvVpV)`{xVEW1+MGPnPNSL zrCqMFo@o~xDf{rVmwnmIKKyt=5pw5ex5dk(^ZIFJ6x-T4`XqBqD7C!&XJ({xLZzB_ z?DLP0TExWiHx!?ZYWCBm=ySEPEV=TneEQl(#zl=lQcEZK!2QDq=~4Xy>>SBmPv)|wAEjZ(0P6J+_c-^{2|3Cp;D!oU|*3<4UR0z z@-vv{>Vf+$Dlb@WEUj571^E#VcwMF;qkVIRQ!!&sq|#X_gC(3oBh$j!bD+CYy36|; zUPw_0?U0-|gZGrGP$|_%_bP13Q`MAMlY5s1+6z)4FZw}cq=}fGS^zjX=t{^W0DWycguGhwZ2-urK|O^KfSI@GK8O^ zy{^5^@Z0+~6LkSc6D7C2>xv$AEr*&x!I4mkVn}f{iw!dhMv?Xhd@GI}%B67la zp6F7{;+^36u1M;bYpPNzzJQU@5{lrsWAq>`?DIWd#WgfTHOeu^CXZNmpUTG1l`3H` z!>Sc824?5M-k(B0YRyB;LLT?IRI2r#H`6fFc+6lPB5u%ZJHul*ofMWrI;`(|t2;zQ zxt-$*tJX8jm#<&6Zpw~QJ%38_fYZ*3KkkS-jauHmieyu*ILCMwni%s*llZjOAHuh< zf7r+35IH!*jW1&|_>@UP_}Hmu#(8#6r}UlyxF^H1Bvr z($Xk)_%ksI?}a{!0RDsr|IxyKNG?I|9zlnO;_v<$uOIox!x~-PC=?bYaqa4D8@$OL zl6=Lct%^B~G_TJu_wo3V*07R)cKd$1dw-djssiZ`v#R<6B~^1R`fqo$Pw9)iwh(pQ z|BgB0-jRs0)tQ;Kt~$rs%j?JL#sYOiM$*)inrwqJmeuX2R-6PztXtI$r??Jr9wWgc zpunPb{)c;bm{mop;>QJIMi&(N_x~>8q2+{#{~jn~$D)+uyN~bRyUYdUQ@49IqYE~L zl){DjEI*Ox?|Z^&jHn^*z56lB#iI#A%f8i=?EWeq0Wo%U|KDGvj6>n+rI?vt*n2MI z5%B-#5&kcZf>r{yE7N!?XC%0~bGZR#qEgBQ#ly|NEW)TuI9;^uB)B#j*3;%Gymhzu z!QyB`!~CtV>tfY2aDm>|@>EyY>R91Ne$(ItwLHF_o_3+@_dC<|tp;APbOzf`>$}tP zrY_V9az^rG_@=aRAAS{{sZgwVwM}6Ov)r!PTIguMKABcG*{Wii;k>mFl4;Nq>q1*8 zg2G)O^*N{+rq7Kg_6aNwylg({dQj*Qd3*8$QQY&5jfJ{~d3uc9wd$hP;Q&1+X1wa8 zqAi2%UlqcWh3nI4_tJFkEseK?SuUKi#4Sy1Y}kW(my+lb zt}|MoIh50r6=W`#IY!XMk7~^ntf=R$Pv;poMM{4XTro08-g23Bts~>iuU{nk>c&}k zcT)O|H6}_ngq~a|sc_AJ#>i@{v24-rR^3X`_U6n()3Zd^P`J-Dj3^E}1q1ja3Xkx} z_G+DTw^B!{t@EN$Pi_nKxx4qrd)B71`q0ZV7(LW?zU{9_g6#5kc0y9h(ie5>+n? z{&;$1vV@2soz67B!Jp4q`91>|1(wkPZR2gummsp9vg)qwm>Jc4(NlE+uD zy|vzuzrndkR1)EXvt>Xd*Gs-(i68GwByzt2E^dgW8*IBI}FeEoVFJgGTM9 z)0<=xNpi)ud#wA!0?b?PDCL|yiY$4x-peC_gPn<1F*N*qJ&!9+G)(YmmcMB~rOxDn z%_O#QHui?}iSr@M$I5fdbhp9cJ(X0jtQ?$F%~^CsdD?x@t#yKsvB4pUzh=mKvb|yG zJ*S3{S>?$W*_<2EA^aR%jd3GdgGBLg6j*WMVnSxo8c1PpSx_2Sba`{iJJN*?s5EBO`Lp$WGP+1 zQAdqWBF|pZyb<%9AgoE0s%V%?H;#~e|GA67VYXyCgC<^VA-(78LE+;GOucTm>-qw2 z1xJ~*BynB~>&G%|K8cN@A%qo*^nQNb{KJL3={J zU^$c|&ZE3-oYga&=}wN#*u+10g<|gcp=+=ZF-p@l^wzj={+NoEFqe+JJI517#-c*3 zy2coUQFkz;kEr5pzaE$;_|&H1?0BsthyNyq_Ni^bvj%}D>fz>FW(~Y^Nxroj>-Jfd zuCX3(7=(p#6P~nnr0I&cCaBP?uJ>)z*C?quq1GD28N?_z*nTbBxu^y8X4kxI)11s~ zTe>A_fw?oi#6A+EQ6X2q{q1a0bo&{#EJ(axVT!ZYIuhNtR&BXQ!dCN<(L2nDs!5!< zYDiIOhigaOE>Kx5+Mt&r#CwI7Bjj?D4YzA)7F>qRE1usKgWE^ixluf@K2zjrvhba| z?%G1Zna`hB?LG-?I_9f1zw2|}#&j}8xp4E@a!-bJ?IR5BO%+QC7_m*be?tQIo|VZwqNBO4jpDy9Wg#(ggjF+GWW zGu&fV&Cy`I^x~?~d{+Wrd9Y{Z9Oh>NW1)8SheZ0IypRDk*`kf5HVx~mQO=tiGo((N zKgn-BTKZN?Cp(e4X}6TK`26v&fcX=61gTOk7ejkxc@LwBwU}pzd^K{bxYSXHH>a1@ zB5wQ9y!lwZ#HRn{8zk}j82e?OnaqR}PQQLEFL#+n-L8AV;B>TSx>-Tiy|C4-eMLE! z&FZkbj$#EfhqMoChJF)sa(f=RX>T$<|M}a4*rdGa+)=CEy7f`R?Ps-hWF8w?CL3|R zdRJntRRsN$BrZv+Q_$3q*}bb>C7KFh<+KWF+YplW=OO97;~mJOPyo?jay+`+)oHGb z#-xkUvsf}8M*K?C7Aye&w(7C+QG<7bmSE=53Wkq|Kf>&{NR-KEE6^c z;jeVMqeT{d-W+C$uXt9ynJM-4*$8`jjdk;e{S7B!$+??Q)9J1GZJnmuF6b+lYRi-w z+1S*KT z{qF3?ivEswXC(zLe zHVI{Nq?9E0k;PJxQBJbQY`o#FeU!9H1S?JfV3lAJS%OGtGnvic!JerR$QAYb_8+}J zeyrJ8fy3}8k$p;m$M}Oq@76liT#Fd{IF)>-&?uA~CUzX7Ao~;Q?T^e`vjfsXW;pi` zDET!AM(L!b+fiGa>v`%@N)#gu!jG2RG<~fbE*kEucyXEbfa_EXpVYN8^5$OTM5cxye>?p&z;{M%T)V`LURpQ8Ww#(oZ@t4_ zI_idFXJ(>4tzOfjsFX0FXzrqn0e#Uzv{8;@~rn>2;0I8p{R&&8Wj|A0+8|R}~ zp$Y|1H%uA{+Zx`yp8u>ZY{)67_h_A7FmozvS?v?gpqL~s(-U%8Qg4@)?0NFkNBWD} ztY<#t^I2AfJZ+A@$1Pm#*mj!9c)~sAyLTVp9^a%PKd%UjTHzpx8v=>^)ZF8rhu-BE z*A}eQ-7#KaIayZgu~MFXJzr(kgZYFgS0d*c*7zIQV5{ zM%WrkUZ=ByG6D0WZ6mCxcFq45jJHx~e`X=apH+!5%BC=x95q{1k=GIUPEZH<6iJPHhmV zGnufmallS0qHSR;*q@TeMBZ|9_UpmKD^^cDG(4Z2>fu_ko9&)b71qf5X}PW>p()6l zhItBzk${NcMbNOw_e8J9fSOx%*POSaO5ybR5I3 zyGzMFoi{D1n4Tz7bg^F>i^|L5?|$TJYgoJ{<{*y3ouh(U)kr3qMuELwK^)D08m4|m1s@Xr*C95}DMXi`_?VT=z3I~=kt|6Kx1633ouI&mz9dw4S{)iS9te$X@g9~{CuL{h6eL&-w2{8=CT*8l z(CU2#=6#ur!bNAB_wzGiM!8b7@)h-)%Ql`L(y7iWex$yfq)}8DWL|rD+R8Mwt6Z%6 zcx*Km`;|9+wn%5lFvZTD_l_rD+j)E`tE-^|&=lW91&N-5TN3{|@*y=!EdBHeyhIHF zWg|B@1iw<35qf5~DaOhWC+}B~QPq(-yxW&o(&M4)Cv&LN3HFYVz>&c0?}4ZP^!AKz zG0=;5m~-fn>>W7*M=n41yDYKWeM2-uq8(ALKfHH@1&){xaG87U{rrFRKol;+rP{-% z5ABi*lZRk1gAK3V+->}Efj|w^ysG{#acY+y=wQO4{4s4$KJ3u}mrufxBffs#*LL}Y zRB_0e_KAcXS9gz?iNFz-^V}@2c6kUbPv8)iRmqf}>>l~~6psAQ0PPOP|EB{qWIk|i zX8|#mqM<2GyXv~HV}7U_zfNRGNy9M%`e)YUKq;g?bP|d znlnv$Xn$qs)X?TFHr`yADpNtuwI_sgdksaak#nQ5HU7L)`3tpfg`SQV^&3yCWE$Nw zqE3RXA)9p617w?-hs;Bx)cA(fPe z&!AJxT~s?!OS~I9tk2M&_G4){)r~gSSF+ZYCREB^Qza-SC`aP0wZti9>D2h&D{|U2 z`udzaV%F@jC%a zFXf&Lb-6Y_w%?fT`*XeAHv$nF7lVsBOAa1%{I%?NVkvDd?>lf@Pc6?XgGSw^1dswn zHo4#K&!Ny~m?&~pW}Bj9v&hb8Gn&k@m6KAj-%V04Fanz9OxU+uyYYxeFhKhBJj%E& zF-SW2%H?U2Rl+08QpvfN6Kkfc9=q#=@$DJ(r#!+ws2mCuu~ANe_R~2gZ=#qP-*c$6 z);tXnb}l5Re7}IX*ApUuXxaX)`hI(2T9gp69AO_MF>V*3U{rr~_d9jv) z>JnMwEuxUscc--SJg%NFRI|dv5;p|=kRdc&1@@%!6&@$1-igy!oxi8-x;F|GtjMT} zKHr}*=plGMx3m$M4}G8{0@N&9?qpV<&#Rv}X5&}&PmW@=z=YZzZj@jNqNHj*@@_hN z@IW5WQd3?x&$BIlUl|Fuul@G^tncE@3P&hqVN?Bty9?0;Yk>YlhUIOzVdyX{Yu)FV zh13kIVL#p6d-JQ+3XVyHlf0kUI@*4`U@(ym;FHc!&fHt+zehcqna2J2<;Eo|s93(X z=YK+HpecUB(nrNfA9x|#Z;iHLykg#tF+@I4%8A2IB|EH|3HH0-OI24AI_fWZjD$D~ zy^n3*2Sde5h5kf`Z@1i`+XaN16egH2J>vpi%{u%yV3?*ws7m?!}h z!6bComRF;LKU_oRDD^7V@Gt`~G&t#d83ym^tm*IGV1^-*BPA3$<}xlY3Dikuo4S2j z!D-qsiGOBQ2v_fpS0f~Xpp-vh@zw){r-u~Iy(4mZ$lNEWWMx7~g)dt6+Ky1sz9ikP zOn3yZ6&Wowu`|GQPP8Tj829FPnB)vmXQ|3x@!DMJ6IMU8`cKH6rpQI5i@rF(2YD## zLvN;W*JSQQ;@Oh|2mb!z+gI38lah(kEom{j#eJ4-YLP=XZ~VQ-k3+<22cu=XqGTDe z>htZcO8kd^GDax_$A*wLHXsx3zLty25#k{Zo5T})2e3BK6n(Xy(!0ESh(Zz%T`#B3 zN9(@(?oXAVSmw8ReAtVePn3)(@*(Z8hTY%%e|8(j^a+>ezJYKbtUhIX_T#WJ`wP#% z{eGwIBaEoc5W*xRRlgx9Tpgw}Yz%*O2VUZlGhwK4XFAC_rX#SrD#hUORP)CJfzqXn zDTWtJfPm!Fs}C)WM<%-6&OzzxyCgDe3&x>wkZh@og-YmFBZX zzD)`S2+QU1xFmmdQ=n&qOfw8x;+;0vS|e`K&|SFiawkEV_YTocu!?XbLrzo4Fu2og z-VUoFK{dzhaWxzA(61FBZ;n18B#U=kUsjBiIyTW;kjHD(UT@GG{i8RI#-cahme1kW zBf5(ZpSm*$_tNqj+zt#rP6qGHYK4oq>D&2~;0=`o7(GaKTm~RgX$(u-v_8|4K~& zf7h31WYPt}%1^@KT*V}HjDjcYUrmfr5J@*{J^jj}qj|>4{~0L?q(H_#8|7Wc^eViy(Ag4MJSe>J zs8d$NZhb0is?#vZ9bIOhVm2hX4&|X+^Xj0nsLAE!GOS^-uMeg|)~^)-aOyBwy_J3j>kQ4EfII*{J9;Nm$NaU_ss` z3^fo&&VBvQxu+?SjMBJQM_4*9RvaHJd}0;ErA<14CMtRR z0up5@WMfq4CsCpR9(^zU%aO)inH>)cc~D}U#w?BruVaz!5i4GwhJ3GSp}29LB9~rn+Xvx{I8-t%3PPRe`~C(_ zss>{^o?edGP&_c*9h_2R@K3nYXjp=oD}By=u}Vqw*%8lC$F15Q{E5m3l*Gm;+UrK0 zZ{QUONDx7+^|KgR9$<|puZ=+^<1=iHFXrMxZgc_C;PbiI1|3KmmT2XMFwiD&Bk%Px zJd00MB2$v8%IM?$HnrPl7#Zo`vwRx*HE9>oJrM1JZGd){x`2&$uYn`}pL71t$LFaK z%Kh4@%!g&9Dg}0y4HI%qeFbE`Cat5L9 z>u-)e7_9Kj0vJzaihr5*@6U@MQSG{q+zb-}88c1tJv(7=cQFn>0SMCNFJzqUE_nFp ztdmGB|D6y+wFpG4$(&$OTa^&fl#&aT-Tfp&IMEX4>rRi!)w+F|{qN0Hkvy1b*jCFd z8*GH6q;7Bd5-48rCOx?%S)Y)1nI-JC86;OJbjaD}t6TBo*6jp!dEw_A0!^`u=D2XY z(Fz7*Eva4jq2apImZ#mHM8GQup`I|*RFai!wAE~c< z4L_BW6lyHIF)P{ySljh=JMxE z-u#>x{?FDky{&1wb;ath&a36Nf4ry}56rwi!z1WUmIpnBnR{f@CizXeKUxU#LDWss zw5RKPTY?^ElKta(ak;@W=z{k0#@j+{BWm%j=z$c_tve&71BRKGx{n9mWkN5@3*#Tx!Ti>#rH15tL@IP)gC1ZRu!H*4I6 z@;nmm-`0?%4T~t2E1(*xj&d-t?TmF%)~J$)*8biA+p)t##EcZQILMKNy|?CNvEG6R zc*Wi#3CEDBV>~pRRwEoirGTDZAnU-0Ziu4}=ol#=;bcU2zE2JY@%tNLK8>2iJIBQa zaT687azuP4yKdcO%#Se3hg+|nM3zkPHkrdpkM*?YGW1O<^}bu}MW8wKBPHdv6k~*m zh`XD^Qj3!DX#J;1m1byDqk^2bR;L|7fLGI0ciyxVoQO}GTx^off}x_mhrgf{-k%2T z(=^GAyqUthg86S}m-}50c7mF2G7@O+al-uj#mG!m=%BzFfWO`pvgK1m+PedqONkw} zH&;yd$G6@)AnDC4Z8kXW`fX?3a2>iq>mn0)seva(Tp}y7&uQH_tI~c;rJMFhY^tlgX8FL@h>INiq>jBf`%t!8V`C>92f5S%|CeA4jUqPGE6S z+^{24zuJpg>DIK{%Ke}zu=>**zd~s|=Gsl)^Ohz0`=)N#`d&64{`lcxr|n2k&me!x zk+|>*v+_u2{{ zK^ug>f{|`S$Ff~*UOCQS|LCu|!35L3!pNadunxwbljX1U+MB430`^cbni|0Fq6ic^ zh6H)AOKRLTEn(RpsplzI`>+ktzgVpoJ=h`5-=j57-g2&L;08o}e!+65;rU`!z_|fa ziDh%V%Zq@2EK5>4quREnRtNNGD*k{pc<&q15YVyo*L$9?xYo5B)Cta9v9?#g$-Qd$ zxctLRbQ|rApY!)9ol(PmQ6FB&*PZjM>AJPnyw|@`${?4Q4Mjm`>qgCyTCmb9Sl0k; zn7dV7cYb$T-tqcWaKRG_t=G8HjkXx3>0$A&6`S8S+HxQ*ts`j9wCo}ImlOvaf%7W z&)HEe-%cSoHZ+?+o)o)TuBRs5+PcX53qgNRMX{a=CcvR|3n~J-d3`=~hnqhDCGM<1- z^+sxgreGDMgZ3Szz}fW|f-q9BBFnQCZ>k~eh2?m2RjtsvQ5#)s6hm1gok{k|We$WU z+`Ze&vu}A&K^HZj7i_IfB%(2<7}i5B`(k!*;BOY1;xwFr0S3otsx#y2x)*{F|M1h; zPP9aYOL^-rz^Az#vvz@9KpD`hlp6ky+MUpqKYW7?wFw%(RGnjzaz-p*`|pKYYlahj zMMY}XJ(du4MG+Q^e1E|)7K@g^m&2@%`Y6bxKuotINEVv4$7Ux4ERv&w?Y=>Lx$d#} zkk8r3PM^RRFzLRe0!V=jyTlU?<5_d37uMyXAHn<@wJ8BYQ;lnKq43P6H+ zngx0oL{@6tSW}b=1Vwi}_!$k_>qi^HNU*Mtb|zaAsiU#QX7fL*5PXA_&v~A?_e$z1 zKnSY^ zF*sZZ)Rl?*d%ol~XW_xxh0>jCz6*UjbjrW7|z8cyjl zzWD6}hoQekI49Tz_T&mbQV7B*DZhvOy*8R()&N#~eL6(>&)V!q67N}<%=jMEZ)XIH;ooS~X3LQlXwzA3$m=exE(&7+u2Cq;D zbgpDRJ8`Gw?b3R73$ky#?ZPmwrjg4WO8bG|%nA1Q#d8N@SQy6c&AQX^XR?GiG-6nU zdNT#NG;p&}PZ9b-5hS(~wyaQdaBoTD!72qPQ`?p3;DIZyCqN%g?|0KI4iZ)DF zWTHwsOx*K)Yv$v>epTF0c!K($cPMA5VPw*(yjfT<(N6|px|w@C$ak3oSlLR9V;sM3 zQ-Ag}o`)(uSgu_@Of@tC9>$MP%o`iR?n)YQ=H$H@y0dr5wZY{U$K_tvTkpUFLO|Fx@+a4vp+#T{`n36TfN# zFE`n(OdErhC4H(ZizYe}kOZI3_oEYF0Kuhd9rOPguG`CUQ#m^~TX&nq@Ce|%->o3_ zD1p~?w>xo)yzY6oi)|q^#p@)ve7D)x&kHIQ2ulOq64U&;N$rz{e{N*|YKZhHIBRrZ7kSy3POd(QVaDO@)IsiOCt+kL|X zyjTR2R{L_wUb@WoUNlx*={FoT1_4PX^Vr^lqR^`ZP<&$*6a1xv1b81kSOI!0H^q1S z3`cGFa-c<{M5fcGopt*=Ch^<|KOV~aZEDt*vR78YhUS(gu|ui-DOO@gu_{+E=}fOW zpFbV`(w)HXL zps`mh!N~x4swqFN9SKd$9cNeQ-{>~4yZ7S2iPvei|32$0r1-8+td0Y5kO9>(k3_A zrcq>3IbgvB{{ZX8)o8rk!2}wM7;-)kPxgkL=`mzN3t6Es3z1@@OQ%139X%4OTRahG zInlZrP;USCLC#U#5FnAjMVJ^T-A(yi%$5)RiOF$2sF;6J{_gMs)S{QeJW;4q5(W=$ zJe2Uvo$?qREVKygIPc86#T!yPB?>!DdhTv=F`r5IQ5tN}vG?qEUaQF9p^1NfKo*Q= zhXc5O5|onE8aDu0$*t26EN=#n{HUrbYft;OSnpg;YK<37yN{#xK? zC1F1W<<0Ci)ZVq}yqVl0RT>Uut^cB?20cv&Gj(2W#`i=2;^Z%+r>F2hoXMeEkLfxa z72=c&)gZbUYbGrNCY-%G^Y%6Jg09tlb`u;*ZQzhSewPJLkCE&j*%S}S*wC=|I)RbP zMXl-|FvjSJE4~YMv%6Mces7$jXvdGuz|7>$2&trMNm#6eIIUH+CTY|) z-n?~49hssWCPZAb2mK6R)&^i3^{Z=t%IFgUG=6<3IifMGkA`^~fkXak+0UKF_L0ZK zY|1R)Ey{U?E<&PI0a^JEGl3?QKY+zwVcua}z%*tA(iBptv%1Z0_U9Zp##O5G{o|p# z*AcCZ;xxsjeLQ-i^Zz_DD=8kj{8fxk=52Sg)<$cG3p{1XMADP9WhvjBzLYPN(( z+%v^uOg@WV&nQ^q7nq}0IscJ|U9cj!ViYK{RP+7eY%)cA`Fb7(vD2}=W zgYzu%KOiMBj^d;BpQ$5+{{HM!(Bw&MS^qM^tOm%#{&(l#iY0D{IZ})x#0}}$3--%K zpcRPT=LPe3kl3krzZp+pG-W~fT2Cb50Ar5>8fcmfupxIJxcu|2!qNuj4hW;y4LKu$PVQIkA57jt}OZ(g1zqn@x!qOPXp0podUvz=* z)oA0_Tx;~Lu_IT0QGIl^yIpn71#w_*m zJ|wNBKEyctXW=m3M7X~~aZmb4Mhg&btfq5DaxVt^yW9qI2LC>bt&LUCLN3tp8u;W% zhn%V9!QZ>I{~$s%LL$uqj!$`}w;(~cE*KKoGMXmsKf#hdhXr@{6M}plI?EvNcg5a` z`_J4KXk4+YfOD<5yZKFfjX;0qS+X+$GpQADN?=rfjlg`{Ixcr>kQUN%%tx4e27y!O zKN0eeW*m%V#h2Tr%-9$GZ5?n-0%a&JhJmQqmVYimpdkktLgbYWpw;*T89zaW*Nxk!pgdQ;bH9 zGM()=^ej6ax)cEHfWia_SpA2VDC3X~B?*1Uv+*ER$&Dl8ofB*}SO(X2cGuLZZcfs@ zwDO+U+mJrGpS{kK(TmA@9Y}#bNrA|*&~QA$uQE2nbVW>8{v3>aPL@ zuFAdZ;JMR~MkFKP`Q&OIwH=k^;7eM$+mu z4%e3!BKbd9i`r)tkLqXObba z23&aX1ZiSs^IH?u4F785$nF_9GfyY|C{CUwG*}kXBX#ftvE;7WMD=cmh@cR`D|dN5 z`?*1D_c<89!*ve|?b7!mllT(~Pmh?BR(g+5{BjPSeK=0MYqtf)QIK9BVS7sB&b&i$ zhO^89JnR7CcwpM1>WnYanGb#dw=!DnENlQw4{m;rl-IY~XuwyAY{mJbpWVvhgsnjy|xw)Zb1i*^y7Ma)#veP=TDNjHG=TCNqGDeZ{^!-Qgi-BR|@D^eg25mFqw zkrUbXfUq^*m70q^4l$y7E+#g=-ubo9#jxW{4@upCMG2>YRo1u*jNIXU(KtabQ2y@0 zv-xNEK7Wo>(VUaXU=&(md}4z)3i7qrvRtBSP9vXb?{VTtq7%_HJhvJPUzNX{hHYSq zuxI7k9XWUO(nY@P%ani5*=zv{t zt6>X(PznYJ*`0X6uE8sh1*8xmc^OMhf?zK9xi@XD{*$*7LB5mu#oB(`?ta=!*GNVR zQoL3?@-pqu@Aek^7`!nDrp=3cPbm}u3ncC9>T67UbJYkdPuVW<0-Y#)V${ z66|nlYBG3I$U~L`X;)(60X_i*aR_RA`>S=$m->fx*sqV?>uItQK+^Ajl4j$MfxS;g z&?~tssSd2Z>J$dXqzi^v`lF>B2_x!+x4RF3kWGiNvyglIYUGUJwhx=aWHJ81b8}XWC}e5l8c%|j zYyrr88R3HCk_rv%3M?lSt$88U>VVLmg-9@CNy9e*SY;>uYjYH_dws(X_S8yZcBIPc=`tuIeW zZ~Ofb&MYt?c1cn9z60QYevrY0>H3@Gxxoq*=*eGqzFGU7J}PN(AnIgSykvj5UvfP9 zmgMc;I3-R50lHeT9K@YC1?u^2Pvy9oC9_>m-^9b)-_X4kl~japr`}F(C$;vrly-90UJCOGycmUZxd$Z?$m6c>e%uM5p_%-cKq!c8@N5Y0G7wx` zh*d1aVg425M7C)G$6UkESEQgHS@n;_In)MT#%afB8O(=lQFPy0ifY`Kd6h99UA476 zez3BF-u?}WC!Xe`6%pe0Xt~E@(%oM32+aR!9IDy%&3lGId&*F!LpuKH{h1%EB|kKW zrCE$MA_fR-3dtmhXRQGFiw6<)N)d$kr$acw$agtm6S84!Mz67oBt~7CH9R;g*gcAy zS_8Yq;jQiF(rVvi(fqZH+VR3IQ;-gHbepHZA9cD!;*Udw%&>?!&E0~FHr`4lW??>8eus?LdKARJF z5jySrb`Vu|$${F9;Q&)r7LTGxtF5n7qswO&?tvzvW;Yg*ILPMQWy7G3le;dbtUi|6 zWx~yo-<7I;6QO&jUT)y8W}E0|+cZ ziTsPPafzvFRvl%8Q5_P}aXVqgb*P?+8T?aJDRmrp*`^#s=bS@g3qJxpK*tJn z>IU0JszkCm zU!K{`wa_;pKGy%}sH6_w1m=F&) zAERw=S)q=Eug9{`;4KVoCY@dQ)U2*7V+6}`nmV64xAjTK_+0bHI#2|!*`}ZKYMsrW zOs$@TZPe!6$K)TpM4`_3BHse|8TKr{QXh|lyAfQ(D>)=jJ_=YGd|}Z&)1?u@k72~Y zOy#f?*S+Y@8xDN@1Ib+DKBnNW%mYos7;#t^DCgo=T!`z9um-I(Cu>cCp#?>wrL%3LDg_$(cyHT|iu_G{Ak?aJXUhu*%746nBoC zmgk0I&4IJBtwJ2dNzWDsF{dNLyNbTvkG}K?LCrz$(64~1Iy+rewl2nCO+-r3jzjxj ziK?4`f_>b^2hc%Bu+y48x*mIi>rkaJPD@x=2n2X&@n~TbA zAce{wu4g}sbWMm4^^tvoLaecsmgM4s<~JWU!TEZ&mY{e?JN5_pATF3dmK)Sl5go44N6B@FhVx6FhT{<}HEsnSG4chwydf^0k2Kh6(#lcxc* zy5-r-f0|x2o*mW=^^RTgMKQ909q~Y3Ip)6Ic!BUYjWb7fdTlknRgdZkGt6aqv>VOR?hU$V$le zhOYfsgfF_f>fA9rbiLQ(k?4EONZmASiG2@B^rd8NK%B3-1ZlJJe-kERr{0d&jo1hm zwd7m?vf-3I*?Y<$lqS}#*319!jx;`f>!Wfqrne1zPrjl1UjKpBq3Oi+_{z$OS|37Q znBbsDG;A#;ITL1DfH=elyKQ$nXowUG5(<|Oi4%THx<_W-`Bu?u`z^63R_-%6xdvMwc;$>Yi)^ z^LQdG%i^#Y2QUd-N6}V_BG&l&HEo4pB{jY6|9G@U;H55168lM1 z&HJ+ju62lL3%h&ySEwwafp4r|2Fph1sd;&dkKDQ*5Gy@DkNeF2an7;kV^c$l{ILSi zXs-kRN9LS-JQj!Ixkdvc)sYD@N;XI9(GtY1@xky|xR$5a?VdGHO3o9oIb0E3*u?|D zP3CBS*fFS>km0L7z5kYba6i0nvSHw{2k@qZiKH)m6`W&@4&*z+uwo};b$+OM^?>5KpT_DhN zrQTwE-)H*DNmys_^84p}hg_cjWH&I1pf+RR(UZIHwka-FZcpi_L7$!G8)M0O1oN6} zzw?in6>9)zxTtL4A&MP-^BR&_*wjALDktF&CP7|;g0P;`Mk>WvLseLb=xy$IN4%yC z%+zm+B=)><=MUn38-v2ri!__`y@R%EbzsMo-fPjL{jDZpJrJ|-=(D=aCiN_nAUaoC z)06kfufhimrKS^2jICM8%?;WpReX&XYTzN76AE+pUqK)2J zZP1wfI1E0=wk7tK1o%+HXI@ZkXOH`yS2NJAp6^e@9{)qo5c{Eu8bqy1^v)w|8)<(i ztROyCINz-vJm@B6v$qM_&n`lEQ(uR+0M+F;UkbZ|Nh?8yZbIksCs2@iX3){9I51z8ne}&YDJhi za?lB`dmQ)6F#bOL{D)F@oGXLVvm>nCy$)NmX9KZ6mWLO7{TMW{+~%5`f5&1!2nF0v zHTnM@`3^fl|L>i1_oWbbR(zKstZT4Sv&U%^IkjeR>?i+{^hk+h?}c~Ajgwm#UH`qi z9oZQ1yD&3~;+d4_5?7e~ok~9d8al(}>VJbshK~(Kp;cW-luwoo+Y;!~didvy`v?TR; zRlTSnEB`5A=n%H89lD1}r<5L`(mx4!dKpZD0Vn~)25`W?=m3L;lnFEzIqN^9k|f8K z#Dw2c5mQ`?(6ItlvkShG@BmQkMaO+q`3zv}T#ODcAIV$;@@Fcw`g|HR!<_B~?G_M( z%TdCcRme6U*(-BTk#9sy9~37HU+WN;JpTwb$aI2r=Ao?6YB*-=*I?~byQZgfA(P5R zkxQGU6gweWz4(|u>`^JrBd5a9CGnqWjK7yQYOh{Oa|x35Dd?Lj(@KE2icQ)74iY@8 ztdQvwLVEDMRstn@{4(so3k+Bxj?4SaV3adj^vj4c$*Bc@XN^f<%^+h5|E0En}}fxNF1C`6=LZMdRNKo-4n*V=){ zs6-aAw{or)Ot_uiQWtuBG2+3YcHl_5r;cPOWzDJEjh(SJ><83LQqAV0CzuC(VE-@p zfi%Qk25l^<&%0Z4*sQ7LZgbi48tQP8@2gPJdfpx*{FEXwsJm3b#FkSGmfvY1^QtT@ zw+%EYc8My$LeLhpDl6ExQKqvXfDHwDaM)Vj22(M-^s*DawKN&-Et3iw9?|4gMJLGf z8>db>Co#}F$rdBD*gmlr8$OcZtKheLJUE}2GwiQ-U*i-xNyAkt2QPV=yG2d~0X9C) z2c=z@P&G-1H-hU_lW#KT6m6}=sXZ>EG7$+Jrg$q)Q=e^Ydge_l771U4rftVSxpRBcF`t=V%4|A=OhbuP;U z_Xgqw4_yA{JRkFGsPDx}33^TVn4ng9pCsn2l*0n=FZJW-HRpr_ZlHyA!YUY5M6-De ze)yoN$67g1<~9W?4!3D9Vpe}HsLQ6>y-j{p>VYO7n=KwkLb!^>RvR!eg! z(dGH%7sD@4TFDl@?XJ9U-c0Im3ILCN2Poz<>JwIGc~(=OS93N_1&2uSY)K4_^R^y5 zoZu$@?d;o1PWV8`P3BNbd?nC#mA`UjvfR$<1Jy0W$oktM)^wNh^9CKEgk;p&L+g+N z)kg))BhVa<(Mj#wamdD2CXY*B76pBMR3TO6+)_0Dbj&&>ZF-{|5=eFa5cj;pEHA5a z6~mEn(}3!}!Btq;*5~gl$rc06Rz8mRSm^ZJ#(79(T(zVT?pWu44A%d~%DyGClEJPoL|P@G*&ks@w@1*ghPk ze(Qj#1WH-*eBp;f<4sYX_G`c^y5qI{62lylC{PS9MW=SR0HC4xs_7~{VaB4#se*f86E~QjpMlS`COom^!rb?cgOs=u{*^4bv}V@i1kqN0Q{7d}M^_(J ztXl(^F$!;0AO`JuC{!$Pav=8DW`Hp3kfROZ;$49R{8*9$w4Nf!_dRIp2Pt^Z3RyW= zFK78vpK@^#VRa{Lxn#nLB0NnFfz6ZLPPqpkU`NflueWVP4fY6jiW{P^0Lahr{S^gS z^HF$uKgeVL+J6}Ts~Zu7KI0GHw+l>AI355}O~nrt{vP>)Y^~~jOZx}AK$F~vY`?;H zlm1Ihl5&C$^gj=@Hy{5;Bg9BY2o2U__$Gr?aMJ(k?aITUTKK=Xa}y;hcSKStl|o4- ziXkCMmMkTPsO(f^n2AA~2sdTVQr5^wma&Y;RkX-HgE96@V;LqUJMZ^&f4}~E|9=0R z@jT<4=bZChKHGu4qZ^3{1iR=PkOE+(l8lnVO!}d07Kuo!XIKmY8|4mYV@m*{Ay}kW zuZRa!%i>cEAnh9uaRbW6^U%yEK>qd`(cD7W z^xUX9XJ2eX@q}|if-t?SoDr)HQdp4Uu19GJM;7~gXx#UZK_r3hoCeQ)5vq4OBPRtB z=kRI)z`s!nHN_fW_HkJ69(fi4G-*|jBTife()=~lPX5mB zno_-x2@M(4d3@DKC9YE4TFGAlYIdzZst zWhHrr`Bk^e0*;qYT!p2f;^ySfx5P=5*<--*m6QXQ=0ee0dQ^MN8`#w-5$M~xBARpk z4Iq!*%;irA#hlnNh|(5QYIt<;;+x&pQIUwjJ9JhUJGfjM<@fHjTR1wW!h^cq#;SmR zoHaVd|L!!vle>B)w5(R(MmQyJMc&2@alvl`r?=ml(;2V`kWYM!rj8P9A+>{ir&kPZA4=rDDU(-WX=4fat4on(Nu9KhrJzQx?jN6X+S_T9|jp z?_i|oXvV<+eJfQdAdrgf?C~eOD`#L5Rw1opmpb`&6}R&-(7C!%A0e9~R4I*d2(;FM zg+Vew@_y3<`<^)5ftpq&UDV0mcr5;YZ+vqo-4NZPG}M_9^v{@v&qZMQZD&fV8$s|Z z;|~i^&m}A$kEDIT8|bZd(1RQGmH z;*5)gdzPu@<4Ycn)vN-2(y3b$-A8?&Gyuvz@pT~1F7U>@HoYH4+*^#f)V&^ah*I^$ z>U470D%`O>n&2vJX#2Alo~qlR#35ks8GuV_4fEs-A?M538gI(WTY31}yX!cmC8R)r z;PBso&Mrjs4o#{B*$vd1MwQA76#Xik*)+dZTiupPbR`o8suquBwET42x#JU85UZPi zRj{JlX#2}7$M33dQ++D!C>7ZG;mt_2UA`UGr6Fka$Ak6XX#L zo>pZ4E~JyvLRZJ2*pj3~tjm`x?q*ugu(lUMEU_dj?Z$oQ?dm8V{loEBtk_c8AG>3o}Z*WW4iOLW<8`GX1pL^Ma z`N^ydc~v z8+>=7gPVmB&+dp(?2R=^G8d4HXAV`xn=a)gv1}IfJWaQ#zRExaB-&WCdk)%yg6VL~ zWyBPIZoCb>*i;s!n%Fqr_k*Soz>K6H^u@YJF~6R@m2be*{3*9N0kge@=e&PMt9t|x`%#anW$eH)Y0EtQXfma0dMu-VaOid}G?y>=NA(MdzaLP3`6n#0yf zCW;;(-gRC_nvT78dE8;F#Z|z1){<^)r))J3+8O44m&P_f15&fI#l24Kj+w4jkK21X zo_umT%h*598tI+d2oDj&$%H=cpyv2WWq>agQzW0;TZJX38 zu9DNVhE&Dx!nE6t`dbo{Yd2+0XpmXVQD2;44-xi?Um+YBv8~B`UlwDY8pyTtY0>4x z=6L$&;m-{HC{{TyZ=gYPjT*IlowwZ(l|Eh7Z|bNW5*kkeD{*(L3DjY7;n zoUCmS9-lXB^ezl@gn^Q>jyxS48$$MZ(w$ZqP1qFa*+tkK*rO)jOq1ceXT(lPk9?`> z+>_0}%NENMm46v*tMRAXgt>n@kJmM6faZ%27V;W(!0bZi6iVnj# zPy@%ub}FB=u5GZ(YN%Y6QX6`7q-T?MZ_^>nd0UV0taI(ps|L*JYnAHsDX{;WF~Y z!XohgxQYvGozD}Pn_o!za>)16Y6)gbje=>WdR0GNft8U--PAR|_#v>#F3M7BO0KFr z22DL&=b3P@W0H9j&msp5*$PZX?Q%+=rn5SPPuUWwHOC1JS5_9V-$*G`?EM#uNPzyJ z@Ke*rv;PEvd__$z?NVIt8$HWDsg3NulV6O}*6EBYw1>YEUx%R!Jx?HlY#*9f+5g19*;SHH_8oduC@RwhN5squAHo43}kNi~q6O{X&juN2j+W_e%pKHwtt zFTbdJFzum7?{(p}?mTN*^E`!|Su@9ob(-N4Nu#0-d*Mw3nxefB2kNlK=+D*(e51(E zxNip3wV8t829M>m*6q`vY8QPkzn8+Khtpz20K90uA*}{O-~VwRDga(=Ni@{e`G5ET z^pt=esFP)#eml4C>cLs4#D(4e%_nC9z)|dDqyH7I*1x|b7y$r>v!eKh-K^L(d#izxkKol3nF3lRw~1 zC|a*cZfalM1!!y6@c$twy5n!L>sm+7uR9aO_v`bV=yffuZ+pnUpZ=GBl?dK9uOo6* S`5W@u76aXLr^qMmL;eG_=7K5! literal 5590 zcmd5=cT^PFns1##xu0q%tuL0xh5j5(XrSgdqw@qXmNkf;}iAxdaI! zK|z`Z1QY~Dq@l@@nk=zlkepw^o3m&C*mri%?t8mied~tr`~ALf@40>I-Ux!B?hzJ# z78D9~1po6zV-)Hjj6xk4LjQzF42%^IAx#tEis>b!MWJvglp_jyoNeBed_w|tx?Jk+T+ehBrZEtVyBjNf;j(udL>{Agv z^6Vn0UBt?6A88+mVD|(TH-){CY%rcbn{UqxSZ>3ol2<$#u*QPb|O5fjGNmN_&JOL^D4UIiq5WU?^~lXxqm zhpOZDo=1I@<={3Ag<*bxsZ&%Y=MV^xR$ncP!Rkpw@j!guQNHh0)z(`BoL?OL+~3gctJZzRoM;E${sw2J%Jot=iF`L0$SgDF=*WnB zQ{j+6kV2H zzmXL)UgxY*?tY1$xOlJf=He@7FOH7U8??rUsv#abz1NxhPBc{&+<6C;Kb;HN*(zWo zPz$fTug-U~e$m#+DtxZkEid@6YK7Lg84t=#vw7n16IiPO>QyJ#yIB5Oa^FIJwS2U9 z&R^la{P)@UN|=Z;BAAuE7jU_ymf|0x!dP?gjSgD4KIA<(A0&6lM@t`+}p3tJ!Y9dRKCx`{zKA#_3B?3{SDD z&I1M%?u1TFTWLAn1(wy1z4sdD@=jGfGT)oEbNvGr^hnjxTIvRkN=FP%Du!F7_r|?Z z93)nrEkw=CW_$YDrwKPK zz1~xxL^bMzDyw_s9UQ0+#QhR$n6}OEW6k1XxSl!Z!`FUO%Rr*3r&%he z6}2~54z*-Qgu%bw+geXA>voZo0}Hhh+`Sk77q;ksvgfn1J)0`U3prz-r;el@^9nvB zA+L$%KY-U~hc4^1wS~f*r1wjr&cOePScviH1UgVlLS88Ug?l51+At~4M-Zcj=V$w( z#|*LP6tz8o4#PUg5&2MHN^0uaklIp++ifh*EF1n@l5fWl*#S!kI_ zH7ZCnN3=##rc9C3^qCSkbNUC_hno3^Coe0)c#+rG`lf-4H};R<2sj-r9n~L?mSce$ zLt#iXM*}T~-tUH$ju;WK5qmm40+PxF-r+BM_%Py|#p|d0e}iBMka9IiuF?9Bm9FHI$RF z1NbPX96}(z9qdHO*VP$Si~~)$33TH9;8>M90;e7(kRLF(znkCu>AHr{vNT8oXjc`P zA*uT@f$AJ*4p_(Ljx2n4;aR1w?K}UIA8+>LTD#K~|H&LrJ_yE4_On}*QjPlA`Hw2- zB7~Hf4GS8Ve@E$&?Hw|)OI?=+2*$y0xH42`g~KDe_l>CKg%%k3b+cQ$H|~exjwKGo zYz%)jFrN?vxpcIhH9ieqI!{{=MLKpTChtN8bIUmjl67cdK65#R#KO^3)%bny5B)nDmfOW;AeIYAGKe!E zni=G(p{XJ%oj<-IB@7s#FARPTg)tbu4JiprLqrUPS7Fe5k&)iM^!U4b3D3!-`=0Cf zVa!XBGYIGBY&N;$3ep^B#KepeS^u6!;qTn4lT=&EV%CjlCJpcWc;;51&gXybd{nwuZG*XRbe zsvy9!A}c7=VvlSqVL*r-YDPgZ z%%BqrYzT#w@59KJ;M1YmN_kXP$f_!cPac=zUG&8HAN&r04-pkev*qx)%;9q!NZ|y8 z4uMVpxS5c@tROLYY3ZP-vvzS5AJ%znLr#ZAbVO#CbBVh+YAVYqHJ9^D03{&7s;PFW zY%@*b9M`Fba9iA}Y4n4h-!9S;03Jij+@DTWkkFBE#>njism7@3IhklETq;k|+9vtk zf)lTo9N6+$8zaYbP}D%o5+^U_JD0iL1EJJAe%vhgzAuYxPt17 z?2pS0Zua4x8BCfQajRPm^(?(N9cU^-jjn?e$JLnFQ(No5%htUnUI*Fv)RaOO2R0v= zv#ARw(M%naBRHbEdi5TqvI;R0kMr2yfVUSsKlWO`i^Tt`KY9z5nX23vsgNHit>7C zLC^7-C#8q0#i!qNG@Bjj+SDn5JuUg9*6`c+O{2 zOqlYZw+<`I4@rorM^hi#39`)5)3>bpdw2y_?MxAqpMB^qFJi?XPus52ZkJUB@Qb*w z0H;#?`Lo8*8G(2AKGTxs@KtI(zhFf@ntj?Ex!%q`I?Ao{{3FiUBy6P%JYbK(64U10 z5)9TcTw?v~ETXLc;HaB$ffk^6_=49(hu;sYw5vq;e_G&pb~kraOlHBf;R0dgb<9Kf zvxyKp7?F(=hK?HfY5~5%PIC4f@GaGz4tk7N z66j&S898SOjbTLk5rj>MjH;K2-72BZg16Lop)oL-PM??!GY%nq`uDits_Hjf;?JKl z(uL#i$=~fzkw(6-9tm}YNUjZvQ@k_p{dmPbcgL5|+CmUtv#F4sQ!&=PvQ@3?HL(IZ zV8!A^CoL$}*9$H_Nlb=4L?mnZ#+c#^QfEJUhJ zPd5258G2qN-R)Hq5NEiDd?RAI^ddr=ESqg|4|1}`3-{xhtmZfS@63QwbPKsU#?F+R zL|hvbDcN#iY)Ivb4b)r7+vK&mbx!^BieXg}{sv)qECNZ|aN$jE_=x6;@^i-dDm3Zq z+k3i|lf%45segV-$!06hZGPpoTk3i)x3J6a(Nd@uk9C-GxIxdaLswFf()A9Ak5^N-VoQIDB; zLfZaN<2du^G1J*w=Hv`H4_?RqkBmM=UiTLcoADEygZ)XIOi7ZspDvYpq-t-cQ+CKZ z%P*~3t6Xg;lCBSDMSt`CoU}Wjm}F~1RW7k~UM!X7b=A(`qrZ(XudLWe7uIMk_;%78 zZ+|i;q2tMw*Sf!+jWLzpp5{iM~y7>;7*yyAM^LJblc^jg9D5`+Xx+fTwHv zT~$C)Ent?JX#T3GUB0!TE#Q{*nHKX!vpc*$o?B{#Y&h$FbqCIdelueg46~lQRmMk8 z^mqTri0gZHL<`T7Ep7z5VTn^Q!M^YSmr`GGez5IM(HSoa5**H>-*`^Z{d%-K>pA^I zme1C-jcf~;t30*4{&ww}tBTwv_Qa&*FM2day254E-@H3-RQR++{|fP+iZ4)8)}J+7 z=+@@$$iMNN@ul}>QSK@0T`CrwQTF!@pAVz6_5!E5La5)T#7f|l0g6l!PluLB&gQ+) zY5M?C=j=Q0^?k0p3_d;yGR_r03W+RitnqLYD`(%f!}OXjz6Io0Hv`niu+H**pAMXz zdofY(GYumb9G|{@Shap(Gr&_3;!5Xxr$U#l+E`{aIiiUUHf3hyO{LcOP+mu!xCI(q z_@=Se5f_y;l$R#Z?pAlRvi~SUPU?BkDE^yytGjcLRok%#btx{>->M6m7SY?ZtYHK- z7)MWZl&|Kg_K>$a%Ex+Jr0BZ8Xs_KDjcA98wegxaHuQk;!FtWYy8Jfal*g8Fo6Wnd zfMI!;R0ESJ%IR&`A;|nId*$>>XfK~TRqA`L#g^hSi+dfB8j)Teb(`Ol;YX6+Oz{K63&awQ65nF#cuy;R;zhro^;QTMp-vB){ B<;MU3 diff --git a/man/fit_model.Rd b/man/fit_model.Rd index 2fb8adba..56b0a9c7 100644 --- a/man/fit_model.Rd +++ b/man/fit_model.Rd @@ -73,18 +73,17 @@ Type \code{help(package=bmm)} for a full list of available help topics. \examples{ \dontrun{ # generate artificial data from the Bays et al (2009) 3-parameter mixture model -dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +dat <- rsdm(n=2000) # define formula ff <- brms::bf(y ~ 1, - kappa ~ 1, - thetat ~ 1, - thetant ~ 1) + c ~ 1, + kappa ~ 1) # fit the model fit <- fit_model(formula = ff, data = dat, - model = mixture3p(non_targets = paste0('nt',1:3,'_loc'), setsize=4), + model = sdmSimple(), parallel=T, iter=500, backend='cmdstanr') diff --git a/man/gen_3p_data.Rd b/man/gen_3p_data.Rd deleted file mode 100644 index abd45b41..00000000 --- a/man/gen_3p_data.Rd +++ /dev/null @@ -1,60 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/random_data_generation.R -\name{gen_3p_data} -\alias{gen_3p_data} -\title{Generate artificial data from the Bays et al (2009) 3-parameter -mixture model} -\usage{ -gen_3p_data( - N = 2000, - pmem = 0.6, - pnt = 0.3, - kappa = 10, - setsize = 2, - relative_resp = T -) -} -\arguments{ -\item{N}{Numeric. Number of samples} - -\item{pmem}{Numeric. Probability of response coming from memory} - -\item{pnt}{Numeric. Probability of response coming from a non-target item} - -\item{kappa}{Numeric. Precision of the von mises distribution} - -\item{setsize}{Numeric. Number of presented items} - -\item{relative_resp}{Logical. if TRUE, returns response error relative to the -target and all non-target item locations are coded relative to the target. -If FALSE, returns actual response and the location of all items is absolute} -} -\value{ -A data.frame object. y is the response (if relative_resp==F) or -response error (if relative_resp==T), t_loc is the value of the target -(only if relative_resp==F), nt1_loc to nti_loc, are values of the -non-targets, where i=setsize-1. -} -\description{ -Given a set of parameters, and desired setsize, it generates -responses in a continuous reproduction task, with corresponding proportions -coming from memory, non-target location errors, or guessing. -} -\examples{ -# example code -nsub = 30 -df_3p_parms <- data.frame( - theta_pmem = rnorm(nsub, mean = 2, sd = 1), - theta_pnt = rnorm(nsub, mean = 1, sd = 0.5), - kappa = pmax(0,rnorm(nsub, mean = 5, sd = 1)), - pmem = numeric(nsub), - pnt = numeric(nsub), - pguess = numeric(nsub) -) - -# transform continous mixture weights into probabilities using the softmax -df_3p_parms[,c("pmem","pnt","pguess")] <- apply(df_3p_parms[,c("theta_pmem","theta_pnt")], - 1,softmax) - -} -\keyword{simulation} diff --git a/man/gen_imm_data.Rd b/man/gen_imm_data.Rd deleted file mode 100644 index c9ffe007..00000000 --- a/man/gen_imm_data.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/random_data_generation.R -\name{gen_imm_data} -\alias{gen_imm_data} -\title{Generate artificial data from the Interference measurement model} -\usage{ -gen_imm_data(parms, ntrials = 200, setsize = 6) -} -\arguments{ -\item{parms}{Matrix/DataFrame. Matrix or Data frame of IMM parameters, -must contain at least one row of values for: -c = context activation, -a = general activation, -s = spatial similarity gradient, -n = background noise, -kappa = precision of memory representations} - -\item{ntrials}{Numeric. number of responses to simulate for each subject} - -\item{setsize}{Numeric. Number of items in memory set} -} -\value{ -A data.frame object. resp is the response, respErr is the relative -response to the target, Item1 to ItemN is the absolute location of the -N items from -pi to pi for the number of items N specified by the setsize -variable, D1 to DN is the spatial distance of the N items for the N items -specified by the setsize variable -} -\description{ -Given a set of parameters, and desired setsize, this function generates -data following the assumptions of the interference measurement models -} -\keyword{simulation} diff --git a/man/get_model_prior.Rd b/man/get_model_prior.Rd index db90c056..de52152b 100644 --- a/man/get_model_prior.Rd +++ b/man/get_model_prior.Rd @@ -54,22 +54,18 @@ Type \code{help(package=bmm)} for a full list of available help topics. } \examples{ \dontrun{ -# generate artificial data from the Bays et al (2009) 3-parameter mixture model -dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +# generate artificial data from the Signal Discrimination Model +dat <- rsdm(n=2000) # define formula ff <- brms::bf(y ~ 1, - kappa ~ 1, - thetat ~ 1, - thetant ~ 1) - -# simulate data -dat <- gen_3p_data(N = 200) + c ~ 1, + kappa ~ 1) # fit the model get_model_prior(formula = ff, data = dat, - model = mixture3p(non_targets = paste0('nt',1,'_loc'), setsize = 2) + model = sdmSimple() ) } diff --git a/man/mixture2p.Rd b/man/mixture2p.Rd index 0c3edf53..0ac5b177 100644 --- a/man/mixture2p.Rd +++ b/man/mixture2p.Rd @@ -38,7 +38,7 @@ Two-parameter mixture model by Zhang and Luck (2008). \examples{ \dontrun{ # generate artificial data -dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +dat <- data.frame(y = rmixture2p(n=2000)) # define formula ff <- brms::bf(y ~ 1, diff --git a/man/mixture3p.Rd b/man/mixture3p.Rd index 696ac5c1..5155c5d2 100644 --- a/man/mixture3p.Rd +++ b/man/mixture3p.Rd @@ -48,7 +48,12 @@ Three-parameter mixture model by Bays et al (2009). \examples{ \dontrun{ # generate artificial data from the Bays et al (2009) 3-parameter mixture model -dat <- gen_3p_data(N=2000, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) +dat <- data.frame( + y = rmixture3p(n=2000, mu = c(0,1,-1.5,2)), + nt1_loc = 1, + nt2_loc = -1.5, + nt3_loc = 2 +) # define formula ff <- brms::bf(y ~ 1, @@ -57,14 +62,14 @@ ff <- brms::bf(y ~ 1, thetant ~ 1) # specify the 3-parameter model -model <- mixture3p(non_targets = paste0('nt',1:3,'_loc'), setsize=4) +model <- mixture3p(non_targets = paste0('nt',1:3,'_loc'), setsize = 4) # fit the model fit <- fit_model(formula = ff, data = dat, model = model, parallel=T, - iter=500, + iter = 500, backend='cmdstanr') } } diff --git a/tests/testthat/test-fit_model.R b/tests/testthat/test-fit_model.R index 5fe6767a..f80a26f3 100644 --- a/tests/testthat/test-fit_model.R +++ b/tests/testthat/test-fit_model.R @@ -1,7 +1,12 @@ test_that('Available mock models run without errors',{ skip_on_cran() - dat <- gen_imm_data(parms = data.frame(c=2,a=0.5,n=0,s=2,kappa=5), - ntrial = 2, setsize = 5) + dat <- data.frame( + respErr = rIMM(n = 5), + Item2_rel = 2, + Item3_rel = -1.5, + spaD2 = 0.5, + spaD3 = 2 + ) # two-parameter model mock fit f <- brms::bf(respErr ~ 1, kappa ~ 1, thetat ~ 1) @@ -10,10 +15,10 @@ test_that('Available mock models run without errors',{ expect_type(mock_fit$fit_args, "list") expect_equal(names(mock_fit$fit_args[1:4]), c("formula", "data", "family", "prior")) - # three-parameter model mock fit f <- brms::bf(respErr ~ 1, kappa ~ 1, thetat ~ 1, thetant ~ 1) - mock_fit <- fit_model(f, dat, mixture3p(setsize=5, non_targets = paste0('Item',2:5,'_rel')), + mock_fit <- fit_model(f, dat, mixture3p(setsize = 3, + non_targets = paste0('Item',2:3,'_rel')), backend="mock", mock_fit=1, rename=FALSE) expect_equal(mock_fit$fit, 1) expect_type(mock_fit$fit_args, "list") @@ -21,7 +26,8 @@ test_that('Available mock models run without errors',{ # IMMabc model mock fit f <- brms::bf(respErr ~ 1, kappa ~ 1, c ~ 1, a ~ 1) - mock_fit <- fit_model(f, dat, IMMabc(setsize=5, non_targets = paste0('Item',2:5,'_rel')), + mock_fit <- fit_model(f, dat, IMMabc(setsize =3, + non_targets = paste0('Item',2:3,'_rel')), backend="mock", mock_fit=1, rename=FALSE) expect_equal(mock_fit$fit, 1) expect_type(mock_fit$fit_args, "list") @@ -29,7 +35,7 @@ test_that('Available mock models run without errors',{ # IMMbsc model mock fit f <- brms::bf(respErr ~ 1, kappa ~ 1, c ~ 1, s ~ 1) - mock_fit <- fit_model(f, dat, IMMbsc(setsize=5, non_targets = paste0('Item',2:5,'_rel'), spaPos=paste0('spaD',2:5)), + mock_fit <- fit_model(f, dat, IMMbsc(setsize=3, non_targets = paste0('Item',2:3,'_rel'), spaPos=paste0('spaD',2:3)), backend="mock", mock_fit=1, rename=FALSE) expect_equal(mock_fit$fit, 1) expect_type(mock_fit$fit_args, "list") @@ -37,7 +43,7 @@ test_that('Available mock models run without errors',{ # IMMbsc model mock fit f <- brms::bf(respErr ~ 1, kappa ~ 1, c ~ 1, a ~ 1, s ~ 1) - mock_fit <- fit_model(f, dat, IMMfull(setsize=5, non_targets = paste0('Item',2:5,'_rel'), spaPos=paste0('spaD',2:5)), backend="mock", mock_fit=1, rename=FALSE) + mock_fit <- fit_model(f, dat, IMMfull(setsize=3, non_targets = paste0('Item',2:3,'_rel'), spaPos=paste0('spaD',2:3)), backend="mock", mock_fit=1, rename=FALSE) expect_equal(mock_fit$fit, 1) expect_type(mock_fit$fit_args, "list") expect_equal(names(mock_fit$fit_args[1:4]), c("formula", "data", "family", "prior")) @@ -45,8 +51,13 @@ test_that('Available mock models run without errors',{ test_that('Available models produce expected errors', { skip_on_cran() - dat <- gen_imm_data(parms = data.frame(c=2,a=0.5,n=0,s=2,kappa=5), - ntrial = 100, setsize = 5) + dat <- data.frame( + respErr = rIMM(n = 5), + Item2_rel = 2, + Item3_rel = -1.5, + spaD2 = 0.5, + spaD3 = 2 + ) # Missing data okmodels <- supported_models(print_call=FALSE) @@ -73,4 +84,3 @@ test_that('Available models produce expected errors', { } }) - diff --git a/tests/testthat/test-get_model_prior.R b/tests/testthat/test-get_model_prior.R index 9b6e446e..45d35a1c 100644 --- a/tests/testthat/test-get_model_prior.R +++ b/tests/testthat/test-get_model_prior.R @@ -1,7 +1,4 @@ test_that("get_model_prior() returns a brmsprior object", { - # generate artificial data from the Bays et al (2009) 3-parameter mixture model - dat <- gen_3p_data(N=2, pmem=0.6, pnt=0.3, kappa=10, setsize=4, relative_resp=T) - # define formula ff <- brms::bf(y ~ 1, kappa ~ 1, @@ -9,7 +6,9 @@ test_that("get_model_prior() returns a brmsprior object", { thetant ~ 1) # simulate data - dat <- gen_3p_data(N = 200) + dat <- data.frame(y = rmixture3p(n = 200), + nt1_loc = 2, + nt2_loc = -1.5) # fit the model prior <- get_model_prior(formula = ff,