From ad0c54c858b44c408cfd91e1aa3a7b212cb0b5c5 Mon Sep 17 00:00:00 2001 From: OganM Date: Mon, 12 Jun 2023 16:10:12 -0700 Subject: [PATCH 01/21] status checking to gemma_call --- R/convenience.R | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/R/convenience.R b/R/convenience.R index 7363b9f0..c2143a99 100644 --- a/R/convenience.R +++ b/R/convenience.R @@ -623,17 +623,29 @@ gemma_call <- function(call,...,json = TRUE){ attach(args,warn.conflicts = FALSE) if (!is.null(getOption('gemma.username')) && !is.null(getOption('gemma.password'))){ - out <- httr::GET( + response <- httr::GET( glue::glue(paste0(gemmaPath(),call)), httr::authenticate(getOption('gemma.username'), getOption("gemma.password"))) } else{ - out <- httr::GET(glue::glue(paste0(gemmaPath(),call))) + response <- httr::GET(glue::glue(paste0(gemmaPath(),call))) } - - if(json){ - out <- jsonlite::fromJSON(rawToChar(out$content),simplifyVector = FALSE) + + if (response$status_code == 200) { + if(json){ + response <- jsonlite::fromJSON(rawToChar(response$content),simplifyVector = FALSE) + } + return(response) + } else if (response$status_code == 403) { + stop(call,'\n',response$status_code, ": Forbidden. You do not have permission to access this data.") + } else if (response$status_code == 404) { + stop(call,'\n',response$status_code, ": Not found. Ensure your parameters are spelled correctly and that you're querying an existing ID.") + } else if (response$status_code == 500) { + stop(call,'\n',response$status_code, ": Internal server error.") + } else if (response$status_code == 503) { + stop(call,'\n',response$status_code, ": Service Unavailable. Gemma might be under maintenance.") + } else { + stop(call, '\n', "HTTP code ", response$status_code) } - return(out) } From a18dfe2fc92f868de4ffd32aa109c8165450d21d Mon Sep 17 00:00:00 2001 From: OganM Date: Thu, 15 Jun 2023 21:17:12 -0700 Subject: [PATCH 02/21] support for multiple characteristics minus subsets with multiple characteristics --- R/processors.R | 69 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 42 insertions(+), 27 deletions(-) diff --git a/R/processors.R b/R/processors.R index 9c053332..5faba8c5 100644 --- a/R/processors.R +++ b/R/processors.R @@ -80,6 +80,22 @@ processGemmaFactor <- function(d) { } +#' Processes JSON as a factor +#' +#' @param d The JSON to process +#' +#' @return A processed data.table +#' +#' @keywords internal +processCharacteristicBasicValueObject <- function(d){ + data.table( + factorValue = d %>% accessField('value',NA_character_), + factorValueURI = d %>% accessField('valueUri',NA_character_), + category = d %>% accessField('category',NA_character_), + categoryURI = d %>% accessField('categoryUri',NA_character_) + ) +} + #' Processes JSON as an array #' #' @param d The JSON to process @@ -237,26 +253,30 @@ processDEA <- function(d) { result_factors <- seq_along(result_ids) %>% lapply(function(i){ seq_along(result_ids[[i]]) %>% lapply(function(j){ if(length(d[[i]]$resultSets[[j]]$experimentalFactors)==1){ - experimental_factors <- d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$id %>% {d[[i]]$factorValuesUsed[[as.character(.)]]} - factor_ids <- experimental_factors %>% accessField('id',NA_integer_) - + contrast.id = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% accessField('id',NA_integer_) + size = length(contrast.id) out <- data.table( result.ID = d[[i]]$resultSets[[j]]$id, - contrast.id = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% accessField('id',NA_integer_), + contrast.id = contrast.id, experiment.ID = ifelse(is.null(d[[i]]$sourceExperiment), d[[i]]$bioAssaySetId, accessField(d,"sourceExperiment", NA_integer_)), baseline.category = d[[i]]$resultSets[[j]]$baselineGroup$category %>% nullCheck(NA_character_), baseline.categoryURI = d[[i]]$resultSets[[j]]$baselineGroup$categoryUri %>% nullCheck(NA_character_), - baseline.factorValue = d[[i]]$resultSets[[j]]$baselineGroup$value %>% nullCheck(NA_character_), - baseline.factorValueURI = d[[i]]$resultSets[[j]]$baselineGroup$valueUri %>% nullCheck(NA_character_), - experimental.factorValue = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% accessField('factorValue'), - experimental.factorValueURI = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% accessField('id',NA_integer_) %>% match(.,factor_ids) %>% {experimental_factors[.]} %>% accessField('valueUri'), + baseline.factors = d[[i]]$resultSets[[j]]$baselineGroup$characteristics %>% processCharacteristicBasicValueObject() %>% list() %>% rep(size), + experimental.factors = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% + purrr::map('characteristics') %>% purrr::map(processCharacteristicBasicValueObject), subsetFactor.subset = d[[i]]$isSubset %>% nullCheck(), subsetFactor = d[i] %>% purrr::map('subsetFactorValue')%>% processGemmaFactor(), probes.Analyzed = d[[i]]$resultSets[[j]]$numberOfProbesAnalyzed %>% nullCheck(NA_integer_), genes.Analyzed = d[[i]]$resultSets[[j]]$numberOfGenesAnalyzed %>% nullCheck(NA_integer_) ) - out <- out[!experimental.factorValue == baseline.factorValue] + + # remove control as a contrast with self. sorting is there to guarantee + # baseline and experimental values will match + out <- out[!(seq_len(nrow(out)) %>% sapply(function(k){ + identical(out$baseline.factors[[k]] %>% dplyr::arrange(factorValue,factorValueURI,category), + out$experimental.factors[[k]] %>% dplyr::arrange(factorValue,factorValueURI,categoryURI)) + }))] }else{ # if more than 2 factors are present take a look at the @@ -293,6 +313,17 @@ processDEA <- function(d) { purrr::map(function(x){d[[i]]$factorValuesUsed[[as.character(x)]]}) names(experimental_factors) <- d[[i]]$resultSets[[j]]$experimentalFactors %>% purrr::map_int('id') + + exp.factors <- seq_len(nrow(relevant_ids)) %>% + purrr::map(function(k){ + seq_along(relevant_ids[k,]) %>% purrr::map(function(l){ + factors <- experimental_factors[[colnames(relevant_ids)[l]]] + ids <- factors %>% purrr::map_int('id') + factors[[which(ids == relevant_ids[k,l])]]$characteristics %>% processCharacteristicBasicValueObject() + }) %>% {do.call(rbind,.)} + }) + + size = length(exp.factors) out <- data.table( result.ID = d[[i]]$resultSets[[j]]$id, @@ -300,24 +331,8 @@ processDEA <- function(d) { experiment.ID = ifelse(is.null(d[[i]]$sourceExperiment), d[[i]]$bioAssaySetId, accessField(d,"sourceExperiment", NA_integer_)), baseline.category = d[[i]]$resultSets[[j]]$baselineGroup$category %>% nullCheck(NA_character_), baseline.categoryURI = d[[i]]$resultSets[[j]]$baselineGroup$categoryUri %>% nullCheck(NA_character_), - baseline.factorValue = d[[i]]$resultSets[[j]]$baselineGroup$factorValue %>% nullCheck(NA_character_), - baseline.factorValueURI = d[[i]]$resultSets[[j]]$baselineGroup$valueUri %>% nullCheck(NA_character_), - experimental.factorValue = seq_len(nrow(relevant_ids)) %>% - purrr::map_chr(function(k){ - seq_along(relevant_ids[k,]) %>% purrr::map(function(l){ - factors <- experimental_factors[[colnames(relevant_ids)[l]]] - ids <- factors %>% purrr::map_int('id') - factors[[which(ids == relevant_ids[k,l])]]$factorValue %>% nullCheck(NA_character_) - }) %>% {do.call(paste,c(.,list(sep = '_')))} - }), - experimental.factorValueURI = seq_len(nrow(relevant_ids)) %>% - purrr::map_chr(function(k){ - seq_along(relevant_ids[k,]) %>% purrr::map(function(l){ - factors <- experimental_factors[[colnames(relevant_ids)[l]]] - ids <- factors %>% purrr::map_int('id') - factors[[which(ids == relevant_ids[k,l])]]$valueUri %>% nullCheck(NA_character_) - }) %>% {do.call(paste,c(.,list(sep = '_')))} - }), + baseline.factors = d[[i]]$resultSets[[j]]$baselineGroup$characteristics %>% processCharacteristicBasicValueObject() %>% list() %>% rep(size), + experimental.factors = exp.factors, subsetFactor.subset = d[[i]]$isSubset %>% nullCheck(), subsetFactor = d[i] %>% purrr::map('subsetFactorValue')%>% processGemmaFactor(), probes.Analyzed = d[[i]]$resultSets[[j]]$numberOfProbesAnalyzed %>% nullCheck(NA_integer_), From 0518fa3322728d81e328333d6677635c9311cf13 Mon Sep 17 00:00:00 2001 From: OganM Date: Fri, 16 Jun 2023 16:56:09 -0700 Subject: [PATCH 03/21] suppord multiple characteristics for subsets too --- R/processors.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/R/processors.R b/R/processors.R index 5faba8c5..0769c112 100644 --- a/R/processors.R +++ b/R/processors.R @@ -265,7 +265,11 @@ processDEA <- function(d) { experimental.factors = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% purrr::map('characteristics') %>% purrr::map(processCharacteristicBasicValueObject), subsetFactor.subset = d[[i]]$isSubset %>% nullCheck(), - subsetFactor = d[i] %>% purrr::map('subsetFactorValue')%>% processGemmaFactor(), + subsetFactor = d[i] %>% purrr::map('subsetFactorValue') %>% + purrr::map('characteristics') %>% + purrr::map(processCharacteristicBasicValueObject) %>% + do.call(rbind,.) %>% list() %>% + rep(size), probes.Analyzed = d[[i]]$resultSets[[j]]$numberOfProbesAnalyzed %>% nullCheck(NA_integer_), genes.Analyzed = d[[i]]$resultSets[[j]]$numberOfGenesAnalyzed %>% nullCheck(NA_integer_) ) @@ -334,7 +338,11 @@ processDEA <- function(d) { baseline.factors = d[[i]]$resultSets[[j]]$baselineGroup$characteristics %>% processCharacteristicBasicValueObject() %>% list() %>% rep(size), experimental.factors = exp.factors, subsetFactor.subset = d[[i]]$isSubset %>% nullCheck(), - subsetFactor = d[i] %>% purrr::map('subsetFactorValue')%>% processGemmaFactor(), + subsetFactor = d[i] %>% purrr::map('subsetFactorValue') %>% + purrr::map('characteristics') %>% + purrr::map(processCharacteristicBasicValueObject) %>% + do.call(rbind,.) %>% list() %>% + rep(size), probes.Analyzed = d[[i]]$resultSets[[j]]$numberOfProbesAnalyzed %>% nullCheck(NA_integer_), genes.Analyzed = d[[i]]$resultSets[[j]]$numberOfGenesAnalyzed %>% nullCheck(NA_integer_) ) From c0d6e52e238aa50e1bffcc98a5854907d4df7a6a Mon Sep 17 00:00:00 2001 From: OganM Date: Fri, 16 Jun 2023 16:56:29 -0700 Subject: [PATCH 04/21] version bump and news --- DESCRIPTION | 2 +- NEWS.md | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e1b2a1cf..37b98af5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gemma.R Title: A wrapper for Gemma's Restful API to access curated gene expression data and differential expression analyses -Version: 1.3.2 +Version: 1.99.0 Authors@R: c(person(given = "Javier", family = "Castillo-Arnemann", role = c("aut"), email = "javiercastilloar@gmail.com", diff --git a/NEWS.md b/NEWS.md index 1d3ea69e..5e8beef9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# gemma.R 2.0.0 +* Breaking change to `get_dataset_differential_expression_analyses` function in order to return annotations for contrasts with multiple characteristics. + # gemma.R 0.99.44 * Fixes and changes for Bioconductor 3.16 release From 982dd3758a16a310eb545facd29608a23703ad63 Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 21 Jun 2023 19:25:44 -0700 Subject: [PATCH 05/21] documentation update, use processCharacteristicBasicValueObject when appropriate --- R/processors.R | 16 ++++++---------- ...dataset_differential_expression_analyses.Rd | 11 +++-------- man/processCharacteristicBasicValueObject.Rd | 18 ++++++++++++++++++ man/processDEA.Rd | 11 +++-------- 4 files changed, 30 insertions(+), 26 deletions(-) create mode 100644 man/processCharacteristicBasicValueObject.Rd diff --git a/R/processors.R b/R/processors.R index 0769c112..e938fe13 100644 --- a/R/processors.R +++ b/R/processors.R @@ -229,18 +229,13 @@ processSearchAnnotations <- function(d) { #' \item \code{experiment.ID}: Id of the source experiment #' \item \code{baseline.category}: Category for the contrast #' \item \code{baseline.categoryURI}: URI for the baseline category -#' \item \code{baseline.factorValue}: Factor value assigned as the baseline in the contrast. Typically represent control samples -#' \item \code{baseline.factorValueURI}: URI for the baseline.factorValue -#' \item \code{experimental.factorValue}: Factor value assigned to the experimental group. -#' \item \code{experimental.factorValueURI}: URI for the experimental.factorValue +#' \item \code{baseline.factors}: Characteristics of the baseline. This field is a data.table +#' \item \code{experimental.factors}: Characteristics of the experimental group. This field is a data.table #' \item \code{subsetFactor.subset}: TRUE if the result set belong to a subset, FALSE if not. Subsets are created when performing differential expression to avoid unhelpful comparisons. #' \item \code{subsetFactor.category}: Category of the subset -#' \item \code{subsetFactor.categoryURI}: URI of the subset category -#' \item \code{subsetFactor.factorValue}: Factor Value of the subset -#' \item \code{subsetFactor.factorValueURI}: URI of the subset factor value +#' \item \code{subsetFactor}: Characteristics of the subset. This field is a data.table #' \item \code{probes.Analyzed}: Number of probesets represented in the contrast #' \item \code{genes.Analyzed}: Number of genes represented in the contrast -#' \item \code{platform.ID}: Platform id for the contrast #' } #' #' @keywords internal @@ -273,6 +268,7 @@ processDEA <- function(d) { probes.Analyzed = d[[i]]$resultSets[[j]]$numberOfProbesAnalyzed %>% nullCheck(NA_integer_), genes.Analyzed = d[[i]]$resultSets[[j]]$numberOfGenesAnalyzed %>% nullCheck(NA_integer_) ) + # remove control as a contrast with self. sorting is there to guarantee @@ -515,8 +511,8 @@ processSamples <- function(d) { sample.Accession = d %>% purrr::map('accession') %>% accessField('accession',NA_character_), sample.Database = d %>% purrr::map('accession') %>% purrr::map('externalDatabase') %>% accessField('name',NA_character_), # sample.Processed = processDate(d[["processingDate"]]),# not sure what this format is, the function fails - sample.Characteristics = lapply(d %>% purrr::map('sample') %>% purrr::map('characteristics'), processGemmaFactor), - sample.FactorValues = d %>% purrr::map('sample') %>% purrr::map('factorValueObjects') %>% purrr::map(function(x){x %>% purrr::map('characteristics')}) %>% purrr::map(function(x){x %>% purrr::map(processGemmaFactor)}) %>% purrr::map(rbindlist)# , + sample.Characteristics = lapply(d %>% purrr::map('sample') %>% purrr::map('characteristics'), processCharacteristicBasicValueObject), + sample.FactorValues = d %>% purrr::map('sample') %>% purrr::map('factorValueObjects') %>% purrr::map(function(x){x %>% purrr::map('characteristics')}) %>% purrr::map(function(x){x %>% purrr::map(processCharacteristicBasicValueObject)}) %>% purrr::map(rbindlist)# , # processGemmaArray(d[["arrayDesign"]] ) } diff --git a/man/get_dataset_differential_expression_analyses.Rd b/man/get_dataset_differential_expression_analyses.Rd index 2978aa91..69671624 100644 --- a/man/get_dataset_differential_expression_analyses.Rd +++ b/man/get_dataset_differential_expression_analyses.Rd @@ -51,18 +51,13 @@ they uniquely represent a given contrast. \item \code{experiment.ID}: Id of the source experiment \item \code{baseline.category}: Category for the contrast \item \code{baseline.categoryURI}: URI for the baseline category -\item \code{baseline.factorValue}: Factor value assigned as the baseline in the contrast. Typically represent control samples -\item \code{baseline.factorValueURI}: URI for the baseline.factorValue -\item \code{experimental.factorValue}: Factor value assigned to the experimental group. -\item \code{experimental.factorValueURI}: URI for the experimental.factorValue +\item \code{baseline.factors}: Characteristics of the baseline. This field is a data.table +\item \code{experimental.factors}: Characteristics of the experimental group. This field is a data.table \item \code{subsetFactor.subset}: TRUE if the result set belong to a subset, FALSE if not. Subsets are created when performing differential expression to avoid unhelpful comparisons. \item \code{subsetFactor.category}: Category of the subset -\item \code{subsetFactor.categoryURI}: URI of the subset category -\item \code{subsetFactor.factorValue}: Factor Value of the subset -\item \code{subsetFactor.factorValueURI}: URI of the subset factor value +\item \code{subsetFactor}: Characteristics of the subset. This field is a data.table \item \code{probes.Analyzed}: Number of probesets represented in the contrast \item \code{genes.Analyzed}: Number of genes represented in the contrast -\item \code{platform.ID}: Platform id for the contrast } } \description{ diff --git a/man/processCharacteristicBasicValueObject.Rd b/man/processCharacteristicBasicValueObject.Rd new file mode 100644 index 00000000..1974023a --- /dev/null +++ b/man/processCharacteristicBasicValueObject.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/processors.R +\name{processCharacteristicBasicValueObject} +\alias{processCharacteristicBasicValueObject} +\title{Processes JSON as a factor} +\usage{ +processCharacteristicBasicValueObject(d) +} +\arguments{ +\item{d}{The JSON to process} +} +\value{ +A processed data.table +} +\description{ +Processes JSON as a factor +} +\keyword{internal} diff --git a/man/processDEA.Rd b/man/processDEA.Rd index be8b5ca1..1be1c099 100644 --- a/man/processDEA.Rd +++ b/man/processDEA.Rd @@ -25,18 +25,13 @@ they uniquely represent a given contrast. \item \code{experiment.ID}: Id of the source experiment \item \code{baseline.category}: Category for the contrast \item \code{baseline.categoryURI}: URI for the baseline category -\item \code{baseline.factorValue}: Factor value assigned as the baseline in the contrast. Typically represent control samples -\item \code{baseline.factorValueURI}: URI for the baseline.factorValue -\item \code{experimental.factorValue}: Factor value assigned to the experimental group. -\item \code{experimental.factorValueURI}: URI for the experimental.factorValue +\item \code{baseline.factors}: Characteristics of the baseline. This field is a data.table +\item \code{experimental.factors}: Characteristics of the experimental group. This field is a data.table \item \code{subsetFactor.subset}: TRUE if the result set belong to a subset, FALSE if not. Subsets are created when performing differential expression to avoid unhelpful comparisons. \item \code{subsetFactor.category}: Category of the subset -\item \code{subsetFactor.categoryURI}: URI of the subset category -\item \code{subsetFactor.factorValue}: Factor Value of the subset -\item \code{subsetFactor.factorValueURI}: URI of the subset factor value +\item \code{subsetFactor}: Characteristics of the subset. This field is a data.table \item \code{probes.Analyzed}: Number of probesets represented in the contrast \item \code{genes.Analyzed}: Number of genes represented in the contrast -\item \code{platform.ID}: Platform id for the contrast } } \description{ From 5bccd798dd81c8c017028b07995451d73e3c0618 Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 21 Jun 2023 19:43:37 -0700 Subject: [PATCH 06/21] doc updates and adding filter to search_datasets --- R/allEndpoints.R | 373 +++++++++--------- inst/script/openapi.json | Bin 84148 -> 18370 bytes inst/script/overrides.R | 7 + inst/script/registry.R | 4 +- man/get_dataset_annotations.Rd | 4 +- ...ataset_differential_expression_analyses.Rd | 4 +- man/get_dataset_expression.Rd | 4 +- man/get_dataset_platforms.Rd | 4 +- man/get_datasets_by_ids.Rd | 6 +- man/get_gene_probes.Rd | 4 +- man/get_genes.Rd | 4 +- man/get_platform_datasets.Rd | 4 +- man/get_platforms_by_ids.Rd | 3 +- man/get_taxon_datasets.Rd | 3 +- man/search_datasets.Rd | 9 +- 15 files changed, 230 insertions(+), 203 deletions(-) diff --git a/R/allEndpoints.R b/R/allEndpoints.R index 5e74300f..1f0cfb6c 100644 --- a/R/allEndpoints.R +++ b/R/allEndpoints.R @@ -4,26 +4,28 @@ #' #' @param datasets Numerical dataset identifiers or dataset short names. If not #' specified, all datasets will be returned instead -#' @param filter Filter results by matching the expression. The exact syntax is described in the attached external documentation. +#' @param filter Filter results by matching expression. See details for an explanation +#' of the syntax #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param sort Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param sort Order results by the given property and direction. The '+' sign +#' indicate ascending order whereas the '-' indicate descending. +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return @@ -109,19 +111,19 @@ memget_datasets_by_ids <- function( #' #' #' @param resultSet An expression analysis result set numerical identifier. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return Varies @@ -196,19 +198,19 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( #' #' #' @param resultSet An expression analysis result set numerical identifier. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return Varies @@ -282,19 +284,19 @@ mem.getResultSetFactors <- function(resultSet = NA_character_, raw = getOption( #' #' #' @param datasets A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasetResultSets return @@ -363,27 +365,27 @@ memget_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), me ) } -#' Retrieve the expression data of a dataset +#' Retrieve processed expression data of a dataset #' #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param filter The filtered version (`filter = TRUE`) corresponds to what is +#' @param filter The filtered version (\code{filter = TRUE}) corresponds to what is #' used in most Gemma analyses, removing some probes/elements. Unfiltered #' includes all elements. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return If raw is FALSE (default), a data table of the expression matrix for @@ -470,19 +472,19 @@ memget_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( #' will return every probe for the genes. "pickmax" to #' pick the probe with the highest expression, "pickvar" to pick the prove with #' the highest variance and "average" for returning the average expression -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return A list of data frames @@ -602,19 +604,19 @@ memget_dataset_expression_for_genes <- function( #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processSamples return @@ -689,24 +691,24 @@ memget_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), ) } -#' Retrieve the platform of a dataset +#' Retrieve the platforms of a dataset #' #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processPlatforms return @@ -781,24 +783,24 @@ memget_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE ) } -#' Retrieve the annotations analysis of a dataset +#' Retrieve the annotations of a dataset #' #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processAnnotations return @@ -878,19 +880,19 @@ memget_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FAL #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return A data table of the design matrix for the queried dataset. @@ -966,24 +968,24 @@ memget_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), ) } -#' Retrieve the differential analyses of a dataset +#' Retrieve annotations and surface level stats for a dataset's differential analyses #' #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processDEA return @@ -1070,36 +1072,39 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' @param taxon Can either be Taxon ID, Taxon NCBI ID, or one of its string identifiers: scientific name, common name. #' It is recommended to use Taxon ID for efficiency. #' Please note, that not all taxa have all the possible identifiers available. +#' @param filter Filter results by matching expression. See details for an explanation +#' of the syntax #' Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param sort Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param sort Order results by the given property and direction. The '+' sign +#' indicate ascending order whereas the '-' indicate descending. +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return @@ -1110,15 +1115,15 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' @examples #' search_datasets("bipolar", taxon = "human") search_datasets <- function( - query, taxon = NA_character_, offset = 0L, limit = 20L, - sort = "+id", raw = getOption("gemma.raw", FALSE), memoised = getOption( - "gemma.memoised", + query, taxon = NA_character_, filter = NA_character_, + offset = 0L, limit = 20L, sort = "+id", raw = getOption( + "gemma.raw", FALSE - ), file = getOption("gemma.file", NA_character_), - overwrite = getOption("gemma.overwrite", FALSE), attributes = getOption( - "gemma.attributes", - TRUE - )) { + ), memoised = getOption("gemma.memoised", FALSE), + file = getOption("gemma.file", NA_character_), overwrite = getOption( + "gemma.overwrite", + FALSE + ), attributes = getOption("gemma.attributes", TRUE)) { internal <- FALSE keyword <- "dataset" header <- "" @@ -1127,8 +1132,8 @@ search_datasets <- function( preprocessor <- processDatasets validators <- list( query = validateQuery, taxon = validateOptionalTaxon, - offset = validatePositiveInteger, limit = validateLimit, - sort = validateSort + filter = validateFilter, offset = validatePositiveInteger, + limit = validateLimit, sort = validateSort ) endpoint <- "annotations/{encode(taxon)}/search/datasets?query={encode(query)}&limit={encode(limit)}&offset={encode(offset)}&sort={encode(sort)}" if (memoised) { @@ -1139,16 +1144,16 @@ search_datasets <- function( "cache_in_memory") { return(mem_in_memory_cache("search_datasets", query = query, - taxon = taxon, offset = offset, limit = limit, - sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + taxon = taxon, filter = filter, offset = offset, + limit = limit, sort = sort, raw = raw, memoised = FALSE, + file = file, overwrite = overwrite, attributes = attributes )) } else { out <- memsearch_datasets( query = query, taxon = taxon, - offset = offset, limit = limit, sort = sort, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + filter = filter, offset = offset, limit = limit, + sort = sort, raw = raw, memoised = FALSE, file = file, + overwrite = overwrite, attributes = attributes ) return(out) } @@ -1163,20 +1168,20 @@ search_datasets <- function( #' #' @noRd memsearch_datasets <- function( - query, taxon = NA_character_, offset = 0L, limit = 20L, - sort = "+id", raw = getOption("gemma.raw", FALSE), memoised = getOption( - "gemma.memoised", + query, taxon = NA_character_, filter = NA_character_, + offset = 0L, limit = 20L, sort = "+id", raw = getOption( + "gemma.raw", FALSE - ), file = getOption("gemma.file", NA_character_), - overwrite = getOption("gemma.overwrite", FALSE), attributes = getOption( - "gemma.attributes", - TRUE - )) { + ), memoised = getOption("gemma.memoised", FALSE), + file = getOption("gemma.file", NA_character_), overwrite = getOption( + "gemma.overwrite", + FALSE + ), attributes = getOption("gemma.attributes", TRUE)) { mem_call <- memoise::memoise(search_datasets, cache = gemmaCache()) mem_call( - query = query, taxon = taxon, offset = offset, limit = limit, - sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + query = query, taxon = taxon, filter = filter, offset = offset, + limit = limit, sort = sort, raw = raw, memoised = FALSE, + file = file, overwrite = overwrite, attributes = attributes ) } @@ -1191,20 +1196,21 @@ memsearch_datasets <- function( #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param sort Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param sort Order results by the given property and direction. The '+' sign +#' indicate ascending order whereas the '-' indicate descending. +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processPlatforms return @@ -1284,7 +1290,7 @@ memget_platforms_by_ids <- function( ) } -#' Retrieve all experiments within a given platform +#' Retrieve all experiments using a given platform #' #' #' @@ -1294,19 +1300,19 @@ memget_platforms_by_ids <- function( #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return @@ -1395,19 +1401,19 @@ memget_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = g #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processGenes return @@ -1488,24 +1494,24 @@ memget_platform_element_genes <- function(platform, probe, offset = 0L, limit = ) } -#' Retrieve genes matching a gene identifier +#' Retrieve genes matching gene identifiers #' #' #' #' @param genes An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processGenes return @@ -1578,19 +1584,19 @@ memget_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = #' #' #' @param gene An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processGeneLocation return @@ -1657,7 +1663,7 @@ memget_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), mem ) } -#' Retrieve the probes associated to a genes +#' Retrieve the probes associated to a genes across all platforms #' #' #' @@ -1667,19 +1673,19 @@ memget_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), mem #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processElements return @@ -1762,19 +1768,19 @@ memget_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( #' #' #' @param gene An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processGO return @@ -1847,19 +1853,19 @@ memget_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memo #' #' #' @param query The search query -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processSearchAnnotations return @@ -1933,35 +1939,37 @@ memsearch_annotations <- function(query, raw = getOption("gemma.raw", FALSE), me #' @param taxa Limits the result to entities with given identifiers. #' A vector of identifiers. #' Identifiers can be the any of the following: -#' - taxon ID -#' - scientific name -#' - common name +#' \itemize{ +#' \item taxon ID +#' \item scientific name +#' \item common name #' Retrieval by ID is more efficient. #' Do not combine different identifiers in one query. #' For convenience, below is a list of officially supported taxa #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' } #' } -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return A data table with the queried taxa's details. @@ -2035,34 +2043,35 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois #' Please note, that not all taxa have all the possible identifiers available. #' Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param sort Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param sort Order results by the given property and direction. The '+' sign +#' indicate ascending order whereas the '-' indicate descending. +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return @@ -2152,19 +2161,19 @@ memget_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. #' @param resultType The kind of results that should be included in the output. Can be experiment, gene, platform or a long object type name, documented in the API documentation. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If `TRUE` additional information from the call will be added +#' @param attributes If \code{TRUE} additional information from the call will be added #' into the output object's attributes such as offset and available elements. #' #' @return If \code{raw = FALSE} and resultType is experiment, gene or platform, diff --git a/inst/script/openapi.json b/inst/script/openapi.json index d95e136c9d2f3e163626ce9e6a1e8ce18244f258..2a8567987052ca28ec78c6c94226793ef8b29e00 100644 GIT binary patch literal 18370 zcmZU)Q;;Z47c4q6du-dbZF^>qZQHhO+qP}nwrzXP{=a+g%RLnx6&YD8R`pAFtW{Zw z7YPpV|BP$zNS96agtJ;Z7Dw3xYjq!zmPF5&t7Plp!tA&Cl&2?6iend9pa#9Me zjGeE~Y9M|@VgdM~qcvGWJacs*NdEjCa^xSgcgKTu$I|Eg=FRmBtJV#g(auLrydN_W z*(1capP(s|7Uy*=t!)~uO3(RFRzt)XAX8k99x$4k5?M2zIQ=u>Afe~3drQEj)73@tj8HsQHnKNGQ`C;^VY?-a^-MsB!s*ZKX*QfoTVni`1zk0w z&BhySTd%|T+83)E#7G$;F6cgMP1cz)=lkBozMQ|=@z)wLXz_b9xCoasaMT8|C8+l! zj(9z`nsBnr%|XEg>|~I(UF|q)Oh7zBlP@DqVQs0--tXm(hudze1b8|61~H4_SdGfR zfzZ`)z^^l5LDp&GW7<(Twt|}YqH9h0o^9wqa2O&gN1D9@u>j~HIra5oJ!~#^4*C)8 z?cTSXhGb6H`ldjZYS3IUy%J#CMLb-KW+y%V<~nUdpmu=u=RwDp z+@LsV@ZuyJpn$U0cNQM3r*JP7S#T2|lTQ7B|kXTwCrs znI7Ww7>YI-9?;l12g6#^VD#br;GF903hx4)xd`SlzCXTh)?)NXxMy?>!*3>jK&i1-?|bEL>cb_rSBdqAk_ z?Ms0WL15d-4Ev^{!Nxkt1cXPB|J*}UOndzN$wL=k4Hn3Iw}S|K0$|>joQyfk5RzQ5 zPMahL^4i+G2|$R4;W`>%w*mJ=G$hXe1-=u;-6Cli+=2tVqw&J`4{U7SHbmq^swMJy zjt_w4vI^6+3#wzv0P>I3Gm%B-Ac|PbKXe_O(+R<0rNF_8Kcbl5(^G!SDaPJ$SC4m^MatF>oxwWtD+2uLl+DewL0a<_nT zukE}Jhd=@xK&v7Eo8CC%(T=;pIf1bx+qDk^1OXP^4yt(vSVDkRcTdmGCexefQtZ9K z=vF`_79u==?ZWcY&L1Op5Plo(NT5%>{woSX8qp-9siP^dFOxu-^FU{x6)w(SC!cU# z4b(mVwmXu!8w7r6Mj5c~+*(glvG2x2=|jMGZ-FiZJWAq1kv-u_xGET{NTv(gf^)Ds zPTJX8I-g72+?QG2MqM%T{qQH#J|IHFy;($0!jY^xnSCH>FnnY^!3R&%9`ueGvpPFM z&$BlAa6mccuo?i9Gk^=BJkrw{40YD1vq5SEV8yzzuRMvpUz@Hq2ZJu4PwHL$BqHd8 z1c&tJOTXIf4x>K`2==noVN23|v^X}`!8m+rRv#{H=LIn_Wx;o;=)qV5kS2qrdOP&8 z{2KaQLsozCMs)dhfmm<+@FIX3{I4S7Jco? zC=$fQPhr~_8s;p*%e0`vq{35LO|R3+pwS$GIZqnO484UperwIQ9ag#<}qegVG1ed+kQ+y1<8FKtgm! zAHaljV^zKfk*i|B1hr+=e8oYy&6GEb*(0+&MOVG)AiwSngxSA~l=jJZ1D-zzM9W27 zL(H{1+*?=x>2;|2&bWas1%m*%0I!0A`pm!({q1q$xDbK2G+XxnCJ7i`raD5VdXfZ9?7CaU7jyY?0RVDk zH0X0m13MPPRs+Gs`}t&c9wGdxxwiT1x2$hLSi0rrWnJIiUpG^76O^=Js0gYh@!;3u z90fZ!ZfGfYhX3FADF@e-|tifh<7OP%S`A z2AgP9pcIh1@f&ClET^?&5Tg&3=5zrwm#k2m9W1bC%a_*zF-O(7^&=4hex+twCh;wj zcCY%!*X6J{9*4I7&(oNI#-ccqI8KFOXgLIgVF?5M38~zw$wicY;XJ!XaDvO3aMEj8 zR|&RXfUEc!>S0T>z_qA^IJNUbngwJ(WyX4#)J4D`yk3Z+bu7?Gh98cJjMk=*|1fl2 zIv=T)fp62Te8r9jw^Kk0{oZtDUK%V>6i)st#)vMS{@MvE36lj|9$<*Vnkz#880r+n zJ5UXc&3iOklb9~WQ9VNsqy!E8a=R-M{WR)D1^q3N!RTSjhY7eo_BtG=zRfgXMNN#B+(%;*Uw%y{ zHfW=9krmr~T-v}@yj{|_@pAE%yhHv-Coa^ekaKcmbDpG|aEia@?Y>i9dPyEJU_+2i zQCkMvFQZc`LO2-$d}4)XC__as1)yzothxxVL>9994fZx?bfb)c;c}O(M3Nvvd$iBs z3-k-5msuO3zXKwO?6mZ%YPQtzXFvOIc?3xQ!{5IFO9nc#*CqHHcC}D#vZMj=Kz0Cw zzV$x>EX0zQQLLPGI=FF0HqcL9u5y_Dcz)?=u%!MxI&vcZ5vdS4{ee8`eatnV)Y!08 zSo^3uZoDJjA}aUtW`Jkp1|!@=drBIp#y6WYs3Z8_!$y+72NeP1Drr0rNVI;r3{TOS zlfuMR*MMh)f}NwjcYQIh)jw2DiUB0auJ|7*bro@$azw6MRU-Cd*M1C%MsIL; z=&QXewcMbI9{q4|aOz}lGCJA{IJtr%lXMVEL!FqpGIrwGzYzXxn{~akZ?9qSS_Ggg zspTg6n$ua(kOU00!j23G$60CRQXDR6{qv%cwZ2jIZf||d`Vec=d~t$A%$ zH8$S_8NT#i%X_IxWsJ^Lv}7x9nZ9>_cm49MTp<{Jk**c;0OQD8Gy`NWz(NTug|1mb zBur|CrF!pyyCAj|k%=f1%-tQ7X3`nJ$ps!2>Dg}~pxV*U%~~H*82RdOqb+Vk7F(Jd zo4wOR*4P>2Z^dq`?Gc&+ZeTMB^q8SqJ*(|Del_&uh7;>G5%1xNy6o*7Y$- zMnx*L24L{4;_JVqLo9|O&jExbGY%OF_zW>=Az&K>N$rBCDlSZ6j+tA!U>G# z5JZ54M(p`zXSwr=oBJW>37#@|EhTFm&+EC^{JL^_zHR$b_rwyoZTm zVv2Yja``dXISWP6g($VOU4@x}RvFi`8;J!)P=)xjzwpvi>!Tx{4vXl7Sjk=+M>*G3 z@@eXI8TJw}SLh4)d1BAx2BwMRr-+)fLhz9w#V8p%0c!f40jtVwwPD>l`yq_Zwa*6i z3HmuelL5upDQc^e3a9ZgBL_M03BT!#mO7P`;5FQ_m65R6MBk=4h)9jeC98rgSbDO z(zW;9K_sahKB`9Qk!(rM0mvGDnjz|G?NyAtv4C{q0IB?Cb&P7%*B;TqwV^EH!fB97XeJ1H6O-Kr@z8_&`Ht{$2lODVyD3UjjA z37`+e55o_bRt$z6jI`9XE&i0NzyeD8x5P6ZF?zs*F>LH{9_ysp|thKTU-u#yMW{32#DFvF`fl&e=N54@W=T5rFY&19 zUBEvvT$d&NI`D7)^guMY-1d90dqB1S5Rn^rrRFGD&`*XSed^neI2dW`ztHBXB@llb=}MBJ088A7ke`Wy@Xsl%w?gIaqT>5NIWP1(5!Np8E@FnQvZlbpE#x?VHJGxZqn(|J4HwKe& z&W&gE?zZa8hFN;@lACiueA}UTfQtlyiLg)IQc& ze^2MW|7yw7*B!@0@MwO1y+1~uM%fb9IfWjzJ|WS*k_tv<`$+JC@8+xL{_GvzqkvcK z4jfyZb-vrG_i_xc$qd0!jJ>tKVMP%fzT$d87Vg6OIDU`MY?D7K1IMT(y@$NMxa{=o zuJ5dGZu__*;auT#h5lOgZm;ihtbN0HUiI#7`?mTbeS4!`ud&U~ylh@~XCM7F;;fU_ z{r#R6MJ(yh`&=k)0xdw7a4vz>O)u^5b%Ma|WM* z;5jZ)q2}5T3<1l2_1yIG0rTwqT3i9lJl~w@^iHFQ*;@CW-5}vvfFR6zy?tE+-o3FJ z1U^UJ?e=W_MlEsEpY=wYYw@o0z2p5x`q9>??X;!-qBmr3+MVwzw@)hTJU_m+3o5H=A?1{3v{>r?e+`?_O&>(Y28Dn zdAs}gck?#kybkvqzpkLWJFwcDbL{8lhZP4n?%f8=<>q^HySjS&JF)s(3T({T)ztF# zTXz3)@@Lo6bmi==%CfjuZWayUhjl04yGIBtyW5&Iw|i!12X~v`E_C++Z`b726l}$} z?%U=Pz_hKiv9(v3U#M%}FXS5?X7d&fk#PGs*Tu!9fjFT+9}lhBxlSfr&+>B5+9ob= z=4GbS4TsCqtD^HZfre+zSl8ytY3F+6^2mEZUk~AS$F_HKP=BX8u={k4cTEuW$85Hx z)g>hC^!2mzHkj__3d2Nuq0DUTVG$f1{H|CAsVPqx%PkGG2sYo>lx$?|g^M+Pdxq-; zh20R0Vb#VK4}W!JI?XqzA z(MSuv904$nRSDekGkcW0W2Ql(!B%nuWY2Ccsn-#`_LhF+fo5P8haP! zWjO|pPpZtV7gTAw^b40`B|ZYJ_v;v^jtlo2BT~!;ezicH!}HBqZlebV*gvk__aa#^ z9jvWc5*qt{8F;}`B(#&t6ULW%gqHL6#&SVi7{viBJB=vD((&K#yv=smyKKS_5MCut z=LR9E)RYY*swrPzQ3k-V>0?$gVozzxz&^o`-3J6B3u|A2GZMIn6lC$TEYaAsbXR5{ zOr?M@4)ZYf=oao?76Qa05Hwaq6K7-$#YrmK2~xSBC};8AsbthWFNhDEvezwSNqn&; z21WJwhML@#n}m(>u@rj9tb!uA2al-?D46Hw#FP687F9j2{Y~?W=QKpdQArF6C!T7I zzH>uowlFl9QP2xhVkx|Rw0gC~k!A%R#pOa|)ii;a!{uuzJllHF2WR(JXLYrIV60hu z+^6y8Va7@_^lIpGK%BWp86e^!AN%epHdV& zKJt|y=b07j{k6A`^dJZR{g-PUI}!xlg)x55LKk=0@cH27HHl(ba=zEd?nOMwqIwd8 z3G;gyx+S$_JgTy3m+PS>d_4j@i-ML@h4uGarC{X8 zP3Fx)9`$1nJU%46jxrKy(Gh;dWXHyGK}Dic6b{c8)n8GYV{)sX~H(Kb@k{Qa&*EbT%s%mHD*9fb1X* zHa)S@+>BU+vYQWwTdf~R)3zsHiIz4qzW-dF^zxQeg5xbIQB)U-*)|@F%RNx?EBpcG zJ*AYUh(zx3QB-k}6u9^x{e~hl`F67@HhyoqxsgRN1V;wj{!>LfM&xU$S49SmaDr{7 z;cfH?_mLX`HOc{(@jxIJy%cRybwUw6mSoTS(GOw!W%?R!SXAwvek`jF2X4XYlrBb! z%}~D(F^41HCm8`^pMS2}-Pk`~8M88vrhjL?&Q!ff>+_J38M~tw?8q8az+vIVks3X9 zbFI-=1xQ26tfk@0#lf|Z2`ZR(Om?Vj`nu+J#upWulUVjBAFMoR18xw$-5$Lbb!y(- z!+y~dKcPSa;la=leP>1TW`!;{HN317#$&wT!PI>7Hsd*KC2=`6PeV$CCItggpbHcq4}+#d5a!EO2wxEPWqnz0@0a9B4Y z8PQPUyJZI=A}9J&qx{nl%E?ltxFeUE4T^meJ1xGu%gA%|x2i|4k-4k3PK2VpUzA#l zt7e*))afXW7uBR2_sijnR4ClNytZKKvp#>q*}~b&Ke#WZi#b6FiGW9-HfC>`8cDvy zSU8*8k^2MD%vd*@x~zKY2IuVegSyGmJt%rBmvemUjNQB%xIbOcDxhD_q6 z+PlV!Mp9fD+hcI+kt8K3=~lAHp))Qk@0rnGQb3ie;ieGzz0myRo;KOrn`Wd$s9A&I z)op#ZCG4J5-dLKRm6^pyWeT{6*4b6M*`C-b0^M_=P|5s7Q!s+Q38-0r)GynTWyerb z_Z?WG7e99U(JF2xtXLie(egf>j-KehD7)dlh9~~k?OlAHPyW2)D7M&s`hTTEP*2G} z_6qU%`lLP&kb17V!(!a>62&}{lO|~|k|a0WZ#rtM)D@eaJJ#hr4HNXZeqO4dCR_g1soi<(f`|;%(f-X*Lt5htcxSN#d5C zR5n~fCx6_$X|E!Al37Fx88CBo0;=?wRl*RanKaVF({k2V=-~m!>H0;bV^V$Lq3$sn z@3_XDBTS1578mb6I597il!89%5+wZF>Bogvw<$^Vy|V8`6mJueLBc+DMCxwX-9jn;Zr9BoDfkDfz$FW(yTY;)ec#5m-?t{-Hbga;U3c#)PUe6_RSmJfkyDu zzuI2S9-2m6do_~0^yFSYI`Yd@f57ch*Q=Q$WM8<_ZiL~az7vQbK&K8|y}G*;FS47a zszDRy7Da{jUO-R1A0CQ%Abwr)>}EE;VPJcKr9-^?T=p$kBQrRKN7T(uUbt8g@Z4}}bnqp1?9)7cRE)=<< zXebc?&&tHX_$Cz1m{fOJgNje0CaUDXnd27w8PRi%i`%<}3ejlmVBr1}aguTuq#gl-?nbuHl z$N6k^mHE;c5VJ20t?(efGT`bmPcBLjeVW9i+9Ue(I7#HsgfL@QIQAfKgXe-UTz)z=^y zntY`eP+8AexWZ;nD^6;-y%ik-kLuOuX&5*q=%ngjkrwUbxPVq|XDE4m+NFNlm|?Oq zetltwc5$DYtSX^CGsiO$R!C#n#ut%tb%D{^DHGHSnb#k6#c_gQ|I>h1-p zaz172+Bzi~0tzXb%_Vm=(K;TaeiLkxLvo$~cjcV<a=6cvd zsj8c`hR>G-Bh{%9_Lymnqd8 zn{CJuqqb8c=Zy?i2`2&%Pp)7Py+z7x=mBDn@hY!{!b|;B(RXChX)0S6#LWi9jmx*b zIP5Y4@YJ)%(PQy^vhgO}vWMPRoF`zFzDq41quOt!V!!QvzOo;8vlKoZeSZT5HaRa3 z_(rWSAHXyIy*uru$}M00GJq$nY(1GER@NY&_t#C_&!6rO-_Vh7sV}F9T#vVMPr*<> zA3ojep7Qp-1)ka)4O#JJZ`A@Q71p->u_i~Dh%$eCGVUg!15Q1xorhB@^HhT0mwz&y zBM;^3WrA)<$LeH}@pHyQXQ7RDo|^L`VSL3V+POkuw+GztMM=~W=fL&H1cqeCZZYs? zSuf^c0xXJn>Qf$^L^(LJ4CbijTVx#$8nT$7rXbzL`b-!OEl>(v!R|xkVRWpIyzE_t z?}nx3=y$*J>lHY!_OmRVN9uOvrPSNu>E+G3^6$lO^S?UjVV>?Zx2FDm{vD%k;(dA7 zBlT_cc|F-k;6T`mx#<_SQ9e)A3J<Cd|I=7*Dy3lP(XCfbR! zo6k@ADvzaRVC5vQ4-8F5YO1yx%;n&3-^v%!?ZB_W_Zc3_WF>Ln%|3vf>vCaXcJ>qH z9?CjX?`eIukoGv0U?Y7IjG8^II+P8~347%N)nU6p{-!##82&CBU`#K#=$_Q3BiPlD z9g<_1TIVzv;}*1p-R<7(9OH(Ta7?E;7!rZtcDg7NTGr&sD$Isu;BYrWAXb5OcE_Lv zRHHKZ4 z_S8N0i~~KSyH9toT4xcYdtW#j`j5-|AJ4pIQLH?~!^;1`uICp@yt9_*6M^Jtx8w;R%b;q+9Ct4kpa*CcY;orgA zIng&TQ3Ht>C))8e-pzfdY#FOAC$%N;f^IMRVT!tfRz_>%kHDM{QQ1aGcxtPS;3-y5 zKE-@s&z!%VuV*__t>z_T#w?CNBAo`h7tz>q=G;MzQmWq#gh@P|*q3X?lkj5TRM*BV z0Y>1bre?gQ6JH)fBG&gMWG z`B(i-xI$%jvU#>Dr)I3Z^U_3=b^p5RMiSQLsmN9(cKHfhMxav0-=0OC6*me2Tn2>bF!CrFKNJi~ryY&%mNVO^dYI%4!Bq2);FPCY6rqEaYW(=C_|#ZvIidM8 zac)9#Tk?t%0M6CvQ1M9)PlATn!NsbDx9GHbIHrWcN+y0y8cL*zF#MdwHJWo8eO))* zh6^N97Upcn*29O&tVu;l!05U!1AFRXPDhFhO;9q$RMIo35zCF@CeAMIpn=^NtsA`* zx_oA$T26!=ltN>sT|rAh)g(}*?wpAIcR7l*sB-pcxB-Vn|H z<;mg=DIc^}fsH<@#OjjK z`CMBCq(||+MP)xjH!27P6+kYT%oD#Pu#|*Ie}z#UiXi1SG)5LlViO44UT%4H+E+~B z2S4m4doNX6sUAG8GB!M4zG=kfDBcIuZ_IA#Rdf9N2Y)9gF~+zs?q#MBgItYS4$r*MBVdRlD1bFj_0$_ zY1Z5OR?~#UvF(SkD3O$Mf?PFEMA3J8(qDGv8FKOy3kJ+6io*>|9Fd`^Knt4=D(Pai z)<=OXOGr9%1=@smHL5DEt{}7)0=&-5DxyGUAc; zPrQyB@NB-Pv<^FLOyQeRc5@v6{_8cKT`;|+$o9H~_nzYsKZAR?)877OP3w~xxw{a# zOXE1cv6af2dZ2NlkkyWCdLxy|HFFZvh;S;Jg=PN(bi=MXaeiwjvA*?(_0^98+YxT< zKQzs=cj^s?9*fs0p$&8YJ*rVUfi1E79#GyD_l}v;DCr^ed`GR?+=A@*lLhpNdmdWGM5(^KkXADB0}cq~j&#HNYN} zDew+4X#$+64}L=#Wnz{yHZ?Z9lI-?Oj;;~30NFmuh9cKRX#SIA8h}Gv)Y`N9Ku#xt zezdHX*5hTzLwS&sI+|1cyOPB+q&weg%-!e>HCfeDr;h&@_i)m$MtA3HB6?pipKhCr zUwuFbJgC}dsqC&lPiAM4ORLo9K0B38#b*{LzFe2YRlE7~SN03Ht}v~4OPefNOM@al ztR$NaPQsWVI#=ZYyvHxlr<9?zbKcM<7Ge1Eg?qZ4X0=V|n5}nR%!N$i!%qH^UB$Ad zL0WljOQo(~vUu9*cbSq^hfBiW^`OCn+piWgiN>z#jrPcsVCs>FmH$m80g1&>+s|Sx zo3Da%EjRafRdE~YJB?|e8au4rjF#JsGF9t^q$X60MKiNCGkn>(dN<0qrfNmYosJuM5!v(F+)53| z!DO}+<2b=f(_A4+^$1Wzkqzq6@T1{sgF@*NEsiQLAPU=b`+T-BN;dg3H%6y$2W&q(!7o5FjaRvH_qUJg9^4N*iiV1D4ZtST<#G z;Htmud_eUORvup4-%cJrQ404}qrHa-NhW;(Q&-*>a5Zg9Q}T`+6WMW@=@K8_fFP1l zAO3+oU09nIRC4BkN-~TzPqh-I!9T}pRLslyOM;~yVbvwe2B{rG8h&@gOPr?ql;~&Z zw+6{HY(=u5#uZ0WUzN8MtK?3V9V!Kw3Wq)t**A2{(sLSG97GhH6zxLuwfj4hQ!w8# z8J#-Md-+wds1Hu@C?G>IW!NfkvmiIY(QrDth@RLfm!WM8tdkj<6D7G}Y~dvlEy3^R z4VAp6KjhMC!?u`J%F`m8(1qhz_Xya0H{{N_kJk;O!Rt_g?=ANTCN0Tnb|c6I#9%a2 z59Orm)ksbV#+QCS3gezQma~mRoO+ULW;lArQO&Gv(G->B@WePQby{IM;~RQ)i_Sme z7@XniD$k$U*@*KG`8}G2h7O#Hg>WHVMrQqk*RuCZ6CK9&TV9!8fXWLq9yo~b7I)uZ zmq!m@9|x^B_Y`n}$M@7oc?M-d1a=f%7-OUC!oK4|FTvB)S6b=pD$!ZjkD^_(Ve#BP z7o@#+W3ng?d>?SQ5S&J!b4-bbyQiytJv3EDu%4D+Qv1j-uBDm?aVs|@P$eqPv_ouA z#SkP-s#s;jggRKFxTDR0N#(yEeoG9`8+R6q;Wl606j{yi3$GE&t2t@J0lFZC;-10K zXaZH@>?f`%C9(p#$>L9aK64(~czFkXgzLH9@{h)y7&13x}Tfg5!6H5wQ@0EvmBOi>0+foWoIugP3&zHVrlF z2KEUE>xMLamZps8Af}SVhleY+8gz%{?*#)YJ2o`Sw;tV+>}~p|6;RC@8m;?l|L$ag zmp#-p#stU!zS*Z}!2ncR>tAbP)vF=YlDQ+mG?~(+*yR)LQ0_A{T^Z*H6NjsMWQn_| zQ=zCIXs-zO8*ebilQ#VUJUXQ{Qr>MmNRTsgM0i86@7m(|q+H~;b*)e<_~Pe-`(2&Q zz#(z0ysGQ~hRvR4v2%pk()!~&Re{?8oZ68fRMJk#(fiPR(!iX$L6ocwG3zp=qed=G zoy)40B0%(qLMCQDGn%rtgg2<-pDNpE1F0unV`WVKn|g$VHKH_Q+QQ4YM01xI4rFEaZV?Tf(_%LBd|u}F z5^~my54mGu#(2iFs8M6Q}KMtteEDCQq;4vp0)ETecK?HWUmzZ*^mIR4% z^-+VPr*Wxs$-hpZ;Uwr{6mNq3@=q*X6!X&(Cml+aagn4k zb+?0DtC(_&d^8jUOMlYN-!cd>7wvq~u&0**L~oK*j0N5<{^%~L{5O>z%}$hE`@XF{ z0^W>mZ9lH}{nZq^@3|bFz`Ng}Pe+7qjy=UbX zr1~ZIrExWD2UCNJp9e+_)egD(Wt0qSRa;!idL2ydY*j;IGPRa_yXd;E&#LIUi2JkX zdgIfauGP@R`pTGFq^&8kA9$+^C72aqjMVKDdAywWaA|+qGjQ1fkX)dR$AH|Whg{%% zw4P?Dp5jh$#SRKh!t7R(!U)rFq#~wY<7-)kX=bNNF>XHdPlfFX8U5KJx*EHNJg$?C zSQ`Yu-TzhFsd$K;_OokpB18GfW_cbA2lJ$+Tt`>e2M$MOw}qTl=IW@Q`D()|AtTQjQJGA z7Lef?f(0dUW&eN3>s_^jjOaY15dGic$0-%D#e{o>XNE&gN!ID(#3REo_w;dZO8b{7 z?XP$0q;E->%zpx(Wev=9Jl<2w_ha6S*P#b!I+lkk)cbwuGNb}WU%h^3Tpw!3D zK=hR%mcVzIY6k!D7<9kxRwqDZc%IAu1m)^&N$^3uVD?)Pza-}90{1t4$H)DBe;bui zM^l{HbQjW}Z_?n)S-;Yt@uW8A?E&g4GYc_PX#-}Gd=cy-%gJy-s%=Xs1{o0U?#Lbe zwQG-@*(MC*Z%5Kl-miEh>FX4?+bg&yc|LJD6@E)gU9q#-nxeW=bsg;GADFlO2bb~l~`0y8G;7;$9;HT+`hN#NXIL;8G#OmCc!sKojR z8TL@$*e{!S)xDs=V_nawG8uo*_v1fIz%{uV2W8%=d*;nclWi0U-ov+$*s6FALIO^CNEKkNG zojt!4a8nktT@13~0zi2V*p&EO;mXSHzC6E>9MpgN)^DUJ#p9ry{Xd}%PA2reqP#&?u@z5DGg4OBzgig94;3q3sQPm0 zNXoN_l@i2#So7(|9mb{DM-zZ+AqC^Z>hy4|xG>vzqng#kDkH}q4j+ZtiT^EL-+H*; ztfIpz3A%Wk8dsv)GX<`+^;Xs`0u5WTCGJ=9sMo`okv&>xjHYes8c;nktG3cCprNMpT)J~hv1RT5_=S=?sYrqqJg0kj;i5h3u>j195U zw<=~O2~<2HFDP%6;1w1(G`81x zRsj}-6`PCPX=b^aQT4njTE)dW-{OLwyp)v`a^1$}A~FsbPur7Ge&!a7h!rF1d0z8e zRN311iuiSOLQUitdCqCNM2SVYZ+!#KohX9Dp5=ZYNdoH+0zX@hRjy|WdQR$J7G4>3 zHZSaaY-LO6oe_?ig}v&y6l!JnE8*fRGXl$3BB3UnKJ`P zZal6PI7!2&3Pc|273oY>oFFr>htqYA+C?6fe?CeO1&&@RyB5rO#Aa9$$MHi?(2nvo9 zm_zQ|%Dt;hcV?q@l1G3nb}*7!ZJxW@Np*`+L5oy~X5ooY)6X)+ zejlRVdLl}Gn@#pMql-ZTH+DXEha~ApTnmZw*C~^=+& zz|A-$4n+>P!UW3DT;`T(!|;}KO5?z0j{l60#Qcf^Sz_;)!n0G?8iAIxvma1|p8OX$ zB{k7_#$fQ4b>CTW$LF^{8xI+-9@$JnTAsf^Ey`y zCSFy@T&*2L+9ZaO>+32Oi3D8zcQ+1Vgzcz2db9Cc+_RKSut5c)cGkZVzfR_83l zUp`E5C)Q)1>;crIR$LG>0wM(`un4h_^SU|w=l@>?8$1cmOE z!%zGKmr`u1+^OT7k7=x9%L-BxpTG9XnbJG%elZv=?NSCzvI-2F!57&WuyBI=oz4D^ z0sNMPN3pmkVDO1jR^!d@9DJ>bX`+ijIhQAki2+c zVTmC1(!l{gQ0+G8xu=r>hLNVLB>})#LX&qxpTqso14om@j;EH=RtLo?ql>f9Gu_gb zOv2Ch^1T;|b(vk!h|=B@ksW%RJHHjVQctY`GVx3tjK!2f7%{_qrQ>}VH`U)vB2!uS zQ!eFWzG-Hk9b1HUR8k9YJTNVc&r;K>)0Xs9no$z9+0dVx%W47scc5%$6tT^5O`mPq@a9 zAggps(HXVjmje!Y-I`gVN%9L*_>nhN(8SlQvRBwC9e}XC2VpV{NV`{JGFpA*6;EkBZPfy0pxO<}aAOllDg<%X!xOohmg&?&x9FLVT4y*LqZuG*z24PoIF zRYqM{-PS-nsi zani_EX7xh_XlKE{)-Xpqds+~bPp-zlE;42j_q3QU*U}cxyqs1SBT{l*%IK|8D!ZXZ zLRs!ceh?~bR45zks3ex@Ifpzr?Nq0#QnODFU@8N8N>2x z4&4V(5;~RL0`^gt*1^#?=(XiWYxpv(ZnyB^~4X&$uq?NYQIEr-OBsg&SW_ki+ns z(WNbS4A-OthquIKSPfV)G+g#4f6t<7PW^E^ne()f0(*QD)nl}og?~&7;X4^wD*>}C zsg3mGPih-EOGqt?>b!CJeDzL-q}6x`fJJq!7T*#+NqCGI=l|*9+T)qf+cd{rsNKBmI|!+ZO~mun#UOG3@`msNO#BED~8efJ85|K4L$` zg@Czv(t=dmm$}M6tb2!tdrntuqsq->MX(Z(<#MTBHU!*ZpzN(nwP$ADeU^k}s*pP0 zpUX*{JA}Kh`bmrEMe#()kAU8MYTt@@v?Xet1FZKGv#dX(fxh6CP@(>wO55fhz~jIY zV5Mz=aA8K+PC|M`8q7WFf+p1cs+Fo^s!^ETH5XuOTv~uY5;;OM_Y(4N;|mpa%23kN z%7KZ&58j-SpK*ZGE7XLf9`| zLIjPyhnbc)WK=sY3i72c&KB|uBJE-;@+kF!2VdYJ%UgBd%;-mp!)hmlh(dL7{z~p04Q11UAs(de$4V{@@d) zGd|M8qh`M8IZJujXqM9gt@a{9F2}zfC0vy(Uf;M@HJ@@jsm+yB#6k!CY6ZByHR&Ez zWg2@sh}hnCpwkN`X0yEF%S+`>?k)NE#TrUWqU z^aNk2;-Q8W)pxA>_m0)x*K0o5=bxWv0m36=GG7@bo^Ajd-=cF-y}-*tT+)isNJQH7 zB_GXh%-T2QXCELg)^x;;OW6Jt&2t|59qhtVmr^(6hh&E*IZdH>0Wk+EvCTR}V+ZRZ z#v)&g_atl*)_=Kyt$b+Npl!ZRS&D9X`)YG3+Cu!7!q(TBQj2H?(~lDuS|6Y_Y)iKM z%1RAXH$Fab$m5FskuNZWtL^IlzJD~P@NZ1sitUX~X((;{>1b4NKSIJx&KfDZ!tbOr zkEV0nbJbI53Dj~5F2F!I>1F~2IV!+Wc3hqlNs7FiBDI@;=Q)}GQ$R8*e-eH|JKUW# za#ysAb=-Rog@U$8I}%+x6uVj=kB-)*Wl+km;vj0d_6f8MKeg2C-RNbxgBycT?2lb7 z_pbj_{XbD!qVt+*ro2PbE}3FdyW4Nj#ne1gUUa|AS#h^%nH*~u!GwC?63#2JcR}pQ z!k^Ns$GnBt78=H!TP}*C(=Dte^iODE`;beS9R{ zHye7wEL)nyfW@z6>0GN(KcZv&q{Jv5{h$|Ot90t1;|c#*y_pMB6t`>o(}wx7sG#4; zHSTDJk)JoyW_VP6Gq!R0a2h#zZ<=9{-^7m>T#f+4*7|dG6h>uErS{?R=1=y*YrhCH?LaQwq&_9)hQTR6xn|?ofhu5OJ;>IXW7nCke}3RaG4MA<>r(cW@)BV3zjjow;D#1d-7Ow%oaT_RR2v zjM`iId?zWC))|OQL;S%4tORl@(CGO%K^Bi1&eM)w+z4G8Pd`FCU^9LC=FZ;Sl|;&E zd|4eo2SHIBvRlv+^BkjtBeOg-aUd0gZKO2%35Ru-gfXFu3v~?~s>rII&P2)e9<;I9M*t?<W>;Hbg zo(EFN2j5zkrV&x4KU8#}%2UVmeABZzL|jpv^>vLFi? zet*ekGv9lAc6EKT2)*OWbF>+=bd&`1EQlktxSj^7cgKclkTGu@j}|i)WvQ1BflF?38lKN|C8s7~I`Z(sG^Mem|(EL1JqC!DASFQPF^ z!uueac)$C%zBh`;jIU!zFyO2A>lDkYM?}0xMl9XJCSi_rYcUK)0%2P~`Buu3+kn1v zl+FFo2O#`ex&T6x``$F0h2I0lE5^hQghBKn^-?w>Fk8(_gQBagP<7RgYYUS0}BFdVnLgjWE3vOggl}o zB0!=V{Eh`IhQDJCUKV@5;v)tHSTnIjqc|D|w7gWWZ|>iQ!8k}mf7qK~rx(Ls5O48G zw|LJSQw()r~ejZ*JUz4+PH-db^Mo_=)xlzivGL^^=@Naqq_G z_w;$RNP_I1e;@j3FgjjjQ~c}w=gm)8K>Q(K#xK-m?q^es_i2L$T7=mZ%hIh+`QM-E z(}eL=OF9SGZ&{WE?3Q`Hmtt=q9sI}-?^A4z=n2Bgyx~1(>R=2372E_Y!NMT{6VA2g zV~m4=->O;hQL{f^fW&eR3t9vu0SRRMov?o`f`nn5ELkutel!JIxiGz-)Ao=En($c- zQG?%)BaeNYV_3qj74ir|H4$Pg2fl|XL6b8dxS*kT1{GPKSO3M5j4_pUfKvova8dx-0oTSgaUr9PW_a+QX1GH>PlEQ~z{M(@8I!25L;1NQge*(|_R-u&pm`)KQKg2gT0RRhsOYdjHIF$YJUq!z; zr?_|7C{7ZX7i|2S`USiCfqsv$ziIZ{;csC)8QhEtKV>kKvcfO2cQn{N8uSPIJN>

h}%~chz49;w#!6?VoKM9W;dd zfbd}Z0MiqM{q21L;h?|Q2ZaAK%!WGvcyDloS>(U|fT2c~ITRb;$rslzU=G8ah`6zY z|B|tUZil_2{l0|naDPYswS6cc-RBu`SZTkv zeRRZs>-YM5IXI$+o&+n}-#^^OIx)$?&Ox6~0%YzDuyaSdJKNhk2QRk|-UcAoox%40 z5fD}S`R(~X&)#^W(>KSS{z3u(+;rHJ@Er9HLqg?MS?0OAmL%kIx3ZJ-MZMA3Y5gv3Jzp17`cXdwbY>iS5H} zV&NbCS$}&lBs?D->|kf|A8!0v0CM9#WeS^+MQ}RP06+R<3qw~7Ho?QQAvop*`u8M= zAdx+>`kmgM0B`{QRb1Qe9}?H9<~f{14u|`LZGb>bd$fP_TgoBbKRVhu#CHA9&3u0k z^mzc?g#pw*O~!?A%@{bAx7+Ovatf3iv)kL>7Fz`D9Y}t8cGx>S5-nvHvh-G9=m~q# zFvUpg*Vz1U&!D_vcaoK#da#H`QxZDlIAUeDP(@=85ew3Neyxo~7MR_>B2`SIE9(l| z3IoGpx8 zAm1mQ!WZ;N(e>b&(LUu~qp~v2px$7uJn9P7T(F0-=`b`VI!jg}d7_-rxT zc)pFWMZGIa3m3zw$j42Pq#2MV9Q3h7UzwWWyc*zbo6v=joOQtY9|dszZGe}9+HV9E zR(*gN5&#C_M@)j@a{2?B{ZY_O&Y=n0Ht*xv~`j8H0MM2``D;GsQ1fZzV`E!55=0==fC1jxYwwA!kM2`op&+Xu^u1G zw<{M#EuH-KilV6!k-_ax92t5ACsVInAPt)Z;bRL7@fcN6bCDns2=q91NP@E2Ji8}? zTnP~=+Ofxh^yZeyf_vrM6sWaIl)+#)#S{m?F@_$R(~VpvmQ{@Xh}EBJyW{C-r(hne zm8QW)Yo)nXnqRZh)Um~~oUUriPcUrb=yOSHb`_80Cc_~1r9p!+%{byiMCLVt)hIVP z@DRG~bnb(kI6g&d7tZMxM&6r~7w6CwSXTXLO%B7|-Cd6YqrE7c^`cx?|jU zhG=;kf3ge(Y)3y6E;j<*44Vm4m5$ESQ2-y0$14$G$8i!uz=r>+1?giLKWhcH_WJB+ zt!uB(`>MUZCIzO<@~uzuug|6jSRZI4H(49+ly4$)3=lc+Riv$A$0Kklm63Lc8sm(Q ztC-}{>y=3xZJ-7!M;G5eX&S;6Gkndm-BJ^eR?v@Qs4mJiU?1VOK9PedCr56J{Oj`; zJYa-tnrTq9qj*&tsyh{849T<58VEW+$7q|KRf(rP$mUl&zLN6{LT*{K8gYBV<=IC_KgGPtl&;A<%Tr|F zZqN~uFf9$Ck`K2G?{4zI4L~xU> z?4wey3?CO1o=XLF|L0U3xNA1~F-~3*EKTh4H*h!=(%PMw$$XS%zuN8boZ%kRY#8$0 zGNP3TVF$Rsi3#XV6mo5md!OLUiKpCtd-mq)<+t4Xk$H9Y>^V9NV`BVXoJ_V_oqx%* zI6{O0PrJz~CvP-L%URV`1%U~1i@^hHBD)m{gh&bd>E)Y~c3{w~ln0usRl@-^q5y06 zSI02Q#>ivkvptggTau{rQ46bLj;mCoV2)%|eFM<@?(zh8Cv38`l?1)S#0|E_-#~cg z_yjH-IigZx>P&zM`9<5odyb;h+w=K3j=@SMMgHLB%m>8N_|--)R@1 zNqc?uMEIEQ?O){Z6nT!k?o10|CmXhvbysrSwWM2JWeU=8FM{|uP5t}7u$W74QB9=j zWS%OXEO56}-1x^mGj3_391~R&`R?kMQ)#+e!bS8GgqJG_a)s&FRJl5;yb7pt6?WvW zMw0bJ$PYwB*o^!*7d5#fXe|S@jyTc!Ugr8pHTx)pQ_f&V3B*FTa)XX-No`wA0O0a7{0_& z6#f5+Ig!iZpix>&<4SUz!*)bg<@$_~ic(N|sVtKANN0>XGmwsH)lODZme*S+FJ^Lr z=f^zKws6z%lWpB!=cGv>3$?d+F(xAMDyellZ!5>@pWM8*9}}Cx)3B(|K4!=*;QzO| zfs)aAHqGa)NqkN9lAA^P%L`RmIWO$UFJyBG;S}g{^tBup_qGZ3hD*{eN#hI775PHh z;3d#}5oIw-bKVnq8?4~sgD@6#kXvxVe2O}pR7O7UBcl7F3KN&qmcSRm^eUfZ%@Avb zpz>=gFNbB<3zw2)6#=$j2&9t@k?7cX;vm|UD;sgGV2!vCA6$yD*G%wrGJ&@4*Y|!_ zc<<-QZOobw?g>2!K(D-9$)dK65+!X&+$Ozg)N4fzApBt1N-h)A9kt~nD&Mj(C#ZGI z*6n$%qX$nDJ*d<#d~(jPYgtllc0N!kZ@9#u{#>Hg2v1v*H9uu;oQ*qF-dvkfBMPe4 z>{5x$xQ{Z_*v6U0(q|d@nB^<+Wsju#=*i>dFNrfN1zKUR)xlJ~Jw=D-2%O3zF>!~% zsE4LTuG{QWefDm@&}9tL?&`*uy3=bbV{Qu)x^0SQEmX1P7J~Oo%nx?`+pwba8rzmq zY;AP8wTnt{qrF2^m)=*QcgQ*7r<1iu|aE-(tAy`aPnW>$dLD zVZClI2p;{~9iF}xwOEx#C1mzPOz{Yr6(!&xQE zLwK|B4S$VBDJC_FuFBZq7)!^G%P-v2-@I}LslW19dz3a^3G&roPonO1NDZ8bbi8Z4 zXiD}`J@Hkl*hwoV&kRwewim--)RQl>#$y)t5Qf3iM?K@RU++aQ41;)*_;b{;d&_tg z{t;bnsdPqIIL4E`!yr~C9q1gZ1RPrrU#4nP1@QS4-3id%rTPmM5#mw6-@CN+)>n84 zV7x{l&$D_J-?^c;KGN>lPV{WOL?Vjq8(Q0vgvtrO)sONo&6-YpnDoq&DN?2 zsKhn1$}@JT+q~oha0np;e?jF!;xXAXK@@&wM%G9Oc=p2{f|~@#zG$9 z!H^_GQE`&*DyukQ6RH)<^Nf|CsS#2adWe%8o^_lIQKM;=&C};wTlBU}g$FohiK^FXAx>8n4ODgI`#}A7<7w<#dAv_MW<}1F8|u&7R`N22ARz;Jbv;lp>PI|L z58jRn!lSOw4WvMv@Kw+(brSPO-LxVw0B?$F{n6NHwB&dh6l%Mb)2`5?zh@uCp5SQv zYJu#Xr0`&ZCW2*UnmWHPuzwv@8^`ozCUa$DxQD}HNtlEIDvl=cV%`DGCb43eaeNoS zV8)9JxHH_2OUb-|4$AK{`=QuyQz2EBR7X^ZU&yP`YN!H`m`qS86}Z+rSec?x6Ja31 z1{XJiRQTO&HioK{g`#SQ5bIVWkbFw{gVKMrmYAxqn6P8#Yzkd61#cTTsN?DdR`-B? zMRE>*X9NtS0BlX;01)C3JzMwqR~Kn$A-NY0_EyAkm!QJWMHIq_$dU!axq8M#t;l5v zQVAQDKrjb>r~_~uWobaEA)OTiQDJMu!P*_NH{9#6SRWH2PJ>PqI$EusD7(yn{3&WG zD{$Fm!{AhXFrcWTR_G0`Q6CKTiBl!hZgtSQ&6{f?N6VvSHHwgNeC)D<$cJt)?>lX? zp{30Qan~Sc#HjD>2)LquaN zJt2VvgBjiIn=F*QpgGGxx8%}3m^oa#$9d1COrTaxK3&~j`H>%@9xPu?9TgKxyEUE( z8wib6Y`OtEzGlJ~1}2;tH*9b4GuQd_xs~3Y^=ox$t+j)4vy5>I0@a`b6WkRN zfUyZu1?puhF>8;4!MkJWC{d^XE-_{-O^|cCl;@TCB7>CqOmm->|siJv;@f}%A6?sbJuk)aw~-Oq+`Xuzj6Sbkls z7W_I!DB3k;%2n6=y0B)7IEpF5+%&Se!DS{+Cvn}*i3Z-L1(Az`72f)46j0C#_;rj* z+wU;Kv}(vB5{N??r>=n+oV0In(~;mJ3e1SV-cS0_eyO-7Xr+pTQP39{5SIq^iqu53 ze3<2o{e&fpW?NX%HP86DMPq zyfF2jB1Bm4L4vFKpgCiD^_9p}CgC3^T--nCP9D)C(B3+WUQS=~EN~G{4OA*eB7h_( z>J0JS`|hC9xYXSP%O>|m_W#m_QOhGEmd7#L5Z~v5(hpOD7 z8&4}(4&llm!cH=vd3q5~IbI-jxkjKNVr-lqXBoDlD9uZ=y(zR?ZqCsn;Uesfi)d(h^ig1KxyjVIOBY+XDNqu* z4mbVLNSI<)g6Fd7lvjIb2aPaDhkiDi;tcTyiAp9tXg208&JY40nO2Jap68KEjb(*S zHF8DPCXD^7iOgQ2O^Lu}5CA0^tpS6HP6*?%2x-LrfbpncVbm@#j4=Hai;(=wirq09EU1e?0<5?+9uT$^z8e8<5LN>;Bw;JL2c5*2} zxQyq>MM9|0G>N+oaz(k*dShF4zw&4EkUga5TmSB~Xdktj@O1!xGMaEsHi@;N^S}6J zUo5gPK!$SrRf>LMm2mH)lQ>BjkX}?sttMB4jDr;nW5DqX_T9(x2VEDXXonME*UoR* z9NDI@3OeKR1*r^P2CX%ziA@lk%DY$eNvjPo2C%5Cx*?)ih<>PK<&PDF4NQ8YzIM)t^2;XQytmWe?L?6PmGsFl;wss5Xu(Ld&f!I!hoz5p^ z#8(el0ADP%xm_a@6WAB>kgMhli<-UZa*lb+9Xpe>I$=N<2NDP7zKMlbNt5D>E8O{q z?p!+%#3Gz)Y}_<3zpf$alyNE+qDe@wfw8t+vNz=Ox-B^@#U?3eJLI2f*&`NXZ553 z+z}#cj?;?M1UJ2oOc1deKUsou;n&|Lr)DgQ3q|dqHw5Pr9YJ0mA&~O2qs z>?xcm)Sd89oG(AjHemt3a_uN2B<*3{Fb?!$kb;7<_!qT-ekVJ`NiYfE6RSYk!{LiX z+|eLXgB_6~GY%-CBcqe9R{S^up-*7bWb9na=e!AW(g&j{570J&4njcy3*iSpEbWgf zIezIQtz!HZxARTOU@Sv5q$XV?nc43ZizeCBK!BZ>#n}oaxc(UW6G*`t%#p?CSY4wb z*IEn1E#+#y)<5Ts8tq>byPP+uE{eK+DFuWbD?FKosuh^^DQbtSW48J%z9xoK+3VM_ zk?CLXPTLyuxsR`|Gn*@V@E`_}o8wgwUWcJ`ge)i{kV^U*^z2P93|In;F*ef%J#)g#ER+~G%m`yajm5a z45!ftyNO5mcF|uWWGw-3`^pb8E1;DgoD5}~P*^ypJQW4HD+xZnilfPSgz7hijG~<9 ziaED1-ANXkRA1r#T5&5=zLWTFxpAb}PW(Hu3Pbz30CN3a7xi%T>TnkbgNf*{_j?6*blIw{>I=h4oA0oI`CSt>7xstvt51 zZAMw)*KF+O2J#VZHR;qL#KkNeCnvG?NsX<53^XXx$xO%$52Ez-Jt+aBy2n>F)W!gSocg@)oBT?NF^SzA5=Nq>XP3(`Y;v`j^Exq&TmZj%F}r3d4Eb|2^|%hY zd7O3_pVzZ{AO`ckoiS+X*#U!;M*dG`W~C^Dj_%yg=lBelMh6AjaDyGAQjW?&Takxb z!!5%MN;FA|sR-*j+OL^c=sVi}3t2(z8b^vIqcjSzNn9|&^-kbf3T97)UAU^u;f4*& zUjxm?XfY14Nhw;t(m|;8Lp)65kQIE}Tzt59YAJ*)vsHByi@mCQJfv~2S{i92bw(kJ zGaR5ASaq|A*`brWjs2x!pBiwz;X^7&orhiQa|>~7lpoa{^gwx-uZ~A}dWA{%Tz%Oi za!YN&GSpEwv7nC1GBiRQTDCPwq)nIA$QZ1>A=l{^D6UP<8KyL4ch0#Kj3!n=p&D|O z4LUKJtlV>h!=T>BGbv?tC~gdZP>oO|2_jF9`GrfxZd-11BWxG{5|MYOgQ+5F2Cg-W zsgGo+~$Ym&dlHzl@Y?elVHlpR?Zs!p8Fg0x$Q$ON)(WN!7H736(m^OyeoMd{Lin?7BT z&B0Pc(L}WlApn{c!(_g=;@HBp*Bwj*>Rm=YCtR=&JC}AybjLI<&5I?#{nG{5-BuTG zsQB0_86M8aeC#&FA_SKJx+AsZow|^V=yZkun3k%YC{5US58F^MB6phCnD&7l_pM2VoHdhg`akoqr-Mb+;Kla>#S_#?m& z^&T%q$acf11}W!elPf={PSX%9a$Ivi3CzNj66RG-Tb^&2tGK59vn#_Q$ScNC8Q4nA zl_r>L*$1F^RG3`^sYa~B4>oq%z!wt-64aIsw_> z!PV$0?WlGU$hucs1w(kQxdc&5e~lZlj89lQGeP}zTz^n%k=yKz2)%V&`6qnXeR`6> zrW9(NVwpWFPbL(X$_Q~~UTOv^C~Fjan9B=$t1QWok6EcAaU3Gr79p{tWEbX|a$cxI zBG1Rbm)LU&11MD)4Zf z$VvruCJe7dAX;K0{4ri=$^u+qe#4(iK=pPr5!=*nnq2c7BK#yGcD_kMywj>~MVJHg zqzN@uaLcaarad!v39GG`A*%$nBDguYD$~@sI9<0pC$h4DY7U@5=tv9(_0jd0#%Fh^ zR5yZ3bRMSSWp5cTEsGQoLf48mMmdRRR62&Q6!+4QWOa^XhmO0#JFXPC!nOkwcr1lp ztKh-ZCg4OPbZW?1MTu%$#Ty$_trES)upGHm5qmL%pJjf)Zr0I~*%a%kX0_IJru*hb zNdO`9NXQ(QYp6KXM4igk^-yRxWMsuLj);&p?HV6Zf`+w1nVUgmsTGVXw$vam3-dT7 zURo<4XX%+j>6^OE`WZ=%AQLRyknW9`Z4Dr9n#q^Lwq&hn;;zF?IwzO zcPxrR0*$UQv?2sCHb=;d01qC;lf<7-gHbLCo5{{;<*dx^@E6%MPUu#V0gbj_5DqRJ zgy=84q(wR{7>x-0m+{Indv4 z7GZb|CFHv7>JQNt>`iT~C>Wt=hjVmecIYC@s$AUeiwa~A-Ew~G+!+4Y%p6Fg@S2@jV%0u_Vs|CMI^Aqy8p_TY-AK3jJO75+4 zG9-o2kbHQ=&1W?8D#zzG8xqp2N@i z2s0>Sl>>d_j5SD4f@DNhVhjWr-{*074|`2{?R8vnX*30Hh4`qqSPDS_^tpM^`KZD~ zku4jHrD9`(m+CVR66)5N8;i*LQ@{@>8US;hg3r`{MFzJ)n}r!Flw0_^IwL@op)wu! zI>hAdfJym|ut89Du4I=`Ej`->RHM4zDb#4Gyp4Sld4N;tXjJ8W&7hch4olq%uPsCH zepqoznGRHCxpk!_gMON5&L9LbiYP8?P+J|yCSh`US5g^`#PawePd&O|5Q~;#>Z8k` zC>MyR#l^*$Sx$n;R9@ubQA6weE|+FgyuxY+i}Z>+`j%*{n=EYUS8&9{Gi0|Kr=&~ZXJv*tcoDVu$<(OwM;%F(kj9-P5lw4C zcfnJ);-z~GIgfRDYSUL4O}34WTuxc!H#e)k0Et2`)IH`n^G6-$w&73O^-B|6rI&k;N16^gbr072&j-{V(T9K1WGaS>X zJmS;M?99dDDwnJn%sA$%yqna-WV~!|;iV-anfwWz<1~%&9uJY;Dj~m|G8`-*Bia~W zhPgDB8+n{>vBAiiZCWZAE?9~#YP}BlYGeZEXR}22Uh*mxCM`|9sCDoQY{yJ4CrA&*Z{Xog(dAoUEXNTx%jJmFRbno zS$nZiU;#J48q6x=ovz@eT!D z*WxxCZx7&Y_S_|Zwc<%kJ7X$tJI}5>oTA{#|TOIf5(CNqB3a6?0G<{#7%k|W228$3DkOyoAg?y`L7*;d@hEF^~H zDoA&`(`NN_VK7RNK1=cNqKTx&YVq>N&@tactd) zJl8()fp9JvkVIEJDCx^#`P2`kQwFO$svYmw!IA#Ml@EmX#+!zC%jm>q zfwD0_Ch@HLDo$acZ%N}A%w~KfwQu-ebzDqNn`(+($K}vkQ6%La)!ifL9ld{bXDrNiKW!aE%mN$9>L8mKs&0jx-MOA2#+s0UFVJBOz@5COoRM?=f^oL zd7ihY*Qc#2_3*!L*3h03)IUIN(s*;tf=r(5bzTJeJ))`oqD*yFh=dF?7)BvFdy z++5QlNugdwQ;dbxMWe(}TE5kx*~FVcT;|W>tii-XS|tMmGzZSrrc0{oBuCB34JdhR zCS`syn&Rats%psfP2GCMNUC*ltbDg^pY^6V*2nAB7--OYr?bN9;Rjny*5FW+!QiA(WY?MB0`8FRm5gN09i&^Ita>!(h~#u-VM- z%}|Oo>_Mi@;;3gF+VmVTBOI)hJ5O+qi_AJ?C8|U|bk4KQaSN-`!-%8y@~~ttk3^XV z!j|5;z$*c)A7$$CtiD3BW_@oAgtr2y0AvrPJ3&$;zI72#8{~4WWQ5p0`*>#o@vXFH zz-Sv9++gc&^x}Idk~4b-{n&a*nD8IgBfx0z_jb)fm$|rKXHs$_8!jVeDzkxz2{t%s zNXnwuj&W;790MX}I2aw{(wV{W(=3}~%?4rOJx6MTO+!vh#ymXDGWG5ePxoFDL3?EP zlT+fs@%EG{k0DY%5qk4!cv@T>e+XD<=hfNO X)%nGn^Hcmr% sapply(function(x){ x$tags[[which(title)]]$val }) -# download.file('https://dev.gemma.msl.ubc.ca/rest/v2/openapi.json',destfile = 'inst/script/openapi.json') +download.file('https://dev.gemma.msl.ubc.ca/rest/v2/openapi.json',destfile = 'inst/script/openapi.json') api_file = jsonlite::fromJSON(readLines('inst/script/openapi.json'),simplifyVector = FALSE) api_file_fun_names = api_file$paths %>% purrr::map('get') %>% purrr::map_chr('operationId') %>% snakecase::to_snake_case() @@ -205,11 +205,13 @@ registerEndpoint("annotations/{taxon}/search/datasets?query={query}&limit={limit keyword = "dataset", defaults = list(query = bquote(), taxon = NA_character_, + filter = NA_character_, offset = 0L, limit = 20L, sort = "+id"), validators = alist(query = validateQuery, taxon = validateOptionalTaxon, + filter = validateFilter, offset = validatePositiveInteger, limit = validateLimit, sort = validateSort), diff --git a/man/get_dataset_annotations.Rd b/man/get_dataset_annotations.Rd index fc611139..1a3fa441 100644 --- a/man/get_dataset_annotations.Rd +++ b/man/get_dataset_annotations.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_dataset_annotations} \alias{get_dataset_annotations} -\title{Retrieve the annotations analysis of a dataset} +\title{Retrieve the annotations of a dataset} \usage{ get_dataset_annotations( dataset, @@ -51,7 +51,7 @@ The fields of the output data.table are: } } \description{ -Retrieve the annotations analysis of a dataset +Retrieve the annotations of a dataset } \examples{ get_dataset_annotations("GSE2018") diff --git a/man/get_dataset_differential_expression_analyses.Rd b/man/get_dataset_differential_expression_analyses.Rd index 69671624..f2c0e783 100644 --- a/man/get_dataset_differential_expression_analyses.Rd +++ b/man/get_dataset_differential_expression_analyses.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_dataset_differential_expression_analyses} \alias{get_dataset_differential_expression_analyses} -\title{Retrieve the differential analyses of a dataset} +\title{Retrieve annotations and surface level stats for a dataset's differential analyses} \usage{ get_dataset_differential_expression_analyses( dataset, @@ -61,7 +61,7 @@ they uniquely represent a given contrast. } } \description{ -Retrieve the differential analyses of a dataset +Retrieve annotations and surface level stats for a dataset's differential analyses } \examples{ result <- get_dataset_differential_expression_analyses("GSE2872") diff --git a/man/get_dataset_expression.Rd b/man/get_dataset_expression.Rd index 38645e43..606ab85e 100644 --- a/man/get_dataset_expression.Rd +++ b/man/get_dataset_expression.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_dataset_expression} \alias{get_dataset_expression} -\title{Retrieve the expression data of a dataset} +\title{Retrieve processed expression data of a dataset} \usage{ get_dataset_expression( dataset, @@ -45,7 +45,7 @@ If raw is FALSE (default), a data table of the expression matrix for the queried dataset. If raw is TRUE, returns the binary file in raw form. } \description{ -Retrieve the expression data of a dataset +Retrieve processed expression data of a dataset } \examples{ get_dataset_expression("GSE2018") diff --git a/man/get_dataset_platforms.Rd b/man/get_dataset_platforms.Rd index 4eca09eb..d689dfa1 100644 --- a/man/get_dataset_platforms.Rd +++ b/man/get_dataset_platforms.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_dataset_platforms} \alias{get_dataset_platforms} -\title{Retrieve the platform of a dataset} +\title{Retrieve the platforms of a dataset} \usage{ get_dataset_platforms( dataset, @@ -57,7 +57,7 @@ The fields of the output data.table are: } } \description{ -Retrieve the platform of a dataset +Retrieve the platforms of a dataset } \examples{ get_dataset_platforms("GSE2018") diff --git a/man/get_datasets_by_ids.Rd b/man/get_datasets_by_ids.Rd index 532408c5..b9f7c4ee 100644 --- a/man/get_datasets_by_ids.Rd +++ b/man/get_datasets_by_ids.Rd @@ -21,7 +21,8 @@ get_datasets_by_ids( \item{datasets}{Numerical dataset identifiers or dataset short names. If not specified, all datasets will be returned instead} -\item{filter}{Filter results by matching the expression. The exact syntax is described in the attached external documentation.} +\item{filter}{Filter results by matching expression. See details for an explanation +of the syntax} \item{offset}{The offset of the first retrieved result.} @@ -30,7 +31,8 @@ of objects. Has a maximum value of 100. Use together with \code{offset} and the \code{totalElements} \link[base:attributes]{attribute} in the output to compile all data if needed.} -\item{sort}{Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending.} +\item{sort}{Order results by the given property and direction. The '+' sign +indicate ascending order whereas the '-' indicate descending.} \item{raw}{\code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable parsing. Raw results usually contain additional fields and flags that are diff --git a/man/get_gene_probes.Rd b/man/get_gene_probes.Rd index fc4cc69d..32b2dacb 100644 --- a/man/get_gene_probes.Rd +++ b/man/get_gene_probes.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_gene_probes} \alias{get_gene_probes} -\title{Retrieve the probes associated to a genes} +\title{Retrieve the probes associated to a genes across all platforms} \usage{ get_gene_probes( gene, @@ -65,7 +65,7 @@ The fields of the output data.table are: } } \description{ -Retrieve the probes associated to a genes +Retrieve the probes associated to a genes across all platforms } \examples{ get_gene_probes("DYRK1A") diff --git a/man/get_genes.Rd b/man/get_genes.Rd index f96cde83..04727983 100644 --- a/man/get_genes.Rd +++ b/man/get_genes.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_genes} \alias{get_genes} -\title{Retrieve genes matching a gene identifier} +\title{Retrieve genes matching gene identifiers} \usage{ get_genes( genes, @@ -56,7 +56,7 @@ The fields of the output data.table are: } } \description{ -Retrieve genes matching a gene identifier +Retrieve genes matching gene identifiers } \examples{ get_genes("DYRK1A") diff --git a/man/get_platform_datasets.Rd b/man/get_platform_datasets.Rd index 13f0ca98..6286e2c9 100644 --- a/man/get_platform_datasets.Rd +++ b/man/get_platform_datasets.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/allEndpoints.R \name{get_platform_datasets} \alias{get_platform_datasets} -\title{Retrieve all experiments within a given platform} +\title{Retrieve all experiments using a given platform} \usage{ get_platform_datasets( platform, @@ -80,7 +80,7 @@ The fields of the output data.table are: } } \description{ -Retrieve all experiments within a given platform +Retrieve all experiments using a given platform } \examples{ head(get_platform_datasets("GPL1355")) diff --git a/man/get_platforms_by_ids.Rd b/man/get_platforms_by_ids.Rd index 52261f0c..23b0d4c4 100644 --- a/man/get_platforms_by_ids.Rd +++ b/man/get_platforms_by_ids.Rd @@ -27,7 +27,8 @@ of objects. Has a maximum value of 100. Use together with \code{offset} and the \code{totalElements} \link[base:attributes]{attribute} in the output to compile all data if needed.} -\item{sort}{Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending.} +\item{sort}{Order results by the given property and direction. The '+' sign +indicate ascending order whereas the '-' indicate descending.} \item{raw}{\code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable parsing. Raw results usually contain additional fields and flags that are diff --git a/man/get_taxon_datasets.Rd b/man/get_taxon_datasets.Rd index f985a129..e38abcaf 100644 --- a/man/get_taxon_datasets.Rd +++ b/man/get_taxon_datasets.Rd @@ -39,7 +39,8 @@ of objects. Has a maximum value of 100. Use together with \code{offset} and the \code{totalElements} \link[base:attributes]{attribute} in the output to compile all data if needed.} -\item{sort}{Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending.} +\item{sort}{Order results by the given property and direction. The '+' sign +indicate ascending order whereas the '-' indicate descending.} \item{raw}{\code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable parsing. Raw results usually contain additional fields and flags that are diff --git a/man/search_datasets.Rd b/man/search_datasets.Rd index 5a1eb776..f4e4c357 100644 --- a/man/search_datasets.Rd +++ b/man/search_datasets.Rd @@ -7,6 +7,7 @@ search_datasets( query, taxon = NA_character_, + filter = NA_character_, offset = 0L, limit = 20L, sort = "+id", @@ -23,7 +24,10 @@ or full name will also be matched. Can be multiple identifiers separated by comm \item{taxon}{Can either be Taxon ID, Taxon NCBI ID, or one of its string identifiers: scientific name, common name. It is recommended to use Taxon ID for efficiency. -Please note, that not all taxa have all the possible identifiers available. +Please note, that not all taxa have all the possible identifiers available.} + +\item{filter}{Filter results by matching expression. See details for an explanation +of the syntax Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: \tabular{rllr}{ \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr @@ -43,7 +47,8 @@ of objects. Has a maximum value of 100. Use together with \code{offset} and the \code{totalElements} \link[base:attributes]{attribute} in the output to compile all data if needed.} -\item{sort}{Order results by the given property and direction. The '+' sign indicate ascending order whereas the '-' indicate descending.} +\item{sort}{Order results by the given property and direction. The '+' sign +indicate ascending order whereas the '-' indicate descending.} \item{raw}{\code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable parsing. Raw results usually contain additional fields and flags that are From 11864199cd2a3d073f4502e06d364173cda54ec3 Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 21 Jun 2023 19:58:13 -0700 Subject: [PATCH 07/21] support adding details by overrides.R --- inst/script/overrides.R | 6 +++++- inst/script/registry_helpers.R | 11 +++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/inst/script/overrides.R b/inst/script/overrides.R index e0553b01..42c9f16c 100644 --- a/inst/script/overrides.R +++ b/inst/script/overrides.R @@ -1,5 +1,6 @@ # use this file to override automatically generated documentation elements. -# supported elements are title, description, examples, parameters and the return value. +# supported elements are title, description, details, examples, parameters and +# the return value. # add a NULL at the end of the documentation block to allow roxygen to parse # generic_params is matched for all cases @@ -9,6 +10,9 @@ #' specified, all datasets will be returned instead #' @param filter Filter results by matching expression. See details for an explanation #' of the syntax +#' @details +#' Additional details to add +#' #' @examples #' get_datasets_by_ids("GSE2018") #' get_datasets_by_ids(c("GSE2018", "GSE2872")) diff --git a/inst/script/registry_helpers.R b/inst/script/registry_helpers.R index efda63a3..968dee9e 100644 --- a/inst/script/registry_helpers.R +++ b/inst/script/registry_helpers.R @@ -268,6 +268,7 @@ comment <- function(fname, open_api_name = fname, parameters, document = getOpti mDesc <- overrides[[fname]]$tags[[which(description_override)]]$val %>% stringr::str_replace_all('\n',"\n#' ") } + # documentation overrides # uses examples file as an override if provided @@ -295,6 +296,16 @@ comment <- function(fname, open_api_name = fname, parameters, document = getOpti cat(glue::glue("#' {mName}\n#'"), file = document, append = TRUE) cat(glue::glue("\n\n#' {mDesc}\n#'\n\n"), file = document, append = TRUE) + + overrides[[fname]]$tags %>% lapply(class) %>% sapply(function(x){ + any(x %in% 'roxy_tag_details') + }) -> details_override + + if(any(details_override)){ + assertthat::assert_that(sum(details_override)==1) + val = overrides[[fname]]$tags[[which(details_override)]]$val + cat(glue::glue("#' @details {val}\n#'\n\n"), file = document, append = TRUE) + } overrides[[fname]]$tags %>% lapply(class) %>% sapply(function(x){ From 5576c11cce5aaca06487e420a9445643d6788324 Mon Sep 17 00:00:00 2001 From: OganM Date: Thu, 22 Jun 2023 21:36:29 -0700 Subject: [PATCH 08/21] add get_all_pages as a concise way to get paginated data, remove attributes argument and make it mandataroy. include function environment in the output to allow re-creating the call for get_all_pages function --- R/allEndpoints.R | 453 ++++++++---------- R/body.R | 7 +- R/convenience.R | 28 ++ inst/script/openapi.json | Bin 18370 -> 18430 bytes inst/script/overrides.R | 2 - inst/script/registry_helpers.R | 13 +- man/dot-getResultSetFactors.Rd | 6 +- man/dot-getResultSets.Rd | 6 +- man/get_all_pages.Rd | 23 + man/get_dataset_annotations.Rd | 6 +- man/get_dataset_design.Rd | 6 +- ...ataset_differential_expression_analyses.Rd | 6 +- man/get_dataset_expression.Rd | 6 +- man/get_dataset_expression_for_genes.Rd | 6 +- man/get_dataset_platforms.Rd | 6 +- man/get_dataset_samples.Rd | 6 +- man/get_datasets_by_ids.Rd | 9 +- man/get_gene_go_terms.Rd | 6 +- man/get_gene_locations.Rd | 6 +- man/get_gene_probes.Rd | 6 +- man/get_genes.Rd | 6 +- man/get_platform_datasets.Rd | 6 +- man/get_platform_element_genes.Rd | 6 +- man/get_platforms_by_ids.Rd | 6 +- man/get_result_sets.Rd | 6 +- man/get_taxa_by_ids.Rd | 6 +- man/get_taxon_datasets.Rd | 6 +- man/search_annotations.Rd | 6 +- man/search_datasets.Rd | 6 +- man/search_gemma.Rd | 6 +- 30 files changed, 303 insertions(+), 364 deletions(-) create mode 100644 man/get_all_pages.Rd diff --git a/R/allEndpoints.R b/R/allEndpoints.R index 1f0cfb6c..081f3b4b 100644 --- a/R/allEndpoints.R +++ b/R/allEndpoints.R @@ -2,6 +2,8 @@ #' #' #' +#' @details Additional details to add +#' #' @param datasets Numerical dataset identifiers or dataset short names. If not #' specified, all datasets will be returned instead #' @param filter Filter results by matching expression. See details for an explanation @@ -25,8 +27,6 @@ #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return #' @export @@ -45,7 +45,7 @@ get_datasets_by_ids <- function( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -67,21 +67,23 @@ get_datasets_by_ids <- function( return(mem_in_memory_cache("get_datasets_by_ids", datasets = datasets, filter = filter, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_datasets_by_ids( datasets = datasets, filter = filter, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -97,12 +99,12 @@ memget_datasets_by_ids <- function( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_datasets_by_ids, cache = gemmaCache()) mem_call( datasets = datasets, filter = filter, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -123,8 +125,6 @@ memget_datasets_by_ids <- function( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return Varies #' @keywords internal @@ -139,7 +139,7 @@ memget_datasets_by_ids <- function( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- TRUE header <- "text/tab-separated-values" isFile <- TRUE @@ -155,21 +155,21 @@ memget_datasets_by_ids <- function( "cache_in_memory") { return(mem_in_memory_cache(".getResultSets", resultSet = resultSet, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- mem.getResultSets( resultSet = resultSet, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -185,11 +185,11 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(.getResultSets, cache = gemmaCache()) mem_call( resultSet = resultSet, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -210,8 +210,6 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return Varies #' @keywords internal @@ -226,7 +224,7 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- TRUE header <- "" isFile <- FALSE @@ -242,20 +240,21 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( "cache_in_memory") { return(mem_in_memory_cache(".getResultSetFactors", resultSet = resultSet, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- mem.getResultSetFactors( resultSet = resultSet, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -271,11 +270,11 @@ mem.getResultSetFactors <- function(resultSet = NA_character_, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(.getResultSetFactors, cache = gemmaCache()) mem_call( resultSet = resultSet, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -296,8 +295,6 @@ mem.getResultSetFactors <- function(resultSet = NA_character_, raw = getOption( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasetResultSets return #' @export @@ -313,7 +310,7 @@ get_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), memoi ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "internal" header <- "" @@ -330,21 +327,21 @@ get_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), memoi "cache_in_memory") { return(mem_in_memory_cache("get_result_sets", datasets = datasets, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- memget_result_sets( datasets = datasets, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -357,11 +354,11 @@ memget_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), me ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_result_sets, cache = gemmaCache()) mem_call( datasets = datasets, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -385,8 +382,6 @@ memget_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), me #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return If raw is FALSE (default), a data table of the expression matrix for #' the queried dataset. If raw is TRUE, returns the binary file in raw form. @@ -405,7 +400,7 @@ get_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -422,21 +417,22 @@ get_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( "cache_in_memory") { return(mem_in_memory_cache("get_dataset_expression", dataset = dataset, filter = filter, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- memget_dataset_expression( dataset = dataset, filter = filter, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -452,11 +448,11 @@ memget_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_dataset_expression, cache = gemmaCache()) mem_call( dataset = dataset, filter = filter, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -484,8 +480,6 @@ memget_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return A list of data frames #' @export @@ -500,10 +494,7 @@ get_dataset_expression_for_genes <- function( "gemma.memoised", FALSE ), file = getOption("gemma.file", NA_character_), - overwrite = getOption("gemma.overwrite", FALSE), attributes = getOption( - "gemma.attributes", - TRUE - )) { + overwrite = getOption("gemma.overwrite", FALSE)) { internal <- FALSE keyword <- "dataset" header <- "" @@ -558,21 +549,23 @@ get_dataset_expression_for_genes <- function( return(mem_in_memory_cache("get_dataset_expression_for_genes", datasets = datasets, genes = genes, keepNonSpecific = keepNonSpecific, consolidate = consolidate, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_dataset_expression_for_genes( datasets = datasets, genes = genes, keepNonSpecific = keepNonSpecific, consolidate = consolidate, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -585,17 +578,14 @@ memget_dataset_expression_for_genes <- function( "gemma.memoised", FALSE ), file = getOption("gemma.file", NA_character_), - overwrite = getOption("gemma.overwrite", FALSE), attributes = getOption( - "gemma.attributes", - TRUE - )) { + overwrite = getOption("gemma.overwrite", FALSE)) { mem_call <- memoise::memoise(get_dataset_expression_for_genes, cache = gemmaCache() ) mem_call( datasets = datasets, genes = genes, keepNonSpecific = keepNonSpecific, consolidate = consolidate, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -616,8 +606,6 @@ memget_dataset_expression_for_genes <- function( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processSamples return #' @export @@ -632,7 +620,7 @@ get_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), me ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -657,20 +645,21 @@ get_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), me "cache_in_memory") { return(mem_in_memory_cache("get_dataset_samples", dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_dataset_samples( dataset = dataset, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -683,11 +672,11 @@ memget_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_dataset_samples, cache = gemmaCache()) mem_call( dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -708,8 +697,6 @@ memget_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processPlatforms return #' @export @@ -724,7 +711,7 @@ get_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE), ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -749,20 +736,21 @@ get_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE), "cache_in_memory") { return(mem_in_memory_cache("get_dataset_platforms", dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_dataset_platforms( dataset = dataset, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -775,11 +763,11 @@ memget_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_dataset_platforms, cache = gemmaCache()) mem_call( dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -800,8 +788,6 @@ memget_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processAnnotations return #' @export @@ -816,7 +802,7 @@ get_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FALSE) ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -841,20 +827,21 @@ get_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FALSE) "cache_in_memory") { return(mem_in_memory_cache("get_dataset_annotations", dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_dataset_annotations( dataset = dataset, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -867,11 +854,11 @@ memget_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FAL ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_dataset_annotations, cache = gemmaCache()) mem_call( dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -892,8 +879,6 @@ memget_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FAL #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return A data table of the design matrix for the queried dataset. #' A \code{404 error} if the given identifier does not map to any object @@ -909,7 +894,7 @@ get_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), mem ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -934,20 +919,21 @@ get_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), mem "cache_in_memory") { return(mem_in_memory_cache("get_dataset_design", dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_dataset_design( dataset = dataset, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -960,11 +946,11 @@ memget_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_dataset_design, cache = gemmaCache()) mem_call( dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -985,8 +971,6 @@ memget_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processDEA return #' @export @@ -1002,7 +986,7 @@ get_dataset_differential_expression_analyses <- function(dataset, raw = getOptio ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -1027,20 +1011,21 @@ get_dataset_differential_expression_analyses <- function(dataset, raw = getOptio "cache_in_memory") { return(mem_in_memory_cache("get_dataset_differential_expression_analyses", dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_dataset_differential_expression_analyses( dataset = dataset, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1053,13 +1038,13 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_dataset_differential_expression_analyses, cache = gemmaCache() ) mem_call( dataset = dataset, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -1104,8 +1089,6 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return #' @export @@ -1123,7 +1106,7 @@ search_datasets <- function( file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "dataset" header <- "" @@ -1146,21 +1129,23 @@ search_datasets <- function( query = query, taxon = taxon, filter = filter, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memsearch_datasets( query = query, taxon = taxon, filter = filter, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1176,12 +1161,12 @@ memsearch_datasets <- function( file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(search_datasets, cache = gemmaCache()) mem_call( query = query, taxon = taxon, filter = filter, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } @@ -1210,8 +1195,6 @@ memsearch_datasets <- function( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processPlatforms return #' @export @@ -1227,10 +1210,7 @@ get_platforms_by_ids <- function( "gemma.memoised", FALSE ), file = getOption("gemma.file", NA_character_), - overwrite = getOption("gemma.overwrite", FALSE), attributes = getOption( - "gemma.attributes", - TRUE - )) { + overwrite = getOption("gemma.overwrite", FALSE)) { internal <- FALSE keyword <- "platform" header <- "" @@ -1251,21 +1231,22 @@ get_platforms_by_ids <- function( return(mem_in_memory_cache("get_platforms_by_ids", platforms = platforms, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite )) } else { out <- memget_platforms_by_ids( platforms = platforms, offset = offset, limit = limit, sort = sort, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1278,15 +1259,12 @@ memget_platforms_by_ids <- function( "gemma.memoised", FALSE ), file = getOption("gemma.file", NA_character_), - overwrite = getOption("gemma.overwrite", FALSE), attributes = getOption( - "gemma.attributes", - TRUE - )) { + overwrite = getOption("gemma.overwrite", FALSE)) { mem_call <- memoise::memoise(get_platforms_by_ids, cache = gemmaCache()) mem_call( platforms = platforms, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -1312,8 +1290,6 @@ memget_platforms_by_ids <- function( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return #' @export @@ -1331,7 +1307,7 @@ get_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = getO ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "platform" header <- "" @@ -1351,21 +1327,22 @@ get_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = getO "cache_in_memory") { return(mem_in_memory_cache("get_platform_datasets", platform = platform, offset = offset, limit = limit, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- memget_platform_datasets( platform = platform, offset = offset, limit = limit, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1381,12 +1358,11 @@ memget_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = g ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_platform_datasets, cache = gemmaCache()) mem_call( platform = platform, offset = offset, limit = limit, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) } @@ -1413,8 +1389,6 @@ memget_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = g #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processGenes return #' @export @@ -1432,7 +1406,7 @@ get_platform_element_genes <- function(platform, probe, offset = 0L, limit = 20L ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "platform" header <- "" @@ -1453,21 +1427,22 @@ get_platform_element_genes <- function(platform, probe, offset = 0L, limit = 20L return(mem_in_memory_cache("get_platform_element_genes", platform = platform, probe = probe, offset = offset, limit = limit, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite )) } else { out <- memget_platform_element_genes( platform = platform, probe = probe, offset = offset, limit = limit, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1483,14 +1458,14 @@ memget_platform_element_genes <- function(platform, probe, offset = 0L, limit = ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_platform_element_genes, cache = gemmaCache() ) mem_call( platform = platform, probe = probe, offset = offset, limit = limit, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -1511,8 +1486,6 @@ memget_platform_element_genes <- function(platform, probe, offset = 0L, limit = #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processGenes return #' @export @@ -1528,7 +1501,7 @@ get_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = get ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "gene" header <- "" @@ -1545,20 +1518,21 @@ get_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = get "cache_in_memory") { return(mem_in_memory_cache("get_genes", genes = genes, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- memget_genes( genes = genes, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1571,11 +1545,11 @@ memget_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_genes, cache = gemmaCache()) mem_call( genes = genes, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -1596,8 +1570,6 @@ memget_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processGeneLocation return #' @export @@ -1612,7 +1584,7 @@ get_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), memois ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "gene" header <- "" @@ -1629,20 +1601,21 @@ get_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), memois "cache_in_memory") { return(mem_in_memory_cache("get_gene_locations", gene = gene, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite )) } else { out <- memget_gene_locations( gene = gene, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1655,11 +1628,11 @@ memget_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), mem ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_gene_locations, cache = gemmaCache()) mem_call( gene = gene, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -1685,8 +1658,6 @@ memget_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), mem #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processElements return #' @export @@ -1704,7 +1675,7 @@ get_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "gene" header <- "" @@ -1725,20 +1696,22 @@ get_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( return(mem_in_memory_cache("get_gene_probes", gene = gene, offset = offset, limit = limit, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memget_gene_probes( gene = gene, offset = offset, limit = limit, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1754,12 +1727,11 @@ memget_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_gene_probes, cache = gemmaCache()) mem_call( gene = gene, offset = offset, limit = limit, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) } @@ -1780,8 +1752,6 @@ memget_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processGO return #' @export @@ -1796,7 +1766,7 @@ get_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memoise ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "gene" header <- "" @@ -1813,21 +1783,21 @@ get_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memoise "cache_in_memory") { return(mem_in_memory_cache("get_gene_go_terms", gene = gene, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- memget_gene_go_terms( gene = gene, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1840,11 +1810,11 @@ memget_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memo ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_gene_go_terms, cache = gemmaCache()) mem_call( gene = gene, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -1865,8 +1835,6 @@ memget_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memo #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processSearchAnnotations return #' @export @@ -1881,7 +1849,7 @@ search_annotations <- function(query, raw = getOption("gemma.raw", FALSE), memoi ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "misc" header <- "" @@ -1898,20 +1866,21 @@ search_annotations <- function(query, raw = getOption("gemma.raw", FALSE), memoi "cache_in_memory") { return(mem_in_memory_cache("search_annotations", query = query, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite )) } else { out <- memsearch_annotations( query = query, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -1924,11 +1893,11 @@ memsearch_annotations <- function(query, raw = getOption("gemma.raw", FALSE), me ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(search_annotations, cache = gemmaCache()) mem_call( query = query, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -1969,8 +1938,6 @@ memsearch_annotations <- function(query, raw = getOption("gemma.raw", FALSE), me #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return A data table with the queried taxa's details. #' @keywords internal @@ -1983,7 +1950,7 @@ get_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memoised ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- TRUE header <- "" isFile <- FALSE @@ -1999,21 +1966,21 @@ get_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memoised "cache_in_memory") { return(mem_in_memory_cache("get_taxa_by_ids", taxa = taxa, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite )) } else { out <- memget_taxa_by_ids( taxa = taxa, raw = raw, - memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -2026,11 +1993,11 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois ), file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_taxa_by_ids, cache = gemmaCache()) mem_call( taxa = taxa, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite ) } @@ -2071,8 +2038,6 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @inherit processDatasets return #' @export @@ -2090,7 +2055,7 @@ get_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", raw ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "taxon" header <- "" @@ -2111,20 +2076,22 @@ get_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", raw return(mem_in_memory_cache("get_taxon_datasets", taxon = taxon, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, file = file, - overwrite = overwrite, attributes = attributes + overwrite = overwrite )) } else { out <- memget_taxon_datasets( taxon = taxon, offset = offset, limit = limit, sort = sort, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -2140,12 +2107,11 @@ memget_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", ), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(get_taxon_datasets, cache = gemmaCache()) mem_call( taxon = taxon, offset = offset, limit = limit, sort = sort, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) } @@ -2173,8 +2139,6 @@ memget_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", #' it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. -#' @param attributes If \code{TRUE} additional information from the call will be added -#' into the output object's attributes such as offset and available elements. #' #' @return If \code{raw = FALSE} and resultType is experiment, gene or platform, #' a data.table containing the search results. If it is any other type, a list @@ -2194,7 +2158,7 @@ search_gemma <- function( file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { internal <- FALSE keyword <- "misc" header <- "" @@ -2217,21 +2181,22 @@ search_gemma <- function( query = query, taxon = taxon, platform = platform, limit = limit, resultType = resultType, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite )) } else { out <- memsearch_gemma( query = query, taxon = taxon, platform = platform, limit = limit, resultType = resultType, - raw = raw, memoised = FALSE, file = file, overwrite = overwrite, - attributes = attributes + raw = raw, memoised = FALSE, file = file, overwrite = overwrite ) return(out) } } .body( - fname, validators, endpoint, environment(), isFile, - header, raw, overwrite, file, attributes, match.call() + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() ) } @@ -2247,12 +2212,12 @@ memsearch_gemma <- function( file = getOption("gemma.file", NA_character_), overwrite = getOption( "gemma.overwrite", FALSE - ), attributes = getOption("gemma.attributes", TRUE)) { + )) { mem_call <- memoise::memoise(search_gemma, cache = gemmaCache()) mem_call( query = query, taxon = taxon, platform = platform, limit = limit, resultType = resultType, raw = raw, memoised = FALSE, - file = file, overwrite = overwrite, attributes = attributes + file = file, overwrite = overwrite ) } diff --git a/R/body.R b/R/body.R index c9236e9a..ff9f456d 100644 --- a/R/body.R +++ b/R/body.R @@ -22,13 +22,14 @@ gemmaPath <- function(){ #' @param .call The original function call #' #' @noRd -.body <- function(fname, validators, endpoint, envWhere, isFile, header, raw, overwrite, file, attributes, .call) { +.body <- function(fname, validators, endpoint, envWhere, isFile, header, raw, overwrite, file, attributes = TRUE, .call) { # Set header if (header == "text/tab-separated-values") { names(header) <- "Accept" } envWhere$header <- header + original_env = rlang::env_clone(envWhere) # Validate arguments if (!is.null(validators)) { @@ -124,6 +125,10 @@ gemmaPath <- function(){ } } } + if(attributes){ + attributes(mOut) <- c(attributes(mOut), + env = original_env) + } mOut } else if (response$status_code == 403) { stop(call,'\n',response$status_code, ": Forbidden. You do not have permission to access this data.") diff --git a/R/convenience.R b/R/convenience.R index c2143a99..74a22763 100644 --- a/R/convenience.R +++ b/R/convenience.R @@ -649,3 +649,31 @@ gemma_call <- function(call,...,json = TRUE){ } } + + +#' Get all pages of a paginated call +#' +#' Given a Gemma.R output with offset and limit arguments, +#' returns the entire output. +#' +#' @param query Output from a gemma.R function with offset and query argumend +#' @param step_size Size of individual calls to the server. 100 is the maximum value +#' @param binder Binding function for the calls. If \code{raw = FALSE} use \code{rbind} to +#' combine the data.tables. If not, use \code{c} to combine lists +#' @return A data.table or a list containing data from all pages. +get_all_pages <- function(query,step_size = 100,binder = rbind){ + attr = attributes(query) + count = attr$totalElements + + args = formals(attr$env$fname) + args_used = attr$env %>% as.list() %>% {.[names(args)]} + args_used$limit = step_size + + lapply(seq(0,count,step_size),function(offset){ + step_args = args_used + step_args$offset = offset + + do.call(attr$env$fname,step_args) + }) %>% do.call(binder,.) + +} diff --git a/inst/script/openapi.json b/inst/script/openapi.json index 2a8567987052ca28ec78c6c94226793ef8b29e00..96f0d824cdce6227a310e4848dbad5c6b1351192 100644 GIT binary patch literal 18430 zcmZU)Q;;T1&?VfqjcMC9r)}G|ZQHhO+wN)G)-<2Cx%0jI{}H>fby1O#btZ06is9<+Q1d4Si1{(11x}aKM%>r=L#qq1RZwhEI~iIEEC#cYcoLdC z6l>%SR3mWr$EkWUg?v4^BM-A^awRlMn^Y}AxX?$uyic{)QwsM*+JTz|Xp=NQ4cKTW>j2#JqPbqoT}cAvOE+=s&~GSiOSlE!Tp z{t1cbiMP9W$rZ3H*xswg>R&f)QpBm41?AX1GHN4+~X z3?!~!e2vxNX8Mh!$glL)`!>mTOjJnblDgcgxO6>*0D1Wk~9*wfU>k1pLc?iBH!#L&Q-m)x1Y1_+W-k=;JSlCv-f4q7<}f4&glIS3ku^9sfV zzCIa>cMtG(2N9XWW)Ba+{joz<8gmSS6ex7*`bISXLNO8upfO?+wgt`)7^Z}x0tJRV zT84Fk^~ZrEieVOy1O_M(K?s9D2;CEdFq8F}!hX7+`jP*;Awn_>A!}eHumB^)G5Y{% z-C8^b5e#I3Sxz&6kfS5Q&GCKym&u0Gd5H?BYE zA9Jx?;I46Hf!m;odzgUjR}Apy*`N(&5v`c_h+(V`yzi#Lvd39&0Uj>y9}mAs0WFOE zK#yAzq;q6JIA_^#3IYB696b10{$m`(2?E%|_;UqD_b$~AthNmqGN3NMFBjOT3k0aJ zqQD87c^%w&9+4FDid=}mrDll6lb{esR0)~rpx8#RQE4`X$*OC-1ZkVXrYNfL(2-(| z6M!bqY*REBh%2Z2W6etk@-*jJQzgcTCId46YQJWMkYX^sP(5Z0$Q)j%TgMgnfeC7# zogP7+PG0_3TWf1;b8jnRhe2=y^pa+YQK%+jr)Kl+jfXu=8wFn{^RLiB(9yj=&Ex&v zjIt$PBE5>U5~Y|z9{Ck%aMM%Mc|fv&cQoDg1!r@5zc6UgdP+>DDDbxa+>k*dzYY;e z%uVSwIx2Yalt$x}R1gxy37Ai@?lPh2B8dGI4`+qI0HEa?!s`ScI&U;uqf21J;rIs7 zJCM$09HNN?%BFx;6e5U2ALRFn!;JkXC=PNI>!Hnaz*E~@d*9J~FJz!1QXKZ70_b|a zAwuvGJsf}bp!jhky+$nk;$kk(Ux5UV?P3SYQJXSG=1`LC2{mR^T-6rWXl5#~#KV=Rbvwp=<|e@iF`WSMLE2VxO-zK3F?W=+nitRs&V(DV ztwS_?5+cNNr@pCaD{g`xDkIzvKL9iN)@bJ z<>4na!e*#*nR(fEL1=m)(4;PRJfEC%?C=r7u43k*y+^lOj)qGkRwesPUC=+^E!+5A zgO#z`_THUb0ez0ftlMHCQDs=3>`ZV$q87S&PaJ~ln$GTWyo91=>n0y3LFX3~ga5Im+_&oO7Yil$}}zyHr5~ppCXL&o=_J`AwWF9S0Nz-7LdpaK~a2QB&Wo1 z1G0hOc_q1>QL~#mn}|b8c`M~u{tb>U4cWR12*yZ=9Q+sN%d2vvZkR;Euv^hVDaBJu zpiOrb0YG{ZGRE|=HxaQ?z0s8Jf3W^c78;jjhc69vh6_SNkFj|ECS&YiRkILaWF@!8 zWK5T+=mtj^Exk3TZ&-&zMxd8>5a4VikrL!D=3z$FCb2eh5UldY$=5C<+8*%FoQeEQm;YFN-B z;Vx}1>_jU08l56A6CqjgQGEi)$dA?lzxp9u3P_Ly1CqQkF^;_|#uI&6wDoh8qxR8k z)rycs@R4M`BZx)kBW$dZCb)JqGbmH{%b$M=q+z0_^rsiLLM6@r((6*W0%g9y?FA=n zvJ2J^tT&|jCozL~uVPy*8X%v17BOb*ylM&tNIPK7L#n}B27r_xtTYx+cZD!D&qFr{ zR|5E5@zyO^>+}jr@H&}J_^9itAPe^Kkh?}ZY;_g79dRTlw$aP7h#RWR*bkGsycogO zGgY>V0~*N<#x+sro)rz4Kp82F!wDY|Wgy-o3IQ)Z*aA^HM%<9@fJD8KxqKk zmdJ!GS^5=p%{o_pi`eA@e{{IR`cJnYEt*<<^e-7I#s?PMt|KV?rBXa^y&*0HDlfG4 z@eYL$mqS)mjBx_fm9&Z{wSnoPB4vjc2#CFqmoN)78M-5Ny?T(54s|4e=fD7_q!s`= z8giQlwns&owy|CJn@#Wh0=Av`gi9d9#NH4SR9Fr*zJ-{zjmi&-GJ*G^Z~4<^JZO;- zH^irxa9v3wc<$*iox_{rRfjkN(-O07w1e==thx|krZB%)@sS#35ke7kJ3XU5;)98; z++l;0!vzX8b5NwhH5;`wh{z$`6HT+jDA{%PYS{mP82T4M22Bk|qJ+zjgU@_I<-j3= zoun00{kfYml5NKtnNB(CZ}oNPv4wt(p8_0|QZ|S>9Sw$fTP6-Duib9S*nL<7^1@(A z3m(`iN`*V-K^C6|3e=3TrvOn!L(?PhSYB`}dNfTk!9wtYqYUham;e?_&9u&XZ|!-I z<3kgven-_o6PoEf5h~09 zG-I9)4hqLfPLN#@_0dT0R#g zM4GB4C9;JtzU0ArHbTFi4yi<;>X42ar(~KNYR%*zLKAQ>i#ju+oaCmL$y{~J99$L- zaeo=VV(>e-Y5==E%soB~ygAXdO9EW(hCHCQLKPv$BQcX)M8ibLj*}&kx>Zyd?XjN( z;QI}ikDPm;t#>1!vKr^jf<-m$emidH>_CvP{usPgA24Jpm|m#q$Q9jj{2b@^0SRyH zqL_S>ZQ`wZe$vc+i5k`rjLmedSwtomoSPHBZ0h2pkq^RzcDqh?g z`n7isII#a|1QIsW-~J$B9J8naIwrxfv_QLyy#XE@Scx6T5VM`#QEc%GXsvlOI_^Bm zgF;t_19iOWHP&dtWOU5H#PsB9;%ZHYULCCaHVM3o`-+>d2m=SccI+@fFv1Ac!YJJ! z{TvYGjFg@Sw*f9f)%opsWcQgq5EISlbmPpVH!pyN@V`?ieyr8G5c{~1TTI&5R@474AYn*k@0xTWCY+Mf>AdWhgyMS zZ0LwV{l`ah(gZAqT!n%iE@pv8hk~0=r)D+?%EyZJt>XD^p|}M3K*B%)NeFfOP7!Gz zp#jUN;ZOLeX^SXc(TfQhz0G_jB(bk#1cCW?(8og>r6wJ@{mz+aS1s#^Z`wRhJl5X# zZ@R8(s`(SNn(wV`uF){pOb=gPgSjxbuH|2cgmIycEZv=R6ba4IqVgiUboM6p8vS`t zkk*lmh0~8oT_~FJG}e}1Jq3RkszZ)CY9zsODea1I`w>5Fa4AoNi&%TM%8F5q!Jbis_#j9M?V<9^MY9 z84Cpr|Dhw>*Vc#YH38URmE7xeCFrwBAT{Iw;cM@i01XB_UMcv$F5>IUdaivwLzY3W z0f52>FyU>ym)}i;?ed)0ShZ%vpFz3-5j+6yX0;p?v?uj8+X9lu!iaWa5h?LsA3 zS9BhavaEhot1W*sp+L~sWB3Gueg$SO{J8Qsp*}~uxYL94V6cZ)3ALF-a%EQ!xeBFdu3?(7vZe6P#Q1G3ME zJt=r|E#c;BZVmh6Spu&-b&i%C1a{rf>)ZR(C1b&=!Jzr60k^OROu*giy0kBe1yRT- z3=aI=rUuhep_=fJ^s3pC#Qw3M>Y^`S(C?d!rghHwO~8sFgaz2EtKYT%b=;m=AF$zd zI6$&CP8S4!LPS6cVeKGJB5f(OoIB;roQCxv!hyz@PA}nuGltd81nhjuuqy6uW_Y!H zsmb8p=GLaKDGu8vN%>`YYvMh%xw+YNIRA`|5RBciqS)i0Go*}L(JCizC)8BHl-jQ` z(TR)o*2eb_2I`90ansiBwWV$E&XLSAB>Vk{4j|oR=Dno!GXI*qN4VugT39?G1xM6r z(0l1tI{?DN=k36sa+L7)z0g{J7hHXRoZV^k%LQkAk;lNl5~Q&HcH8sfBFO_l7E}W$ zVa8ZlZ>dS3y;L}0KY@M;=5MAn^1x8)wYd)#m#6`@dUvzyp4tsCKApJ+U(@8tA0q%u z_&S$}-0!0jE7UneleqVx#iK!I3~FeqLazO$TR3h6t4Tkzs$pFMYD zV4v>4$!);myW`!A$TFJf-EFVg-6GEZJLKURfSp2v*@+qZ+Z}pJ)8-cDQ8FM>HXpUy)|gZoVj+@4llSk%l`qDyd#_Uz`rq~ zw>RSb;k^~Hx>oSF&Wt*Yw*!)Y}_U z`@<#SYv;?B8;bB@2H|RZYpq*byZeKn?U_NBaBU~Iwzr+9G@k*|Ux2H5Y~0+J##;!_ zK;-q(B>ede0q^m-ZNul;%iG)AC47L+Z-$_6_GS*D=EvY;W)*nW!QI^6zd9t$WEdF! z0~)7o55GjDYf1ocb#*LBDm=_jZ*^&qjWW2pI(Rum2-yqB<(S}hdwx}M-z(AfYMAod zUO(^MkX@blFc}^o-tF1(YYrdo@dWjrYxHdhrTyH^v$Y4rAkEpoxbMLTY;Um0kdzEA zM4T8RGa~Ja<9?yfqx0zQ8{(vMhkW4D>^<+1V2iu943yc@lH| zx&qkrn#z2*-2m*7bI*6T+Pfhebbnkq_Pif(HauWoDBh@<=_8gifW{Xg>jPyH*jCd|PeA@wW{)ArSVTn`59(O>MJ|q2JALW|J|@R$^w5aLJF=Xd<2AYGkA!&fJtdZe(aqMLC9QRkn~@(WMM*EE zMNe{LBx$?qV5S^G50Dzny4r|hE}Q=L$>;8vt;Z#PgW^|ib75ML#z5alqLKEC5n~D} zmo;G@Pxg|b2k9UB(z;7vwzT<{JS9bpR7sYo&l5vP$8_WU%3KP7=sXMKglpyHZzV)Y z?!jn7R((v)Qj)5smz|gkf_XgNWkA8u_XhXGGk4oUoy-?!VQSJyXr#+)wN2cr7)N7- z!7U`myL+3;z=?fiO*(OqWLq8RH`qKoe@shc7MsMPdSIi?6tMJrOi#mr7lW__A)O)y z(s+()iuhZ-mc{L|xXE0hniI9Nyac~W8HYa?hXBbvKd*M=z8=K16W}ujUG{mXsWA6q z#wcb0VAbS1SY3v|INxsECA&UxY-f4ZB}z*EtwVIG6UIGxNc}6HdF=h=cXx z(TNtZs-RGRcN z2p{d?e2$8WB#yeZc}$~lj%fz=SEPC-7D`Q#HCOOBs#lWgEpog43`@HgE^B1^e!AZ3 z%wObDK~JD>nWZ<7YZhPemmOxr+ePjA4?K?ds>`zzg&gAZP(BnGA0& z2L)?Ejr=rpGvap*N{cN+iny$t@^fRS>$3kVG$N{fNoHFj ze|+l~Po$qw5a1h=)U=i!7nah)eNX+SP<13y(nx<+i=D`{Z? zkZhi4lkpsh`kk1-zNaljW_qVD#haWq4M|Nk*uUC!eq*O3_FJd+U&U79tWw!mOvwo& zynL9I)Z1s`-@EVl4VziI=o?2XIR(dRc(~oGfrif~lDuc}U7p;gAE|Rm(MtKEo9^<2 zQLk05-0g^hxgBehNU|X>qCUPu=?za(t7?fYPq3^J7>#~y_Hk=EXur{NI=`H2ii70; zy+nGWZbi zc$sdlFaB4ele-_WJf<1^8O=STcRs4G3ws-s(C%4}O(9Raw;UY_{N$G3MAcO~TTz29 zJELRsD#%sp&(&z0g}^br&Wnk+w&&k_IFU*5=cwBzqzOtqQSrca*I`7fjYMM9y%kvo zY?HFwMK?|zgq){NiM^}Jd?u+F#rsE;<2!l}t32RInS?8uhCpBtiEj*>gvZx=?>50a zNZ5W)1dfVoRTsC-O&xLL^NcJ96pVB#CQNdsv#f_y(wLi>&$7ywiAdtqF4Lw0bl)sg zksVk-3%l+cd-pi(m(Q9u9kj*io*zXCi~mLrn7Rm!?cd=}(LEx~8Uj(}6qBup%t->y z$11#IUv05K*`{k{ic5ZRBgpg668G!zKuno5i2x_Xv?EXktV=bpO!;(V*WE?_tC)}# z4duq+aTlavq%fjBVqqPJBv~khV4|~+8<&p2wq&bNN=NtG1ao>5MXAiAAb1PTqmN@a zRHFAn7#F-dUJ&Nvo3d(jE?4!-3=zrRNDzOODD+klCiOpk!io=%GD@~-lN*Gpap<9V zG$<4yV^&|(%YilhGYuFw8c^)D?cc`e2F0p=K($33j7laYU9Tz__wuSzheLOUaD4h!C_13~8doyCVqA$LbU9G=7r9I<3LYk02#Ym`dQl*H`Sj3K)Cf>=ww4FdX4zEw5H#UCVJU^C|5+U({f!9W?x^!m-|=$`eb# z`h5=;R3c{asy49OD~t*z=5`!c`#lQu%OuPr9b=UWI`VrPPcV8`*;q0NiJgUu`E|>} zl+qA0g-%eaBc}4$#rG04aQp<8>0H`&Ek`QPyAvRF;xoNvlifShRxzU{^o`1;CgVfy zy0|=|{z1H30(E9|9OsQX3DG=2q&N51{`$;xMcb=sIE-k;vh-T0{;EX|rl71nA=D{I zH7l*@*=F1ugxNd%`j7KJKJK4l`kFM4X%-V%^AG|gijsx4JWMI{6?G+p^&;Y`1n+YU zA^8YohC!OAJi~cagpY{-DCL)K)PqQS*V<8xr2RR{^SL_oVlc4^yP6dFfce-9ls~>ZWQZ}u(s?ph-a>uJ7aqgXs3ESR))*u- z>g{!Yd9t+~n6T}S6l}p-j(F2ZUZv=ZZnUp|=k^zHH>b6i1@>vrL-RZ#x=gLEd{Iwe zOgq}wt~-bCdBxl$^QhCfmrp`mfmNf&hrZ#as|2|_xJnlv)S&C}V(Ts%{l{)-aLeP#6=gT#-?jE5&y~YS82!ssYQ3(ff{B zOoE)g2|9`zp2#&XkW;GMfOO3{UB}q59>>!+DVgbY;u&v;g>CTu>{BJcxY`EMbU|fX z4LRjw?%m+Vnf_m%$Lw=%#_%59#B??uMdO2wv5w5rWE0_o-|aK%Ruk!pm7A$$T5w*R z1DxNZ|IO?v@BU?TCd$qiTtB?~O=E}Rov=Atz~NLn88VD}8RgeL&SZg0@EX_4h#MH& zG!*0ZYm1S*Z!_Al?*!}!oNieH(ej@L-k&d4(UjUV42hfOAvF#!7nS56RC>+5N;m#w ztE*k&dYRU!+UH1ymalIv>!gjUfj%?*D0{(oToI+VU<6jT=&d!Kq-2hGgFB?2!AQrr zHvGaUALKxlU+edCId2OaWWdJlFB1nsA)NKZ3`^S7ope((sJMpn>*Zh$`pX&EpC4|2 zj>@lVKz`V8jr;N_|ESK@6KtmLtbMA^^*(>yDuOS(d>yqAe(qon$e*XgzhG_uX5Pag zGGFd)3EJ<%zd%^9Kfhj1pH0W$ByY{Vmb~P>k7fbf8&h&B(ee}mZ2{=For{I|i1XlC z&xt)~sjk@P8lquC#-(DXUiu;Pa&MokmRfyf2hYVSS(GXV18QZLZzet4X7!5#?cXVh zS_&QC`rN{j4_&c_+V^TE`g4U~7fHl-J$m%OqT1v4Xai(dx>;C@QRy>LzAfy=V$nZJ z^pD!#*YC3n43p4$@N)89t9J$-D*`-0^6C`jm=x(>)tAz*_YbZ=S5^*BKV7Sq1aD{Q z5Akd3pJ$(N8YiC@_7v%_C+}BMO@xlbz*@Kd;Tx3mG;N5`TC|b9g*pRwZ%+r}8B6g z3j8_2mUVOI7iRf$mIr8>%^l}ZdBWc-)I(Nh64?z}&rIk#S~d1-wA|wn&WRS=5tuo z!(%9j!`VfcIsG-Srkj?ds-pFfbA>Qp<+=kS^K~7sU>1M!!mLs5m3tp6Tb07ysIv~D ztolLuV>kZXvmeMQ!=zBPzpHHS02Uwk5Ha4je|z41)c1d?vmT-&IA1Pn&20F8L3?Z?LT3lWwRKksi|9)?5C)+S z>GA+9Rdu)vPYdfL{7bY{IMd5abtB<+ur>U(%;xmp`*QhEzvmK_XY{tvZ4gH)Ac}Ef ztURb!6fh4Iq$=J6#Jw98Xdc*xZ~@|LiC3|~WbkRls63kRI>oiM5j8a-c$>|UJ#!!o zAioJr1)@|Kz|2O*hU#JHEkd$wH0Vw+gXs<|HUde7TLeUK*sQZ_U2he#| z=GaOUX$nuc!pdL@>gMX48XCT3yB*5q#J-jWL!{+!K1YxG27yVR4~U(pv_g zvgSilh0zlq+WR7Ui$&1>;@oj&&0i}ta3rhI_K~yVm_?wF%YZtZXlg&kY3D^XH|Rmb zC;heDmv6(D^k(AL(90?bMiQj0WwxvnSB)LjM{z(K1H=;>WM`l`Iy@hc#sm2axtyw2 zb6SVwkj7N5=*3u3^F;iXlN8o4%@QQ+`{;e{$ul_WdU*FonlpYOi4-m*fIv`^7|-kO zPhfP?91=N)(Q7BU(d4OS@)G5KBiNaZ5qV8wop{x4>yTj20dUg8kZ*PWf!EOj5#*ZG zlnnRi)RzHN=*C=Hl$yIVZ$~Z)DGkd!Gd@|UBA(=)--DJ4$`e+Pn1#tD~XW#a6JDtLytKXlRXtuG|^dGf6`IP-$nvV)JUm~5CZ ziV?D+$8chvOE(YrXB;eht*)f4rJJ!U^P%(3en$^>20bsgw%`)gNEw>d zaFA9z=5JoV-eX||<30`sYYs(h=8W8{gj}X(?S!DVqMPdCYbaN@164_gg-_j|1yhjG zbKoqVz%(oci~H1#t-fQ~fveXiSTT6g+Xc4->XUVEAgcOZl3YQFdbZ*=@`tF?cOqm) zN6A7#E5J{;FQtRaWGtmOS3vmPHQz=#tbQBerYNSh_x*MlX->qP)7G?_=#s1*f$%JqF;x~#KJ^s4sPw`Rn(+;(-C_LB5ZQ@S+|kt$Kx$$$Ir<>h|m?s7m47GxK!G}HKcWj#!V8&RR5z*)`0aX5UJ}FADy@0qGzd2RW77TG!gd~L|XJ1{M8jlzz zMHf|z5yBiTqNli7`F1Djrq-2kxcPV8JF=K*yK`zccTE^yzZ#DgNu|uoN7y*+D$vlJg;|n*wCS8PmiYh<=nacpEYxGcv;06VzJYycT-k?bFk z@vDDXi%EOzv1Pmo?-M9P25o&63ZZ3Dxm%i(6K>T6nf9#1xXPKzw$4EbX^)%^gC~vq zu%`^eFZ07wOr;*VsvNVAm^HRuLV%*H{@2!qj8g$GSHquL>lV-ehHWN~-V(w%5+o%1 zjsV!$CW-CV-9#Msyi?jcT?P+4lt-D9tv)4aIejC3K9f$%b}^#i0Y5BoIbtJ<eKSA zf9dv^Q#E>hUX*`x8NGM*3v4aYTv!C`j6NtKn7Cg4&!jvkx)gd1ZoGy2ihO2uymC`=l>9C;@;MU_Ixrdw2YWUzu_8jE}W2l1l zd$VnTKZ?FIWT8g(FS!w4R32cvxF;muTr!sIossEDne$`;CZQrJVxSZ|NdQA4XAx6K z)lFXGCTYG~Q?~oE-a~8%+7e1vC~zfqDIwS|ev}d<^=|~fPx0GHFghE`!3DvoI3atW zY<&F(f&5&&B6VKw?Oq3I>02`)i#$IGz5T4ckiLvQoKOL~Z$sQ+nBmR?sc!GPn6}daN@ndnZ*ojv{&( z)2c`DPxjkXYqYKvT`5KQN=Kej$rt+-nRzW8HWDgss!rjB`jg$MY51?WtZuy*1Tjql zy5nWcbNgIl)RYXZ+n>3F06j=cje-wFiTj_@-6LsI&PrZzW zxII>l>bz(dEU{#cBv4*I4W)B_%&ikd+=n&zXxn7ac^?`k-B>CSNeJzfQ)SsEZHhDI z$yMMlZL%BJn%+MsmjP6U#jXLVOskvwZDlo0f(b6m15Q+4WY)ojN^@Tn=4Y&Cnrk94!ooIWss?sU*dd3Aw z5gx`^qQ5vG6iUCdL6ydrafhvCD7x-m+8kDeB=l+2_B@P|p#1P+m;tHx#$b)a2N?ny zNj%`bszeLIAHOkms3e5_OC>q(30Zx?raV&HE=^rWCIwqKJBmz^)zN3FIvT4wvrehK zQaP)Obiscrw5K{sipJLtL!%DT?LVQdC$e@%2Bo-RpAnqJ0% z>T@RyQgWzL}=0YO8qb?@3*Iw&x<^h1Q?b^0Bp z`sO%i069Eq6@oL&gP(WF=3*1OR$o>1KZVVmB6jqN+0w`Hny4aa`->`0e^}M&PS^Sb zyQpVM?<7<)Cm--0*6^fIY0BW$Oy~ayN+laVniWr0TOt%*L%3hoWTUK4cAk+PwB(qH z)(J~n)Hag+{oMklIH!d3##;-lVk*<3BXeM-#KM+;tQ?_rLDUcjq_^8AwMZ8dHV(Vh zEVt0|C)0`-m&Du+1$u;5v)IOyJS^RSWYHw9Csl&B2d3JX(l5zKDI07FuB^t_ONs7g zA!G>Wl*4igbjO84mi5d`pcTBlmtb+Mi z$YS!PR9Jf67}qYCQq1&g_xQ>zIs_95<*{r9nnX7F~ zXkpa#>J(ow^jjBS74>)(Uuk-tF|Zr0IN+M}khQZ&35IC%w1T!FkEgnOrASotA1)b9 zn}Mh}0#}G~@EKOP@>PtU{o`MR8>nuCR&Js&CQj|7sE#rZN2%Zk-n>CB_g0;~!rgjPabuADuSj%-1Vq8afdjPN=vYim;a~Z!tfCUK z$V$o~kJ^==Mo|e_#3f}=l~h7j|F3!eU?QX(vW!N=_Wy19zfIqFjb19Dizrk4{~d3f zM#xGku*y42sh|w)>|qj_xm0jwbTF=y(}EtsFEu*249%iZDVz%YAL>7h#VJ?HCrhcI zER}*X%<`X5Vrp5cd9(SLY|Cw#BeQ>yE(4kWmQq02HWw|Vi|P9N+F1VwKR=E&@z441 z5ys!>cxL?1fffJ7Rbv?c=l}mh{%5jG{dk%U|BHsF4AW9q{2$EEI%p;Zq!z~zP%2pO zfbiuIw5z(G{J1xU4IU8LHNG9v2Y*= zsnwp0BF0!IDvn8{w8$EFy3jo{6CMuPrOCIK{p91mnGN=mjb_KF?bZjCT0MJ=$Ojzg`sQ;4cm3ymbi_|V8weB zF#`IpxFsNm8iCTqwuLvvlNXT<6gxFtYp>2NlN0d3V*tPQ95%Hp9Fc})@Rvwm+w;J5al~YV?b>I{^HMgDuE;6&i3N=%l}1!BskX3S60PqaFVU0? z&^;ET4traSb*u1FvKw#o7H3H_CakqV@WnF5?$o!Jek@O9QcbO@T@>we1)0i^<%Pu- zU6w>tcIRy^;HfgSw+w8>3zG5z0+{r2a^d=UEG#Xih78{PYnf1%=5td0PkJRAjZt6~ zhworCBoS9B(Rlv#{E)|~!SHEMFdO$+7Ko%ED?U+G*)*%vP9UxwEvFh;D}oS!f!iou zdpUhPQ74emLrowNP$4v_k419B^&bAH^Q8%v}S=b38Nww)efat1sRXRb7FPZC;hFIQyW9Jfu`HQ+OL4fSO+%FYwwg}S+mfqc4aJ6Lrk~*t^ zp|(iDo z7ww>yr-K(&L8Cs;t%}o9Tca(is}?iiax@qEXYWX2pIc767im+EY_4OWknh_UB>P6) z$$8bN18ek=QfC1};)oLJE))ai%|N^#^^{no52iXh_m1T30;83X9{DE~5!&tog#4W! z&Mf_T*f9^wr9@340s1zh(+QE7(VRL&Yo(1by})RV8gDjL!fwW{+=|`_!V*)LSnKYq+p!r1pz-iw0UV`6{mO$nf{26cta3xGp#zhUasb_o=6&ZTT)qS8+wMBR6dlp`ZFp|`<^?6lUBo_pmuchGG&m#*vJyDjG zQ(lE95U&th!3l1cjB94~peZ4fR>kL0tn?zj38Sgjdg)qKwRLV=gssNPX#%buk`l%w zTm7d`t2Hb40c0RDXNz_+ie(OKf46KuxUk|0Mrq&y1?daDG(%)y>~~fWc-k>S1KyVL z^kpIm495Tdwv5qRDGDFWvV7Xjh;kZAf8 zM|3HwA3M|TKzSp}2Pa^_CqyZ6Jg}#5x{yH%=n}EDwbmteevk4w6;}uq%mE@*c7{-i z*vhMZCygt=^kfE#^N1-EBUS`jD;x~%K<*X=<(iRZ=_M*it3Y8u7GaU>D@ON`bc$Hk z+gpJzV_tyL6oG7)$vW}mk;6HKKLm%To5)>h$cwr2;CG*O7is3|;HmLXzqwU&2GN09 zr#3=a@kkv@0CppVs(!gGt};d=uNG7$L(l(xzc&^QC=26^k7A3+%iL;(Sj)?QN*8%f zVC9j~#TA%DAY3*0=tQ1+Ncs3~9yqWI`t)RjG(IfN^94UVCa~k>gONCYZNUb6Qmi4T zbptEtwrp`Nb&NocA=&y7KN~}T9mY6C^mAo&gJRcZBbbCjV`3t8X8+Ur>$@p7oqk@hwNMq_s`2}PP z^G7AjVuhkcu>p#v1}%1YO=5p>6DTOB*g7|=41`YqSXJ5NB0o4P_0A<0X!oher$sUD+O=F2%m(K;}wXI*7Rgyrf-dlIjm&e@Y4d~~ z6;-dr8je=f=3+d98dyVPZ|N<9-kVc%3Ms!cu^jy4WU_il8#==&JZ^uRL68rf20e!@Vz#wxBasP6S6vOWB3Jb0OGaDjb1nP^8MMmv;}WRlb3|9 zs2sy`fyBZw?|gax~mpBc$z$UUwq}zkNmAukyjsIYS=pR|)^+^AUAs;Qf~5 z(OVl^B*~Zn3G$X|ui4NunG7V7tV1gm5XJ_Pq8Ik~n=wkzc*6L8rBa%P$OIii34VII zJNle?=;0=Q@D-T>=OemNJZOEUQ_l;J{{jz|#ce<)zKXNy(i#L?e%Js*Pk zy<%2ojTSGctYd1w_7J`X?KAd4t)7+}D3bN4vXQAL2;YA?WFtDAFVaOCt|r`i1ZUdi z62dq6bZXsn$;S$;{QY-iMOxXVux$K%IwjmKD&`?IG@*3c%{`=v1pN`bG5lv%(zHUd#K_b(CI{dml{}jUHJ2MX48$ zPoF+cl+r+*PjWVl1AkPiP`ln{rA?s|lb1Q!joGEv#MD}s+PzzAU1~3Xtu=PgBW%FP4D$sEB zFKebiVlCHqiHMTHh?69Lx`0mc2=~|c&%VX z>wRM~O02ag#ZmOskyU5pm~}$oT3p&YYK{Bc=QOM_UJ zx*z3L(bKP$R@DtY)ZG=+_=U;af01#|uz7{z>&*Zv$zqZCRh+V9@%O%G5!@{)*2={# zY}{y)3Oij=P%DpBDswow(j96X4AsV8a^P$=3ruyz18h|KPqg<|?Yy=p_%tTcwSo(& z#P3DI^bD+_VAf#={WZG6JM`d%r6(tR){nhv<|B|;N+$XiLUCBSw_jKBMIow zXc?LoFF{A9i7RFBT2qjaHHw38Km*}~<53S<3n|6wHh4XT8{w%Ih^{V#XAifgp_d|d zpN(7fLln+vkP%i9eYpj{vKf$(=knjyG>;*Pf;QYS{tB?FD4M9?0&=_5iZ?T$*7uq> z>Z&OQ(u$6EvQaJ!s^W;j~@6TdS$;UCOwox&=eF(( zET4F@fe^n>L+w4im$qoA6@_dxf!JQVp%r(wBU4Rdx(`mA}52_N0cMVxH698L9?lmUv+oDo* z78*VZ1!$Ig=rg=zQPzR;9MaTBfEksM@|3pgkx`=V%8RD{uO`kso(cbtLU(w{g6;WZtmfXiSn`1+$v~tcZn_S<76wA>=hqHe2d-V8z z|9ZdQ&&T`odjI==KR%Dg%SYo!lD7LG<%+^_vgBnL$MPUk>fN!upB+I>Wc%ytNryz; z)~`m@SbaG?$N_v`40n9CLX&w3{ilbLzqfkhtKa3sNlnC+Z|lP?n$cF-! z?t+t}AvaBfHw~~KD5(;z6A*`$Z|k5YK^_t{UZ}15$cJ8>cnq5tR%G0gZAXCqRmz## zSjzMsOIgxkDr)4F$V~F5bq}|C4b3${9jTe68a&Gx=CeF66Zzq;w26QSUlEW zFnXw&2h1G%!3~cN$t*7T9+WOW*4}g7&zq-+@m)q8bQ~NZAUGc9^WHii@bhiKYgb|0 z9fR)TdLnxx=$xxQDFZU2ZZ;Hu!WKsnjRBY)hg2HXAA*V@Bs+-6vR(mZ8i}pLXy@Us z7JZs6faFJ>kEM_b>!%aGTHKh~s+&9MuUvAAF-}Cjda8?C$H7mftWfb$?>E%Zdt6~h z$YuVY7F_-)96U)wj+Ps}RWxIUY-^5rq`W77(n+4B1;9S}zX(!0j#vJ?KLiE>NNT#3xc^ zjX9=qYjEOzx(0t=bj!2G_4#OnpWD(~n=5aqEjAAJ_r|OZDJ9^c&`-1bRIY{=Cx;`q zN&*IlY9l*txe%iB z5T>$oH?`qQ?cV9f2LJV22jt;R`d0)Zj4D^!ftX5b*}J>4wCVbR{b}F~#BW%EKl4W= zHUCn>$v?9rGuu-1OpKEp8BvBTQFtt}Z&@?jAK!GNHx$_oXf_Qt%XOaGLf;gSm4i;f zjlEBNcY9MxAv?sJJ1iCktn2vbi*z}XmULdSR}co$)a@h7^a!a$#N}RDOUl?6p4zSL z*BcS3cEU2CFe~lF9({pPlY0wnJ&xFY>0I@gFYE8o5OY>;oZSI#&``xX;ZWtc$kGxB zL^m2g69~hHRM+fme3SKod`V~pMJg|TGmUDf-QG%kb5X&O0TTDflhTNPf;t@Ts=JZ@ zqPXD9?8hq0z&4gdug($Iv(_;EFIxCY^GBC)n*^0#Q$t0t5WtRkiO+GRy9SowPL`WL zCK?`|4q7A8?+JkNM&gJCd1ykx^RiAs_Oh{Fi)|TBB12;5Hj{iBya(=nXJ%fFCZlOG ze3+OeFC>V(_PY6*QQhW(wNs8P?tv;y{A}QOWLT<-_^dq~FmCt%Ws{ks_X@8lD;>9U ztY>4qPoA3b3-_3<&24Q&V046fZqAQ#$Yg0D?ehuLG=*Oz-f_dixQ&`t>MEKfOGi>;A516*s)fb9q{(+2$OML| zB~#^qBS*sntWYQLWZpXxvQT#jz6@F)?pF#i?VUemM>!h3zClB|5W9 zo!QcL7@HbwIDdT~cJJR|vr4kGiYHn;2kh7h9B&2qx-DXxNDRBz1f-i5k69xTvZNs!Z7`**V2mU{3~_%8p_V@lB)2?!|JFq zqMZ^kD*GZ%d{kr3{=V$doE5k}IcHwD8{e^QVIp1m+E=l^8x`sk&nQ$M*m0$yc~$SF z0W~XV774e7L>^>w6;mew)rC+w@mH}D{D%9RoMx2QCe;%87aKQ2YKIR?a`|4E_uRSv klqUY%2>jEd^Dgf1R2e#wBP4FK$o&QUAZBXFo)X~uA2i?63IG5A literal 18370 zcmZU)Q;;Z47c4q6du-dbZF^>qZQHhO+qP}nwrzXP{=a+g%RLnx6&YD8R`pAFtW{Zw z7YPpV|BP$zNS96agtJ;Z7Dw3xYjq!zmPF5&t7Plp!tA&Cl&2?6iend9pa#9Me zjGeE~Y9M|@VgdM~qcvGWJacs*NdEjCa^xSgcgKTu$I|Eg=FRmBtJV#g(auLrydN_W z*(1capP(s|7Uy*=t!)~uO3(RFRzt)XAX8k99x$4k5?M2zIQ=u>Afe~3drQEj)73@tj8HsQHnKNGQ`C;^VY?-a^-MsB!s*ZKX*QfoTVni`1zk0w z&BhySTd%|T+83)E#7G$;F6cgMP1cz)=lkBozMQ|=@z)wLXz_b9xCoasaMT8|C8+l! zj(9z`nsBnr%|XEg>|~I(UF|q)Oh7zBlP@DqVQs0--tXm(hudze1b8|61~H4_SdGfR zfzZ`)z^^l5LDp&GW7<(Twt|}YqH9h0o^9wqa2O&gN1D9@u>j~HIra5oJ!~#^4*C)8 z?cTSXhGb6H`ldjZYS3IUy%J#CMLb-KW+y%V<~nUdpmu=u=RwDp z+@LsV@ZuyJpn$U0cNQM3r*JP7S#T2|lTQ7B|kXTwCrs znI7Ww7>YI-9?;l12g6#^VD#br;GF903hx4)xd`SlzCXTh)?)NXxMy?>!*3>jK&i1-?|bEL>cb_rSBdqAk_ z?Ms0WL15d-4Ev^{!Nxkt1cXPB|J*}UOndzN$wL=k4Hn3Iw}S|K0$|>joQyfk5RzQ5 zPMahL^4i+G2|$R4;W`>%w*mJ=G$hXe1-=u;-6Cli+=2tVqw&J`4{U7SHbmq^swMJy zjt_w4vI^6+3#wzv0P>I3Gm%B-Ac|PbKXe_O(+R<0rNF_8Kcbl5(^G!SDaPJ$SC4m^MatF>oxwWtD+2uLl+DewL0a<_nT zukE}Jhd=@xK&v7Eo8CC%(T=;pIf1bx+qDk^1OXP^4yt(vSVDkRcTdmGCexefQtZ9K z=vF`_79u==?ZWcY&L1Op5Plo(NT5%>{woSX8qp-9siP^dFOxu-^FU{x6)w(SC!cU# z4b(mVwmXu!8w7r6Mj5c~+*(glvG2x2=|jMGZ-FiZJWAq1kv-u_xGET{NTv(gf^)Ds zPTJX8I-g72+?QG2MqM%T{qQH#J|IHFy;($0!jY^xnSCH>FnnY^!3R&%9`ueGvpPFM z&$BlAa6mccuo?i9Gk^=BJkrw{40YD1vq5SEV8yzzuRMvpUz@Hq2ZJu4PwHL$BqHd8 z1c&tJOTXIf4x>K`2==noVN23|v^X}`!8m+rRv#{H=LIn_Wx;o;=)qV5kS2qrdOP&8 z{2KaQLsozCMs)dhfmm<+@FIX3{I4S7Jco? zC=$fQPhr~_8s;p*%e0`vq{35LO|R3+pwS$GIZqnO484UperwIQ9ag#<}qegVG1ed+kQ+y1<8FKtgm! zAHaljV^zKfk*i|B1hr+=e8oYy&6GEb*(0+&MOVG)AiwSngxSA~l=jJZ1D-zzM9W27 zL(H{1+*?=x>2;|2&bWas1%m*%0I!0A`pm!({q1q$xDbK2G+XxnCJ7i`raD5VdXfZ9?7CaU7jyY?0RVDk zH0X0m13MPPRs+Gs`}t&c9wGdxxwiT1x2$hLSi0rrWnJIiUpG^76O^=Js0gYh@!;3u z90fZ!ZfGfYhX3FADF@e-|tifh<7OP%S`A z2AgP9pcIh1@f&ClET^?&5Tg&3=5zrwm#k2m9W1bC%a_*zF-O(7^&=4hex+twCh;wj zcCY%!*X6J{9*4I7&(oNI#-ccqI8KFOXgLIgVF?5M38~zw$wicY;XJ!XaDvO3aMEj8 zR|&RXfUEc!>S0T>z_qA^IJNUbngwJ(WyX4#)J4D`yk3Z+bu7?Gh98cJjMk=*|1fl2 zIv=T)fp62Te8r9jw^Kk0{oZtDUK%V>6i)st#)vMS{@MvE36lj|9$<*Vnkz#880r+n zJ5UXc&3iOklb9~WQ9VNsqy!E8a=R-M{WR)D1^q3N!RTSjhY7eo_BtG=zRfgXMNN#B+(%;*Uw%y{ zHfW=9krmr~T-v}@yj{|_@pAE%yhHv-Coa^ekaKcmbDpG|aEia@?Y>i9dPyEJU_+2i zQCkMvFQZc`LO2-$d}4)XC__as1)yzothxxVL>9994fZx?bfb)c;c}O(M3Nvvd$iBs z3-k-5msuO3zXKwO?6mZ%YPQtzXFvOIc?3xQ!{5IFO9nc#*CqHHcC}D#vZMj=Kz0Cw zzV$x>EX0zQQLLPGI=FF0HqcL9u5y_Dcz)?=u%!MxI&vcZ5vdS4{ee8`eatnV)Y!08 zSo^3uZoDJjA}aUtW`Jkp1|!@=drBIp#y6WYs3Z8_!$y+72NeP1Drr0rNVI;r3{TOS zlfuMR*MMh)f}NwjcYQIh)jw2DiUB0auJ|7*bro@$azw6MRU-Cd*M1C%MsIL; z=&QXewcMbI9{q4|aOz}lGCJA{IJtr%lXMVEL!FqpGIrwGzYzXxn{~akZ?9qSS_Ggg zspTg6n$ua(kOU00!j23G$60CRQXDR6{qv%cwZ2jIZf||d`Vec=d~t$A%$ zH8$S_8NT#i%X_IxWsJ^Lv}7x9nZ9>_cm49MTp<{Jk**c;0OQD8Gy`NWz(NTug|1mb zBur|CrF!pyyCAj|k%=f1%-tQ7X3`nJ$ps!2>Dg}~pxV*U%~~H*82RdOqb+Vk7F(Jd zo4wOR*4P>2Z^dq`?Gc&+ZeTMB^q8SqJ*(|Del_&uh7;>G5%1xNy6o*7Y$- zMnx*L24L{4;_JVqLo9|O&jExbGY%OF_zW>=Az&K>N$rBCDlSZ6j+tA!U>G# z5JZ54M(p`zXSwr=oBJW>37#@|EhTFm&+EC^{JL^_zHR$b_rwyoZTm zVv2Yja``dXISWP6g($VOU4@x}RvFi`8;J!)P=)xjzwpvi>!Tx{4vXl7Sjk=+M>*G3 z@@eXI8TJw}SLh4)d1BAx2BwMRr-+)fLhz9w#V8p%0c!f40jtVwwPD>l`yq_Zwa*6i z3HmuelL5upDQc^e3a9ZgBL_M03BT!#mO7P`;5FQ_m65R6MBk=4h)9jeC98rgSbDO z(zW;9K_sahKB`9Qk!(rM0mvGDnjz|G?NyAtv4C{q0IB?Cb&P7%*B;TqwV^EH!fB97XeJ1H6O-Kr@z8_&`Ht{$2lODVyD3UjjA z37`+e55o_bRt$z6jI`9XE&i0NzyeD8x5P6ZF?zs*F>LH{9_ysp|thKTU-u#yMW{32#DFvF`fl&e=N54@W=T5rFY&19 zUBEvvT$d&NI`D7)^guMY-1d90dqB1S5Rn^rrRFGD&`*XSed^neI2dW`ztHBXB@llb=}MBJ088A7ke`Wy@Xsl%w?gIaqT>5NIWP1(5!Np8E@FnQvZlbpE#x?VHJGxZqn(|J4HwKe& z&W&gE?zZa8hFN;@lACiueA}UTfQtlyiLg)IQc& ze^2MW|7yw7*B!@0@MwO1y+1~uM%fb9IfWjzJ|WS*k_tv<`$+JC@8+xL{_GvzqkvcK z4jfyZb-vrG_i_xc$qd0!jJ>tKVMP%fzT$d87Vg6OIDU`MY?D7K1IMT(y@$NMxa{=o zuJ5dGZu__*;auT#h5lOgZm;ihtbN0HUiI#7`?mTbeS4!`ud&U~ylh@~XCM7F;;fU_ z{r#R6MJ(yh`&=k)0xdw7a4vz>O)u^5b%Ma|WM* z;5jZ)q2}5T3<1l2_1yIG0rTwqT3i9lJl~w@^iHFQ*;@CW-5}vvfFR6zy?tE+-o3FJ z1U^UJ?e=W_MlEsEpY=wYYw@o0z2p5x`q9>??X;!-qBmr3+MVwzw@)hTJU_m+3o5H=A?1{3v{>r?e+`?_O&>(Y28Dn zdAs}gck?#kybkvqzpkLWJFwcDbL{8lhZP4n?%f8=<>q^HySjS&JF)s(3T({T)ztF# zTXz3)@@Lo6bmi==%CfjuZWayUhjl04yGIBtyW5&Iw|i!12X~v`E_C++Z`b726l}$} z?%U=Pz_hKiv9(v3U#M%}FXS5?X7d&fk#PGs*Tu!9fjFT+9}lhBxlSfr&+>B5+9ob= z=4GbS4TsCqtD^HZfre+zSl8ytY3F+6^2mEZUk~AS$F_HKP=BX8u={k4cTEuW$85Hx z)g>hC^!2mzHkj__3d2Nuq0DUTVG$f1{H|CAsVPqx%PkGG2sYo>lx$?|g^M+Pdxq-; zh20R0Vb#VK4}W!JI?XqzA z(MSuv904$nRSDekGkcW0W2Ql(!B%nuWY2Ccsn-#`_LhF+fo5P8haP! zWjO|pPpZtV7gTAw^b40`B|ZYJ_v;v^jtlo2BT~!;ezicH!}HBqZlebV*gvk__aa#^ z9jvWc5*qt{8F;}`B(#&t6ULW%gqHL6#&SVi7{viBJB=vD((&K#yv=smyKKS_5MCut z=LR9E)RYY*swrPzQ3k-V>0?$gVozzxz&^o`-3J6B3u|A2GZMIn6lC$TEYaAsbXR5{ zOr?M@4)ZYf=oao?76Qa05Hwaq6K7-$#YrmK2~xSBC};8AsbthWFNhDEvezwSNqn&; z21WJwhML@#n}m(>u@rj9tb!uA2al-?D46Hw#FP687F9j2{Y~?W=QKpdQArF6C!T7I zzH>uowlFl9QP2xhVkx|Rw0gC~k!A%R#pOa|)ii;a!{uuzJllHF2WR(JXLYrIV60hu z+^6y8Va7@_^lIpGK%BWp86e^!AN%epHdV& zKJt|y=b07j{k6A`^dJZR{g-PUI}!xlg)x55LKk=0@cH27HHl(ba=zEd?nOMwqIwd8 z3G;gyx+S$_JgTy3m+PS>d_4j@i-ML@h4uGarC{X8 zP3Fx)9`$1nJU%46jxrKy(Gh;dWXHyGK}Dic6b{c8)n8GYV{)sX~H(Kb@k{Qa&*EbT%s%mHD*9fb1X* zHa)S@+>BU+vYQWwTdf~R)3zsHiIz4qzW-dF^zxQeg5xbIQB)U-*)|@F%RNx?EBpcG zJ*AYUh(zx3QB-k}6u9^x{e~hl`F67@HhyoqxsgRN1V;wj{!>LfM&xU$S49SmaDr{7 z;cfH?_mLX`HOc{(@jxIJy%cRybwUw6mSoTS(GOw!W%?R!SXAwvek`jF2X4XYlrBb! z%}~D(F^41HCm8`^pMS2}-Pk`~8M88vrhjL?&Q!ff>+_J38M~tw?8q8az+vIVks3X9 zbFI-=1xQ26tfk@0#lf|Z2`ZR(Om?Vj`nu+J#upWulUVjBAFMoR18xw$-5$Lbb!y(- z!+y~dKcPSa;la=leP>1TW`!;{HN317#$&wT!PI>7Hsd*KC2=`6PeV$CCItggpbHcq4}+#d5a!EO2wxEPWqnz0@0a9B4Y z8PQPUyJZI=A}9J&qx{nl%E?ltxFeUE4T^meJ1xGu%gA%|x2i|4k-4k3PK2VpUzA#l zt7e*))afXW7uBR2_sijnR4ClNytZKKvp#>q*}~b&Ke#WZi#b6FiGW9-HfC>`8cDvy zSU8*8k^2MD%vd*@x~zKY2IuVegSyGmJt%rBmvemUjNQB%xIbOcDxhD_q6 z+PlV!Mp9fD+hcI+kt8K3=~lAHp))Qk@0rnGQb3ie;ieGzz0myRo;KOrn`Wd$s9A&I z)op#ZCG4J5-dLKRm6^pyWeT{6*4b6M*`C-b0^M_=P|5s7Q!s+Q38-0r)GynTWyerb z_Z?WG7e99U(JF2xtXLie(egf>j-KehD7)dlh9~~k?OlAHPyW2)D7M&s`hTTEP*2G} z_6qU%`lLP&kb17V!(!a>62&}{lO|~|k|a0WZ#rtM)D@eaJJ#hr4HNXZeqO4dCR_g1soi<(f`|;%(f-X*Lt5htcxSN#d5C zR5n~fCx6_$X|E!Al37Fx88CBo0;=?wRl*RanKaVF({k2V=-~m!>H0;bV^V$Lq3$sn z@3_XDBTS1578mb6I597il!89%5+wZF>Bogvw<$^Vy|V8`6mJueLBc+DMCxwX-9jn;Zr9BoDfkDfz$FW(yTY;)ec#5m-?t{-Hbga;U3c#)PUe6_RSmJfkyDu zzuI2S9-2m6do_~0^yFSYI`Yd@f57ch*Q=Q$WM8<_ZiL~az7vQbK&K8|y}G*;FS47a zszDRy7Da{jUO-R1A0CQ%Abwr)>}EE;VPJcKr9-^?T=p$kBQrRKN7T(uUbt8g@Z4}}bnqp1?9)7cRE)=<< zXebc?&&tHX_$Cz1m{fOJgNje0CaUDXnd27w8PRi%i`%<}3ejlmVBr1}aguTuq#gl-?nbuHl z$N6k^mHE;c5VJ20t?(efGT`bmPcBLjeVW9i+9Ue(I7#HsgfL@QIQAfKgXe-UTz)z=^y zntY`eP+8AexWZ;nD^6;-y%ik-kLuOuX&5*q=%ngjkrwUbxPVq|XDE4m+NFNlm|?Oq zetltwc5$DYtSX^CGsiO$R!C#n#ut%tb%D{^DHGHSnb#k6#c_gQ|I>h1-p zaz172+Bzi~0tzXb%_Vm=(K;TaeiLkxLvo$~cjcV<a=6cvd zsj8c`hR>G-Bh{%9_Lymnqd8 zn{CJuqqb8c=Zy?i2`2&%Pp)7Py+z7x=mBDn@hY!{!b|;B(RXChX)0S6#LWi9jmx*b zIP5Y4@YJ)%(PQy^vhgO}vWMPRoF`zFzDq41quOt!V!!QvzOo;8vlKoZeSZT5HaRa3 z_(rWSAHXyIy*uru$}M00GJq$nY(1GER@NY&_t#C_&!6rO-_Vh7sV}F9T#vVMPr*<> zA3ojep7Qp-1)ka)4O#JJZ`A@Q71p->u_i~Dh%$eCGVUg!15Q1xorhB@^HhT0mwz&y zBM;^3WrA)<$LeH}@pHyQXQ7RDo|^L`VSL3V+POkuw+GztMM=~W=fL&H1cqeCZZYs? zSuf^c0xXJn>Qf$^L^(LJ4CbijTVx#$8nT$7rXbzL`b-!OEl>(v!R|xkVRWpIyzE_t z?}nx3=y$*J>lHY!_OmRVN9uOvrPSNu>E+G3^6$lO^S?UjVV>?Zx2FDm{vD%k;(dA7 zBlT_cc|F-k;6T`mx#<_SQ9e)A3J<Cd|I=7*Dy3lP(XCfbR! zo6k@ADvzaRVC5vQ4-8F5YO1yx%;n&3-^v%!?ZB_W_Zc3_WF>Ln%|3vf>vCaXcJ>qH z9?CjX?`eIukoGv0U?Y7IjG8^II+P8~347%N)nU6p{-!##82&CBU`#K#=$_Q3BiPlD z9g<_1TIVzv;}*1p-R<7(9OH(Ta7?E;7!rZtcDg7NTGr&sD$Isu;BYrWAXb5OcE_Lv zRHHKZ4 z_S8N0i~~KSyH9toT4xcYdtW#j`j5-|AJ4pIQLH?~!^;1`uICp@yt9_*6M^Jtx8w;R%b;q+9Ct4kpa*CcY;orgA zIng&TQ3Ht>C))8e-pzfdY#FOAC$%N;f^IMRVT!tfRz_>%kHDM{QQ1aGcxtPS;3-y5 zKE-@s&z!%VuV*__t>z_T#w?CNBAo`h7tz>q=G;MzQmWq#gh@P|*q3X?lkj5TRM*BV z0Y>1bre?gQ6JH)fBG&gMWG z`B(i-xI$%jvU#>Dr)I3Z^U_3=b^p5RMiSQLsmN9(cKHfhMxav0-=0OC6*me2Tn2>bF!CrFKNJi~ryY&%mNVO^dYI%4!Bq2);FPCY6rqEaYW(=C_|#ZvIidM8 zac)9#Tk?t%0M6CvQ1M9)PlATn!NsbDx9GHbIHrWcN+y0y8cL*zF#MdwHJWo8eO))* zh6^N97Upcn*29O&tVu;l!05U!1AFRXPDhFhO;9q$RMIo35zCF@CeAMIpn=^NtsA`* zx_oA$T26!=ltN>sT|rAh)g(}*?wpAIcR7l*sB-pcxB-Vn|H z<;mg=DIc^}fsH<@#OjjK z`CMBCq(||+MP)xjH!27P6+kYT%oD#Pu#|*Ie}z#UiXi1SG)5LlViO44UT%4H+E+~B z2S4m4doNX6sUAG8GB!M4zG=kfDBcIuZ_IA#Rdf9N2Y)9gF~+zs?q#MBgItYS4$r*MBVdRlD1bFj_0$_ zY1Z5OR?~#UvF(SkD3O$Mf?PFEMA3J8(qDGv8FKOy3kJ+6io*>|9Fd`^Knt4=D(Pai z)<=OXOGr9%1=@smHL5DEt{}7)0=&-5DxyGUAc; zPrQyB@NB-Pv<^FLOyQeRc5@v6{_8cKT`;|+$o9H~_nzYsKZAR?)877OP3w~xxw{a# zOXE1cv6af2dZ2NlkkyWCdLxy|HFFZvh;S;Jg=PN(bi=MXaeiwjvA*?(_0^98+YxT< zKQzs=cj^s?9*fs0p$&8YJ*rVUfi1E79#GyD_l}v;DCr^ed`GR?+=A@*lLhpNdmdWGM5(^KkXADB0}cq~j&#HNYN} zDew+4X#$+64}L=#Wnz{yHZ?Z9lI-?Oj;;~30NFmuh9cKRX#SIA8h}Gv)Y`N9Ku#xt zezdHX*5hTzLwS&sI+|1cyOPB+q&weg%-!e>HCfeDr;h&@_i)m$MtA3HB6?pipKhCr zUwuFbJgC}dsqC&lPiAM4ORLo9K0B38#b*{LzFe2YRlE7~SN03Ht}v~4OPefNOM@al ztR$NaPQsWVI#=ZYyvHxlr<9?zbKcM<7Ge1Eg?qZ4X0=V|n5}nR%!N$i!%qH^UB$Ad zL0WljOQo(~vUu9*cbSq^hfBiW^`OCn+piWgiN>z#jrPcsVCs>FmH$m80g1&>+s|Sx zo3Da%EjRafRdE~YJB?|e8au4rjF#JsGF9t^q$X60MKiNCGkn>(dN<0qrfNmYosJuM5!v(F+)53| z!DO}+<2b=f(_A4+^$1Wzkqzq6@T1{sgF@*NEsiQLAPU=b`+T-BN;dg3H%6y$2W&q(!7o5FjaRvH_qUJg9^4N*iiV1D4ZtST<#G z;Htmud_eUORvup4-%cJrQ404}qrHa-NhW;(Q&-*>a5Zg9Q}T`+6WMW@=@K8_fFP1l zAO3+oU09nIRC4BkN-~TzPqh-I!9T}pRLslyOM;~yVbvwe2B{rG8h&@gOPr?ql;~&Z zw+6{HY(=u5#uZ0WUzN8MtK?3V9V!Kw3Wq)t**A2{(sLSG97GhH6zxLuwfj4hQ!w8# z8J#-Md-+wds1Hu@C?G>IW!NfkvmiIY(QrDth@RLfm!WM8tdkj<6D7G}Y~dvlEy3^R z4VAp6KjhMC!?u`J%F`m8(1qhz_Xya0H{{N_kJk;O!Rt_g?=ANTCN0Tnb|c6I#9%a2 z59Orm)ksbV#+QCS3gezQma~mRoO+ULW;lArQO&Gv(G->B@WePQby{IM;~RQ)i_Sme z7@XniD$k$U*@*KG`8}G2h7O#Hg>WHVMrQqk*RuCZ6CK9&TV9!8fXWLq9yo~b7I)uZ zmq!m@9|x^B_Y`n}$M@7oc?M-d1a=f%7-OUC!oK4|FTvB)S6b=pD$!ZjkD^_(Ve#BP z7o@#+W3ng?d>?SQ5S&J!b4-bbyQiytJv3EDu%4D+Qv1j-uBDm?aVs|@P$eqPv_ouA z#SkP-s#s;jggRKFxTDR0N#(yEeoG9`8+R6q;Wl606j{yi3$GE&t2t@J0lFZC;-10K zXaZH@>?f`%C9(p#$>L9aK64(~czFkXgzLH9@{h)y7&13x}Tfg5!6H5wQ@0EvmBOi>0+foWoIugP3&zHVrlF z2KEUE>xMLamZps8Af}SVhleY+8gz%{?*#)YJ2o`Sw;tV+>}~p|6;RC@8m;?l|L$ag zmp#-p#stU!zS*Z}!2ncR>tAbP)vF=YlDQ+mG?~(+*yR)LQ0_A{T^Z*H6NjsMWQn_| zQ=zCIXs-zO8*ebilQ#VUJUXQ{Qr>MmNRTsgM0i86@7m(|q+H~;b*)e<_~Pe-`(2&Q zz#(z0ysGQ~hRvR4v2%pk()!~&Re{?8oZ68fRMJk#(fiPR(!iX$L6ocwG3zp=qed=G zoy)40B0%(qLMCQDGn%rtgg2<-pDNpE1F0unV`WVKn|g$VHKH_Q+QQ4YM01xI4rFEaZV?Tf(_%LBd|u}F z5^~my54mGu#(2iFs8M6Q}KMtteEDCQq;4vp0)ETecK?HWUmzZ*^mIR4% z^-+VPr*Wxs$-hpZ;Uwr{6mNq3@=q*X6!X&(Cml+aagn4k zb+?0DtC(_&d^8jUOMlYN-!cd>7wvq~u&0**L~oK*j0N5<{^%~L{5O>z%}$hE`@XF{ z0^W>mZ9lH}{nZq^@3|bFz`Ng}Pe+7qjy=UbX zr1~ZIrExWD2UCNJp9e+_)egD(Wt0qSRa;!idL2ydY*j;IGPRa_yXd;E&#LIUi2JkX zdgIfauGP@R`pTGFq^&8kA9$+^C72aqjMVKDdAywWaA|+qGjQ1fkX)dR$AH|Whg{%% zw4P?Dp5jh$#SRKh!t7R(!U)rFq#~wY<7-)kX=bNNF>XHdPlfFX8U5KJx*EHNJg$?C zSQ`Yu-TzhFsd$K;_OokpB18GfW_cbA2lJ$+Tt`>e2M$MOw}qTl=IW@Q`D()|AtTQjQJGA z7Lef?f(0dUW&eN3>s_^jjOaY15dGic$0-%D#e{o>XNE&gN!ID(#3REo_w;dZO8b{7 z?XP$0q;E->%zpx(Wev=9Jl<2w_ha6S*P#b!I+lkk)cbwuGNb}WU%h^3Tpw!3D zK=hR%mcVzIY6k!D7<9kxRwqDZc%IAu1m)^&N$^3uVD?)Pza-}90{1t4$H)DBe;bui zM^l{HbQjW}Z_?n)S-;Yt@uW8A?E&g4GYc_PX#-}Gd=cy-%gJy-s%=Xs1{o0U?#Lbe zwQG-@*(MC*Z%5Kl-miEh>FX4?+bg&yc|LJD6@E)gU9q#-nxeW=bsg;GADFlO2bb~l~`0y8G;7;$9;HT+`hN#NXIL;8G#OmCc!sKojR z8TL@$*e{!S)xDs=V_nawG8uo*_v1fIz%{uV2W8%=d*;nclWi0U-ov+$*s6FALIO^CNEKkNG zojt!4a8nktT@13~0zi2V*p&EO;mXSHzC6E>9MpgN)^DUJ#p9ry{Xd}%PA2reqP#&?u@z5DGg4OBzgig94;3q3sQPm0 zNXoN_l@i2#So7(|9mb{DM-zZ+AqC^Z>hy4|xG>vzqng#kDkH}q4j+ZtiT^EL-+H*; ztfIpz3A%Wk8dsv)GX<`+^;Xs`0u5WTCGJ=9sMo`okv&>xjHYes8c;nktG3cCprNMpT)J~hv1RT5_=S=?sYrqqJg0kj;i5h3u>j195U zw<=~O2~<2HFDP%6;1w1(G`81x zRsj}-6`PCPX=b^aQT4njTE)dW-{OLwyp)v`a^1$}A~FsbPur7Ge&!a7h!rF1d0z8e zRN311iuiSOLQUitdCqCNM2SVYZ+!#KohX9Dp5=ZYNdoH+0zX@hRjy|WdQR$J7G4>3 zHZSaaY-LO6oe_?ig}v&y6l!JnE8*fRGXl$3BB3UnKJ`P zZal6PI7!2&3Pc|273oY>oFFr>htqYA+C?6fe?CeO1&&@RyB5rO#Aa9$$MHi?(2nvo9 zm_zQ|%Dt;hcV?q@l1G3nb}*7!ZJxW@Np*`+L5oy~X5ooY)6X)+ zejlRVdLl}Gn@#pMql-ZTH+DXEha~ApTnmZw*C~^=+& zz|A-$4n+>P!UW3DT;`T(!|;}KO5?z0j{l60#Qcf^Sz_;)!n0G?8iAIxvma1|p8OX$ zB{k7_#$fQ4b>CTW$LF^{8xI+-9@$JnTAsf^Ey`y zCSFy@T&*2L+9ZaO>+32Oi3D8zcQ+1Vgzcz2db9Cc+_RKSut5c)cGkZVzfR_83l zUp`E5C)Q)1>;crIR$LG>0wM(`un4h_^SU|w=l@>?8$1cmOE z!%zGKmr`u1+^OT7k7=x9%L-BxpTG9XnbJG%elZv=?NSCzvI-2F!57&WuyBI=oz4D^ z0sNMPN3pmkVDO1jR^!d@9DJ>bX`+ijIhQAki2+c zVTmC1(!l{gQ0+G8xu=r>hLNVLB>})#LX&qxpTqso14om@j;EH=RtLo?ql>f9Gu_gb zOv2Ch^1T;|b(vk!h|=B@ksW%RJHHjVQctY`GVx3tjK!2f7%{_qrQ>}VH`U)vB2!uS zQ!eFWzG-Hk9b1HUR8k9YJTNVc&r;K>)0Xs9no$z9+0dVx%W47scc5%$6tT^5O`mPq@a9 zAggps(HXVjmje!Y-I`gVN%9L*_>nhN(8SlQvRBwC9e}XC2VpV{NV`{JGFpA*6;EkBZPfy0pxO<}aAOllDg<%X!xOohmg&?&x9FLVT4y*LqZuG*z24PoIF zRYqM{-PS-nsi zani_EX7xh_XlKE{)-Xpqds+~bPp-zlE;42j_q3QU*U}cxyqs1SBT{l*%IK|8D!ZXZ zLRs!ceh?~bR45zks3ex@Ifpzr?Nq0#QnODFU@8N8N>2x z4&4V(5;~RL0`^gt*1^#?=(XiWYxpv(ZnyB^~4X&$uq?NYQIEr-OBsg&SW_ki+ns z(WNbS4A-OthquIKSPfV)G+g#4f6t<7PW^E^ne()f0(*QD)nl}og?~&7;X4^wD*>}C zsg3mGPih-EOGqt?>b!CJeDzL-q}6x`fJJq!7T*#+NqCGI=l|*9+T)qf+cd{rsNKBmI|!+ZO~mun#UOG3@`msNO#BED~8efJ85|K4L$` zg@Czv(t=dmm$}M6tb2!tdrntuqsq->MX(Z(<#MTBHU!*ZpzN(nwP$ADeU^k}s*pP0 zpUX*{JA}Kh`bmrEMe#()kAU8MYTt@@v?Xet1FZKGv#dX(fxh6CP@(>wO55fhz~jIY zV5Mz=aA8K+PC|M`8q7WFf+p1cs+Fo^s!^ETH5XuOTv~uY5;;OM_Y(4N;|mpa%23kN z%7KZ&58j-SpK*ZGE7XLf9`| zLIjPyhnbc)WK=sY3i72c&KB|uBJE-;@+kF!2VdYJ%UgBd%;-mp!)hmlh(dL7{z~p04Q11UAs(de$4V{@@d) zGd|M8qh`M8IZJujXqM9gt@a{9F2}zfC0vy(Uf;M@HJ@@jsm+yB#6k!CY6ZByHR&Ez zWg2@sh}hnCpwkN`X0yEF%S+`>?k)NE#TrUWqU z^aNk2;-Q8W)pxA>_m0)x*K0o5=bxWv0m36=GG7@bo^Ajd-=cF-y}-*tT+)isNJQH7 zB_GXh%-T2QXCELg)^x;;OW6Jt&2t|59qhtVmr^(6hh&E*IZdH>0Wk+EvCTR}V+ZRZ z#v)&g_atl*)_=Kyt$b+Npl!ZRS&D9X`)YG3+Cu!7!q(TBQj2H?(~lDuS|6Y_Y)iKM z%1RAXH$Fab$m5FskuNZWtL^IlzJD~P@NZ1sitUX~X((;{>1b4NKSIJx&KfDZ!tbOr zkEV0nbJbI53Dj~5F2F!I>1F~2IV!+Wc3hqlNs7FiBDI@;=Q)}GQ$R8*e-eH|JKUW# za#ysAb=-Rog@U$8I}%+x6uVj=kB-)*Wl+km;vj0d_6f8MKeg2C-RNbxgBycT?2lb7 z_pbj_{XbD!qVt+*ro2PbE}3FdyW4Nj#ne1gUUa|AS#h^%nH*~u!GwC?63#2JcR}pQ z!k^Ns$GnBt78=H!TP}*C(=Dte^iODE`;beS9R{ zHye7wEL)nyfW@z6>0GN(KcZv&q{Jv5{h$|Ot90t1;|c#*y_pMB6t`>o(}wx7sG#4; zHSTDJk)JoyW_VP6Gq!R0a2h#zZ<=9{-^7m>T#f+4*7|dG6h>uErS{?R=1=y*YrhCH?LaQwq&_9)hQTR6xn|?ofhu5OJ;>IXW7nCke}3RaG4MA<>r(cW@)BV3zjjow;D#1d-7Ow%oaT_RR2v zjM`iId?zWC))|OQL;S%4tORl@(CGO%K^Bi1&eM)w+z4G8Pd`FCU^9LC=FZ;Sl|;&E zd|4eo2SHIBvRlv+^BkjtBeOg-aUd0gZKO2%35Ru-gfXFu3v~?~s>rII&P2)e9<;I9M*t?< Date: Tue, 27 Jun 2023 21:44:16 -0700 Subject: [PATCH 09/21] tentative support for measurements --- R/processors.R | 35 ++++++++++++++++++++++++++--------- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/R/processors.R b/R/processors.R index e938fe13..c481f504 100644 --- a/R/processors.R +++ b/R/processors.R @@ -89,13 +89,30 @@ processGemmaFactor <- function(d) { #' @keywords internal processCharacteristicBasicValueObject <- function(d){ data.table( - factorValue = d %>% accessField('value',NA_character_), - factorValueURI = d %>% accessField('valueUri',NA_character_), + value = d %>% accessField('value',NA_character_), + valueUri = d %>% accessField('valueUri',NA_character_), category = d %>% accessField('category',NA_character_), categoryURI = d %>% accessField('categoryUri',NA_character_) ) } + +processFactorValueValueObject <- function(d){ + if(is.null(d)){ + return(data.table()) + } else if(d$isMeasurement){ + data.table( + value = nullCheck(d$factorValue,NA_character_), + valueUri = NA_character_, + category = nullCheck(d$category,natype = NA_character_), + categoryURI = nullCheck(d$categoryUri,natype = NA_character_) + ) + + } else{ + d$characteristics %>% processCharacteristicBasicValueObject + } +} + #' Processes JSON as an array #' #' @param d The JSON to process @@ -210,6 +227,7 @@ processSearchAnnotations <- function(d) { # good test cases 442, 448, 200, 174 +# for values 326 #' Processes JSON as a differential expression analysis #' #' @param d The JSON to process @@ -240,7 +258,6 @@ processSearchAnnotations <- function(d) { #' #' @keywords internal processDEA <- function(d) { - # Initialize internal variables to avoid R CMD check notes result_ids <- d %>% purrr::map('resultSets') %>% purrr::map(function(x){x %>% accessField('id')}) @@ -250,19 +267,19 @@ processDEA <- function(d) { if(length(d[[i]]$resultSets[[j]]$experimentalFactors)==1){ contrast.id = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% accessField('id',NA_integer_) size = length(contrast.id) + out <- data.table( result.ID = d[[i]]$resultSets[[j]]$id, contrast.id = contrast.id, experiment.ID = ifelse(is.null(d[[i]]$sourceExperiment), d[[i]]$bioAssaySetId, accessField(d,"sourceExperiment", NA_integer_)), baseline.category = d[[i]]$resultSets[[j]]$baselineGroup$category %>% nullCheck(NA_character_), baseline.categoryURI = d[[i]]$resultSets[[j]]$baselineGroup$categoryUri %>% nullCheck(NA_character_), - baseline.factors = d[[i]]$resultSets[[j]]$baselineGroup$characteristics %>% processCharacteristicBasicValueObject() %>% list() %>% rep(size), + baseline.factors = d[[i]]$resultSets[[j]]$baselineGroup %>% processFactorValueValueObject %>% list() %>% rep(size), experimental.factors = d[[i]]$resultSets[[j]]$experimentalFactors[[1]]$values %>% - purrr::map('characteristics') %>% purrr::map(processCharacteristicBasicValueObject), + purrr::map(processFactorValueValueObject), subsetFactor.subset = d[[i]]$isSubset %>% nullCheck(), subsetFactor = d[i] %>% purrr::map('subsetFactorValue') %>% - purrr::map('characteristics') %>% - purrr::map(processCharacteristicBasicValueObject) %>% + purrr::map(processFactorValueValueObject) %>% do.call(rbind,.) %>% list() %>% rep(size), probes.Analyzed = d[[i]]$resultSets[[j]]$numberOfProbesAnalyzed %>% nullCheck(NA_integer_), @@ -274,8 +291,8 @@ processDEA <- function(d) { # remove control as a contrast with self. sorting is there to guarantee # baseline and experimental values will match out <- out[!(seq_len(nrow(out)) %>% sapply(function(k){ - identical(out$baseline.factors[[k]] %>% dplyr::arrange(factorValue,factorValueURI,category), - out$experimental.factors[[k]] %>% dplyr::arrange(factorValue,factorValueURI,categoryURI)) + identical(out$baseline.factors[[k]] %>% dplyr::arrange(value,valueUri,category), + out$experimental.factors[[k]] %>% dplyr::arrange(value,valueUri,categoryURI)) }))] }else{ From ad23a3e6e615a08f8b391376687e46d7f42c265f Mon Sep 17 00:00:00 2001 From: OganM Date: Thu, 29 Jun 2023 15:54:09 -0700 Subject: [PATCH 10/21] get value from measurement object --- R/processors.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/processors.R b/R/processors.R index c481f504..3d73a7af 100644 --- a/R/processors.R +++ b/R/processors.R @@ -102,7 +102,7 @@ processFactorValueValueObject <- function(d){ return(data.table()) } else if(d$isMeasurement){ data.table( - value = nullCheck(d$factorValue,NA_character_), + value = nullCheck(d$measurement$value,NA_character_), valueUri = NA_character_, category = nullCheck(d$category,natype = NA_character_), categoryURI = nullCheck(d$categoryUri,natype = NA_character_) From 5e10d6d96bd8955d8bad4844e2931b656baf3c93 Mon Sep 17 00:00:00 2001 From: OganM Date: Thu, 13 Jul 2023 17:47:33 -0700 Subject: [PATCH 11/21] test fixes --- tests/testthat/testDatasetEndpoints.R | 8 +++++++- tests/testthat/testPlatformEndpoints.R | 8 +++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/tests/testthat/testDatasetEndpoints.R b/tests/testthat/testDatasetEndpoints.R index 10e1d2f1..3a68b909 100644 --- a/tests/testthat/testDatasetEndpoints.R +++ b/tests/testthat/testDatasetEndpoints.R @@ -10,7 +10,13 @@ test_that("getDatasetsInfo queries work", { expect_equal(get_datasets_by_ids(c("GSE2018", "GSE2872")) %>% nrow(), 2) expect_equal(get_datasets_by_ids(c(1, 2)) %>% nrow(), 2) expect_equal(get_datasets_by_ids(limit = 10) %>% nrow(), 10) - expect_equal(get_datasets_by_ids(offset = 2,attributes = FALSE)[1, 1], get_datasets_by_ids(offset = 0,attributes = FALSE)[3, 1]) + + a = get_datasets_by_ids(offset = 2)[1, 1] + b = get_datasets_by_ids(offset = 0)[3, 1] + attributes(a) = NULL + attributes(b) = NULL + + expect_equal(a, b) expect_false(get_datasets_by_ids(sort = "-id")[1, 1] == get_datasets_by_ids(sort = "+id")[1, 1]) }) diff --git a/tests/testthat/testPlatformEndpoints.R b/tests/testthat/testPlatformEndpoints.R index e561b393..9b7b317c 100644 --- a/tests/testthat/testPlatformEndpoints.R +++ b/tests/testthat/testPlatformEndpoints.R @@ -24,8 +24,14 @@ test_that("getPlatformDatasets queries work", { raw %>% purrr::map_chr('name'), raw %>% purrr::map('bioAssayCount') %>% purrr::map_chr(as.character) )) + + expect_equal(get_platform_datasets(1, limit = 10) %>% nrow(), 10) - expect_equal(get_platform_datasets(1, offset = 0,attributes = FALSE)[2, ], get_platform_datasets(1, offset = 1,attributes = FALSE)[1, ]) + a = get_platform_datasets(1, offset = 0)[2, ] + b = get_platform_datasets(1, offset = 1)[1, ] + attributes(a) = NULL + attributes(b) = NULL + expect_equal(a, b) }) # function tentatively removed From 0cb87d3adc78df296b6a0f5c9e33a34b214388c7 Mon Sep 17 00:00:00 2001 From: OganM Date: Fri, 14 Jul 2023 14:10:48 -0700 Subject: [PATCH 12/21] export get_all_pages --- NAMESPACE | 1 + R/convenience.R | 67 +++++++++++++++++++++++++------------------------ 2 files changed, 35 insertions(+), 33 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 416362e1..e862cd24 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(forget_gemma_memoised) export(gemma_call) +export(get_all_pages) export(get_dataset_annotations) export(get_dataset_design) export(get_dataset_differential_expression_analyses) diff --git a/R/convenience.R b/R/convenience.R index 74a22763..71f8aa05 100644 --- a/R/convenience.R +++ b/R/convenience.R @@ -220,10 +220,10 @@ make_design = function(samples,metaType){ #' output will only include samples relevant to the specific contrats. #' #' @return A list of \code{\link[SummarizedExperiment]{SummarizedExperiment}}s, -#' \code{\link[Biobase]{ExpressionSet}}s or a tibble containing metadata and -#' expression data for the queried datasets and genes. Metadata will be expanded to include +#' \code{\link[Biobase]{ExpressionSet}}s or a tibble containing metadata and +#' expression data for the queried datasets and genes. Metadata will be expanded to include #' a variable number of factors that annotates samples from a dataset but will -#' always include single "factorValues" column that houses data.tables that +#' always include single "factorValues" column that houses data.tables that #' include all annotations for a given sample. #' @keywords dataset #' @export @@ -231,13 +231,13 @@ make_design = function(samples,metaType){ #' get_dataset_object("GSE2018") get_dataset_object <- function(datasets, genes = NULL, - keepNonSpecific = FALSE, + keepNonSpecific = FALSE, consolidate = NA_character_, resultSets = NULL, contrasts = NULL, - filter = FALSE, - metaType = 'text', - type = "se", + filter = FALSE, + metaType = 'text', + type = "se", memoised = getOption("gemma.memoised", FALSE)) { if (type != "eset" && type != "se" && type != 'tidy') { stop("Please enter a valid type: 'se' for SummarizedExperiment or 'eset' for ExpressionSet and 'tidy' for a long form tibble.") @@ -312,37 +312,37 @@ get_dataset_object <- function(datasets, designs <- metadata %>% lapply(function(meta){ make_design(meta,metaType) }) - + # pack the information that will be included in all outputs packed_data <- seq_along(datasets) %>% lapply(function(i){ dataset <- datasets[i] - # we don't want to pass data.tables by reference because + # we don't want to pass data.tables by reference because # same datasets might be re-used - packed_info <- + packed_info <- list(design = data.table::copy(designs[[as.character(dataset)]]), exp = data.table::copy(expression[[as.character(dataset)]]), result_set = resultSets[i], contrast = contrasts[i], dat = get_datasets_by_ids(dataset, raw = FALSE,memoised = memoised)) - - + + # reorders the expression to match the metadata gene_info <- colnames(packed_info$exp)[!colnames(packed_info$exp) %in% rownames(packed_info$design)] data.table::setcolorder(packed_info$exp,c(gene_info,rownames(packed_info$design))) if(!is.null(resultSets)){ diff <- get_dataset_differential_expression_analyses(dataset,memoised = memoised) - subset_category <- diff %>% - dplyr::filter(result.ID == resultSets[i]) %>% + subset_category <- diff %>% + dplyr::filter(result.ID == resultSets[i]) %>% .$subsetFactor.category %>% unique - subset_factor <- diff %>% - dplyr::filter(result.ID == resultSets[i]) %>% + subset_factor <- diff %>% + dplyr::filter(result.ID == resultSets[i]) %>% .$subsetFactor.factorValue %>% unique - + assertthat::assert_that(length(subset_category)==1) assertthat::assert_that(length(subset_factor)==1) - + if(!is.na(subset_category)){ in_subset <- packed_info$design$factorValues %>% purrr::map_lgl(function(x){ x %>% dplyr::filter(category %in% subset_category) %>% @@ -355,7 +355,7 @@ get_dataset_object <- function(datasets, contrast <- diff %>% dplyr::filter(result.ID == resultSets[i] & contrast.id == contrasts[i]) in_contrast <- packed_info$design$factorValues %>% purrr::map_lgl(function(x){ x %>% dplyr::filter(category == contrast$baseline.category) %>% - .$factorValue %in% c(contrast$baseline.factorValue,contrast$experimental.factorValue) %>% + .$factorValue %in% c(contrast$baseline.factorValue,contrast$experimental.factorValue) %>% all }) } else{ @@ -364,7 +364,7 @@ get_dataset_object <- function(datasets, packed_info$exp <- packed_info$exp[,.SD,.SDcols = c(gene_info, rownames(packed_info$design)[in_subset & in_contrast])] packed_info$design <- packed_info$design[in_subset & in_contrast,] } - + return(packed_info) }) @@ -378,7 +378,7 @@ get_dataset_object <- function(datasets, } else{ names(packed_data) <- packed_data %>% purrr::map('dat') %>% purrr::map_int('experiment.ID') } - + if (type == 'se'){ out <- packed_data %>% lapply(function(data){ @@ -427,7 +427,7 @@ get_dataset_object <- function(datasets, genes <- S4Vectors::DataFrame(exprM[,.SD,.SDcols = colnames(exprM)[colnames(exprM) %in% c('Probe','GeneSymbol','GeneName','NCBIid')]]) exprM <- exprM[,.SD,.SDcols = colnames(exprM)[!colnames(exprM) %in% c('Probe','GeneSymbol','GeneName','NCBIid')]] %>% data.matrix() - + # reordering happens above # exprM <- exprM[, match(rownames(design), colnames(exprM))] @@ -465,7 +465,7 @@ get_dataset_object <- function(datasets, exprM <- data$exp design <- data$design - + rownames(exprM) <- exprM$Probe genes <- exprM[,.SD,.SDcols = colnames(exprM)[colnames(exprM) %in% c('Probe','GeneSymbol','GeneName','NCBIid')]] exprM <- exprM[,.SD,.SDcols = colnames(exprM)[!colnames(exprM) %in% c('Probe','GeneSymbol','GeneName','NCBIid')]] %>% @@ -482,10 +482,10 @@ get_dataset_object <- function(datasets, dplyr::inner_join(genes, by ='Probe') %>% dplyr::inner_join(design, by = "Sample") %>% dplyr::rename(sample = "Sample", probe = "Probe") %>% - dplyr::mutate(experiment.ID = data$dat$experiment.ID, + dplyr::mutate(experiment.ID = data$dat$experiment.ID, experiment.ShortName = data$dat$experiment.ShortName, .before = 1) - + if(!is.null(data$result_set)){ frm <- mutate(frm, result.ID = data$result_set,.before = 3) } @@ -497,7 +497,7 @@ get_dataset_object <- function(datasets, }) %>% do.call(dplyr::bind_rows,.) } - + return(out) } @@ -630,7 +630,7 @@ gemma_call <- function(call,...,json = TRUE){ } else{ response <- httr::GET(glue::glue(paste0(gemmaPath(),call))) } - + if (response$status_code == 200) { if(json){ response <- jsonlite::fromJSON(rawToChar(response$content),simplifyVector = FALSE) @@ -652,28 +652,29 @@ gemma_call <- function(call,...,json = TRUE){ #' Get all pages of a paginated call -#' +#' #' Given a Gemma.R output with offset and limit arguments, #' returns the entire output. -#' +#' #' @param query Output from a gemma.R function with offset and query argumend #' @param step_size Size of individual calls to the server. 100 is the maximum value #' @param binder Binding function for the calls. If \code{raw = FALSE} use \code{rbind} to #' combine the data.tables. If not, use \code{c} to combine lists #' @return A data.table or a list containing data from all pages. +#' @export get_all_pages <- function(query,step_size = 100,binder = rbind){ attr = attributes(query) count = attr$totalElements - + args = formals(attr$env$fname) args_used = attr$env %>% as.list() %>% {.[names(args)]} args_used$limit = step_size - + lapply(seq(0,count,step_size),function(offset){ step_args = args_used step_args$offset = offset - + do.call(attr$env$fname,step_args) }) %>% do.call(binder,.) - + } From 1632b4f5ca4e727e96a870a8f25ea0f5c97037f0 Mon Sep 17 00:00:00 2001 From: OganM Date: Mon, 17 Jul 2023 15:44:21 -0700 Subject: [PATCH 13/21] simplify file creation. do not add extensions to user input --- R/allEndpoints.R | 288 +++++++++--------- R/body.R | 38 +-- inst/script/overrides.R | 4 +- inst/script/registry.R | 11 + man/dot-getResultSetFactors.Rd | 4 +- man/dot-getResultSets.Rd | 4 +- man/get_dataset_annotations.Rd | 4 +- man/get_dataset_design.Rd | 4 +- ...ataset_differential_expression_analyses.Rd | 4 +- man/get_dataset_expression.Rd | 4 +- man/get_dataset_expression_for_genes.Rd | 4 +- man/get_dataset_platforms.Rd | 4 +- man/get_dataset_samples.Rd | 4 +- man/get_datasets_by_ids.Rd | 4 +- man/get_gene_go_terms.Rd | 4 +- man/get_gene_locations.Rd | 4 +- man/get_gene_probes.Rd | 4 +- man/get_genes.Rd | 4 +- man/get_platform_datasets.Rd | 4 +- man/get_platform_element_genes.Rd | 4 +- man/get_platforms_by_ids.Rd | 4 +- man/get_result_sets.Rd | 4 +- man/get_taxa_by_ids.Rd | 4 +- man/get_taxon_datasets.Rd | 4 +- man/search_annotations.Rd | 4 +- man/search_datasets.Rd | 4 +- man/search_gemma.Rd | 4 +- 27 files changed, 217 insertions(+), 216 deletions(-) diff --git a/R/allEndpoints.R b/R/allEndpoints.R index 081f3b4b..88329060 100644 --- a/R/allEndpoints.R +++ b/R/allEndpoints.R @@ -15,16 +15,16 @@ #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -113,16 +113,16 @@ memget_datasets_by_ids <- function( #' #' #' @param resultSet An expression analysis result set numerical identifier. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -198,16 +198,16 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( #' #' #' @param resultSet An expression analysis result set numerical identifier. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -283,16 +283,16 @@ mem.getResultSetFactors <- function(resultSet = NA_character_, raw = getOption( #' #' #' @param datasets A numerical dataset identifier or a dataset short name -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -367,19 +367,19 @@ memget_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), me #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param filter The filtered version (\code{filter = TRUE}) corresponds to what is +#' @param filter The filtered version (`filter = TRUE`) corresponds to what is #' used in most Gemma analyses, removing some probes/elements. Unfiltered #' includes all elements. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -468,16 +468,16 @@ memget_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( #' will return every probe for the genes. "pickmax" to #' pick the probe with the highest expression, "pickvar" to pick the prove with #' the highest variance and "average" for returning the average expression -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -594,16 +594,16 @@ memget_dataset_expression_for_genes <- function( #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -685,16 +685,16 @@ memget_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -776,16 +776,16 @@ memget_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -867,16 +867,16 @@ memget_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FAL #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -959,16 +959,16 @@ memget_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1061,14 +1061,14 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' of the syntax #' Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount @@ -1077,16 +1077,16 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1183,16 +1183,16 @@ memsearch_datasets <- function( #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1278,16 +1278,16 @@ memget_platforms_by_ids <- function( #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1377,16 +1377,16 @@ memget_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = g #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1474,16 +1474,16 @@ memget_platform_element_genes <- function(platform, probe, offset = 0L, limit = #' #' #' @param genes An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1558,16 +1558,16 @@ memget_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = #' #' #' @param gene An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1646,16 +1646,16 @@ memget_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), mem #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1740,16 +1740,16 @@ memget_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( #' #' #' @param gene An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1823,16 +1823,16 @@ memget_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memo #' #' #' @param query The search query -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -1908,34 +1908,32 @@ memsearch_annotations <- function(query, raw = getOption("gemma.raw", FALSE), me #' @param taxa Limits the result to entities with given identifiers. #' A vector of identifiers. #' Identifiers can be the any of the following: -#' \itemize{ -#' \item taxon ID -#' \item scientific name -#' \item common name +#' - taxon ID +#' - scientific name +#' - common name #' Retrieval by ID is more efficient. #' Do not combine different identifiers in one query. #' For convenience, below is a list of officially supported taxa #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } -#' } -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -2010,14 +2008,14 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois #' Please note, that not all taxa have all the possible identifiers available. #' Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount @@ -2026,16 +2024,16 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @@ -2127,16 +2125,16 @@ memget_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. #' @param resultType The kind of results that should be included in the output. Can be experiment, gene, platform or a long object type name, documented in the API documentation. -#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or \code{NULL} to not write -#' results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' @param file The name of a file to save the results to, or `NULL` to not write +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' diff --git a/R/body.R b/R/body.R index ff9f456d..176d2fda 100644 --- a/R/body.R +++ b/R/body.R @@ -101,34 +101,26 @@ gemmaPath <- function(){ } } - if (!is.null(file) && !is.na(file)) { - extension <- ifelse(raw, ".json", ifelse(any(vapply(mOut, typeof, character(1)) == "list"), ".rds", ".csv")) - if (isFile && raw){ - extension <- '.gz' - } - file <- paste0(tools::file_path_sans_ext(file), extension) - - if (file.exists(file) && !overwrite && !file.info(file)$isdir) { - warning(file, " exists. Not overwriting.") - } else { - if (extension == ".json") { - write(jsonlite::toJSON(mOut, pretty = 2), file) - } else if (extension == ".rds") { - saveRDS(mOut, file) - } else if (extension == '.gz'){ - tmp <- mOut - attributes(tmp) = NULL - writeBin(tmp,file) - } else { - utils::write.csv2(mOut, file, row.names = FALSE) - } - } - } if(attributes){ attributes(mOut) <- c(attributes(mOut), env = original_env) } + + + if (!is.null(file) && !is.na(file)) { + if (file.exists(file) && !overwrite && !file.info(file)$isdir) { + warning(file, " exists. Not overwriting.") + } + + if(raw){ + writeBin(response$content,file) + } else{ + saveRDS(mOut, file) + } + } + + mOut } else if (response$status_code == 403) { stop(call,'\n',response$status_code, ": Forbidden. You do not have permission to access this data.") diff --git a/inst/script/overrides.R b/inst/script/overrides.R index b2fecfdb..356818f7 100644 --- a/inst/script/overrides.R +++ b/inst/script/overrides.R @@ -249,8 +249,8 @@ NULL #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be a JSON file. Otherwise, -#' it will be a RDS file. +#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. #' @param sort Order results by the given property and direction. The '+' sign diff --git a/inst/script/registry.R b/inst/script/registry.R index 53b4e9de..5e3fe376 100644 --- a/inst/script/registry.R +++ b/inst/script/registry.R @@ -199,6 +199,17 @@ registerEndpoint('datasets/{dataset}/analyses/differential', ), preprocessor = quote(processDEA)) +registerEndpoint('datasets/{dataset}/quantitationTypes', + 'get_dataset_differential_expression_analyses', open_api_name = 'get_dataset_differential_expression_analyses', + keyword = 'dataset', + defaults = list( + dataset = bquote() + ), + validators = list( + dataset = validateSingleID + ), + preprocessor = quote(processDEA)) + registerEndpoint("annotations/{taxon}/search/datasets?query={query}&limit={limit}&offset={offset}&sort={sort}", "search_datasets", open_api_name = 'search_datasets', diff --git a/man/dot-getResultSetFactors.Rd b/man/dot-getResultSetFactors.Rd index 4bb1268d..1daaaa1e 100644 --- a/man/dot-getResultSetFactors.Rd +++ b/man/dot-getResultSetFactors.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/dot-getResultSets.Rd b/man/dot-getResultSets.Rd index 21cb3ac6..e904f9e6 100644 --- a/man/dot-getResultSets.Rd +++ b/man/dot-getResultSets.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_annotations.Rd b/man/get_dataset_annotations.Rd index 8b2371e2..175a1eb3 100644 --- a/man/get_dataset_annotations.Rd +++ b/man/get_dataset_annotations.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_design.Rd b/man/get_dataset_design.Rd index 3061bbf9..da7d1055 100644 --- a/man/get_dataset_design.Rd +++ b/man/get_dataset_design.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_differential_expression_analyses.Rd b/man/get_dataset_differential_expression_analyses.Rd index 27ec2580..d4a28527 100644 --- a/man/get_dataset_differential_expression_analyses.Rd +++ b/man/get_dataset_differential_expression_analyses.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_expression.Rd b/man/get_dataset_expression.Rd index 01eaef0a..272ae0de 100644 --- a/man/get_dataset_expression.Rd +++ b/man/get_dataset_expression.Rd @@ -30,8 +30,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_expression_for_genes.Rd b/man/get_dataset_expression_for_genes.Rd index 813b5c17..633f13dd 100644 --- a/man/get_dataset_expression_for_genes.Rd +++ b/man/get_dataset_expression_for_genes.Rd @@ -38,8 +38,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_platforms.Rd b/man/get_dataset_platforms.Rd index 4a801461..2c1c78fe 100644 --- a/man/get_dataset_platforms.Rd +++ b/man/get_dataset_platforms.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_dataset_samples.Rd b/man/get_dataset_samples.Rd index 57239734..9f9ff946 100644 --- a/man/get_dataset_samples.Rd +++ b/man/get_dataset_samples.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_datasets_by_ids.Rd b/man/get_datasets_by_ids.Rd index 364f1285..92ec7014 100644 --- a/man/get_datasets_by_ids.Rd +++ b/man/get_datasets_by_ids.Rd @@ -43,8 +43,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_gene_go_terms.Rd b/man/get_gene_go_terms.Rd index c1e8e44c..e69fe6d9 100644 --- a/man/get_gene_go_terms.Rd +++ b/man/get_gene_go_terms.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_gene_locations.Rd b/man/get_gene_locations.Rd index c649698e..927788fb 100644 --- a/man/get_gene_locations.Rd +++ b/man/get_gene_locations.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_gene_probes.Rd b/man/get_gene_probes.Rd index 0a111207..d0ba5665 100644 --- a/man/get_gene_probes.Rd +++ b/man/get_gene_probes.Rd @@ -34,8 +34,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_genes.Rd b/man/get_genes.Rd index 55b1fecc..3450908e 100644 --- a/man/get_genes.Rd +++ b/man/get_genes.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_platform_datasets.Rd b/man/get_platform_datasets.Rd index 3b62425c..3757875c 100644 --- a/man/get_platform_datasets.Rd +++ b/man/get_platform_datasets.Rd @@ -34,8 +34,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_platform_element_genes.Rd b/man/get_platform_element_genes.Rd index 97ca3cef..dbacd176 100644 --- a/man/get_platform_element_genes.Rd +++ b/man/get_platform_element_genes.Rd @@ -37,8 +37,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_platforms_by_ids.Rd b/man/get_platforms_by_ids.Rd index 973c839d..81b8528c 100644 --- a/man/get_platforms_by_ids.Rd +++ b/man/get_platforms_by_ids.Rd @@ -39,8 +39,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_result_sets.Rd b/man/get_result_sets.Rd index 92c2d2fe..a1db1d55 100644 --- a/man/get_result_sets.Rd +++ b/man/get_result_sets.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_taxa_by_ids.Rd b/man/get_taxa_by_ids.Rd index a1f4c70a..4ca3f0e0 100644 --- a/man/get_taxa_by_ids.Rd +++ b/man/get_taxa_by_ids.Rd @@ -45,8 +45,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/get_taxon_datasets.Rd b/man/get_taxon_datasets.Rd index 2f2afe2a..3d724086 100644 --- a/man/get_taxon_datasets.Rd +++ b/man/get_taxon_datasets.Rd @@ -51,8 +51,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/search_annotations.Rd b/man/search_annotations.Rd index 89109bd5..8fc870a6 100644 --- a/man/search_annotations.Rd +++ b/man/search_annotations.Rd @@ -25,8 +25,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/search_datasets.Rd b/man/search_datasets.Rd index a663b226..737dddf5 100644 --- a/man/search_datasets.Rd +++ b/man/search_datasets.Rd @@ -59,8 +59,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} diff --git a/man/search_gemma.Rd b/man/search_gemma.Rd index 9dfd59c6..a8b3f033 100644 --- a/man/search_gemma.Rd +++ b/man/search_gemma.Rd @@ -40,8 +40,8 @@ Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} \item{file}{The name of a file to save the results to, or \code{NULL} to not write -results to a file. If \code{raw == TRUE}, the output will be a JSON file. Otherwise, -it will be a RDS file.} +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} \item{overwrite}{Whether or not to overwrite if a file exists at the specified filename.} From e454e09844faca9a25e10b31420566608081832d Mon Sep 17 00:00:00 2001 From: OganM Date: Mon, 17 Jul 2023 17:19:02 -0700 Subject: [PATCH 14/21] help out file creation --- R/body.R | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/R/body.R b/R/body.R index 176d2fda..f29f74cb 100644 --- a/R/body.R +++ b/R/body.R @@ -111,13 +111,16 @@ gemmaPath <- function(){ if (!is.null(file) && !is.na(file)) { if (file.exists(file) && !overwrite && !file.info(file)$isdir) { warning(file, " exists. Not overwriting.") - } - - if(raw){ - writeBin(response$content,file) } else{ - saveRDS(mOut, file) + dir.create(dirname(file),showWarnings = FALSE,recursive = TRUE) + if(raw){ + writeBin(response$content,file) + } else{ + saveRDS(mOut, file) + } } + + } From e86b83272d5b8ef7bc3f561591ed6aa83acf7432 Mon Sep 17 00:00:00 2001 From: OganM Date: Mon, 17 Jul 2023 17:32:58 -0700 Subject: [PATCH 15/21] test for get_all_ages --- tests/testthat/testConvenience.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/testConvenience.R b/tests/testthat/testConvenience.R index 54ec958f..ca46ef7f 100644 --- a/tests/testthat/testConvenience.R +++ b/tests/testthat/testConvenience.R @@ -67,3 +67,11 @@ test_that('gemmaCall works properly',{ out<- gemma_call('datasets/{dataset}/svd',dataset = 1) expect_is(out,'list') }) + +test_that('get_all_pages works properly',{ + out <- get_datasets_by_ids(datasets = c(1,2,3), + limit = 1) %>% + get_all_pages(step_size = 1) + expect_true(nrow(out)==3) + +}) \ No newline at end of file From e86317735da00eb80d0854262d55540ae60b01e5 Mon Sep 17 00:00:00 2001 From: OganM Date: Mon, 17 Jul 2023 17:54:06 -0700 Subject: [PATCH 16/21] file saving support for get_all_pages --- R/convenience.R | 51 +++++++++++++++++++++++++++++++++----------- man/get_all_pages.Rd | 22 +++++++++++++++---- 2 files changed, 57 insertions(+), 16 deletions(-) diff --git a/R/convenience.R b/R/convenience.R index 71f8aa05..47a97ddb 100644 --- a/R/convenience.R +++ b/R/convenience.R @@ -653,28 +653,55 @@ gemma_call <- function(call,...,json = TRUE){ #' Get all pages of a paginated call #' -#' Given a Gemma.R output with offset and limit arguments, -#' returns the entire output. +#' Given a Gemma.R output from a function with offset and limit arguments, +#' returns the output from all pages. All arguments other than offset, limit #' -#' @param query Output from a gemma.R function with offset and query argumend +#' @param query Output from a gemma.R function with offset and query argument #' @param step_size Size of individual calls to the server. 100 is the maximum value #' @param binder Binding function for the calls. If \code{raw = FALSE} use \code{rbind} to #' combine the data.tables. If not, use \code{c} to combine lists +#' @param directory Directory to save the output from the individual calls to. If provided, each page +#' is saved to separate files. +#' @param file Name of the file to save the results to. If provided, combined output is saved as an RDS file. +#' @param overwrite #' @return A data.table or a list containing data from all pages. #' @export -get_all_pages <- function(query,step_size = 100,binder = rbind){ - attr = attributes(query) - count = attr$totalElements +get_all_pages <- function(query, step_size = 100,binder = rbind,directory = NULL, file = getOption("gemma.file", NA_character_),overwrite = getOption("gemma.overwrite", FALSE)){ + attr <- attributes(query) + count <- attr$totalElements - args = formals(attr$env$fname) - args_used = attr$env %>% as.list() %>% {.[names(args)]} - args_used$limit = step_size + args <- formals(attr$env$fname) + args_used <- attr$env %>% as.list() %>% {.[names(args)]} + args_used$limit <- step_size + args_used$overwrite <- overwrite - lapply(seq(0,count,step_size),function(offset){ - step_args = args_used - step_args$offset = offset + out <- lapply(seq(0,count,step_size),function(offset){ + step_args <- args_used + step_args$offset <- offset + if(!is.null(directory)){ + step_args$file = file.path(directory,offset) + } else{ + # file argument should not be preserved since it'll overwrite itself in + # each call + step_args$file <- NA_character_ + } + do.call(attr$env$fname,step_args) }) %>% do.call(binder,.) + + if(!is.null(file) && !is.na(file)){ + if (file.exists(file) && !overwrite && !file.info(file)$isdir) { + warning(file, " exists. Not overwriting.") + } else{ + dir.create(dirname(file),showWarnings = FALSE,recursive = TRUE) + saveRDS(out, file) + } + } + + return(out) } + + + diff --git a/man/get_all_pages.Rd b/man/get_all_pages.Rd index 72db6a64..abfe2420 100644 --- a/man/get_all_pages.Rd +++ b/man/get_all_pages.Rd @@ -4,20 +4,34 @@ \alias{get_all_pages} \title{Get all pages of a paginated call} \usage{ -get_all_pages(query, step_size = 100, binder = rbind) +get_all_pages( + query, + step_size = 100, + binder = rbind, + directory = NULL, + file = getOption("gemma.file", NA_character_), + overwrite = getOption("gemma.overwrite", FALSE) +) } \arguments{ -\item{query}{Output from a gemma.R function with offset and query argumend} +\item{query}{Output from a gemma.R function with offset and query argument} \item{step_size}{Size of individual calls to the server. 100 is the maximum value} \item{binder}{Binding function for the calls. If \code{raw = FALSE} use \code{rbind} to combine the data.tables. If not, use \code{c} to combine lists} + +\item{directory}{Directory to save the output from the individual calls to. If provided, each page +is saved to separate files.} + +\item{file}{Name of the file to save the results to. If provided, combined output is saved as an RDS file.} + +\item{overwrite}{} } \value{ A data.table or a list containing data from all pages. } \description{ -Given a Gemma.R output with offset and limit arguments, -returns the entire output. +Given a Gemma.R output from a function with offset and limit arguments, +returns the output from all pages. All arguments other than offset, limit } From e2b4629284ae37968bbb530fa94605707b949501 Mon Sep 17 00:00:00 2001 From: OganM Date: Thu, 20 Jul 2023 07:10:34 -0700 Subject: [PATCH 17/21] fix to processDEA --- R/processors.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/processors.R b/R/processors.R index 3d73a7af..a4d49a23 100644 --- a/R/processors.R +++ b/R/processors.R @@ -293,7 +293,7 @@ processDEA <- function(d) { out <- out[!(seq_len(nrow(out)) %>% sapply(function(k){ identical(out$baseline.factors[[k]] %>% dplyr::arrange(value,valueUri,category), out$experimental.factors[[k]] %>% dplyr::arrange(value,valueUri,categoryURI)) - }))] + })),] }else{ # if more than 2 factors are present take a look at the From 32f0e8db9f35ea4ec401ab6a4f9ae53221725182 Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 26 Jul 2023 17:04:26 -0700 Subject: [PATCH 18/21] fix to processExpressionMatrix --- R/processors.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/processors.R b/R/processors.R index 3d73a7af..5e0a49f1 100644 --- a/R/processors.R +++ b/R/processors.R @@ -762,15 +762,19 @@ processExpressionMatrix <- function(m) { m <- m[,!colnames(m) %in% c('Sequence','GemmaId'),with = FALSE] # here we standardize the output column names so that they fit output # from other endpoints + m_cols = make.names(colnames(m)) + dataset <- parent.frame(n=2)$dataset samples <- get_dataset_samples(dataset, raw = TRUE) sample_ids <- samples %>% purrr::map('sample') %>% purrr::map_chr('name') sample_names <- samples %>% purrr::map_chr('name') - sample_matches <- sample_ids %>% purrr::map_int(function(x){ - grep(paste0(make.names(x),"_"),colnames(m),fixed = TRUE) - }) + sample_matches <- sample_ids %>% gsub(' ','',.,fixed = TRUE) %>% + make.names %>% purrr::map_int(function(x){ + grep(paste0(x,'_'),m_cols, fixed = TRUE) + }) colnames(m)[sample_matches] <- sample_names - + assertthat::assert_that(all(sample_names %in% colnames(m))) + m } From 0291a79af61ee6b892e0e5ca0414a02255f68c7c Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 2 Aug 2023 13:29:09 -0700 Subject: [PATCH 19/21] fix test --- tests/testthat/testProcessors.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/testProcessors.R b/tests/testthat/testProcessors.R index 0707fd5a..a4534853 100644 --- a/tests/testthat/testProcessors.R +++ b/tests/testthat/testProcessors.R @@ -6,16 +6,16 @@ test_that('processor file writing',{ file = tempfile() gemma.R::get_dataset_expression(dataset = 'GSE2018', file = file) - expect_true(file.exists(paste0(file,'.csv'))) + expect_true(file.exists(file)) file = tempfile() gemma.R::get_dataset_expression(dataset = 'GSE2018', file = file, raw = TRUE) - expect_true(file.exists(paste0(file,'.gz'))) + expect_true(file.exists(file)) file = tempfile() gemma.R::get_dataset_expression(dataset = 'GSE2018', file = file, raw = FALSE) - expect_true(file.exists(paste0(file,'.csv'))) + expect_true(file.exists(file)) }) From b782e470f03b2dddcc4a454ac35ca414b9817a76 Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 2 Aug 2023 17:28:33 -0700 Subject: [PATCH 20/21] remove empty parameters from the call --- R/body.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/body.R b/R/body.R index f29f74cb..635e1dc0 100644 --- a/R/body.R +++ b/R/body.R @@ -30,7 +30,7 @@ gemmaPath <- function(){ } envWhere$header <- header original_env = rlang::env_clone(envWhere) - + # Validate arguments if (!is.null(validators)) { for (v in names(validators)) { @@ -39,6 +39,11 @@ gemmaPath <- function(){ } # Generate request call <- quote(paste0(gemmaPath(), gsub("/((NA)?/)", "/", gsub("\\?[^=]+=NA", "\\?", gsub("&[^=]+=NA", "", glue::glue(endpoint)))))) %>% eval(envir = envWhere) + + # remove empty parameters + call<- call %>% stringr::str_split('&') %>% + {.[[1]]} %>% {.[!grepl("\\=$",.)]} %>% + paste0(collapse = '&') if (!is.null(getOption('gemma.username')) && !is.null(getOption('gemma.password'))){ requestExpr <- quote(httr::GET( From 311cc12f8bf860011f71cdd7ef57f511ee6c325f Mon Sep 17 00:00:00 2001 From: OganM Date: Wed, 2 Aug 2023 17:30:46 -0700 Subject: [PATCH 21/21] get_datasets added + some documentation --- NAMESPACE | 1 + R/allEndpoints.R | 358 +++++++++++++++++++++++------------ R/validators.R | 27 +++ inst/script/openapi.json | Bin 18430 -> 18601 bytes inst/script/overrides.R | 19 +- inst/script/registry.R | 33 ++-- man/get_datasets.Rd | 66 +++++++ man/search_gemma.Rd | 5 +- man/validateOptionalQuery.Rd | 20 ++ 9 files changed, 395 insertions(+), 134 deletions(-) create mode 100644 man/get_datasets.Rd create mode 100644 man/validateOptionalQuery.Rd diff --git a/NAMESPACE b/NAMESPACE index e862cd24..0a18874d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ export(get_dataset_expression_for_genes) export(get_dataset_object) export(get_dataset_platforms) export(get_dataset_samples) +export(get_datasets) export(get_datasets_by_ids) export(get_differential_expression_values) export(get_gene_go_terms) diff --git a/R/allEndpoints.R b/R/allEndpoints.R index 88329060..224b9f94 100644 --- a/R/allEndpoints.R +++ b/R/allEndpoints.R @@ -15,15 +15,15 @@ #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -108,20 +108,131 @@ memget_datasets_by_ids <- function( ) } +#' Retrieve all datasets +#' +#' +#' +#' @details Additional details to add +#' +#' @param query The search query. Either plain text ('traumatic'), or an ontology +#' term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that +#' contain the given string in their short of full name will also be matched. +#' @param filter Filter results by matching expression. See details for an explanation +#' of the syntax +#' @param offset The offset of the first retrieved result. +#' @param limit Optional, defaults to 20. Limits the result to specified amount +#' of objects. Has a maximum value of 100. Use together with \code{offset} and +#' the \code{totalElements} \link[base:attributes]{attribute} in the output to +#' compile all data if needed. +#' @param sort Order results by the given property and direction. The '+' sign +#' indicate ascending order whereas the '-' indicate descending. +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +#' parsing. Raw results usually contain additional fields and flags that are +#' omitted in the parsed results. +#' @param memoised Whether or not to save to cache for future calls with the +#' same inputs and use the result saved in cache if a result is already saved. +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +#' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +#' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. +#' @param overwrite Whether or not to overwrite if a file exists at the specified +#' filename. +#' +#' @return Varies +#' @export +#' +#' @keywords dataset +#' +#' @examples +#' get_datasets() +#' get_datasets(query = "http://purl.obolibrary.org/obo/UBERON_0002048") +get_datasets <- function( + query = NA_character_, filter = NA_character_, offset = 0L, + limit = 20L, sort = "+id", raw = getOption("gemma.raw", FALSE), + memoised = getOption("gemma.memoised", FALSE), file = getOption( + "gemma.file", + NA_character_ + ), overwrite = getOption( + "gemma.overwrite", + FALSE + )) { + internal <- FALSE + keyword <- "dataset" + header <- "" + isFile <- FALSE + fname <- "get_datasets" + preprocessor <- processDatasets + validators <- list( + query = validateOptionalQuery, filter = validateFilter, + offset = validatePositiveInteger, limit = validateLimit, + sort = validateSort + ) + endpoint <- "datasets/?&offset={encode(offset)}&limit={encode(limit)}&sort={encode(sort)}&filter={encode(filter)}&query={encode(query)}" + if (memoised) { + if (!is.na(file)) { + warning("Saving to files is not supported with memoisation.") + } + if ("character" %in% class(gemmaCache()) && gemmaCache() == + "cache_in_memory") { + return(mem_in_memory_cache("get_datasets", + query = query, + filter = filter, offset = offset, limit = limit, + sort = sort, raw = raw, memoised = FALSE, file = file, + overwrite = overwrite + )) + } else { + out <- memget_datasets( + query = query, filter = filter, + offset = offset, limit = limit, sort = sort, + raw = raw, memoised = FALSE, file = file, overwrite = overwrite + ) + return(out) + } + } + .body( + fname = fname, validators = validators, endpoint = endpoint, + envWhere = environment(), isFile = isFile, header = header, + raw = raw, overwrite = overwrite, file = file, attributes = TRUE, + .call = match.call() + ) +} + +#' Memoise get_datasets +#' +#' @noRd +memget_datasets <- function( + query = NA_character_, filter = NA_character_, offset = 0L, + limit = 20L, sort = "+id", raw = getOption("gemma.raw", FALSE), + memoised = getOption("gemma.memoised", FALSE), file = getOption( + "gemma.file", + NA_character_ + ), overwrite = getOption( + "gemma.overwrite", + FALSE + )) { + mem_call <- memoise::memoise(get_datasets, cache = gemmaCache()) + mem_call( + query = query, filter = filter, offset = offset, + limit = limit, sort = sort, raw = raw, memoised = FALSE, + file = file, overwrite = overwrite + ) +} + #' Retrieve a single analysis result set by its identifier #' #' #' #' @param resultSet An expression analysis result set numerical identifier. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -198,15 +309,15 @@ mem.getResultSets <- function(resultSet = NA_character_, raw = getOption( #' #' #' @param resultSet An expression analysis result set numerical identifier. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -283,15 +394,15 @@ mem.getResultSetFactors <- function(resultSet = NA_character_, raw = getOption( #' #' #' @param datasets A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -367,18 +478,18 @@ memget_result_sets <- function(datasets, raw = getOption("gemma.raw", FALSE), me #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param filter The filtered version (`filter = TRUE`) corresponds to what is +#' @param filter The filtered version (\code{filter = TRUE}) corresponds to what is #' used in most Gemma analyses, removing some probes/elements. Unfiltered #' includes all elements. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -468,15 +579,15 @@ memget_dataset_expression <- function(dataset, filter = FALSE, raw = getOption( #' will return every probe for the genes. "pickmax" to #' pick the probe with the highest expression, "pickvar" to pick the prove with #' the highest variance and "average" for returning the average expression -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -594,15 +705,15 @@ memget_dataset_expression_for_genes <- function( #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -685,15 +796,15 @@ memget_dataset_samples <- function(dataset, raw = getOption("gemma.raw", FALSE), #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -776,15 +887,15 @@ memget_dataset_platforms <- function(dataset, raw = getOption("gemma.raw", FALSE #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -867,15 +978,15 @@ memget_dataset_annotations <- function(dataset, raw = getOption("gemma.raw", FAL #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -959,15 +1070,15 @@ memget_dataset_design <- function(dataset, raw = getOption("gemma.raw", FALSE), #' #' #' @param dataset A numerical dataset identifier or a dataset short name -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1061,14 +1172,14 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' of the syntax #' Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount @@ -1077,15 +1188,15 @@ memget_dataset_differential_expression_analyses <- function(dataset, raw = getOp #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1183,15 +1294,15 @@ memsearch_datasets <- function( #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1278,15 +1389,15 @@ memget_platforms_by_ids <- function( #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1377,15 +1488,15 @@ memget_platform_datasets <- function(platform, offset = 0L, limit = 20L, raw = g #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1474,15 +1585,15 @@ memget_platform_element_genes <- function(platform, probe, offset = 0L, limit = #' #' #' @param genes An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1558,15 +1669,15 @@ memget_genes <- function(genes, raw = getOption("gemma.raw", FALSE), memoised = #' #' #' @param gene An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1646,15 +1757,15 @@ memget_gene_locations <- function(gene, raw = getOption("gemma.raw", FALSE), mem #' of objects. Has a maximum value of 100. Use together with \code{offset} and #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1740,15 +1851,15 @@ memget_gene_probes <- function(gene, offset = 0L, limit = 20L, raw = getOption( #' #' #' @param gene An ensembl gene identifier which typically starts with ensg or an ncbi gene identifier or an official gene symbol approved by hgnc -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1823,15 +1934,15 @@ memget_gene_go_terms <- function(gene, raw = getOption("gemma.raw", FALSE), memo #' #' #' @param query The search query -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -1908,31 +2019,33 @@ memsearch_annotations <- function(query, raw = getOption("gemma.raw", FALSE), me #' @param taxa Limits the result to entities with given identifiers. #' A vector of identifiers. #' Identifiers can be the any of the following: -#' - taxon ID -#' - scientific name -#' - common name +#' \itemize{ +#' \item taxon ID +#' \item scientific name +#' \item common name #' Retrieval by ID is more efficient. #' Do not combine different identifiers in one query. #' For convenience, below is a list of officially supported taxa #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' } #' } -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -2008,14 +2121,14 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois #' Please note, that not all taxa have all the possible identifiers available. #' Use the \code{\link{get_taxa_by_ids}} function to retrieve the necessary information. For convenience, below is a list of officially supported taxa: #' \tabular{rllr}{ -#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr -#' 1 \tab human \tab Homo sapiens \tab 9606 \cr -#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr -#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr -#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr -#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr -#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr -#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 +#' \strong{ID} \tab \strong{Comm.name} \tab \strong{Scient.name} \tab \strong{NcbiID}\cr +#' 1 \tab human \tab Homo sapiens \tab 9606 \cr +#' 2 \tab mouse \tab Mus musculus \tab 10090 \cr +#' 3 \tab rat \tab Rattus norvegicus \tab 10116 \cr +#' 11 \tab yeast \tab Saccharomyces cerevisiae \tab 4932 \cr +#' 12 \tab zebrafish \tab Danio rerio \tab 7955 \cr +#' 13 \tab fly \tab Drosophila melanogaster \tab 7227 \cr +#' 14 \tab worm \tab Caenorhabditis elegans \tab 6239 #' } #' @param offset The offset of the first retrieved result. #' @param limit Optional, defaults to 20. Limits the result to specified amount @@ -2024,15 +2137,15 @@ memget_taxa_by_ids <- function(taxa, raw = getOption("gemma.raw", FALSE), memois #' compile all data if needed. #' @param sort Order results by the given property and direction. The '+' sign #' indicate ascending order whereas the '-' indicate descending. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. @@ -2117,7 +2230,10 @@ memget_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", #' #' #' -#' @param query The search query. Either plain text ('traumatic'), or an ontology term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that contain the given string in their short of full name will also be matched ('GSE201', 'Bronchoalveolar lavage samples'. +#' @param query The search query. Either plain text ('traumatic'), or an ontology +#' term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that +#' contain the given string in their short of full name will also be matched. +#' Can be multiple identifiers separated by commas. #' @param taxon A numerical taxon identifier or an ncbi taxon identifier or a taxon identifier that matches either its scientific or common name #' @param platform A platform numerical identifier or a platform short name #' @param limit Optional, defaults to 20. Limits the result to specified amount @@ -2125,15 +2241,15 @@ memget_taxon_datasets <- function(taxon, offset = 0L, limit = 20, sort = "+id", #' the \code{totalElements} \link[base:attributes]{attribute} in the output to #' compile all data if needed. #' @param resultType The kind of results that should be included in the output. Can be experiment, gene, platform or a long object type name, documented in the API documentation. -#' @param raw `TRUE` to receive results as-is from Gemma, or `FALSE` to enable +#' @param raw \code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable #' parsing. Raw results usually contain additional fields and flags that are #' omitted in the parsed results. #' @param memoised Whether or not to save to cache for future calls with the #' same inputs and use the result saved in cache if a result is already saved. -#' Doing `options(gemma.memoised = TRUE)` will ensure that the cache is always +#' Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always #' used. Use \code{\link{forget_gemma_memoised}} to clear the cache. -#' @param file The name of a file to save the results to, or `NULL` to not write -#' results to a file. If `raw == TRUE`, the output will be the raw endpoint from the +#' @param file The name of a file to save the results to, or \code{NULL} to not write +#' results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the #' API, likely a JSON or a gzip file. Otherwise, it will be a RDS file. #' @param overwrite Whether or not to overwrite if a file exists at the specified #' filename. diff --git a/R/validators.R b/R/validators.R index 41a29433..cf781ab4 100644 --- a/R/validators.R +++ b/R/validators.R @@ -144,6 +144,33 @@ validateQuery <- function(name, ...) { paste0(query, collapse = ",") } +#' Validate am optional query +#' +#' @param name The variable name +#' @param ... Any queries +#' +#' @return The validated queries +#' +#' @keywords internal +validateOptionalQuery <- function(name,...){ + if (all(is.na(as.character(unlist(list(...)))))) { + "" + } else { + validateSingleQuery(name, ...) + } +} + +validateSingleQuery <- function(name,...){ + query <- unlist(list(...)) + if (all(is.na(query)) || length(query) == 0){ + stop(glue::glue("Please specify a query for {name}."), call. = FALSE) + } else if(length(query)>1){ + stop(glue::glue("Please use a length one vector for {name}."), call. = FALSE) + } + + query +} + #' Validate a non-negative integer value #' #' @param name The variable name diff --git a/inst/script/openapi.json b/inst/script/openapi.json index 96f0d824cdce6227a310e4848dbad5c6b1351192..3379f4b9475e8a1351f2138dae5b2f42a28cb21c 100644 GIT binary patch literal 18601 zcmY&Lf6l!xcOGVCl1XMBva&+L7$~6s zyKem8J-0es&JB&-@3^JASWfEK6?QK!k_8Xd9lsjWdfV%-+~lJgM#4#2$;>6YX95CP zfuw@Tq=H-UwxBm%o14Jk0tbCfncl09=AtZTa%ca|rgb_vxOL%=b-(c5{a%VG9HYGd zWK3J6IXkoU^yqg;{Q3gf+o8mRS`u*gLDDmnD_CtOE1!#vG<-jpNc2##6;U%|6tWYC z2gv@u*8*KGU0I{e48Qg6f(5Wx7TPjMn7Z1%fS^e9cF*kMF1=@hjc9$sn%a2-YL7P7 z2tG_^P8pcj*_wudw(E=!V)Zb8d7*1Qma%o~4!n?|9cr1G9li&MR=sSH=JNjC`>l0& z7F80{!3}aNd)>^`4rC#pW8qG?jhDY$qQ8_KDe<-oBiJ@!t)v%$NDUJxjLCfx3{}o@wcG$ zZOs&n;A4_5-uZc~5?1c*}2 zFu}N*drA*P_XdD!#FzmaFvI3pN!a3Jdp{O>GxoG3#Q$i2me$!kXWYMTQ?@C!;4VC3 zzro{YnGWeKNU^~7LGkIfseB!`<)qwX`USfATS&B|(RSTf4fDG-zzQtxzgsDPoP>km z8Y8Ur7E8-RbQ>OZVNVGL=7o&w?g9Ybbf*CMW63n1V-%SMPAU03#{n6-?aDy0Ako`M z_>9h1Aa75y$Vho+q`Ab!nzKF7=pZ+JEU>JEv_L6Dp`}{3n#elt60)7J&REicvD^~| zEM)BlQHI!~@CHie@FHs=AjRWdeG=a3ZzQ0-0Z0@sF5M}9vO?Aexrb^*G&idzV*gQO z5m!EN5W?Z<93~e4S~=<1T|{9koID3Lkz@D#?dI^r&cHQ-OaFjD7sEVLUHsuzjw7BJKE{-=|q!}+Hp70CKo^*|@H>E_^0ob$G#vv*jqQDgv_ zEiw+pbCM%K0$ImE$FRniRLC{l=;L(>x}5bK=gA9=0vHH|A@`QYVS73np!&XaD#{E- zjxvgqFp(oYXN%Z?m|+wdBn^Q|qmx8GGBHGBjQZu16Lp7ttZ(EtrjL{7ekPZAS3#7h zK)(~OTXN`z>VOH%@(Bk9I{N9|rJE^m*atj6k67e|2;IO8ZRCqf4$mM!Y4}jxNC=cL zr`#mmF19|D5tts>0~6#PX{i+~*WuoW)CM+X@rV@43xz9$D~F5;MM{Fvh&uM?Hi}as?)u2$oL>9_7+0C>SUm*v8D04?~qZnZj8~v4y*UGNK1} zddj4eKiWnVg(Oz3Gro!e2V3#Es1uvwh62(%o0*we%<5b-I03q=?`0>d!uCcyCs5?y zd!d|?1#-E;MqBp*wNOO1X38StNM^Zv$Y$p#eFJPSvF0NSpo`=@6%8}%fy%M^$ZHLQR@XB0EL3^N&PUL#Ux$DM!-@wNyNh@V}Xc=?86v^ zBNPaL*|<35HX08`3QVI2GrdIDApRKvrpL~fk5xCyKEaI@2?f?up0zG2gg@_+IM7zSPMp*&QcugF^&x^8PbZvh7gMF_v->S z+XmrPAu*kVzD{Rf&jw1*M7dplvtPmz3kUrii6Um!r5U=|<6TCO9w~N(oyNkpY7$ec z0v{=5o7!sjn4W~gbOp0P z7GwZP2yC4__K}(nX74a{*!T3?D$9m)VJ}xvi3_`2`UG*s!t*e`-+&V+qPh%5-6v8e zN@!%1V&kC3>w4)01IP!PZpf`3WolVz6w-sc0?h>5V1V;yK_g4GBQsz(08+T=I2Lx$ z&Wxgm1E=PJ^if^-F=0T$+z%Rp9!$?`-uR`pqwc`A4#5aieHl>JgE!XQDp3yyi3*Mm zKqqj>#w;6u+UGs93g1Oqe;A{Jc_-;pC+#T29Kcv$lV-ut{XtXqftZLYdB*_xs_u5l zP;7cyV$Zs+sQsYHd?NWr;TuJPdMQ5t;sZ<$R&^aL5Qyw^q3myw3t1>cPGf3m0+6vV z%fH#@p#j^OsF+eo+Ughn%Gk1}z}S@2XbRt9w!@DkDZFS{{`jyYi9rIJuWzai0=Lla ze8%6z=+6cE^y!CmF1J|vh&@#IH=`L&pVE~>ihSTl31MM}F}H9_eQr;5rXWT=T8Z=C zP#R%Sz#bs$(9l5(2qXnS=sr*wBpD9-?n596e`mpy--fy{{n_ILM&EnGibJN30#gV> zygFXzV}*+W2&1&_Xh51fy&VPhB7|@XhU>ik;M=$9c=U*>KChe8nIAD+hGwcWy zV9yAE$Vad+YcvK~Y^kw7-;sLz!O#<*(X5f(NjE=MjkQi+f);$V6lYoX>rK(*ozQAA% z=KY!Mf(!)GSfWBy9DpIA(fug}Ijaq40eQH}x+n7BIL0*g2OI*!6NlvL`%^Fax^2PS zS)i4KjGew7UxJku4H$+HE;agrTh^G`S|`Fv{`d{65#gD~L0l$=NEaO49Vvl;O_B#z?6#H6X^ zNSAc}bMRh3j2bk01O#3=x}Be$N3`iw58I(Y5sVCa4>laY{3FdyCSx1R&C_5&kY@G+ z_uS*EgfmDOn3;h<5oFF-Q6w}v1vYoTnae$NUq;Ov?i8QQu7sxM~s_Wnk&{?Nzl z73Lt*Q1XZ%wuhpD?t*F)J2Em8!j#%dh0uv_#3~*B3zXpeZTkfwF4Ym9w9_o2ol-;9LFA>B5NgTBuza38j{2S5~Qm<42ZU@V^XfSp}EP>kQFTb0SqFZL3A|E+f5&QqjP4rTb4qnc|ot(0h5Gp@BIz{z@q1Gt(nBK znGAwNh7V}Ab$3T?!TxH-H>rpPp>jNmt4VMaF9A0wt{B8TBS1mKc--?L5_ck!PA@%g zREZs+fT&eL^kPn(jLej!l&i(WBys1Id;aXy$nzw6U%7Bxyg4SC@E2lMG)Pz&%D4g> zPnXa$kYw)_b7Kh<+g>^1926TI7S`=DPs$MGa4fU`@TZ4ZMk8cGm(n-Yj+P&qEAApU z!r$?y0AuF_?c4=M<5&Ka%W|e8vRA;rZZN#9dl~PL2qDZ_wYzhUGO;m6Tv2S7-qx%h zyB{AqqOg&vaQZo`3&mQI)ZY55so-=WJL9OMCJH>4%3;X1e(7f33YSa%x}*Q8Z|S;* zfM{R3hdrJN5%ik^$a%IKhp;w@*(?d&ssm~p&liZkL|F*+9t7WR#9!}7IrBH0V)wCMrakxTSP%UpDj!xEWU}l3YFOb{0i};4h-V5LF z&?PfUOt-v=3B<1#=rMUjpLfo6aJ?Dp$PRRQ@~nVB!{C6}U*L382t82Lf?0b2MsZgR z{y@V3{vt4chFBWBG4yz<+5o&=Ad$TI`M#LRjI8BcdzNrvCD%P>UMbxH;_2Mc^bf)% zg#WuPVz0%X=-}GXu0JDp72Tr(i_6)6AtS<|lGyt3YB1r3B=W~s1ewvWbuyEhw%6?t zniS%UVKir{H=qb;6y9_`fk@iO;`z4=zZ3bNdY2$(Fga|tNGh>z(@24QYNK7c3SO$c z0#QrBzmSn-VYfwB)<9HnSP}sP*Oq>1s`u@PX zbyuzY{2|YL5hX{UO;BUxuSo!Sfd>y|4C~WsaNDGT6WZ;5aM*X)Q zaogHlUru)&bl7AUFO{}NSNz&n$-0(H@Ajv|+k)6$EuguvAKm&#FR>kIXCZBEL-T}7 z`vci2Waq{^({H{`!2CAq60_swUK{Hm`F}TC?>wg4^^YtAPJcUdj6$bKQU8p;UM!W{ z&NbGPGI>iLzdfTeyzz)E<@!qtLhTj$<^Sv-abrN$>v@rXf4Ath6JWX@fjyjgGFy&;(9_tBUu^G4n>Wqz&jCKMrE^MP$gKTv&pY4EWNU3< z_I4Jc$lb^1>}HlASL5>+$k&$B;Cq+gx23ap@XhRdhxf<&$esm%l@uRLqoujIy-yZ$ zV`p=xAOwhI&tYh`cWYP2aBq{}V6WFHP_Lb1&2!ftqpuI^>*#zLi!kps?iuqEgmkF= z2!Hd0x5e_-uHoZ4gO``rEn%3W@}%&aFmgspCd2lcwT4Y2ZzDfDMJ3`>Xw=8TibfNZT9I_ ztygZ3A`cwh;Z1j3J1^JtR(r!6-j>hR_z+>u2H^7)>fy`5^D6g#w3dCCP7a3vUV8`! z7!j}frT zaF*W6?|Qex@tf;$Q3IH#%`jnKO~0DlVe>E(NmjE1Jr!YDieuGVu!LSGki%B%6{e@ug;=$4)G`>{CfXog$&7rr*eY@J> z=~+1PfMGxw+v5?&g4RUG3XqC@a=-!8!nBlhMWCgy^fON0(u%ksSKX<|y_5{4?Y~Y^ zX#bO!of#EQN3v=%<|XjPikRsec{J!ZCy=ltqIsIeDovZC_QdL3Ibtp?+u4FIXHU;l z2N&%mUaZyt@L5#=9CzZeiq*1bk5D()p{nE=nFQ^185M42wwhT}utwLu3%Nd)56^N7 z+5hwSqL+!!wO38C5f2)sE)L1~ZWGQ-XqZOZFmcJGLuh8uoclVDzXi^7O4`6{24yOQ zW;*q)hLTId@(Ebro(N$&5wl)ZJ^6XujxOtWs!}CVS}BMwo4ZRAK#p>LMcDdeiI$%p zm6>Ai6i$Rtu<{R1r!?<-MF|#=vtJ^V0SIIrr2UsM9eu5#Z=06jFO#Zn=&@Pk%kNjK zUg%OJoqA1Iqebj-EprYa+o?IpO0(6e^Mkd$Va&StX)Rp|-gn)0^ZmrmfHoe@-MksmYvDXL9Y6NphPLEdTf|4QP zEmr$@9)-5|YGh7T)FwRZ&gZj5>Ff@b__8-n@pnF7{;q#5nZUMO#{F938&T0IAw}=| zFBRR_rfl*?GiKyfl!8>q88|ofw=;S^)~N`zW(>wVi|1A7h8l7MTXk`K zfv9=3e*XQZVyFZI9>5TK&9Qb8d7K;8I|62$_68HDBJD`DkzlBH9nhHM3fN9N;*7Onl@r3EY6 z5qLz06E@+AI#o9_UH`Zm_2Q@X*qyefZGtN~!CAYafl6QgPt$bKXBN%NYEs6Z1dpVv zN%P>Q1p{iLWz`qMj*9W6_tj5}q#}roLt3wL(2|bzWBS6eCpz1!t<$lJQz8m4q2G(zH1$wj=A~Fn&YHRsd{2pm-O#Yls12! zuC2B}ZFjf!7#7H=@Eg#S;p6xo4AvF2Xec*iR@(H%xA?EBE4RRzu&TguMN-#7>`IRe zDT{dyqQBEL?(eyPb8HJbWAipOFGz4!oZe{?bc9X~0hOC1S_6-lupY(t%EHC{dupZI zx&)T5PPO8NZ(RP%$!Rf%)`1yfAyqt%A(%HF+~GaC=S9VY?$41R zpSJ%K=^klXH-$v87x?`lFHzeso|Re-rr&8*mK?cb2i4*kV_1+s-K8%Cjl0%1xH-R! zxwg@cX0l}6qbKS|s&~j4Z#g`(GkZ7T3BWic70rBRzu^QXx}fDtzw*o6ahgV}yr+z2EL(X6DWCoOQ^Y9DU!CvJx0i_ydpt;`Q^(jeIH62Jur@5uw^%DQL!}NcO2j ziSRAFvpkKMV6_@IbS0{rvGHhjxQ6EK%3NK1q2FSg<@2=e0nrr1q&^ zj@?Nt^}Ro``J9#Nt8Ev!M`PC&_fwGI4v#V$)?53-f}2e#h$)Fv2`&w3XD(LSt-% z%5*d+$44TDFIr=k*K1qKUeiH++!c;u_#sy)3OIoC4T7mKdeu7%vQbH+%Zpf&8TrZW zjqZW}8V1j#$(pmw@z5a^Y{?EzqA4XQJ*JE9J=m$%}LsXQW{#ObCcb6;EvoT8u zzj+qJ#7GMJi8f@{_5|+dCj4VRUBIaO=c8&lqoAY-eh~=CIKbP=$B>u_o_cNS+?)^-3v+?|iYIJV*bofj$>7FROfRyM|o2Vkj z6~Bn0(~HcKZMxKE;UYZSol7>Ak3h<+t2?in5m5{f1;!y}1)SRew?_qwS9NPm%0+vSkFi1i%gVXI%F_QlT zV)V;yh#WtB#kO)@;POp8*An#25j&+vUECY*XdhN4~6KtmKlhh)$(q78bCp%OI zY2G(lc~(deEsd$WurJLTMRPY@WwUXA$`D+}y83tg*y#1*?AwUg9BP*qv_$ns(!h= zehTuO*t)#4#Om3v+jA^iDX8vP-=IcMOkJ(hrhaB@J@_gImhF+!Qv3{cs_reJ zDFG5!9whiA8W8S6^({*6moh;*V6s1SJsLv>oH?(B9ZdsH?4B0PB~?~HzUG>)XX;#! z}0A%J`-|$+QGZB2sntkEqLtZq>zXvlCdHO(+rd7L>9ZK`Vpv>sxx$ ze59Wr;cHYcZgQpTI9++?%6!q~CF`+Ub*D?Hab+e(OlPN0Djnvg`b~*0ZBl9m?e=_a zR%!8@gM3}%yPBEdLMg;e8u1fF4LzvH_}B|J0NDe67S^gs_Pq2@8>>lJOkinjMf=ya z*Xv+?Dryg24xW45@Zfz@z#pJ|h6IJ#1cuLaP0af-M$PY~slk)qD;!F{<6^@(0R!Ww zkY-h*)aI%D1cv*B>LuBU;E||ztGZuM3)LWlMn9o>tf<U8ZopXc zl4-`moL|P;&&I}B@sITymVp7>y{*+kf5-W-jTYe#WZNmBH|7uKmE>=QwgEl%^IJq< z*Ayww=EZ|Dd=H7w=^J00YlY|^X)A_^7U1d^a@#@sSv<>?PY=FkDz}+YE4asANT)Ax zCWwUXEM6n~aQIhjI22_G0A)~4XLr}(yE zk#EKS!&Ur;tG~8k;UYM7;^Uk6`tx_#+2TK6-iMcO>Y0D)hi5#NcRa2;|HEDI_saNm zjgDZD2`%7T5(C$WIlABA_%qM!Gw=A5!2FZoWPkF&;Z?kw7<{a zW~`#hL}^A;H|bfcw8D%^cc#Y#w~M^vwL>Ad7Y)SoQw+)`UT@_(Re$hRsKsW!O1L__ zTm{}8IbH@@o$%g@5yQs3PsFSE`<&))uX97mpo^LbB_imWm8~oZE#eTu&4$=+c@Sn$ z0pcQ~coilHtBL8s77T+`XqFvTxw$09ighS_>|F?5c zB2@hJxiz;O6Ro`0yA&GrHU5iv89qdMC)E&IR*+H2#4l z&SFLC{3D#GDz}nmc{;Y17FAm?SVQJ#<_+bx|nv5|EzrDnxI8TInHMjiyjY zi8so7a;@Z|K`a7BI>iMM7!quCY<9J>y6FQZBwm>Fzhb0y3KDO;90Edf^2@SxG~BN}WhR?cTbCP{j-SM(a+zshR3XrT`(# zAP3q8XA{MuFr*9xOJ)a$=D{KFD_~&`Z2@gqeg27Zv(mO}Mpe-5Lt9?$)ZFPPgVFB*GE`t__xXw!YW6sC8fxhx z$B+(_JccYXVWF$Bd`{!Bfky$_Exu_eTmCB-+FM)Jf7N*~1eU*}LWT;c)jBtENE&6n z{S-BvWQa$7Hn^u(rdovYdytM+(4;i3C{y0Zx8^h+s0wEURGiHNSvvFFO5QA+h8U8B zeALd|2Z;=tfw_1lhj%OMI{3r<1NPJ8zq0I6=}`dd8=^4=|D}lGCxGf;ed7E87y?jZNHbS}|JJz5Bn7YTcVK zD$y94rS*~Rnl!N$EB5*ek!or6qjiuVN9tA2mmR2ae&op0JVun(OL&Rf#74HDB^GU| z54Fc>#cU$#L*0yuXlYZe7|MbJ?JUT<9K{=sk|?x=MwEOL!AX@XJ=*;u?JMp&k-dDm zpbP^VZVs5c8QR1OEj>z}ME7Y`LqAOgApN2OiBjIo+wC&a1~_FSsbiX>viMycgNeH& z>09v6e_Uqh%tjr%a#1FA@WWD?xr{VjI-4fpCh=<~$t@lZ&rQKR4sFX2;YE)DrL@GHC z(JM|aJmH#DDqAiZOj5P>$05dEWPI1Ecjuz@UvRdbvxs&m*HiR(TZ8)=ooojyU7x_c ze|D>yK=6fzXQM$$N3~k$}22elN>4Apj+CW6g~q zAj~yRa{JAk%vAW;Z>sxdv?ccjwY@U9hwn8fZ?5eIds)9hjx(w)7cqCAhyO?oeHj-w zO!dsxI454@UHp>u{v`JlJKA5tu79TKOYSu-wO>Dj+xc1R7-p>=>czOy&l(PtUg&Ut z!#nU_#f*NMFozX0V*D@E*r)Z?!-#S8U@AzxOe`R~ajuq0dV#yAmAa;BIOsy~cUMV} zPgd)O(T`8La9S*so1x3LawXK}QXafgd4*B{)j7}aiN_{7P3FFY z<>N`ZnIpAXwNp4xsW62Jc~k|NA=U#MZ;i~Y8Ph)-Th~ncQ z!~a{rKZlVdYpCk57*%@>78$Y_w-rj(gk*PC$P~KUKlHPRrHV@R@ER^<68Fb|YFpTISP8m?A<jk9d)(H*E z@^nkWxp?M~tMl|~(yY~2XQxcFR{Za?kI@AuE-v01oH5CA%Zvqp>&7hOEJFfBxuZ>) zlcK~)w(h#@8h^!v-1m*DzN~S_BcO>-&FcG_Rhe8CIZ><6Ac<#6S2_=bmSfUvJ9T)H zvgk1ldyNqv7Ac{f{6h7?8I>cS)1-dB21&9Lxy0TTPHmwyQln7)lEs7`da3D7$zo`1 zsiOh)o0;R^3bC>!IoO+p)Q=WX&?!eLhR}2%W~f1x4MM?0mnB(7B7juNs*~Mux|MbJ4D{^V!s%b5M$J#B8ahDvIO%;Lfv_&6YvaRXV|e2F zWyE*ueSmFCM$XX`M&<7VhQ)_^(!BaKY5^3UDa@&wW^|g=WW;Ybl+N(E6-qa#?S-*DSv17IhVM4h0iTU7&3yX)8 z=?>$@Bj4<=Ag#q&FMJdv+xu^yqxZw>%dfYe18BsIlLtD~LKCSHkz*Av*2Khzqycb2 z5-K|jFDpHY23XO^AUXY02aUA`AkKWI+PkhqGpJc+Gxc84-4;7N<@sHsM~S5;^w2ao z@g@~@(e0)>QGxkrvjL(eFsH`0jVsqo>~$0FezOuzVlcOA@xl3u6Q5Xc!SY3*k>vj0 zEL-&H!9Rn9RdJ^O+qr)q@Mpk`jg{$I+jT5lpm%f}yV-+(K!cHNFgK)MbgH5~60hA7 zJh>qqulK*$NFoNIT2r5j=6Z6grSwz3RudYs{aVj6NK^W%4X=CrlOA|ww^l>Bff`6~ zcG4DT-&lA3Jxz*EW8_N7Kn(P5BZf}zJhENO3yjS$dBC#=!STUQ4e+GY-E;{0}2PyOP`DXlPOd1%}DN35Olg)7< znI)@b3)R%1B|MRv)3&)eYxoYbw?g)wzjBeQ_XL5g%(6x7iGNO2#=orL3+VETUR+!> zv$Lqbxwb@>wcq-jf$p1DHF9E!+4%Id>YRhaB>+xGojBN}DN;mbm3ZR3Y#hU2F-c{A z%s6Ll;mn$!{Y%Z& z$VAeQOGGa>5d1OH@w0j(yt$q9)l#!@XA6uM)miJjc zA!qOCnn#kmkPi=cGQ-5h36{F!Rx7GM-W1)8NS{seq)q{!^1Sjm+(OC_=NjVd{|DkPUG>G)Gs%G(n6B4ek)wo9zq;XinLI0uGDfw# zT#@JcdMIJ8dq5z$!g6Gb57ThTROahvN-l(k0;lOlUV_3-?-*I*w#nZ8miUj9HrKNG zYgMCNRs%+f9`iNGQ&EG*G?$Z>p~QaIZYqWYabrRUqpmkxb;Hn~w!BI9ggkdLuhbgI zgjB=2UD!g;H=!6vtYc4=*9g~H@6W$-6zG@qAf4C^xj+p)bejcvc`O=zG8^VD47+M1 zyVUlwOHc8rV^+^98q%yobXxF%4P4Ea<{ABgDuO~bkZOlhN~ZH-e67W-!k34El>*A_pP^gMY?n{wj{9jlHS_qSJWmMYT zSw%lb?f(P)POmFsk|#GW4@>sq`W8l|HK8^C--X3588_!eNIALxkKsQtu>VPln!n8J z602Z9{_J51c8gN-Q*J0`gt?3f-a9TTU_j3DSSA-~&i#*|PokC%HKSYjzn80ILoZPZ z=hP(5Q3~Y?t^Y^2H^EoPMOFs?Lv)E*4J*4xDb;fRuePQ`{YUtpqd?2&{N<7LN(2M) z|K+bDTHJz2Jzx4?vOY=6D+NH*=;D6_{P&-#CyW1>{=+&;{_oR%*1_`WQ1rOQC*&fG z&IsQ|!Mmw_{LyjyO-?nwMc&qe_S zAhlc4P{V`~TzBGuDQs~?-tT>D-TnRL+2((4r=N2wxgYNSpw$V2=Alri98=LSUjj*{e<9$`cM=_Jzlj9r z%s8=-Da+~w#WztQdm%&)3yWFYyQ9%b4Uw?nVt#U8xA*e|AVMX2pE>epSzjCs{$UKQ z&DAzm6o{#J+q8b!R+I84^BjT4o#P@~5OPnZBr1Odh0({QM>HpxQ<4`BA1z&Nuhyqf z_;-z=HQcy;;KK2!Pu*(7%J6YH-`E<3f9nNQL=KVRJ-())=at09%0~MviDzdVq?N(j+OLe*mpu=OO0RMVXV+qmNk=W}wdH-|cS8wxj&PK`K1Yn^H`<4w|L1==yWqqE!CRhQ;vJ9q=BeP-dD zgFw6<&!%aG&t=$vi>x;Q`mOfi4BDwRY`WA3DVST8WO=eJ ztP_m9TjSD6Ao5t_+CyVTe3od&l*7ac|3<c_onxcA);h7)Ac^x%>yLK!xkwSH2@%NoYBIi4J|-fUsvh;U>3?9#4(#pETmMxvN@nDn>ewU#Jv4XkUD7Bp-Mv+A&?GUcvirY7f zGRhk)g($vdNCnv_SMRg#7!;4JB&R>pAmqx#T6mEru`?0$pYg{irM-QX=t_o_o(9PE z`yBQ;?vHH1S-LrdUtYqeBhkxdZtX`^+VAWZ?$@kpKN$}^goj0Ka384>(iJyUNu;el zlrWVhLUP)}bP`&OBP53hG=5m6Bb%V^I;v4cn`!be~LOR%37EdoaL_&1{j4FE`kM%QYY zZFiQkl-ybwdlnN*+FkqG28y*qsC8F5&bcS(iqyEtA!4tMT7=TEd5VbX$$jUS4aalF zU=&*M11&DJjuwtUqO)_IauRr9j;IX|wBSq1787(qb<#jjentbYNXBt?Ej3qGMg_`0 zY@>UdlY;{zFmyoV>figr4~7^*c}8h}UOU6e8ITD$jzOJh*DMj`K<(JD^~kk`$s6@v zCBl6Pg91+f$%gr%ZLcC7tJKa1a(pCLZEYo1L<9df>orL-oG@@1P1{s8n%I?_W>V|1 z2MVLC9o%@@SfG(Q+`{hw-m6f1N~oASu^jem?zDUu8#cowJ~m9EXgK=iUGh*ppOr}b zBafJ!<=r^Ptm=>ME$a%K8$&kIQdD8@3kiLIfk-Vt0y`;oa`}2C93@fJ{Ql`HR?ww3 zEIip(j!_$f!o#5crYLL>%>SyyvRHQ%PuGk`KCS{?Uu^v}GT=|HWR7R~6!d$b0QKjzS~pFTwMX3BEEpy3C0#Zw|JGNb!CB;k!#Vw;N>C3y1Ll z^YBVdj|eOuXC)K+yu8lFaIv?_#WGY1S!2glI2afgY0pJ)WAxvsUi(O_RxeJQpuzNE zHVYg~G2N>QTWmX<1Xzs1d|?4??-^|Z25J7s`Zf1Bz)++1(0`9{}gp?^JG zx0??sAOY_!J`z1~lBHQMxQ2zl2QyE87p4xc#NYFNs;S#dQr}pp{N{xWwI#+IXaTAS(OowX#O}FV;cq!Z$2mE13Pmrh_^l4m!=}4zNCW_$H6_c_q5mLh;CWsi@anAH z9Xc9xv$W`@PfE`(iT!(h9NFx*w$FaJTQM819#(A_juMAfDw}6%z6j1#paPS{5Opcy z14Q5=nk;=@L54B<$_`KwUt%%VStymM({M|U(JBGArN%*@BGl$jDvedxEV!N~CnJs7ivqWJ%{+5e@c??|-let~ zx})=Es*fJAt_^r}6`C?8zKeGu6`2-mtXA0#&ZP%66gfTPop$kEDo-kNuF4q=t`KzK zHcp~PZ7ZzWAL_!2S&c*wl_s1L{?t>oI);*&mD8FcX0tMxwnXSBeH)J6aNpEk}k913=gE##qv2FUwryHQB=PI_Em)d^n%( z=lTDh`+tAEKitpF;`@Q>u(373%>*GI%Wd-c&fmHkM=se^D4pXNuRhfC_iT%+RlRp>xWG_vYgzsJ(6h!>PJXu8nJW9!M zgeHGfpHm$KAE+J(94uhDS^s3RB$)fOwyQ(biY-RoW;-tOl0aS_|_Kh#hDH3_(hf7OmZL{uyLWXuvWaUL8@tAcGU@Py@&P%7t zrNpEsf&*atjb7KKpi9-fhI2X&7F=5JtQTE39JKlq^`Dc@u>8FPSQ*de_YU6}jSm7QbC7Oku1%FORABgxoB>m&Kj{ z^-mW@c%hmvz*TNQ7^N^lRsV;ipBVB8Wz)T*c>l|Fu}Qs|&JZ!MK7zBLPVl$`#VHwV8}Mj~8li*8qrB&$qV1joN-| z#QtI9da|mtbz`w={J}Oj_;-CU6%M52Y?JsYBy>MQ zg}h22{j%mjJaekc!l};!ZM>hy1qVB@;zeQS+VBnI1;dr`nTWwqv@t)6rW@+%W}VEH zHSi+sYB4bz0P7(v&h(GBa@E#eSJ}>c zO?(Xrc^oPud*nY?-TT@3aZx->g7A^gC2{D@xsEZn$0;LWjwz*|CsN7t3p0Ok2l-Ve zAODS0rU3Aw5?jLGcG$B^HMYYM4&B^uj5|DhlDcJn@|>gpxzfDMqkz+W*F*&6v0^`I zAM6_3x)!2UYbM;dgw0E2r0py>!eK>1kv6y#@XAX%{du*8qT<_pclZY2t0pvDH9~jY z6OJDHSYDrhwflBePxIN5x>I&X`)oGb;polJb<9lr_O-U%s4C$o@$m_RG&j4@xi2DD zsxfrJ;^|;T*?DTt9HrP>@@mWM1HHF8H-uEri|(x12^BwT1?UJGISH&YCMi_8^kI*c z$ds0sudB;RtIFgrUZZR=+;7mE4o*zx&;LHwspxqB_x3-)NnH+c0w|WB{!beD*cC;h zNR1T{$Tb$O;LmVj9NhdS!_gJ2<|lFzPo!=ku^4{46Yjb7uSaa$cXCn-xg@*@3peK# zz1h}&;`FdRiB^qLS|?JZR!;bdN_&}k5{=&lmqbWGFRlKKZn5Hy^G|ftwWhnsW1o|X z(NE#R`(enL={-Ezd|LE=n*4Rd`{nf1unCM_Y^qUvkF^tlcX7|YQxolTPg79IGeZD< z#o8vY(ZtG2gHo@C5YeC5cb@E`IU}`kv$4<3-1_9zrouCo)VGZqip~#S($TQA^pL5ubE?0KYl=ZG z7#v=zU2;Yi@dOr_Zj>#qqFUh0x0Gcs&!7hAkz5eZYsW~Zl9+BeAQ9n!ZO>b|2QnJx0IbX>C7(*v(JHm_=Ym2;UDwZE&!r^0v!7Dh8I z>>N;#1%d4zC}t{8b}c+`?412+o685A{$hed+Aa%V5GOx>eMN%=#4p=hRtxEirEf^$ zv0)24p;~a~OtF!Mk!}I=*fmGHyF=w87v5_R&pRA!A>A?J543neojC(~%OkSH{E~z| zzdB#d8~%xvhCZtG4|;|-WXAq82Kc7q=R0GrzrY@2)TW+<3k|X!=*VpUm`_mV7A>)( z%x(5Z_Ln`A(pr<<3>8vJw1Rk9YnnUTP~Fn~-jCLqEDyn2R}JnszbwOd#S3{@c=@m2 z*k+!Eu@V|fVa%sv5~TG%qs3~%7qePa8_N(m6pF4o3Fc!CZMNmtRSBJ*iwbZSu*F~}oWr$PEz z8sq8_IiR1xU0;d4%_!w5@?3y1GHdrZ+xvgC?afBBM)wt$#L~}kx>3!kL(f711L1$~ z*f^`!dc2cIFkGD0IpHY!{cAF@_mdA#ua*GHPefkYw5zlX3_#9F-ys2$upzP*9KZyP zPvhIy3@_=w0^dJ0%_Ez4Np(E`V`oH8|8a@FWpAvIWSuZ@)P_we=rFBd?H+Mj*1$3y IXSq232?`k?Bme*a literal 18430 zcmZU)Q;;T1&?VfqjcMC9r)}G|ZQHhO+wN)G)-<2Cx%0jI{}H>fby1O#btZ06is9<+Q1d4Si1{(11x}aKM%>r=L#qq1RZwhEI~iIEEC#cYcoLdC z6l>%SR3mWr$EkWUg?v4^BM-A^awRlMn^Y}AxX?$uyic{)QwsM*+JTz|Xp=NQ4cKTW>j2#JqPbqoT}cAvOE+=s&~GSiOSlE!Tp z{t1cbiMP9W$rZ3H*xswg>R&f)QpBm41?AX1GHN4+~X z3?!~!e2vxNX8Mh!$glL)`!>mTOjJnblDgcgxO6>*0D1Wk~9*wfU>k1pLc?iBH!#L&Q-m)x1Y1_+W-k=;JSlCv-f4q7<}f4&glIS3ku^9sfV zzCIa>cMtG(2N9XWW)Ba+{joz<8gmSS6ex7*`bISXLNO8upfO?+wgt`)7^Z}x0tJRV zT84Fk^~ZrEieVOy1O_M(K?s9D2;CEdFq8F}!hX7+`jP*;Awn_>A!}eHumB^)G5Y{% z-C8^b5e#I3Sxz&6kfS5Q&GCKym&u0Gd5H?BYE zA9Jx?;I46Hf!m;odzgUjR}Apy*`N(&5v`c_h+(V`yzi#Lvd39&0Uj>y9}mAs0WFOE zK#yAzq;q6JIA_^#3IYB696b10{$m`(2?E%|_;UqD_b$~AthNmqGN3NMFBjOT3k0aJ zqQD87c^%w&9+4FDid=}mrDll6lb{esR0)~rpx8#RQE4`X$*OC-1ZkVXrYNfL(2-(| z6M!bqY*REBh%2Z2W6etk@-*jJQzgcTCId46YQJWMkYX^sP(5Z0$Q)j%TgMgnfeC7# zogP7+PG0_3TWf1;b8jnRhe2=y^pa+YQK%+jr)Kl+jfXu=8wFn{^RLiB(9yj=&Ex&v zjIt$PBE5>U5~Y|z9{Ck%aMM%Mc|fv&cQoDg1!r@5zc6UgdP+>DDDbxa+>k*dzYY;e z%uVSwIx2Yalt$x}R1gxy37Ai@?lPh2B8dGI4`+qI0HEa?!s`ScI&U;uqf21J;rIs7 zJCM$09HNN?%BFx;6e5U2ALRFn!;JkXC=PNI>!Hnaz*E~@d*9J~FJz!1QXKZ70_b|a zAwuvGJsf}bp!jhky+$nk;$kk(Ux5UV?P3SYQJXSG=1`LC2{mR^T-6rWXl5#~#KV=Rbvwp=<|e@iF`WSMLE2VxO-zK3F?W=+nitRs&V(DV ztwS_?5+cNNr@pCaD{g`xDkIzvKL9iN)@bJ z<>4na!e*#*nR(fEL1=m)(4;PRJfEC%?C=r7u43k*y+^lOj)qGkRwesPUC=+^E!+5A zgO#z`_THUb0ez0ftlMHCQDs=3>`ZV$q87S&PaJ~ln$GTWyo91=>n0y3LFX3~ga5Im+_&oO7Yil$}}zyHr5~ppCXL&o=_J`AwWF9S0Nz-7LdpaK~a2QB&Wo1 z1G0hOc_q1>QL~#mn}|b8c`M~u{tb>U4cWR12*yZ=9Q+sN%d2vvZkR;Euv^hVDaBJu zpiOrb0YG{ZGRE|=HxaQ?z0s8Jf3W^c78;jjhc69vh6_SNkFj|ECS&YiRkILaWF@!8 zWK5T+=mtj^Exk3TZ&-&zMxd8>5a4VikrL!D=3z$FCb2eh5UldY$=5C<+8*%FoQeEQm;YFN-B z;Vx}1>_jU08l56A6CqjgQGEi)$dA?lzxp9u3P_Ly1CqQkF^;_|#uI&6wDoh8qxR8k z)rycs@R4M`BZx)kBW$dZCb)JqGbmH{%b$M=q+z0_^rsiLLM6@r((6*W0%g9y?FA=n zvJ2J^tT&|jCozL~uVPy*8X%v17BOb*ylM&tNIPK7L#n}B27r_xtTYx+cZD!D&qFr{ zR|5E5@zyO^>+}jr@H&}J_^9itAPe^Kkh?}ZY;_g79dRTlw$aP7h#RWR*bkGsycogO zGgY>V0~*N<#x+sro)rz4Kp82F!wDY|Wgy-o3IQ)Z*aA^HM%<9@fJD8KxqKk zmdJ!GS^5=p%{o_pi`eA@e{{IR`cJnYEt*<<^e-7I#s?PMt|KV?rBXa^y&*0HDlfG4 z@eYL$mqS)mjBx_fm9&Z{wSnoPB4vjc2#CFqmoN)78M-5Ny?T(54s|4e=fD7_q!s`= z8giQlwns&owy|CJn@#Wh0=Av`gi9d9#NH4SR9Fr*zJ-{zjmi&-GJ*G^Z~4<^JZO;- zH^irxa9v3wc<$*iox_{rRfjkN(-O07w1e==thx|krZB%)@sS#35ke7kJ3XU5;)98; z++l;0!vzX8b5NwhH5;`wh{z$`6HT+jDA{%PYS{mP82T4M22Bk|qJ+zjgU@_I<-j3= zoun00{kfYml5NKtnNB(CZ}oNPv4wt(p8_0|QZ|S>9Sw$fTP6-Duib9S*nL<7^1@(A z3m(`iN`*V-K^C6|3e=3TrvOn!L(?PhSYB`}dNfTk!9wtYqYUham;e?_&9u&XZ|!-I z<3kgven-_o6PoEf5h~09 zG-I9)4hqLfPLN#@_0dT0R#g zM4GB4C9;JtzU0ArHbTFi4yi<;>X42ar(~KNYR%*zLKAQ>i#ju+oaCmL$y{~J99$L- zaeo=VV(>e-Y5==E%soB~ygAXdO9EW(hCHCQLKPv$BQcX)M8ibLj*}&kx>Zyd?XjN( z;QI}ikDPm;t#>1!vKr^jf<-m$emidH>_CvP{usPgA24Jpm|m#q$Q9jj{2b@^0SRyH zqL_S>ZQ`wZe$vc+i5k`rjLmedSwtomoSPHBZ0h2pkq^RzcDqh?g z`n7isII#a|1QIsW-~J$B9J8naIwrxfv_QLyy#XE@Scx6T5VM`#QEc%GXsvlOI_^Bm zgF;t_19iOWHP&dtWOU5H#PsB9;%ZHYULCCaHVM3o`-+>d2m=SccI+@fFv1Ac!YJJ! z{TvYGjFg@Sw*f9f)%opsWcQgq5EISlbmPpVH!pyN@V`?ieyr8G5c{~1TTI&5R@474AYn*k@0xTWCY+Mf>AdWhgyMS zZ0LwV{l`ah(gZAqT!n%iE@pv8hk~0=r)D+?%EyZJt>XD^p|}M3K*B%)NeFfOP7!Gz zp#jUN;ZOLeX^SXc(TfQhz0G_jB(bk#1cCW?(8og>r6wJ@{mz+aS1s#^Z`wRhJl5X# zZ@R8(s`(SNn(wV`uF){pOb=gPgSjxbuH|2cgmIycEZv=R6ba4IqVgiUboM6p8vS`t zkk*lmh0~8oT_~FJG}e}1Jq3RkszZ)CY9zsODea1I`w>5Fa4AoNi&%TM%8F5q!Jbis_#j9M?V<9^MY9 z84Cpr|Dhw>*Vc#YH38URmE7xeCFrwBAT{Iw;cM@i01XB_UMcv$F5>IUdaivwLzY3W z0f52>FyU>ym)}i;?ed)0ShZ%vpFz3-5j+6yX0;p?v?uj8+X9lu!iaWa5h?LsA3 zS9BhavaEhot1W*sp+L~sWB3Gueg$SO{J8Qsp*}~uxYL94V6cZ)3ALF-a%EQ!xeBFdu3?(7vZe6P#Q1G3ME zJt=r|E#c;BZVmh6Spu&-b&i%C1a{rf>)ZR(C1b&=!Jzr60k^OROu*giy0kBe1yRT- z3=aI=rUuhep_=fJ^s3pC#Qw3M>Y^`S(C?d!rghHwO~8sFgaz2EtKYT%b=;m=AF$zd zI6$&CP8S4!LPS6cVeKGJB5f(OoIB;roQCxv!hyz@PA}nuGltd81nhjuuqy6uW_Y!H zsmb8p=GLaKDGu8vN%>`YYvMh%xw+YNIRA`|5RBciqS)i0Go*}L(JCizC)8BHl-jQ` z(TR)o*2eb_2I`90ansiBwWV$E&XLSAB>Vk{4j|oR=Dno!GXI*qN4VugT39?G1xM6r z(0l1tI{?DN=k36sa+L7)z0g{J7hHXRoZV^k%LQkAk;lNl5~Q&HcH8sfBFO_l7E}W$ zVa8ZlZ>dS3y;L}0KY@M;=5MAn^1x8)wYd)#m#6`@dUvzyp4tsCKApJ+U(@8tA0q%u z_&S$}-0!0jE7UneleqVx#iK!I3~FeqLazO$TR3h6t4Tkzs$pFMYD zV4v>4$!);myW`!A$TFJf-EFVg-6GEZJLKURfSp2v*@+qZ+Z}pJ)8-cDQ8FM>HXpUy)|gZoVj+@4llSk%l`qDyd#_Uz`rq~ zw>RSb;k^~Hx>oSF&Wt*Yw*!)Y}_U z`@<#SYv;?B8;bB@2H|RZYpq*byZeKn?U_NBaBU~Iwzr+9G@k*|Ux2H5Y~0+J##;!_ zK;-q(B>ede0q^m-ZNul;%iG)AC47L+Z-$_6_GS*D=EvY;W)*nW!QI^6zd9t$WEdF! z0~)7o55GjDYf1ocb#*LBDm=_jZ*^&qjWW2pI(Rum2-yqB<(S}hdwx}M-z(AfYMAod zUO(^MkX@blFc}^o-tF1(YYrdo@dWjrYxHdhrTyH^v$Y4rAkEpoxbMLTY;Um0kdzEA zM4T8RGa~Ja<9?yfqx0zQ8{(vMhkW4D>^<+1V2iu943yc@lH| zx&qkrn#z2*-2m*7bI*6T+Pfhebbnkq_Pif(HauWoDBh@<=_8gifW{Xg>jPyH*jCd|PeA@wW{)ArSVTn`59(O>MJ|q2JALW|J|@R$^w5aLJF=Xd<2AYGkA!&fJtdZe(aqMLC9QRkn~@(WMM*EE zMNe{LBx$?qV5S^G50Dzny4r|hE}Q=L$>;8vt;Z#PgW^|ib75ML#z5alqLKEC5n~D} zmo;G@Pxg|b2k9UB(z;7vwzT<{JS9bpR7sYo&l5vP$8_WU%3KP7=sXMKglpyHZzV)Y z?!jn7R((v)Qj)5smz|gkf_XgNWkA8u_XhXGGk4oUoy-?!VQSJyXr#+)wN2cr7)N7- z!7U`myL+3;z=?fiO*(OqWLq8RH`qKoe@shc7MsMPdSIi?6tMJrOi#mr7lW__A)O)y z(s+()iuhZ-mc{L|xXE0hniI9Nyac~W8HYa?hXBbvKd*M=z8=K16W}ujUG{mXsWA6q z#wcb0VAbS1SY3v|INxsECA&UxY-f4ZB}z*EtwVIG6UIGxNc}6HdF=h=cXx z(TNtZs-RGRcN z2p{d?e2$8WB#yeZc}$~lj%fz=SEPC-7D`Q#HCOOBs#lWgEpog43`@HgE^B1^e!AZ3 z%wObDK~JD>nWZ<7YZhPemmOxr+ePjA4?K?ds>`zzg&gAZP(BnGA0& z2L)?Ejr=rpGvap*N{cN+iny$t@^fRS>$3kVG$N{fNoHFj ze|+l~Po$qw5a1h=)U=i!7nah)eNX+SP<13y(nx<+i=D`{Z? zkZhi4lkpsh`kk1-zNaljW_qVD#haWq4M|Nk*uUC!eq*O3_FJd+U&U79tWw!mOvwo& zynL9I)Z1s`-@EVl4VziI=o?2XIR(dRc(~oGfrif~lDuc}U7p;gAE|Rm(MtKEo9^<2 zQLk05-0g^hxgBehNU|X>qCUPu=?za(t7?fYPq3^J7>#~y_Hk=EXur{NI=`H2ii70; zy+nGWZbi zc$sdlFaB4ele-_WJf<1^8O=STcRs4G3ws-s(C%4}O(9Raw;UY_{N$G3MAcO~TTz29 zJELRsD#%sp&(&z0g}^br&Wnk+w&&k_IFU*5=cwBzqzOtqQSrca*I`7fjYMM9y%kvo zY?HFwMK?|zgq){NiM^}Jd?u+F#rsE;<2!l}t32RInS?8uhCpBtiEj*>gvZx=?>50a zNZ5W)1dfVoRTsC-O&xLL^NcJ96pVB#CQNdsv#f_y(wLi>&$7ywiAdtqF4Lw0bl)sg zksVk-3%l+cd-pi(m(Q9u9kj*io*zXCi~mLrn7Rm!?cd=}(LEx~8Uj(}6qBup%t->y z$11#IUv05K*`{k{ic5ZRBgpg668G!zKuno5i2x_Xv?EXktV=bpO!;(V*WE?_tC)}# z4duq+aTlavq%fjBVqqPJBv~khV4|~+8<&p2wq&bNN=NtG1ao>5MXAiAAb1PTqmN@a zRHFAn7#F-dUJ&Nvo3d(jE?4!-3=zrRNDzOODD+klCiOpk!io=%GD@~-lN*Gpap<9V zG$<4yV^&|(%YilhGYuFw8c^)D?cc`e2F0p=K($33j7laYU9Tz__wuSzheLOUaD4h!C_13~8doyCVqA$LbU9G=7r9I<3LYk02#Ym`dQl*H`Sj3K)Cf>=ww4FdX4zEw5H#UCVJU^C|5+U({f!9W?x^!m-|=$`eb# z`h5=;R3c{asy49OD~t*z=5`!c`#lQu%OuPr9b=UWI`VrPPcV8`*;q0NiJgUu`E|>} zl+qA0g-%eaBc}4$#rG04aQp<8>0H`&Ek`QPyAvRF;xoNvlifShRxzU{^o`1;CgVfy zy0|=|{z1H30(E9|9OsQX3DG=2q&N51{`$;xMcb=sIE-k;vh-T0{;EX|rl71nA=D{I zH7l*@*=F1ugxNd%`j7KJKJK4l`kFM4X%-V%^AG|gijsx4JWMI{6?G+p^&;Y`1n+YU zA^8YohC!OAJi~cagpY{-DCL)K)PqQS*V<8xr2RR{^SL_oVlc4^yP6dFfce-9ls~>ZWQZ}u(s?ph-a>uJ7aqgXs3ESR))*u- z>g{!Yd9t+~n6T}S6l}p-j(F2ZUZv=ZZnUp|=k^zHH>b6i1@>vrL-RZ#x=gLEd{Iwe zOgq}wt~-bCdBxl$^QhCfmrp`mfmNf&hrZ#as|2|_xJnlv)S&C}V(Ts%{l{)-aLeP#6=gT#-?jE5&y~YS82!ssYQ3(ff{B zOoE)g2|9`zp2#&XkW;GMfOO3{UB}q59>>!+DVgbY;u&v;g>CTu>{BJcxY`EMbU|fX z4LRjw?%m+Vnf_m%$Lw=%#_%59#B??uMdO2wv5w5rWE0_o-|aK%Ruk!pm7A$$T5w*R z1DxNZ|IO?v@BU?TCd$qiTtB?~O=E}Rov=Atz~NLn88VD}8RgeL&SZg0@EX_4h#MH& zG!*0ZYm1S*Z!_Al?*!}!oNieH(ej@L-k&d4(UjUV42hfOAvF#!7nS56RC>+5N;m#w ztE*k&dYRU!+UH1ymalIv>!gjUfj%?*D0{(oToI+VU<6jT=&d!Kq-2hGgFB?2!AQrr zHvGaUALKxlU+edCId2OaWWdJlFB1nsA)NKZ3`^S7ope((sJMpn>*Zh$`pX&EpC4|2 zj>@lVKz`V8jr;N_|ESK@6KtmLtbMA^^*(>yDuOS(d>yqAe(qon$e*XgzhG_uX5Pag zGGFd)3EJ<%zd%^9Kfhj1pH0W$ByY{Vmb~P>k7fbf8&h&B(ee}mZ2{=For{I|i1XlC z&xt)~sjk@P8lquC#-(DXUiu;Pa&MokmRfyf2hYVSS(GXV18QZLZzet4X7!5#?cXVh zS_&QC`rN{j4_&c_+V^TE`g4U~7fHl-J$m%OqT1v4Xai(dx>;C@QRy>LzAfy=V$nZJ z^pD!#*YC3n43p4$@N)89t9J$-D*`-0^6C`jm=x(>)tAz*_YbZ=S5^*BKV7Sq1aD{Q z5Akd3pJ$(N8YiC@_7v%_C+}BMO@xlbz*@Kd;Tx3mG;N5`TC|b9g*pRwZ%+r}8B6g z3j8_2mUVOI7iRf$mIr8>%^l}ZdBWc-)I(Nh64?z}&rIk#S~d1-wA|wn&WRS=5tuo z!(%9j!`VfcIsG-Srkj?ds-pFfbA>Qp<+=kS^K~7sU>1M!!mLs5m3tp6Tb07ysIv~D ztolLuV>kZXvmeMQ!=zBPzpHHS02Uwk5Ha4je|z41)c1d?vmT-&IA1Pn&20F8L3?Z?LT3lWwRKksi|9)?5C)+S z>GA+9Rdu)vPYdfL{7bY{IMd5abtB<+ur>U(%;xmp`*QhEzvmK_XY{tvZ4gH)Ac}Ef ztURb!6fh4Iq$=J6#Jw98Xdc*xZ~@|LiC3|~WbkRls63kRI>oiM5j8a-c$>|UJ#!!o zAioJr1)@|Kz|2O*hU#JHEkd$wH0Vw+gXs<|HUde7TLeUK*sQZ_U2he#| z=GaOUX$nuc!pdL@>gMX48XCT3yB*5q#J-jWL!{+!K1YxG27yVR4~U(pv_g zvgSilh0zlq+WR7Ui$&1>;@oj&&0i}ta3rhI_K~yVm_?wF%YZtZXlg&kY3D^XH|Rmb zC;heDmv6(D^k(AL(90?bMiQj0WwxvnSB)LjM{z(K1H=;>WM`l`Iy@hc#sm2axtyw2 zb6SVwkj7N5=*3u3^F;iXlN8o4%@QQ+`{;e{$ul_WdU*FonlpYOi4-m*fIv`^7|-kO zPhfP?91=N)(Q7BU(d4OS@)G5KBiNaZ5qV8wop{x4>yTj20dUg8kZ*PWf!EOj5#*ZG zlnnRi)RzHN=*C=Hl$yIVZ$~Z)DGkd!Gd@|UBA(=)--DJ4$`e+Pn1#tD~XW#a6JDtLytKXlRXtuG|^dGf6`IP-$nvV)JUm~5CZ ziV?D+$8chvOE(YrXB;eht*)f4rJJ!U^P%(3en$^>20bsgw%`)gNEw>d zaFA9z=5JoV-eX||<30`sYYs(h=8W8{gj}X(?S!DVqMPdCYbaN@164_gg-_j|1yhjG zbKoqVz%(oci~H1#t-fQ~fveXiSTT6g+Xc4->XUVEAgcOZl3YQFdbZ*=@`tF?cOqm) zN6A7#E5J{;FQtRaWGtmOS3vmPHQz=#tbQBerYNSh_x*MlX->qP)7G?_=#s1*f$%JqF;x~#KJ^s4sPw`Rn(+;(-C_LB5ZQ@S+|kt$Kx$$$Ir<>h|m?s7m47GxK!G}HKcWj#!V8&RR5z*)`0aX5UJ}FADy@0qGzd2RW77TG!gd~L|XJ1{M8jlzz zMHf|z5yBiTqNli7`F1Djrq-2kxcPV8JF=K*yK`zccTE^yzZ#DgNu|uoN7y*+D$vlJg;|n*wCS8PmiYh<=nacpEYxGcv;06VzJYycT-k?bFk z@vDDXi%EOzv1Pmo?-M9P25o&63ZZ3Dxm%i(6K>T6nf9#1xXPKzw$4EbX^)%^gC~vq zu%`^eFZ07wOr;*VsvNVAm^HRuLV%*H{@2!qj8g$GSHquL>lV-ehHWN~-V(w%5+o%1 zjsV!$CW-CV-9#Msyi?jcT?P+4lt-D9tv)4aIejC3K9f$%b}^#i0Y5BoIbtJ<eKSA zf9dv^Q#E>hUX*`x8NGM*3v4aYTv!C`j6NtKn7Cg4&!jvkx)gd1ZoGy2ihO2uymC`=l>9C;@;MU_Ixrdw2YWUzu_8jE}W2l1l zd$VnTKZ?FIWT8g(FS!w4R32cvxF;muTr!sIossEDne$`;CZQrJVxSZ|NdQA4XAx6K z)lFXGCTYG~Q?~oE-a~8%+7e1vC~zfqDIwS|ev}d<^=|~fPx0GHFghE`!3DvoI3atW zY<&F(f&5&&B6VKw?Oq3I>02`)i#$IGz5T4ckiLvQoKOL~Z$sQ+nBmR?sc!GPn6}daN@ndnZ*ojv{&( z)2c`DPxjkXYqYKvT`5KQN=Kej$rt+-nRzW8HWDgss!rjB`jg$MY51?WtZuy*1Tjql zy5nWcbNgIl)RYXZ+n>3F06j=cje-wFiTj_@-6LsI&PrZzW zxII>l>bz(dEU{#cBv4*I4W)B_%&ikd+=n&zXxn7ac^?`k-B>CSNeJzfQ)SsEZHhDI z$yMMlZL%BJn%+MsmjP6U#jXLVOskvwZDlo0f(b6m15Q+4WY)ojN^@Tn=4Y&Cnrk94!ooIWss?sU*dd3Aw z5gx`^qQ5vG6iUCdL6ydrafhvCD7x-m+8kDeB=l+2_B@P|p#1P+m;tHx#$b)a2N?ny zNj%`bszeLIAHOkms3e5_OC>q(30Zx?raV&HE=^rWCIwqKJBmz^)zN3FIvT4wvrehK zQaP)Obiscrw5K{sipJLtL!%DT?LVQdC$e@%2Bo-RpAnqJ0% z>T@RyQgWzL}=0YO8qb?@3*Iw&x<^h1Q?b^0Bp z`sO%i069Eq6@oL&gP(WF=3*1OR$o>1KZVVmB6jqN+0w`Hny4aa`->`0e^}M&PS^Sb zyQpVM?<7<)Cm--0*6^fIY0BW$Oy~ayN+laVniWr0TOt%*L%3hoWTUK4cAk+PwB(qH z)(J~n)Hag+{oMklIH!d3##;-lVk*<3BXeM-#KM+;tQ?_rLDUcjq_^8AwMZ8dHV(Vh zEVt0|C)0`-m&Du+1$u;5v)IOyJS^RSWYHw9Csl&B2d3JX(l5zKDI07FuB^t_ONs7g zA!G>Wl*4igbjO84mi5d`pcTBlmtb+Mi z$YS!PR9Jf67}qYCQq1&g_xQ>zIs_95<*{r9nnX7F~ zXkpa#>J(ow^jjBS74>)(Uuk-tF|Zr0IN+M}khQZ&35IC%w1T!FkEgnOrASotA1)b9 zn}Mh}0#}G~@EKOP@>PtU{o`MR8>nuCR&Js&CQj|7sE#rZN2%Zk-n>CB_g0;~!rgjPabuADuSj%-1Vq8afdjPN=vYim;a~Z!tfCUK z$V$o~kJ^==Mo|e_#3f}=l~h7j|F3!eU?QX(vW!N=_Wy19zfIqFjb19Dizrk4{~d3f zM#xGku*y42sh|w)>|qj_xm0jwbTF=y(}EtsFEu*249%iZDVz%YAL>7h#VJ?HCrhcI zER}*X%<`X5Vrp5cd9(SLY|Cw#BeQ>yE(4kWmQq02HWw|Vi|P9N+F1VwKR=E&@z441 z5ys!>cxL?1fffJ7Rbv?c=l}mh{%5jG{dk%U|BHsF4AW9q{2$EEI%p;Zq!z~zP%2pO zfbiuIw5z(G{J1xU4IU8LHNG9v2Y*= zsnwp0BF0!IDvn8{w8$EFy3jo{6CMuPrOCIK{p91mnGN=mjb_KF?bZjCT0MJ=$Ojzg`sQ;4cm3ymbi_|V8weB zF#`IpxFsNm8iCTqwuLvvlNXT<6gxFtYp>2NlN0d3V*tPQ95%Hp9Fc})@Rvwm+w;J5al~YV?b>I{^HMgDuE;6&i3N=%l}1!BskX3S60PqaFVU0? z&^;ET4traSb*u1FvKw#o7H3H_CakqV@WnF5?$o!Jek@O9QcbO@T@>we1)0i^<%Pu- zU6w>tcIRy^;HfgSw+w8>3zG5z0+{r2a^d=UEG#Xih78{PYnf1%=5td0PkJRAjZt6~ zhworCBoS9B(Rlv#{E)|~!SHEMFdO$+7Ko%ED?U+G*)*%vP9UxwEvFh;D}oS!f!iou zdpUhPQ74emLrowNP$4v_k419B^&bAH^Q8%v}S=b38Nww)efat1sRXRb7FPZC;hFIQyW9Jfu`HQ+OL4fSO+%FYwwg}S+mfqc4aJ6Lrk~*t^ zp|(iDo z7ww>yr-K(&L8Cs;t%}o9Tca(is}?iiax@qEXYWX2pIc767im+EY_4OWknh_UB>P6) z$$8bN18ek=QfC1};)oLJE))ai%|N^#^^{no52iXh_m1T30;83X9{DE~5!&tog#4W! z&Mf_T*f9^wr9@340s1zh(+QE7(VRL&Yo(1by})RV8gDjL!fwW{+=|`_!V*)LSnKYq+p!r1pz-iw0UV`6{mO$nf{26cta3xGp#zhUasb_o=6&ZTT)qS8+wMBR6dlp`ZFp|`<^?6lUBo_pmuchGG&m#*vJyDjG zQ(lE95U&th!3l1cjB94~peZ4fR>kL0tn?zj38Sgjdg)qKwRLV=gssNPX#%buk`l%w zTm7d`t2Hb40c0RDXNz_+ie(OKf46KuxUk|0Mrq&y1?daDG(%)y>~~fWc-k>S1KyVL z^kpIm495Tdwv5qRDGDFWvV7Xjh;kZAf8 zM|3HwA3M|TKzSp}2Pa^_CqyZ6Jg}#5x{yH%=n}EDwbmteevk4w6;}uq%mE@*c7{-i z*vhMZCygt=^kfE#^N1-EBUS`jD;x~%K<*X=<(iRZ=_M*it3Y8u7GaU>D@ON`bc$Hk z+gpJzV_tyL6oG7)$vW}mk;6HKKLm%To5)>h$cwr2;CG*O7is3|;HmLXzqwU&2GN09 zr#3=a@kkv@0CppVs(!gGt};d=uNG7$L(l(xzc&^QC=26^k7A3+%iL;(Sj)?QN*8%f zVC9j~#TA%DAY3*0=tQ1+Ncs3~9yqWI`t)RjG(IfN^94UVCa~k>gONCYZNUb6Qmi4T zbptEtwrp`Nb&NocA=&y7KN~}T9mY6C^mAo&gJRcZBbbCjV`3t8X8+Ur>$@p7oqk@hwNMq_s`2}PP z^G7AjVuhkcu>p#v1}%1YO=5p>6DTOB*g7|=41`YqSXJ5NB0o4P_0A<0X!oher$sUD+O=F2%m(K;}wXI*7Rgyrf-dlIjm&e@Y4d~~ z6;-dr8je=f=3+d98dyVPZ|N<9-kVc%3Ms!cu^jy4WU_il8#==&JZ^uRL68rf20e!@Vz#wxBasP6S6vOWB3Jb0OGaDjb1nP^8MMmv;}WRlb3|9 zs2sy`fyBZw?|gax~mpBc$z$UUwq}zkNmAukyjsIYS=pR|)^+^AUAs;Qf~5 z(OVl^B*~Zn3G$X|ui4NunG7V7tV1gm5XJ_Pq8Ik~n=wkzc*6L8rBa%P$OIii34VII zJNle?=;0=Q@D-T>=OemNJZOEUQ_l;J{{jz|#ce<)zKXNy(i#L?e%Js*Pk zy<%2ojTSGctYd1w_7J`X?KAd4t)7+}D3bN4vXQAL2;YA?WFtDAFVaOCt|r`i1ZUdi z62dq6bZXsn$;S$;{QY-iMOxXVux$K%IwjmKD&`?IG@*3c%{`=v1pN`bG5lv%(zHUd#K_b(CI{dml{}jUHJ2MX48$ zPoF+cl+r+*PjWVl1AkPiP`ln{rA?s|lb1Q!joGEv#MD}s+PzzAU1~3Xtu=PgBW%FP4D$sEB zFKebiVlCHqiHMTHh?69Lx`0mc2=~|c&%VX z>wRM~O02ag#ZmOskyU5pm~}$oT3p&YYK{Bc=QOM_UJ zx*z3L(bKP$R@DtY)ZG=+_=U;af01#|uz7{z>&*Zv$zqZCRh+V9@%O%G5!@{)*2={# zY}{y)3Oij=P%DpBDswow(j96X4AsV8a^P$=3ruyz18h|KPqg<|?Yy=p_%tTcwSo(& z#P3DI^bD+_VAf#={WZG6JM`d%r6(tR){nhv<|B|;N+$XiLUCBSw_jKBMIow zXc?LoFF{A9i7RFBT2qjaHHw38Km*}~<53S<3n|6wHh4XT8{w%Ih^{V#XAifgp_d|d zpN(7fLln+vkP%i9eYpj{vKf$(=knjyG>;*Pf;QYS{tB?FD4M9?0&=_5iZ?T$*7uq> z>Z&OQ(u$6EvQaJ!s^W;j~@6TdS$;UCOwox&=eF(( zET4F@fe^n>L+w4im$qoA6@_dxf!JQVp%r(wBU4Rdx(`mA}52_N0cMVxH698L9?lmUv+oDo* z78*VZ1!$Ig=rg=zQPzR;9MaTBfEksM@|3pgkx`=V%8RD{uO`kso(cbtLU(w{g6;WZtmfXiSn`1+$v~tcZn_S<76wA>=hqHe2d-V8z z|9ZdQ&&T`odjI==KR%Dg%SYo!lD7LG<%+^_vgBnL$MPUk>fN!upB+I>Wc%ytNryz; z)~`m@SbaG?$N_v`40n9CLX&w3{ilbLzqfkhtKa3sNlnC+Z|lP?n$cF-! z?t+t}AvaBfHw~~KD5(;z6A*`$Z|k5YK^_t{UZ}15$cJ8>cnq5tR%G0gZAXCqRmz## zSjzMsOIgxkDr)4F$V~F5bq}|C4b3${9jTe68a&Gx=CeF66Zzq;w26QSUlEW zFnXw&2h1G%!3~cN$t*7T9+WOW*4}g7&zq-+@m)q8bQ~NZAUGc9^WHii@bhiKYgb|0 z9fR)TdLnxx=$xxQDFZU2ZZ;Hu!WKsnjRBY)hg2HXAA*V@Bs+-6vR(mZ8i}pLXy@Us z7JZs6faFJ>kEM_b>!%aGTHKh~s+&9MuUvAAF-}Cjda8?C$H7mftWfb$?>E%Zdt6~h z$YuVY7F_-)96U)wj+Ps}RWxIUY-^5rq`W77(n+4B1;9S}zX(!0j#vJ?KLiE>NNT#3xc^ zjX9=qYjEOzx(0t=bj!2G_4#OnpWD(~n=5aqEjAAJ_r|OZDJ9^c&`-1bRIY{=Cx;`q zN&*IlY9l*txe%iB z5T>$oH?`qQ?cV9f2LJV22jt;R`d0)Zj4D^!ftX5b*}J>4wCVbR{b}F~#BW%EKl4W= zHUCn>$v?9rGuu-1OpKEp8BvBTQFtt}Z&@?jAK!GNHx$_oXf_Qt%XOaGLf;gSm4i;f zjlEBNcY9MxAv?sJJ1iCktn2vbi*z}XmULdSR}co$)a@h7^a!a$#N}RDOUl?6p4zSL z*BcS3cEU2CFe~lF9({pPlY0wnJ&xFY>0I@gFYE8o5OY>;oZSI#&``xX;ZWtc$kGxB zL^m2g69~hHRM+fme3SKod`V~pMJg|TGmUDf-QG%kb5X&O0TTDflhTNPf;t@Ts=JZ@ zqPXD9?8hq0z&4gdug($Iv(_;EFIxCY^GBC)n*^0#Q$t0t5WtRkiO+GRy9SowPL`WL zCK?`|4q7A8?+JkNM&gJCd1ykx^RiAs_Oh{Fi)|TBB12;5Hj{iBya(=nXJ%fFCZlOG ze3+OeFC>V(_PY6*QQhW(wNs8P?tv;y{A}QOWLT<-_^dq~FmCt%Ws{ks_X@8lD;>9U ztY>4qPoA3b3-_3<&24Q&V046fZqAQ#$Yg0D?ehuLG=*Oz-f_dixQ&`t>MEKfOGi>;A516*s)fb9q{(+2$OML| zB~#^qBS*sntWYQLWZpXxvQT#jz6@F)?pF#i?VUemM>!h3zClB|5W9 zo!QcL7@HbwIDdT~cJJR|vr4kGiYHn;2kh7h9B&2qx-DXxNDRBz1f-i5k69xTvZNs!Z7`**V2mU{3~_%8p_V@lB)2?!|JFq zqMZ^kD*GZ%d{kr3{=V$doE5k}IcHwD8{e^QVIp1m+E=l^8x`sk&nQ$M*m0$yc~$SF z0W~XV774e7L>^>w6;mew)rC+w@mH}D{D%9RoMx2QCe;%87aKQ2YKIR?a`|4E_uRSv klqUY%2>jEd^Dgf1R2e#wBP4FK$o&QUAZBXFo)X~uA2i?63IG5A diff --git a/inst/script/overrides.R b/inst/script/overrides.R index 356818f7..93cee15d 100644 --- a/inst/script/overrides.R +++ b/inst/script/overrides.R @@ -19,6 +19,19 @@ #' @inherit processDatasets return NULL +#' get_datasets +#' @param filter Filter results by matching expression. See details for an explanation +#' of the syntax +#' @details +#' Additional details to add +#' +#' @param query The search query. Either plain text ('traumatic'), or an ontology +#' term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that +#' contain the given string in their short of full name will also be matched. +#' @examples +#' get_datasets() +#' get_datasets(query = "http://purl.obolibrary.org/obo/UBERON_0002048") +NULL #' get_result_sets #' @@ -210,6 +223,7 @@ NULL #' @return A data table with the queried taxa's details. NULL + #' get_taxon_datasets #' @param taxon can either be Taxon ID, Taxon NCBI ID, or one of its string identifiers: scientific name, common name. #' It is recommended to use Taxon ID for efficiency. @@ -231,7 +245,10 @@ NULL NULL #' search_gemma -#' @param query The search query. Either plain text ('traumatic'), or an ontology term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that contain the given string in their short of full name will also be matched ('GSE201', 'Bronchoalveolar lavage samples'. +#' @param query The search query. Either plain text ('traumatic'), or an ontology +#' term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that +#' contain the given string in their short of full name will also be matched. +#' Can be multiple identifiers separated by commas. #' @param resultType The kind of results that should be included in the output. Can be experiment, gene, platform or a long object type name, documented in the API documentation. #' @return If \code{raw = FALSE} and resultType is experiment, gene or platform, #' a data.table containing the search results. If it is any other type, a list diff --git a/inst/script/registry.R b/inst/script/registry.R index 5e3fe376..f463ebca 100644 --- a/inst/script/registry.R +++ b/inst/script/registry.R @@ -68,6 +68,27 @@ registerEndpoint("datasets/{datasets}?&offset={offset}&limit={limit}&sort={sort} preprocessor = quote(processDatasets) ) + +registerEndpoint("datasets/?&offset={offset}&limit={limit}&sort={sort}&filter={filter}&query={query}", + "get_datasets",open_api_name = "get_datasets", keyword = "dataset", + defaults = list( + query = NA_character_, + filter = NA_character_, + offset = 0L, + limit = 20L, + sort = "+id" + ), + validators = alist( + query = validateOptionalQuery, + filter = validateFilter, + offset = validatePositiveInteger, + limit = validateLimit, + sort = validateSort + ), + preprocessor = quote(processDatasets) +) + + registerEndpoint( "resultSets/{resultSet}", ".getResultSets", open_api_name = 'get_result_set', @@ -199,17 +220,7 @@ registerEndpoint('datasets/{dataset}/analyses/differential', ), preprocessor = quote(processDEA)) -registerEndpoint('datasets/{dataset}/quantitationTypes', - 'get_dataset_differential_expression_analyses', open_api_name = 'get_dataset_differential_expression_analyses', - keyword = 'dataset', - defaults = list( - dataset = bquote() - ), - validators = list( - dataset = validateSingleID - ), - preprocessor = quote(processDEA)) - +# probably to be deprecated registerEndpoint("annotations/{taxon}/search/datasets?query={query}&limit={limit}&offset={offset}&sort={sort}", "search_datasets", open_api_name = 'search_datasets', diff --git a/man/get_datasets.Rd b/man/get_datasets.Rd new file mode 100644 index 00000000..658471a6 --- /dev/null +++ b/man/get_datasets.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/allEndpoints.R +\name{get_datasets} +\alias{get_datasets} +\title{Retrieve all datasets} +\usage{ +get_datasets( + query = NA_character_, + filter = NA_character_, + offset = 0L, + limit = 20L, + sort = "+id", + raw = getOption("gemma.raw", FALSE), + memoised = getOption("gemma.memoised", FALSE), + file = getOption("gemma.file", NA_character_), + overwrite = getOption("gemma.overwrite", FALSE) +) +} +\arguments{ +\item{query}{The search query. Either plain text ('traumatic'), or an ontology +term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that +contain the given string in their short of full name will also be matched.} + +\item{filter}{Filter results by matching expression. See details for an explanation +of the syntax} + +\item{offset}{The offset of the first retrieved result.} + +\item{limit}{Optional, defaults to 20. Limits the result to specified amount +of objects. Has a maximum value of 100. Use together with \code{offset} and +the \code{totalElements} \link[base:attributes]{attribute} in the output to +compile all data if needed.} + +\item{sort}{Order results by the given property and direction. The '+' sign +indicate ascending order whereas the '-' indicate descending.} + +\item{raw}{\code{TRUE} to receive results as-is from Gemma, or \code{FALSE} to enable +parsing. Raw results usually contain additional fields and flags that are +omitted in the parsed results.} + +\item{memoised}{Whether or not to save to cache for future calls with the +same inputs and use the result saved in cache if a result is already saved. +Doing \code{options(gemma.memoised = TRUE)} will ensure that the cache is always +used. Use \code{\link{forget_gemma_memoised}} to clear the cache.} + +\item{file}{The name of a file to save the results to, or \code{NULL} to not write +results to a file. If \code{raw == TRUE}, the output will be the raw endpoint from the +API, likely a JSON or a gzip file. Otherwise, it will be a RDS file.} + +\item{overwrite}{Whether or not to overwrite if a file exists at the specified +filename.} +} +\value{ +Varies +} +\description{ +Retrieve all datasets +} +\details{ +Additional details to add +} +\examples{ +get_datasets() +get_datasets(query = "http://purl.obolibrary.org/obo/UBERON_0002048") +} +\keyword{dataset} diff --git a/man/search_gemma.Rd b/man/search_gemma.Rd index a8b3f033..f4fc176d 100644 --- a/man/search_gemma.Rd +++ b/man/search_gemma.Rd @@ -17,7 +17,10 @@ search_gemma( ) } \arguments{ -\item{query}{The search query. Either plain text ('traumatic'), or an ontology term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that contain the given string in their short of full name will also be matched ('GSE201', 'Bronchoalveolar lavage samples'.} +\item{query}{The search query. Either plain text ('traumatic'), or an ontology +term URI ('http://purl.obolibrary.org/obo/UBERON_0002048'). Datasets that +contain the given string in their short of full name will also be matched. +Can be multiple identifiers separated by commas.} \item{taxon}{A numerical taxon identifier or an ncbi taxon identifier or a taxon identifier that matches either its scientific or common name} diff --git a/man/validateOptionalQuery.Rd b/man/validateOptionalQuery.Rd new file mode 100644 index 00000000..6914525a --- /dev/null +++ b/man/validateOptionalQuery.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/validators.R +\name{validateOptionalQuery} +\alias{validateOptionalQuery} +\title{Validate am optional query} +\usage{ +validateOptionalQuery(name, ...) +} +\arguments{ +\item{name}{The variable name} + +\item{...}{Any queries} +} +\value{ +The validated queries +} +\description{ +Validate am optional query +} +\keyword{internal}