knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "../man/figures/README-" ) library(dplyr) library(evalITR) load("../data/star.rda") # specifying the outcome outcomes <- "g3tlangss" # specifying the data (remove other outcomes) star_data <- star %>% dplyr::select(-c(g3treadss,g3tmathss)) %>% mutate(SCHLURBN = as.numeric(SCHLURBN)) %>% rename(T = treatment) star_data = star_data %>% mutate( cov1 = GKWHITE, cov2 = GKBUSED, cov3 = GKFRLNCH, school_urban = SCHLURBN ) # specifying the formula user_formula <- as.formula( "g3tlangss ~ T + gender + race + birthmonth + birthyear + SCHLURBN + GRDRANGE + GKENRMNT + cov3 + cov2 + cov1 ")
The package allows to compare the performance of estimated ITRs with user defined ITRs. The estimate_itr
function takes the following arguments:
| Argument | Description |
|:-------- | :------------------------|
| fit
| a fitted object from the estimate_itr
function |
| user_itr
| a function defined by users that returns a unit-level continuous score for treatment assignment (we assume those that have score less than 0 should not have treatment) |
| data
| a data frame |
| treatment
| a character string specifying the treatment variable in the data
|
| outcome
| a character string specifying the outcome variable in the data
|
| budget
| a numeric value specifying the maximum percentage of population that can be treated under the budget constraint |
The function returns an object that contains the estimated GATE, ATE, and AUPEC for the user defined ITR.
# estimate ITR fit <- estimate_itr( treatment = "T", form = user_formula, data = star_data, algorithms = c("causal_forest"), budget = 0.2, split_ratio = 0.7) # user's own ITR score_function <- function(data){ data %>% mutate(score = case_when( school_urban == 1 ~ 0.1, # inner-city school_urban == 2 ~ 0.2, # suburban school_urban == 3 ~ 0.4, # rural school_urban == 4 ~ 0.3, # urban )) %>% pull(score) -> score return(score) } # evalutate ITR compare_itr <- evaluate_itr( fit = fit, user_itr = score_function, data = star_data, treatment = "T", outcome = outcomes, budget = 0.2) # summarize estimates summary(compare_itr)
We plot the estimated Area Under the Prescriptive Effect Curve (AUPEC) for the writing score across a range of budget constraints for user defined ITR and estimated ITRs. The plot shows that the estimated ITRs have better performance than the user defined ITR.
# plot the AUPEC plot(compare_itr)
The package also allows to compare the performance of estimated ITRs of existing ML packages with user defined models. The following code shows an example using causal forest from the grf
package with sample splitting. The estimate_itr
function takes the following arguments:
| Argument | Description |
|:-------- | :------------------------|
| treatment
| a character string specifying the treatment variable in the data
|
| form
| a formula specifying the outcome and covariates |
| data
| a data frame |
| algorithms
| a character vector specifying the ML algorithms to be used |
| budget
| a numeric value specifying the maximum percentage of population that can be treated under the budget constraint |
| split_ratio
| a character string specifying the outcome variable in the data
|
| user_model
| a character string specifying the user defined model |
The user_model
input should be a function that takes two arguments: training_data
and test_data
.
The function will make use of the training_data
to fit a model and then use the test_data
to estimate CATE or other metrics of interest.
It should also specify the way to get the ITR, based on the estimated effects.
In the following example, we fit a linear model with sample splitting and use the estimated CATE. We compute the ITR by
assigning treatment to those with positive CATE and no treatment to those with negative CATE. The function user_model
takes in the training data and test data and return a list that contains (1) an ITR; (2) a fitted model; and (3) a continuous score with the same length as the input data.
# user-defined model user_model <- function(training_data, test_data){ # model fit on training data fit <- train_model(training_data) # estimate CATE on test data compute_hatf <- function(fit, test_data){ score <- fit_predict(fit, test_data) itr <- score_function(score) return(list(itr = itr, score = score)) } hatf <- compute_hatf(fit, test_data) return(list( itr = hatf$itr, fit = fit, score = hatf$score)) }
Note that the user defined model can be any model that returns a unit-level continuous score for treatment assignment.
It does not have to be a linear model or model that estimate CATE. We can specify custom functions in the train_model
function and the fit_predict
function to compute the score. If the model does not have a default predict
function, we need to write up a custom function with fit_predict
.
# train model train_model <- function(data){ fit <- lm( Y ~ T*(cov1 + cov1 + cov3), data = data) return(fit) } # predict function fit_predict <- function(fit, data){ # need to change this function if # the model does not have a default predict function score <- predict(fit, data) return(score) }
In addition, we can also choose any scoring rule that maps the score to a binary indicator of treatment assignment.
# score function score_function <- function(score){ itr <- (score >= 0) * 1 return(itr) }
If split_ratio
is specified, the function will split the data into training and test data. The split_ratio
should be a numeric value between 0 and 1.
Alternatively, if n_folds
is specified, the function will use the entire data to fit the user defined model via cross-validation.
# estimate ITR compare_fit <- estimate_itr( treatment = "T", form = user_formula, data = star_data, algorithms = c("causal_forest"), budget = 0.2, split_ratio = 0.7, user_model = "user_model") # evaluate ITR compare_est <- evaluate_itr(compare_fit) # summarize estimates summary(compare_est) plot(compare_est)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.