Add maq_scale (#104)

Author: erikcs

r-package/maq/NAMESPACE

@@ -10,6 +10,7 @@ export(get_aipw_scores)
 export(get_ipw_scores)
 export(integrated_difference)
 export(maq)
+export(maq_scale)
 importFrom(Rcpp,evalCpp)
 importFrom(stats,predict)
 useDynLib(maq, .registration = TRUE)

r-package/maq/R/maq.R

@@ -548,3 +548,46 @@ integrated_difference <- function(object.lhs,
 
   c(estimate = point.estimate, std.err = std.err)
 }
+
+#' Scale a Qini curve.
+#'
+#' Remap the policy value and budget to some problem-specific application.
+#' This is a convenience function that is usually useful for plotting.
+#'
+#' @param object A maq object.
+#' @param scale A numeric value to scale by.
+#'
+#' @return A rescaled maq object.
+#'
+#' @examples
+#' \donttest{
+#' # Generate some single-arm toy data.
+#' n <- 1500
+#' K <- 1
+#' reward <- matrix(1 + runif(n * K), n, K)
+#' scores <- reward + 5 * matrix(rnorm(n * K), n, K)
+#' cost <- 1
+#'
+#' # Fit a Qini curve.
+#' qini <- maq(reward, cost, scores, R = 200)
+#'
+#' # Plot the policy values as we vary the fraction treated.
+#' qini |>
+#'   plot(xlab = "Treated fraction")
+#'
+#' # Plot the policy values for a maximum allocation of, for example, 500 units.
+#' maq_scale(qini, 500) |>
+#'   plot(xlab = "Units treated")
+#'}
+#' @export
+maq_scale <- function(object,
+                      scale = 1) {
+  object[["_path"]]$spend <- scale * object[["_path"]]$spend
+  object[["_path"]]$gain <- scale * object[["_path"]]$gain
+  object[["_path"]]$std.err <- scale * object[["_path"]]$std.err
+  object[["_path"]]$gain.bs <- lapply(object[["_path"]]$gain.bs,
+                                      function(x) scale * x)
+  object$budget <- object$budget * scale
+
+  object
+}

r-package/maq/R/plot.R

@@ -23,11 +23,11 @@
 #' \donttest{
 #' if (require("ggplot2", quietly = TRUE)) {
 #' # Generate toy data and customize plots.
-#' n = 500
-#' K = 1
-#' reward = matrix(1 + rnorm(n * K), n, K)
-#' scores = reward + matrix(rnorm(n * K), n, K)
-#' cost = 1
+#' n <- 500
+#' K <- 1
+#' reward <- matrix(1 + rnorm(n * K), n, K)
+#' scores <- reward + matrix(rnorm(n * K), n, K)
+#' cost <- 1
 #'
 #' # Fit Qini curves.
 #' qini.avg <- maq(reward, cost, scores, R = 200, target.with.covariates = FALSE)

r-package/maq/man/maq_scale.Rd

@@ -16,6 +16,7 @@ reference:
   - title: Multi-Armed Qini
     contents:
       - maq
+      - maq_scale
       - predict.maq
       - average_gain
       - difference_gain

r-package/maq/man/plot.maq.Rd

@@ -558,3 +558,19 @@ test_that("integrated_difference grid lookup numerics works as expected", {
 
   expect_equal(est, estt, tolerance = 1e-10)
 })
+
+test_that("maq_scale works as expected", {
+  n <- 500
+  K <- 2
+  reward <- matrix(1 + rnorm(n * K), n, K)
+  scores <- reward + matrix(rnorm(n * K), n, K)
+  cost <- matrix(1 + runif(n * K), n, K)
+
+  scale <- 100
+  qini <- maq(reward, cost, scores, R = 200)
+  qini.s <- maq(reward, cost * scale, scores * scale, R = 200)
+
+  expect_equal(qini.s, maq_scale(qini, scale))
+  expect_equal(average_gain(qini.s, 42),
+               average_gain(maq_scale(qini, scale), 42))
+})