library(knitr) opts_chunk$set(message = FALSE, warning=FALSE)
library(hexSticker) library(jcolors) sticker(expression({plot.new(); text(0.5, 0.5, "p", font=2, cex = 10, col = scales::alpha("#0091b6", 0.35))}), package="personalized", p_size = 7, s_x=0.8, s_y=.75, s_width=1.3, s_height=1, p_y = 1.35, h_size = 2, h_color = scales::alpha(unname(jcolors()[2]), 0.75), h_fill = scales::alpha(unname(jcolors()[2]), 1), filename="man/figures/sticker.png")
The 'personalized' package is designed for the analysis of data where the effect of a treatment or intervention may vary for different patients. It can be used for either data from randomized controlled trials or observational studies and is not limited specifically to the analysis of medical data.
The personalized package provides estimation methods for subgroup identification under the framework of Chen et al (2017). It also provides routines for valid estimation of the subgroup-specific treatment effects.
library(diagram) library(scales) par(mai = c(0.01, 0, 0.01, 0)) openplotmat(xlim = c(0, 1), ylim = c(0, 0.5)) elpos <- coordinates (c(3,3)) elpos[c(2:3, 5:6),1] <- elpos[c(2:3, 5:6),1] - 0.075 elpos[1:3,2] <- elpos[1:3,2] - 0.01 elpos[4:6,2] <- elpos[4:6,2] + 0.01 arrpos <- matrix(ncol = 2, nrow = 3) arrpos[1,] <- straightarrow (to = elpos[2,] - c(0.12, 0), from = elpos[1,] + c(0.1, 0), lwd = 2, arr.pos = 0.8, arr.length = 0.5, endhead = TRUE) arrpos[2,] <- straightarrow (to = elpos[3,] - c(0.16, 0), from = elpos[2,] + c(0.12, 0), lwd = 2, arr.pos = 0.8, arr.length = 0.5, endhead = TRUE) arrpos[3,] <- straightarrow (to = elpos[6,] - c(0.16, 0), from = elpos[5,] + c(0.12, 0), lwd = 2, arr.pos = 0.8, arr.length = 0.5, endhead = TRUE) textrect(elpos[1,], lab = expression(X~","~Y~","~Treatment), box.col = alpha("deepskyblue3", 0.85), lcol = alpha("deepskyblue3", 1), shadow.size = 0, lwd = 0.001, radx = 0.1, rady = 0.065, adj = (0.495), cex = 2) textrect(elpos[2,], lab = "Estimate \n Subgroups", box.col = alpha("chartreuse3", 0.85), lcol = alpha("deepskyblue3", 1), shadow.size = 0, lwd = 0.001, radx = 0.12, rady = 0.065, adj = (0.5), cex = 2) textrect(elpos[3,], lab = "Estimate Treatment Effects \n within Subgroups", box.col = alpha("red", 0.85), lcol = alpha("deepskyblue3", 1), shadow.size = 0, lwd = 0.001, radx = 0.16, rady = 0.065, adj = (0.5), cex = 2) textrect(elpos[5,], lab = "model <- \n fit.subgroup(x, y, trt)", box.col = alpha("chartreuse3", 0.85), lcol = alpha("deepskyblue3", 1), shadow.size = 0, lwd = 0.001, radx = 0.12, rady = 0.065, adj = (0.5), cex = 2) textrect(elpos[6,], lab = "validate.subgroup(model)", box.col = alpha("red", 0.85), lcol = alpha("deepskyblue3", 1), shadow.size = 0, lwd = 0.001, radx = 0.16, rady = 0.065, adj = (0.5), cex = 2)
Tutorial / Vignette - tutorial of statistical methodology and usage of the package
Install from CRAN using:
install.packages("personalized")
or install the development version using the devtools package:
devtools::install_github("jaredhuling/personalized")
or by cloning and building using R CMD INSTALL
Load the package:
library(personalized)
set.seed(123) n.obs <- 500 n.vars <- 50 x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) # simulate non-randomized treatment xbetat <- 0.5 + 0.5 * x[,21] - 0.5 * x[,41] trt.prob <- exp(xbetat) / (1 + exp(xbetat)) trt01 <- rbinom(n.obs, 1, prob = trt.prob) trt <- ifelse(trt01 == 1, "Trt", "Ctrl") # simulate response delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11]) xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] + 0.5 * x[,15] ^ 2 xbeta <- xbeta + delta * (2 * trt01 - 1) # continuous outcomes y <- drop(xbeta) + rnorm(n.obs, sd = 2)
(it should be a function which inputs covariates and treatments and returns propensity score):
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 = trt, propensity.func = prop.func, loss = "sq_loss_lasso", nfolds = 5) # option for cv.glmnet
summary(subgrp.model)
val.model <- validate.subgroup(subgrp.model, B = 100, method = "training_test", train.fraction = 0.75)
print(val.model, digits = 2, sample.pct = TRUE)
Visualize subgroup-specific treatment effect estimates across training/testing iterations:
plot(val.model)
Here we only display covariates with a significantly different mean value (at level 0.05)
summ <- summarize.subgroups(subgrp.model) print(summ, p.value = 0.05)
personalized
Access help files for the main functions of the personalized
package:
?fit.subgroup ?validate.subgroup
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.