From a83f88be1742eb626001434716cb6528f1263ee0 Mon Sep 17 00:00:00 2001 From: patrickbarks Date: Wed, 30 Oct 2024 10:01:39 +0100 Subject: [PATCH 1/5] testing temp fix for issue when 1+ batch of records is empty --- R/fetch_records.R | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/R/fetch_records.R b/R/fetch_records.R index 3ba73c4..e86f392 100644 --- a/R/fetch_records.R +++ b/R/fetch_records.R @@ -374,6 +374,24 @@ fetch_records_ <- function(conn, on_error = "fail" ) + # scripts often failing when 1 batch isn't a data.frame, causes error in + # bind_rows below. testing temp fix, when batch doesn't return df, pause + # and try again, and print class of non-df object + if (!"data.frame" %in% class(out_batch[[i]])) { + + warning(class(out_batch[[i]])) + + Sys.sleep(batch_delay * 3) + + out_batch[[i]] <- post_wrapper( + conn, + body = body_batch, + content = NULL, + na = na, + on_error = "fail" + ) + } + if (i < max(batch)) Sys.sleep(batch_delay) } From 3c1fc38fbc0f87ac1a96d45975316a2ac192690a Mon Sep 17 00:00:00 2001 From: patrickbarks Date: Wed, 30 Oct 2024 11:56:36 +0100 Subject: [PATCH 2/5] more debugging redcap api issues --- NAMESPACE | 2 ++ R/utils.R | 45 ++++++++++++++++++++++++++++++--------------- 2 files changed, 32 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8fdc421..5560c0b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -57,6 +57,7 @@ importFrom(dplyr,ungroup) importFrom(httr,POST) importFrom(httr,config) importFrom(httr,content) +importFrom(httr,http_status) importFrom(httr,stop_for_status) importFrom(lifecycle,badge) importFrom(lifecycle,deprecated) @@ -69,6 +70,7 @@ importFrom(purrr,map_chr) importFrom(purrr,map_dfr) importFrom(readr,col_character) importFrom(readr,cols) +importFrom(readr,read_csv) importFrom(rlang,.data) importFrom(rlang,.env) importFrom(rlang,`!!!`) diff --git a/R/utils.R b/R/utils.R index 5024797..5351b89 100644 --- a/R/utils.R +++ b/R/utils.R @@ -204,8 +204,8 @@ valid_datetime_arg <- function(x) { #' @noRd -#' @importFrom httr POST content stop_for_status -#' @importFrom readr cols col_character +#' @importFrom httr POST content stop_for_status http_status +#' @importFrom readr read_csv cols col_character post_wrapper <- function(conn, body = NULL, content = NULL, @@ -234,24 +234,39 @@ post_wrapper <- function(conn, encode = "form" ) - if (response$status_code != 200L) { - if (on_error == "fail") { - httr::stop_for_status(response) - } else { - out <- NULL - } - } else { - suppressWarnings( - out <- httr::content( - response, + response_raw <- httr::content( + x = response, + as = "text", + encoding = "UTF-8", + type = "text/csv" + ) + + response_message <- httr::http_status(response)[["message"]] + is_success <- response$status_code == 200L + + if (is_success) { + + out <- try( + readr::read_csv( + file = I(response_raw), col_types = readr::cols(.default = readr::col_character()), na = na, progress = FALSE - ) + ), + silent = TRUE ) - if (is.null(out)) { - stop("Response from REDCap API has status 200 but is empty") + if ("try-error" %in% class(out) | !inherits(out, "data.frame")) { + is_success <- FALSE + response_message <- paste("API request had status 200 but no data returned\nRaw text:", response_raw) + } + } + + if (!is_success) { + if (on_error == "fail") { + stop(response_message) + } else { + out <- NULL } } From 690f8248f1c79787c76cba61703f112aacce4fc1 Mon Sep 17 00:00:00 2001 From: patrickbarks Date: Wed, 30 Oct 2024 13:00:36 +0100 Subject: [PATCH 3/5] always debugging --- R/meta_dictionary.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/meta_dictionary.R b/R/meta_dictionary.R index 7c9bf77..88e9442 100644 --- a/R/meta_dictionary.R +++ b/R/meta_dictionary.R @@ -95,6 +95,11 @@ meta_dictionary <- function(conn, if (!is.null(out)) { + # temp debugging check + if (!"select_choices_or_calculations" %in% names(out)) { + stop(deparse(out)) + } + ## shorten names out <- dplyr::rename( out, From bdc7b38d8866a5619e9db0595be8187ecfda29ca Mon Sep 17 00:00:00 2001 From: patrickbarks Date: Thu, 21 Nov 2024 11:44:36 +0100 Subject: [PATCH 4/5] add param to exclude calculated fields from assessment of missing rows --- R/fetch_database.R | 2 ++ R/fetch_records.R | 13 ++++++++++++- man/fetch_database.Rd | 7 +++++++ man/fetch_records.Rd | 7 +++++++ 4 files changed, 28 insertions(+), 1 deletion(-) diff --git a/R/fetch_database.R b/R/fetch_database.R index f7896da..a7016ca 100644 --- a/R/fetch_database.R +++ b/R/fetch_database.R @@ -59,6 +59,7 @@ fetch_database <- function(conn, records_omit = NULL, id_field = TRUE, rm_empty = TRUE, + rm_empty_omit_calc = FALSE, value_labs = TRUE, value_labs_fetch_raw = FALSE, header_labs = FALSE, @@ -113,6 +114,7 @@ fetch_database <- function(conn, fields = NULL, id_field = id_field, rm_empty = rm_empty, + rm_empty_omit_calc = rm_empty_omit_calc, value_labs = value_labs, value_labs_fetch_raw = value_labs_fetch_raw, header_labs = header_labs, diff --git a/R/fetch_records.R b/R/fetch_records.R index e86f392..bc05f9c 100644 --- a/R/fetch_records.R +++ b/R/fetch_records.R @@ -33,6 +33,11 @@ #' @param rm_empty Logical indicating whether to remove rows for which all #' fields from the relevant form(s) are missing. See section __Removing empty #' rows__. Defaults to `TRUE`. +#' @param rm_empty_omit_calc Logical indicating whether to exclude calculated +#' fields from assessment of empty rows. Defaults to FALSE. In some cases +#' calculated fields can be autopopulated for certain records even when the +#' relevant form is truly empty, which would otherwise lead to "empty" forms +#' being returned even when `rm_empty` is `TRUE`. Defaults to `FALSE`. #' @param value_labs Logical indicating whether to return value labels (`TRUE`) #' or raw values (`FALSE`) for categorical REDCap variables (radio, dropdown, #' yesno, checkbox). Defaults to `TRUE` to return labels. @@ -154,6 +159,7 @@ fetch_records <- function(conn, fields = NULL, id_field = TRUE, rm_empty = TRUE, + rm_empty_omit_calc = FALSE, value_labs = TRUE, value_labs_fetch_raw = FALSE, header_labs = FALSE, @@ -197,6 +203,7 @@ fetch_records <- function(conn, fields = fields, id_field = id_field, rm_empty = rm_empty, + rm_empty_omit_calc, value_labs = value_labs, value_labs_fetch_raw = value_labs_fetch_raw, header_labs = header_labs, @@ -240,6 +247,7 @@ fetch_records_ <- function(conn, fields, id_field, rm_empty, + rm_empty_omit_calc, value_labs, value_labs_fetch_raw, header_labs, @@ -546,7 +554,8 @@ fetch_records_ <- function(conn, forms = forms, value_labs = value_labs, header_labs = header_labs, - checkbox_labs = checkbox_labs + checkbox_labs = checkbox_labs, + rm_empty_omit_calc = rm_empty_omit_calc ) out <- out[!rows_missing, , drop = FALSE] @@ -602,12 +611,14 @@ all_fields_missing <- function(x, value_labs, header_labs, checkbox_labs, + rm_empty_omit_calc, drop_first_row = TRUE) { col_field <- ifelse(header_labs, "field_label", "field_name") if (drop_first_row) dict <- dict[-1, , drop = FALSE] dict_form <- dict[dict$form_name %in% forms, , drop = FALSE] + if (rm_empty_omit_calc) dict_form <- dict_form[!dict_form$field_type %in% "calc", , drop = FALSE] # if value_labs = TRUE # - checkbox_labs = TRUE, empty checkbox fields will be diff --git a/man/fetch_database.Rd b/man/fetch_database.Rd index 63e9eec..1453fd0 100644 --- a/man/fetch_database.Rd +++ b/man/fetch_database.Rd @@ -13,6 +13,7 @@ fetch_database( records_omit = NULL, id_field = TRUE, rm_empty = TRUE, + rm_empty_omit_calc = FALSE, value_labs = TRUE, value_labs_fetch_raw = FALSE, header_labs = FALSE, @@ -69,6 +70,12 @@ request the record ID field.} fields from the relevant form(s) are missing. See section \strong{Removing empty rows}. Defaults to \code{TRUE}.} +\item{rm_empty_omit_calc}{Logical indicating whether to exclude calculated +fields from assessment of empty rows. Defaults to FALSE. In some cases +calculated fields can be autopopulated for certain records even when the +relevant form is truly empty, which would otherwise lead to "empty" forms +being returned even when \code{rm_empty} is \code{TRUE}. Defaults to \code{FALSE}.} + \item{value_labs}{Logical indicating whether to return value labels (\code{TRUE}) or raw values (\code{FALSE}) for categorical REDCap variables (radio, dropdown, yesno, checkbox). Defaults to \code{TRUE} to return labels.} diff --git a/man/fetch_records.Rd b/man/fetch_records.Rd index 1063d1d..1afbe71 100644 --- a/man/fetch_records.Rd +++ b/man/fetch_records.Rd @@ -13,6 +13,7 @@ fetch_records( fields = NULL, id_field = TRUE, rm_empty = TRUE, + rm_empty_omit_calc = FALSE, value_labs = TRUE, value_labs_fetch_raw = FALSE, header_labs = FALSE, @@ -71,6 +72,12 @@ request the record ID field.} fields from the relevant form(s) are missing. See section \strong{Removing empty rows}. Defaults to \code{TRUE}.} +\item{rm_empty_omit_calc}{Logical indicating whether to exclude calculated +fields from assessment of empty rows. Defaults to FALSE. In some cases +calculated fields can be autopopulated for certain records even when the +relevant form is truly empty, which would otherwise lead to "empty" forms +being returned even when \code{rm_empty} is \code{TRUE}. Defaults to \code{FALSE}.} + \item{value_labs}{Logical indicating whether to return value labels (\code{TRUE}) or raw values (\code{FALSE}) for categorical REDCap variables (radio, dropdown, yesno, checkbox). Defaults to \code{TRUE} to return labels.} From 3421b987d1a51c3bdac8732e47547e3b1c67f073 Mon Sep 17 00:00:00 2001 From: patrickbarks Date: Thu, 21 Nov 2024 12:01:35 +0100 Subject: [PATCH 5/5] rm some old debugging checks --- R/fetch_records.R | 2 -- R/meta_dictionary.R | 5 ----- 2 files changed, 7 deletions(-) diff --git a/R/fetch_records.R b/R/fetch_records.R index bc05f9c..3579c8e 100644 --- a/R/fetch_records.R +++ b/R/fetch_records.R @@ -387,8 +387,6 @@ fetch_records_ <- function(conn, # and try again, and print class of non-df object if (!"data.frame" %in% class(out_batch[[i]])) { - warning(class(out_batch[[i]])) - Sys.sleep(batch_delay * 3) out_batch[[i]] <- post_wrapper( diff --git a/R/meta_dictionary.R b/R/meta_dictionary.R index 88e9442..7c9bf77 100644 --- a/R/meta_dictionary.R +++ b/R/meta_dictionary.R @@ -95,11 +95,6 @@ meta_dictionary <- function(conn, if (!is.null(out)) { - # temp debugging check - if (!"select_choices_or_calculations" %in% names(out)) { - stop(deparse(out)) - } - ## shorten names out <- dplyr::rename( out,