673: Add LogisticLogNormalGrouped class

.lintr

@@ -3,6 +3,5 @@ linters: linters_with_defaults(
   cyclocomp_linter = NULL,
   object_usage_linter = NULL,
   object_length_linter = NULL,
-  indentation_linter = NULL,
   object_name_linter = object_name_linter(c("CamelCase", "camelCase", "snake_case"))
  )

NAMESPACE

@@ -43,6 +43,7 @@ export(.DefaultIncrementsRelativeParts)
 export(.DefaultLogisticKadane)
 export(.DefaultLogisticKadaneBetaGamma)
 export(.DefaultLogisticLogNormal)
+export(.DefaultLogisticLogNormalGrouped)
 export(.DefaultLogisticLogNormalMixture)
 export(.DefaultLogisticLogNormalSub)
 export(.DefaultLogisticNormal)
@@ -112,6 +113,7 @@ export(.LogisticIndepBeta)
 export(.LogisticKadane)
 export(.LogisticKadaneBetaGamma)
 export(.LogisticLogNormal)
+export(.LogisticLogNormalGrouped)
 export(.LogisticLogNormalMixture)
 export(.LogisticLogNormalSub)
 export(.LogisticNormal)
@@ -210,6 +212,7 @@ export(LogisticIndepBeta)
 export(LogisticKadane)
 export(LogisticKadaneBetaGamma)
 export(LogisticLogNormal)
+export(LogisticLogNormalGrouped)
 export(LogisticLogNormalMixture)
 export(LogisticLogNormalSub)
 export(LogisticNormal)
@@ -400,6 +403,7 @@ exportClasses(LogisticIndepBeta)
 exportClasses(LogisticKadane)
 exportClasses(LogisticKadaneBetaGamma)
 exportClasses(LogisticLogNormal)
+exportClasses(LogisticLogNormalGrouped)
 exportClasses(LogisticLogNormalMixture)
 exportClasses(LogisticLogNormalSub)
 exportClasses(LogisticNormal)

R/Model-class.R

@@ -516,6 +516,97 @@ ProbitLogNormalRel <- function(mean, cov, ref_dose = 1) {
   ProbitLogNormalRel(mean = c(-0.85, 1), cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2))
 }
 
+# LogisticLogNormalGrouped ----
+
+## class ----
+
+#' `LogisticLogNormalGrouped`
+#'
+#' @description `r lifecycle::badge("experimental")`
+#'
+#' [`LogisticLogNormalGrouped`] is the class for a logistic regression model
+#'  for both the mono and the combo arms of the simultaneous dose escalation
+#'  design.
+#'
+#' @details The continuous covariate is the natural logarithm of the dose \eqn{x} divided by
+#'   the reference dose \eqn{x*} as in [`LogisticLogNormal`]. In addition,
+#'   \eqn{I_c} is a binary indicator covariate which is 1 for the combo arm and 0 for the mono arm.
+#'   The model is then defined as:
+#'   \deqn{logit[p(x)] = (alpha0 + I_c * delta0) + (alpha1 + I_c * delta1) * log(x / x*),}
+#'   where \eqn{p(x)} is the probability of observing a DLT for a given dose \eqn{x},
+#'   and `delta0` and `delta1` are the differences in the combo arm compared to the mono intercept
+#'   and slope parameters `alpha0` and `alpha1`.
+#'   The prior is defined as \deqn{(alpha0, log(delta0), log(alpha1), log(delta1)) ~ Normal(mean, cov).}
+#'
+#' @seealso [`ModelLogNormal`], [`LogisticLogNormal`].
+#'
+#' @aliases LogisticLogNormalGrouped
+#' @export
+#'
+.LogisticLogNormalGrouped <- setClass(
+  Class = "LogisticLogNormalGrouped",
+  contains = "ModelLogNormal"
+)
+
+## constructor ----
+
+#' @rdname LogisticLogNormalGrouped-class
+#'
+#' @inheritParams ModelLogNormal
+#'
+#' @export
+#' @example examples/Model-class-LogisticLogNormalGrouped.R
+#'
+LogisticLogNormalGrouped <- function(mean, cov, ref_dose = 1) {
+  params <- ModelParamsNormal(mean, cov)
+  .LogisticLogNormalGrouped(
+    params = params,
+    ref_dose = positive_number(ref_dose),
+    priormodel = function() {
+      theta ~ dmnorm(mean, prec)
+      alpha0 <- theta[1]
+      delta0 <- exp(theta[2])
+      alpha1 <- exp(theta[3])
+      delta1 <- exp(theta[4])
+    },
+    datamodel = function() {
+      for (i in 1:nObs) {
+        logit(p[i]) <- (alpha0 + is_combo[i] * delta0) +
+          (alpha1 + is_combo[i] * delta1) * log(x[i] / ref_dose)
+        y[i] ~ dbern(p[i])
+      }
+    },
+    modelspecs = function(group, from_prior) {
+      ms <- list(
+        mean = params@mean,
+        prec = params@prec
+      )
+      if (!from_prior) {
+        ms$ref_dose <- ref_dose
+        ms$is_combo <- as.integer(group == "combo")
+      }
+      ms
+    },
+    init = function() {
+      list(theta = c(0, 1, 1, 1))
+    },
+    datanames = c("nObs", "y", "x"),
+    sample = c("alpha0", "delta0", "alpha1", "delta1")
+  )
+}
+
+## default constructor ----
+
+#' @rdname LogisticLogNormalGrouped-class
+#' @note Typically, end users will not use the `.DefaultLogisticLogNormalGrouped()` function.
+#' @export
+.DefaultLogisticLogNormalGrouped <- function() {
+  LogisticLogNormalGrouped(
+    mean = rep(0, 4),
+    cov = diag(rep(1, 4)),
+  )
+}
+
 # LogisticKadane ----
 
 ## class ----

