Predicts benefit scores or treatment recommendations based on a fitted subgroup identification model

Function to obtain predictions for weighted ksvm objects

# S3 method for subgroup_fitted
predict(
  object,
  newx,
  type = c("benefit.score", "trt.group"),
  cutpoint = 0,
  ...
)

# S3 method for wksvm
predict(object, newx, type = c("class", "linear.predictor"), ...)

Arguments

object

fitted object returned by validate.subgrp() function.

For predict.wksvm(), this should be a fitted wksvm object from the weighted.ksvm() function

newx

new design matrix for which predictions will be made

type

type of prediction. type = "benefit.score" results in predicted benefit scores and type = "trt.group" results in prediction of recommended treatment group.

For predict.wksvm(), type = 'class' yields predicted class and type = 'linear.predictor' yields estimated function (the sign of which is the estimated class)

cutpoint

numeric value for patients with benefit scores above which (or below which if larger.outcome.better = FALSE) will be recommended to be in the treatment group. Can also set cutpoint = "median", which will use the median value of the benefit scores as the cutpoint or can set specific quantile values via "quantx" where "x" is a number between 0 and 100 representing the quantile value; e.g. cutpoint = "quant75" will use the 75th perent upper quantile of the benefit scores as the quantile.

...

not used

See also

fit.subgroup for function which fits subgroup identification models.

weighted.ksvm for fitting weighted.ksvm objects

Examples

library(personalized)

set.seed(123)
n.obs  <- 500
n.vars <- 15
x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars)


# simulate non-randomized treatment
xbetat   <- 0.5 + 0.5 * x[,11] - 0.5 * x[,3]
trt.prob <- exp(xbetat) / (1 + exp(xbetat))
trt01    <- rbinom(n.obs, 1, prob = trt.prob)

trt      <- 2 * trt01 - 1

# simulate response
delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12])
xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13]
xbeta <- xbeta + delta * trt

# continuous outcomes
y <- drop(xbeta) + rnorm(n.obs, sd = 2)

# create function for fitting propensity score model
prop.func <- function(x, trt)
{
    # fit propensity score model
    propens.model <- cv.glmnet(y = trt,
                               x = x, family = "binomial")
    pi.x <- predict(propens.model, s = "lambda.min",
                    newx = x, type = "response")[,1]
    pi.x
}

subgrp.model <- fit.subgroup(x = x, y = y,
                            trt = trt01,
                            propensity.func = prop.func,
                            loss   = "sq_loss_lasso",
                            nfolds = 3)              # option for cv.glmnet

subgrp.model$subgroup.trt.effects
#> $subgroup.effects
#> Est of E[Y|T=0,Recom=0]-E[Y|T=/=0,Recom=0] 
#>                                   13.62195 
#> Est of E[Y|T=1,Recom=1]-E[Y|T=/=1,Recom=1] 
#>                                   20.46271 
#> 
#> $avg.outcomes
#>            Recommended 0 Recommended 1
#> Received 0     -15.61725    -29.986895
#> Received 1     -29.23920     -9.524184
#> 
#> $sample.sizes
#>            Recommended 0 Recommended 1
#> Received 0           103           115
#> Received 1           121           161
#> 
#> $overall.subgroup.effect
#> [1] 17.43788
#> 
benefit.scores <- predict(subgrp.model, newx = x, type = "benefit.score")

rec.trt.grp <- predict(subgrp.model, newx = x, type = "trt.group")