#code for Chapter 3 "Propensity Score Weighting" of book: #Leite, W. L. (2017). Practical propensity score methods using R. #Thousand Oaks, CA: Sage. # #this is the code that was used to generate the example results in the book #As the R software and the R packages used in this example are updated frequently #some incompatibilities between the current code and new R versions or package versions #may appear #Any updates to the code will be posted at: # http://www.practicalpropensityscore.com #============================================================== #THIS PART IS ADVANCED #For beginner R users, I recommend that #you evaluate covariate balance #with the code shown in part 4 and skip this #================================ #create a custom function to return balance summaries #the arguments are: #data - the name of the data.frame containing the data. #samplingWeight - the name of the variable containing the sampling weight, in quotes #PSWeight - the name of the variable containing the propensity score weight, in quotes #treatment - the of the treatment indicator variable, in quotes #the type of treatment effect, either "ATT" or "ATE" #covariateNames - the vector of covariate names balanceSummarizer <- function(data, samplingWeight, PSWeight, treatment, effect, covariateNames) { finalWeight <- data[,samplingWeight]*data[,PSWeight] #evaluate covariate balance for ATT require(twang) balance.table <- bal.stat(data, vars= covariateNames, treat.var = treatment, w.all = finalWeight, get.ks=F, sampw = data[,samplingWeight], estimand=effect, multinom=F) balance.table <- balance.table$results #calculate variance ratio balance.table$varRatio <- with(balance.table, tx.sd^2/ct.sd^2) #summarize the covariate balance quality return(rbind( std.eff.sz = summary(abs(balance.table$std.eff.sz)), #standardized effect sizes varRatio = summary(balance.table$varRatio) ))#variance ratios #close function } #==================================================================== #obtain summaries of covariate balances with different propensity scores #using the balanceSummarizer function I defined above. #load datasets load(file="Chapter3_ELS_data_imputed_example_career_academy.Rdata") load(file="Chapter3_ELS_data_imputed_with_weights.Rdata") #create table of covariate balance for each type of weight Table3.1 <- rbind( logistic = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATT", effect="ATT", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames), RF = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATTRf", effect="ATT", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames), GBM = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATTGBM",effect="ATT", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames)) Table3.1 <- data.frame(Table3.1, index=rep(c("std.eff.sz","varRatio"),3), method=rep(c("Logistic","RF","GBM"),each=2)) #write table of results write.csv(Table3.1, file="Table3-1.csv") Table3.2 <- rbind( logistic = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATE",effect="ATE", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames), truncated = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATETruncated",effect="ATE", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames), stabilized = balanceSummarizer(data=ELS.data.imputed,PSWeight="stabilizedWeightATE",effect="ATE", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames), RF = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATERf",effect="ATE", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames), GBM = balanceSummarizer(data=ELS.data.imputed,PSWeight="weightATEGBM",effect="ATE", samplingWeight="bystuwt", treatment="treat",covariateNames=covariateNames)) Table3.2 = data.frame(Table3.2, index=rep(c("std.eff.sz","varRatio"),5), method=rep(c("Logistic","Truncated","Stabilized","RF","GBM"),each=2)) #write table of results write.csv(Table3.2, file="Table3-2.csv")