diff --git a/DESCRIPTION b/DESCRIPTION index 69332e0..266e699 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rgeco Type: Package Title: R package for accessing the Generable API -Version: 0.0.7 +Version: 0.0.7-9000 Author: Generable Inc Maintainer: Jacqueline Buros Description: The Generable API is a HTTP REST API that provides access to data and inferences. The rgeco package provides convenient access to the information in the API in an R-friendly format. @@ -34,7 +34,10 @@ Imports: table1, reticulate, boot, - cli + cli, + data.table, + httpcache, + keyring Suggests: testthat, knitr, @@ -43,5 +46,5 @@ Suggests: scales, tidyverse, utils -RoxygenNote: 7.2.0 +RoxygenNote: 7.3.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 798599e..e8b3cb7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,9 @@ # Generated by roxygen2: do not edit by hand +export(configure) +export(drop_configs) export(extract_subsample_info) +export(fetch_aes) export(fetch_association_state) export(fetch_biomarker_params) export(fetch_biomarkers) @@ -23,6 +26,7 @@ export(find_runs) export(flog.logger) export(format_quantiles_as_widths) export(list_biomarker_names) +export(list_configs) export(list_datasets) export(list_models) export(list_parameter_names) @@ -36,10 +40,12 @@ export(prep_pkpd_data) export(sample_groups) import(checkmate) import(cli) -import(httr) +import(keyring) importFrom(RJSONIO,fromJSON) importFrom(boot,inv.logit) importFrom(broom,tidy) +importFrom(data.table,data.table) +importFrom(data.table,setkeyv) importFrom(dplyr,arrange) importFrom(dplyr,desc) importFrom(dplyr,distinct) @@ -49,7 +55,15 @@ importFrom(dplyr,select) importFrom(dplyr,semi_join) importFrom(futile.logger,flog.logger) importFrom(glue,glue_safe) +importFrom(httpcache,GET) +importFrom(httpcache,POST) +importFrom(httr,add_headers) +importFrom(httr,content) +importFrom(httr,http_error) importFrom(httr,modify_url) +importFrom(httr,status_code) +importFrom(httr,user_agent) +importFrom(keyring,backend_file) importFrom(lubridate,ymd_hms) importFrom(magrittr,"%>%") importFrom(rlang,"!!!") diff --git a/R/geco_aes.R b/R/geco_aes.R new file mode 100644 index 0000000..9cc64ef --- /dev/null +++ b/R/geco_aes.R @@ -0,0 +1,75 @@ + +#' Fetch AE data from the Generable API +#' +#' Fetch AE data from the Generable API for a specific project. +#' +#' This function retrieves AE data from the Generable API. +#' It requires authentication (see \code{\link{login}}) prior to use +#' and this pulls data from the Generable API. +#' +#' @note +#' A project can be specified by using the project name or a specific project version. +#' \enumerate{ +#' \item If a project is specified using the name, data is fetched for the latest version of the project. +#' \item If a project is specified using the project version, the project name is not required. +#' \item If neither a project nor a project version is provided, the default project or project version is used. These are set by the environment variables GECO_API_PROJECT and GECO_API_PROJECT_VERSION +#' } +#' +#' @param project Project name. If NULL, defaults to value of environment variable GECO_API_PROJECT +#' @param project_version_id Project version. If NULL, defaults to the most recent version of the project if provided, or the value of environment variable GECO_API_PROJECT_VERSION +#' @param event_type Limits the event_types to the names provided. NULL is unfiltered. Default is NULL. +#' @param ... Optional filters applied to events data, provided as name-value pairs to limit returned values. +#' Example: trial_id = unique(subjects$trial_id) +#' @return data.frame with one record per subject and event type +#' @export +fetch_aes <- function(project = NULL, project_version_id = NULL, event_type = NULL, + serious_event_flag = NULL, ...) { + where <- rlang::list2(...) + pv_id <- .process_project_inputs(project = project, project_version_id = project_version_id) + if (!is.null(event_type)) { + where <- .update_filter(where, event_type = event_type) + } + if (!is.null(serious_event_flag)) { + where <- .update_filter(where, serious_event_flag = serious_event_flag) + } + events <- .fetch_ae_data(project_version_id = pv_id, where = where) + if (nrow(events) == 0 && !is.null(project)) { + futile.logger::flog.info(glue::glue('No ae information available for this version of project {project} data.')) + } else if (nrow(events) == 0) { + futile.logger::flog.debug(glue::glue('No ae information available for this project_version_id: {project_version_id}.')) + } + events +} + + +#' @importFrom rlang .data +pivot_ae_wider <- function(.d) { + tidyr::pivot_wider(.d, + id_cols = c(.data$subject_id), + names_from = c(.data$event_type), + values_from = c(.data$event_flag, .data$event_trial_day, .data$event_id, .data$event_created_at), + names_glue = "{event_type}_{.value}") +} + + +#' @importFrom magrittr %>% +.fetch_ae_data <- function(project = NULL, project_version_id = NULL, where = list()) { + pv_id <- .process_project_inputs(project = project, project_version_id = project_version_id) + filter <- .prepare_filter(where, endpoint = 'AES') + events <- geco_api(AES, project_version_id = pv_id, url_query_parameters = filter) + d <- as_dataframe.geco_api_data(events, flatten_names = c('params')) + if ('params' %in% names(d)) { + d <- d %>% + tidyr::unnest_wider(.data$params, names_repair = 'universal') + } + d <- .apply_filters(d, where) + suppressWarnings({ + d <- d %>% + dplyr::rename_at(.vars = dplyr::vars(-dplyr::one_of(c('subject_id'))), + .funs = ~ stringr::str_c('ae_', .x)) + }) + d +} + + + diff --git a/R/geco_api.R b/R/geco_api.R index 326f3f9..f31bba7 100644 --- a/R/geco_api.R +++ b/R/geco_api.R @@ -14,6 +14,7 @@ PROJECTVERSIONS <- 'data/project/{project}/projectversions' PROJECTS <- 'data/projects' LESIONS <- 'data/projectversion/{project_version_id}/lesions' LESIONTV <- 'data/projectversion/{project_version_id}/lesiontvs' +AES <- 'data/projectversion/{project_version_id}/ae' # ---- inference api endpoints ---- IDATA <- 'inferences/projectversion/{project_version_id}/dataset/attributes' @@ -56,6 +57,20 @@ geco_api_url <- function(..., project = NULL, project_version_id = NULL, run_id= glue::glue_safe(url) } +#' Never cache certain endpoints +.clean_cache <- function() { + nocache_endpoints <- c( + LOGIN, + PROJECTVERSIONS, + PROJECTS, + IDATA, + IMODELS, + IRUNS + ) + nocache_endpoints |> + purrr::walk(httpcache::dropOnly) +} + #' Log in to the Generable API #' #' This function logs the user into the Generable API. @@ -72,12 +87,22 @@ geco_api_url <- function(..., project = NULL, project_version_id = NULL, run_id= #' @param password User password. If not provided, will read the `GECO_API_PASSWORD` environment variable. #' @return The OAuth 2.0 Bearer Token for the Generable API #' @export -login <- function(user, password) { - if (missing(user)) { - user <- Sys.getenv('GECO_API_USER') +login <- function(user, password, host) { + url <- .get_url(host) + if (missing(password) || missing(user)) { + use_keyring <- Sys.getenv('GECO_API_NO_KEYRING') == "" + if (!use_keyring) { + user <- Sys.getenv('GECO_API_USER') + password <- Sys.getenv('GECO_API_PASSWORD') + } else { + # get credentials from keyring + creds <- .get_credentials(host = host, user = user) + user = creds[1] + password = creds[2] + } } - if (missing(password)) { - password <- Sys.getenv('GECO_API_PASSWORD') + if (is.null(user)) { + cli::cli_inform('Note: credential storage has changed; please run `configure()` to migrate to the new storage.') } body <- list(email = user, password = password) resp <- geco_api(LOGIN, body = body, encode = 'json', method = 'POST') @@ -85,7 +110,132 @@ login <- function(user, password) { invisible(resp$content) } +#' Configure Geco credentials, saving in keyring +#' @param user Geco user name (email address). Defaults to GECO_API_USER environment variable +#' @param password Geco password (will prompt if not provided). Defaults to GECO_API_PASSWORD environment variable +#' @param host (optional) alternate host for API, only used for testing +#' @import keyring +#' @export +configure <- function(user, password, host) { + cli::cli_inform('Configuring credentials for Geco API') + url <- .get_url(host) + if (missing(user)) { + cli::cli_inform('Reading username from environment variable: GECO_API_USER') + user <- Sys.getenv('GECO_API_USER', unset = '') + if (user == '') { + stop('Username not provided.') + } + } + if (missing(password)) { + cli::cli_inform('Reading password from environment variable: GECO_API_PASSWORD') + password <- Sys.getenv('GECO_API_PASSWORD', unset = '') + cli::cli_inform('GECO_API_PASSWORD not found. Prompting you for your geco password.') + if (password == '' && interactive()) { + password <- rstudioapi::askForPassword(prompt = 'Please enter your geco password.') + } + } + cli::cli_inform('Attempting to log in ...') + res <- tryCatch(login(user=user, password = password, host=host)) + if (inherits(res, 'try-error')) { + cli::cli_alert_warning('Failed to authenticate.') + } else { + cli::cli_alert_success('Success!') + if (keyring::has_keyring_support() && interactive() && askYesNo("Do you want to save credentials in your keyring?")) { + keyring::key_set_with_value(service = .get_keyring_service(), + username = user, password = password) + cli::cli_alert_success('Credentials saved.') + } else { + cli::cli_inform('Populating credentials in environment variables.') + Sys.setenv('GECO_API_USER'=user) + Sys.setenv('GECO_API_PASSWORD'=password) + Sys.setenv('GECO_API_URL'=url) + } + } +} + +#' List saved configurations +#' @param host Host identifier, defaults to 'geco' +#' @export +list_configs <- function(host='geco') { + service <- .get_keyring_service(host) + key_list(service) +} + +#' Drop saved configurations +#' Warning! this will remove all saved configurations from the host. +#' @param host Host identifier, defaults to 'geco' +#' @param user Optional username, provided as a string. +#' @seealso [list_configs()] +#' @export +drop_configs <- function(user, host='geco') { + service <- .get_keyring_service(host) + keys <- key_list(service) + if (!missing(user)) { + keys <- keys %>% + filter(username == !!user) + } + if (nrow(keys) == 0) { + cli::cli_alert_info('No keys found.') + } else { + cli::cli_alert_warning('This will drop _ALL_ saved configs listed.') + print(keys) + confirm <- askYesNo("Do you want to drop these configs from your keyring?", + default = FALSE) + if (!is.na(confirm) && isTRUE(confirm)) { + keys %>% + dplyr::pull(username) %>% + purrr::walk(~ keyring::key_delete(service=service, username = .)) + } + } +} + + +.get_keyring_service <- function(host) { + url <- .get_url(host) + stringr::str_c('R-GECO_API', url, sep = '-') +} +.get_url <- function(host) { + if (missing(host)) { + url <- Sys.getenv('GECO_API_URL', unset = 'https://geco.generable.com') + } else { + url <- glue::glue('https://{host}.generable.com') + Sys.setenv('GECO_API_URL' = url) + } + url +} + +# returns vector as username, password +.get_credentials <- function(host, user) { + if (!keyring::has_keyring_support()) { + if (missing(user)) { + user <- Sys.getenv('GECO_API_USER') + } + password <- Sys.getenv('GECO_API_PASSWORD') + return(c(user, password)) + } + # get user & reconcile with keychain + service <- .get_keyring_service(host) + keys <- key_list(service) + if (missing(user)) { + if (nrow(keys) == 1) { + user <- unique(keys$username) + } else { + user <- Sys.getenv('GECO_API_USER', unset = 'null') + if (is.null(user)) { + stop("Multiple users configured; please set default user with GECO_API_USER environment variable") + } + } + } else if (user %in% keys$username) { + Sys.setenv('GECO_API_USER' = user) + } else { + stop('User does not exist in keyring; please run `configure()`') + } + # get password + password <- key_get(service, username = user) + return(c(user, password)) +} +#' @importFrom httr add_headers get_auth <- function() { if (!exists(envir = ENV, '.GECO_AUTH')) { futile.logger::flog.error('Not logged in. Use `login(user, password)` to login.') @@ -94,23 +244,26 @@ get_auth <- function() { httr::add_headers(.headers = unlist(ENV$.GECO_AUTH)) } -#' @import httr +#' @importFrom httr user_agent http_error content status_code +#' @importFrom httpcache GET POST #' @importFrom RJSONIO fromJSON geco_api <- function(path, ..., method = c('GET', 'POST'), project = NULL, project_version_id = NULL, run_id=NULL, type=NULL, parameter=NULL, filters=NULL, url_query_parameters=NULL) { url <- geco_api_url(path, project = project, project_version_id = project_version_id, run_id=run_id, type=type, parameter=parameter, filters=filters, url_query_parameters=url_query_parameters) ua <- httr::user_agent("https://github.com/generable/rgeco") + .clean_cache() method <- match.arg(method, several.ok = FALSE) if (method == 'GET') - resp <- try(httr::GET(url, ..., get_auth(), ua)) + resp <- try(httpcache::GET(url, ..., get_auth(), ua)) else if (method == 'POST') - resp <- try(httr::POST(url, ..., ua)) + resp <- try(httpcache::POST(url, ..., ua)) #if (httr::http_type(resp) != "application/json") { # stop("API did not return json", call. = FALSE) #} if (inherits(resp, 'try-error')) { stop(glue::glue("Error connecting to API: {url} {print(resp)}")) + httpcache::dropOnly(url) } parsed <- try(RJSONIO::fromJSON(httr::content(resp, "text", encoding = 'UTF-8'), simplify = FALSE), silent = T) diff --git a/R/geco_biomarkers.R b/R/geco_biomarkers.R index 22a34d0..b8f3cce 100644 --- a/R/geco_biomarkers.R +++ b/R/geco_biomarkers.R @@ -61,7 +61,7 @@ fetch_biomarkers <- function(project = NULL, project_version_id = NULL, measurem biomarkers <- geco_api(TIMEVARYING, project_version_id = pv_id, url_query_parameters = filters) b <- as_dataframe.geco_api_data(biomarkers, flatten_names = 'params') if (nrow(b) > 0 && 'params' %in% names(b) && isTRUE(annotate)) { - b <- b %>% tidyr::unnest_wider(.data$params) + b <- b %>% tidyr::unnest_wider(.data$params, names_repair = 'universal') } suppressWarnings({ b <- b %>% diff --git a/R/geco_doses.R b/R/geco_doses.R index da5cca6..b49180e 100644 --- a/R/geco_doses.R +++ b/R/geco_doses.R @@ -46,16 +46,21 @@ fetch_doses <- function(project = NULL, project_version_id = NULL, ...) { .funs = ~ stringr::str_c('dose_', .x)) }) if (nrow(d) > 0) { - d <- d %>% - dplyr::mutate(start_hours = .format_hours(.data$trial_day, .data$start_time), - end_hours = .format_hours(.data$trial_day, .data$end_time)) %>% - dplyr::group_by(.data$subject_id) %>% - dplyr::mutate(cycle_num = dplyr::dense_rank(.data$start_hours)) %>% - dplyr::ungroup() %>% - dplyr::mutate(administered = factor(stringr::str_c(.data$amount, .data$unit)), - administered = forcats::fct_reorder(.data$administered, .data$amount), - cycle = factor(stringr::str_c('Cycle ', .data$cycle_num)), - cycle = forcats::fct_reorder(.data$cycle, .data$cycle_num)) + if ('start_time' %in% names(d)) { + d <- d %>% + dplyr::mutate(start_hours = .format_hours(.data$trial_day, .data$start_time)) %>% + dplyr::group_by(.data$subject_id) %>% + dplyr::mutate(cycle_num = dplyr::dense_rank(.data$start_hours)) %>% + dplyr::ungroup() %>% + dplyr::mutate(administered = factor(stringr::str_c(.data$amount, .data$unit)), + administered = forcats::fct_reorder(.data$administered, .data$amount), + cycle = factor(stringr::str_c('Cycle ', .data$cycle_num)), + cycle = forcats::fct_reorder(.data$cycle, .data$cycle_num)) + } + if ('end_time' %in% names(d)) { + d <- d %>% + dplyr::mutate(end_hours = .format_hours(.data$trial_day, .data$end_time)) + } } .apply_filters(d, where) } diff --git a/R/geco_events.R b/R/geco_events.R index fa5f3ee..0353124 100644 --- a/R/geco_events.R +++ b/R/geco_events.R @@ -57,7 +57,7 @@ pivot_events_wider <- function(.d) { d <- as_dataframe.geco_api_data(events, flatten_names = c('params')) if ('params' %in% names(d)) { d <- d %>% - tidyr::unnest_wider(.data$params) + tidyr::unnest_wider(.data$params, names_repair = 'universal') } suppressWarnings({ d <- d %>% diff --git a/R/geco_filters.R b/R/geco_filters.R index 85f6589..4ac0ede 100644 --- a/R/geco_filters.R +++ b/R/geco_filters.R @@ -111,18 +111,22 @@ c() } else if (endpoint == 'TRIALARMS') { c('trial_id', 'trial_arm_id') + } else if (endpoint == 'LABS') { + c('trial_id', 'trial_arm_id', 'subject_id', 'description', 'baseline_flag', 'n_subjects') } else if (endpoint == 'SUBJECTS') { - c('trial_id', 'trial_arm_id', 'age_min', 'age_max') + c('trial_id', 'trial_arm_id', 'age_min', 'age_max', 'n_subjects') } else if (endpoint == 'EVENTS') { - c('trial_id', 'trial_arm_id', 'subject_id', 'event_type') + c('trial_id', 'trial_arm_id', 'subject_id', 'event_type', 'n_subjects') + } else if (endpoint == 'AES') { + c('trial_id', 'trial_arm_id', 'subject_id', 'event_type', 'serious_event_flag', 'n_subjects') } else if (endpoint == 'TIMEVARYING') { - c('trial_id', 'trial_arm_id', 'subject_id', 'measurement_name') + c('trial_id', 'trial_arm_id', 'subject_id', 'measurement_name', 'n_subjects') } else if (endpoint == 'DOSE') { - c('trial_id', 'trial_arm_id', 'subject_id') + c('trial_id', 'trial_arm_id', 'subject_id', 'day_min', 'day_max', 'n_subjects') } else if (endpoint == 'LESIONS') { - c('trial_id', 'trial_arm_id', 'subject_id') + c('trial_id', 'trial_arm_id', 'subject_id', 'n_subjects') } else if (endpoint == 'LESIONTV') { - c('trial_id', 'trial_arm_id', 'subject_id', 'lesion_id', 'measurement_name') + c('trial_id', 'trial_arm_id', 'subject_id', 'lesion_id', 'measurement_name', 'n_subjects') } else { c() } @@ -132,5 +136,6 @@ updates <- rlang::list2(...) updates <- .check_format(updates) filter %>% - purrr::list_merge(!!!updates) + purrr::list_merge(!!!updates) %>% + purrr::map_depth(2, unique) } diff --git a/R/geco_labs.R b/R/geco_labs.R index 6798cfa..47d3b11 100644 --- a/R/geco_labs.R +++ b/R/geco_labs.R @@ -17,14 +17,21 @@ #' #' @param project Project name. If NULL, defaults to value of environment variable GECO_API_PROJECT #' @param project_version_id Project version. If NULL, defaults to the most recent version of the project if provided, or the value of environment variable GECO_API_PROJECT_VERSION +#' @param description Vector of lab names to return. `NULL` returns all measurements. Default +#' is `NULL`. +#' @param baseline_flag if `TRUE`, return only baseline values #' @param annotate if `TRUE`, annotate lab data with dose data. Default is `TRUE`. +#' @param ... Optional filters applied to subjects data, provided as name-value pairs where names are fields and values contain a subset of valid values +#' Example: trial_name = c('trial-A', 'trial-N'), performance_status = c(0,1) #' @importFrom magrittr %>% #' @importFrom rlang !! #' @return data.frame of lab data for the project specified #' @export -fetch_labs <- function(project = NULL, project_version_id = NULL, annotate = T) { +fetch_labs <- function(project = NULL, project_version_id = NULL, description = NULL, baseline_flag = NULL, annotate = T, ...) { + where <- rlang::list2(...) + where <- .check_format(where, alert = T) pv_id <- .process_project_inputs(project = project, project_version_id = project_version_id) - d <- .fetch_labs_data(project_version_id = pv_id, annotate = annotate) + d <- .fetch_labs_data(project_version_id = pv_id, annotate = annotate, description=description, baseline_flag=baseline_flag, where=where) if (nrow(d) == 0 && !is.null(project)) { futile.logger::flog.info(glue::glue('No labs information available for this version of project {project} data.')) } else if (nrow(d) == 0) { @@ -34,10 +41,19 @@ fetch_labs <- function(project = NULL, project_version_id = NULL, annotate = T) } #' @importFrom magrittr %>% -.fetch_labs_data <- function(project = NULL, project_version_id = NULL, annotate = T) { +.fetch_labs_data <- function(project = NULL, project_version_id = NULL, annotate = T, + description = NULL, baseline_flag = NULL, where = list()) { pv_id <- .process_project_inputs(project = project, project_version_id = project_version_id) - labs <- geco_api(LABS, project_version_id = pv_id) + if (!is.null(description)) { + where <- .update_filter(where, description = description) + } + if (!is.null(baseline_flag)) { + where <- .update_filter(where, baseline_flag=baseline_flag) + } + filters <- .prepare_filter(where, endpoint = 'LABS') + labs <- geco_api(LABS, project_version_id = pv_id, url_query_parameters = filters) d <- as_dataframe.geco_api_data(labs, flatten_names = 'params') + d <- .apply_filters(d, where) suppressWarnings({ d <- d %>% dplyr::rename_at(.vars = dplyr::vars(dplyr::one_of(c('created_at', 'params', 'id', 'description'))), diff --git a/R/geco_lesions.R b/R/geco_lesions.R index bfc53aa..9b95074 100644 --- a/R/geco_lesions.R +++ b/R/geco_lesions.R @@ -95,7 +95,7 @@ fetch_lesions <- function(project = NULL, project_version_id = NULL, annotate = lesions <- geco_api(LESIONS, project_version_id = pv_id, url_query_parameters = filters) d <- as_dataframe.geco_api_data(lesions, flatten_names = 'params') if (nrow(d) > 0 && 'params' %in% names(d) && isTRUE(annotate)) { - d <- d %>% tidyr::unnest_wider(.data$params) + d <- d %>% tidyr::unnest_wider(.data$params, names_repair = 'universal') } suppressWarnings({ d <- d %>% diff --git a/R/geco_regimens.R b/R/geco_regimens.R index 4065267..c786bfd 100644 --- a/R/geco_regimens.R +++ b/R/geco_regimens.R @@ -11,7 +11,7 @@ purrr::map('treatments') td <- purrr::map_dfr(treatments, ~ as_dataframe.geco_api_data(content = .x, flatten_names = 'drug'), .id = 'regimen_id') %>% - tidyr::unnest_wider(.data$drug, names_sep = '_') %>% + tidyr::unnest_wider(.data$drug, names_sep = '_', names_repair = 'universal') %>% dplyr::rename_at(.vars = dplyr::vars(-dplyr::starts_with('drug'), -dplyr::starts_with('regimen')), .funs = .add_prefix, diff --git a/R/geco_subjects.R b/R/geco_subjects.R index 0485eb2..f17c94f 100644 --- a/R/geco_subjects.R +++ b/R/geco_subjects.R @@ -108,7 +108,7 @@ fetch_subjects <- function(project = NULL, project_version_id = NULL, event_type } if ('baseline_weight_min' %in% names(s)) { s <- s %>% - dplyr::mutate(baseline_weight = .data$baseline_weight_min + .data$baseline_weight_max / 2) + dplyr::mutate(baseline_weight = (.data$baseline_weight_min + .data$baseline_weight_max) / 2) } if ('indication' %in% names(s)) { s <- s %>% diff --git a/R/geco_trial_arms.R b/R/geco_trial_arms.R index c160408..85c5409 100644 --- a/R/geco_trial_arms.R +++ b/R/geco_trial_arms.R @@ -29,7 +29,7 @@ } if ('params' %in% names(ta) && all(purrr::map_int(ta$params, nrow) == 1)) { ta <- ta %>% - tidyr::unnest_wider(.data$params) + tidyr::unnest_wider(.data$params, names_repair = 'universal') } } suppressWarnings({ diff --git a/R/rgeco-package.R b/R/rgeco-package.R index 0658fc1..f34d444 100644 --- a/R/rgeco-package.R +++ b/R/rgeco-package.R @@ -66,7 +66,6 @@ #' #' @docType package #' @name rgeco -NULL xarray <- NULL @@ -77,6 +76,16 @@ xarray <- NULL .check_python_deps() } +#' @import cli +#' @importFrom keyring backend_file +.check_keyring_setup <- function() { + use_keyring <- Sys.getenv('GECO_API_NO_KEYRING') == "" + if (use_keyring && keyring::has_keyring_support()) { + cli::cli_inform('This package uses `keyring` to store passwords on your local system securely.') + cli::cli_alert_success('Keyring supported.') + } +} + #' @import cli .check_python_installed <- function() { a <- reticulate::py_discover_config() diff --git a/R/utils_pkpd.R b/R/utils_pkpd.R index dee33c0..f7fb79f 100644 --- a/R/utils_pkpd.R +++ b/R/utils_pkpd.R @@ -18,6 +18,8 @@ fetch_pkpd <- function(project = NULL, project_version_id = NULL, pd_measure = N pkpd <- prep_pkpd_data(biomarkers_data = b, dose_data = d, pd_measure = pd_measure, pk_measure = pk_measure) } +.datatable.aware = TRUE + #' Merge and annotate pkpd biomarkers data with dosing data #' returns a data.frame suitable for plotting and analysis. #' @param biomarkers_data data.frame containing biomarkers data @@ -25,6 +27,7 @@ fetch_pkpd <- function(project = NULL, project_version_id = NULL, pd_measure = N #' @param pk_measure measurement_name of PK measurement (defaults to 'conc', NULL indicates no PK marker) #' @param pd_measure measurement_name of PD measurement (defaults to NULL - no PD marker) #' @return data.frame containing merged biomarker & dose data for the PK & PD parameter selected, with columns annotating cycles, time since last SDA, and measurement type. +#' @importFrom data.table setkeyv data.table #' @export prep_pkpd_data <- function(biomarkers_data, dose_data, pd_measure = NULL, pk_measure = NULL) { if (nrow(dose_data) == 0) { @@ -40,37 +43,43 @@ prep_pkpd_data <- function(biomarkers_data, dose_data, pd_measure = NULL, pk_mea if (!'start_hours' %in% names(dose_data)) { stop('dose_data does not have start_hours data. Cannot prepare pkpd data without a formatted start time.') } - dose_data_renamed <- dose_data %>% + dosesDT <- dose_data %>% dplyr::rename_at(.vars = dplyr::vars(-.data$subject_id, -.data$drug), .funs = ~ stringr::str_c('dose_', .x)) %>% - dplyr::mutate(hours = .data$dose_start_hours) - if ('collection_timepoint' %in% names(biomarkers_data)) { - merged_data <- biomarkers_data %>% - dplyr::mutate(.dir = dplyr::if_else(.data$collection_timepoint == 'Pre-infusion', 'forward', 'reverse')) %>% - rolling_join(dose_data_renamed, - by = 'subject_id', - on = 'hours', - direction_field = '.dir', - how = 'left', - suffix = c('', '.dose')) %>% - dplyr::select(-.data$hours.dose, -.data$.dir) - } else { - merged_data <- rolling_join(biomarkers_data, - dose_data_renamed, - by = 'subject_id', - on = 'hours', - direction = 'reverse', - how = 'left', - suffix = c('', '.dose')) %>% - dplyr::select(-.data$hours.dose) - } + dplyr::mutate(hours = .data$dose_start_hours) %>% + data.table::data.table() + biomarkersDT <- data.table::data.table(biomarkers_data) + data.table::setkeyv(biomarkersDT, c('subject_id', 'hours')) + data.table::setkeyv(dosesDT, c('subject_id', 'hours')) + # for each PK measurement, identify the dose immediately preceding it + prior_dose <- dosesDT[biomarkersDT, roll = T] + # also identify the next dose + next_dose <- dosesDT[biomarkersDT, roll = -Inf] + + ## construct final data frame: + # for measurements with a preceding dose, use this as the "closest dose" + with_prior_dose <- prior_dose |> + dplyr::filter(!is.na(.data$dose_dose_id)) + # otherwise, use next dose + no_prior_dose <- next_dose |> + dplyr::anti_join(with_prior_dose, by = 'measurement_id') + merged_data <- dplyr::bind_rows(with_prior_dose, + no_prior_dose) |> + dplyr::arrange(subject_id, hours) |> + dplyr::mutate(hours_since_SDA = hours - dose_start_hours) + + + # merged_data <- rolling_join(biomarkers_data, + # dose_data_renamed, + # by = 'subject_id', + # on = 'hours', + # direction = 'reverse', + # how = 'left', + # suffix = c('', '.dose')) %>% + # dplyr::select(-.data$hours.dose) if (nrow(merged_data) != nrow(biomarkers_data)) { futile.logger::flog.warn(glue::glue("Number of records in biomarkers data changed after join, from {nrow(biomarkers_data)} to {nrow(merged_data)}.")) } - pkpd_data <- annotate_pkpd_data(merged_data, pd_measure = pd_measure, pk_measure = pk_measure) - if (nrow(pkpd_data) != nrow(biomarkers_data)) { - futile.logger::flog.warn(glue::glue("Number of records in biomarkers data changed after annotation, from {nrow(biomarkers_data)} to {nrow(pkpd_data)}.")) - } - pkpd_data + merged_data } #' @importFrom rlang !! diff --git a/man/configure.Rd b/man/configure.Rd new file mode 100644 index 0000000..c703b91 --- /dev/null +++ b/man/configure.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geco_api.R +\name{configure} +\alias{configure} +\title{Configure Geco credentials, saving in keyring} +\usage{ +configure(user, password, host) +} +\arguments{ +\item{user}{Geco user name (email address). Defaults to GECO_API_USER environment variable} + +\item{password}{Geco password (will prompt if not provided). Defaults to GECO_API_PASSWORD environment variable} + +\item{host}{(optional) alternate host for API, only used for testing} +} +\description{ +Configure Geco credentials, saving in keyring +} diff --git a/man/dot-clean_cache.Rd b/man/dot-clean_cache.Rd new file mode 100644 index 0000000..2188a31 --- /dev/null +++ b/man/dot-clean_cache.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geco_api.R +\name{.clean_cache} +\alias{.clean_cache} +\title{Never cache certain endpoints} +\usage{ +.clean_cache() +} +\description{ +Never cache certain endpoints +} diff --git a/man/drop_configs.Rd b/man/drop_configs.Rd new file mode 100644 index 0000000..885e54e --- /dev/null +++ b/man/drop_configs.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geco_api.R +\name{drop_configs} +\alias{drop_configs} +\title{Drop saved configurations +Warning! this will remove all saved configurations from the host.} +\usage{ +drop_configs(user, host = "geco") +} +\arguments{ +\item{user}{Optional username, provided as a string.} + +\item{host}{Host identifier, defaults to 'geco'} +} +\description{ +Drop saved configurations +Warning! this will remove all saved configurations from the host. +} +\seealso{ +[list_configs()] +} diff --git a/man/fetch_aes.Rd b/man/fetch_aes.Rd new file mode 100644 index 0000000..c53af4f --- /dev/null +++ b/man/fetch_aes.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geco_aes.R +\name{fetch_aes} +\alias{fetch_aes} +\title{Fetch AE data from the Generable API} +\usage{ +fetch_aes(project = NULL, project_version_id = NULL, event_type = NULL, ...) +} +\arguments{ +\item{project}{Project name. If NULL, defaults to value of environment variable GECO_API_PROJECT} + +\item{project_version_id}{Project version. If NULL, defaults to the most recent version of the project if provided, or the value of environment variable GECO_API_PROJECT_VERSION} + +\item{event_type}{Limits the event_types to the names provided. NULL is unfiltered. Default is NULL.} + +\item{...}{Optional filters applied to events data, provided as name-value pairs to limit returned values. +Example: trial_id = unique(subjects$trial_id)} +} +\value{ +data.frame with one record per subject and event type +} +\description{ +Fetch AE data from the Generable API for a specific project. +} +\details{ +This function retrieves AE data from the Generable API. +It requires authentication (see \code{\link{login}}) prior to use +and this pulls data from the Generable API. +} +\note{ +A project can be specified by using the project name or a specific project version. +\enumerate{ + \item If a project is specified using the name, data is fetched for the latest version of the project. + \item If a project is specified using the project version, the project name is not required. + \item If neither a project nor a project version is provided, the default project or project version is used. These are set by the environment variables GECO_API_PROJECT and GECO_API_PROJECT_VERSION +} +} diff --git a/man/fetch_labs.Rd b/man/fetch_labs.Rd index f5e97c7..4ff46e4 100644 --- a/man/fetch_labs.Rd +++ b/man/fetch_labs.Rd @@ -4,14 +4,29 @@ \alias{fetch_labs} \title{Fetch lab data from the Generable API} \usage{ -fetch_labs(project = NULL, project_version_id = NULL, annotate = T) +fetch_labs( + project = NULL, + project_version_id = NULL, + description = NULL, + baseline_flag = NULL, + annotate = T, + ... +) } \arguments{ \item{project}{Project name. If NULL, defaults to value of environment variable GECO_API_PROJECT} \item{project_version_id}{Project version. If NULL, defaults to the most recent version of the project if provided, or the value of environment variable GECO_API_PROJECT_VERSION} +\item{description}{Vector of lab names to return. `NULL` returns all measurements. Default +is `NULL`.} + +\item{baseline_flag}{if `TRUE`, return only baseline values} + \item{annotate}{if `TRUE`, annotate lab data with dose data. Default is `TRUE`.} + +\item{...}{Optional filters applied to subjects data, provided as name-value pairs where names are fields and values contain a subset of valid values +Example: trial_name = c('trial-A', 'trial-N'), performance_status = c(0,1)} } \value{ data.frame of lab data for the project specified diff --git a/man/list_configs.Rd b/man/list_configs.Rd new file mode 100644 index 0000000..ff74ea7 --- /dev/null +++ b/man/list_configs.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geco_api.R +\name{list_configs} +\alias{list_configs} +\title{List saved configurations} +\usage{ +list_configs(host = "geco") +} +\arguments{ +\item{host}{Host identifier, defaults to 'geco'} +} +\description{ +List saved configurations +} diff --git a/man/login.Rd b/man/login.Rd index 502e0bc..ecd4428 100644 --- a/man/login.Rd +++ b/man/login.Rd @@ -4,7 +4,7 @@ \alias{login} \title{Log in to the Generable API} \usage{ -login(user, password) +login(user, password, host) } \arguments{ \item{user}{User email address. If not provided, will read the `GECO_API_USER` environment variable.} diff --git a/man/re-exports.Rd b/man/re-exports.Rd index 4922c38..311e361 100644 --- a/man/re-exports.Rd +++ b/man/re-exports.Rd @@ -1,16 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R -\docType{import} \name{re-exports} \alias{re-exports} \alias{flog.logger} \title{Re-exports} -\keyword{internal} +\usage{ +flog.logger(...) +} \description{ -These objects are imported from other packages. Follow the links -below to see their documentation. - -\describe{ - \item{futile.logger}{\code{\link[futile.logger]{flog.logger}}} -}} - +Re-exports +} diff --git a/man/rgeco.Rd b/man/rgeco.Rd index f6294cb..214a386 100644 --- a/man/rgeco.Rd +++ b/man/rgeco.Rd @@ -2,8 +2,16 @@ % Please edit documentation in R/rgeco-package.R \docType{package} \name{rgeco} +\alias{-package} \alias{rgeco} +\alias{xarray} \title{rgeco: R package for accessing the Generable API} +\format{ +An object of class \code{python.builtin.module} (inherits from \code{python.builtin.object}) of length 0. +} +\usage{ +xarray +} \description{ The Generable API is a HTTP REST API that provides access to data and inferences. The rgeco package provides convenient @@ -75,3 +83,4 @@ Key methods for working with inferences are: } } +\keyword{datasets} diff --git a/tests/testthat/setup_test_environment.R b/tests/testthat/setup_test_environment.R index 6d5d033..c2c446a 100644 --- a/tests/testthat/setup_test_environment.R +++ b/tests/testthat/setup_test_environment.R @@ -5,6 +5,7 @@ test_login <- function() { } futile.logger::flog.info('Logging in as test user ...') Sys.setenv(GECO_API_URL=Sys.getenv('GECO_API_TEST_URL')) + configure() a <- login(Sys.getenv('GECO_API_TEST_USER'), password = Sys.getenv('GECO_API_TEST_PASSWORD')) }