Propensity Score Analysis (PSA) - ITQ-tobacco

library(foreign)

data=read.dta("C:/Users/binht/Dropbox/Hue/paper writing/Intention to quit/BAO/dataforR1.dta")

mydata=subset(data, select=c("year", "age","job", "educ1"  ))

https://datascienceplus.com/how-to-use-r-for-matching-samples-propensity-score/

PSA

---

pacman::p_load(knitr, wakefield, MatchIt, tableone, captioner)

0.0.0.1

library(wakefield)

0.1 variables

names(mydata)

## [1] "year"  "age"   "job"   "educ1"

0.1.1

library(pacman)

## Warning: package 'pacman' was built under R version 4.0.3

library(dplyr)

## Warning: package 'dplyr' was built under R version 4.0.3

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:wakefield':
## 
##     id

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

mydata$educ1=as.factor(mydata$educ1)
mydata$job=as.factor(mydata$job)
mydata$year=as.factor(mydata$year)

library(plyr)

## ------------------------------------------------------------------------------

## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)

## ------------------------------------------------------------------------------

## 
## Attaching package: 'plyr'

## The following objects are masked from 'package:dplyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize

## The following object is masked from 'package:wakefield':
## 
##     id

mydata$group <- revalue(mydata$year, c("2010"= "0", "2015"= "1"))

0.2 Table 1: Comparison of unmatched samples

pacman::p_load(tableone)
table1 <- CreateTableOne(vars = c('age', "job", 'educ1' ), 
                         data = mydata, 
                         factorVars = 'educ1', 
                         strata = 'year')
table1 <- print(table1, 
                printToggle = FALSE, 
                noSpaces = TRUE)
kable(table1[,1:3],  
      align = 'c', 
      caption = 'Table 1: Comparison of unmatched samples')

Table 1: Comparison of unmatched samples

	2010	2015	p
n	1471	1303
age (mean (SD))	42.09 (13.48)	44.85 (13.85)	<0.001
job (%)			<0.001
0	150 (10.2)	174 (13.4)
1	139 (9.4)	93 (7.1)
2	107 (7.3)	137 (10.5)
3	1075 (73.1)	899 (69.0)
educ1 = 1 (%)	1086 (73.8)	936 (71.8)	0.256

0.3 matching

set.seed(1234)

match.it <- matchit(group ~ educ1 + job + age, data = mydata, method="nearest", ratio=1)

a <- summary(match.it)

kable(a$nn, digits = 2, align = 'c', 
      caption = 'Table 2: Sample sizes')

Table 2: Sample sizes

	Control	Treated
All	1471	1303
Matched	1303	1303
Unmatched	168	0
Discarded	0	0

kable(a$sum.matched[c(1,2,4)], digits = 2, align = 'c', 
      caption = 'Table 3: Summary of balance for matched data')

Table 3: Summary of balance for matched data

	Means Treated	Means Control	Mean Diff
distance	0.48	0.47	0.01
educ10	0.28	0.29	-0.01
educ11	0.72	0.71	0.01
job1	0.07	0.09	-0.02
job2	0.11	0.08	0.02
job3	0.69	0.71	-0.02
age	44.85	43.97	0.88

plot(match.it, type = 'jitter', interactive = FALSE)

0.4 save new dataset

df.match <- match.data(match.it)[1:ncol(mydata)]

0.5 new result

pacman::p_load(tableone)
table4 <- CreateTableOne(vars = c('age', "job", 'educ1'), 
                         data = df.match, 
                         factorVars = 'educ1', 
                         strata = 'year')
table4 <- print(table4, 
                printToggle = FALSE, 
                noSpaces = TRUE)
kable(table4[,1:3],  
      align = 'c', 
      caption = 'Table 4: Comparison of matched samples')

Table 4: Comparison of matched samples

	2010	2015	p
n	1303	1303
age (mean (SD))	43.97 (13.04)	44.85 (13.85)	0.094
job (%)			0.022
0	147 (11.3)	174 (13.4)
1	119 (9.1)	93 (7.1)
2	107 (8.2)	137 (10.5)
3	930 (71.4)	899 (69.0)
educ1 = 1 (%)	929 (71.3)	936 (71.8)	0.794