Added new tests for API. The error detection method has been unified …

…across the entire API. Added library::function notation where it was missing. The structure has been changed to reflect changes caused by the implementation of code coverage.

R/api_create_study.R

@@ -1,139 +1,104 @@
 api__minimization_pocock <- function( # nolint: cyclocomp_linter.
     identifier, name, method, arms, covariates, p, req, res) {
-  validation_errors <- vector()
 
-  err <- checkmate::check_character(name, min.chars = 1, max.chars = 255)
-  if (err != TRUE) {
-    validation_errors <- unbiased:::append_error(
-      validation_errors, "name", err
-    )
-  }
+  collection <- checkmate::makeAssertCollection()
 
-  err <- checkmate::check_character(identifier, min.chars = 1, max.chars = 12)
-  if (err != TRUE) {
-    validation_errors <- unbiased:::append_error(
-      validation_errors,
-      "identifier",
-      err
-    )
-  }
+  checkmate::assert(
+    checkmate::check_character(name, min.chars = 1, max.chars = 255),
+    .var.name = "name",
+    add = collection
+  )
 
-  err <- checkmate::check_choice(method, choices = c("range", "var", "sd"))
-  if (err != TRUE) {
-    validation_errors <- unbiased:::append_error(
-      validation_errors,
-      "method",
-      err
-    )
-  }
+  checkmate::assert(
+    checkmate::check_character(identifier, min.chars = 1, max.chars = 12),
+    .var.name = "identifier",
+    add = collection
+  )
+
+  checkmate::assert(
+    checkmate::check_choice(method, choices = c("range", "var", "sd")),
+    .var.name = "method",
+    add = collection)
 
-  err <-
+  checkmate::assert(
     checkmate::check_list(
       arms,
       types = "integerish",
       any.missing = FALSE,
       min.len = 2,
       names = "unique"
-    )
-  if (err != TRUE) {
-    validation_errors <- unbiased:::append_error(
-      validation_errors,
-      "arms",
-      err
-    )
-  }
+    ),
+    .var.name = "arms",
+    add = collection
+  )
 
-  err <-
+  checkmate::assert(
     checkmate::check_list(
       covariates,
       types = c("numeric", "list", "character"),
       any.missing = FALSE,
-      min.len = 2,
+      min.len = 1,
       names = "unique"
-    )
-  if (err != TRUE) {
-    validation_errors <-
-      unbiased:::append_error(validation_errors, "covariates", err)
-  }
+    ),
+    .var.name = "covariates3",
+    add = collection
+  )
 
   response <- list()
   for (c_name in names(covariates)) {
     c_content <- covariates[[c_name]]
 
-    err <- checkmate::check_list(
-      c_content,
-      any.missing = FALSE,
-      len = 2,
-    )
-    if (err != TRUE) {
-      validation_errors <-
-        unbiased:::append_error(
-          validation_errors,
-          glue::glue("covariates[{c_name}]"),
-          err
-        )
-    }
-    err <- checkmate::check_names(
-      names(c_content),
-      permutation.of = c("weight", "levels"),
-    )
-    if (err != TRUE) {
-      validation_errors <-
-        unbiased:::append_error(
-          validation_errors,
-          glue::glue("covariates[{c_name}]"),
-          err
-        )
-    }
+    checkmate::assert(
+      checkmate::check_list(
+        c_content,
+        any.missing = FALSE,
+        len = 2,
+      ),
+      .var.name = "covariates1",
+      add = collection)
+
+    checkmate::assert(
+      checkmate::check_names(
+        names(c_content),
+        permutation.of = c("weight", "levels"),
+      ),
+      .var.name = "covariates2",
+      add = collection)
 
     # check covariate weight
-    err <- checkmate::check_numeric(c_content$weight,
-      lower = 0,
-      finite = TRUE,
-      len = 1,
-      null.ok = FALSE
-    )
-    if (err != TRUE) {
-      validation_errors <-
-        unbiased:::append_error(
-          validation_errors,
-          glue::glue("covariates[{c_name}][weight]"),
-          err
-        )
-    }
-
-    err <- checkmate::check_character(c_content$levels,
-      min.chars = 1,
-      min.len = 2,
-      unique = TRUE
-    )
-    if (err != TRUE) {
-      validation_errors <-
-        unbiased:::append_error(
-          validation_errors,
-          glue::glue("covariates[{c_name}][levels]"),
-          err
-        )
-    }
+    checkmate::assert(
+      checkmate::check_numeric(c_content$weight,
+                               lower = 0,
+                               finite = TRUE,
+                               len = 1,
+                               null.ok = FALSE
+      ),
+      .var.name = "weight",
+      add = collection)
+
+    checkmate::assert(
+      checkmate::check_character(c_content$levels,
+                                 min.chars = 1,
+                                 min.len = 2,
+                                 unique = TRUE
+      ),
+      .var.name = "levels",
+      add = collection)
   }
 
   # check probability
-  p <- as.numeric(p)
-  err <- checkmate::check_numeric(p, lower = 0, upper = 1, len = 1)
-  if (err != TRUE) {
-    validation_errors <-
-      unbiased:::append_error(
-        validation_errors,
-        "p",
-        err
-      )
-  }
+  checkmate::assert(
+    checkmate::check_numeric(p, lower = 0, upper = 1, len = 1,
+                             any.missing = FALSE, null.ok = FALSE),
+    .var.name = "p",
+    add = collection)
+
 
