Merge pull request #119 from generable/support-ae

Support ae & update filters in labs

NAMESPACE

@@ -3,6 +3,7 @@
 export(configure)
 export(drop_configs)
 export(extract_subsample_info)
+export(fetch_aes)
 export(fetch_association_state)
 export(fetch_biomarker_params)
 export(fetch_biomarkers)
@@ -60,6 +61,7 @@ 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,"!!!")

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
+}
+
+
+

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'

R/geco_filters.R

@@ -111,10 +111,14 @@
     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')
   } else if (endpoint == 'SUBJECTS') {
     c('trial_id', 'trial_arm_id', 'age_min', 'age_max')
   } else if (endpoint == 'EVENTS') {
     c('trial_id', 'trial_arm_id', 'subject_id', 'event_type')
+  } else if (endpoint == 'AES') {
+    c('trial_id', 'trial_arm_id', 'subject_id', 'event_type', 'serious_event_flag')
   } else if (endpoint == 'TIMEVARYING') {
     c('trial_id', 'trial_arm_id', 'subject_id', 'measurement_name')
   } else if (endpoint == 'DOSE') {

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'))),