diff --git a/DESCRIPTION b/DESCRIPTION index f9a44b923..c2c85dc83 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -82,6 +82,7 @@ Collate: 'Data-validity.R' 'helpers.R' 'Data-class.R' + 'helpers_data.R' 'Data-methods.R' 'Rules-validity.R' 'Rules-class.R' diff --git a/NAMESPACE b/NAMESPACE index 5fc20e077..26d1633ab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,7 @@ export(.DataDA) export(.DataDual) export(.DataGrouped) export(.DataMixture) +export(.DataOrdinal) export(.DataParts) export(.DefaultCohortSizeConst) export(.DefaultCohortSizeDLT) @@ -187,6 +188,7 @@ export(DataDA) export(DataDual) export(DataGrouped) export(DataMixture) +export(DataOrdinal) export(DataParts) export(Design) export(DualDesign) @@ -373,6 +375,7 @@ exportClasses(DataDA) exportClasses(DataDual) exportClasses(DataGrouped) exportClasses(DataMixture) +exportClasses(DataOrdinal) exportClasses(DataParts) exportClasses(Design) exportClasses(DualDesign) diff --git a/R/Data-class.R b/R/Data-class.R index 3fc92ea50..5d2ccce29 100644 --- a/R/Data-class.R +++ b/R/Data-class.R @@ -380,6 +380,105 @@ DataDA <- function(u = numeric(), ) } +# DataOrdinal ---- + +## class ---- + +#' `DataOrdinal` +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' [`DataOrdinal`] is a class for ordinal toxicity data. +#' It inherits from [`GeneralData`] and it describes toxicity responses on an +#' ordinal rather than binary scale. +#' +#' @note This class has been implemented as a sibling of the existing `Data` class +#' (rather than as a parent or child) to minimise the risk of unintended side +#' effects on existing classes and methods. +#' +#' The default setting for the `yCategories` slot replicates the behaviour +#' of the existing `Data` class. +#' +#' @aliases DataOrdinal +#' @export +.DataOrdinal <- setClass( + Class = "DataOrdinal", + contains = "GeneralData", + slots = c( + x = "numeric", + y = "integer", + doseGrid = "numeric", + nGrid = "integer", + xLevel = "integer", + yCategories = "integer", + placebo = "logical" + ), + prototype = prototype( + x = numeric(), + y = integer(), + doseGrid = numeric(), + nGrid = 0L, + xLevel = integer(), + yCategories = c("No DLT" = 0L, "DLT" = 1L), + placebo = FALSE + ), + validity = v_data_ordinal +) + +## constructor ---- + +#' @rdname DataOrdinal-class +#' @param yCategories (named `integer`)\cr the names and codes for the +#' toxicity categories used in the data. Category labels are taken from the +#' names of the vector. The names of the vector must be unique and its values +#' must be sorted and take the values 0, 1, 2, ... +#' @inheritParams Data +#' @inherit Data details note params +#' @example examples/Data-class-DataOrdinal.R +#' @export +DataOrdinal <- function(x = numeric(), + y = integer(), + ID = integer(), + cohort = integer(), + doseGrid = numeric(), + placebo = FALSE, + yCategories = c("No DLT" = 0L, "DLT" = 1L), + ...) { + assert_numeric(doseGrid, any.missing = FALSE, unique = TRUE) + assert_numeric(yCategories, any.missing = FALSE, unique = TRUE) + assert_character(names(yCategories), any.missing = FALSE, unique = TRUE) + assert_flag(placebo) + + doseGrid <- as.numeric(sort(doseGrid)) + + if (length(ID) == 0 && length(x) > 0) { + message("Used default patient IDs!") + ID <- seq_along(x) + } + + if (!placebo && length(cohort) == 0 && length(x) > 0) { + message("Used best guess cohort indices!") + # This is just assuming that consecutive patients + # in the data set are in the same cohort if they + # have the same dose. Note that this could be wrong, + # if two subsequent cohorts are at the same dose. + cohort <- as.integer(c(1, 1 + cumsum(diff(x) != 0))) + } + + .DataOrdinal( + x = as.numeric(x), + y = safeInteger(y), + ID = safeInteger(ID), + cohort = safeInteger(cohort), + doseGrid = doseGrid, + nObs = length(x), + nGrid = length(doseGrid), + xLevel = matchTolerance(x = x, table = doseGrid), + placebo = placebo, + yCategories = yCategories + ) +} + # DataGrouped ---- ## class ---- @@ -408,8 +507,6 @@ DataDA <- function(u = numeric(), validity = v_data_grouped ) -## constructor ---- - #' @rdname DataGrouped-class #' #' @param group (`factor` or `character`)\cr whether `mono` or `combo` was used. diff --git a/R/Data-methods.R b/R/Data-methods.R index 3fcd3de79..2f37a8834 100644 --- a/R/Data-methods.R +++ b/R/Data-methods.R @@ -1,3 +1,5 @@ +#' @include helpers_data.R + # plot ---- ## Data ---- @@ -8,7 +10,30 @@ #' #' A method that creates a plot for [`Data`] object. #' -#' @param x (`Data`)\cr object we want to plot. +#' @return The [`ggplot2`] object. +#' +#' @aliases plot-Data +#' @rdname plot-Data +#' @export +#' @example examples/Data-method-plot.R +#' +setMethod( + f = "plot", + signature = signature(x = "Data", y = "missing"), + definition = function(x, y, blind = FALSE, legend = TRUE, ...) { + assert_flag(blind) + assert_flag(legend) + h_plot_data_dataordinal(x, blind, legend, ...) + } +) + +#' Plot Method for the [`DataOrdinal`] Class +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' A method that creates a plot for [`DataOrdinal`] object. +#' +#' @param x (`DataOrdinal`)\cr object we want to plot. #' @param y (`missing`)\cr missing object, for compatibility with the generic #' function. #' @param blind (`flag`)\cr indicates whether to blind the data. @@ -16,62 +41,55 @@ #' as the active dose level in the corresponding cohort, #' and DLTs are always assigned to the first subjects in a cohort. #' @param legend (`flag`)\cr whether the legend should be added. +#' @param tox_labels (`named list of character`)\cr the labels of the toxicity +#' categories. +#' @param tox_shapes (`names list of integers`)\cr the symbols used to identify +#' the toxicity categories. #' @param ... not used. #' +#' @note With more than 9 toxicity categories, toxicity symbols must be +#' specified manually.\cr With more than 5 toxicity categories, toxicity labels +#' must be specified manually. +#' #' @return The [`ggplot2`] object. #' -#' @aliases plot-Data +#' @rdname plot-Data #' @export -#' @example examples/Data-method-plot.R -#' +#' @example examples/DataOrdinal-method-plot.R setMethod( f = "plot", - signature = signature(x = "Data", y = "missing"), - definition = function(x, y, blind = FALSE, legend = TRUE, ...) { - assert_flag(blind) - assert_flag(legend) - - if (x@nObs == 0L) { - return() - } - - df <- h_plot_data_df(x, blind, ...) - - p <- ggplot(df, aes(x = patient, y = dose)) + - geom_point(aes(shape = toxicity, colour = toxicity), size = 3) + - scale_colour_manual( - name = "Toxicity", values = c(Yes = "red", No = "black") - ) + - scale_shape_manual(name = "Toxicity", values = c(Yes = 17, No = 16)) + - scale_x_continuous(breaks = df$patient, minor_breaks = NULL) + - scale_y_continuous( - breaks = sort(unique(c(0, df$dose))), - minor_breaks = NULL, - limits = c(0, max(df$dose) * 1.1) - ) + - xlab("Patient") + - ylab("Dose Level") - - p <- p + h_plot_data_cohort_lines(df$cohort, placebo = x@placebo) - - if (!blind) { - p <- p + - geom_text( - aes(label = ID, size = 2), - data = df, - hjust = 0, - vjust = 0.5, - angle = 90, - colour = "black", - show.legend = FALSE - ) + signature = signature(x = "DataOrdinal", y = "missing"), + definition = function(x, + y, + blind = FALSE, + legend = TRUE, + tox_labels = NULL, + tox_shapes = NULL, + ...) { + if (is.null(tox_shapes)) { + assert_true(length(x@yCategories) <= 9) + tox_shapes <- c(17L, 16L, 15L, 18L, 0L:2L, 5L, 6L)[seq_along(x@yCategories)] + names(tox_shapes) <- names(x@yCategories) } - - if (!legend) { - p <- p + theme(legend.position = "none") + if (is.null(tox_labels)) { + assert_true(length(x@yCategories) <= 5) + tox_labels <- switch(length(x@yCategories), + c("black"), + c("black", "red"), + c("black", "orange", "red"), + c("black", "green", "orange", "red"), + c("black", "green", "yellow", "orange", "red") + ) + names(tox_labels) <- names(x@yCategories) } - - p + h_plot_data_dataordinal( + x, + blind, + legend, + tox_labels = tox_labels, + tox_shapes = tox_shapes, + ... + ) } ) @@ -249,7 +267,12 @@ setMethod( #' @param new_cohort (`flag`)\cr if `TRUE` (default) the new data are assigned #' to a new cohort. #' @param check (`flag`)\cr whether the validation of the updated object should -#' be conducted. Current implementation of this `update` method allows for +#' be conducted. See details below. +#' @param ... not used. +#' +#' @return The new, updated [`Data`] object. +#' +#' @details The current implementation of this `update` method allows for #' updating the `Data` class object by adding a single dose level `x` only. #' However, there might be some use cases where the new cohort to be added #' contains a placebo and active dose. Hence, such update would need to be @@ -259,9 +282,6 @@ setMethod( #' the `update` method would normally throw the error when attempting to add #' a placebo in the first call. To allow for such updates, the `check` #' parameter should be then set to `FALSE` for that first call. -#' @param ... not used. -#' -#' @return The new, updated [`Data`] object. #' #' @aliases update-Data #' @export @@ -319,6 +339,97 @@ setMethod( } ) +## DataOrdinal ---- + +#' Updating `DataOrdinal` Objects +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' A method that updates existing [`DataOrdinal`] object with new data. +#' +#' @param object (`DataOrdinal`)\cr object you want to update. +#' @param x (`number`)\cr the dose level (one level only!). +#' @param y (`integer`)\cr the vector of toxicity grades (0, 1, 2, ...) for all +#' patients in this cohort. You can also supply `numeric` vectors, but these +#' will then be converted to `integer` internally. +#' @param ID (`integer`)\cr the patient IDs. +#' You can also supply `numeric` vectors, but these will then be converted to +#' `integer` internally. +#' @param new_cohort (`flag`)\cr if `TRUE` (default) the new data are assigned +#' to a new cohort. +#' @param check (`flag`)\cr whether the validation of the updated object should +#' be conducted. See Details below. +#' @param ... not used. +#' +#' @return The new, updated [`DataOrdinal`] object. +#' +#' @details The current implementation of this `update` method allows for +#' updating the `DataOrdinal` class object by adding a single dose level `x` only. +#' However, there might be some use cases where the new cohort to be added +#' contains a placebo and active dose. Hence, such update would need to be +#' performed iteratively by calling the `update` method twice. For example, +#' in the first call a user can add a placebo, and then in the second call, +#' an active dose. Since having a cohort with placebo only is not allowed, +#' the `update` method would normally throw the error when attempting to add +#' a placebo in the first call. To allow for such updates, the `check` +#' parameter should be then set to `FALSE` for that first call. +#' +#' @aliases update-DataOrdinal +#' @export +#' @example examples/DataOrdinal-method-update.R +#' +setMethod( + f = "update", + signature = signature(object = "DataOrdinal"), + definition = function(object, + x, + y, + ID = length(object@ID) + seq_along(y), + new_cohort = TRUE, + check = TRUE, + ...) { + assert_numeric(x, min.len = 0, max.len = 1) + assert_numeric(y, lower = 0, upper = length(object@yCategories) - 1) + assert_numeric(ID, len = length(y)) + assert_disjunct(object@ID, ID) + assert_flag(new_cohort) + assert_flag(check) + + # How many additional patients, ie. the length of the update. + n <- length(y) + + # Which grid level is the dose? + gridLevel <- matchTolerance(x, object@doseGrid) + object@xLevel <- c(object@xLevel, rep(gridLevel, n)) + + # Add dose. + object@x <- c(object@x, rep(as.numeric(x), n)) + + # Add DLT data. + object@y <- c(object@y, safeInteger(y)) + + # Add ID. + object@ID <- c(object@ID, safeInteger(ID)) + + # Add cohort number. + new_cohort_id <- if (object@nObs == 0) { + 1L + } else { + tail(object@cohort, 1L) + ifelse(new_cohort, 1L, 0L) + } + object@cohort <- c(object@cohort, rep(new_cohort_id, n)) + + # Increment sample size. + object@nObs <- object@nObs + n + + if (check) { + validObject(object) + } + + object + } +) + ## DataParts ---- #' Updating `DataParts` Objects @@ -647,18 +758,26 @@ setMethod( f = "dose_grid_range", signature = signature(object = "Data"), definition = function(object, ignore_placebo = TRUE) { - assert_flag(ignore_placebo) + h_obtain_dose_grid_range(object, ignore_placebo) + } +) - dose_grid <- if (ignore_placebo && object@placebo && object@nGrid >= 1) { - object@doseGrid[-1] - } else { - object@doseGrid - } - if (length(dose_grid) == 0L) { - c(-Inf, Inf) - } else { - range(dose_grid) - } +## DataOrdinal ---- + +#' @include Data-methods.R +#' @rdname dose_grid_range +#' @description `r lifecycle::badge("experimental")` +#' +#' @param ignore_placebo (`flag`)\cr should placebo dose (if any) not be counted? +#' +#' @aliases dose_grid_range-Data +#' @example examples/DataOrdinal-method-dose_grid_range.R +#' +setMethod( + f = "dose_grid_range", + signature = signature(object = "DataOrdinal"), + definition = function(object, ignore_placebo = TRUE) { + h_obtain_dose_grid_range(object, ignore_placebo) } ) diff --git a/R/Data-validity.R b/R/Data-validity.R index e424a5aee..08a0ffee8 100644 --- a/R/Data-validity.R +++ b/R/Data-validity.R @@ -48,18 +48,17 @@ h_doses_unique_per_cohort <- function(dose, cohort) { all(num_doses_per_cohort == 1L) } -#' @describeIn v_data_objects validates that the [`Data`] object contains -#' valid elements with respect to their types, dependency and length. -v_data <- function(object) { +#' Helper Function performing validation Common to Data and DataOrdinal +#' +#' @rdname h_validate_common_data_slots +#' @param object (`Data` or `DataOrdinal`)\cr the object to be validated +#' @returns a `Validate` object containing the result of the validation +h_validate_common_data_slots <- function(object) { v <- Validate() v$check( test_double(object@x, len = object@nObs, any.missing = FALSE), "Doses vector x must be of type double and length nObs" ) - v$check( - test_integer(object@y, lower = 0, upper = 1, len = object@nObs, any.missing = FALSE), - "DLT vector y must be nObs long and contain 0 or 1 integers only" - ) v$check( test_double(object@doseGrid, len = object@nGrid, any.missing = FALSE, unique = TRUE, sorted = TRUE), "doseGrid must be of type double and length nGrid and contain unique, sorted values" @@ -97,9 +96,21 @@ v_data <- function(object) { } else { v$check( h_doses_unique_per_cohort(dose = object@x, cohort = object@cohort), - "There must be only one dose level, per cohort" + "There must be only one dose level per cohort" ) } + v +} + +#' @describeIn v_data_objects validates that the [`Data`] object contains +#' valid elements with respect to their types, dependency and length. +v_data <- function(object) { + v <- h_validate_common_data_slots(object) + v$check( + test_integer(object@y, lower = 0, upper = 1, len = object@nObs, any.missing = FALSE), + "DLT vector y must be nObs long and contain 0 or 1 integers only" + ) + v$result() } @@ -181,6 +192,21 @@ v_data_da <- function(object) { v$result() } +#' @describeIn v_data_objects validates that the [`DataOrdinal`] object +#' contains valid elements with respect to their types, dependency and length. +v_data_ordinal <- function(object) { + v <- h_validate_common_data_slots(object) + v$check( + test_integer(object@y, lower = 0, upper = length(object@yCategories) - 1, len = object@nObs, any.missing = FALSE), + "DLT vector y must be nObs long and contain integers between 0 and k-1 only, where k is the length of the vector in the yCategories slot" # nolint + ) + v$check( + length(unique(names(object@yCategories))) == length(names(object@yCategories)), + "yCategory labels must be unique" + ) + v$result() +} + #' @describeIn v_data_objects validates that the [`DataGrouped`] object #' contains valid group information. v_data_grouped <- function(object) { diff --git a/R/helpers_data.R b/R/helpers_data.R new file mode 100644 index 000000000..a055085dd --- /dev/null +++ b/R/helpers_data.R @@ -0,0 +1,209 @@ +#' Helper Function to Blind Plot Data +#' +#' @param df (`GeneralData`)\cr The data to be blinded +#' @param blind (`flag`)\cr Should the data be blinded? +#' @param has_placebo (`flag`)\cr Does the data contain a placebo dose? +#' @param pbo_dose (`positive_number`)\cr The dose to be taken as placebo. +#' Ignored if `has_placebo` is `FALSE` +#' @returns The blinded data +h_blind_plot_data <- function(df, blind, has_placebo, pbo_dose) { + if (blind) { + # This is to blind the data. + # For each cohort, all DLTs are assigned to the first subjects in the cohort. + # In addition, the placebo (if any) is set to the active dose level for that + # cohort. + # Notice: dapply reorders records of df according to the lexicographic order + # of cohort. + df <- dapply(df, f = ~cohort, FUN = function(coh) { + coh$toxicity <- sort(coh$toxicity, decreasing = TRUE) + coh$dose <- max(coh$dose) + coh + }) + } else if (has_placebo) { + # Placebo will be plotted at y = 0 level. + df$dose[df$dose == pbo_dose] <- 0 + } + df +} + +# h_plot_data_df ---- + +## generic ---- + +#' Helper Function for the Plot Method of subclasses of [`GeneralData`] +#' +#' @description `r lifecycle::badge("experimental")` +#' +#' A method that transforms [`GeneralData`] objects into a `tibble` suitable for +#' plotting with `ggplot2` methods +#' +#' @param data (`GeneralData`)\cr object from which data is extracted and converted +#' into a data frame. +#' @param ... further arguments passed to class-specific methods. +#' @return `data.frame` containing columns for patient, cohort, dose and toxicity grade +#' @aliases h_plot_data_df +#' +setGeneric( + name = "h_plot_data_df", + def = function(data, ...) standardGeneric("h_plot_data_df"), + valueClass = "data.frame" +) + +# Data ---- + +#' Helper Function for the Plot Method of [`Data`] +#' +#' @param data (`Data`)\cr object from which data is extracted and converted +#' into a data frame. +#' @param blind (`flag`)\cr should data be blinded? +#' If `TRUE`, then for each cohort, all DLTs are assigned to the first +#' subjects in the cohort. In addition, the placebo (if any) is set to the +#' active dose level for that cohort. +#' @param legend (`flag`)\cr Display the legend for the toxicity categories +#' @param ... further arguments passed to `data.frame` constructor. +#' It can be e.g. an extra `column_name = value` pair based on a slot +#' from `x` (which in this case might be a subclass of `Data`) +#' which does not appear in `Data`. +#' @return A `data.frame` object with columns patient, ID, cohort, dose and +#' toxicity. +#' @describeIn h_plot_data_df method for [`Data`]. +setMethod( + f = "h_plot_data_df", + signature = signature(data = "Data"), + definition = function(data, blind = FALSE, legend = TRUE, ...) { + df <- data.frame( + patient = seq_along(data@x), + ID = paste(" ", data@ID), + cohort = data@cohort, + dose = data@x, + toxicity = ifelse(data@y == 1, "Yes", "No"), + ... + ) + df <- h_blind_plot_data(df, blind, data@placebo, data@doseGrid[1]) + df + } +) + +# DataOrdinal ---- + +#' Helper Function for the Plot Method of [`DataOrdinal`] +#' +#' @describeIn h_plot_data_df Class specific method for [`DataOrdinal`] +setMethod( + f = "h_plot_data_df", + signature = signature(data = "DataOrdinal"), + definition = function(data, blind = FALSE, legend = TRUE, ...) { + df <- data.frame( + patient = seq_along(data@x), + ID = paste(" ", data@ID), + cohort = data@cohort, + dose = data@x, + toxicity = names(data@yCategories)[1 + data@y], + ... + ) + df <- h_blind_plot_data(df, blind, data@placebo, data@doseGrid[1]) + df + } +) + + +# h_plot_data_dataordinal + +## Data ---- + +#' Helper Function for the Plot Method of the Data and DataOrdinal Classes +#' +#' @description `r lifecycle::badge("stable")` +#' +#' A method that creates a plot for [`Data`] and [`DataOrdinal`] objects. +#' +#' @note The default values of `tox_shapes` and `tox_labels` result in DLTs +#' being displayed as red triangles and other responses as black circles. +#' @return The [`ggplot2`] object. +#' +#' @rdname plot-Data +h_plot_data_dataordinal <- function( + x, + blind = FALSE, + legend = TRUE, + tox_labels = c(Yes = "red", No = "black"), + tox_shapes = c(Yes = 17L, No = 16L), + ...) { + assert_flag(blind) + assert_flag(legend) + assert_character(tox_labels, any.missing = FALSE, unique = TRUE) + assert_integer(tox_shapes, any.missing = FALSE, unique = TRUE) + assert_true(length(tox_shapes) == length(tox_labels)) + assert_subset(x@y, as.integer(0:(length(tox_shapes) - 1))) + if (x@nObs == 0L) { + return() + } + df <- h_plot_data_df(x, blind, ...) + + p <- ggplot(df, aes(x = patient, y = dose)) + + geom_point(aes(shape = toxicity, colour = toxicity), size = 3) + + scale_colour_manual( + name = "Toxicity", + values = tox_labels, + breaks = names(tox_labels), + guide = guide_legend(reverse = TRUE) + ) + + scale_shape_manual( + name = "Toxicity", + values = tox_shapes, + breaks = names(tox_shapes), + guide = guide_legend(reverse = TRUE) + ) + + scale_x_continuous(breaks = df$patient, minor_breaks = NULL) + + scale_y_continuous( + breaks = sort(unique(c(0, df$dose))), + minor_breaks = NULL, + limits = c(0, max(df$dose) * 1.1) + ) + + xlab("Patient") + + ylab("Dose Level") + + p <- p + h_plot_data_cohort_lines(df$cohort, placebo = x@placebo) + + if (!blind) { + p <- p + + geom_text( + aes(label = ID, size = 2), + data = df, + hjust = 0, + vjust = 0.5, + angle = 90, + colour = "black", + show.legend = FALSE + ) + } + + if (!legend) { + p <- p + theme(legend.position = "none") + } + + p +} + +#' Helper Function Containing Common Functionality +#' +#' Used by `dose_grid_range-Data` and `dose_grid_range-DataOrdinal` +#' @param object (`Data` or `DataOrdinal`)\cr the object for which the dose grid +#' range is required +#' @param ignore_placebo (`flag`)\cr should placebo dose (if any) not be counted? +#' +h_obtain_dose_grid_range <- function(object, ignore_placebo) { + assert_flag(ignore_placebo) + + dose_grid <- if (ignore_placebo && object@placebo && object@nGrid >= 1) { + object@doseGrid[-1] + } else { + object@doseGrid + } + + if (length(dose_grid) == 0L) { + c(-Inf, Inf) + } else { + range(dose_grid) + } +} diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 91b3857a8..392ca902b 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -38,6 +38,7 @@ reference: - GeneralData - Data - DataDual + - DataOrdinal - DataParts - DataMixture - DataDA @@ -130,6 +131,7 @@ reference: - TDDesign - title: Internal Helper Functions contents: + - h_blind_plot_data - h_doses_unique_per_cohort - h_all_equivalent - h_plot_data_df @@ -163,10 +165,12 @@ reference: - h_next_best_td_plot - h_next_best_mg_plot - h_next_best_mgsamples_plot + - h_obtain_dose_grid_range - h_covr_helpers - h_default_if_empty - h_unpack_stopit - h_calc_report_label_percentage + - h_validate_common_data_slots - title: Internal Validation Functions contents: - v_general_data @@ -260,6 +264,7 @@ reference: - update-DataParts - update-DataDual - update-DataDA + - update-DataOrdinal - getEff - getEff-DataDual - ngrid diff --git a/examples/Data-class-DataOrdinal.R b/examples/Data-class-DataOrdinal.R new file mode 100644 index 000000000..a0dc9f016 --- /dev/null +++ b/examples/Data-class-DataOrdinal.R @@ -0,0 +1,9 @@ +DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) diff --git a/examples/Data-method-update-DataOrdinal.R b/examples/Data-method-update-DataOrdinal.R new file mode 100644 index 000000000..c4900b9de --- /dev/null +++ b/examples/Data-method-update-DataOrdinal.R @@ -0,0 +1,13 @@ +# Create some data of class 'DataOrdinal'. +my_data <- DataOrdinal( + x = c(0.1, 0.5, 1.5, 3, 6, 10, 10, 10), + y = c(0, 0, 0, 0, 0, 0, 1, 0), + ID = 1L:8L, + cohort = c(1L:5L, 6L, 6L, 6L), + doseGrid = c(0.1, 0.5, 1.5, 3, 6, seq(from = 10, to = 80, by = 2)), + yCategories = c("No tox" = 0L, "AE" = 1L, "DLT" = 2L) +) + +# Update the data with a new cohort. +my_data1 <- update(my_data, x = 20, y = c(0L, 1L, 2L)) +my_data1 diff --git a/examples/DataOrdinal-method-dose_grid_range.R b/examples/DataOrdinal-method-dose_grid_range.R new file mode 100644 index 000000000..f835df39b --- /dev/null +++ b/examples/DataOrdinal-method-dose_grid_range.R @@ -0,0 +1,11 @@ +data <- DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) + +dose_grid_range(data) diff --git a/examples/DataOrdinal-method-plot.R b/examples/DataOrdinal-method-plot.R new file mode 100644 index 000000000..bd99ee304 --- /dev/null +++ b/examples/DataOrdinal-method-plot.R @@ -0,0 +1,11 @@ +data <- DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) + +plot(data) diff --git a/examples/DataOrdinal-method-update.R b/examples/DataOrdinal-method-update.R new file mode 100644 index 000000000..968abc706 --- /dev/null +++ b/examples/DataOrdinal-method-update.R @@ -0,0 +1,11 @@ +data <- DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) + +update(data, x = 70, y = c(1L, 2L, 1L)) diff --git a/examples/Simulations-class-Simulations.R b/examples/Simulations-class-Simulations.R index d7094e66a..c2d9e7dc3 100644 --- a/examples/Simulations-class-Simulations.R +++ b/examples/Simulations-class-Simulations.R @@ -29,4 +29,11 @@ stop_report <- matrix(c(TRUE, FALSE), nrow = 2) stop_reasons <- list("A", "B") -simulations <- Simulations(fit = fit, stop_report = stop_report, stop_reasons = stop_reasons, data, doses, seed) +simulations <- Simulations( + fit = fit, + stop_report = stop_report, + stop_reasons = stop_reasons, + data, + doses, + seed +) diff --git a/examples/mcmc-DataOrdinal.R b/examples/mcmc-DataOrdinal.R new file mode 100644 index 000000000..3e83f94ac --- /dev/null +++ b/examples/mcmc-DataOrdinal.R @@ -0,0 +1,11 @@ +data <- DataOrdinal( + doseGrid = seq(10, 100, 10), + x = c(10, 20, 30, 40, 50, 50, 50), + y = c(0L, 0L, 0L, 0L, 0L, 1L, 2L), + ID = 1L:7L, + cohort = as.integer(c(1:4, 5, 5, 5)), + yCategories = c("No Tox" = 0L, "Sub tox AE" = 1L, "DLT" = 2L) +) +model <- .DefaultLogisticLogNormalOrdinal() +options <- McmcOptions(rng_kind = "Mersenne-Twister", rng_seed = 1234567) +samples <- mcmc(data, model, options) diff --git a/inst/WORDLIST b/inst/WORDLIST index b9e74ed2b..0610efa09 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -76,6 +76,7 @@ customised DataCombo DataDual DataMixture +DataOrdinal dataname datanames DataParts @@ -221,6 +222,7 @@ md mDA Michielin MinimalInformative +minimise minInfModel ModelEff modelled diff --git a/man/DataOrdinal-class.Rd b/man/DataOrdinal-class.Rd new file mode 100644 index 000000000..9be68a721 --- /dev/null +++ b/man/DataOrdinal-class.Rd @@ -0,0 +1,77 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Data-class.R +\docType{class} +\name{DataOrdinal-class} +\alias{DataOrdinal-class} +\alias{.DataOrdinal} +\alias{DataOrdinal} +\title{\code{DataOrdinal}} +\usage{ +DataOrdinal( + x = numeric(), + y = integer(), + ID = integer(), + cohort = integer(), + doseGrid = numeric(), + placebo = FALSE, + yCategories = c(`No DLT` = 0L, DLT = 1L), + ... +) +} +\arguments{ +\item{x}{(\code{numeric})\cr the doses for the patients.} + +\item{y}{(\code{integer})\cr the vector of toxicity events (0 or 1). +You can also supply \code{numeric} vectors, but these will then be converted to +\code{integer} internally.} + +\item{ID}{(\code{integer})\cr unique patient IDs. +You can also supply \code{numeric} vectors, but these will then be converted to +\code{integer} internally.} + +\item{cohort}{(\code{integer})\cr the cohort (non-negative sorted) indices. +You can also supply \code{numeric} vectors, but these will then be converted to +\code{integer} internally.} + +\item{doseGrid}{(\code{numeric})\cr all possible doses.} + +\item{placebo}{(\code{flag})\cr if \code{TRUE} the first dose level +in the \code{doseGrid} is considered as placebo.} + +\item{yCategories}{(named \code{integer})\cr the names and codes for the +toxicity categories used in the data. Category labels are taken from the +names of the vector. The names of the vector must be unique and its values +must be sorted and take the values 0, 1, 2, ...} + +\item{...}{not used.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +\code{\link{DataOrdinal}} is a class for ordinal toxicity data. +It inherits from \code{\link{GeneralData}} and it describes toxicity responses on an +ordinal rather than binary scale. +} +\details{ +The \code{cohort} can be missing if and only if \code{placebo} is equal to +\code{FALSE}. +} +\note{ +This class has been implemented as a sibling of the existing \code{Data} class +(rather than as a parent or child) to minimise the risk of unintended side +effects on existing classes and methods. + +The default setting for the \code{yCategories} slot replicates the behaviour +of the existing \code{Data} class. +} +\examples{ +DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) +} diff --git a/man/Simulations-class.Rd b/man/Simulations-class.Rd index d4520aef5..e79e064e5 100644 --- a/man/Simulations-class.Rd +++ b/man/Simulations-class.Rd @@ -67,5 +67,12 @@ stop_report <- matrix(c(TRUE, FALSE), nrow = 2) stop_reasons <- list("A", "B") -simulations <- Simulations(fit = fit, stop_report = stop_report, stop_reasons = stop_reasons, data, doses, seed) +simulations <- Simulations( + fit = fit, + stop_report = stop_report, + stop_reasons = stop_reasons, + data, + doses, + seed +) } diff --git a/man/dose_grid_range.Rd b/man/dose_grid_range.Rd index 13b814de2..9168fe104 100644 --- a/man/dose_grid_range.Rd +++ b/man/dose_grid_range.Rd @@ -4,11 +4,14 @@ \alias{dose_grid_range} \alias{dose_grid_range,Data-method} \alias{dose_grid_range-Data} +\alias{dose_grid_range,DataOrdinal-method} \title{Getting the Dose Grid Range} \usage{ dose_grid_range(object, ...) \S4method{dose_grid_range}{Data}(object, ignore_placebo = TRUE) + +\S4method{dose_grid_range}{DataOrdinal}(object, ignore_placebo = TRUE) } \arguments{ \item{object}{(\code{Data})\cr object with dose grid.} @@ -28,6 +31,8 @@ A function that returns a vector of length two with the minimum and maximum dose in a grid. It returns \code{c(-Inf, Inf)} if the range cannot be determined, which happens when the dose grid is empty. User can choose whether the placebo dose (if any) should be counted or not. + +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } \examples{ my_data <- Data( @@ -40,4 +45,15 @@ my_data <- Data( ) dose_grid_range(my_data) dose_grid_range(my_data, ignore_placebo = FALSE) +data <- DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) + +dose_grid_range(data) } diff --git a/man/h_blind_plot_data.Rd b/man/h_blind_plot_data.Rd new file mode 100644 index 000000000..9c27dc3ce --- /dev/null +++ b/man/h_blind_plot_data.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers_data.R +\name{h_blind_plot_data} +\alias{h_blind_plot_data} +\title{Helper Function to Blind Plot Data} +\usage{ +h_blind_plot_data(df, blind, has_placebo, pbo_dose) +} +\arguments{ +\item{df}{(\code{GeneralData})\cr The data to be blinded} + +\item{blind}{(\code{flag})\cr Should the data be blinded?} + +\item{has_placebo}{(\code{flag})\cr Does the data contain a placebo dose?} + +\item{pbo_dose}{(\code{positive_number})\cr The dose to be taken as placebo. +Ignored if \code{has_placebo} is \code{FALSE}} +} +\value{ +The blinded data +} +\description{ +Helper Function to Blind Plot Data +} diff --git a/man/h_obtain_dose_grid_range.Rd b/man/h_obtain_dose_grid_range.Rd new file mode 100644 index 000000000..f64ca622d --- /dev/null +++ b/man/h_obtain_dose_grid_range.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers_data.R +\name{h_obtain_dose_grid_range} +\alias{h_obtain_dose_grid_range} +\title{Helper Function Containing Common Functionality} +\usage{ +h_obtain_dose_grid_range(object, ignore_placebo) +} +\arguments{ +\item{object}{(\code{Data} or \code{DataOrdinal})\cr the object for which the dose grid +range is required} + +\item{ignore_placebo}{(\code{flag})\cr should placebo dose (if any) not be counted?} +} +\description{ +Used by \code{dose_grid_range-Data} and \code{dose_grid_range-DataOrdinal} +} diff --git a/man/h_plot_data_df.Rd b/man/h_plot_data_df.Rd index e3d935b01..8c5a37836 100644 --- a/man/h_plot_data_df.Rd +++ b/man/h_plot_data_df.Rd @@ -1,27 +1,42 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helpers.R +% Please edit documentation in R/helpers.R, R/helpers_data.R \name{h_plot_data_df} \alias{h_plot_data_df} +\alias{h_plot_data_df,Data-method} +\alias{h_plot_data_df,DataOrdinal-method} \title{Preparing Data for Plotting} \usage{ -h_plot_data_df(data, blind = FALSE, ...) +h_plot_data_df(data, ...) + +h_plot_data_df(data, ...) + +\S4method{h_plot_data_df}{Data}(data, blind = FALSE, legend = TRUE, ...) + +\S4method{h_plot_data_df}{DataOrdinal}(data, blind = FALSE, legend = TRUE, ...) } \arguments{ \item{data}{(\code{Data})\cr object from which data is extracted and converted into a data frame.} +\item{...}{further arguments passed to \code{data.frame} constructor. +It can be e.g. an extra \code{column_name = value} pair based on a slot +from \code{x} (which in this case might be a subclass of \code{Data}) +which does not appear in \code{Data}.} + \item{blind}{(\code{flag})\cr should data be blinded? If \code{TRUE}, then for each cohort, all DLTs are assigned to the first subjects in the cohort. In addition, the placebo (if any) is set to the active dose level for that cohort.} -\item{...}{further arguments passed to \code{data.frame} constructor. -It can be e.g. an extra \code{column_name = value} pair based on a slot -from \code{x} (which in this case might be a subclass of \code{Data}) -which does not appear in \code{Data}.} +\item{legend}{(\code{flag})\cr Display the legend for the toxicity categories} } \value{ A \code{\link{data.frame}} object with values to plot. + +\code{data.frame} containing columns for patient, cohort, dose and toxicity grade + +A \code{data.frame} object with columns patient, ID, cohort, dose and +toxicity. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} @@ -29,4 +44,16 @@ A \code{\link{data.frame}} object with values to plot. This helper function prepares a \code{data.frame} object based on \code{Data} class object. The resulting data frame is used by the plot function for \code{Data} class objects. + +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A method that transforms \code{\link{GeneralData}} objects into a \code{tibble} suitable for +plotting with \code{ggplot2} methods } +\section{Methods (by class)}{ +\itemize{ +\item \code{h_plot_data_df(Data)}: method for \code{\link{Data}}. + +\item \code{h_plot_data_df(DataOrdinal)}: Class specific method for \code{\link{DataOrdinal}} + +}} diff --git a/man/h_validate_common_data_slots.Rd b/man/h_validate_common_data_slots.Rd new file mode 100644 index 000000000..546872555 --- /dev/null +++ b/man/h_validate_common_data_slots.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Data-validity.R +\name{h_validate_common_data_slots} +\alias{h_validate_common_data_slots} +\title{Helper Function performing validation Common to Data and DataOrdinal} +\usage{ +h_validate_common_data_slots(object) +} +\arguments{ +\item{object}{(\code{Data} or \code{DataOrdinal})\cr the object to be validated} +} +\value{ +a \code{Validate} object containing the result of the validation +} +\description{ +Helper Function performing validation Common to Data and DataOrdinal +} diff --git a/man/plot-Data-missing-method.Rd b/man/plot-Data-missing-method.Rd deleted file mode 100644 index 420c9dd6d..000000000 --- a/man/plot-Data-missing-method.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Data-methods.R -\name{plot,Data,missing-method} -\alias{plot,Data,missing-method} -\alias{plot-Data} -\title{Plot Method for the \code{\link{Data}} Class} -\usage{ -\S4method{plot}{Data,missing}(x, y, blind = FALSE, legend = TRUE, ...) -} -\arguments{ -\item{x}{(\code{Data})\cr object we want to plot.} - -\item{y}{(\code{missing})\cr missing object, for compatibility with the generic -function.} - -\item{blind}{(\code{flag})\cr indicates whether to blind the data. -If \code{TRUE}, then placebo subjects are reported at the same level -as the active dose level in the corresponding cohort, -and DLTs are always assigned to the first subjects in a cohort.} - -\item{legend}{(\code{flag})\cr whether the legend should be added.} - -\item{...}{not used.} -} -\value{ -The \code{\link{ggplot2}} object. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -A method that creates a plot for \code{\link{Data}} object. -} -\examples{ -# Create some data of class 'Data'. -my_data <- Data( - x = c(0.001, 0.1, 0.1, 0.5, 0.001, 3, 3, 0.001, 10, 10, 10), - y = c(0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0), - cohort = c(1, 1, 1, 2, 3, 3, 3, 4, 4, 4, 4), - doseGrid = c(0.001, 0.1, 0.5, 1.5, 3, 6, seq(from = 10, to = 80, by = 2)), - placeb = TRUE -) - -# Plot the data. -plot(my_data) -} diff --git a/man/plot-Data.Rd b/man/plot-Data.Rd new file mode 100644 index 000000000..049964060 --- /dev/null +++ b/man/plot-Data.Rd @@ -0,0 +1,103 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers_data.R, R/Data-methods.R +\name{h_plot_data_dataordinal} +\alias{h_plot_data_dataordinal} +\alias{plot,Data,missing-method} +\alias{plot-Data} +\alias{plot,DataOrdinal,missing-method} +\title{Helper Function for the Plot Method of the Data and DataOrdinal Classes} +\usage{ +h_plot_data_dataordinal( + x, + blind = FALSE, + legend = TRUE, + tox_labels = c(Yes = "red", No = "black"), + tox_shapes = c(Yes = 17L, No = 16L), + ... +) + +\S4method{plot}{Data,missing}(x, y, blind = FALSE, legend = TRUE, ...) + +\S4method{plot}{DataOrdinal,missing}( + x, + y, + blind = FALSE, + legend = TRUE, + tox_labels = NULL, + tox_shapes = NULL, + ... +) +} +\arguments{ +\item{x}{(\code{DataOrdinal})\cr object we want to plot.} + +\item{blind}{(\code{flag})\cr indicates whether to blind the data. +If \code{TRUE}, then placebo subjects are reported at the same level +as the active dose level in the corresponding cohort, +and DLTs are always assigned to the first subjects in a cohort.} + +\item{legend}{(\code{flag})\cr whether the legend should be added.} + +\item{tox_labels}{(\verb{named list of character})\cr the labels of the toxicity +categories.} + +\item{tox_shapes}{(\verb{names list of integers})\cr the symbols used to identify +the toxicity categories.} + +\item{...}{not used.} + +\item{y}{(\code{missing})\cr missing object, for compatibility with the generic +function.} +} +\value{ +The \code{\link{ggplot2}} object. + +The \code{\link{ggplot2}} object. + +The \code{\link{ggplot2}} object. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +A method that creates a plot for \code{\link{Data}} and \code{\link{DataOrdinal}} objects. + +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +A method that creates a plot for \code{\link{Data}} object. + +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A method that creates a plot for \code{\link{DataOrdinal}} object. +} +\note{ +The default values of \code{tox_shapes} and \code{tox_labels} result in DLTs +being displayed as red triangles and other responses as black circles. + +With more than 9 toxicity categories, toxicity symbols must be +specified manually.\cr With more than 5 toxicity categories, toxicity labels +must be specified manually. +} +\examples{ +# Create some data of class 'Data'. +my_data <- Data( + x = c(0.001, 0.1, 0.1, 0.5, 0.001, 3, 3, 0.001, 10, 10, 10), + y = c(0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0), + cohort = c(1, 1, 1, 2, 3, 3, 3, 4, 4, 4, 4), + doseGrid = c(0.001, 0.1, 0.5, 1.5, 3, 6, seq(from = 10, to = 80, by = 2)), + placeb = TRUE +) + +# Plot the data. +plot(my_data) +data <- DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) + +plot(data) +} diff --git a/man/update-Data-method.Rd b/man/update-Data-method.Rd index ad6e6d75e..84581aa2d 100644 --- a/man/update-Data-method.Rd +++ b/man/update-Data-method.Rd @@ -32,16 +32,7 @@ You can also supply \code{numeric} vectors, but these will then be converted to to a new cohort.} \item{check}{(\code{flag})\cr whether the validation of the updated object should -be conducted. Current implementation of this \code{update} method allows for -updating the \code{Data} class object by adding a single dose level \code{x} only. -However, there might be some use cases where the new cohort to be added -contains a placebo and active dose. Hence, such update would need to be -performed iteratively by calling the \code{update} method twice. For example, -in the first call a user can add a placebo, and then in the second call, -an active dose. Since having a cohort with placebo only is not allowed, -the \code{update} method would normally throw the error when attempting to add -a placebo in the first call. To allow for such updates, the \code{check} -parameter should be then set to \code{FALSE} for that first call.} +be conducted. See details below.} \item{...}{not used.} } @@ -53,6 +44,18 @@ The new, updated \code{\link{Data}} object. A method that updates existing \code{\link{Data}} object with new data. } +\details{ +The current implementation of this \code{update} method allows for +updating the \code{Data} class object by adding a single dose level \code{x} only. +However, there might be some use cases where the new cohort to be added +contains a placebo and active dose. Hence, such update would need to be +performed iteratively by calling the \code{update} method twice. For example, +in the first call a user can add a placebo, and then in the second call, +an active dose. Since having a cohort with placebo only is not allowed, +the \code{update} method would normally throw the error when attempting to add +a placebo in the first call. To allow for such updates, the \code{check} +parameter should be then set to \code{FALSE} for that first call. +} \examples{ # Create some data of class 'Data'. my_data <- Data( diff --git a/man/update-DataOrdinal-method.Rd b/man/update-DataOrdinal-method.Rd new file mode 100644 index 000000000..eb6677adb --- /dev/null +++ b/man/update-DataOrdinal-method.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Data-methods.R +\name{update,DataOrdinal-method} +\alias{update,DataOrdinal-method} +\alias{update-DataOrdinal} +\title{Updating \code{DataOrdinal} Objects} +\usage{ +\S4method{update}{DataOrdinal}( + object, + x, + y, + ID = length(object@ID) + seq_along(y), + new_cohort = TRUE, + check = TRUE, + ... +) +} +\arguments{ +\item{object}{(\code{DataOrdinal})\cr object you want to update.} + +\item{x}{(\code{number})\cr the dose level (one level only!).} + +\item{y}{(\code{integer})\cr the vector of toxicity grades (0, 1, 2, ...) for all +patients in this cohort. You can also supply \code{numeric} vectors, but these +will then be converted to \code{integer} internally.} + +\item{ID}{(\code{integer})\cr the patient IDs. +You can also supply \code{numeric} vectors, but these will then be converted to +\code{integer} internally.} + +\item{new_cohort}{(\code{flag})\cr if \code{TRUE} (default) the new data are assigned +to a new cohort.} + +\item{check}{(\code{flag})\cr whether the validation of the updated object should +be conducted. See Details below.} + +\item{...}{not used.} +} +\value{ +The new, updated \code{\link{DataOrdinal}} object. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A method that updates existing \code{\link{DataOrdinal}} object with new data. +} +\details{ +The current implementation of this \code{update} method allows for +updating the \code{DataOrdinal} class object by adding a single dose level \code{x} only. +However, there might be some use cases where the new cohort to be added +contains a placebo and active dose. Hence, such update would need to be +performed iteratively by calling the \code{update} method twice. For example, +in the first call a user can add a placebo, and then in the second call, +an active dose. Since having a cohort with placebo only is not allowed, +the \code{update} method would normally throw the error when attempting to add +a placebo in the first call. To allow for such updates, the \code{check} +parameter should be then set to \code{FALSE} for that first call. +} +\examples{ +data <- DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE +) + +update(data, x = 70, y = c(1L, 2L, 1L)) +} diff --git a/man/v_data_objects.Rd b/man/v_data_objects.Rd index f3958cbd1..c3f3d1f83 100644 --- a/man/v_data_objects.Rd +++ b/man/v_data_objects.Rd @@ -9,6 +9,7 @@ \alias{v_data_parts} \alias{v_data_mixture} \alias{v_data_da} +\alias{v_data_ordinal} \alias{v_data_grouped} \title{Internal Helper Functions for Validation of \code{\link{GeneralData}} Objects} \usage{ @@ -26,6 +27,8 @@ v_data_mixture(object) v_data_da(object) +v_data_ordinal(object) + v_data_grouped(object) } \arguments{ @@ -71,6 +74,9 @@ contains valid elements with respect to their types, dependency and length. \item \code{v_data_da()}: validates that the \code{\link{DataDA}} object contains valid elements with respect to their types, dependency and length. +\item \code{v_data_ordinal()}: validates that the \code{\link{DataOrdinal}} object +contains valid elements with respect to their types, dependency and length. + \item \code{v_data_grouped()}: validates that the \code{\link{DataGrouped}} object contains valid group information. diff --git a/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo-blinding-nolegend.svg b/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo-blinding-nolegend.svg new file mode 100644 index 000000000..0a786ef7f --- /dev/null +++ b/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo-blinding-nolegend.svg @@ -0,0 +1,98 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +25 +50 +100 + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +Patient +Dose Level +plot-DataOrdinal-placebo-blinding-nolegend + + diff --git a/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo-blinding.svg b/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo-blinding.svg new file mode 100644 index 000000000..c3c5b872c --- /dev/null +++ b/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo-blinding.svg @@ -0,0 +1,92 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +10 +20 +30 +40 +50 +60 + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Patient +Dose Level + +Toxicity + + + + + + +DLT +Sub-tox AE +No tox +plot-DataOrdinal-placebo-blinding + + diff --git a/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo.svg b/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo.svg new file mode 100644 index 000000000..51229c0fd --- /dev/null +++ b/tests/testthat/_snaps/Data-methods/plot-dataordinal-placebo.svg @@ -0,0 +1,102 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + + + +0 +10 +20 +30 +40 +50 +60 + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Patient +Dose Level + +Toxicity + + + + + + +DLT +Sub-tox AE +No tox +plot-DataOrdinal-placebo + + diff --git a/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo-and-blinding.svg b/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo-and-blinding.svg index 2d942cc29..2c7732976 100644 --- a/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo-and-blinding.svg +++ b/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo-and-blinding.svg @@ -25,83 +25,83 @@ - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -100 - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -Patient -Dose Level +0 +25 +50 +100 + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +Patient +Dose Level @@ -114,118 +114,118 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 - - - - - - - - - - - - - - - - -0 -50 -100 -150 -Time -Patient - -Toxicity - - - - - - - - - -No -Start -Yes +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +0 +50 +100 +150 +Time +Patient + +Toxicity + + + + + + + + + +No +Start +Yes diff --git a/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo.svg b/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo.svg index cfee7cc27..6ac24bf1a 100644 --- a/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo.svg +++ b/tests/testthat/_snaps/Data-methods/plot-of-datada-with-placebo.svg @@ -25,95 +25,95 @@ - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 -0 -25 -50 -100 - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -Patient -Dose Level +0 +25 +50 +100 + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +Patient +Dose Level @@ -126,130 +126,130 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 - - - - - - - - - - - - - - - - -0 -50 -100 -150 -Time -Patient - -Toxicity - - - - - - - - - -No -Start -Yes +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +0 +50 +100 +150 +Time +Patient + +Toxicity + + + + + + + + + +No +Start +Yes diff --git a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg index 19a028ef9..9e13fae7c 100644 --- a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg +++ b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo-and-blinding.svg @@ -30,78 +30,78 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -25 -50 -100 - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -Patient -Dose Level +0 +25 +50 +100 + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +Patient +Dose Level @@ -114,67 +114,67 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -25 -50 -75 -100 - - - - - - - - -40 -60 -80 -100 -Dose Level -Biomarker - -Toxicity - - - - -No -Yes +25 +50 +75 +100 + + + + + + + + +40 +60 +80 +100 +Dose Level +Biomarker + +Toxicity + + + + +No +Yes diff --git a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg index 4e826e4ce..faf2ae9b0 100644 --- a/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg +++ b/tests/testthat/_snaps/Data-methods/plot-of-datadual-with-placebo.svg @@ -30,90 +30,90 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 -0 -25 -50 -100 - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -Patient -Dose Level +0 +25 +50 +100 + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +Patient +Dose Level @@ -126,82 +126,82 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 -25 -50 -75 -100 - - - - - - - - - -0 -25 -50 -75 -100 -Dose Level -Biomarker - -Toxicity - - - - -No -Yes +25 +50 +75 +100 + + + + + + + + + +0 +25 +50 +75 +100 +Dose Level +Biomarker + +Toxicity + + + + +No +Yes diff --git a/tests/testthat/helper-data.R b/tests/testthat/helper-data.R index a9ce8a03f..4819ea624 100644 --- a/tests/testthat/helper-data.R +++ b/tests/testthat/helper-data.R @@ -162,6 +162,19 @@ h_get_data_sr_2 <- function() { ) } +# Sample ordinal data ---- +h_get_data_ordinal <- function() { + DataOrdinal( + x = c(10, 20, 30, 40, 50, 50, 50, 60, 60, 60), + y = as.integer(c(0, 0, 0, 0, 0, 1, 0, 0, 1, 2)), + ID = 1L:10L, + cohort = as.integer(c(1:4, 5, 5, 5, 6, 6, 6)), + doseGrid = c(seq(from = 10, to = 100, by = 10)), + yCategories = c("No tox" = 0L, "Sub-tox AE" = 1L, "DLT" = 2L), + placebo = FALSE + ) +} + # DataGrouped ---- h_get_data_grouped <- function(empty = FALSE, placebo = TRUE) { diff --git a/tests/testthat/test-Data-class.R b/tests/testthat/test-Data-class.R index c8c83bc42..19c0b3c64 100644 --- a/tests/testthat/test-Data-class.R +++ b/tests/testthat/test-Data-class.R @@ -186,6 +186,37 @@ test_that("DataDA object can be created with custom values", { expect_valid(result, "DataDA") }) +# DataOrdinal-class ---- + +test_that(".DataOrdinal works as expected", { + result <- expect_silent(.DataOrdinal()) + expect_valid(result, "DataOrdinal") +}) + +# DataOrdinal-constructor ---- + +test_that("DataOrdinal object can be created with user constructor DataOrdinal", { + result <- expect_silent(DataOrdinal()) + expect_valid(result, "DataOrdinal") +}) + +test_that("DataOrdinal object can be created with custom values", { + result <- expect_silent( + DataOrdinal( + u = c(42, 30, 15), + t0 = c(0, 15, 30), + Tmax = 60, + x = c(0.1, 0.5, 1.5), + y = c(0, 0, 0), + ID = 1:3, + cohort = 1:3, + doseGrid = c(0.1, 0.5, 1.5, 3, 6, seq(from = 10, to = 80, by = 2)), + yCategories = c("Cat 0" = 0L, "Cat 1" = 1L, "Cat 2" = 2L) + ) + ) + expect_valid(result, "DataOrdinal") +}) + # DataGrouped-class ---- test_that(".DataGrouped works as expected", { diff --git a/tests/testthat/test-Data-methods.R b/tests/testthat/test-Data-methods.R index c386c09fd..41f917ce2 100644 --- a/tests/testthat/test-Data-methods.R +++ b/tests/testthat/test-Data-methods.R @@ -59,6 +59,30 @@ test_that("Plot works for DataDA object with placebo and blinding", { ) }) +# plot-DataOrdinal ---- + +test_that("Plot works as expected for DataOrdinal object with placebo", { + data <- h_get_data_ordinal() + result <- plot(data) + + vdiffr::expect_doppelganger("plot-DataOrdinal-placebo", result) +}) + +test_that("Plot works as expected for DataOrdinal object with placebo and blinding", { + data <- h_get_data_ordinal() + result <- plot(data, blind = TRUE) + + vdiffr::expect_doppelganger("plot-DataOrdinal-placebo-blinding", result) +}) + +test_that("Plot works for DataOrdinal object with placebo, blinding and no legend", { + data <- h_get_data() + result <- plot(data, blind = TRUE, legend = FALSE) + + vdiffr::expect_doppelganger("plot-DataOrdinal-placebo-blinding-nolegend", result) +}) + + # update-Data ---- test_that("Update of Data works as expected", { @@ -125,6 +149,71 @@ test_that("Update of Data, no error for non-valid update and validation off", { ) }) +# update-DataOrdinal +test_that("Update of Data works as expected", { + object <- h_get_data() + result <- update(object, x = 25, y = c(0L, 1L, 1L)) + + object@x <- c(object@x, 25, 25, 25) + object@y <- c(object@y, 0L, 1L, 1L) + object@nObs <- object@nObs + 3L + object@ID <- c(object@ID, 13L, 14L, 15L) + object@xLevel <- c(object@xLevel, 2L, 2L, 2L) + object@cohort <- c(object@cohort, 4L, 4L, 4L) + + expect_valid(result, "Data") + expect_identical(result, object) +}) + +test_that("Update of empty DataOrdinal works as expected", { + object <- DataOrdinal( + x = c(25, 25), y = c(0L, 1L), doseGrid = 25, ID = 1:2, cohort = c(1L, 1L) + ) + result <- update(DataOrdinal(doseGrid = 25), x = 25, y = c(0L, 1L)) + + expect_valid(result, "DataOrdinal") + expect_identical(result, object) +}) + +test_that("Update of DataOrdinal works for 'empty' update", { + object <- h_get_data_ordinal() + result <- update(object, x = numeric(0), y = integer(0)) + expect_identical(result, object) +}) + +test_that("Update of DataOrdinal works when doses are added to the old cohort", { + object <- h_get_data_ordinal() + result <- update(object, x = 60, y = c(0L, 1L, 2L), new_cohort = FALSE) + + object@x <- c(object@x, 60, 60, 60) + object@y <- c(object@y, 0L, 1L, 2L) + object@nObs <- object@nObs + 3L + object@ID <- c(object@ID, 11L, 12L, 13L) + object@xLevel <- c(object@xLevel, 6L, 6L, 6L) + object@cohort <- c(object@cohort, 6L, 6L, 6L) + + expect_valid(result, "DataOrdinal") + expect_identical(result, object) +}) + +test_that("Update of DataOrdinal throws the error for a dose x out of the grid", { + object <- h_get_data_ordinal() + expect_error( + update(object, x = 12345, y = c(0L, 1L, 1L), new_cohort = FALSE), + ".*Dose values in x must be from doseGrid.*" + ) +}) + +test_that("Update of DataOrdinal, no error for non-valid update and validation off", { + object <- h_get_data_ordinal() + expect_silent( + update( + object, + x = 12345, y = c(0L, 1L, 1L), new_cohort = FALSE, check = FALSE + ) + ) +}) + # update-DataParts ---- test_that("Update of DataParts works as expected", { @@ -479,3 +568,42 @@ test_that("dose_grid_range-Data works as expected without placebo in grid", { expect_identical(dose_grid_range(data_empty), c(-Inf, Inf)) expect_identical(dose_grid_range(data_empty, FALSE), c(-Inf, Inf)) }) + +## DataOrdinal ---- + +test_that("dose_grid_range-DataOrdinal works as expected with placebo in grid", { + data <- h_get_data_ordinal() + expect_identical(dose_grid_range(data), c(10, 100)) + expect_identical(dose_grid_range(data, FALSE), c(10, 100)) + + data_1 <- DataOrdinal(doseGrid = c(0.001, 25), placebo = TRUE) + expect_identical(dose_grid_range(data_1), c(25, 25)) + expect_identical(dose_grid_range(data_1, FALSE), c(0.001, 25)) + + data_2 <- DataOrdinal(doseGrid = 0.001, placebo = TRUE) + expect_identical(dose_grid_range(data_2), c(-Inf, Inf)) + expect_identical(dose_grid_range(data_2, FALSE), c(0.001, 0.001)) + + data_empty <- DataOrdinal(placebo = TRUE) + expect_identical(dose_grid_range(data_empty), c(-Inf, Inf)) + expect_identical(dose_grid_range(data_empty, FALSE), c(-Inf, Inf)) +}) + +test_that("dose_grid_range-DataOrdinal works as expected without placebo in grid", { + data <- h_get_data_ordinal() + data@placebo <- TRUE + expect_identical(dose_grid_range(data), c(20, 100)) + expect_identical(dose_grid_range(data, FALSE), c(10, 100)) + + data_1 <- DataOrdinal(doseGrid = c(0.001, 25), placebo = FALSE) + expect_identical(dose_grid_range(data_1), c(0.001, 25)) + expect_identical(dose_grid_range(data_1, FALSE), c(0.001, 25)) + + data_2 <- DataOrdinal(doseGrid = 10, placebo = FALSE) + expect_identical(dose_grid_range(data_2), c(10, 10)) + expect_identical(dose_grid_range(data_2, FALSE), c(10, 10)) + + data_empty <- DataOrdinal(placebo = FALSE) + expect_identical(dose_grid_range(data_empty), c(-Inf, Inf)) + expect_identical(dose_grid_range(data_empty, FALSE), c(-Inf, Inf)) +}) diff --git a/tests/testthat/test-Data-validity.R b/tests/testthat/test-Data-validity.R index a80ddbcdb..21fcf5b9c 100644 --- a/tests/testthat/test-Data-validity.R +++ b/tests/testthat/test-Data-validity.R @@ -259,6 +259,82 @@ test_that("v_data_da: error for t0 of wrong length, negative values", { ) }) +# v_data_ordinal ---- + +test_that("v_data_ordinal passes for valid object", { + object <- h_get_data_ordinal() + expect_true(v_data_ordinal(object)) +}) + +test_that("v_data_ordinal correctly detects bad data", { + object <- h_get_data_ordinal() + object@x[2] <- NA + expect_equal( + v_data_ordinal(object), + c( + "Doses vector x must be of type double and length nObs", + "Dose values in x must be from doseGrid", + "x must be equivalent to doseGrid[xLevel] (up to numerical tolerance)" + ) + ) + + object <- h_get_data_ordinal() + object@x[2] <- 5 + expect_equal( + v_data_ordinal(object), + c( + "Dose values in x must be from doseGrid", + "x must be equivalent to doseGrid[xLevel] (up to numerical tolerance)" + ) + ) + + expect_error( + object@yCategories <- c("No tox" = 0, "AE" = 1, "DLT" = 2), + "assignment of an object of class \"numeric\" is not valid for @'yCategories' in an object of class \"DataOrdinal\"" + ) + + object <- h_get_data_ordinal() + object@y[3] <- 3L + expect_equal( + v_data_ordinal(object), + "DLT vector y must be nObs long and contain integers between 0 and k-1 only, where k is the length of the vector in the yCategories slot" # nolint + ) + + object <- h_get_data_ordinal() + object@yCategories <- c("Good" = 0L, "Bad" = 1L, "Bad" = 2L) + expect_equal( + v_data_ordinal(object), + "yCategory labels must be unique" + ) + + object <- h_get_data_ordinal() + object@x <- c(10, 20, 30, 40, 50, 80, 50, 60, 60, 60) + expect_equal( + v_data_ordinal(object), + c( + "x must be equivalent to doseGrid[xLevel] (up to numerical tolerance)", + "There must be only one dose level per cohort" + ) + ) + + object <- h_get_data_ordinal() + object@placebo <- TRUE + expect_equal( + v_data_ordinal(object), + "A cohort with only placebo is not allowed" + ) + + object <- h_get_data_ordinal() + object@placebo <- TRUE + object@x <- c(10, 20, 30, 40, 50, 80, 10, 60, 60, 60) + object@xLevel <- as.integer(c(1, 2, 3, 4, 5, 8, 1, 6, 6, 6)) + object@cohort <- as.integer(c(1, 1, 2, 3, 4, 4, 4, 5, 5, 5)) + expect_equal( + v_data_ordinal(object), + "There must be only one dose level, other than placebo, per cohort" + ) +}) + # v_data_grouped ---- test_that("v_data_grouped passes for valid object", {