R/Model-methods.R

@@ -50,8 +50,8 @@ setMethod(
       data = model_params,
       options = McmcOptions(samples = NROW(model_params[[1]]))
     )
-    function(x) {
-      dose(x = x, model = model, samples = samples)
+    function(x, ...) {
+      dose(x = x, model = model, samples = samples, ...)
     }
   }
 )
@@ -127,8 +127,8 @@ setMethod(
       data = model_params,
       options = McmcOptions(samples = NROW(model_params[[1]]))
     )
-    function(dose) {
-      prob(dose = dose, model = model, samples = samples)
+    function(dose, ...) {
+      prob(dose = dose, model = model, samples = samples, ...)
     }
   }
 )
@@ -403,6 +403,41 @@ setMethod(
   }
 )
 
+## LogisticLogNormalGrouped ----
+
+#' @describeIn dose method for [`LogisticLogNormalGrouped`] which needs `group`
+#'   argument in addition.
+#' @param group (`character` or `factor`)\cr for [`LogisticLogNormalGrouped`],
+#'   indicating whether to calculate the dose for the `mono` or for
+#'   the `combo` arm.
+#' @aliases dose-LogisticLogNormalGrouped
+#' @export
+#'
+setMethod(
+  f = "dose",
+  signature = signature(
+    x = "numeric",
+    model = "LogisticLogNormalGrouped",
+    samples = "Samples"
+  ),
+  definition = function(x, model, samples, group) {
+    assert_probabilities(x)
+    assert_subset(c("alpha0", "delta0", "alpha1", "delta1"), names(samples))
+    assert_length(x, len = size(samples))
+    assert_multi_class(group, c("character", "factor"))
+    assert_subset(as.character(group), choices = c("mono", "combo"))
+    assert_length(group, len = size(samples))
+
+    alpha0 <- samples@data$alpha0
+    delta0 <- samples@data$delta0
+    alpha1 <- samples@data$alpha1
+    delta1 <- samples@data$delta1
+    ref_dose <- as.numeric(model@ref_dose)
+    is_combo <- as.integer(group == "combo")
+    exp((logit(x) - (alpha0 + is_combo * delta0)) / (alpha1 + is_combo * delta1)) * ref_dose
+  }
+)
+
 ## LogisticKadane ----
 
 #' @describeIn dose compute the dose level reaching a specific target
@@ -923,6 +958,41 @@ setMethod(
   }
 )
 
+## LogisticLogNormalGrouped ----
+
+#' @describeIn prob method for [`LogisticLogNormalGrouped`] which needs `group`
+#'   argument in addition.
+#' @param group (`character` or `factor`)\cr for [`LogisticLogNormalGrouped`],
+#'   indicating whether to calculate the probability for the `mono` or for
+#'   the `combo` arm.
+#' @aliases prob-LogisticLogNormalGrouped
+#' @export
+#'
+setMethod(
+  f = "prob",
+  signature = signature(
+    dose = "numeric",
+    model = "LogisticLogNormalGrouped",
+    samples = "Samples"
+  ),
+  definition = function(dose, model, samples, group) {
+    assert_numeric(dose, lower = 0L, any.missing = FALSE, min.len = 1L)
+    assert_subset(c("alpha0", "delta0", "alpha1", "delta1"), names(samples))
+    assert_length(dose, len = size(samples))
+    assert_multi_class(group, c("character", "factor"))
+    assert_subset(as.character(group), choices = c("mono", "combo"))
+    assert_length(group, len = size(samples))
+
+    alpha0 <- samples@data$alpha0
+    delta0 <- samples@data$delta0
+    alpha1 <- samples@data$alpha1
+    delta1 <- samples@data$delta1
+    ref_dose <- as.numeric(model@ref_dose)
+    is_combo <- as.integer(group == "combo")
+    plogis((alpha0 + is_combo * delta0) + (alpha1 + is_combo * delta1) * log(dose / ref_dose))
+  }
+)
+
 ## LogisticKadane ----
 
 #' @describeIn prob

R/crmPack-package.R

@@ -81,7 +81,9 @@ globalVariables(c(
   "logit<-",
   "rho0",
   "alpha0",
+  "delta0",
   "alpha1",
+  "delta1",
   "inverse",
   "priorCov",
   "theta",
@@ -135,7 +137,8 @@ globalVariables(c(
   "ref_dose",
   "comp",
   "X",
-  "skel_probs"
+  "skel_probs",
+  "is_combo"
 ))
 
 # nolint end

_pkgdown.yaml

@@ -51,6 +51,7 @@ reference:
       - LogisticLogNormalSub
       - ProbitLogNormal
       - ProbitLogNormalRel
+      - LogisticLogNormalGrouped
       - LogisticKadane
       - LogisticKadaneBetaGamma
       - LogisticNormalMixture

examples/Model-class-LogisticLogNormalGrouped.R

@@ -0,0 +1,6 @@
+my_model <- LogisticLogNormalGrouped(
+  mean = c(-0.85, 0, 1, 0),
+  cov = diag(1, 4),
+  ref_dose = 50
+)
+my_model