From 69415b25e687f7a5c7b443929f780fe322b0f103 Mon Sep 17 00:00:00 2001 From: kauedesousa Date: Thu, 9 Nov 2023 20:55:27 +0100 Subject: [PATCH] v1.0 --- DESCRIPTION | 8 +- NAMESPACE | 2 + NEWS.md | 8 + R/AAA-getDataCM.R | 22 +- R/getProjectProgress.R | 11 +- R/getProjectsCM.R | 4 +- R/randomise.R | 633 ------------------ R/randomize.R | 592 ++++++++++++++++ R/rankTricot.R | 340 +++++----- README.md | 4 +- codemeta.json | 122 +++- docs/404.html | 2 +- docs/CODE_OF_CONDUCT.html | 2 +- docs/CONTRIBUTING.html | 2 +- docs/LICENSE-text.html | 2 +- docs/articles/Overview.html | 96 ++- .../figure-html/plrankings-1.png | Bin 0 -> 63903 bytes docs/articles/index.html | 2 +- docs/authors.html | 23 +- docs/index.html | 6 +- docs/news/index.html | 15 +- docs/pkgdown.yml | 4 +- docs/reference/ClimMobTools.html | 2 +- docs/reference/getDataCM.html | 38 +- docs/reference/getProjectProgress.html | 30 +- docs/reference/getProjectsCM.html | 21 +- docs/reference/getTraitList.html | 19 +- docs/reference/index.html | 6 +- docs/reference/randomise.html | 2 +- docs/reference/randomize.html | 203 ++++++ docs/reference/rankTricot.html | 78 ++- docs/reference/rmGeoIdentity.html | 41 +- docs/sitemap.xml | 3 + inst/CITATION | 20 + man/getDataCM.Rd | 17 +- man/getProjectProgress.Rd | 11 +- man/getProjectsCM.Rd | 4 +- man/{randomise.Rd => randomize.Rd} | 43 +- man/rankTricot.Rd | 19 +- vignettes/Overview.R | 96 +-- vignettes/Overview.Rmd | 25 +- 41 files changed, 1504 insertions(+), 1074 deletions(-) delete mode 100644 R/randomise.R create mode 100644 R/randomize.R create mode 100644 docs/articles/Overview_files/figure-html/plrankings-1.png create mode 100644 docs/reference/randomize.html create mode 100644 inst/CITATION rename man/{randomise.Rd => randomize.Rd} (61%) diff --git a/DESCRIPTION b/DESCRIPTION index e0771f4..bcff510 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: ClimMobTools Type: Package Title: API Client for the 'ClimMob' Platform -Version: 0.5.003 +Version: 1.0 Authors@R: c(person("Kauê", "de Sousa", email = "desousa.kaue@gmail.com", role = c("aut", "cre"), @@ -26,17 +26,21 @@ Depends: R (>= 3.5.0) Imports: httr, jsonlite, + lpSolve, Matrix, methods, RSpectra, + stats, utils Suggests: + climatrends, gosset, knitr, + nasapower, rmarkdown, sf, PlackettLuce, testthat (>= 2.1.0) -Language: en-GB +Language: en-US RoxygenNote: 7.2.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 9c874e0..6faa194 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,5 +17,7 @@ importFrom(httr,RETRY) importFrom(httr,accept_json) importFrom(httr,content) importFrom(jsonlite,fromJSON) +importFrom(lpSolve,lp) importFrom(methods,as) +importFrom(stats,runif) importFrom(utils,tail) diff --git a/NEWS.md b/NEWS.md index a6af162..6dbb09f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +ClimMobTools 1.0 (2023-11-10) +========================= + +### BUG FIXES + +* Fix an issue in `randomize()` to allocate blocks + + ClimMobTools 0.4.6 (2022-08-11) ========================= diff --git a/R/AAA-getDataCM.R b/R/AAA-getDataCM.R index 845220a..f63a3fb 100644 --- a/R/AAA-getDataCM.R +++ b/R/AAA-getDataCM.R @@ -29,13 +29,22 @@ #' # This function only works with an API key #' # the API key can be obtained once a free ClimMob account #' # is created via https://climmob.net/ +#' +#' library("ClimMobTools") +#' my_key <- "ff05a174-28d0-4a40-ab5a-35dc486133a6" #' -#' my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c" +#' getDataCM(key = my_key, +#' project = "beanaru23", +#' userowner = "student", +#' server = "1000farms") +#' +#' # get in the wide format #' #' getDataCM(key = my_key, -#' project = "testmark", -#' userowner = "kauedesousa", -#' server = "testing") +#' project = "beanaru23", +#' userowner = "student", +#' server = "1000farms", +#' pivot.wider = TRUE) #' #' @seealso ClimMob website \url{https://climmob.net/} #' @importFrom httr accept_json content RETRY @@ -87,3 +96,8 @@ getDataCM <- function(key, return(cmdata) } + + + + + diff --git a/R/getProjectProgress.R b/R/getProjectProgress.R index 070e2f3..da34f4c 100644 --- a/R/getProjectProgress.R +++ b/R/getProjectProgress.R @@ -17,13 +17,14 @@ #' # This function only works with an API key #' # the API key can be obtained once a free ClimMob account #' # is created via https://climmob.net/ -#' -#' my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c" #' +#' library("ClimMobTools") +#' my_key <- "ff05a174-28d0-4a40-ab5a-35dc486133a6" +#' #' getProjectProgress(key = my_key, -#' project = "testmark", -#' userowner = "kauedesousa", -#' server = "testing") +#' project = "beanaru23", +#' userowner = "student", +#' server = "1000FARMS") #' #' #' @seealso ClimMob website \url{https://climmob.net/} diff --git a/R/getProjectsCM.R b/R/getProjectsCM.R index cb4c5fb..f5a224a 100644 --- a/R/getProjectsCM.R +++ b/R/getProjectsCM.R @@ -69,9 +69,9 @@ #' # the API key can be obtained once a free ClimMob account #' # is created via https://climmob.net/ #' -#' my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c" +#' my_key <- "ff05a174-28d0-4a40-ab5a-35dc486133a6" #' -#' getProjectsCM(key = my_key, server = "testing") +#' getProjectsCM(key = my_key, server = "1000FARMS") #' #' @seealso ClimMob website \url{https://climmob.net/} #' @export diff --git a/R/randomise.R b/R/randomise.R deleted file mode 100644 index c04f807..0000000 --- a/R/randomise.R +++ /dev/null @@ -1,633 +0,0 @@ -#' Randomised group of items -#' -#' Set a randomised group of items for crowdsourcing citizen science. -#' Generate designs for ranking of options. It is designed for tricot trials -#' specifically (comparing 3 options), but it will also work with comparisons -#' of any other number of options. -#' The design strives for approximate A optimality, this means that it is robust -#' to missing observations. It also strives for balance for positions of each option. -#' Options are equally divided between first, second, third, etc. position. -#' The strategy is to create a "pool" of combinations that does not repeat -#' combinations and is A-optimal. Then this pool is ordered to make subsets of -#' consecutive combinations also relatively balanced and A-optimal -#' -#' @author Jacob van Etten -#' @param ncomp an integer for the number of items to be assigned to each package -#' @param npackages an integer for the number of trial packages to be produced -#' @param itemnames a character for the name of items tested in the project -#' @param availability optional, a vector with integers indicating the -#' number of packages available for each \var{itemnames} -#' @param proportions optional, a numeric vector with the desired proportions -#' for each \var{itemnames} -#' @param ... additional arguments passed to methods -#' @references -#' Bailey and Cameron (2004). Combinations of optimal designs. -#' \url{https://webspace.maths.qmul.ac.uk/l.h.soicher/designtheory.org/library/preprints/optimal.pdf} -#' @return A dataframe with the randomised design -#' @examples -#' ncomp <- 3 -#' npackages <- 20 -#' itemnames <- c("apple","banana","grape","mango", "orange") -#' availability <- c(5, 8, 50, 50, 50) -#' -#' randomise(ncomp = ncomp, -#' npackages = npackages, -#' itemnames = itemnames) -#' -#' randomise(ncomp = ncomp, -#' npackages = npackages, -#' itemnames = itemnames, -#' availability = availability) -#' -#' @aliases randomize -#' @importFrom Matrix Diagonal -#' @importFrom methods as -#' @importFrom RSpectra eigs -#' @importFrom utils tail -#' @export -randomise <- function(npackages, - itemnames, - ncomp = 3, - availability = NULL, - proportions = NULL, - ...) { - - dots <- list(...) - - comp <- dots[["comp"]] - - if (is.null(comp)) { - comp <- 10 - } - - nitems <- length(itemnames) - - # check inputs - if (!is.null(availability) & length(availability) != nitems) { - stop("nitems is different than length of vector with availability") - } - - if (nitems < 3) { - stop("nitems must be larger than 2") - } - - nneeded <- npackages * ncomp - - if (!is.null(availability)) { - - maxav <- which.max(availability)[1] - availability[maxav] <- availability[maxav] + 1 - - if (sum(availability) < nneeded) { - stop("availability is not sufficient: smaller than npackages * ncomp \n") - } - if (length(availability) != nitems) { - stop("length of vector availability should be nitems \n") - } - } - - if (!is.null(proportions)) { - - if (length(proportions) != nitems) { - stop("length of vector proportions should be nitems") - - } - - if (sum(proportions) != 1) { - - proportions <- proportions / sum(proportions) - warning("sum of proportions is not 1; values have been rescaled \n") - - } - } - - # depth1 is the number of rows after the procedure starts to compare options with the Kirchoff index - depth1 <- floor(nitems / ncomp * 2) - - # in the second round, it is also how far it 'looks back' in the sequential balancing - depth2 <- min(20, floor(nitems / ncomp * 4)) - - # Varieties indicated by integers - varieties <- seq_len(nitems) - - # Full set of all combinations - varcombinations <- t((.combn(varieties, ncomp))) - - if (is.null(availability) & is.null(proportions)) { - - # if the full set of combinations is small and can be covered at least once - # the set will include each combination at least once - ncomb <- dim(varcombinations)[1] - n <- floor(npackages / ncomb) - nfixed <- ncomb * n - vars1 <- varcombinations[c(rep(1:(dim(varcombinations)[1]), times = n)), ] - - # the remaining combinations are sampled randomly but in a balanced way - # this means that no combination enters more than once - nremain <- npackages - nfixed - - # create set to get to full number of observers - vars2 <- matrix(nrow = nremain, ncol = ncomp) - - # set up array with set of combinations - varcomb <- matrix(0, nrow = nitems, ncol = nitems) - - if (dim(vars2)[1] > 0.5) { - - # select combinations for the vars2 set that optimize design - for (i in 1:nremain) { - - # calculate frequency of each variety - sumcomb <- (rowSums(varcomb) + colSums(varcomb)) / 2 - - # priority of each combination is equal to Shannon index of varieties - # in each combination - prioritycomb <- apply(varcombinations, 1, function(x){ - .getShannonVector(x, sumcomb, nitems) - }) - - # highest priority to be selected is the combination which has the lowest - # Shannon index - selected <- which(prioritycomb == min(prioritycomb)) - - # if there are ties, find out which combination reduces Kirchhoff index most - - if (length(selected) > 1 & i > depth1) { - - reduce <- max(2, min(comp, round(5000/npackages), round(200/nitems))) - - # randomly subsample from selected if there are too many combinations to check - if (length(selected) > reduce) { - selected <- sample(selected, reduce) - } - - # get a nitems x nitems matrix with number of connections - - # calculate Kirchhoff index and select smallest value - khi <- vector(length = length(selected)) - for (k in 1:length(selected)) { - - evalgraph <- varcomb - index <- t(.combn(varcombinations[selected[k],], 2)) - evalgraph[index] <- evalgraph[index] + 1 - khi[k] <- .KirchhoffIndex(evalgraph) - - } - - selected <- selected[which(khi == min(khi))] - - } - - # if there are still ties between ranks of combinations, selected randomly - # from the ties - if (length(selected) > 1) { - selected <- sample(selected, 1) - } - - # assign the selected combination - vars2[i,] <- varcombinations[selected,] - - varcomb[t(.combn(varcombinations[selected,],2))] <- - varcomb[t(.combn(varcombinations[selected,],2))] + 1 - - # remove used combination - varcombinations <- varcombinations[-selected,] - - } - } - - # merge vars1 and vars2 to create the full set of combinations - vars <- rbind(vars1, vars2) - - # calculate allocations available to each item - allocations <- as.integer(table(vars)) - - } - - if (!is.null(availability) | !is.null(proportions)) { - - #create the objects available or proportions is they are not available - if (is.null(availability)) { - available <- rep(npackages, times = nitems) - availability <- rep(npackages, times = nitems) - } else { - available <- availability - } - if (is.null(proportions)) { - proportions <- rep(1/nitems, times = nitems) #available / sum(available) - } - - #order vector from low availability to high as .smart.round will favour right size of vector - #to resolve dilemmas, it will add more of the items that are more abundant - names(available) <- varieties - available <- sort(available) - proportions <- proportions[as.integer(names(available))] - - # calculate the packages that are needed - this will round later numbers to higher values - # if needed to fill the quota - needed <- .smart.round((nneeded * proportions) / sum(proportions)) - - # prepare inputs into loop - allocations <- rep(0, times = nitems) - names(allocations) <- names(available) #just to check, can be removed - tremain <- 1 - - while(tremain > 0) { - - allocate <- pmin(available, needed) - available <- available - allocate - - allocations <- allocations + allocate - tremaining <- nneeded - sum(allocations) - - needed <- available > 0 - needed <- needed * (tremaining / sum(needed)) - needed <- .smart.round(needed) - - tremain <- tremaining - - } - - #reorder the vector with allocations back to original order - allocations <- allocations[match(1:nitems, as.integer(names(available)))] #should be in ascending order - - # prepare variables - ncomb <- dim(varcombinations)[1] - n <- floor(npackages / ncomb) - nfixed <- ncomb * n - - # create set to get to full number of observers - vars <- matrix(nrow = npackages, ncol = ncomp) - - # set up array with set of combinations - varcomb <- matrix(0, nrow = nitems, ncol = nitems) - - if (dim(vars)[1] > 0.5) { - - # select combinations for the vars set that optimize design - for (i in 1:npackages) { - - # calculate frequency of each variety and define input for Shannon function, which prefers - # low and even values - varfreq <- (rowSums(varcomb) + colSums(varcomb)) / 2 - sumcomb <- (varfreq / allocations) * mean(allocations) #adjust for unequal required allocations - - # priority of each combination is equal to Shannon index of varieties - # in each combination - prioritycomb <- apply(varcombinations, 1, function(x){ - .getShannonVector(x, sumcomb, nitems) - }) - - # highest priority to be selected is the combination which has the lowest - # Shannon index - selected <- which(prioritycomb == min(prioritycomb)) - - # if there are ties, find out which combination reduces Kirchhoff index most - - if (length(selected) > 1 & i > depth1) { - - reduce <- max(2, min(length(selected), comp, round(5000/npackages), round(200/nitems))) - - # randomly subsample from selected if there are too many combinations to check - if (length(selected) > reduce) { - selected <- sample(selected, reduce) - } - - # get a nitems x nitems matrix with number of connections - - # calculate Kirchhoff index and select smallest value - khi <- vector(length = length(selected)) - for (k in 1:length(selected)) { - - evalgraph <- varcomb - index <- t(.combn(varcombinations[selected[k],], 2)) - evalgraph[index] <- evalgraph[index] + 1 - khi[k] <- .KirchhoffIndex(evalgraph) - - } - - selected <- selected[which(khi == min(khi))] - - } - - # if there are still ties between ranks of combinations, selected randomly - # from the ties - if (length(selected) > 1) { - selected <- sample(selected, 1) - } - - # assign the selected combination - vars[i,] <- varcombinations[selected,] - - varcomb[t(.combn(varcombinations[selected,],2))] <- - varcomb[t(.combn(varcombinations[selected,],2))] + 1 - - } - } - - } - - # create empty object to contain ordered combinations of vars - varOrdered <- matrix(NA, nrow = npackages, ncol = ncomp) - - # set up array with set of combinations - varcomb <- matrix(0, nrow = nitems, ncol = nitems) - - # fill first row - selected <- sample(1:npackages, 1) - varcomb[t(.combn(vars[selected,],2))] <- 1 - varOrdered[1,] <- vars[selected,] - vars <- vars[-selected,] - - # optimize the order of overall design by repeating a similar procedure to the above - for (i in 2:(npackages-1)) { - - # calculate frequency of each variety - sumcomb <- (rowSums(varcomb) + colSums(varcomb)) / 2 - sumcomb <- (sumcomb / allocations) * mean(allocations) - - # priority of each combination is equal to Shannon index of varieties - # in each combination - prioritycomb <- apply(vars, 1, function(x){ - .getShannonVector(x, sumcomb, nitems) - }) - - # highest priority to be selected is the combination which has the - # lowest Shannon index - selected <- which(prioritycomb == min(prioritycomb)) - - # if there are ties, find out which combination reduces Kirchhoff index most - if (length(selected) > 1 & i > depth1) { - - reduce <- max(2, min(comp, round(5000/npackages), round(200/nitems))) - - # randomly subsample from selected if there are too many combinations to check - if (length(selected) > reduce) { - selected <- sample(selected, reduce) - } - - # get a nitems x nitems matrix with number of connections - sumcombMatrix <- varcomb * 0 - - # in this case, get matrix to calculate Kirchhoff index only for - # last depth2 observers - for (j in max(1,i-depth2):(i-1)) { - index <- t(.combn(varOrdered[j,],2)) - sumcombMatrix[index] <- sumcombMatrix[index] + 1 - - } - - # calculate Kirchhoff indices for the candidate matrix corresponding - # to each row in selected - khi <- vector(length = length(selected)) - for (k in 1:length(selected)) { - - evalgraph <- sumcombMatrix - index <- t(.combn(vars[selected[k],], 2)) - evalgraph[index] <- evalgraph[index] + 1 - khi[k] <- .KirchhoffIndex(evalgraph) - - } - - # select combination that produces the lowest Kirchhoff index - selected <- selected[which(khi == min(khi, na.rm=TRUE))] - - } - - # if there are still ties between ranks of combinations, select one randomly - if (length(selected) > 1) { - selected <- sample(selected, 1) - } - - # assign the selected combination - varOrdered[i,] <- vars[selected,] - varcomb[t(.combn(vars[selected,], 2))] <- varcomb[t(.combn(vars[selected,], 2))] + 1 - - # remove used combination - vars <- vars[-selected, ] - - } - - # assign last one - varOrdered[npackages,] <- vars - - # Equally distribute positions to achieve order balance - # First create matrix with frequency of position of each of nitems - position <- matrix(0, ncol = ncomp, nrow = nitems) - - # Sequentially reorder sets to achieve evenness in positions - # Shannon is good here, because evenness values are proportional - # the H denominator in the Shannon formula is the same - - for (i in 1:npackages) { - - varOrdered_all <- .getPerms(varOrdered[i,]) - varOrdered_Shannon <- apply(varOrdered_all, 1, function(x) { - .getShannonMatrix(x, position) - }) - varOrdered_i <- varOrdered_all[which(varOrdered_Shannon == - min(varOrdered_Shannon))[1],] - varOrdered[i,] <- varOrdered_i - pp <- position * 0 - pp[cbind(varOrdered_i,1:ncomp)] <- 1 - position <- position + pp - - } - - # The varOrdered matrix has the indices of the elements - # Create the final matrix - finalresults <- matrix(NA, ncol = ncomp, nrow = npackages) - - # loop over the rows and columns of the final matrix and put - # the elements randomized - # with the indexes in varOrdered - for (i in seq_len(npackages)){ - for (j in seq_len(ncomp)){ - finalresults[i,j] <- itemnames[varOrdered[i,j]] - } - } - - dimnames(finalresults) <- list(seq_len(npackages), - paste0("item_", LETTERS[1:ncomp])) - - finalresults <- as.data.frame(finalresults, stringsAsFactors = FALSE) - - r <- table(unlist(finalresults))[itemnames] - - if (!all(r <= availability)) { - - few <- itemnames[!r <= availability] - nfew <- availability[!r <= availability] - nmin <- r[!r <= availability] - - stop("You indicated the availability of ", paste(nfew, collapse = ", "), " packages for ", - paste(few, collapse = ", "), " but you require a minimum of ", - paste(nmin, collapse = ", "), " for the given items \n" ) - - } - - class(finalresults) <- union("CM_df", class(finalresults)) - - return(finalresults) - -} - -#' @inheritParams randomise -#' @export -randomize <- function(...){ - - randomise(...) - -} - -# Define function for Kirchhoff index -# This index determines which graph is connected in the most balanced way -# In this context, lower values (lower resistance) is better -.KirchhoffIndex <- function(x) { - # The input matrix only has one triangle filled - # First we make it symmetric - x <- x + t(x) - - # Then some maths to get the Kirchhoff index - - # Using rARPACK:eigs, setting k to n-1 because we don't need the - # last eigen value - Laplacian <- methods::as(Matrix::Diagonal(x = colSums(x)) - x, - "dsyMatrix") - lambda <- - try(RSpectra::eigs(Laplacian, - k = (dim(Laplacian)[1] - 1), - tol = 0.01, - retvec = FALSE)$values, silent = TRUE) - if (inherits(lambda, "try-error")) - lambda <- Inf - # RSpectra:eigs is faster than base:eigen - # lambda <- eigen(Laplacian)$values - # lambda <- lambda[-length(lambda)] - - return(sum(1 / lambda)) - -} - -# get all permutations -.getPerms <- function(x) { - if (length(x) == 1) { - return(x) - } - else { - res <- matrix(nrow = 0, ncol = length(x)) - for (i in seq_along(x)) { - res <- rbind(res, cbind(x[i], Recall(x[-i]))) - } - return(res) - } -} - -# Shannon (as evenness measure) -.shannon <- function(x){ - sum(ifelse(x == 0, 0, x * log(x))) -} - -# Get Shannon index for order positions -.getShannonMatrix <- function(x, position) { - pp <- position * 0 - pp[cbind(x, 1:length(x))] <- 1 - pp <- position + pp - return(.shannon(as.vector(pp))) - -} - -.getShannonVector <- function(x, sumcomb, nitems) { - xi <- rep(0, times = nitems) - xi[x] <- 1 - return(.shannon(sumcomb + xi)) - -} - -.combn <- function (x, m, FUN = NULL, simplify = TRUE, ...) -{ - stopifnot(length(m) == 1L, is.numeric(m)) - if (m < 0) - stop("m < 0", domain = NA) - if (is.numeric(x) && length(x) == 1L && x > 0 && trunc(x) == - x) - x <- seq_len(x) - n <- length(x) - if (n < m) - stop("n < m", domain = NA) - x0 <- x - if (simplify) { - if (is.factor(x)) - x <- as.integer(x) - } - m <- as.integer(m) - e <- 0 - h <- m - a <- seq_len(m) - nofun <- is.null(FUN) - if (!nofun && !is.function(FUN)) - stop("'FUN' must be a function or NULL") - len.r <- length(r <- if (nofun) x[a] else FUN(x[a], ...)) - count <- as.integer(round(choose(n, m))) - if (simplify) { - dim.use <- if (nofun) - c(m, count) - else { - d <- dim(r) - if (length(d) > 1L) - c(d, count) - else if (len.r > 1L) - c(len.r, count) - else c(d, count) - } - } - if (simplify) - out <- matrix(r, nrow = len.r, ncol = count) - else { - out <- vector("list", count) - out[[1L]] <- r - } - if (m > 0) { - i <- 2L - nmmp1 <- n - m + 1L - while (a[1L] != nmmp1) { - if (e < n - h) { - h <- 1L - e <- a[m] - j <- 1L - } - else { - e <- a[m - h] - h <- h + 1L - j <- 1L:h - } - a[m - h + j] <- e + j - r <- if (nofun) - x[a] - else FUN(x[a], ...) - if (simplify) - out[, i] <- r - else out[[i]] <- r - i <- i + 1L - } - } - if (simplify) { - if (is.factor(x0)) { - levels(out) <- levels(x0) - class(out) <- class(x0) - } - dim(out) <- dim.use - } - out -} - -# Rounding values to closest integer while retaining the same sum -# From https://stackoverflow.com/questions/32544646/round-vector-of-numerics-to-integer-while-preserving-their-sum -.smart.round <- function(x) { - y <- floor(x) - indices <- utils::tail(order(x-y), round(sum(x)) - sum(y)) - y[indices] <- y[indices] + 1 - y -} - - diff --git a/R/randomize.R b/R/randomize.R new file mode 100644 index 0000000..cda8ce8 --- /dev/null +++ b/R/randomize.R @@ -0,0 +1,592 @@ +#' Set an experimental incomplete block design +#' +#' Generate an incomplete block A-optional design. The function is optimized for +#' incomplete blocks of three, but it will also work with comparisons of any +#' other number of options. +#' The design strives for approximate A optimality, this means that it is robust +#' to missing observations. It also strives for balance for positions of each option. +#' Options are equally divided between first, second, third, etc. position. +#' The strategy is to create a "pool" of combinations that does not repeat +#' combinations and is A-optimal. Then this pool is ordered to make subsets of +#' consecutive combinations also relatively balanced and A-optimal +#' +#' @author Jacob van Etten +#' @param ncomp an integer for the number of items to be assigned to each incomplete block +#' @param npackages an integer for the number of incomplete blocks to be generated +#' @param itemnames a character for the name of items tested in the experiment +#' @param availability optional, a vector with integers indicating the +#' number of plots available for each \var{itemnames} +#' @param props optional, a numeric vector with the desired proportions +#' for each \var{itemnames} +#' @param ... additional arguments passed to methods +#' @references +#' Bailey and Cameron (2004). Combinations of optimal designs. +#' \url{https://webspace.maths.qmul.ac.uk/l.h.soicher/designtheory.org/library/preprints/optimal.pdf} +#' @return A dataframe with the randomized design +#' @examples +#' ncomp = 3 +#' npackages = 20 +#' itemnames = c("apple","banana","grape","mango", "orange") +#' availability = c(5, 8, 50, 50, 50) +#' +#' randomize(ncomp = ncomp, +#' npackages = npackages, +#' itemnames = itemnames) +#' +#' randomize(ncomp = ncomp, +#' npackages = npackages, +#' itemnames = itemnames, +#' availability = availability) +#' +#' @aliases randomise +#' @importFrom Matrix Diagonal +#' @importFrom methods as +#' @importFrom RSpectra eigs +#' @importFrom utils tail +#' @importFrom stats runif +#' @importFrom lpSolve lp +#' @export +randomize <- function(npackages, + itemnames, + ncomp = 3, + availability = NULL, + props = NULL, + ...) { + + dots <- list(...) + + comp <- dots[["comp"]] + + if (is.null(comp)) { + comp <- 10 + } + + nitems <- length(itemnames) + + # depth1 is the number of rows after the procedure starts to compare options with the Kirchoff index + depth1 <- floor(nitems / ncomp ) + + # Varieties indicated by integers + varieties <- seq_len(nitems) + + # Full set of all combinations + varcombinations <- .combn(varieties, ncomp) + + # check inputs + if (!is.null(availability) & (length(availability) != nitems)) { + stop("nitems is different than length of vector with availability") + } + + if (nitems < 3) { + stop("nitems must be larger than 2") + } + + nneeded <- npackages * ncomp + + if (!is.null(availability)) { + + if (sum(availability) < nneeded) { + stop("availability is not sufficient: smaller than npackages * ncomp \n") + } + if (length(availability) != nitems) { + stop("length of vector availability should be nitems \n") + } + } + + if (!is.null(props)) { + + if (length(props) != nitems) { + stop("length of vector props should be nitems") + + } + + if (sum(props) != 1) { + + props <- props / sum(props) + warning("sum of props is not 1; values have been rescaled \n") + + } + } + + #create the objects available or props if they are not available + if (is.null(availability)) { + availability <- rep(npackages, times = nitems) + } + + available <- availability + + if (is.null(props)) { + props <- rep(1/nitems, times = nitems) #available / sum(available) + } + + #order vector from low availability to high as .smart.round will favour right size of vector + #to resolve dilemmas, it will add more of the items that are more abundant + names(available) <- varieties + available <- sort(available) + props <- props[as.integer(names(available))] + + # calculate the packages that are needed - this will round later numbers to higher values + # if needed to fill the quota + needed <- .smart.round((nneeded * props) / sum(props)) + + # prepare inputs into loop + allocations <- rep(0, times = nitems) + names(allocations) <- names(available) #just to check, can be removed + tremain <- 1 + + while(tremain > 0) { + + allocate <- pmin(available, needed) + available <- available - allocate + + allocations <- allocations + allocate + tremaining <- nneeded - sum(allocations) + + needed <- available > 0 + needed <- needed * (tremaining / sum(needed)) + needed <- .smart.round(needed) + + tremain <- tremaining + + } + + #reorder the vector with allocations back to original order + allocations <- allocations[match(1:nitems, as.integer(names(available)))] #should be in ascending order + allocationsMatrix <- makeAllocationsMatrix(allocations) + + # prepare variables + ncomb <- dim(varcombinations)[1] + n <- floor(npackages / ncomb) + nfixed <- ncomb * n + n <- ceiling(npackages / ncomb) + + # make a set of variety combinations + # repeating the combinations if the unique combinations are not sufficient + vars <- varcombinations[c(rep(1:(dim(varcombinations)[1]), times = n)), ] + + # create matrix that will hold the blocks + blocks <- matrix(nrow = npackages, ncol = ncomp) + + # set up array with set of combinations + varcomb <- matrix(0, nrow = nitems, ncol = nitems) + + if (dim(vars)[1] > 0.5) { + + # select combinations for the vars set that optimize design + for (i in 1:npackages) { + + varcombScore <- apply(varcombinations, 1, function(x){ + .getScoreBlocks(x, varcomb, allocationsMatrix) + }) + # highest priority to be selected is the combination which has the highest score + selected <- which(varcombScore >= (max(varcombScore))) + + # if there are ties, find out which combination reduces Kirchhoff index most + + if (length(selected) > 1 & i > depth1) { + + reduce <- max(2, min(length(selected), comp)) + + # randomly subsample from selected if there are too many combinations to check + if (length(selected) > reduce) { + selected <- sample(selected, reduce) + } + + # calculate Kirchhoff index and select smallest value + khi <- vector(length = length(selected)) + for (k in 1:length(selected)) { + + evalgraph <- varcomb + index <- .combn(varcombinations[selected[k],], 2) + evalgraph[index] <- evalgraph[index] + 1 + evalgraph[cbind(index[,2], index[,1])] <- evalgraph[cbind(index[,2], index[,1])] + 1 + khi[k] <- .KirchhoffIndex(evalgraph / (allocationsMatrix+diag(nrow(allocationsMatrix)))) + + } + + selected <- selected[which(khi == min(khi))] + + } + + # if there are still ties between ranks of combinations, selected randomly + # from the ties + if (length(selected) > 1) { + selected <- sample(selected, 1) + } + + # assign the selected combination + blocks[i,] <- varcombinations[selected,] + + index <- .combn(varcombinations[selected,],2) + varcomb[index] <- varcomb[index] + 1 + varcomb[cbind(index[,2], index[,1])] <- varcomb[cbind(index[,2], index[,1])] + 1 + + } + } + + varOrdered <- blocks + + # Equally distribute positions to achieve order balance + # First create matrix with frequency of position of each of nitems + position <- matrix(0, ncol = ncomp, nrow = nitems) + + # Sequentially reorder sets to achieve evenness in positions + # Shannon represents evenness here + # the H denominator in the Shannon formula is the same + + for (i in 1:npackages) { + + varOrdered_all <- .getPerms(varOrdered[i,]) + varOrdered_Shannon <- apply(varOrdered_all, 1, function(x) { + .getShannonMatrix(x, position) + }) + varOrdered_i <- varOrdered_all[which(varOrdered_Shannon == + min(varOrdered_Shannon))[1],] + varOrdered[i,] <- varOrdered_i + pp <- position * 0 + pp[cbind(varOrdered_i,1:ncomp)] <- 1 + position <- position + pp + + } + + # The varOrdered matrix has the indices of the elements + # Create the final matrix + finalresults <- matrix(NA, ncol = ncomp, nrow = npackages) + + # loop over the rows and columns of the final matrix and put + # the elements randomized + # with the indexes in varOrdered + for (i in seq_len(npackages)){ + for (j in seq_len(ncomp)){ + finalresults[i,j] <- itemnames[varOrdered[i,j]] + } + } + + dimnames(finalresults) <- list(seq_len(npackages), + paste0("item_", LETTERS[1:ncomp])) + + finalresults <- as.data.frame(finalresults, stringsAsFactors = FALSE) + + r <- table(unlist(finalresults))[itemnames] + + if (!is.null(availability)){ + if (!all(r <= availability)) { + + few <- itemnames[!r <= availability] + nfew <- availability[!r <= availability] + nmin <- r[!r <= availability] + + warning("You indicated the availability of ", paste(nfew, collapse = ", "), " packages for ", + paste(few, collapse = ", "), " but you require a minimum of ", + paste(nmin, collapse = ", "), " for the given items. \nYou could try to run the randomization again to solve this issue." ) + + } + } + + class(finalresults) <- union("CM_df", class(finalresults)) + + return(finalresults) + +} + +#' @inheritParams randomize +#' @export +randomise <- function(...){ + + randomize(...) + +} +# Define function for Kirchhoff index +# This index determines which graph is connected in the most balanced way +# In this context, lower values (lower resistance) is better +#' @noRd +.KirchhoffIndex <- function(x) { + + # Add a tiny bit of noise to avoid zeros + noise <- x * 0 + stats::runif(length(x))/length(x)^3 + noise <- noise + t(noise) + x <- x + noise + + # Then some maths to get the Kirchhoff index + + # Using rARPACK:eigs, setting k to n-1 because we don't need the + # last eigen value + Laplacian <- methods::as(Matrix::Diagonal(x = colSums(x)) - x, + "dsyMatrix") + + # RSpectra:eigs is faster than base:eigen + # The following would also work if we want to reduce a dependency + # lambda <- eigen(Laplacian)$values + # lambda <- lambda[-length(lambda)] + lambda <- + try(RSpectra::eigs(Laplacian, + k = (dim(Laplacian)[1] - 1), + tol = 0.01, + retvec = FALSE)$values, silent = TRUE) + if(inherits(lambda, "try-error")){lambda <- Inf} + + return(sum(1 / lambda)) + +} + +# get all permutations +#' @noRd +.getPerms <- function(x) { + if (length(x) == 1) { + return(x) + } + else { + res <- matrix(nrow = 0, ncol = length(x)) + for (i in seq_along(x)) { + res <- rbind(res, cbind(x[i], Recall(x[-i]))) + } + return(res) + } +} + +# Shannon (as evenness measure) +#' @noRd +.shannon <- function(x){ + sum(ifelse(x == 0, 0, x * log(x))) +} + +# Get Shannon index for order positions +#TODO check this function!!! +#' @noRd +.getShannonMatrix <- function(x, position) { + + pp <- position * 0 + pp[cbind(x, 1:length(x))] <- 1 + pp <- position + pp + return(.shannon(as.vector(pp))) + +} + +#' @noRd +.getScoreBlocks <- function(x, varcomb, allocationsMatrix) { + + #get combinations from vector of varieties x + cb <- .combn(x,2) + + #get progress + progress <- sum(varcomb) / sum(allocationsMatrix) + + #get score pairwise + score1 <- varcomb[cb]/allocationsMatrix[cb] < progress + + #get score sums + score2 <- colSums(varcomb)[x]/colSums(allocationsMatrix)[x] < progress + + #the smallest available amount should be avoided, so this check penalizes it + if(any(score2 == FALSE) & min(colSums(varcomb)[x]) == min(colSums(varcomb))){score2[1] <- score2[1]-1} + + #calculate total score + score <- sum(score1+score2) + + return(score) + +} + +#' @noRd +makeAllocationsMatrix <- function(allocations){ + + #prepare basic parameters and empty matrix + n1 <- length(allocations) + combs <- .combn(1:n1, 2) + n2 <- nrow(combs) + a <- matrix(0,nrow=n1, ncol=n2) + + #fill matrix with constraints on row/column sums + for(i in 1:n1){ + + a[i,] <- (combs[,1] == i | combs[,2] == i) + + } + + #include auxiliary variable z to the matrix + #this variable will be maximized, pushing all values up equally + minShare <- pmin(allocations[combs[,1]], allocations[combs[,2]]) / ((n1-1)/2) + f.con <- rbind(a, -diag(n2)) + f.con <- cbind(f.con, c(rep(0, times=n1), minShare)) + + # set up vector with allocations (column sums) and zeros for z constraint + f.rhs <- c(allocations, rep(0, times=n2)) + + #objective function emphasizes raising the z value, which increases an equal spread + f.obj <- c(rep(1, times=n2), max(allocations)^2) + f.dir <- rep("<=", times=n1+n2) + + sol <- lpSolve::lp("max", f.obj, f.con, f.dir, f.rhs) + x <- sol$solution[1:n2] + result <- matrix(0, nrow=n1, ncol=n1) + result[combs] <- x + result <- result + t(result) + return(result) + +} + +#' @noRd +.combn <- function (x, m, FUN = NULL, simplify = TRUE, ...) +{ + stopifnot(length(m) == 1L, is.numeric(m)) + if (m < 0) + stop("m < 0", domain = NA) + if (is.numeric(x) && length(x) == 1L && x > 0 && trunc(x) == + x) + x <- seq_len(x) + n <- length(x) + if (n < m) + stop("n < m", domain = NA) + x0 <- x + if (simplify) { + if (is.factor(x)) + x <- as.integer(x) + } + m <- as.integer(m) + e <- 0 + h <- m + a <- seq_len(m) + nofun <- is.null(FUN) + if (!nofun && !is.function(FUN)) + stop("'FUN' must be a function or NULL") + len.r <- length(r <- if (nofun) x[a] else FUN(x[a], ...)) + count <- as.integer(round(choose(n, m))) + if (simplify) { + dim.use <- if (nofun) + c(m, count) + else { + d <- dim(r) + if (length(d) > 1L) + c(d, count) + else if (len.r > 1L) + c(len.r, count) + else c(d, count) + } + } + if (simplify) + out <- matrix(r, nrow = len.r, ncol = count) + else { + out <- vector("list", count) + out[[1L]] <- r + } + if (m > 0) { + i <- 2L + nmmp1 <- n - m + 1L + while (a[1L] != nmmp1) { + if (e < n - h) { + h <- 1L + e <- a[m] + j <- 1L + } + else { + e <- a[m - h] + h <- h + 1L + j <- 1L:h + } + a[m - h + j] <- e + j + r <- if (nofun) + x[a] + else FUN(x[a], ...) + if (simplify) + out[, i] <- r + else out[[i]] <- r + i <- i + 1L + } + } + if (simplify) { + if (is.factor(x0)) { + levels(out) <- levels(x0) + class(out) <- class(x0) + } + dim(out) <- dim.use + } + return(t(out)) +} + +# Rounding values to closest integer while retaining the same sum +# From https://stackoverflow.com/questions/32544646/round-vector-of-numerics-to-integer-while-preserving-their-sum +#' @noRd +.smart.round <- function(x) { + y <- floor(x) + indices <- utils::tail(order(x-y), round(sum(x)) - sum(y)) + y[indices] <- y[indices] + 1 + y +} + +# #-----------------Run an example------------------- +# +# ncomp = 3 +# npackages = 238 +# vars = 15 +# proportions = rep(1, vars)/vars +# itemnames = c(LETTERS[1:vars]) +# availability = rep(ceiling(238*3/vars), times=vars) +# availability[2] = availability[2]*2 +# availability[5] = availability[5]/2 +# +# a = randomise(ncomp = ncomp, +# npackages = npackages, +# itemnames = itemnames, +# availability = availability) +# +# +# a +# +# #----------Diagnostics------------- +# #the only input assumed here is table a +# #get item names from the table +# ua = sort(unique(c(t(a)))) +# ncomp = ncol(a) +# +# comb_balance = matrix(0, nrow=length(ua), ncol=length(ua)) +# +# for(i in 1:nrow(a)){ +# +# j = t(combn(match(a[i,], ua),2)) +# comb_balance[j] = comb_balance[j] + 1 +# +# } +# +# cb = comb_balance + t(comb_balance) +# cb +# #show total number of times options are included in packages +# cb = rbind(cb, rowSums(cb)/2) +# +# #show result nicely +# rownames(cb) = c(ua, "Total") +# colnames(cb) = ua +# cb +# #check the distances between packages that contain the same option +# #as a measure of sequential balance +# d = matrix(NA, nrow = length(itemnames), ncol=ncomp) +# +# for(i in 1:length(ua)) { +# s = apply(a, 1, function(x){sum(x==ua[i])}) +# di = diff(which(s==1)) +# hist(di) +# d[i,] = c(mean(di), sd(di), max(di)) +# } +# colnames(d) = c("mean", "sd", "max") +# rownames(d) = ua +# +# # print d nicely +# format(as.data.frame(d), digits=3) +# +# #check if options are equally distributed across columns +# f = matrix(NA, nrow=length(ua), ncol=ncomp) +# rownames(f) = ua +# f +# for(i in 1:ncomp){ +# +# tai = table(a[,i]) +# f[names(tai),i] = tai +# +# } +# +# f +# comb_balance +# # connection graph +# g = graph_from_adjacency_matrix(comb_balance+t(comb_balance), mode = "lower", weighted = "weight") +# g +# plot(g, edge.width = E(g)$weight, edge.label = E(g)$weight) + diff --git a/R/rankTricot.R b/R/rankTricot.R index 8fe32b8..9ceb0a1 100644 --- a/R/rankTricot.R +++ b/R/rankTricot.R @@ -1,6 +1,6 @@ #' Build Plackett-Luce rankings from tricot dataset #' -#' Create an object of class "rankings" from tricot data. +#' Create an object of class "rankings" from tricot data #' #' @author Kauê de Sousa and Jacob van Etten, with ideas from Heather Turner #' @param data a data.frame with columns specified by items and input values @@ -9,6 +9,8 @@ #' @param input a character or numerical vector for indexing the column(s) #' containing the values in \code{data} to be ranked #' @param group logical, if \code{TRUE} return an object of class "grouped_rankings" +#' @param validate.rankings logical, if \code{TRUE} implements a check on ranking consistency +#' looking for possible ties, NA or letters other than A, B, C. These entries are set to 0 #' @param additional.rank optional, a data frame for the comparisons between #' tricot items and the local item #' @param ... additional arguments passed to methods. See details @@ -31,7 +33,7 @@ #' #' # first build rankings with only tricot items #' # and return an object of class 'rankings' -#' R <- rankTricot(data = beans, +#' R = rankTricot(data = beans, #' items = c(1:3), #' input = c(4:5)) #' head(R) @@ -41,7 +43,7 @@ #' # pass the comparison with local item as an additional rankings, then #' # each of the 3 varieties are compared separately with the local item #' # and return an object of class grouped_rankings -#' G <- rankTricot(data = beans, +#' G = rankTricot(data = beans, #' items = c(1:3), #' input = c(4:5), #' group = TRUE, @@ -51,219 +53,194 @@ #' } #' #' @export -rankTricot <- function(data, items, input, - group = FALSE, - additional.rank = NULL, - ...) { +rankTricot = function(data, + items, + input, + group = FALSE, + validate.rankings = FALSE, + additional.rank = NULL, + ...) { # if tibble coerce into a data.frame if (.is_tibble(data)) { - data <- as.data.frame(data, stringsAsFactors = FALSE) + data = as.data.frame(data, stringsAsFactors = FALSE) } - items <- data[, items] + items = data[, items] - input <- data[, input] + input = data[, input] # get nrow - n <- nrow(data) + n = nrow(data) # get extra arguments - dots <- list(...) + dots = list(...) # if all data is required - full.output <- dots[["full.output"]] - - # check number of comparisons to decide which way data will - # be handled, if type is tricot or if it contains more comparisons - ncomp <- ncol(items) + full.output = dots[["full.output"]] - # with 3 comparisons - if (ncomp == 3) { - - n <- nrow(items) - - # check for more than two missing labels in items - mi <- rowSums(apply(items, 2, is.na)) - if (any(mi > 1)) { - stop("Cannot handle more than 2 NAs per row in 'items', + n = nrow(items) + + # check for more than two missing labels in items + mi = rowSums(apply(items, 2, is.na)) + if (any(mi > 1)) { + stop("Cannot handle more than 2 NAs per row in 'items', more than 2 NAs where found in rows ", - paste(which(mi > 1), collapse = ", "), "\n") - } - - # if there is one NA per row in items and observations - # with only two items add a pseudo-item which will be removed later - if (any(mi == 1)) { - items[is.na(items)] <- "pseudoitem" - } - - # data frame with items as matrix - im <- as.matrix(items) - - # get the names of items - itemnames <- unique(as.vector(im)) - - # a Sparse matrix where rows are the observations - # and columns the item names - r <- matrix(0, nrow = n, ncol = length(itemnames)) - colnames(r) <- itemnames + paste(which(mi > 1), collapse = ", "), "\n") + } + + # if there is one NA per row in items and observations + # with only two items add a pseudo-item which will be removed later + if (any(mi == 1)) { + items[is.na(items)] = "pseudoitem" + } + + # validate rankings, and set to 0 if required + keep = .validate_rankings(input) + + out = which(keep == FALSE) + + # data frame with items as matrix + im = as.matrix(items) + + # get the names of items + itemnames = unique(as.vector(im)) + + # a Sparse matrix where rows are the observations + # and columns the item names + r = matrix(0, nrow = n, ncol = length(itemnames)) + colnames(r) = itemnames + + # run over the rows filling the rankings that were observed + for(j in seq_len(n)){ - # run over the rows filling the rankings that were observed - for(j in seq_len(n)){ - - r[j, im[j,]] <- .setorder(as.vector(unlist(input[j,]))) + r[j, im[j,]] = .setorder(as.vector(unlist(input[j,]))) - } + } + + R = PlackettLuce::as.rankings(r) + + # if ranking validation was required, rankings that did not passed the + # validation are set to 0, this does not affect the final length + # of the rankings + if (isTRUE(validate.rankings)) { - a <- list(x = r) + R[!keep] = 0 - R <- do.call("as.rankings", args = a) - - # if full output is required, for internal use - # put r into the ordering format - if (isTRUE(full.output)) { - r2 <- matrix("", nrow = n, ncol = 3) - colnames(r2) <- c("best", "middle", "worst") - r[r==0] <- NA - for(j in seq_len(n)) { - jr <- sort(r[j, !is.na(r[j, ])]) - if (sum(jr == 2) > 1) { - names(jr)[jr == 2] <- paste(names(jr[jr == 2]), collapse = ", ") - } - r2[j, ] <- names(jr) - } - r <- r2 + } + + if (length(out) > 0) { + messag = paste0("Ties, NA's or letters different than A, B, C, were identified in rows ", + paste(out, collapse = ", "), "\n") + if (isFALSE(validate.rankings)) { + messag = paste(messag, "Use validate.rankings = TRUE to ignore these entries\n") } - + warning(messag) } - # with 4 or more comparisons - if (ncomp >= 4) { - - r <- .pivot_tetra(i = items, r = input) - - # get item names - itemnames <- sort(unique(as.vector(r))) - - # make a PlackettLuce rankings - a <- list(x = r, - input = "ordering", - items = itemnames) - R <- do.call("as.rankings", args = a) - + # if full output is required, for internal use + # put r into the ordering format + if (isTRUE(full.output)) { + r2 = matrix("", nrow = n, ncol = 3) + colnames(r2) = c("best", "middle", "worst") + r[r==0] = NA + for(j in seq_len(n)) { + jr = sort(r[j, !is.na(r[j, ])]) + if (sum(jr == 2) > 1) { + names(jr)[jr == 2] = paste(names(jr[jr == 2]), collapse = ", ") + } + r2[j, ] = names(jr) + } + r = r2 } # if pseudo-item were added, it is removed - pseudo <- grepl("pseudoitem", itemnames) + pseudo = grepl("pseudoitem", itemnames) if (any(pseudo)) { - R <- R[, !pseudo] + R = R[, !pseudo] } # check if additional rankings are required if (!is.null(additional.rank)) { # add comparisons with local rankings - R <- .additional_rankings(i = items, R = R, add = additional.rank) + R = .additional_rankings(i = items, R = R, add = additional.rank) } # and into a grouped_rankings - gi <- rep(seq_len(n), (nrow(R) / n)) - - a <- list(x = R, - index = gi) - - G <- do.call("group", args = a) + gi = rep(seq_len(n), (nrow(R) / n)) + G = PlackettLuce::group(R, index = gi) # check if all data is required if (isTRUE(full.output)) { - R <- list(PLranking = R, PLgrouped = G, myrank = r) + R = list(PLranking = R, PLgrouped = G, myrank = r) } # return a grouped_rankings if required if (group) { - R <- G + R = G } return(R) } + +#' Validate rankings +#' +#' This check ranking consistency making sure that +#' no NAs or ties are mantained in the final PlackettLuce ranking +#' +#' @param x data.frame with two columns indicating the tricot rankings +#' @noRd +.validate_rankings = function(x) { + + ABC = apply(x, 1, function(y) { + all(y %in% LETTERS[1:3]) + }) + + noNA = apply(x, 1, function(y) { + all(!is.na(y)) + }) + + noDups = apply(x, 1, function(y) { + all(!duplicated(y)) + }) + + keep = as.vector(ABC & noNA & noDups) + + return(keep) + +} + + #' Set the order of tricot rankings -#' @param x a vector of length 3 with the tricot letters A, B, C, -#' a Tie will be assigned the value 2 +#' +#' This function set the indices to place the order of best worst +#' technologies indicates in the tricot approach +#' +#' @param x a vector of length 2 with the LETTERS A, B or C, or Tie +#' first element in the vector indicates the best technology, +#' second element indicates the worst technology #' @examples -#' x <- c("C", "Tie") +#' x = c("C", "Tie") #' gosset:::.setorder(x) #' -#' x <- c("A", "B") +#' x = c("A", "B") #' gosset:::.setorder(x) #' @noRd -.setorder <- function(x){ - s <- rep(2, times = 3) #default value is 2 - L <- LETTERS[1:3] +.setorder = function(x){ + # default value is 2 + s = rep(2, times = 3) + L = LETTERS[1:3] # works backwards from C to A to give most importance # to item(s) listed as better - s[L %in% strsplit(x[2], split="")] <- 3 - s[L %in% strsplit(x[1], split="")] <- 1 + s[L %in% strsplit(x[2], split = "")] = 3 + s[L %in% strsplit(x[1], split = "")] = 1 - #avoid skipped numbers - # s <- order(s) return(s) -} - -#' Tetra rankings -#' This function deals with object in the tetra approach -#' in ClimMob when four or more items are tested by each participant -#' @param i is a dataframe with items -#' @param r is a dataframe with rankings -#' @noRd -.pivot_tetra <- function(i, r){ - - # fix names in r data - names(r) <- paste0("PosItem", 1:ncol(r)) - - # get the number of possible rankings - nrank <- ncol(r) - # number of rows - n <- nrow(r) - - # handle NAs - r[r==0] <- NA - - for (z in seq_len(nrank)) { - rm <- is.na(i[, z]) | is.na(r[, z]) - i[rm , z] <- NA - r[rm , z] <- NA - } - # check for more than two missing labels in items - mi <- rowSums(t(apply(i, 1, is.na))) - mi <- nrank - mi - if( any(mi <= 1) ) { - stop("Cannot handle more than 2 NAs per row in 'items' \n") - } - - # if there is accepted NAs in items - # put a label as pseudoitem which will be removed later - if ( any(mi < nrank) ) { - i <- t(apply(i, 1, function(p) { - pi <- length(p[is.na(p)]) - p[is.na(p)] <- paste0("pseudoitem", 1:pi) - p - })) - } - - # add a very high value if there is accepted NAs in rankings - if (any(mi < nrank)) { - r[is.na(r)] <- 999999 - } - - decoded <- .decode_ranking(i, r) - - return(decoded) - -} - +} #' this function adds additional ranks, generally when a local item #' is tested against the tricot items @@ -273,18 +250,18 @@ rankTricot <- function(data, items, input, #' indication whether the tricot items performed "Better" or "Worse" #' compared to the local item #' @noRd -.additional_rankings <- function(i, R, add){ +.additional_rankings = function(i, R, add){ - n <- nrow(add) + n = nrow(add) - ncomp <- ncol(i) + ncomp = ncol(i) # convert it into characters - add[1:ncol(add)] <- lapply(add[1:ncol(add)], as.character) + add[1:ncol(add)] = lapply(add[1:ncol(add)], as.character) - add <- as.matrix(add) + add = as.matrix(add) - i <- as.matrix(i) + i = as.matrix(i) # treat these comparisons as additional rankings. # first we convert the orderings of the items to @@ -296,9 +273,9 @@ rankTricot <- function(data, items, input, # make sure that values in add are integers # where 1 means Better and 2 means Worse - add <- apply(add, 2, function(x) { - x <- ifelse(x == "Better" | x == 1, 1, - ifelse(x == "Worse" | x == 2, 2, NA)) + add = apply(add, 2, function(x) { + x = ifelse(x == "Better" | x == 1, 1, + ifelse(x == "Worse" | x == 2, 2, NA)) x }) @@ -308,36 +285,31 @@ rankTricot <- function(data, items, input, } # add local to itemnames - itemnames <- dimnames(R)[[2]] - itemnames <- unique(c("Local Check", itemnames)) + itemnames = dimnames(R)[[2]] + itemnames = unique(c("Local", itemnames)) - paired <- list() + paired = list() for (p in seq_len(ncomp)) { - ordering <- matrix("Local Check", nrow = n, ncol = 2) - worse <- add[, p] == 2 + ordering = matrix("Local", nrow = n, ncol = 2) + worse = add[, p] == 2 # name of winner - ordering[!worse, 1] <- i[, p][!worse] + ordering[!worse, 1] = i[, p][!worse] # name of loser - ordering[worse, 2] <- i[, p][worse] - paired[[p]] <- ordering + ordering[worse, 2] = i[, p][worse] + paired[[p]] = ordering } # we then convert these orderings to sub-rankings of the full set of items # and combine them with the rankings - paired <- lapply(paired, function(x) { - a <- list(x = x, - input = "ordering", - items = itemnames) - x <- do.call("as.rankings", args = a) + paired = lapply(paired, function(x) { + x = PlackettLuce::as.rankings(x, input = "ordering", items = itemnames) }) - paired <- do.call("rbind", paired) + paired = do.call("rbind", paired) - R <- rbind(R, paired) + R = rbind(R, paired) return(R) } - - diff --git a/README.md b/README.md index 778116d..330683b 100644 --- a/README.md +++ b/README.md @@ -4,9 +4,7 @@ ClimMobTools [![CRAN](https://www.r-pkg.org/badges/version/ClimMobTools)](https://cran.r-project.org/package=ClimMobTools) -[![CRANchecks](https://cranchecks.info/badges/worst/ClimMobTools)](https://cran.r-project.org/web/checks/check_results_ClimMobTools.html) -[![codecov](https://codecov.io/gh/agrdatasci/ClimMobTools/master.svg)](https://codecov.io/github/agrdatasci/ClimMobTools?branch=master) -[![lifecycle](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle/#maturing) +[![CRANchecks](https://badges.cranchecks.info/worst/ClimMobTools.svg)](https://cran.r-project.org/web/checks/check_results_ClimMobTools.html) [![Downloads](https://cranlogs.r-pkg.org/badges/ClimMobTools)](https://cran.r-project.org/package=ClimMobTools) diff --git a/codemeta.json b/codemeta.json index a870025..70506d2 100644 --- a/codemeta.json +++ b/codemeta.json @@ -7,7 +7,7 @@ "codeRepository": "https://agrdatasci.github.io/ClimMobTools/", "issueTracker": "https://github.com/agrdatasci/ClimMobTools/issues", "license": "https://spdx.org/licenses/MIT", - "version": "0.5.3", + "version": "1.0", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R", @@ -50,6 +50,18 @@ } ], "softwareSuggestions": [ + { + "@type": "SoftwareApplication", + "identifier": "climatrends", + "name": "climatrends", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=climatrends" + }, { "@type": "SoftwareApplication", "identifier": "gosset", @@ -74,6 +86,18 @@ }, "sameAs": "https://CRAN.R-project.org/package=knitr" }, + { + "@type": "SoftwareApplication", + "identifier": "nasapower", + "name": "nasapower", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=nasapower" + }, { "@type": "SoftwareApplication", "identifier": "rmarkdown", @@ -156,6 +180,18 @@ "sameAs": "https://CRAN.R-project.org/package=jsonlite" }, "4": { + "@type": "SoftwareApplication", + "identifier": "lpSolve", + "name": "lpSolve", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=lpSolve" + }, + "5": { "@type": "SoftwareApplication", "identifier": "Matrix", "name": "Matrix", @@ -167,12 +203,12 @@ }, "sameAs": "https://CRAN.R-project.org/package=Matrix" }, - "5": { + "6": { "@type": "SoftwareApplication", "identifier": "methods", "name": "methods" }, - "6": { + "7": { "@type": "SoftwareApplication", "identifier": "RSpectra", "name": "RSpectra", @@ -184,12 +220,88 @@ }, "sameAs": "https://CRAN.R-project.org/package=RSpectra" }, - "7": { + "8": { + "@type": "SoftwareApplication", + "identifier": "stats", + "name": "stats" + }, + "9": { "@type": "SoftwareApplication", "identifier": "utils", "name": "utils" }, "SystemRequirements": null }, - "fileSize": "1217.505KB" + "fileSize": "1248.669KB", + "citation": [ + { + "@type": "ScholarlyArticle", + "datePublished": "2023", + "author": [ + { + "@type": "Person", + "givenName": "Carlos", + "familyName": "Quirós" + }, + { + "@type": "Person", + "givenName": "Kauê", + "familyName": "de Sousa" + }, + { + "@type": "Person", + "givenName": "Jonathan", + "familyName": "Steinke" + }, + { + "@type": "Person", + "givenName": "Brandon", + "familyName": "Madriz" + }, + { + "@type": "Person", + "givenName": "Marie-Angélique", + "familyName": "Laporte" + }, + { + "@type": "Person", + "givenName": "Elizabeth", + "familyName": "Arnaud" + }, + { + "@type": "Person", + "givenName": "Rhys", + "familyName": "Manners" + }, + { + "@type": "Person", + "givenName": "Berta", + "familyName": "Ortiz-Crespo" + }, + { + "@type": "Person", + "givenName": "Anna", + "familyName": "Müller" + }, + { + "@type": "Person", + "givenName": "Jacob", + "familyName": "van Etten" + } + ], + "name": "{ClimMob: Software to Support Experimental Citizen Science in Agriculture}", + "identifier": "10.2139/ssrn.4463406", + "url": "http://dx.doi.org/10.2139/ssrn.4463406", + "@id": "https://doi.org/10.2139/ssrn.4463406", + "sameAs": "https://doi.org/10.2139/ssrn.4463406", + "isPartOf": { + "@type": "PublicationIssue", + "datePublished": "2023", + "isPartOf": { + "@type": ["PublicationVolume", "Periodical"], + "name": "{SSRN} Electronic Journal" + } + } + } + ] } diff --git a/docs/404.html b/docs/404.html index 1e38c7a..df50c42 100644 --- a/docs/404.html +++ b/docs/404.html @@ -39,7 +39,7 @@ ClimMobTools - 0.5 + 1.0 diff --git a/docs/CODE_OF_CONDUCT.html b/docs/CODE_OF_CONDUCT.html index 79921c7..089567b 100644 --- a/docs/CODE_OF_CONDUCT.html +++ b/docs/CODE_OF_CONDUCT.html @@ -17,7 +17,7 @@ ClimMobTools - 0.5 + 1.0 diff --git a/docs/CONTRIBUTING.html b/docs/CONTRIBUTING.html index ffb6f1f..ecbacd0 100644 --- a/docs/CONTRIBUTING.html +++ b/docs/CONTRIBUTING.html @@ -17,7 +17,7 @@ ClimMobTools - 0.5 + 1.0 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 5fc9910..67edb31 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -17,7 +17,7 @@ ClimMobTools - 0.5 + 1.0 diff --git a/docs/articles/Overview.html b/docs/articles/Overview.html index d2fe252..670b3b9 100644 --- a/docs/articles/Overview.html +++ b/docs/articles/Overview.html @@ -40,7 +40,7 @@ ClimMobTools - 0.5 + 1.0 @@ -90,10 +90,10 @@

ClimMobTools: API Client for the ‘ClimMob’

Kauê de Sousa

- Department of Agricultural Sciences, Inland Norway University of -Applied Sciences, Hamar, Norway
Digital Inclusion, Bioversity -International, Montpelier, -France

Jacob + Digital Inclusion, Bioversity International, Montpelier, France +
Department of Agricultural Sciences, Inland Norway University of +Applied Sciences, Hamar, +Norway

Jacob van Etten

Digital Inclusion, Bioversity International, Montpelier, @@ -135,12 +135,16 @@

Usage an API key from the ClimMob user’s account.

 library("ClimMobTools")
+library("PlackettLuce")
+library("climatrends")
+library("nasapower")
 
 # the API key
 key <- "d39a3c66-5822-4930-a9d4-50e7da041e77"
 
 dat <- getDataCM(key = key,
                  project = "breadwheat",
+                 userowner = "gosset",
                  pivot.wider = TRUE)
 
 
@@ -154,10 +158,7 @@ 

Tricot data with environmenta Here we use function temperature() to compute the temperature indices for the first 80 days after planting.

-library("climatrends")
-library("nasapower")
-
-dat$plantingdate <- as.Date(dat$plantingdate, format = "%Y-%m-%d")
+dat$plantingdate <- as.Date(dat$plantingdate, format = "%Y-%m-%d")
 dat$lon <- as.numeric(dat$farm_geo_longitude)
 dat$lat <- as.numeric(dat$farm_geo_latitude)
 
@@ -165,7 +166,20 @@ 

Tricot data with environmenta day.one = dat[, "plantingdate"], span = 80) -temp

+temp +#> maxDT minDT maxNT minNT DTR SU TR CFD WSDI CSDI T10p T90p +#> <dbl> <dbl> <dbl> <dbl> <int> <int> <int> <int> <int> <int> <dbl> <dbl> +#> 1: 30.75 20.65 17.67 4.63 15 2 0 0 3 2 5.50 27.74 +#> 2: 29.15 20.65 16.52 4.63 15 0 0 0 4 2 5.50 27.46 +#> 3: 32.76 20.65 18.49 4.63 15 7 0 0 8 2 5.50 29.16 +#> 4: 29.15 20.65 16.52 4.63 15 0 0 0 3 2 5.50 27.27 +#> 5: 29.15 20.65 16.52 4.63 15 0 0 0 4 2 5.50 26.22 +#> --- +#> 489: 29.15 20.65 16.52 4.63 15 0 0 0 3 2 5.50 27.27 +#> 490: 29.15 20.65 16.52 4.63 15 0 0 0 3 2 5.50 27.27 +#> 491: 32.76 20.65 17.67 4.63 15 5 0 0 6 2 5.50 28.41 +#> 492: 29.15 20.65 16.52 4.63 15 0 0 0 3 2 5.50 27.27 +#> 493: 29.15 20.65 16.52 4.63 15 0 0 0 3 2 5.50 27.27

Tricot data into rankings @@ -179,9 +193,7 @@

Tricot data into rankingsWe build the rankings using the function rankTricot().

-library("PlackettLuce")
-
-R <- rankTricot(dat, 
+R <- rankTricot(dat, 
                 items = c("item_A","item_B","item_C"), 
                 input = c("overallperf_pos","overallperf_neg"),
                 group = TRUE)
@@ -192,8 +204,66 @@ 

Tricot data into rankings data = pld) summary(pl) +#> $`2` +#> Call: PlackettLuce(rankings = y, weights = weights, na.action = NULL, +#> start = start) +#> +#> Coefficients: +#> Estimate Std. Error z value Pr(>|z|) +#> CSW18 0.0000 NA NA NA +#> WR544 -3.3246 0.4380 -7.590 3.20e-14 *** +#> PBW343 -0.6595 0.4512 -1.462 0.143852 +#> HP1633 -3.4306 0.4323 -7.936 2.09e-15 *** +#> HW2045 -3.5339 0.4396 -8.039 9.03e-16 *** +#> DBW17 -1.4614 0.4132 -3.537 0.000405 *** +#> HD2985 -2.0511 0.4413 -4.648 3.35e-06 *** +#> DPW621-50 -2.0924 0.4376 -4.782 1.74e-06 *** +#> HD2824 -3.1032 0.4347 -7.138 9.46e-13 *** +#> RAJ4120 -3.0018 0.4331 -6.932 4.16e-12 *** +#> PBW550 -3.2180 0.4269 -7.537 4.79e-14 *** +#> K0307 -3.4931 0.4458 -7.835 4.67e-15 *** +#> HI1563 -3.4131 0.4425 -7.713 1.23e-14 *** +#> PBW502 -3.1382 0.4539 -6.914 4.71e-12 *** +#> HD2932 -2.7048 0.4320 -6.261 3.83e-10 *** +#> K9107 0.2791 0.4794 0.582 0.560486 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual deviance: 766.05 on 855 degrees of freedom +#> AIC: 796.05 +#> Number of iterations: 25 +#> +#> $`3` +#> Call: PlackettLuce(rankings = y, weights = weights, na.action = NULL, +#> start = start) +#> +#> Coefficients: +#> Estimate Std. Error z value Pr(>|z|) +#> CSW18 0.0000 NA NA NA +#> WR544 -2.1327 0.4498 -4.741 2.13e-06 *** +#> PBW343 0.2557 0.4366 0.586 0.558045 +#> HP1633 -2.1386 0.4676 -4.574 4.79e-06 *** +#> HW2045 -1.9125 0.4482 -4.267 1.98e-05 *** +#> DBW17 -0.7026 0.4481 -1.568 0.116904 +#> HD2985 -1.1698 0.4286 -2.729 0.006343 ** +#> DPW621-50 -1.5821 0.4475 -3.535 0.000408 *** +#> HD2824 -2.5380 0.4852 -5.231 1.69e-07 *** +#> RAJ4120 -2.5301 0.4974 -5.087 3.64e-07 *** +#> PBW550 -2.1052 0.4693 -4.486 7.26e-06 *** +#> K0307 -2.3455 0.4467 -5.251 1.51e-07 *** +#> HI1563 -2.3205 0.4502 -5.154 2.54e-07 *** +#> PBW502 -1.9471 0.4245 -4.586 4.51e-06 *** +#> HD2932 -1.5077 0.4469 -3.374 0.000741 *** +#> K9107 1.1110 0.5217 2.129 0.033215 * +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual deviance: 559.08 on 594 degrees of freedom +#> AIC: 589.08 +#> Number of iterations: 15 plot(pl)

+

References diff --git a/docs/articles/Overview_files/figure-html/plrankings-1.png b/docs/articles/Overview_files/figure-html/plrankings-1.png new file mode 100644 index 0000000000000000000000000000000000000000..6f82208cf1b52a7c59632e1926187dd97014ee67 GIT binary patch literal 63903 zcmeFZby!q=*EWo;D2jn7NT`EKUrINZN(@MMt4OzWW1t8EI+V2N(A`}sAT@-*&>-Q^ z-TAH!c;D~$JpX)uf5*3v>k`;Ad+%Sab*^)rYrm6~79%01ASNOrB0-BklqVuO=0HSr zf6KfAsv*>srCuP_%Ya%`iWA ztqZ|fFo4JUjK#SD|D$_N`~Uy>|LO=dKX&Y8K{|KmrZ%Q&`bM1`ZSAbx`Gf9~`l?HI z->m&&)1#ny6V8#6g%xNapOJnE$Ko(;DQavXlJv|%LOR499a61M_Q{9#uk;wR{)j4` z`*xbSThrmUC!PJg_Q*ohN%+w6N8#QbknergKk0CA0j=oyxx@R{3ctTGcx?Yyk1HY- zr}uv)y6f#he(>wlONUqwe*JOhFtUx;%o@EcC*Y)4!7cN>OWJ~z zl9k8T=7%vTHtRwP_=t9);1%)_iM+XantA!QU4A|MMKrO0V~V3}zcO`ea?Ja9rNTL- zYHMq|3$5dO^pLjNdeb2{Xr{H9>Xh4DowYAM1Al(jwmR`Yn{;w>WjY`w_)|f3LPEf%C{g`t^T~1+BURovm%L7sFW6<5c*D$K=7_Q&9P1Suk!4 ziTPOVD)$vx(=E3mS@{_3EXoX%Q@GaTi?Nfqw<>W29-w>ibh$A6LYwD^iewyb{gC>L z{uMv9?L-?|Xlw3)K!}P!B%ggpf2nh+eureGC2yNHn$bJIiO%fe3#302qgnUzfR#Nk6`U0EWG$|=o+X!kTSM&+^Q zm6dDGW%$p}qB{D27hp zlcP3$8?eeVxyoGO4&{^3{f<5x`@}`Yp9G6cXP05p2P>{lC z!8Xc`s&AP3C`N5%+?Qjdkou?bL_AvqV zt!$y5AbaZlONAdTh;MKm!@pTh=C&*u!AP1`zC5NZD@)qq!KSEt#^C|krAwVJkDZ#xaE{%yI&4{qucE#f z{G@Gu-SLLWW#hI4xebEQZX#>>mb`9_pHjdrsUb4W*|pQh2EsMST+)%7?oGiR?bf5{ zUCfdgnw;*|E#taC`tDqlkbb90W|AxaRP+&3#=JOk!gyzE9XUC9y3O3g-%U+g^{_UI21%!))-K>>I1YQOU| zEXA~bU-irObIJq1zrUUCcb?5HC@8=bJGy_cDfJ;-h07+++auPN-NiuMNu~8En(71z z1$KE7Ke>$8QR&Gu(_$gXZBNtUE8W?cR4;ccJx)S_LPw%pKMy*)y-BWuK77XQ*=u%F zym&Xt$mah2mvJ)DX<%j(Ee6WW@t!9qd-BtjQ`KYf+Rjp^PMyNAt5@DK#TRJoJ^q4E z3fzPJkrZ7ilTj9mgo;G{|d+bRMwjTEH*J&4bt{lXHGBP`!zjpGqJ zP0rHhap*{ITB17Ak?EfNVl7csq4ioBc89sg`Sl6Gwv!!3uwEr(WJ0hvG3FnaLX$VLpQm%%ninhHm`IkK8DYlQdSn|3; z*I(c=o8-OEJ4h3eKZ<&PFn$@oxBs<4hG=ZQQc3?ziQ{4~?)>@DKaJt!MJ%&hL)M66 zg+o}t2gaoj zcjmk<{7ls$*sdwiM} z<$OkZrbd~IBf42FHC3nFEzbm>mSOESS9yXXjICFh{7`ymSBQ?=)uLOoi?*&85ZCv7 zt$Y#glQ}Ge5}=@=Nw4xDH>vPAWR8FJRL6Zgx5#cfDTq;}NK3-^%r$P=+49}8q2Xb= zaXfL9$^PSsZan*pJ&fjrCCXdqb1`;yu#^zx{LSyw(Zj(ZAqGZ9Mk^x$GGX{hX4?=m zb#?VzKgY?`eBLH4Xy;LFk;cXdo@{LJ#VW!zxZjs+dt2{e`9ri1%5k=MR!}N}yJgym z!gHutP3HH!0|Kfdoo5Q2CKBUwoL9|Zku^GQ6-}lEget9bQ#aL?)r?YQmpzK$mRs$! zk4CLu;wN0tVn&ug(4HgpGN(pcqatnRtH@2dbBv&$_b?dDlE3@b_frPHT3d5qX@n#v z6@qUbHxSwkMMcIA77`NIkez9H5%KrJHpL39xnONtz^IQbu1`!?7)06zy9h?VA)&m5 zuEXIvc6VlXC%{e@!rDsw@#CSE`}VSW*0XokHO920&C$DC2EJ5$%2a%IieMU8O6Kkh z>~1aA)zu{}ebSFZ_6=-j1SEuUnkD6#^%%p1NTAUzLy6z$f z|GDn06Go|ZYcX^Z;^MMTpMHU6#0k^NX4A-eu{H54$nej)KjhoOBiFz+zDW&t9E4mxnk$pUcb=sT`C=eb4Ke z^DG7gC-Lbzg}Tyw)9gK^&h~{h^$iUW8IM*jAr!2$S;B&28-W~tYtNLrLGE2Fh) ze40cK7FhdS461njPdGE_$u{Q-l?!tlE`kBiU_0ivC#z`u`|peOZ8u~qrMhme#2?K7 zpP2Rj{h7thZDjq?xXit%s;UY_O#+PT#1E}*rh*N|U9%?Oa))dDHNd%Fye-`sClx;B z&6s9MO~Y$5MsI!e@F7Z0(@$)F$~I^C^coW6zDCsOxUG*WP^U{(nCJ(8`ZUJxKG~6~ z<&<&5(I<+QoSexub_WJsI{QLE#Uow)O z#R_qcPVwQbn*<2&y9%ud^!{&;C;O1Ip5+shlly2p+uwIJBr?*q?h}k=H~@fZ)6R@a z$EjKO-QvYJ-3^ff_ZT z22tZv8dkdbS)#ravB_z~{ia1Gc$V#z{POlA=lDN=74w(C?99CtN>GTG9;N=udEcG- zcUWcBm(AI79RzD)%`vwMGyx0~)!o_6H-Mi7m5k$e(M}7sw?~(qv{=N9f5rKRahP0Q z$!sou?DL=^gP+EiHcXJ?Fu^xt-fogc(VF|}KoABW6*}A4Cd?39-M9rJC zR7v2Ize?03y^DyrW>5~h+tw~(V`SNBIecJC6hK@MwuY`Tz-A&GF;Xg)NTeie6G}TC z5hdVkJo59SIsOJ(sjR1+;ImcU-_+RH4(D_98!1ZHhJ2j9*m2jGMkM-FP2*j3& z_*@Pm4!>yzYZK=NFgcPczRZ_`Bk9@tJ8P7$eLfPMy&gKdH|oDXE`2~rh29gHpPy$5 zxu~dPe?B~v)3o!m=V@}|@z&UlKj9YN`lmINLbUAE64T#8SL~*{+w&TTnRUu~yLM}3 z+~nhHl4RiWuzPym)&4ZB=yQ@A?!=th;8{HC_d>QWHBG2xaS4gmv6ioWX|dX{1|Gp; zN-bL(I!$nX_wHR0bi=mt7&KW7KnvV}Jbk!OP>PVO}_TSzxL8L3g>k`#JP0RH{|+E$ApI0^=SA z^q`Ek*5=7LDNGE#y}j8Dn`vWXW6{KE0xq+qs}t|paNK%RfEJS330ZpeOEp3}a+tt~ zh!j}eXpDKuyy!GUKZ1$$G6Ktrot7$?!!Lwm7r~=XR#RHolxb({`%=5D zJwdn557*d&hsT$V-CLRJ`U*aXM`yRjeM{_z|9O)8xW>DfZ}$C2Ci z*u!agV$_a#*?6=r26{xntvVc6}aRP!ej z?7OsUft)%l*eakU>uXM((j~D?W7O zIQORedcDpbrYPFo*|eP-tb9)3v77oN>UVA2rPN{mDPUkeoz>X^9s2>-d=xzwm&$Op zZ*oQ&*tL4XVq_M4o(%DV1S~`_GD@ml=P5{hGTogUptxZ^uyE<}<)|!AjT38Md{|l`l5dZf zi8d}-=)CmYkFzX*4B7z4$>B3-yKbX+HE>Xd9|HrQVN$?vjr!F#HgceE)y|YG;-1%- z^%k^TU4`~VFRVcz$1Et=e^tS5(W!I=wr+Qs>!!3LlaSEBWoGpem&i|_48i}5c4R#t zl`u$YB4mSS;q!;BT+&N%KOer+DMGIG%wKRL0ia`<@@x;{l^s>mG}VS3CnTX6dp;#X zl@N{CN;qiiw!=}A1LfsCU6ILWX#`CXq=9&@p`oD^@Wq_^4Oha2+{;EsM!1Isch+pw5RaNn|(@CSDgb(pXz7 z2Xon*b|OJhTG|ir89mw)qb|*k7dWfFE{0B}?U?~foiG$wv_h>DvUJx847Zv8V|;tXDttcO zM_NlNu(z-N_lb~O=mFQ&$R1lFr3=r~E+7`O;Qjs%=&khm^oaLcRxGd*vx-gN?0BpZ$DJFNoT9U{5JG3Yt3xh$d;gxo ziWAJW>iOnoj*gD!Nk%BXfMcsV_0KsV0A>mhXD|%jnbfwXuC_K4qKbfLg3+uu4q2$H zhp{!S6QV6dL_|2El2dwnHBI`8Y-_hlCw6sVK9S>Lx*~dIrg&Bq^}fEY?p`|HL^~bd z?=Vcl##aCHX9f_3{m0KbK!eE_3sWCoLzvCs?5wOW zL#i<*E7GC&sv1%{4$aQ=6-N^6Cp(zGNV0u8hQHzGU8yI(0R%t)(f*A=x?f31+T(iQdi4um7--2t#@Qw=MxZ&~*k1RO}@ zVKUOeIaoU6%@{%0U5wsMSy^OcGit?R)(QB@+Xr*$b)6tdyyha=I#EtR}X-MVE`JP3`RLVuxv*r|ueTLBF+xIvPURBJal78{=;cYUP_pF7`5} z6?{=|O7-q5wucCV1APchXy1PbnYT4!UWfv-L|UDX9XsX((eh2sMEqoX#*^=LuKd6? zU%d6`0}7m{6u9+-jxCrp$Sx$$+d(*@w61#f>Q$T@Y-2{MfjB8j10g=XV)b;!)*6Iu zTvRt`_!KiTGGg4W5LG-|*3-2cy}KUm)o^tpzkEBD`1ENyqZq8a$QIIqguD9@!eR<4 zoX0w@wYBxez26_MKe$9gqx1U{MA8J@4n)XF9PYHFvQM5o@#QKX&>7W5T+XJIRnRUk zCGP!nOVZrrnYm#UF( zT>bv4{M^~!1~++mpc%%#hykSCFvYMJXJp7i{2CnE?({8sXDL3&j|XVa$Zce~(PXDN zlxiE4GYEwb@yXDkfupvbR&C;6d=HG%7yZVt@$J=tkecB{W#-ZKMhmy$DIvJ_d}#LT zP$cAMU|_&t)i9i5OM6}C*zfw130e%eza#*4)NjxBkf z(|KizfhHNE37nhNoN5fhs&xr%Fa1hhF1lfxLPE(o)@AUDtDFUFGlF=OsYbiX-OB~n z29KcS^MTX9G@?=i0Z}>vv@vdhOR5iV0~!;4xDTP@zhkIFut3fuHa@BSnNp!OhYk8r zbdyT*aC@wIUlGry(y1>1zh*JVP$5EG)PZZHrE378aJNf_E2hzY$Od z_yVK}cT+8pEFC7v;_x@6c|pvxnbDzY;72_Ys#uMo0WFNQ<96s8a#rmW9_v4C4qqU{ zrNnzHCsQ5hwPcQ6pud6fF)rz|#cL@EcECc6*k;zqQ{?6(J;_b-^Uay7^0A^uwvH*@ zVJ)8h|5EX$l^nN0{42n`+vuW+q+}bwbV`%CO3wh`(@6?lQ<=M#qHWK+*L@-)zj;gw z82UU2@EHa?uR5KufSG5Y5^`CyB+RsIZEYF%&GYD1pCPDnbRiIsfo5{<_jlaltw*0^ ze|N&n^5_z9ks7IZ#eo|2Qm0%X1|ZQC(Fe|zKDp751iU{{r+dDkDHFdz# zQ@pr}nToK+WkU3-M4xb)#DT608eLE2JU95SK`)hkuiUh3hTsuxwrnIx^u$I)@*@Av z+A!{}AGLt`G+rsXM!ncBb#W_JGDMlT49G{^8bnY^n-0IP@jEo*cnA>~$K8Bf6Ee(j zeEw*7%P0~>$?uRcIy$OE(Gf)A06hC8I}&wB*5Ea*ec8+*h&_Mm^kl1wj;oRpZK+=U zWrK#V{(=;C4PebBQeSC=)FeH!J=~83)+w|#O-8Uq_p|``$<&pNhTkKjqg`|%n)3H% zi-xQZK&$X;o4_0~j4!o7Hw1$WXQt|omoS`t3wyxWt$g6{3y)ZxR+Mfu%9l= z+rtuzdSubM2M?I|DT{W*AUEihukOr)1W;(hmJIK@~ ze`uD{$T!c0{1}3;kWYa}^u5N@DhM_tLsI@nUFO7t&_Q0A*4UZIj{Qdn58u_4e}URe z-`z;hxNcG4L4N1_$)i&{o3pGuV#MA}^zgMGpSbtXx3KS)TB{U>*lo3Vz-Z{lJFs-m zi*Nn#f}zIdN%G@O=n2f}XjgyX_x$+s(Ypw7oJs9M#5PlkNZ!BYS z9#mTE=N2o$MW6Hbz%<1hcO)mvx-!$3eEq?jz^#ie?9cV%uCnQm!Go1VMc<%YuN!@M zNjSi^9(RTU*tIa|ECklwV`C%nRnXUuLs(Vi=Yp4_DYeO)WDaIe=^y1*D|B!~gsG0p zyl0Qv&55qMAVy{$o@b zJ+M*?+CH|Bjtu_z@wXlIyOR)oq(gMZVw2iuLAPu_?{a|fNS_Fz{n2#+&%hYwkZU_s zE-Wnc;%>`503^He?KG<@L_3l%`}oo2m+hwyU<`>eIhrPM&AbW8=mP&@0PxkE5Cq%h z%MBz`80osw6=Of`rn=RCaE0Mf$Un(d9eM(RyXo(5o=6T0$0~Og3Dwq6)o83MxK<-I>@ygB}MPX3iFB_ z>=znQrLm8NugF^VbrjQ0GwehGS>BCgoNN53%n9MX9YCJKzN!NLiHu?_j=WsOpRC+o zc}tr!c{bp0u4!8mlOtOB_#cf{+w1-uA8i7#tll*FNEY(<8%onEZ!*YT_u}{|OTf=X zyYCeCS$-$EOioTtF_p&TW)b$fMCYdWz=MFCqP5ZkT-z+X9FQYcDQp>nJ6a_&4JI_|rBExXC`uM#sXn zgMN~Fng<4ceN0*)A-~BWnEnbIPe;Y%mIicio9O#1PZkMHx2IA)0Z?>lSd{AB6n&oo z6#1Lu#V5So|0tE-Tx}RyZSx)&rc7Gn-yb+4Io!>0tH?9w2xw#VSB_!mBCX2U!x9~C zbW^Eu#P|Dz=bKjS+D!%e;;LrNYF+%_{W00UQ23Dvi&2^Maj$dq_hNL!(5s0N8TK>1 zg~3r#Gj_og91vWY!Jng^MU39=!BjWq${bJvOkwE<9l6Vz6WVPRWFB`J{p7p$-kt$$ zn$eYQ&;$O9QY0V`hIqhzx3n=zpa=ZqV-T#wyfD{#UG!TsKA;ib;q~8!oHC0GPV){= z6p=@FZr(#Rho{T52Aba(z+LzKGlFy!n za!h@`X-FoiM>ants}aA^{>uv5DC@5p00H>t--U9mG<3PL8S@>!#GK;E7W0@5@uD0D z${UGViHGLrCpuEYomOWcEOq)Txd2Y?Ryuz2e(fkD6H^=DzjS~j01x&=Bf$A$!Qs=B zo(!aNdsxXArgF(*Kw<%JT`QmQvHt{y&z^O*&%S z=*M51kOf`7ofsnhrj%TKLVIgl9&*D@OJgwzLr2AHBMS>YQb=+I@N0vYX9dLcyq1F= zFsSj6UeSB@jC&K}@?Q`ZA&L2K-@aMOoD=W9HBNc#K_5tD=y%-M4H=B$u&1hYWIisH zytH3|ZA@FepBX>XNY@z5E?PM_a~`cgwtZcj4J|-+#?ASyDM4}NAqYeeQ17_-2dMwT zJ?dQsT~}YP;O6GmDYUq-umtg7U5bQIQY3~`vink2EV?dzM>1W7`WWR@scOk?9(Fe{ zkf1LID=a}^-!0((ZGDS5&d{l9l7gj6Q&x0lrd$5dhOV@A<-4?dwP-;5ZZa7oe)mlgT+7cPSd%f60=`6wxuap zmg1``7{_gn&1#z~mvEe0jK5T(z#-HSO}8mV=c(l$bErtT@{L6;#!YrEV!gZFdw=nJ zh>qPlMrja=b-&{v#wbfRO~!BVNZ#+I@7lqxYCGcp(l;x`VH0Te*276(6S0N7j?@Ay zJDxQA-;j+DW9+1@M;$|L)10r1`6CgQe(Vx|e1Au+9uPr$$3xi@XcMwCLw=GQp2ee| z4;3m`TGw4NE$gW4d%ph-k2jyij!u`}#v|VwKh{m-x9@ZSt?}Kbe-dk0~ti zIlF>yOck zx#4}x2tN%+0^jej#C6TolL^q(sCqiWvc(VH*8R^6ABRagsjw?N_&y>x7ZLZjyA%o4=4mcKW;ZuH{ii(nmj?~}RB4nbyRD`|#h`xxKj zPCGg_JW*>HTF`bSZP4J`rLFhPe+Ng-Q{Py)%87oh>z`vnjQ_czBFuW;efclNqeOB( ze=VgK1vOe`{Mp4swJ)I*vR9*D`ks&!E%XubQ+-vJSRaN%}X;vw6{ z_(6l@5$lyeRs6wv%5A&fdOy-MZpGtdq({+^T*i|aoyw-(!^ebP?GL4Jt}P}oDFC*r zUH-MtEq8icQUjn*dk1aDndVx3;~u)mSs0qH7rR}UAN*$k$ULDdn$YfEOv2*_4;1Fu z(2EBsK9Etm^%rl~$oM%JhQU0`M*L7O(*Xi#iTA{=B3+<>Imna!&+Rgs^^I$g^Xgiu zuny%#4sPZl>JQ^@O5fvR=JB^(70mfwaFU4uPUieQ`B^Z?ERItF8uZjxrc%`F@0|@F z8pa)Gzeasb==*<89p#l&XN3VHX>2EUi!(Y{2hGAHisSmm1lYeGC;4EQIR9=ciceXM zZQX_HBpyYWgh7Ldzw<^S9Dy}}Mt{Bw?VC3GJAJf&P~z%X7}Fg|Xby!B%whkU>4Uiki(1a~GuD;(IPZWD^i9`3N`gy=a?BiIS>U+SbOmNH4;gRL zHtE>#^u8hEgVDZ2C*7LO+ofpq20Hqg9TweX$+U}2|8d`G$j*0z#U$(iZh$42T}J~u z$Z_0A=Z}syH8|gs>SQb8{3H5r1_4eU;jIr z2`6CNJ8Gq#6i#7;QBeEOC=6Xdl_I0;#qa+Tf9dbt+g@bbWQD57VHsi93Lhcsc9~|} zyW|JajME_^+WQTrQP|7o_?G4=;4dIKWWq{+=Z+zS9NANnEQQaMKxyV*tffLXv+BUV z*~@a+i&MYj-&PZIyxd11m~$Y!U#5eE4zsJE&JF~oyP<)BOJ93zIfM(T{Ry1;K47x1 z(+(a(p2VaeZ<0SLtT;9^?@(r6e3G{NlNuMgr#J10-0x2{!$!l1rkVXH`?>u|fB@|O zrLq|LzL(ry#sm3vU#2S@LJqbdTz)&S#AlMNe zpX155qja}#Cj+YCB}7=W!=KDrMT#$kKjS7=H@A)3lY&541MHdn_!{Ih#RQ|%>v|w9 zG?8LQlzB5aJ*d4@T0)a?Z)uTuh3csvQIwT^tXuv5E}G07k>Qw!hK}x@T$vrP0FK+u z(|T$ASIt>!e%0IQx`4uQRsf?E$JfMYTyt9S*NTE1r~4)dDMz0AgxV$toO8HjcoJVX zp?$m2*fzBxB|3Z0;dwA*9ltVn{P3aTg*wK_@=pV9o6~vL1ZhSFhI0zdVRJ0Roub*;w@lVQ&<0T}&)ztzfv1+MlkT^pI-DB)2$v=ZyB@UU3 zA={9FEas$nN5;KAPm45sWLT&hS*-j`LOaVkR(X@vU%5(Q&LDnF|{}*wc zkTJqzj~>>hJ!A6ukOh-Aqlt4Qd-8HF2AEcllQFem*iSODu_*vA5rhJ|MjaH1y_ul> zY$4(5rA0H`xzh}6JAr>CUTC|vE1KO%-m|7;JT5$98{`We2{Yo{&qutnqXPp+)TxNR z(BSK6(}Ezk^%fy=U+02!%)lMe$iN=LD(ocefR4p-1u|Odzpup{sstHSvZ4VulBV9* zsK+n}?ZVhvuJnMmc$gQ&p_xvpDbu#{L+Yo9gmaL6_W3+F1Yf~SYF}V~GO%SE?=q}_ z@EYd^ghlKyaOa>+AC!P3^HY8bKa7U7-RZM zYNW|nsJs`YQ=GIetW^gI6Ox;ba#=u6!Wbm#^FZq|PtdqDmu)Rbo<4f`ywD0z;j`CF znm_*=OYIDz_~hO*cLW4V75iY7`l|W@=_Vc&ege4TUX+@Pi;Jg}7YY%kUYaqG2;iVS zlU#Gl1Vs9;e6QU7(niRYi56S|#z(31WGaiuW^NWQ9-XbO!)TPX2YtL){@kw!4+zi& z8X}u-w&WMGPRk#Gvb_(YT74jBwIW{^=~v3GtCVjjB@UYpl$Ex9Y7*M*bwuJmGTbWU z_JYEI+SWRsoXcA&0_+%Do=UoQ9&pn2I2;mU0_U;Q-qCbgjS?VMG z7fzg`&H?dW3!<4Lu=RWqIqeL>9n;;N?Pd7~DVmJQlye;m>S%=Y0(;7$?0;w$g39TI zdRC#)vxy)iZRmH~G~)vqRU|$G^e@GOFHcKQxg%NC_h5ChAVv*G@c~sg4LSQK1jy)d z(_!s~&-TB3dDx&gHNW2&g109%K(wk2l(|M`B04kIPssMxJn0|_dW3GE)ww9y4P_H2 z8-P$YgT#gHiqN;Gf25aU7D78X1pYfY##^R=%Zf|bA*WJV1s?Q!YB)^6>nCy-=7N7VHs-D`5;TB*m(ao+XNy`e=`c=C@EToS`R_da z`9@I!Owvm2?dZ-=cXg$Wp8o>rO!!@0(bz_(q#;l|aXQQm$}jrU2=zl|LVnt505YzW zu$!z`)qumAdU1j}!=h}xx}gCyoBEg(SYWwne2QAf$PpO^+pISkqePk1UYjn@U4}A( z8X9*~AR`%VU6YL}C@1lCMQ0qoYcihNFBEF2g6Z5VHvlv-4W$s7kS8rwtoQ)(5k#Be zy1k5V*EV<#S;7t^Etdvzg=nCHcHUV@d8Yj;uo-Xl!fCkQ@ho5}%Ig}0=U{D@+ zlc{LRO@wiqcK)N0`P6fLdxxT_Pc|*c_Uhc5LghWZ0?3AaMC2+oIzZ5G2DG4EBL`lQ zaWL|qCodPt7Y25BRylZAAp6-kxePMo+?<>o;u>in1J%;+K`Dc14Wo?GD<2Tm!G|1> z(u%E!$4n7ohlhaui)k$f982Wi!dE+Emx@xx5(7Y-wil5fy$Ia#ND&0#dr*m8dG z)j8hbGAJe>COndovaRk1D;{$Wc#?|hU1TFVm?DjQu#9<+D-YKp9VRmJ-^GAfGNeRlA}wdaREfl)=Ka-S{@a3r zW$M=#kgSez8gM*3)>23OI2mMPXk}hiUgT4>f ziO`)ui$!FN0*J^1733tyq}lXAAgUJ+PI#|rLhB!+aveWddbAl(ijvZnp zeN))^EH&+6Pi~grk$!dU|86`A)d~%AyV-s-8KLbQkbV3F(n=pB78|Rx7C_i#H#CfG z&Ql3EwIP}dL|U9{++GI{1WLaPJiM+&`8HzgLRJ;`5D}m&Eko44xx4XW*beY5`=u&( zHM40uDlg(b0qUkzbMiwEDNpY-`J0*JUnE#I4A19S6+`ez@p3=qg4k=Kwln{;77#i6 zzYsfe@^2~x`BnJ6@zCBgX&HBfob9P;lx%n1w*LU8r^2x;%Z{^>I?jOtj za+0B0A}Ctb7#6g~d5sqN@`6`d)V2>UC7z}=&h$Rb(r#Rt`cj$n1IP7uPflr^RMW@J z`g4bzLIs4@HbfNuUUuPMaOizDBe2@|{#LZh^FP;g?Atmi(qk8(YADEh1{=mv^fJK7P#n3W8yscr4bzj6nRQ z*AD3p2)eN0SXR2L=wdpOe999J87xc6@Incj^hQ9iePtelSiyZJRD;cL&t)zi9Xw}UXZx_tMkqi;b> zQbvZ6hYkIbn!iWmT|xtow{SmmTU1t-#a^DQR0|ODZ#zg6Q*jce33pY0iB%jaIbt5eX5gq?mb`UHRX;Cm7xwr%BrOELLx2 zovJ=W#I9?)PfiG5qKYpHPbA3>J5FTD#I5r8bU@@yqqloEaz}3DcQ7Rd^-4$^J+!8k zHrc!msE3nsS=bXc4gujp?;waLTEQmR>B=0m=JR3;jF73ZLK}%uCGLEOcH_T?Co*5$yClsnsqaHu`Fi&=q*s=={ilgY?p9C7zLWi{1?XiqDwzf* z`I-@+_fYVrCb!X$H|gsE?Ae#cc8F+DwE9XD2nz0jeq}&;h`>NZ8^gThz+awA^+oVq zNwIw}b|&uu+#CxE5=7j;Bh&M)3-nPBe+g+&C6E9@9{&j+@eP|EvwV7H=Dl=2)iENE z4{|D;LTy1aqEe^WEs(ncosyKC9O;h~1c3ncx|Yd%t2B@d-<75adsu%H4Ne~q9Mm3l z1J%r+h3cS>kN5&=nSVi5l==RyTrs}KqC6G6Bf5NRl(ikeNrLa>Bl$24Iw+aK7=)-iEx^ysUuax7FvkZK^g-tL2~(3WGaT>c9YW5%;$=b z`c6=fgZ9v8!W}XkKQ7qnO|`YPja8BBv;h>1fp{Vp*dWk1{z4+u_$Vg{m{Xq(fkeiy z3g5-l&uwsw=Elbzee8MnkJS;{G-^=5-Au&QKoA6o2|8z=RtSPT-3WH}9e%D}%U9EP z;*yf;9)0@fcLHJcr+?+E6A*Z;u&=v;Lg^k*8KRi3OkJ@{JI7|urxJ>=*dI$XeSBkA z0EM%`VMTf#yH2$c1HrJd5r~*RkMxlYCVdQAm#i zlM{l{vTavFs>O|sjiGuZ7s5cKtPF#7-=5Urh1l=G#%Z^IvJIM))zm`M3ja_*kp##3 zz~JQ;r?geb*#Xu!gs@IRTDl`ZMlccd*&xhKEGf|hu|pP!PE*s%HY7@&S35xdNZG*d zykgpC*JFmkf_m8m!sZ31(xjxMR)|OfqodP-BuEB{4+A}YqW$}D^CC2cU9avEEGLd} zp2I{HmnZ7tcpz5@=qDY?QNnsea1ltJZbmo7dwUZjrL$1)hP;q~1F!iNiW0;|%i4mZ z(tn4mpA(%#CXm$r&D9d&-eb6&E1(gw?uE!|c-iTdcKsutH%I}ibTDv+91i`kRwEW? zpiawcRz+QX;(a!V8N6z&z8VVPL3JOyxR#`pJVB)ki{usuN4xkvNDe2gMgZNxJ*)|X zTTNJ`vcomkIz^N249NbELLWZnglHbp*%8C zA^v#j0HDyZh+-JeuhgsMmyJi5ePOoEb7C}ARmUQ-L526ZkccS5x9DCGq)H>t0KT?u zwmuSacnu29!fkY5PVjS5sVBZ}cPl6ymcnF^Xa^e-$)f&xbf zqEToiC8hJFo|y>=;vnh>MD;mMrjkVAV2>v{WzcR9U6YCAY#^npi_5Udk5PU7^5q+k{b0ol zTWU~nuHMJNHj;Y&JnQ4Ld-v{9@LNFag!=^V>abWEI7#He+!oZ5%6KHYc%z@=(w&Us zjzCo1D2l!dr(qY!ovR)~x_+bjj5g5>JFFH&{Eu0JX+gx>=Y5A4*V&ER?g(tneaB#d z={5wXyRhzpm<~Ym%U@}>#oRsL zV9zLebIgELUiLdjVqWRNGumi<2)}T; zNB1Uo3Vyw5&S{0wJk&ok<>B+bFiAQYU1X#9G zf2k<`E*|Y%VXLndLGle9VD{ zBBYvNB6Ntp&BOZVsexrevR(wQWJ#~ADY6+Kx^{v^i!|wWl*4_{SD$xZUB5%Hl1QT=KKhn@v?@N22Jp4$Rs5C5DX$ury zybo|l9Q0qgP~k^d1ooeOBsY7DuSVkS>35IcoTHh!2G*;K=WK+h6=bYVP~GedQ+Od& z?88!&(89k%Wd@U$3nag2)43Yp`EB5x0TVHAsh^jvAZ5B@{?t$Wp%QTL8fey8uqM2= z6PK3KH(yMqf`9pE>Jh+DWa+v;w06ytjh+PGRa}ia2j>P;W>&wOmsh<;zB${LsPHvh87&WvHFCIu zTDh z6j(8E9)L1GqLwGx8L`eeM!%|gR%WR+)YQgP%xrtDYCPGc2X$hP982?T2kRvDB#5eJ2YAo}^DnWD*v$;0l4 zh__~0Eyv%ynd&d?;lcg@#eWJ8y5t1rzh&hO4u57qL-jJ6>@OR7iIW=^V@al zg?P59^2>i|58^bDpkFAur@Z`GM?u@!SmLuI1dX&z;53|;TEytuFLw!Tb~U|>qFL+s zBCD?^o-2|cy~~RKcqxvgl#J2RB^}>0rcrcwmjp4@d~XL}3J@3O3rPpZ;tnKv40U*8 zP*ahz7@Q)0^s-Tl8)aC}!{I_|UYi6ch+X=5)8FvthwHe-o_HCWKG0Tg0Isuzq?i#5 zItEJ(tfiyI7x!Ue`ZWq;w;df-I*tOKcZ#dIBznxy#S3J%dLy=a|3FcUvbJ^8FOXoT_v-FGfPKWS;Zoe3RH&10*rS7tW6C zx<4c~BOj?C(SKQ5b=NXQ7XRZ25v`n@ifDAruvKvRhx@x+$G@bdw6`IX_4vUzM})r@U~9xwT~<@GcdW+? zAUb7)8L6t_u`&_{WzZ+2D@gNHsr5{(mhYA##qj{F_>xvn^%9}vI3>JR{c7f&(zZbr z`De@i&j5Q>Q@Ke#R@DB)>blDYRH{ZyzAPoXH%HzL-*^*wbsxnRz{GRswqVf#_ls_2 z{7YF|{NqAu+IxE`dXe}vQ)7WE_4uf;3x?W;bBDctLe4jRV0*?MgGErIt7N3R*b@YC zSo>^1tr_BDFvbRIM|Vb@Ko5?ahj8|l->`d+iz~e1VB*@QPr~C{GEpfxIqVRg-^1o+ z``JLYiO+LhXLm!T4=MtswEbcPNz86MRVcCN_p7!Ru%FS4|Dav&=Gtt%JMZr<4*cQ# zPc`lr(VJXmCO^SmM+}2r1TaeZ6H%}llPQb<+t8t5Y1zv z0h(~YG(y|sGLgdwnelH;A;fAFE~bFuaJNW7obkBX3V_`b7^TFbBE*L2MRF)V$OQcW zvucJg1`1xscqyNYgu9FSpuk!%=&zy`A>x+d{(Ut51JuX(Q}Ug)5{}gssS3-^lyrqCWcC`U{HsW!4BlJWnNkb7IOy(P0+#4iQPz{h#6;Yq=Aogd zP?mCYY#mmxdXC{o6vD5-dj}N6S5H0Ex*A!OmAL#k1u-5(R=V#Udx^Y~Yp9(Y#P4Am zAm>in%CQUhBf?~h2J+IIassCny&|hg&Ctlp$u3-P0g{5 zM=-jn*JZJBFBWD4_F~y@89;eWt<7?~3f>t98I=fYc#jq}y9T^D%z6frHsm`(XNf$x zW71NR6KzMKmTjm#8^P{>rKh|E(+<_1$#NGKF# zCJn}9+}NfDl}s5*84{(C3?ZQj6-v>dk_Ksfk8A6Bp3m=}-&*h6TA%g(KDGC~@B6yX z>l}{rIFD;$HC$3i449p~0b_y*QVfvnRqw^WUyM?!m^NF0rl+!u! zTFB~DNBlYLo~*2m5$i9OT^L5W-S z+YdE%d{b*T(miqa@}EXY^Kt0ysbIIP#$saIR{M{c1Y&qoC$$lXi(w!srh^lwVdFi5 zwvWwRph;xDaia#UJ7L9X$9=1{HjOGRL7Bb&z|Ba(fvTNJ$IHCCKIe_j_!M z?}LMVcUrb|^hbNA^v?EI!!xDtH45T|8_+;3|HPf*w$#iCrnL)&_AYR!mh0#|mRhmm zB&Oe1gEm(U`wN89V_F+tj!MLj$0OaSX4Ye($s24IA-(XL{b=8>6>ZrEmpP7d$w{eI~s3SF0fq^c^9EuaNn{nW+9IqE&qS5#!CZ2%%!uxs+dwc?60L^{~M7wzx zFvT`BK}&0f0r^palYW>HCoNK{tq|Sh)TWAlo`H~ zRk(9R%we5&2OgU!2AGqjt0d}SlKE2-Cn?vcw< zBJbz<9R=`o$#{hn;c20iq!p&F`Rxcei8}Om%NqPDkw3W@sphN&t!8z{m=f#K?fk7j z^u=W@Z4wIObw}C&*C9;kXAW%nsftp)cP0js~rK;(TlrtF0CMpVA z+jqxIln`co$WgsS%<@ z2V7*lZ_czYJ{XaD={j=paL^^B&0!$67*xy8m`^zog^^Xl3#A1iByHUgQ!JyT^e9xXH9XkqcZ$Wc5pE6J|+oNs=c z@ws)TU5GZM`tk5_TK2(+pAii1M|Xl3BMb*7^%?-vBe?35f}E5SXNY1IX%vVa`fLrM zf+1=Q+b`rRcEQ1yT~NpkYg1!CVdzn(or#5uEqpIFlx;QQv^NU1^;bhx-xwk)vvCI( z{jj!WytB=MZQ`Kp>zWU#Iu?mF!ZT*!)|XG#UP%A^!;D3_%?n^EQ~=U22lVbuaHKv& zXb+(VsCB1!wZR^PNGL(#a#@6#m*~L(@GK|cf=GgT>&)NOP6!`k7z%YpMQ;z>bBS&v zy5T+NN011XtUuW?KHs=N)MtYlf@_h0f@2;g{~uEs^Mnd2f;4tp)R}|PsfIz*$I4F9 znJoLvoBUbLPf9dAQlrHkjyM=KU+EW5Hc)|^v%3g_F>&GWN7v*&Kq42A%B#zbL4qtI zOe6P_^!LCNkW^dJOGr;-~bVO3j9z|8_*eDHQSx7p{IC8qym?U#GI}V)|wq zn|ySm^xlkZIH|t!4UxOJHMDktUg4WJyC**3_gVBBkyL`*TMl` z1^Z6Q99i50NPI~M6`P}r^%)kh2VE;`p?w(Srxn84E6I(a4|wYyc#dKZXQQe;K-3?7{N8PT>KX1YK8fT?t9zQPYZdD)#T~b?QgmZx6-U9w#2fnrf_S~(*%r%fj2O4QgT1p7w^FiRXcfG{6J%C3Vh&dyIq z>oKeuN>xJ9cIcZtA!h-PKocDz%Ax6%!Q7gQ{~{cg8u_* zurs#TJ>c^}Z9<-}(8AmiqKJ#|?3AT#paoqhOtQOHy7hSBjMSa1&(uQKZCv~8-zf|i ze^Yv|Tlxcp|dY@Kqys^4hoJj9^7uPN#MQ-!!U7U2KV z|46C+fBX7#f7?`qs(bGLjkN5Wqt)X-bMpV+2?PIJ*v9AYpc;F2NQ-Z_un z+NX-@-M_ML`+i-~$9+8RKpN-1k)zV)_3?Qt-cK<~j%^c_iq2QPzJGpA7ZgSywPfer zL)T;`AFoS;3JmGlVy-~!!IP{)P>g@QacJz{czAjtfU#|6@nL!YJVRaYzK9>&^Z@dw zoSp#!^$Oq*O?mnJQXWD@`1|X#&@cOf23p*~-zXtJ<72m0@%sEroT%%@tf%6cyNe&H zEm-r@FS);I`9JF!+4U2pQ1UC`Y;Ui_|1PH@DM-Jnkv;+vDEBlL^?#SwiAYxN*q%Y7 zf!<0&bZ5ic{OzN3Xv8bn`Zl79#vO-HJ# ztG@tt*#mV#?$e)8XgHoZ{Jj*xU!>h5e#O5}X^A}U4SeS#qACow|4~{Ynb0M|N&0_& z244U2aGUn~y0OVPW2>TpzayEHJns#u;QOD|dHIu@2zzvy|F5ll(g+I-3|zUwu;IT8 zQ&~P#CjE1_qi)b49YUFiV(-D(wXBc*|L2z$%PT5o+g>H`_N0WaDIeyCOjykpf zUGY4c-3Xo!AT8>x!=YeSDe`wI3|^2$MHfv5?YWRejt2i;p&kt3$GooWmL!cKfBtVa z^{5Sc4T#CTC?>$+QTX?D)ZGX8d>J`4X-?G^G|?8(sYTSCsL@F@Mh~DAIh;I5NS^rpCv|w{BqEM&F9J2GLg2Ur^cQ{wWIRgRqRJI^PeHt+3xy$qcs~QU@@92bv zaKqf&8g;aBaS`nch8Ktr;KM(uvLYGWj6M`~&F`?s)~@Vi8%Am-2JK>AO(euOoq=qH zA>MCb5Hr*WDf_# zg_?o?a|238IynX$Z(DL-l)Y=|s)x};bRCVOA_8WEd-7nv0u)V%+AjWsbQZT-kjc{~ zZu*)yLR7ziD2|evUdkKjKEd?AAXk5l2H5VPII_8^zGNui@5~SCfTX#vBBhov*G6;x z!Nu)saD2kn4fN#>!&=aRcHo9EMG3k|Wkbi&jBgK-^jM|0T0N^}}VS~s1uGWd~ z@DG&stDipy5l(do5mKp(kJujv78s&fm$&P})&Itk9s60n{kMmg`>`ldegAVZAMcJ9 zHFN&!Q@gk@F?C8ixF3FXAGTZp30bav#KQt}oEQT3^-c!A=9j*sC9V{`TAagBCBmFd z|A9-dD%(ZxLH+wP1nGvTREz3VvjcgDFk@I#~?RSMkU$=AM>Uyo4c5e zlaqpbGD?q3pr|@z2Rh~BO4#s3cND&tksgL!6C(DrJRCt_GSDRTByzJiNS-Q1nAs!g zFGBh^_d~}BlI%T$WOKIEOR|Tfjp?qfiH0c-OWKAtzk=vDH@Y0{UYgfb{^q}LrVNI^ z8#Ng{J&3&YZApXAea-~>b?p&qFN=^Muh_!J&323L?+|`u5=d@Q^k=}oQ4}#l!)E-i zA5EB^4j{U;U|iT?8qcTQkkR$ufGJHRfANcNZY|u1qNh@Xl|533%s>ht^D z@;Pgg5KT2D!mLE^XOJ2_&v0%R;RV}bd-aCk=t+g>lP%t>N;ew? z83lz*sh1NI+vZ;4ow;=%-8V(Xo9Ir3vX>r1ni&7^ad(s8Z=jj1Tz39^jR+HaEPWN2 z=l)uXKvp6VKR<$f05f8jXeGq-NcZ&s5#XnB+RA_jS)U#ILH@IMajA%5U4W|QPRLRz z$}W;8-r9mwUXqm|F25Ow-aA4__e;RuDhHq7zqN{{zj7W=r11{uu9Kl6`a?Puf=xvu zqO_^)?poY@%=9pIYYWVj@Cb<-BHfA?v-?aj9-e!8FVHjJ5trh39PI~lH!;@x&Huhb zPQ1e}|Ai?Ex6A#bu6>eh57)yMtdO?i>GtSA?-P`YX!QntOgz zGze*h=qt?aC{@-uPu#I4CWn4UkzRj4_gkoe2-eT}CqnKRq(;u88{;zSG2#&-%@myK zHepX~#SGg!8M9S?uQW2clYXU}ACbRVx(O&z>4xy{w{S#-ISuNM$W-#p>FL9$qY8wl zfgknL?ZlBp=f2U_KDtre>OAI-7mU{Eu$tYpKl=-y+m9fu<83m z>=W+7jYa9^uH-(}#+_j%$a|`PU<&X#q9CGY^g|cEKLv9XAr1WqBL zGZ-A=4#9<=8^Aa-qwTtTS|rsGp44J)&p`6`pFKl4!M6eDoc}bNatL&CCuT zyKlbY)S|Cy;GPgF6IVZWqYENeKVfjAU-pQ;d+N-vE<_{yQ2?Km9C<|SI$meU*V9v+ znG?GEt4LC@;gt5^oLis=&!o8C(RG_pgxg|tYOOvY(Vfsg6wbA9u8>=*0~2i{A3+;n zE2h!uInOMh=Q;xWjoFbEMKEW1IJ(XqA;cOebrpf1KulH*+W>dv684N4WN}&Q?YWPh z(8%^Oz(*yd=pV%$fm^zPcoHztvT}13%&(47bx6rh1fv5;;tI1KFFJqTiUyMMJ}q`W zd&DWfR4`o8`kj+3B^A-u`hX&GSO9|CwhgQl1Gn;$l1+e{edo3xR%0z&epa7 zUKlwK$PEKj%|f4u@*b5#xNlOk9Ku^4)r1OAqe7V*nj z-4VZPP=`6iJ?57ePDT=I$gp#8u%w|1@z!F;1|@mYU&FjX4AV`Cm28Ri{WuEEydTj> zVFiRQlnDh2f?~bkCHN4yBr*x05V9HM4bhfxmhXu#jT{96QGlk*V=A$)99emJTa*jn zHGSIpLxS5@^7N@Eg) z{8`^J&Beyg?V>8w^|xX(Uc5St7rVhr<)0+6?=lcZa~qB?ImRnJ`xET zk+*C&ZOTKwE-n2rG#J;6eP7k3cn|E#b0`9akaM)}6ZWbinim?4vniyjM*JT8OQ=lS z;i76dePb?HQ6Yr^Al4!xDrTKFijA}!BVbNh{>TFA=^=96U!V$5}x15 z_%R4K#B+e8PZ~^6kiSNJzEtdq6TgAx@`9b zFgX4-T0AhtPYD})DV(g@?=9Ep3yr^&XvgPSxm}F8|7NL?#ma4(ma2Fx8F;SU|Kz!< z>%p4?`4YXd^YE>MRHntQ8EVGs;Yy{=;p#7w9OMU~!~^Up!}#@_YgtEb5RMks-xac` zZXSMUJ-Sq1I^{2xfC5536u@Xo|ri~1yPhD zf>`*EGU7(Tl@C1yah4LyoRpJey2kL?(7zdUvN9-l8B%?=h8@T)tsg-lfDlke(lC_x z5bZ`;Y3X$!UjAJ-a$&T9z^6ZrBm-=9V`mK9e})9{ZnT}=fYLy0@zzu5rY;5*w*+ha z_nY9rNF^jNvTE8j8wFlp!uXQWvFTOgYrgJK(t8=8G|LCs8{v=jfm?s!UMT7O= z-|%OLD~pl@Y7T4qLgFu$9mE5&V{>W$^O0u&v$o_jJR|n`7NgfNWs;18eA-LjVfd0m zNoi?%P}uZR9u9o-D&p8L9Ask$^8Tk3c9ajTpzeHmc2sPL?jsiy1eY+Lao|fQti=q$ z&+D|y{+ImkhOci!K8C&_C9+O<^{!;V+2=q;y$m|#+-^35emD_F)M0T#BI%ZoDEnrh zvf!N{7AXseFJ`VWbcEt@7roSsbf?fu2xD_|^8{kn!EXx52@>?kG%83h9+z3rt><5( zYN|xO2mg}^y$K5%nq4aq4X~}w&n4s1zgd*#k{Z}^$m@!0?``Hh5{76X?9-L)4HAr; zlF}9WLrf|4HO(bedqCPGd4Ouf?}Lx6M^&)QtI4ntIj92%&DIR=4kT^zmemfN` zT2q`X^biE}xfs@k+85?WK8t<7i)<9C8uCmBw1MaH3QlCVmdN?0Dvg=k{>j!2#xRd} zZ}bi{L~>c^x0G@6WI4d;-Dp@1L2Z@pGO(=KkLi|@mL_Me z(2lhtrN^IM9(BjHw)hvTN-L5jV7>j!%`dOKikg2gfRBI+x9&sX0~luE-~7(N3Z}6h z=V93+zRsoi$Duz>q{<&5RQc#|IK{&x-r$fm@U)JjC$g8sF=aLAP&x&FfWngH*6(+_OqZL7N?ll^^UXZ9j8qyc3xf@Psk%Bt zHAFDNX?#912vv1;z0eu2T7px1n0N+zeJ@!V=}x3nU~lBZ;nxMcOiZWo@}`#_TkSa?iI=Pn%W+wOFmwME8&4bi z`K^L@u7|0(goKT8K!6J6>xgu|=}Fuw%fR#m{m%PSkb~owI4a!=z)*~mcI=pp7CUZH1)da|i%T@J$>ZEXFD5-F=iE#kcDHO=TztG$ zdPud)zJ2>{n|C-3cFZ@(R$8`<()5e*A`hcnmPG*8L!w1kD?n=Zqly$n_b#fD@$zv% zy)T8^_3>7-j@CB49UGI>Vm~flL4Lf%nyII!r=zp;ChW|k9gCo%xnji%99zgUfBt+t zPI^LRb+!B>%>xGxFu@EYY+D(X>=$u16l!K!d})#+Z$KiyQ)1PsOHO0a(a~JE?RYDU z)(TT90wmEE!>$AtD0e+nSo1c_6uU&ck;zTKF66tQDqc)|Z+riP>dA zz@DGrwU02^)|Ll48;3MLXWO#=VM#s~te{sQOv$Nk8CfnYm_N6ut{}mzHnam_V#fJW zHkxFe`B+(52OdApxxXR)Gj3UE9qe|~MHjuGSG|TIi*Ui1tAP{qkzd9ljk`^j$)d<+ z2ZT__;GcDoMV3wK0Z<%x`T3c*ZQCYUEGZ!|h#Ec?wSQAf%i54dDz@rXOq*VgzI&Gf zWuQ)~A$FJFn&00f39ANB#tx+7RbyB`D7f6jiymAG8j-u7wJ5kKa+o#Axjpb%yB%^Nv9>+u*g71_jlQB>!m)GRD1e`KukgyTVCva;-NkGK5( z{kvp)qdsU2=|IP{#L0R~3WVJ*K|&-RnW$Nmi z@xI*Y?~5!t_}1VIF&VLy*vSp1V-e+Iv18Nqp<*5h5WNAtL9&t46U@xb8Hn>T+h8=F zEFX5;>&cTRqwn8Sk$Z|`JeN4Ze2(g>s}ZvNe0&n*EirA}xY6pgt`NN0+$DNze@uV< zirw5TNfBEtm#NKc(#(;h34`J-V0zT+b^tZ<_Q6YKiw6EKeMVkJrU@(Ghr>0kj;k;mu_c%%#CHskPf|sa;Bh;N6M+2T zFG?ibg6>yMvMzEtfKTQFoCyPGbEm2JYEMZWioHJRDNV9zlPCf7)q30?q-hhV)2u=P zAz6q`WXrR7@lo($#nsgXa6HI)ERsilERXcc#n5~fJ>UbVWQV8c(b(8|9=mqs!^yS9 z!({nz+JI%qyebObw_PIs@gQmgZLu|Asya1?L^%8#kJQ ztYbNpmDM&pEQ&lWiic5IS=nSRNK%EIx5PJkYW%crC9x;rvKjA5eSa10XM zZHs-c@Q8}e&$6%||2U-1{lqH;1`*UMz-?SKK#st6C%i@jKJ3wTD8iYV9>0n2l+@5z zj8=FP-h29q6NwPE6IWGT1S)`mpWmg)FqWc~Q`rwr8_MhIE`?aTmIFx@(tBV8;qy{V zY^RT2)2}J7$DK@jM{I=0OFs<3%4oD27NVQJ;NU^1l)dl}EcwmPJwYsZ*zh$CfT#y2uP!O|jXJ zVo}_}>%Gu_dv)*J-Lzn$q1F*c|A0OpE{3a|dcgbnWaGS8AF zNx(;Ca;fq09ymg(8HdBh;C$B(s*yk>vkNUBR6(yNb;`&tcbe{(!U9%2W{Qc9p8L^w z`LKk~fzvO{lLeKH&bg00e?Eodq~vnV_CI|1umpn-C`DNJ?AbHuk9CLzEp-8!3oV$v zhp*#oVpKA>-n1zako-@~>QohEmf^?3Q}=`D$!}(aXEM34SyEb>nKDWuI(Pd1W2)YK z$RC3A4}4_H7cFEbbsy%sHgK;X5|fyVfIt;6uczk=QueJ0J zclQ|5!uC0BY@7-@pVsxwA9kP8-ER}6iZ?p#&DqefB$+D;i+pn_M+2o75ILsvcu=Rw zeL0353b!r*!(Z*DA|XM$fP+Q+f`hX}VmcInVrB1fLLWXV<5*5%VPQbTJ1lPv8Z0F0 zamA1;I*}_vQgEqOz&!ghI|d3&Nf-xtQT!ra?sam??YSm_XXmvyLHK$p>`=aWCDRIJ zF&uGYj3-fst{QQ=W(+=k264z^&8;z!Lumr=W(`PAYyBWxwq8(o#nY)U z!ynB34hC%Rm)Vn@jN?IRBIm3yhRaGZHZjRQs30N1NV(+RK411Yap&DfEQ)So9`cJY zfDsWmWz)09ov>g-JitdBwUPB>DTLtxh$tc@$Djc_6FtX4h(;XZMr6dP(Y7H=t0>6L zRN)?3re>~fF1BF%*ui-5Ys8*4bPrv00B*4lsro4@<}`1DO6%(BdCpI6=Tc2SN{-U@ zHdKG|L8mWWx%!?JRn?a-x8eew3e!W6AA?*KVGO=j za%T5b4f7V?sM>~qVg`Q?Y^u1Wvy%g|x(At3x!O!ZC}j;mMw2l7)k(E32HM6*fg@&? zFK--K=x!~Qyk z;|vs?>ZY0|o<4obyKrF)BC)xJm*7ye&pOVAKTgf^v5^)+OV>Snk}$~6N_fM-0n=$T#wAOZ z1igPEL`t%wM~_a%^V5*sK3QHS=~a(MR_tpNr>;by3z(RqoS_be*bg3XN;_#GKAC1lTRO}A0 zTmV~+?sm8X^l?K~x-f9OphDJn94-jEudHjBUEZ;H^M8Rx!r4ogcz_9Lbj-r4JEjpT z%!6m%JD=ZnWj+W}gcg55%1dq#3csh`lPbjO)FQ`6Hl zkt0~A`yen}!W{Wu1%&c?;1@M!>InC^%-UcGq? zM8Zz85LLvMy4%9MdOdin9;VAABo=OVa!LkO0~;-Rv=nF%)AUmGo`rR`xeS( z0{PRn`HP){Bm*T9FoBE+ysXrxPoH9{t5+Kt86j9yk?~H)ORfw^xsj#7!0Jez%*KFp zbYQ^msk9IaX9LvR1j1IYUQOok9Jg(2X>Bd)9>X0`D2>0qEyo57)>n6`I=~J9o;en1Z$8 zig1X-8^QlFMfnzQwtuqO(gN|S@ZNi)y>g4o{`lO@vndS{^@JOMYz;$QqZS*Um^W)9 za8}->OOqjSfDB?|NUjQGt$C5MPEAeqddCb;lSBg~5b{b;pRS#|IwB`AA8cQ|WX_v- zj2YnLu5e?5kdT;^p>#fqaM**xxX8B;9y-KLjLxbFaLTUAjJ|*4N0< z@t6zeyw61|S>X2#D#`6{A#Mtiz$r~l2H0-V*lzuUj~}~(Bn;D!!w*CPp1Fy{0$69? z0Uu-Id7$Os9iBBH@tkN%#;2sTVvdd&Vb~BO5%)!LnLGZmhS{OW!QK1rU4m$g-|0+z zsi~r{WRL-P2}S_1NSly}2c$RzJYa#Pp(mn789gOzY|;xA>Y9BcqIeA|vv12IDn{*X z02rRNDfRpO${OdMH8(dK_R+nJ?$k=A{0R2>^G!BwN}Ci!g6T%;SsNP)p2LGnE{g*h zHV(N>6M0#Qzx8|FFO8!1EX0)(dtL(bf}tQ-5i#4u9uzCa<48JS1rj2t(F*G7u*CNx z=aQ+cXp17FEIE6R_AmwC196}~-E1?NT_Oeb<76a)H}Bk8|FNDpK3)7Wagj{;6y7Gi zEH~aZYJXKP<{>Bp{($FVV`Bw(5`U_42$pRQD$Xq&wZ8o)=vq|;f>v&B5=h)u=wMZZ z%m`Z0bocH?cxM%90CtGXMjjr8edDTa7CUf-hJgXcZ?m&Ius~G>X-9TMP1`B!)fa#>N3i1L2814jQqMB)Hd0 z6*Gux|WTHTz$R>dA-r3FN1T!J;;5AZP8xCL`Dm7PXA(AT`Oq8b~hp?n+WZjmvy%4Ed zDY}q1eYU#ldC|gjE?t0l>aZb?3w4A3>fpil!ocrKvS5g&VG4mtG-m+0tm! z;n5*CC5k)@y|1-iUL}SaJy7!#adLL{|NV16>d8LW2|6C+gY;?&69)_wh_T6NrFhpJ z`k{_Bsy`MP-(iJ-FRrI20+s!#&!00zjw*1GTlU}&yS%t{i2q8Q8~hg34k)fCS%{xY zBu5xfC@2ima$np)r9^;VQj28HwxE8G{GrFgdz|DWI3E-;Ey!SQdw2B1wwJf`BPahs z2b6^@JUpa)e0@n0h2o`)8pF&fFbcsZXdlxuXa8&&mO$uMsiOG zg~&cxQ%u}zw3J*L;(-V?!@uAiX?&Z7(l!C|WS6uPr@4g>ASVVYfdTmpH*DFRjg?=j ze^9XLSFMxEJQkLlPoIjQ4DCG|VD6by$fUbv8n z@(O~w5?9Q^_V3>T0KpL>9nE*wBT*%@&9F^ZSQp-q{qExa;%9IQptl$RsRWdyC>?|S z@8~EP`Qv~E%-K6IG_)N~PkHYXO}I@)#J%OxGBRvfNY$Z(IIC4q({CBkaA+keQ6eW) zz4HfV6A&$|t*x;WT98N+GrmuN6jG6EX>Hj(-*;r2@5y;v29D;ykwEwJRH;ol@_r<- zlEe^?*AYOFf{#mUv0J|!2f&3h*8rYc-Z|^6T<&ZrpA>SK4id>}%wa{HdCn_47?siw zq8OuTHv;|l{v>^^>GAn3tKkNp;YD@ay_@4gPd2sYP)9i?RNv{F4<6J7mY9SLsRiAF z-2!<3*cp5n7j^T;-IeeGF~&{4QU)&b*WDV=XgD&xm>GFM8jzE0#0939Fi|d5Jr8m8 z2>V$ok+B-5(veBi5Uv=E1PPzsKQ8oQVuE1b#^D4Wv9{*b)zz&tqQ>(G2*e>qxZN+Y zrtg^Jo5~+}4L4|=4u2y{l0vfFo?th9!@Oo1RMG~P0=REMYL@~7X&wJ|g^WU=G8?#l z;7Z@P6wKZIkF&)0b9s5oexl_G=W?7l4Ugp{D4?c7vjVpvKwvg4R9m1w+%j$*4}%JW zGR}F2#W_}L{l0+ZrzduTz8e6~YSwx#Q(2FubR_09&ASLlZi^lw3uWr#$MoD-1%B9H z03#zKMaF@&z}g@UIYdQ8QE=Xb z5L>c3&|!NkRFS0V(Ew3FtYqIBFO9`Gpl;O-c(<;^u_OJ!dLT zAt4ZH8j;_f(u#x;z2ERYPMe!SLVz_N?br&^2 zAIe<}fAWD`#ETAVJSN;&P^B58P9YTvGLPF-b7O(ze-?^3MkJ3@#ZC6K$iC+|mil2f~rjvwuDjX90)w9V-E*%}6n9~Q4 z0#IJmc=lqrivz^>Bw#OQU9O6;Jm0_!SOqKuVtN9AhYUd$m_n}~iSSxr9A#2y2k>tf zGBbYZ4*SHcg+S!AuW-!~TVL@9_k-TtXQ%i<&tehC@EhEP(Ip`(h;%q>|0D_kWl-FK zq~>?NLiS>cEAs$h*WuVAL!vOovlx)z`UM54zS<9*&l>nl(A$T1@+KabBHC3#zyYq< zyvucd#r8%jvgNbTt#YjLV8?+1(SSpCU{^zRVd2s&l>mw{gxj9;{! zeS>kV9 z$#E_W_9A;y2dY)(Gha+U8Go0ncK{6x2|4_*CNw*B2r8U-#~)NyiUBmk)_+e8^c8cd z^{$IpF#zgd$xPjJGHO6t3bRX@U71~}TmRyhK_hQ3Hc~N!af&K}CwD02Nq0k12Cp*L zI<+XUDP84uE1o96Y_aOgSFWv-EkCZHdHM{=MR@91u=HGyC!wQ|KxQz(d$VDPv{l!( zEKHxZM6HiX$a<%zBJ(hKhkP40Y@qib)?G#Qn7Joc@mDwsE31^0NyV^0M2i$4rBzl#U_aDN#M;;Z~mOrSHp5fF(uEc!PNm*dWWkU0 z>`7r`+upr{t_fRE(%iV z7k5h;0lSFD8i4d@Is94t6VIYWu>dgNsx4o&D(w$7z9TP|r!Mq^=nP}O_2I+%kv~G; z(%w6csxhdm|5VrQgz;1!oDCqgD7-1KnUD~5 znbr;*F{3TE4>cm#2p@k~8M9o*;RioIMEq%ikKkRjNJ@u#`^Q8u_iJiny_ErosXI+q znFDKY0q*9H_9ut$3I9*y>xoT*^kiUXm&vejvlYgI$Q;C9{PlU#qd%PJVM5yY>`WcJ z3^to=8cJ(91UOYP(k9w^^*BpCn>D$WkS-3`Quqewiz zvm2=;;H-AkY{=9kM7|&krI6pn_3QuvNoZ>e+ZJ2xe{o|m>QU5IOpx{b(X_jg^wuCu zW(f21N4@H9vRr}_VnC!eu@OLgt>UsCT`4Db6T6yn%q42Efq7IYTsJM_7*)=`%oRA4 z_Q*I4;89##8nn|Gja+h)6{>P*N`W&2lpeO$3U97hK0P0X{NiJW`0$w(G zlc~Kuq1ng4Diha15^?$BTj;LTGY$3aG*X z&?17dJ57~k0rwjs5g_2pXGFuwAFia{`}pyrbf|xKuGT^v7uyO9Hd*L+eD@QuE*YMT zT#P)~N27haw{CeC-X5-xZSHbADgTDmWxbf}q$E!5kV&@7TT@V?by3}IP%j)oqL(bH zCp4Ww$=m@hlC{zj@K5lGL z0@FXk)aq(ug#ysRqR}8l^Dhzlr5#jvJCLjhN1Cgj@d7ONm{#C&lwt%3!cWH@JvxTT zjCE*&F!b}K7r7r`Q4v7oEVQp#A5*$GEUK}(a>0id6pPB3YA5>z-l^{3tO`jD_l@Y2 zg^A){jHho0`nW8%38s+<@E}LEdIjNo6yWG65E;-LT#R&n+xt&T^}-je`Sm$t%U5Xf z*P1{-kdkL}LGyu^s-TJo8!R{p$8rfzHlQXZ-4K18HZm|U;0hXAs?S>kF3Vq~+70OK;-8I_LLAmeUnZ)e5! z3{TaglMlcq19@q6kZO!KuwEqptHAsjv{o=eHo_|=mP%qGj@vMXRtV|AqlM5#H8I|` ze8q}$M&*Cv%|v}q#w9lNm9I>WJ9>19R7RzD;2zEg*?S?_Om-Y_c65tUQ18pCq=qmw z!+|c+!fj=f>!zot3qq6-9_$&}PY;nr;f3abpBA1%~(I9mI$`Rq$&&kPIj1F%C{A4roTLd+dMs0Z^Epf_QRX8>-E+5!4(tK;nfYHnU zZ~?TqgjD7o`u@2Ys$9+$A9r6Kn&fOi3oSAxhKWE!2n2)vi!h=r%LR%KWfh9FjJS_ds}2>6)V*zlq50UTpz(i0mzx`*g=RIQStF?gnmPzAeW~AO)sfROi5vO{VgAMy`kX} zv|12~EkYKp10eGpx8Dx0yy;qq@1Q?0-c<*``Q>T{bD(_exP4o;x~?49m>e`%l{i*N zNk~|N#B}^fr_E`l6pBj-p(`1Qj)W`V{HlUY(n!^hHvoN?fPlwD zQXxc881aiLU3a8vR&wA-3~{Z5X`E5WhHMVK;Ik;0Y*bXe`{yBQ8ez|F$kmKO@CAkX zFolw<>CXt)Yhq@`M&L+5SMHEmBM<%a*RM*q)t{~rd-7nzIQZeI9vsD;6sgPK1;}{;U4O-)}s(A=w z3=}BG8wT)|m0*3up)nT1bqX2FlHjGh$3@>I9;9c8B`OFSRxVgH3V|LX!lUi5D+ok!)jjIeSfcDU4>O2&exEcJ$U|NPu=y5J1_GiD z`WHIZc=1B^Rt@@38X&@S!RVLmqI+wa^a_ z_jCg_riY*Ii1BVAq=mKwKmH-#%Q~eOhnH+Bh!RS(g*}-QC>*DZne1fameGsht4# zv(r26E^PgBb`18tO=0_urC+~(_4D&HfCG3oI=ZRCUJVEzT1~rtt=~qiK%v09Q5*MQ?qGTTN?`szGeh<3;l5fS~w|p^d`W3mpc6OqbX3>Ecvx? zJtS$y-TpkgJ{(YM4AFR8|Ckft@R>8IIMRm$7}udmf1EF1fHcz|(Aqp^W+7P-djYz| z3owItX`x3BB%pL(`BRY%dJw>tj{vuu0mX;pax63&1$wv6&TbJfqiBra;R(v%2r~CL z0jb;stN}fG2_>Zk7}<=|+bP6L7Ys$maE1Re=MHa_Bf5m!{s z&_v|~06WvGjHc#1zdsMd(TH(3wZjoCf<0%}q=NNZEi(lvI&PGcv8bjn-^&GvaxlHK z2z4lNj9AX2Xn~9ZRztLpx_D6uh-(~F4M<&3L|wqn-V9+wi(dx;RDdj+jQ%T1pfyv) z5eT289LvniG^Og{N>@YPCF0N?4h-DM{>hLkdjaB@{Vsopx2SFe^$%)-xz%)Cv?Gt~ zv0h9PfLi5-NKk}M94`Z?db&6?$i%9c3QS5$& z^Af_b3DcLbJh!==6ouE@5N1a)^@2XrDWlR7mFIfbJp^)db9wmrzYH*b!0c`e0F*pr zPbO9-se#B;X(Fkx|9#W)G|1m2Vi4B+qOyyNOZdJwgtUNBr#zG!uZFMdknR*B`RnVv ztQ1riH{0SqJm3}TM>OUU6#O=D%_P3#CqbZ4;uig`NClVOuaReWLe1T`s0zYoerl-0 zJn%)g-#=$xJt)ta)Lec62`i!QKbx313Y3#Tq-<<#23}q=0PTYH?*ek@ynJ+?_0CX0 z|DZ3t(%XxYoTKn;Ct!C8n^;sF_<2$dFfg&mRJj?lBdk9tw{JnMB|7MNMVDoP==qsr zsJ&f5jNu;&iisEfjJ?BPP_OPRCGjcq)TtEWa)F-+T+1)Rm{5s*xd15gq)RgBFWLp> z3cRnNvRmw=%<{Y7_z}u5Duly-euXyROmqMnCx%0hfTgHcb8a4Q);j>NFNH(FNo87b zwi7g737cD_5k&~|U0s|=6E#l$HbO_6NDgn%^F0R|9XT%9H4u7_>o3~NA*Ue40S;e^ zhgzhc>1GKg_%zc0p&a|^%xdhRSy@?$zae9ut;5{KHl-HtwV{=fog2q>2UQ^88yxm7 zZ=rtX;UnZj+_{MzRizK!1S}3)>AQL(Efsg9Qb#z-(1fJCpBW7f4b90lTLb^T78O2m zZXGv+Hf`cTiDz-T;4H~=w_fHz(Y#aiExa5|VFySaCD6Xc?Zx7Mt~k~j)PGek#r#e( zXd@#hXN0xpuGKyhZ*`_tFQ(}0$OB{@0#vazL;zFp&|dL*fOrydcLi8*q}?V^k6jh? zY7!ejCB6Q%zA%?`e~H{0knVQRIb=)w{S!Neof%JFY9uKoh8hE+?tKz}Xkn z3Gu1#S-5DCN1CqjR-Y$k9yh6?dUS_@Fcx*?%9Tk??Imiv7ooL5SfKC@om5*z(0&}R z>=hx+1~{|AqM~Nd(NPM+{7T%g8^G-Y^M(mNrx~O|(LqTia5ZsOfCw4WLE{dh5)_;p z)dX9c0wf_RC3S1G)lKQVlh|w_;VKHSwA}krI_y*>2UD+Lqlao`YS`QBCz>*~IBLIV@|MRsM zya3penhGtfdZ#sSF;3is{5~E=sz3D+&h|O{WB8Y61l&Oc`O;(XS(Ahnj50kQumoPBj<-bB=f6qyuew2y&#HEB1wq@oa9NbB?ELxUiBAo!W)Yocmn%QJAImp z*{7RBLqle-6>Q-!5W1`(Pw}V@y^Ce=%NUU2kS=e4ExGR8*?KKzkyI>wZSXeqr$0e9 zn-D+AEDP$Od<3lUQxPy*624JpCn6Qj2RuY7B4KcVkynnPP4sYyALrDtw^*xx7LE(WTCjCKM9%zhMg9g{WLXUAzLhC|;jrb6Uq21e5+t&>!mA_$^ z^ws&h=V}F-geK-xtZ9WnRHKgwHceGk>-+rA*m^#=N^C;=r*~@k2AFo6& zP8nzX`2*8J^V}-hq=5I?vuDzcNnPQnj|*RfF3|Hq4}~#O5Qh~{%4GE;TrpF~5)WEi zx$N3iEV#fxYrX&uvXZdO)SP{Y725yJLIl$9A2f9Uk1A-lD?nSrG5 zXfl69x6us>YE_cy$Ds?x2?1~>WKUdT`b+7}4V`<%1_gbi2xuhVRNQ`p3;#+IXh^-R z16Hu;ZG=@;7lMGLx_$pTByo6@xMwZ1aeC?XogEzp_y}5i^){(mNXjt{a>@6xI_Ut% zzs?MP*~yQ|H{4$ReRmXSsjwo_Q~?yI+(EiDN4H*hxCbW}YLoUVz+qvjwL39f6$u?l zb~3(VXxQwYdgygg&Lso}$1PjL6&2?L5^Dp#l1vCqd3l81w9008*DBARTosLBIgAzo z_8|iepnl0`uPf+VhHf%Rh__T1TVMP`NVh=MF>=#_B|-=!Ih91HIa(-NKipydgX2rG zexhl&Cunkj@F8B_cxYQ{C%AeS7jn2*e)-L=kUSs*VQ}8PRXZ&S>%t3VM19YCkB9Rd zrurp=-VNDPct8Tm$Ao>|wQHP|=co>=3S`MC-;9xA=q#e!v^x9D86{F{f-oXYVe|C# z{0IpX2asjfOn*b&n+Uo-;h39}7SVH@W5J6=jt?F)aXdLSbumiOm0z4cpq!6K9wc)j z>V>R~3=akzc(>L1@FFdhfTm()z37$13pJ+XC3d;LuZwn2tQdW;9^As7Kf_O-JmI== z!af^00qw!2tGdXQ#X&aVR+&MtDVf=`l2YNLnulGU^Zi$-zdtWXyL`JZe?RLFaxp)| zH6mK!^rZ{cx5M}kxT<+=NyUaBY%)PzQyfK!6-&mFk28H@W?@N$hsge}5h)H-&9(so zL#aQt2_IcyTdfuBJ*H>y;`YV>>RzH{f)%4H#V{OO%?F!6!+4pp zGB4Jp9YKQBK$uoD3sG$)?L7*J&PSjyGca)M;hM*!#XQ^~gfIg>Ax-3{1sU)H`(q3) ztqrUKGMaG^DszOUjiIq9WGy-8lbvrI)S?$h8!jOh$6ULnLqI`tyDWFZP{YBfxdBDW ze>n#DJ0EX=UW#LMB*v5S{*M)o)cXJu!dd`1P(kd)IrYFy6U&eC(~ch}aQ-vkrluH_ zyxs2W|h%Ex5fRZz4k+Xqd zkyDX_k|YR7j)FO$q#{|wMsh5RoDn61AUT7Qp~$Jo+;zIY@8OQ|zuYnI(_atWO;c2z zv(Mfu%(d2>AmRpKQ#~A81aX7Ij>+E*a4nCVgr;938hXw z1FqvF8^Ci?4fw!Wv7EdO^AD}T>lc@@l3-d4TBCh-z(vagsL)K*fD(&5eAXmrG)^{|65%No9i%ie+j8*&c(6T0WS{HDa5#c z=<(#qMQDe_uNuQ$Q^ChlffOb!Jl$!-d6*P?@a&O;_kZV&Zx}Gdts~O%@;^qW5+gyzQhBJi4mGtuu_euJpVMMxbGk%?tm$SpN*TGy(K(YPL#BS&&UP&ZDVtnoK5kS@CfLzAU zP*6|^+sF>U=o8R^-iuEpK?uH;FbU>z0?q}Ey3B40L;-yL#8%nswEV_52R1mq|0Xjf zXVL$a8n6S<)$5Ru4i*@YW?-m?=gc>8s!|A|IrHY%8u#zNo9oMs1y+GTO(%>1H}@qd z%|kOu!IXU!gkji;R=CihsMmi%>({@ObO5-LotOZcou9-Ph^+6Qttf{fp(=qU|GjyR zmp|~GHgzC}V>Agg3)>`T}iSZ;@)>4w!*@m_?}r zzbJS2?zcZIU_*Z<+2es=eq2TH4*=D@e)$eV6&>-!QN{&e@zwz8j@&(5hBag6`wF%T zW1Z9uE$@J1*FJEanVpR$8YY81HHQ$!93t)scu3QZl*yeoa$w9iWA*{MMGb89lYGY7 z+trM#e2OgnfB;hL>0V(eXbon%g6UaEa)mDRchDj>cj!)9UA?*U;&0SnG+ulk0SG@D z2av|i=Q$%_O7+ys{cOOSs34YN8=ZQ9}T-hny4>Zg_qBNs5dcc_(E5EK*yXycn&GYjbbR;{X@h0aOJ z$}u2ojo8~u@3eVUP_S{YgN2jxK2iXrJbeCOF;QIk`zgFJ?`l-8RL!FkQpG3WbH9@pr&_2pH-~;iL z!=^HrlVkBe+I>WTNC*ko!s6nL*WZ8{P~1#t1s8t9DFgO^CU~%_S$J;&48evVX6#FG zF~9dAD4qIFNg=Kr0>Yw!Vux7dk)ofA+`2`utjr71Ojf|`c!#6(e-+&XLWfIt7e~sp z@wB$eL!nGa70L6#xDS!)7~h80n+Mf@H_*Nci{5_)~#VelQgjlO*28HDg3nMK-)seq;f>X?mj zh!%~z0;ior&Qq~psciBAqJ_6)NvYC+IY0h_>?+dNYl`JEz%NHLq|q*Uq$3kh^^y6E53fwd4A@1qlOAo%}%|5 zRJ{zy5}C~ELD%p*$u@12s16KO5D{GmacIklhn8mvX`js}aPw5cM?jiJ?alz@T>hoV z*{wBzBL@wjmb3wiL=teWT*0K!Y-|lci}MC(YKkL##~T9{A>tuY>+b|1ck2(zzr^4w zDe%zO?0Xg_Bd1~d9A^8o=cG2j=pQe5G$s~c4S?P_Kg$rDJdnJJe8b{v3Vhd3x#$eFCL zgh**ETXy_FG$%DDA$%Jv`~Bux9P9%zXs369sOmQoxweD2$r2RJx&}*~lQ+Op`UXeG z$1g#cyT3lP0*h=eH6<4U(b4XuerNjh($ax>P)1BYmhSUi>V>~GStdzeJSX-j-d(qA z_z9E^D}oV8A)PW)X8(y(PCm}hMG0W($2V@x012lO$$Fo8b9Z&U6r_axM&BTVPY*lZ z0}vw)Rn>K2e(pXc0lpgO9BQX30>Z&O&fl&7BESm`Ai9=)z=Ycv(&_ZFe z^>3(MxdP-e69**M?T|mmLF1zY;7`s_K$wPpS+SB4mk+Z808qLg9zTWaYX`Rw4__hy zX`3g+)L}aJ-phsPe>X>jDXSZ7N6U-;-Gxxa@z`D-jqUMe)B^qUg$Y2HKeN^gdyTRGModYC|}Sly7o2eSu}ds>XBQyxMSg{<7=3Rpvly}5t&$^q|_%iRDD6+0M7b?y%jpFGU|0=W(d z#0LX38`ra5{Fc$@KI}SYljA5O$4+@#lN1Cz;mKn~xWSRjNw)&Ydq?D_yal9f2@YaE zgey=#!9(zl5IR9iuOXlysMs9v`S#F@Cb2zW(F;*E@Wn}HZr!&|Bf{Hk0qbxkBGhrv zZR_>=$2P^+05J7sAZ^MI?xNIm256s@f74*%Kv5lr?SHHnwqf*4rimg5VF45edjSR8 z1jK6rVKoF7iu9mDJrSW4l_2I6h_&mw0IYNsK!l_1lA3wQjaCa6p?(b6CohmP@?1Oz z{44$vi(kHf?lS>OdsuItMrT&8iCLh;#SU!)=e*oOHTcVnEl@_fDC$`b$3zHR?58qk z0|4!Nz|k2y&Hk-Op9KC!;UE_l5^f#QaYE?r`-x=YppDQ2pdyGKaY;%Vy=CzD6f8dT zDZ~9O#kDk8EO>T6ua~`vq_xt(v!7rASfxCK(p#0rLXZ-~NP6bMv1S|%I6eeMt`#PC zHR&xKL@fn6c?tz?Jy-d5#?&$gQd`z4W2>64`=DSk2i+10Q3e$rxyYEcI}{W~)}Y?u zuf8SfFq8s?MqNOgcs(DdC_-s8+;ACCqaIjR>J4TiXk;&ZQ2XK)aTgj6H$g$gCr}#F z8`T6UamRRje3dSMu|L7C6#`crh(g{26d;5XykK|t`G6*%jSJ#W)MPY!%3pd^aXX@IVhHLlRSpNBjJIhW;Z_%cq?IE(FpK-giN>y{^z?{$fGl% zG2h^r6mYD!Oul=f3u$TI1C@&mp1jg;m_rD=D>lW<2Dcy%fYs=MkZd9A2(Hep3(c`x z%>a)6Do9ZR-xxm{^a}og@bziP%gqn&&O!;$3-NA+1Oyh^VC5xKOrbmuu2b7bvtIy4 zF%SVVw;oMJNH^4AF`jA>Z6Ps124jGojP(E zSmHJnrdXae3~53}j%kDQT=^>OwGk|ZLA<(YoOH%Q$|WK_pAdAI*8mOFg}UdRRNAU z5BzMJj*fW%l`0{5s0+O!;8pANzVIxJf92M}mg`B0x+dlIq|8v`jd8%?RsugFx3B<{ zt}6O?@GXcQ;fMsHBJl^M)GrB-`>+r?V5`6bD>yLSK*J3rGD6ax(E)tfnP4r!t;Ws{ zKz8%5t_V;(fLMbus4geNHC)If!3Hq`$Q)F?|7Ds6T0#w|!KY3G%I6zwVr=Z!M05u& za0Q3?TP{=gf!i({f>^tu!c1s7(b|K|H_-cIU^*0X6QbX9Ts&tp)f9%9_hSr{^MzRT#w`?7^vVIeYGsg&fp($P$D=2tT&}z<8S({KBK#^$OI=aGEx^z}AIVDr zoLNZuGJtz2>>^5=Q0LP-Q=_yx4D^^w^U~LEK6r*-!vjZVKY>FvX3A(p&+KXM#%vXQ ztQwe9(6d>D0P^Ncxh(K;J%R+d9WI?1=eOS64nhP(dKmO{=9s-dvj%-k3PAy*?)|&f zcxCIp->^=R!MLa#XesduGyn#q)oJByg;=!IuKqeIXaCBl|6WpM?%yfCp+G0&YVHqsgjL{+-0Wq-Q&J6o$v5xC}B3U#I zzf>>qd4&-WISPm$%l1|C`TiC}!+rqs2xO35pl_H73;4A;$*pvcymbG~t z9Ow>~Y5~d~q{@%i5pG-9q&_jNso=P(i&H2vp%VpgsdR|WcB_~5k!S&7tVYNhsrur< zy8G|8n(fh4fUWjfD(Xi>wQL|*b0%H@0!PGFI1x@--h4|_`GkJ<1v&q!+u3}m!ePv# z5Ee||YN9c+o1pD!I@kn`2#~+@yBud#6?2r--B=+>S9 ziOy9vk0yvQ7P*%pm$x;DsfCAL z#sDY*_lc_bcu>l78#2LuMGXVy47_sBiY9mZH!&FGN*%#63B!XZEEkSb;?zK#hDw|v^c0;h8?P6}Po=zsCGzfBoyJ+Z+u1SD5N8KP za_0(fgg6KcZyy*#ljlZJhHwkoFeC?uV*8alqU8y|<#;rIH+B;sv~1{j1o>na%<(HK zwVx0oX4TcZzghzM4}kG|pf9Q?1x>XD5FuQrD#<#v2P%5P{s&%sX4O&?D^SKLpZokl z2#7dS-fFxDnjXFd;94g(_vO_b`IxTsdA0Wv=E(fWN3J4yryQe44_Jg zF!YhENT49V8VeO7JCNa$0QpOx{!RO|<-c8!I1iIJYfBS(mJJk#AOiIn0)5oOQP}hI z@IzS%s4^0eHghEAK#G#aY7JovctwGE z5Te!sQI(N$Br1fS%@z9t@D`?!QWm$%9{V{!N2^^t>`dTe!2lEGrf@Mrd?f+Plx@s& z6}D|Qm`P-9Q!S1HfVm!|K6JnyZ+$R3xXTgmrlr)u1ibb1@!m5y!_p^7V*$rc9Y8h# zhBrF__sxKkL^gaL*9VFd)IsEx8JFP%rXmZCXj0SkV_+?T42}^xdhSxbb7$x!IoPuM$Z<4!CNIOuqXAPnbnBIOCfAPcMC zDG|lW&Dik+1q5A?=09;FV-K30Qy`8O=OcjM6NWbKj_>0qZ(DsoW2(aqbwEwnsohm{ z)LD>VLaJ7=`BwJe4kSQBWv=Ovfi4rpFa%?t`P8c*(ugS79um!tyMUT58LAu$0EP6z z4d9vXy}9Xs=~uW#h_o&|zb@z{*o4CmTSPSrrhI}Wm&Fj>1Us0>Q=070)>DTMC~&Oa zwH6Of2D=V=%rCAsTnoS7|eXPd$GI&J(vy zNIUiX1g+;uS>#nvRw+qK|^So+$;A{|}q?2@SOKbA-Ged2w^`BZ@f4>o!~c z8AMqFd1a))SO52)Cn7J?{;w?5KiG*=z&ic!>;LPAN3vzcr|h#n<+e>s`GHLccYB^< zoH!XNsSCu^rhaSk6buqNkkFPw%AX1twC(DzTAxKiV(Q0wCHQ_yaT@u&LN10un`!T$Y&er#@ zTIdacYlJX38EK}QQGy9$Az)vIWFqUpD9#*~8#^VoHU_KmtW5;@1%srBV>|#7^DsGu z2m!Y;IKi_k2R6{~U`($|%m2YJow(fv4<-}RSm-gZLX->3MbmR|&u{+6oB09iPUsOLgmDZ(`z9{sNd!2Ok45uI!}Z!n&k1IP-WK|aD1-G>M%Kz-H*jP!J% zuvJS$*N2McI_7jB`MZsw3N8EPlXti<#~`qz=MmhgFX#pTO)>e#JENgw@S$e+vT=Z2~4#?ce5!L9ElMO zW+w?Xo*x7a1jKYeOCb?)IbEp`@e>hm2w$)uu8V2ovPG1Fvd9cq**TQE?#o|KdsvY& z{%0%4{e>vYk7!--Ono@;e5!SdAFuo^{C9K;Qc-}}b^((aBz$)HZy`WrM9WZSIzszG z*)MK1#2tMgQp|$h0}ue)-npm`8Z{ZS`co0Gt1<%fSsgxX9JK20uCw-;>2=lDu79(% z02fzT=m$Yz0|g8NuXL@0-7#@sg+HhS!qA_9$SMcmAq8(MNBW8RAoZV|4n#EGgdK)@ zT>obe${Uc>k^J6!S1`*ogmdE4e){k?U%CP!^Wr!`L4Xh%udJ>jR8R`K-h+QmZ0^dqnFGc(Tv*fPvV<1c`kCr+LbZJIGJ-29BVf*(zNu%jg0t7^y$M<3h3S!4> zL>?YyP7rBH*7?NagLD^{kptf`$iX-e+1nK&Sgnl5putP7zGYNsqiNXQ(V+(?FFX(f z=yyb2R#V(MfI^5c4pN|Ac6S)E9MZfQf$Zk3DR!e#+eoTM-C-9>TF%1V0Ly}7Wgxga zZ8#es^i=z|L1Doc9AzmY6Z8CBqkz{3Flgul2w{cGlw69MBPnDX++^1ki_n=UlK+|ZoPe_v|Z zU;sm@HBiX7)+yXU35U1e$$#V8Q zc5H$Td5HvW3HVNMN48Mvs4o0v0y+=i#*^VpWA$KX+{lV$6R%ag9@0u<*lNv@5&Jmj zS;`Q$T*;@)a4f8+esWv4Q1o(H6^wyE&k^(sMs5+zy6OW3!Z%u4;@}Ih+6j`OlcxDUqR0Q?38?JvRSE&A&`AUuJ=RmF}syDaIx-J@#1ypzc z7N{NQPhs+S^qNF;^WwR3yeU-2NdNIr>8iQ1^@O{k)&vf9NLxNHDo#Nlp0-#)>)euO zByYG5S0??EQ1zo_A(5?ir>gtnzFzHsdOB0FWqT4m&Xrr|563sgHV-2=r1QoZTfhF; zshWOIy`GV>@?u&okp3))Je)YnY%<1w-cb6_6_GjeuMY7s7W)_B2#ggu<SsMfHS5)u_Lnx6OsQ2vq94}w~);61;Bu9un0*Z*hzBO_9G3c5@jBh6IJ4|jp)p*5O~j`+_vJ`ux~ z!s>VFZ&H$K*A>vRr2}g4r(Uy)d3u`vbIRGQ(0i^QXM>|QhaY%jRkGja4{?w5=H6`Z zY1q9;RLk}YG4C*^4;3=eGF>GRBdT!^!8T<5A?qTYX};bfnTz_*0KMWxv#|aM?UC9k zxr%L%E@a->kH-36x7dC5&1BTYqQ`*C*5ymwWsr5L3JjG0_i1pmDQi8#vF`HV z2A`LpeN4MfpsU!Hf(s55aD6mMioC%o*IMbaHM;PY<)f+*n@(t7OKbTfHEX{jO>E5l za`mxC)*!NW+vT8Xi<=wI`mfuK#IkfhU26En(tGf3>vf9c!5|_9w3C6Fj{MIvUCO_t z2MhM^%aZy3uQ=^~Uq9AAqEMKEaBS~zPo4+6sTyP68n{1RTBJ1@fZa~#Dz-c#nWL|D zU-XSHqL^PTO7TNibX^`kG6*AMJq%47$e+mjV8kO_9VR}OvJoH==T0dS%0WD z;}sn|u&w@&#K4VAx%tsqlF|_N&A`0O*rDG158~Znjn3kx%GvpYw#X*GZJr??ba2;x z%}PX}v?^gKk=nLK#W8F-PK059m>m~~ia++9qp$vK^-X+=gqqbkaZ#HBt=e^^CN<@D zjCp^w4u>k?57e=5xlm+8Y}&veHU=)8wMb*nF|Zfg!>LM0-SnTi+H!C_e=*d1ygRil zB~GZmJ+g;amB6-9o=&`Crl|E&s9ue9i}8N+cgyP8ZYK3!(ezwezm$9BA)cz1WBYDR zQM+yFtq+yV)Qq&XCWY#wx+-dfHGDdlx^dki+I#Ixt~yU$hlWtITL1H${;&Ag?cHf5 ziF;kF5C{&j*@mQaut{^z-$lD)^;d3T9m6-%QdZa)LN{g6c;#{htyr;EMyAZ0J7PDu z8s#hZbF7M$$V&BR(DpbZlOED=neKt4H2=P<{UDuYf|I>;;+*D?{oA5>{1CBis zKcDGB@>#}uORt3X^iGQCoDG^jD)7GDWsTlo9p%lmz~0)hl$lN1s*X9Bx&Ar2Xe?7E zuY?)co6mcXXZ6?av+L3&Q~NWtdz7gZr_559ssDAqx$oo=6P^{H!|iRARl}klSC`@+~< zzn<@v9I8LgFKR2NdTM*tQcdjcmM>ezbu6E)=aczFIM|Q$+c&24AM|9I6 z+B7NUPyT*lG|y#!2LJib{=q4tmv?c}(h4TBBvL+6b-Q#-ZRV80Tq(hz%N5HXT6W@H z*4xT1U(@+VYFwE3%6y5b2(9U6o@Opec~d%*EE3MrMd^K|7Bl{IR-qJ*=3-L(z7d*M zSwhA7EyevTp7}Q4XDEfgbF1{~J{Gu^mrqvVNvy`hS^cG8> z1c`I+P8HEY`*R?fphF15X8q1B@qf}Ju7|`FP9o6&k%7VB* z+$$Y+jXTu`J~!8qR|cmr70t#q>b8rQJZZa>!AHB@8T2-Rbc*4x8rD`7bBITyrJb;Q?|Tw3Ouc#>Ot z$SbEJry_3yS6oxn#Q@B~l*A3&KumyjoDa`S_rORm4oSr@Nvj}KhnczbvBC@Ypw1-8 zz5LUy#x}i&>MzQfimVJzvbsJ9O#6IkjWn6Val^Io;1P=N)M8!dQv95yS@fT%QCRyDE~MVEEs z*yf+$Xeg6r`?>c`$X)06;>@{Roo^hobN?h9N3GGpw zIW1EtZEARKpn0d{{KB7>{Pgr}^YZf5QB@`l_I7-(L2c(>v2^>?Q%PG<*=z`@?5!sno*bMSuZrb}{N=J?cD~_n5FSub2utHqlxT3K=4R_;HzQrkMK{4tE8v^`9QLObk_w{lxBeS2yl~ z@A8*ESA`d!n3~xqv76fVgB1J=XDtm~#IZAQ0=+`klF{sc<8z;Urh=|NYAR<1c$V%x4xRM-S|MV@4cCC^1MlkzMGK-q+D>s8fxh#nxzDb*%n^e< z=#|{TPPJF&m(N6KSr4LrGSjZH2W9EZvI4prS?8x8i1+;9 zt#b@oFF8HD`59B4(dJroSuJJ^{YCmXzon7m-Td2QLo3l-)?mzz{#Nv_jz|=T6xJ=g zYXi6UR^@ZPJo}w{y91M4j_6@sR(wKRea6qlxwBT-)kx>4HTwXPvI*{%9-C|17)|;z zf@55EpydA3JN1q!oss-hWG`2G1UEYbogafM^L=jMKZaE1U!6SVG;^-WjqAKO+k5u` z&u*V6Z^tSOSt5@&2JbGE>0IXE5s8#$)v`Pdl-3^(`B97mwn1>a_IHIeoWP3 zNA7z0Y2ugg$o%lT1Cun2_rEau9tUoDuZ17R=l9AV{%jlFrHS~gPh*GB6g znHj5?@|aPaj<7%dqa~_>co_#hdD|Pdk>5Bb_pJ=C`(Yo5*KCtQ*Q+UIi(1q&gs!-Yr^QAB(P2t7+Ud`RYPlwR=3MySvNT z(HPF@oU>SNINi$_wXt6Arn6J!H~ifta?o0S%=_`9$R&gOqpVg-x$BJC2UOXW0<{v0 zG?%3>mpKjYKfGQq8$3+)kX4EP;DKkR$(4erFpl}G2fGjD6L_VpA{F<)m^cbYZQlLj zS28h<#_>>glFUV)C(w*QQc-hxF2$bG@bILnZ3gx>D)4Gh=O?W84Dh+Pxah(hoXO zDzuqSR)4O@Dy%)y3AW1q=K0Qr+FQ{OE5YU0xX1N+rLM-VSDd58N8n3~W5chkb2Z`f zLvz~%&NIWIJoBbRQb0qNzM2PZ)fOr-TF{D}a~Izh-4eidXktw>V`=rx-mbuidhq?u zFj?Zq>c|HS!j}ij=ajP_n=J;3dVh4AyJF*>>q7We5F@IyC|RItX=>42>3^(tv7qu4 zcA4NGzZTk1r}`Pt}aD$!{%s8Q@n&a+RZmP1Dq@^hc^mDul8 zDOv{%^9dIJsz8mh$10jgNXN9seH|LNr<$&|FEQJ%Fk9@4jy3Kn5!e*^U_g$`slu@1 z|6;-amHqBNBVvc_nR{V+KH=~8KN?L%u7NwUF#h#}e*5;6Swjv+hO$Y;an)p%q>DOR zCyW|(8H<>2@5d~2OniCtNGh|<)#Jl^+MImpF+I?7xe#7fz=Go^$MpoU^?(1~@iaTH zO^%X>y4qqlnYr=XdUvO8Sy{?7%H(PQ--dWD-GTS(wg-FUR@iTrDMaC*hOrf_>bYe- zukqd6*7U`p)Qo)r`nd5{|6Ai3tNsTmZEY<{q#KG|=TT_&IdcDZm&TV=b@_0P5>7lL zu0s*vqY^c zy{ufl!1@)x+S8m#;q6(NFvUfk4^}COOGT|rI^y2n#5zQF>#nWL zNTNnR$Y6T}O52Q3leZeKN#b!S)wSzWSKODv4~UkLKs70}aUoqo!y(py| zR&ec&@x>fbv#{_#1{N#Ov)ploqG9MU)^6dS%eptv1v%@sy1TsD^bWCI)20j(7riSL zYv!`wbM=jO+4v_ng>%*nj_0n>8l$&^(*oUaAg%xq4VqF7q0mOYwJ#ZP+&sF&umMHf@OuwVK_dWOij1fe*8GYFUi5AmlOAYTCPog zDiWP&6HhbG-)99JXTGf1=}dj?_O&Wkis$I&n~9ciJF#;TC3sEI-kG30L#~Z7+ewn# zdYUWI*`S(#wzcGuc4ZTHx_MivrMJV{Z%@&LhYV4P z$9PM%7mKfoANNOxp)6G0Lv5{`6I3SRsg1X7UaR-zg`znZDs~cEvWr#pGPNgr&NsOo zlkci^8oAJi+V)bJd;Zw!W4_ z<4QY9@0g-Z--{u;O+U){oSUhGj;wPLKpLkwz;wciWG>=J7Brvr2c zRrRVGbiEbZ44W*k<)9#1uqt0~S%}eA%0yyqh$QRon%aiy>9Qc6VBBz;D%@C6;Pr}D zltawQYnF}rJt}#2YC^e4TS?2KR=?+OmX(%tr_gVH$YgA3O+EhDk+IiQC|MDkyZ#n7 z&0wx|@T#{FcZ>RE$Dl7pUBy?nuC}=S5tI9*KO)_-{Kk>N^0K1<*7nYm$Toi(i9rLF zd398-h+`CbfvuaZqgwK56{cEiExfUU+Ogg}3^M%Uj;OiiY8JuHhDRuq{kw_rQu4vR zHWgiyBCj@oCWTW)DCVi~2sYC@jjcM5-cJ}+%Dfj-{F^dR=6PE$nb{3HPFMQ-J$4Vn zT1sF!?6VisFmaGSdF8clD!+`5~X%Rw#K>6hB(viXqBt5=Vaw{a zkZ?MurSM-XNy`}|xW=pWi$ajizV#7lx^9{H_(~&e$cd)-h_8X2;|vwDJB*GH70jDBCzT2rSOb{dV4R z5dCnGWLfgTeQ@;Dq`ULR%csn=OXlC^$&SqeA}ZEuX7s1m$i@dRaQYd4AemSncM#P0 z3ochkn(2P@F@03`Msg{~g`H7dx4F=q%v;X-uh#W<@Z{^O#XMEo3>Bij<))5BlAQNK z>5%6Px7!LyXDd&(-T&)$;VAG1Q=vOgXMyNnSPCOTN@YQIx@{IfX8=Y`9DAEZF=yzA|9;v%mL1ft;dp!xH+Y zb%pV)#OsRrA{{RknTl-fO1gN;l9uh}Zysf_!UGALzf_1T$;OTW?xeDB;jyK=YUJ*N z{JIBgIoy4$FqiESs*VG^%T}+hs z^3B&3O#VzH&rSyU;xV!+MGtHrOZ)mZZ(nm9FHIxo_jplDnGJ8U4l+h%_17Fg9>A&?KqsLWzH8HP~9?#NCpo_QXtfchk3I7y9 z9lCp$(m}hBDv73Vdofs(V@glgM07vdQcdb^t5>{9#oMCAZ>SCvCu!QHR~!k6`mM|1 zXw!VFqX0!~zg!!^(wUaF^{YP8;dCANXzF2AB8zM);Lp2Xvt~V{qy-wo)pSRx0}mN{ zLdEZp_qumS_N(jZ69VR4a6GwI^zx=t>-GU5jYQ|sF<0r_*gv(TXxS$fEI70!fgC2h#%KK zO=FMqMtM@*%RP$aJ~%URx_?DM-t?FIzJA*3=%`HsVS$EgJLP;Qqm|K#gCWEI0L$$f zjsBcq6jj};1X*nYMZtnYB;7xKx&(qaZ;U-dK%le zS>1RuMFYhww(xfV4W+$~;?b}~EdffXjB0fE#nF)^uJ(kM&3zHr8KDjIUw_u}9-GlY^6`oEJDQ+jT3|IjB==TgUt7+L=CH0K`bmoclZ`hm8-H*wt z!`J>mH$-H4F!N*D&Wt^4d;M8%MLVhOIPLNj-!7Q z*Pf3A)xT?bUD+iGm!$_ABhv+7oLlJ;O+4Wk3(lj@Gy7Df8t^p|<=1v27-sxhRv5WR@OZ-&!q?rTKX1=v>&cYM?ga-FRIfpbsAL z1AC=C%lrjg_{3Ax`6fjahX{pK4u>K;SAfb)yG>Zz`vzaEzd-lhG>JJ*SM#mRHhYa5 zg8q|yfpLHRG2g3^wm&F|3Qxb>?8XqF(8WepawW^|U}*fX2hGl8#*9u ClimMobTools - 0.5 + 1.0

