From 8f6feaaf6c924886c90a5ac62d8ab300d92f851a Mon Sep 17 00:00:00 2001 From: Kinga Date: Tue, 6 Feb 2024 10:51:14 +0000 Subject: [PATCH] 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 | 177 ++++---- R/api_randomize.R | 160 ++++---- R/db.R | 21 +- tests/testthat/test-DB-study.R | 106 ++--- .../test-E2E-study-minimisation-pocock.R | 387 +++++++++++++++--- 5 files changed, 554 insertions(+), 297 deletions(-) diff --git a/R/api_create_study.R b/R/api_create_study.R index a6a0157..9744dcd 100644 --- a/R/api_create_study.R +++ b/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 )) } diff --git a/R/api_randomize.R b/R/api_randomize.R index 9cb6e31..4093904 100644 --- a/R/api_randomize.R +++ b/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) + } +} diff --git a/R/db.R b/R/db.R index 8bca246..c2f6846 100644 --- a/R/db.R +++ b/R/db.R @@ -139,15 +139,22 @@ create_study <- function( r } -save_patient <- function(study_id, arm_id) { - db_connection_pool <- get("db_connection_pool") - randomized_patient <- DBI::dbGetQuery( - db_connection_pool, - "INSERT INTO patient (arm_id, study_id) +save_patient <- function(study_id, arm_id){ + + r <- tryCatch({ + randomized_patient <- DBI::dbGetQuery( + db_connection_pool, + "INSERT INTO patient (arm_id, study_id) VALUES ($1, $2) RETURNING id, arm_id", - list(arm_id, study_id) + list(arm_id, study_id) + ) + }, + error = function(cond) { + logger::log_error("Error randomizing patient: {cond}", cond=cond) + list(error = conditionMessage(cond)) + } ) - return(randomized_patient) + return(r) } diff --git a/tests/testthat/test-DB-study.R b/tests/testthat/test-DB-study.R index ca474cb..54c05a5 100644 --- a/tests/testthat/test-DB-study.R +++ b/tests/testthat/test-DB-study.R @@ -5,10 +5,10 @@ pool <- get("db_connection_pool", envir = globalenv()) test_that("it is enough to provide a name, an identifier, and a method id", { conn <- pool::localCheckout(pool) with_db_fixtures("fixtures/example_study.yml") - expect_no_error({ - tbl(conn, "study") |> - rows_append( - tibble( + testthat::expect_no_error({ + dplyr::tbl(conn, "study") |> + dplyr::rows_append( + tibble::tibble( identifier = "FINE", name = "Correctly working study", method = "minimisation_pocock" @@ -19,25 +19,25 @@ test_that("it is enough to provide a name, an identifier, and a method id", { }) # first study id is 1 -new_study_id <- 1 |> as.integer() +new_study_id <- as.integer(1) test_that("deleting archivizes a study", { conn <- pool::localCheckout(pool) with_db_fixtures("fixtures/example_study.yml") - expect_no_error({ - tbl(conn, "study") |> - rows_delete( - tibble(id = new_study_id), + testthat::expect_no_error({ + dplyr::tbl(conn, "study") |> + dplyr::rows_delete( + tibble::tibble(id = new_study_id), copy = TRUE, in_place = TRUE, unmatched = "ignore" ) }) - expect_identical( - tbl(conn, "study_history") |> - filter(id == new_study_id) |> - select(-parameters, -sys_period, -timestamp) |> - collect(), - tibble( + testthat::expect_identical( + dplyr::tbl(conn, "study_history") |> + dplyr::filter(id == new_study_id) |> + dplyr::select(-parameters, -sys_period, -timestamp) |> + dplyr::collect(), + tibble::tibble( id = new_study_id, identifier = "TEST", name = "Test Study", @@ -49,11 +49,11 @@ test_that("deleting archivizes a study", { test_that("can't push arm with negative ratio", { conn <- pool::localCheckout(pool) with_db_fixtures("fixtures/example_study.yml") - expect_error( + testthat::expect_error( { - tbl(conn, "arm") |> - rows_append( - tibble( + dplyr::tbl(conn, "arm") |> + dplyr::rows_append( + tibble::tibble( study_id = 1, name = "Exception-throwing arm", ratio = -1 @@ -68,7 +68,7 @@ test_that("can't push arm with negative ratio", { test_that("can't push stratum other than factor or numeric", { conn <- pool::localCheckout(pool) with_db_fixtures("fixtures/example_study.yml") - expect_error( + testthat::expect_error( { tbl(conn, "stratum") |> rows_append( @@ -89,10 +89,10 @@ test_that("can't push stratum level outside of defined levels", { with_db_fixtures("fixtures/example_study.yml") # create a new patient return <- - expect_no_error({ - tbl(conn, "patient") |> - rows_append( - tibble( + testthat::expect_no_error({ + dplyr::tbl(conn, "patient") |> + dplyr::rows_append( + tibble::tibble( study_id = 1, arm_id = 1, used = TRUE @@ -104,11 +104,11 @@ test_that("can't push stratum level outside of defined levels", { added_patient_id <- return$id - expect_error( + testthat::expect_error( { - tbl(conn, "patient_stratum") |> - rows_append( - tibble( + dplyr::tbl(conn, "patient_stratum") |> + dplyr::rows_append( + tibble::tibble( patient_id = added_patient_id, stratum_id = 1, fct_value = "Female" @@ -120,10 +120,10 @@ test_that("can't push stratum level outside of defined levels", { ) # add legal value - expect_no_error({ - tbl(conn, "patient_stratum") |> - rows_append( - tibble( + testthat::expect_no_error({ + dplyr::tbl(conn, "patient_stratum") |> + dplyr::rows_append( + tibble::tibble( patient_id = added_patient_id, stratum_id = 1, fct_value = "F" @@ -136,12 +136,12 @@ test_that("can't push stratum level outside of defined levels", { test_that("numerical constraints are enforced", { conn <- pool::localCheckout(pool) with_db_fixtures("fixtures/example_study.yml") - added_patient_id <- 1 |> as.integer() + added_patient_id <- as.integer(1) return <- - expect_no_error({ - tbl(conn, "stratum") |> - rows_append( - tibble( + testthat::expect_no_error({ + dplyr::tbl(conn, "stratum") |> + dplyr::rows_append( + tibble::tibble( study_id = 1, name = "age", value_type = "numeric" @@ -153,10 +153,10 @@ test_that("numerical constraints are enforced", { added_stratum_id <- return$id - expect_no_error({ - tbl(conn, "numeric_constraint") |> - rows_append( - tibble( + testthat::expect_no_error({ + dplyr::tbl(conn, "numeric_constraint") |> + dplyr::rows_append( + tibble::tibble( stratum_id = added_stratum_id, min_value = 18, max_value = 64 @@ -166,11 +166,11 @@ test_that("numerical constraints are enforced", { }) # and you can't add an illegal value - expect_error( + testthat::expect_error( { - tbl(conn, "patient_stratum") |> - rows_append( - tibble( + dplyr::tbl(conn, "patient_stratum") |> + dplyr::rows_append( + tibble::tibble( patient_id = added_patient_id, stratum_id = added_stratum_id, num_value = 16 @@ -182,10 +182,10 @@ test_that("numerical constraints are enforced", { ) # you can add valid value - expect_no_error({ - tbl(conn, "patient_stratum") |> - rows_append( - tibble( + testthat::expect_no_error({ + dplyr::tbl(conn, "patient_stratum") |> + dplyr::rows_append( + dplyr::tibble( patient_id = added_patient_id, stratum_id = added_stratum_id, num_value = 23 @@ -195,11 +195,11 @@ test_that("numerical constraints are enforced", { }) # but you cannot add two values for one patient one stratum - expect_error( + testthat::expect_error( { - tbl(conn, "patient_stratum") |> - rows_append( - tibble( + dplyr::tbl(conn, "patient_stratum") |> + dplyr::rows_append( + tibble::tibble( patient_id = added_patient_id, stratum_id = added_stratum_id, num_value = 24 diff --git a/tests/testthat/test-E2E-study-minimisation-pocock.R b/tests/testthat/test-E2E-study-minimisation-pocock.R index c366092..6cb6917 100644 --- a/tests/testthat/test-E2E-study-minimisation-pocock.R +++ b/tests/testthat/test-E2E-study-minimisation-pocock.R @@ -1,4 +1,6 @@ -test_that("endpoint returns the study id, can randomize 2 patients", { +pool <- get("db_connection_pool", envir = globalenv()) + +test_that("correct request with the structure of the returned result", { response <- request(api_url) |> req_url_path("study", "minimisation_pocock") |> req_method("POST") |> @@ -10,8 +12,7 @@ test_that("endpoint returns the study id, can randomize 2 patients", { p = 0.85, arms = list( "placebo" = 1, - "active" = 1 - ), + "active" = 1), covariates = list( sex = list( weight = 1, @@ -21,10 +22,10 @@ test_that("endpoint returns the study id, can randomize 2 patients", { weight = 1, levels = c("up to 60kg", "61-80 kg", "81 kg or more") ) - ) - ) + )) ) |> req_perform() + response_body <- response |> resp_body_json() @@ -36,60 +37,346 @@ test_that("endpoint returns the study id, can randomize 2 patients", { req_url_path("study", response_body$study$id, "patient") |> req_method("POST") |> req_body_json( - data = list( - current_state = - tibble::tibble( - "sex" = c("female", "male"), - "weight" = c("61-80 kg", "81 kg or more"), - "arm" = c("placebo", "") - ) - ) + data = list(current_state = + tibble::tibble("sex" = c("female", "male"), + "weight" = c("61-80 kg", "81 kg or more"), + "arm" = c("placebo", ""))) ) |> req_perform() + response_patient_body <- response_patient |> resp_body_json() testthat::expect_equal(response$status_code, 200) - expect_number(response_patient_body$patient_id, lower = 1) + checkmate::expect_number(response_patient_body$patient_id, lower = 1) # Endpoint Response Structure Test - checkmate::expect_names( - names(response_patient_body), - identical.to = c("patient_id", "arm_id", "arm_name") - ) - checkmate::expect_list( - response_patient_body, - any.missing = TRUE, - null.ok = FALSE, - len = 3, type = c("numeric", "numeric", "character") - ) - - # Incorrect Study ID + checkmate::expect_names(names(response_patient_body), identical.to = c("patient_id", "arm_id", "arm_name")) + checkmate::expect_list(response_patient_body, any.missing = TRUE, null.ok = FALSE, len = 3, type = c("numeric", "numeric", "character")) +}) + +test_that("request with one covariate at two levels", { + + response_cov <- + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = 1, + "active" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + )) + ) + ) |> + req_perform() + + response_cov_body <- + response_cov |> + resp_body_json() + + testthat::expect_equal(response_cov$status_code, 200) +}) + +test_that("request with incorrect study id", { + + response <- request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = 1, + "active" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform() + + response_body <- + response |> + resp_body_json() response_study <- - tryCatch( - { - request(api_url) |> - req_url_path("study", response_body$study$id + 1, "patient") |> - req_method("POST") |> - req_body_json( - data = list( - current_state = - tibble::tibble( - "sex" = c("female", "male"), - "weight" = c("61-80 kg", "81 kg or more"), - "arm" = c("placebo", "") - ) - ) - ) |> - req_perform() - }, - error = function(e) e - ) - - checkmate::expect_set_equal( - response_study$status, 400, - label = "HTTP status code" - ) + tryCatch({ + request(api_url) |> + req_url_path("study", response_body$study$id + 1, "patient") |> + req_method("POST") |> + req_body_json( + data = list(current_state = + tibble::tibble("sex" = c("female", "male"), + "weight" = c("61-80 kg", "81 kg or more"), + "arm" = c("placebo", ""))) + ) |> + req_perform() + }, error = function(e) e) + + testthat::expect_equal(response_study$status, 400, label = "HTTP status code") +}) + +test_that("request with patient that is assigned an arm at entry", { + + response <- request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = 1, + "active" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform() + + response_body <- + response |> + resp_body_json() + + response_current_state <- + tryCatch({ + request(api_url) |> + req_url_path("study", response_body$study$id, "patient") |> + req_method("POST") |> + req_body_json( + data = list(current_state = + tibble::tibble("sex" = c("female", "male"), + "weight" = c("61-80 kg", "81 kg or more"), + "arm" = c("placebo", "control"))) + ) |> + req_perform() + }, error = function(e) e) + + testthat::expect_equal(response_current_state$status, 500, label = "HTTP status code") +}) + +test_that("request with incorrect number of levels", { + + response_cov <- + tryCatch({ + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = 1, + "active" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform()}, + error = function(e) e) + + testthat::expect_equal(response_cov$status, 400) + +}) + +test_that("request with incorrect parameter p", { + response_p <- + tryCatch({ + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = "A", + arms = list( + "placebo" = 1, + "active" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform()}, + error = function(e) e) + + testthat::expect_equal(response_p$status, 400) +}) + +test_that("request with incorrect arms", { + response_arms <- + tryCatch({ + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_raw('{ + "identifier": "ABC-X", + "name": "Study ABC-X", + "method": "var", + "p": 0.85, + "arms": { + "placebo": 1, + "placebo": 1 + }, + "covariates": { + "sex": { + "weight": 1, + "levels": ["female", "male"] + }, + "weight": { + "weight": 1, + "levels": ["up to 60kg", "61-80 kg", "81 kg or more"] + } + } + }' + ) |> + req_perform()}, + error = function(e) e) + + testthat::expect_equal(response_arms$status, 400) +}) + +test_that("request with incorrect method", { + + response_method <- + tryCatch({ + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = 1, + p = 0.85, + arms = list( + "placebo" = 1, + "control" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform()}, + error = function(e) e) + + testthat::expect_equal(response_method$status, 400) +}) + +test_that("request with incorrect weights", { + response_weights <- + tryCatch({ + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = 1, + "control" = 1), + covariates = list( + sex = list( + weight = "1", + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform()}, + error = function(e) e) + + testthat::expect_equal(response_weights$status, 400) +}) + +test_that("request with incorrect ratio", { + + response_ratio <- + tryCatch({ + request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = "1", + "control" = 1), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + )) + ) |> + req_perform()}, + error = function(e) e) + + testthat::expect_equal(response_ratio$status, 400) + })