#=========================================================== #code for Chapter 5 "Propensity Score Matching" of book: #Leite, W. L. (2017). Practical propensity score methods using R. #Thousand Oaks, CA: Sage. #PART 4 - GENETIC MATCHING WITH PROPENSITY SCORES AND #COVARIATES, WITH SENSITIVITY ANALYSIS # #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 example estimates the effect of mothers having a job #that provides or subsidizes child care #on the length that they breastfeed their children #National Longitudinal Survey of Youth 1979 (NLSY79) #and the NLSY79 Children and Youth #Perform genetic matching #load data load(file="Chapter5_data_with_propensity_scores_and_formula.rData") #perform variable ratio genetic matching with replacement (no caliper) #based on covariates and the Propensity score #to estimate the ATT library(Matching) #create a dataset of covariates in numeric format covariateData <- as.matrix(data$logitPScores) for (c in covariateNames) { covariateData <- cbind(covariateData,as.numeric(as.matrix(data[,c]))) } colnames(covariateData) <- c("logitPScores",covariateNames) #convert the treatment from 0/1 to TRUE/FALSE as required by GenMatch data$childCare <- ifelse(data$childCare==1, TRUE, FALSE) geneticWeights <- GenMatch(Tr=data$childCare, X=covariateData, pop.size=1000, fit.func="pvals", estimand="ATT", replace=T, ties=T) geneticMatching <- Match(Y=data$C0338600, Tr=data$childCare, X=covariateData, Weight.matrix = geneticWeights, estimand = "ATT", M = 1, replace=TRUE, ties=TRUE) #evaluate covaraite balance balance.geneticMatching <- MatchBalance(psFormula, data = data, match.out = geneticMatching, ks = F, paired=F) balance.geneticMatchingAfter <- unlist(balance.geneticMatching$AfterMatching) #summarize only the standized mean differences (they have been multiplied by 100, so I divided by 100) #see details in ?balanceUV summary(abs(balance.geneticMatchingAfter[names(balance.geneticMatchingAfter)=="sdiff"]/100)) table(abs(balance.geneticMatchingAfter[names(balance.geneticMatchingAfter)=="sdiff"]/100)>0.1) #-------------------------------- #estimate the ATT with variable ratio genetic matching #with replacement within 0.25 caliper #standard error is obtained with Abadie and Imbens (2006) estimator summary(geneticMatching) #----------------------------------------- #Repeat the genetic matching, but this time with bias adjustment geneticMatchingBA <- Match(Y=data$C0338600, Tr=data$childCare, X=covariateData, BiasAdjust=T, Z=covariateData, Weight.matrix = geneticWeights, estimand = "ATT", M = 1, replace=TRUE, ties=TRUE) summary(geneticMatchingBA) #======================================= #Rosenbaum Sensitivity Test for Wilcoxon Signed Rank P-Value #with genetic matching library(rbounds) psens(geneticMatching, Gamma=3, GammaInc=.1)