diff --git a/docs/authors.html b/docs/authors.html index ab9c55d..3d71fa6 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -17,7 +17,7 @@ ClimMobTools - 0.5 + 1.0 @@ -74,21 +74,20 @@

Authors

Citation

- Source: DESCRIPTION + Source: inst/CITATION
-

de Sousa K, van Etten J, Madriz B (2022). -ClimMobTools: API Client for the 'ClimMob' Platform. -R package version 0.5, https://agrdatasci.github.io/ClimMobTools/. -

-
@Manual{,
-  title = {ClimMobTools: API Client for the 'ClimMob' Platform},
-  author = {Kauê {de Sousa} and Jacob {van Etten} and Brandon Madriz},
-  year = {2022},
-  note = {R package version 0.5},
-  url = {https://agrdatasci.github.io/ClimMobTools/},
+    

Carlos Quirós, Kauê de Sousa, Jonathan Steinke, Brandon Madriz, Marie-Angélique Laporte, Elizabeth Arnaud, Rhys Manners, Berta Ortiz-Crespo, Anna Müller, Jacob van Etten. ClimMob: Software to Support Experimental Citizen Science in Agriculture. SSRN http://dx.doi.org/10.2139/ssrn.4463406

+
@Article{,
+  title = {{ClimMob: Software to Support Experimental Citizen Science in Agriculture}},
+  doi = {10.2139/ssrn.4463406},
+  url = {http://dx.doi.org/10.2139/ssrn.4463406},
+  year = {2023},
+  publisher = {{Elsevier BV}},
+  author = {Carlos Quirós and Kauê {de Sousa} and Jonathan Steinke and Brandon Madriz and Marie-Angélique Laporte and Elizabeth Arnaud and Rhys Manners and Berta Ortiz-Crespo and Anna Müller and Jacob {van Etten}},
+  journal = {{SSRN} Electronic Journal},
 }
diff --git a/docs/index.html b/docs/index.html index 210519d..452cef2 100644 --- a/docs/index.html +++ b/docs/index.html @@ -47,7 +47,7 @@ ClimMobTools - 0.5 + 1.0 @@ -192,9 +192,7 @@

Developers

Dev status

  • CRAN
  • -
  • CRANchecks
  • -
  • codecov
  • -
  • lifecycle
  • +
  • CRANchecks
  • Downloads
diff --git a/docs/news/index.html b/docs/news/index.html index be198b7..caa23e6 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -17,7 +17,7 @@ ClimMobTools - 0.5 + 1.0 @@ -57,6 +57,13 @@

Changelog

Source: NEWS.md +
+ +
+

BUG FIXES

+
+
@@ -79,7 +86,7 @@

IMPROVEMENTSClimMobTools 0.4.3 (2021-11-20)

BUG FIXES

-
  • Fix an issue in randomise() to check for unbalanced designs
  • +
    • Fix an issue in randomise() to check for unbalanced designs
    • Remove dependency to “PlackettLuce” and “climatrends” to avoid errors in CRAN check for Windows
@@ -88,7 +95,7 @@

Author

Examples

-
if (FALSE) { # interactive()
-
-# This function only works with an API key
-# the API key can be obtained once a free ClimMob account
-# is created via https://climmob.net/
-
-my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c"
-
-getDataCM(key = my_key,
-          project = "testmark",
-          userowner = "kauedesousa",
-          server = "testing")
-}
+
if (FALSE) { # interactive()
+
+# This function only works with an API key
+# the API key can be obtained once a free ClimMob account
+# is created via https://climmob.net/
+ 
+library("ClimMobTools")
+my_key <- "ff05a174-28d0-4a40-ab5a-35dc486133a6"
+
+getDataCM(key = my_key,
+          project = "beanaru23",
+          userowner = "student",
+          server = "1000farms")
+          
+# get in the wide format
+
+getDataCM(key = my_key,
+          project = "beanaru23",
+          userowner = "student",
+          server = "1000farms",
+          pivot.wider = TRUE)
+}
+
@@ -113,19 +113,21 @@

Author

Examples

-
if (FALSE) { # interactive()
-# This function only works with an API key
-# the API key can be obtained once a free ClimMob account
-# is created via https://climmob.net/
-
-my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c"
- 
-getProjectProgress(key = my_key,
-                   project = "testmark",
-                   userowner = "kauedesousa",
-                   server = "testing")
-
-}
+
if (FALSE) { # interactive()
+# This function only works with an API key
+# the API key can be obtained once a free ClimMob account
+# is created via https://climmob.net/
+ 
+library("ClimMobTools")
+my_key <- "ff05a174-28d0-4a40-ab5a-35dc486133a6"
+
+getProjectProgress(key = my_key,
+                   project = "beanaru23",
+                   userowner = "student",
+                   server = "1000FARMS")
+
+}
+
@@ -126,15 +126,16 @@

Author

Examples

-
if (FALSE) { # interactive()
-# This function only works with an API key
-# the API key can be obtained once a free ClimMob account
-# is created via https://climmob.net/
-
-my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c"
-
-getProjectsCM(key = my_key, server = "testing")
-}
+
if (FALSE) { # interactive()
+# This function only works with an API key
+# the API key can be obtained once a free ClimMob account
+# is created via https://climmob.net/
+
+my_key <- "ff05a174-28d0-4a40-ab5a-35dc486133a6"
+
+getProjectsCM(key = my_key, server = "1000FARMS")
+}
+
@@ -101,14 +101,15 @@

Value

Examples

-
if (FALSE) { # interactive()
-
-require("gosset")
-
-data("breadwheat", package = "gosset")
-
-getTraitList(breadwheat, c("_best", "_worst"))
-}
+
if (FALSE) { # interactive()
+
+require("gosset")
+
+data("breadwheat", package = "gosset")
+
+getTraitList(breadwheat, c("_best", "_worst"))
+}
+
@@ -81,9 +81,9 @@

All functions

Organise trait ranks in a ClimMob data

-

randomise()

+

randomize()

-

Randomised group of items

+

Set an experimental incomplete block design

rankTricot()

diff --git a/docs/reference/randomise.html b/docs/reference/randomise.html index d322ae4..5accec0 100644 --- a/docs/reference/randomise.html +++ b/docs/reference/randomise.html @@ -26,7 +26,7 @@ ClimMobTools - 0.5 + 0.6 diff --git a/docs/reference/randomize.html b/docs/reference/randomize.html new file mode 100644 index 0000000..7ee4ce3 --- /dev/null +++ b/docs/reference/randomize.html @@ -0,0 +1,203 @@ + +Set an experimental incomplete block design — randomize • ClimMobTools + + +
+
+ + + +
+
+ + +
+

Generate an incomplete block A-optional design. The function is optimized for +incomplete blocks of three, but it will also work with comparisons of any +other number of options. +The design strives for approximate A optimality, this means that it is robust +to missing observations. It also strives for balance for positions of each option. +Options are equally divided between first, second, third, etc. position. +The strategy is to create a "pool" of combinations that does not repeat +combinations and is A-optimal. Then this pool is ordered to make subsets of +consecutive combinations also relatively balanced and A-optimal

+
+ +
+
randomize(
+  npackages,
+  itemnames,
+  ncomp = 3,
+  availability = NULL,
+  props = NULL,
+  ...
+)
+
+ +
+

Arguments

+
npackages
+

an integer for the number of incomplete blocks to be generated

+ + +
itemnames
+

a character for the name of items tested in the experiment

+ + +
ncomp
+

an integer for the number of items to be assigned to each incomplete block

+ + +
availability
+

optional, a vector with integers indicating the +number of plots available for each itemnames

+ + +
props
+

optional, a numeric vector with the desired proportions +for each itemnames

+ + +
...
+

additional arguments passed to methods

+ +
+
+

Value

+ + +

A dataframe with the randomized design

+
+
+

References

+

Bailey and Cameron (2004). Combinations of optimal designs. + https://webspace.maths.qmul.ac.uk/l.h.soicher/designtheory.org/library/preprints/optimal.pdf

+
+
+

Author

+

Jacob van Etten

+
+ +
+

Examples

+
ncomp = 3
+npackages = 20
+itemnames = c("apple","banana","grape","mango", "orange")
+availability = c(5, 8, 50, 50, 50)
+
+randomize(ncomp = ncomp,
+          npackages = npackages,
+          itemnames = itemnames)
+#>     item_A item_B item_C
+#>      <chr>  <chr>  <chr>
+#> 1:   apple banana  mango
+#> 2:   grape  apple orange
+#> 3:  banana  mango  grape
+#> 4:   mango orange banana
+#> 5:  orange  grape  apple
+#> ---                     
+#> 16: banana  mango orange
+#> 17:  apple  grape  mango
+#> 18:  grape  apple banana
+#> 19: orange banana  apple
+#> 20:  mango orange  grape
+
+randomize(ncomp = ncomp,
+          npackages = npackages,
+          itemnames = itemnames,
+          availability = availability)
+#>     item_A item_B item_C
+#>      <chr>  <chr>  <chr>
+#> 1:   grape  mango orange
+#> 2:   apple banana  grape
+#> 3:   mango orange  apple
+#> 4:  banana orange  mango
+#> 5:  orange  grape  mango
+#> ---                     
+#> 16:  mango orange  grape
+#> 17: banana  mango orange
+#> 18: orange  grape  mango
+#> 19:  apple banana  grape
+#> 20:  grape  mango orange
+          
+
+
+
+ +
+ + +
+ +
+

Site built with pkgdown 2.0.6.

+
+ +
+ + + + + + + + diff --git a/docs/reference/rankTricot.html b/docs/reference/rankTricot.html index 03a280e..9ef8583 100644 --- a/docs/reference/rankTricot.html +++ b/docs/reference/rankTricot.html @@ -1,5 +1,5 @@ -Build Plackett-Luce rankings from tricot dataset — rankTricot • ClimMobToolsBuild Plackett-Luce rankings from tricot dataset — rankTricot • ClimMobTools @@ -17,7 +17,7 @@ ClimMobTools - 0.5 + 1.0 @@ -59,11 +59,19 @@

Build Plackett-Luce rankings from tricot dataset

-

Create an object of class "rankings" from tricot data.

+

Create an object of class "rankings" from tricot data

-
rankTricot(data, items, input, group = FALSE, additional.rank = NULL, ...)
+
rankTricot(
+  data,
+  items,
+  input,
+  group = FALSE,
+  validate.rankings = FALSE,
+  additional.rank = NULL,
+  ...
+)
@@ -86,6 +94,11 @@

Arguments

logical, if TRUE return an object of class "grouped_rankings"

+
validate.rankings
+

logical, if TRUE implements a check on ranking consistency +looking for possible ties, NA or letters other than A, B, C. These entries are set to 0

+ +
additional.rank

optional, a data frame for the comparisons between tricot items and the local item

@@ -118,34 +131,35 @@

Author

Examples

-
if (FALSE) { # interactive()
-# beans data where each observer compares 3 varieties randomly distributed
-# from a list of 11 and additionally compares these 3 varieties
-# with their local variety
-if (require("PlackettLuce")){
-  data("beans", package = "PlackettLuce")
-  
-  # first build rankings with only tricot items
-  # and return an object of class 'rankings'
-  R <- rankTricot(data = beans,
-                  items = c(1:3),
-                  input = c(4:5))
-  head(R)
-  
-  ############################################################
-  
-  # pass the comparison with local item as an additional rankings, then
-  # each of the 3 varieties are compared separately with the local item
-  # and return an object of class grouped_rankings
-  G <- rankTricot(data = beans,
-                  items = c(1:3),
-                  input = c(4:5),
-                  group = TRUE,
-                  additional.rank = beans[c(6:8)])
-  
-  head(G)
-}
-}
+
if (FALSE) { # interactive()
+# beans data where each observer compares 3 varieties randomly distributed
+# from a list of 11 and additionally compares these 3 varieties
+# with their local variety
+if (require("PlackettLuce")){
+  data("beans", package = "PlackettLuce")
+  
+  # first build rankings with only tricot items
+  # and return an object of class 'rankings'
+  R = rankTricot(data = beans,
+                  items = c(1:3),
+                  input = c(4:5))
+  head(R)
+  
+  ############################################################
+  
+  # pass the comparison with local item as an additional rankings, then
+  # each of the 3 varieties are compared separately with the local item
+  # and return an object of class grouped_rankings
+  G = rankTricot(data = beans,
+                  items = c(1:3),
+                  input = c(4:5),
+                  group = TRUE,
+                  additional.rank = beans[c(6:8)])
+  
+  head(G)
+}
+}
+
@@ -99,25 +99,26 @@

Value

Examples

-
if (FALSE) { # interactive()
-xy <- matrix(c(11.097799, 60.801090,
-               11.161298, 60.804199,
-               11.254428, 60.822457),
-             nrow = 3, ncol = 2, byrow = TRUE)
-
-rmGeoIdentity(xy)
-
-#' the function also handles NAs
-
-xy2 <- matrix(c(11.097799, 60.801090,
-                NA, NA,
-                11.161298, 60.804199,
-                11.254428, 60.822457,
-                11.254428, NA),
-              nrow = 5, ncol = 2, byrow = TRUE)
-
-rmGeoIdentity(xy2)
-}
+
if (FALSE) { # interactive()
+xy <- matrix(c(11.097799, 60.801090,
+               11.161298, 60.804199,
+               11.254428, 60.822457),
+             nrow = 3, ncol = 2, byrow = TRUE)
+
+rmGeoIdentity(xy)
+
+#' the function also handles NAs
+
+xy2 <- matrix(c(11.097799, 60.801090,
+                NA, NA,
+                11.161298, 60.804199,
+                11.254428, 60.822457,
+                11.254428, NA),
+              nrow = 5, ncol = 2, byrow = TRUE)
+
+rmGeoIdentity(xy2)
+}
+