#Read data
df <- read.csv("Ptdata.csv")
df <- subset(df, select = - c(PtID, P3, P4, P5, P9, P10))
colnames(df)[2:6] <- c("Age", "AdmType", "SOFA", "Gender", "DisStatus")
#Tidy data
df <- df[df$DocID %in% c('doc-01', 'doc-02', 'doc-03', 'doc-04', 'doc-05'), ]
df$y <- ifelse(df$DisStatus == 'A', 1, 0)
df$DocID[1:79] <- paste0("Phys",1)
df$DocID[80:174] <- paste0("Phys",2)
df$DocID[175:264] <- paste0("Phys",3)
df$DocID[265:365] <- paste0("Phys",4)
df$DocID[366:489] <- paste0("Phys",5)
df$Age <- factor(df$Age)
df$AdmType <- factor(df$AdmType)
df$Gender <- factor(df$Gender)
df$DocID <- factor(df$DocID)
############################Using Propensity Weighting with Parametric Method#######################################
library(PSweight)
############################Using Propensity Weighting with Parametric Method#######################################
library(PSweight)
ps.mult <- DocID ~ Age + AdmType + SOFA + Gender
bal.mult <- SumStat(ps.formula = ps.mult, weight = c('IPW', 'overlap'), data = df)
ps.p <- propensity<-bal.mult$propensity
plot(bal.mult, type = "density")
plot(bal.mult, metric = "ASD")
plot(bal.mult, metric = "PSD")
#IPW
ate.mult <- PSweight(ps.formula = ps.mult, yname = 'y', data = df, weight = 'IPW')
contrasts.mult <- rbind(c(1, -1, 0, 0, 0), c(1, 0, -1, 0, 0), c(1, 0, 0, -1, 0), c(1, 0, 0, 0, -1),
c(0, 1, -1, 0, 0), c(0, 1, 0, -1, 0), c(0, 1, 0, 0, -1), c(0, 0, 1, -1, 0),
c(0, 0, 1, 0, -1), c(0, 0, 0, 1, -1))
sum.ate.mult.rr <- summary(ate.mult, type = 'RR', contrast = contrasts.mult)
exp(sum.ate.mult.rr$estimates[, c(1, 4, 5)])
exp(sum.ate.mult.rr$estimates[, 5])-exp(sum.ate.mult.rr$estimates[, 4])
#GOW
ato.mult <- PSweight(ps.formula = ps.mult, yname = 'y', data = df, weight = 'overlap')
sum.ato.mult.rr <- summary(ato.mult, type = 'RR', contrast = contrasts.mult)
exp(sum.ato.mult.rr$estimates[, c(1, 4, 5)])
exp(sum.ato.mult.rr$estimates[, 5])-exp(sum.ato.mult.rr$estimates[, 4])
#IPW-aug
out.y <- y ~ Age + AdmType + SOFA + Gender
ate.mult.aug <- PSweight(ps.formula = ps.mult, yname = 'y', data = df, augmentation = T,
out.formula = out.y, family = 'binomial', weight='IPW')
sum.ate.mult.aug.rr <- summary(ate.mult.aug, type='RR', contrast=contrasts.mult)
exp(sum.ate.mult.aug.rr$estimates[, c(1, 4, 5)])
exp(sum.ate.mult.aug.rr$estimates[, 5])-exp(sum.ate.mult.aug.rr$estimates[, 4])
#GOW-aug
ato.mult.aug <- PSweight(ps.formula = ps.mult, yname = 'y', data = df, augmentation = T,
out.formula = out.y, family = 'binomial')
sum.ato.mult.aug.rr <- summary(ato.mult.aug, type='RR', contrast=contrasts.mult)
exp(sum.ato.mult.aug.rr$estimates[, c(1, 4, 5)])
exp(sum.ato.mult.aug.rr$estimates[, 5])-exp(sum.ato.mult.aug.rr$estimates[, 4])
############################Using Propensity Weighting with Super Learning Method#######################################
library(sl3)