-  if (length(validation_errors) > 0) {
+  if (length(collection$getMessages()) > 0) {
     res$status <- 400
     return(list(
-      error = "Input validation failed",
-      validation_errors = validation_errors
+      error = "There was a problem with the input data to create the study",
+      validation_errors = collection$getMessages()
     ))
   }
 
@@ -167,7 +132,7 @@ api__minimization_pocock <- function( # nolint: cyclocomp_linter.
   if (!is.null(r$error)) {
     res$status <- 503
     return(list(
-      error = "There was a problem creating the study",
+      error = "There was a problem saving created study to the database",
       details = r$error
     ))
   }

R/api_randomize.R

@@ -1,84 +1,3 @@
-api__randomize_patient <- function(study_id, current_state, req, res) {
-  collection <- checkmate::makeAssertCollection()
-
-  db_connection_pool <- get("db_connection_pool")
-
-  # Check whether study with study_id exists
-  checkmate::assert(
-    checkmate::check_subset(
-      x = req$args$study_id,
-      choices = dplyr::tbl(db_connection_pool, "study") |>
-        dplyr::select("id") |>
-        dplyr::pull()
-    ),
-    .var.name = "Study ID",
-    add = collection
-  )
-
-  # Retrieve study details, especially the ones about randomization
-  method_randomization <-
-    dplyr::tbl(db_connection_pool, "study") |>
-    dplyr::filter(.data$id == study_id) |>
-    dplyr::select("method") |>
-    dplyr::pull()
-
-  checkmate::assert(
-    checkmate::check_scalar(method_randomization, null.ok = FALSE),
-    .var.name = "Randomization method",
-    add = collection
-  )
-
-  if (length(collection$getMessages()) > 0) {
-    res$status <- 400
-    return(list(
-      error = "Study input validation failed",
-      validation_errors = collection$getMessages()
-    ))
-  }
-
-  # Dispatch based on randomization method to parse parameters
-  params <-
-    switch(method_randomization,
-      minimisation_pocock = tryCatch(
-        {
-          do.call(
-            parse_pocock_parameters,
-            list(db_connection_pool, study_id, current_state)
-          )
-        },
-        error = function(e) {
-          res$status <- 400
-          res$body <- glue::glue("Error message: {conditionMessage(e)}")
-          logger::log_error("Error: {err}", err = e)
-        }
-      )
-    )
-
-  arm_name <-
-    switch(method_randomization,
-      minimisation_pocock = tryCatch(
-        {
-          do.call(unbiased:::randomize_minimisation_pocock, params)
-        },
-        error = function(e) {
-          res$status <- 400
-          res$body <- glue::glue("Error message: {conditionMessage(e)}")
-          logger::log_error("Error: {err}", err = e)
-        }
-      )
-    )
-
-  arm <- dplyr::tbl(db_connection_pool, "arm") |>
-    dplyr::filter(study_id == !!study_id & .data$name == arm_name) |>
-    dplyr::select(arm_id = "id", "name", "ratio") |>
-    dplyr::collect()
-
-  unbiased:::save_patient(study_id, arm$arm_id) |>
-    dplyr::mutate(arm_name = arm$name) |>
-    dplyr::rename(patient_id = "id") |>
-    as.list()
-}
-
 parse_pocock_parameters <-
   function(db_connetion_pool, study_id, current_state) {
     parameters <-
@@ -129,3 +48,82 @@ parse_pocock_parameters <-
 
     return(params)
   }
+
+api__randomize_patient <- function(study_id, current_state, req, res) {
+  collection <- checkmate::makeAssertCollection()
+
+  db_connection_pool <- get("db_connection_pool")
+
+  # Check whether study with study_id exists
+  checkmate::assert(
+    checkmate::check_subset(
+      x = req$args$study_id,
+      choices = dplyr::tbl(db_connection_pool, "study") |>
+        dplyr::select(id) |>
+        dplyr::pull()
+    ),
+    .var.name = "study_id",
+    add = collection
+  )
+
+  # Retrieve study details, especially the ones about randomization
+  method_randomization <-
+    dplyr::tbl(db_connection_pool, "study") |>
+    dplyr::filter(id == study_id) |>
+    dplyr::select("method") |>
+    dplyr::pull()
+
+  checkmate::assert(
+    checkmate::check_scalar(method_randomization, null.ok = FALSE),
+    .var.name = "method_randomization",
+    add = collection
+  )
+
+  if (length(collection$getMessages()) > 0) {
+    res$status <- 400
+    return(list(
+      error = "There was a problem with the randomization preparation",
+      validation_errors = collection$getMessages()
+    ))
+  }
+
+  # Dispatch based on randomization method to parse parameters
+  params <-
+    switch(
+      method_randomization,
+      minimisation_pocock = do.call(
+        parse_pocock_parameters, list(db_connection_pool, study_id, current_state)
+        )
+    )
+
+  arm_name <-
+    switch(
+      method_randomization,
+      minimisation_pocock = do.call(
+        unbiased:::randomize_minimisation_pocock, params
+        )
+    )
+
+  arm <- dplyr::tbl(db_connection_pool, "arm") |>
+    dplyr::filter(study_id == !!study_id & .data$name == arm_name) |>
+    dplyr::select("arm_id" = "id", "name", "ratio") |>
+    dplyr::collect()
+
+  randomized_patient <-  unbiased:::save_patient(study_id, arm$arm_id)
+
+  if (!is.null(randomized_patient$error)) {
+    res$status <- 503
+    return(list(
+      error = "There was a problem saving randomized patient to the database",
+      details = randomized_patient$error
+    ))
+  } else {
+    randomized_patient <-
+      randomized_patient |>
+      dplyr::mutate(arm_name = arm$name) |>
+      dplyr::rename(patient_id = id) |>
+      as.list()
+
+    return(randomized_patient)
+  }
+}