diff --git a/R/api_get_study.R b/R/api_get_study.R new file mode 100644 index 0000000..16b4a4a --- /dev/null +++ b/R/api_get_study.R @@ -0,0 +1,100 @@ +api_get_study <- function(res, req) { + db_connection_pool <- get("db_connection_pool") + + study_list <- + dplyr::tbl(db_connection_pool, "study") |> + dplyr::select(study_id = id, identifier, name, method, last_edited = timestamp) |> + dplyr::collect() |> + tibble::as_tibble() + + return(study_list) +} + +api_get_study_records <- function(study_id, req, res) { + db_connection_pool <- get("db_connection_pool") + + is_study <- + checkmate::test_subset( + x = req$args$study_id, + choices = dplyr::tbl(db_connection_pool, "study") |> + dplyr::select(id) |> + dplyr::pull() + ) + + if (!is_study) { + res$status <- 404 + return(list( + error = "Study not found" + )) + } + + study <- + dplyr::tbl(db_connection_pool, "study") |> + dplyr::filter(id == !!study_id) |> + dplyr::select( + study_id = id, name, randomization_method = method, + last_edited = timestamp, parameters + ) |> + dplyr::collect() |> + tibble::remove_rownames() + + strata <- + dplyr::tbl(db_connection_pool, "stratum") |> + dplyr::filter(study_id == !!study_id) |> + dplyr::select(stratum_id = id, stratum_name = name, value_type) |> + collect() |> + left_join( + bind_rows( + dplyr::tbl(db_connection_pool, "factor_constraint") |> + dplyr::collect(), + dplyr::tbl(db_connection_pool, "numeric_constraint") |> + dplyr::collect() + ), + by = "stratum_id" + ) |> + tidyr::unite("value_num", c("min_value", "max_value"), + sep = " - ", na.rm = TRUE + ) |> + dplyr::mutate(value = ifelse(is.na(value), value_num, value)) |> + dplyr::select(stratum_name, value_type, value) |> + left_join( + study$parameters |> + jsonlite::fromJSON() |> + purrr::flatten_dfr() |> + select(-c(p, method)) |> + tidyr::pivot_longer( + cols = everything(), + names_to = "stratum_name", + values_to = "weight" + ), + by = "stratum_name" + ) |> + group_by(stratum_name, value_type, weight) |> + summarise(levels = list(value)) + + arms <- + dplyr::tbl(db_connection_pool, "arm") |> + dplyr::filter(study_id == !!study_id) |> + dplyr::select(arm_name = name, ratio) |> + dplyr::collect() |> + tidyr::pivot_wider(names_from = arm_name, values_from = ratio) |> + as.list() + + study_elements <- + list( + strata = strata, + arms = arms + ) + + study_list <- c( + study |> + dplyr::select(-parameters), + study$parameters |> + jsonlite::fromJSON() |> + purrr::flatten_dfr() |> + dplyr::select(p, method), + study_elements + ) + + return(study_list) +} diff --git a/inst/plumber/unbiased_api/plumber.R b/inst/plumber/unbiased_api/plumber.R index 06add32..1fa78a4 100644 --- a/inst/plumber/unbiased_api/plumber.R +++ b/inst/plumber/unbiased_api/plumber.R @@ -15,6 +15,7 @@ #* randomization method and parameters. #* @apiTag randomize Endpoints that randomize individual patients after the #* study was created. +#* @apiTag read Endpoints that read created records #* @apiTag other Other endpoints (helpers etc.). #* #* @plumber diff --git a/inst/plumber/unbiased_api/study.R b/inst/plumber/unbiased_api/study.R index 07e7f95..93fa34e 100644 --- a/inst/plumber/unbiased_api/study.R +++ b/inst/plumber/unbiased_api/study.R @@ -19,8 +19,7 @@ #* @serializer unboxedJSON #* sentryR::with_captured_calls(function( - identifier, name, method, arms, covariates, p, req, res -) { + identifier, name, method, arms, covariates, p, req, res) { return( unbiased:::api__minimization_pocock( identifier, name, method, arms, covariates, p, req, res @@ -44,3 +43,34 @@ sentryR::with_captured_calls(function(study_id, current_state, req, res) { unbiased:::api__randomize_patient(study_id, current_state, req, res) ) }) + +#* Get all available studies +#* +#* @return tibble with study_id, identifier, name and method +#* +#* @tag read +#* @get / +#* @serializer unboxedJSON +#* + +sentryR::with_captured_calls(function(req, res) { + return( + unbiased:::api_get_study(req, res) + ) +}) + +#* Get all records for chosen study +#* +#* @param study_id:int Study identifier +#* +#* @tag read +#* @get / +#* +#* @serializer unboxedJSON +#* + +sentryR::with_captured_calls(function(study_id, req, res) { + return( + unbiased:::api_get_study_records(study_id, req, res) + ) +}) diff --git a/tests/testthat/test-E2E-get-study.R b/tests/testthat/test-E2E-get-study.R new file mode 100644 index 0000000..038c111 --- /dev/null +++ b/tests/testthat/test-E2E-get-study.R @@ -0,0 +1,112 @@ +test_that("correct request to reads studies with the structure of the returned result", { + source("./test-helpers.R") + + conn <- pool::localCheckout( + get("db_connection_pool", envir = globalenv()) + ) + with_db_fixtures("fixtures/example_study.yml") + + response <- request(api_url) |> + req_url_path("study", "") |> + req_method("GET") |> + req_perform() + + response_body <- + response |> + resp_body_json() + + testthat::expect_equal(response$status_code, 200) + + checkmate::expect_names( + names(response_body[[1]]), + identical.to = c("study_id", "identifier", "name", "method", "last_edited") + ) + + checkmate::expect_list( + response_body[[1]], + any.missing = TRUE, + null.ok = FALSE, + len = 5, + type = c("numeric", "character", "character", "character", "character") + ) + + # Compliance of the number of tests + + n_studies <- + dplyr::tbl(db_connection_pool, "study") |> + collect() |> + nrow() + + testthat::expect_equal(length(response_body), n_studies) +}) + +test_that("correct request to reads records for chosen study_id with the structure of the returned result", { + 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 <- + request(api_url) |> + req_url_path("study", response_body$study$id) |> + req_method("GET") |> + req_perform() + + response_study_body <- + response_study |> + resp_body_json() + + testthat::expect_equal(response$status_code, 200) + + checkmate::expect_names( + names(response_study_body), + identical.to = c("study_id", "name", "randomization_method", "last_edited", "p", "method", "strata", "arms") + ) + + checkmate::expect_list( + response_study_body, + any.missing = TRUE, + null.ok = TRUE, + len = 8, + type = c("numeric", "character", "character", "character", "numeric", "character", "list", "character") + ) + + response_study_id <- + tryCatch( + { + request(api_url) |> + req_url_path("study", response_body$study$id + 1) |> + req_method("GET") |> + req_perform() + }, + error = function(e) e + ) + + testthat::expect_equal(response_study_id$status, 404) +}) diff --git a/tests/testthat/test-E2E-study-minimisation-pocock.R b/tests/testthat/test-E2E-study-minimisation-pocock.R index 3ba3e19..aa4c6c6 100644 --- a/tests/testthat/test-E2E-study-minimisation-pocock.R +++ b/tests/testthat/test-E2E-study-minimisation-pocock.R @@ -1,5 +1,3 @@ -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") |>