#----------------------------------------------------------------------------------------------------------------
# 
#       A Comparison of Covariate Adjustment Approaches under Model Misspecification 
#                   in Individually Randomized Trials: Additional Files 
# 
#
#   This R file contains functions which analyse the datasets in the simulations 
#               
#----------------------------------------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# Continuous Outcome
#-------------------------------------------------------------------------------

# Unadjusted
fttest <- function(indata, outcome, treat){
  
  # Form of outcome model (outcome depends only on treatment)
  form.y <- as.formula(paste(outcome, "~", treat))
  
  # Fit simple linear regression model 
  fit_ttest <- lm(form.y, data=indata)
  
  # Estimate, SE, t and p are contained in object: summary(fit_ttest)$coefficients 
  res_ttest <- data.frame("ttest_diff" = fit_ttest$coefficients[2],
                          "ttest_se"   = summary(fit_ttest)$coefficients[2, 2],
                          "ttest_cl"   = fit_ttest$coef[2]-qt(0.975,fit_ttest$df.residual)*summary(fit_ttest)$coefficients[2, 2],
                          "ttest_cu"   = fit_ttest$coef[2]+qt(0.975,fit_ttest$df.residual)*summary(fit_ttest)$coefficients[2, 2],
                          "ttest_p"    = summary(fit_ttest)$coefficients[2, 4])
  
  # Return matrix containing estimate, SE, CI and p
  return(res_ttest)
}

# ANCOVA
fancova <- function(indata, outcome, treat, covariate){
  # Typical use: fancova(dataname, "y1", "treat", "x")

  # Form of outcome model (outcome depends linearly on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+", covariate))
  
  # Fit linear regression model
  fit_ancova <- lm(form.y, data=indata)
  
  # Pick up estimate, SE, t and p 
  res_ancova <- data.frame("ancova_diff" = fit_ancova$coef[2],
                           "ancova_se"   = summary(fit_ancova)$coefficients[2, 2],
                           "ancova_cl"   = fit_ancova$coef[2]-qt(0.975, fit_ancova$df.residual)*summary(fit_ancova)$coefficients[2, 2],
                           "ancova_cu"   = fit_ancova$coef[2]+qt(0.975, fit_ancova$df.residual)*summary(fit_ancova)$coefficients[2, 2], 
                           "ancova_p"    = summary(fit_ancova)$coefficients[2, 4])
  
  # Return matrix containing estimate, SE, CI and p
  return(res_ancova)
}

# Spline
fspline <- function(indata, outcome, treat, covariate, df){
# Typical use: fspline(dataname, "y1", "treat", "x", 6)

  # Form of outcome model (outcome depends linearly on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+ ns(", covariate, ", df=", df, ")"))
  
  # Fit linear regression model
  fit_spline <- lm(form.y, data=indata)
  
  # Pick up estimate, SE, t and p 
  res_spline <- data.frame("spline_diff" = fit_spline$coef[2],
                           "spline_se"   = sqrt(diag(vcov(fit_spline)))[2],
                           "spline_cl"   = fit_spline$coef[2]-qt(0.975, fit_spline$df.residual)*sqrt(diag(vcov(fit_spline)))[2],
                           "spline_cu"   = fit_spline$coef[2]+qt(0.975, fit_spline$df.residual)*sqrt(diag(vcov(fit_spline)))[2], 
                           "spline_p"    = 2*(1-pnorm(abs(fit_spline$coef[2]/sqrt(diag(vcov(fit_spline)))[2]))))
  
  # Return matrix containing estimate, SE, CI and p
  return(res_spline)
}

# Correct regression model
fcorrect <- function(indata, outcome, treat, covariate){#
  
  # Typical use: fcorrect(dataname, "y1", "treat", "x")
  
  # NOTE: Assume outcomes drawn from y1 model have names beginning with y1
  
  # Form of outcome model 
  if (substring(outcome, 1, 2)=="y1") {
    form.y = as.formula(paste0(outcome, "~", treat, "+ ", covariate))
  }
  else if (substring(outcome, 1, 2) %in% c("y2", "y4", "y5")) {
    form.y = as.formula(paste0(outcome, "~", treat, "+", covariate, "+ I(", covariate, "**2)"))
  }
  else if (substring(outcome, 1, 2)=="y3") {
    form.y = as.formula(paste0(outcome, "~", treat, "+ exp(-", covariate, ")"))
  }  
  else if (substring(outcome, 1, 2)=="y6") {
    form.y = as.formula(paste(outcome, "~", treat, "+ cos(2*pi*3*", covariate, "*0.15) + sin(2*pi*3*", covariate, "*0.15)"))
  }     
  else if (substring(outcome, 1, 2)=="y7") {
    form.y = as.formula(paste0(outcome, "~", treat, "+ I(", covariate, ">0)"))
  }
  
  
  # Fit linear regression model
  fit_correct <- lm(form.y, data=indata)
  
  # Pick up estimate, SE, t and p 
  res_correct <- data.frame("correct_diff" = fit_correct$coef[2],
                            "correct_se"   = summary(fit_correct)$coefficients[2, 2],
                            "correct_cl"   = fit_correct$coef[2]-qt(0.975, fit_correct$df.residual)*summary(fit_correct)$coefficients[2, 2],
                            "correct_cu"   = fit_correct$coef[2]+qt(0.975, fit_correct$df.residual)*summary(fit_correct)$coefficients[2, 2], 
                            "correct_p"    = summary(fit_correct)$coefficients[2, 4])
  
  # Return matrix containing estimate, SE, CI and p
  return(res_correct)
}

# IPTW
fiptw <- function(indata, outcome, treat, covariate){
  # Typical use: fiptw(dataname, "y1", "treat", "x")

  # Form of PS model (treatment depends on single covariate)
  form.ps <- as.formula(paste(treat, "~", covariate))
  
  # Obtain IPTW estimate
  fit_iptw <- psw(data = indata, form.ps = form.ps, 
                  weight = "ATE", wt = TRUE, 
                  out.var = outcome,
                  family = "gaussian")
  fit_W <- as.numeric(summary(fit_iptw$W))
  
  # Pick up estimate, SE, t and p 
  res_iptw <- data.frame("iptw_diff" = fit_iptw$est.wt,
                         "iptw_se"   = fit_iptw$std.wt,
                         "iptw_cl"   = fit_iptw$est.wt - qnorm(0.975)*fit_iptw$std.wt,
                         "iptw_cu"   = fit_iptw$est.wt + qnorm(0.975)*fit_iptw$std.wt,
                         "iptw_p"    = 2*(1-pnorm(abs(fit_iptw$est.wt/fit_iptw$std.wt))), 
                         "w_min" = fit_W[1],
                         "w_1q" = fit_W[2], 
                         "w_median" = fit_W[3], 
                         "w_mean" = fit_W[4], 
                         "w_3q" = fit_W[5], 
                         "w_max" = fit_W[6])
  
  # Return matrix containing estimate, SE, CI and p
  return(res_iptw)
}

# IPTW with spline 
fiptw_spline <- function(indata, outcome, treat, covariate){
  # Typical use: fiptw_spline(dataname, "y1", "treat", "x")

  # Form of PS model (treatment depends on single covariate)
  form.ps <- as.formula(paste(treat, "~ ns(", covariate, ", df=4)"))
  
  
  
  # Obtain IPTW estimate with splines 
  fit_iptw <- PSweight(data = indata, ps.formula = form.ps, 
                       weight = "IPW", 
                       yname= outcome,
                       family = "gaussian")
  
  # Pick up estimate, SE, t and p 
  res_iptw <- data.frame("iptw_spline_diff" = summary(fit_iptw)$estimates[1],
                         "iptw_spline_se"   = summary(fit_iptw)$estimates[2],
                         "iptw_spline_cl"   = summary(fit_iptw)$estimates[4],
                         "iptw_spline_cu"   = summary(fit_iptw)$estimates[5],
                         "iptw_spline_p"    = summary(fit_iptw)$estimates[6])
  
  # Return matrix containing estimate, SE, CI and p
  return(res_iptw)
}

# AIPTW
faiptw <- function(indata, outcome, treat, covariate){
  # Typical use: faiptw(dataname, "y1", "treat", "x")

  # Form of PS and outcome models (treatment/outcome depends on single covariate))
  form.ps <- as.formula(paste(treat,   "~", covariate))
  form.y  <- as.formula(paste(outcome, "~", covariate))
  
  # Fit AIPTW model, with PS and outcome models both depending on single covariate
  fit_aiptw <- psw(data = indata, form.ps = form.ps, 
                   weight = "ATE", aug = TRUE, form.outcome = form.y, 
                   family = "gaussian")
  
  # Pick up estimate, SE, t and p 
  res_aiptw <- data.frame("aiptw_diff" = fit_aiptw$est.aug,
                          "aiptw_se"   = fit_aiptw$std.aug,
                          "aiptw_cl"   = fit_aiptw$est.aug - qnorm(0.975)*fit_aiptw$std.aug,
                          "aiptw_cu"   = fit_aiptw$est.aug + qnorm(0.975)*fit_aiptw$std.aug,
                          "aiptw_p"    = 2*(1-pnorm(abs(fit_aiptw$est.aug/fit_aiptw$std.aug))))
  
  # Return matrix containing estimate, SE, CI and p
  return(res_aiptw)
}

# G-computation, same relationship in each arm
fgcomp <- function(indata, outcome, treat, covariate){
  # Typical use: fgcomp(dataname, "y1", "treat", "x")

  # Pick up treatment variable
  treat <- "treat"
  
  # Form of outcome model (outcome depends linearly on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+", covariate))
  
  # Fit linear regression model, with outcome model depending on single covariate
  fit_gcomp_prelim <- glm(form.y, family=gaussian(link="identity"), data=indata)
  
  # Standardise
  fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat")
  fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0)
  
  # Pick up estimate, SE, t and p 
  res_gcomp <- data.frame("gcomp_diff" = fit_gcomp$est.table[2,1],
                          "gcomp_se"   = fit_gcomp$est.table[2,2],
                          "gcomp_cl"   = fit_gcomp$est.table[2,3],
                          "gcomp_cu"   = fit_gcomp$est.table[2,4], 
                          "gcomp_p"    = 2*(1-pnorm(abs(fit_gcomp$est.table[2,1]/fit_gcomp$est.table[2,2]))))
  
  # Return matrix containing estimate, SE, CI and p
  return(res_gcomp)
}


#G-computation, Different covariate-outcome relationship in each arm
fgcomp_int <- function(indata, outcome, treat, covariate){
 # Typical use: fgcomp_int(dataname, "y1", "treat", "x")
 
  # Pick up treatment variable
  treat <- "treat"
  
  # Form of outcome model (outcome depends linearly on treatment and single covariate)
  form.y <- as.formula(paste0(outcome, " ~ ", treat, "*", covariate))
  
  # Fit linear regression model, with outcome model depending on single covariate
  fit_gcomp_prelim <- glm(form.y, family=gaussian(link="identity"), data=indata)
  
  # Standardise
  fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat")
  fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0)
  
  # Pick up estimate, SE, t and p 
  res_gcomp <- data.frame("gcomp_int_diff" = fit_gcomp$est.table[2,1],
                          "gcomp_int_se"   = fit_gcomp$est.table[2,2],
                          "gcomp_int_cl"   = fit_gcomp$est.table[2,3],
                          "gcomp_int_cu"   = fit_gcomp$est.table[2,4], 
                          "gcomp_int_p"    = 2*(1-pnorm(abs(fit_gcomp$est.table[2,1]/fit_gcomp$est.table[2,2]))))
  
  # Return matrix containing estimate, SE, CI and p
  return(res_gcomp)
}

#G-computation,  Different covariate-outcome relationship in each arm with splines
fgcomp_int_spline <- function(indata, outcome, treat, covariate){
  # Typical use: fgcomp_int_spline(dataname, "y1", "treat", "x")
  
  # Pick up treatment variable
  treat <- "treat"
  
  # Form of outcome model (outcome depends linearly on treatment and single covariate)
  form.y <- as.formula(paste0(outcome, " ~ ", treat, "* ns(", covariate, ", df=4)"))
  
  # Fit linear regression model, with outcome model depending on single covariate
  fit_gcomp_prelim <- glm(form.y, family=gaussian(link="identity"), data=indata)
  
  # Standardise
  fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat")
  fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0)
  
  # Pick up estimate, SE, t and p 
  res_gcomp <- data.frame("gcomp_int_spline_diff" = fit_gcomp$est.table[2,1],
                          "gcomp_int_spline_se"   = fit_gcomp$est.table[2,2],
                          "gcomp_int_spline_cl"   = fit_gcomp$est.table[2,3],
                          "gcomp_int_spline_cu"   = fit_gcomp$est.table[2,4], 
                          "gcomp_int_spline_p"    = 2*(1-pnorm(abs(fit_gcomp$est.table[2,1]/fit_gcomp$est.table[2,2]))))
  
  # Return matrix containing estimate, SE, CI and p
  return(res_gcomp)
}

# TMLE 
ftmle <- function(indata, outcome, treat, covariate, SL){
  # Typical use: ftmle(dataname, "y1", "treat", "x", "No")
  # SL options are "No" or "Yes"
  
  
  if (SL=="No"){
    # Pick up variables containing outcome, treatment and covariate
    Y <- indata[, outcome]
    A <- indata[, treat]
    W <-  matrix(cbind(indata[, covariate], indata[, covariate]), ncol=2)
    colnames(W) <- c("W1", "W2")
    
    
    # Obtain TMLE estimate (no super learner) 
    rtmle <- tmle(Y, A, W, family="gaussian", Qform = Y ~ A + W1, gform = A ~ W1)
    # Pick up estimate, SE, t and p 
    res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE)))
    names(res_tmle) <- c("tmle_diff","tmle_se","tmle_cl","tmle_cu","tmle_p")
    res_tmle$tmle_se <- sqrt(res_tmle$tmle_se)
  }
  
  if (SL=="Yes"){
    # Pick up variables containing outcome, treatment and covariate
    Y <- indata[, outcome]
    A <- indata[, treat]
    W <- cbind(indata[, covariate], indata[, covariate])
    
    # Obtain TMLE estimate (with super learner) 
    rtmle <- tmle(Y, A, W, family="gaussian", automate=TRUE)
    # Pick up estimate, SE, t and p 
    res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE)))
    names(res_tmle) <- c("tmle_SL_diff","tmle_SL_se","tmle_SL_cl","tmle_SL_cu","tmle_SL_p")
    res_tmle$tmle_SL_se <- sqrt(res_tmle$tmle_SL_se)
  }
  
  # Return matrix containing estimate, SE, CI and p
  return(res_tmle)
}

#TMLE with more than one covariate 
ftmle_mult <- function(indata, outcome, treat, covariate, SL){
  # Typical use: ftmle_mult(dataname, "y1", "treat", "x", "No")
  # SL options are "No" or "Yes"
  
  # Pick up variables containing outcome, treatment and covariate
  Y <- indata[, outcome]
  A <- indata[, treat]
  W <- indata[, covariate]
  
  # Obtain list of covariates in W
  names <- names(W)
  nameslist <- paste(as.character(names), sepby="+", collapse=" ")
  covlist <- substr(nameslist, 1, nchar(nameslist) - 1)
  
  # Model forms for outcome and treatment
  form.y <- as.formula(paste("Y ~ A + ", covlist))
  form.ps <- as.formula(paste("A ~ ", covlist))
  
  
  if (SL=="No"){
    # Obtain TMLE estimate (no super learner) 
    rtmle <- tmle(Y, A, W, family="gaussian", Qform = form.y, gform = form.ps)
    # Pick up estimate, SE, t and p 
    res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE)))
    names(res_tmle) <- c("tmle_diff","tmle_se","tmle_cl","tmle_cu","tmle_p")
    res_tmle$tmle_se <- sqrt(res_tmle$tmle_se)
  }
  
  if (SL=="Yes"){
    # Obtain TMLE estimate (with super learner) 
    rtmle <- tmle(Y, A, W, family="gaussian", automate=TRUE)
    # Pick up estimate, SE, t and p 
    res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE)))
    names(res_tmle) <- c("tmle_SL_diff","tmle_SL_se","tmle_SL_cl","tmle_SL_cu","tmle_SL_p")
    res_tmle$tmle_SL_se <- sqrt(res_tmle$tmle_SL_se)
  }
  
  # Return matrix containing estimate, SE, CI and p
  return(res_tmle)
}


#------------------------------------------------------------------------------
#Binary outcome
#------------------------------------------------------------------------------

# Unadjusted--------------------------------- 

### Odds ratio
f_or <- function(indata, outcome, treat){
  # Typical use: f_or(data, "y1", "treat")

  # Form of outcome model (outcome depends only on treatment)
  form.y <- as.formula(paste(outcome, "~", treat))
  
  # Fit simple GLM 
  lnor_fit_unadj <- glm(form.y, data=indata, family=binomial(link="logit"), start=c(-0.2, 0))
  
  # Extract estimate (log OR), SE, t and p 
  lnor_res_unadj <- data.frame("lnor_unadj_diff" = lnor_fit_unadj$coefficients[2],
                               "lnor_unadj_se"   = summary(lnor_fit_unadj)$coefficients[2, 2],
                               "lnor_unadj_cl"   = lnor_fit_unadj$coef[2]-qnorm(0.975)*summary(lnor_fit_unadj)$coefficients[2, 2],
                               "lnor_unadj_cu"   = lnor_fit_unadj$coef[2]+qnorm(0.975)*summary(lnor_fit_unadj)$coefficients[2, 2],
                               "lnor_unadj_p"    = summary(lnor_fit_unadj)$coefficients[2, 4], 
                               "scale"           = "log")
  
  # Return matrix containing estimate, SE, CI and p
  return(lnor_res_unadj)
}

### Risk ratio
f_rr <- function(indata, outcome, treat){
 # Typical use: f_rr(data, "y1", "treat")
 
  # Form of outcome model (outcome depends only on treatment)
  form.y <- as.formula(paste(outcome, "~", treat))
  
  # Fit simple GLM 
  lnrr_fit_unadj <- glm(form.y, data=indata, family=binomial(link="log"), start=c(-0.2, 0))
  
  # Extract estimate (log RR), SE, t and p 
  lnrr_res_unadj <- data.frame("lnrr_unadj_diff" = lnrr_fit_unadj$coefficients[2],
                               "lnrr_unadj_se"   = summary(lnrr_fit_unadj)$coefficients[2, 2],
                               "lnrr_unadj_cl"   = lnrr_fit_unadj$coef[2]-qnorm(0.975)*summary(lnrr_fit_unadj)$coefficients[2, 2],
                               "lnrr_unadj_cu"   = lnrr_fit_unadj$coef[2]+qnorm(0.975)*summary(lnrr_fit_unadj)$coefficients[2, 2],
                               "lnrr_unadj_p"    = summary(lnrr_fit_unadj)$coefficients[2, 4], 
                               "scale"           = "log")
  
  # Return matrix containing estimate, SE, CI and p
  return(lnrr_res_unadj)
}

### Risk difference
f_rd <- function(indata, outcome, treat){
  # Typical use: f_rd(data, "y1", "treat")

  # Form of outcome model (outcome depends only on treatment)
  form.y <- as.formula(paste(outcome, "~", treat))
  
  # Fit simple GLM 
  rd_fit_unadj <- glm(form.y, data=indata, family=binomial(link="identity"), start=c(0.2, 0.5))
  
  # Extract estimate (log RR), SE, t and p 
  rd_res_unadj <- data.frame("rd_unadj_diff" = rd_fit_unadj$coefficients[2],
                             "rd_unadj_se"   = summary(rd_fit_unadj)$coefficients[2, 2],
                             "rd_unadj_cl"   = rd_fit_unadj$coef[2]-qnorm(0.975)*summary(rd_fit_unadj)$coefficients[2, 2],
                             "rd_unadj_cu"   = rd_fit_unadj$coef[2]+qnorm(0.975)*summary(rd_fit_unadj)$coefficients[2, 2],
                             "rd_unadj_p"    = summary(rd_fit_unadj)$coefficients[2, 4], 
                             "scale"         = "unlog")
  
  # Return matrix containing estimate, SE, CI and p
  return(rd_res_unadj)
}


# Regression adjustment-----------------------

### Assuming linear relationship (on default scale for the parameter)
### Odds ratio

f_aor <- function(indata, outcome, treat, covariate){
  # Typical use: f_aor(data, "y1", "treat", "x")

  # Form of outcome model (outcome depends on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+", covariate))
  
  # Fit linear regression model
  lnor_fit_radj <- glm(form.y, data=indata, family=binomial(link="logit"))
  
  # Pick up estimate, SE, t and p 
  lnor_res_radj <- data.frame("lnor_radj_diff" = lnor_fit_radj$coef[2],
                              "lnor_radj_se"   = summary(lnor_fit_radj)$coefficients[2, 2],
                              "lnor_radj_cl"   = lnor_fit_radj$coef[2]-qnorm(0.975)*summary(lnor_fit_radj)$coefficients[2, 2],
                              "lnor_radj_cu"   = lnor_fit_radj$coef[2]+qnorm(0.975)*summary(lnor_fit_radj)$coefficients[2, 2], 
                              "lnor_radj_p"    = summary(lnor_fit_radj)$coefficients[2, 4],
                              "scale"          = "log")
  
  # Return matrix containing estimate, SE, CI and p
  return(lnor_res_radj)
}

### Risk ratio
f_arr <- function(indata, outcome, treat, covariate){
  # Typical use: f_arr(data, "y1", "treat", "x")

  # Form of outcome model (outcome depends on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+", covariate))
  
  # Fit linear regression model
  lnrr_fit_radj <- glm(form.y, data=indata, family=binomial(link="log"), start=c(-0.2, 0, 0))
  
  # Pick up estimate, SE, t and p 
  if (lnrr_fit_radj$converged==TRUE) {
    lnrr_res_radj <- data.frame("lnrr_radj_diff" = lnrr_fit_radj$coef[2],
                                "lnrr_radj_se"   = summary(lnrr_fit_radj)$coefficients[2, 2],
                                "lnrr_radj_cl"   = lnrr_fit_radj$coef[2]-qnorm(0.975)*summary(lnrr_fit_radj)$coefficients[2, 2],
                                "lnrr_radj_cu"   = lnrr_fit_radj$coef[2]+qnorm(0.975)*summary(lnrr_fit_radj)$coefficients[2, 2], 
                                "lnrr_radj_p"    = summary(lnrr_fit_radj)$coefficients[2, 4],
                                "scale"          = "log")
  }
  else if (lnrr_fit_radj$converged==FALSE) {
    lnrr_res_radj <- data.frame("lnrr_radj_diff" = 9999,
                                "lnrr_radj_se"   = 9999,
                                "lnrr_radj_cl"   = 9999,
                                "lnrr_radj_cu"   = 9999, 
                                "lnrr_radj_p"    = 9999,
                                "scale"          = "log")
    
  }
  # Return matrix containing estimate, SE, CI and p
  return(lnrr_res_radj)
}

### Risk difference
f_ard <- function(indata, outcome, treat, covariate){
 # Typical use: f_ard(data, "y1", "treat", "x")
 
  # Form of outcome model (outcome depends on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+", covariate))
  
  # Fit linear regression model
  rd_fit_radj <- glm(form.y, data=indata, family=binomial(link="identity"), start=c(0.5, 0, 0))
  
  # Extract estimate (log RR), SE, t and p 
  if (rd_fit_radj$converged==TRUE) {
    rd_res_radj <- data.frame("rd_radj_diff" = rd_fit_radj$coef[2],
                              "rd_radj_se"   = summary(rd_fit_radj)$coefficients[2, 2],
                              "rd_radj_cl"   = rd_fit_radj$coef[2]-qnorm(0.975)*summary(rd_fit_radj)$coefficients[2, 2],
                              "rd_radj_cu"   = rd_fit_radj$coef[2]+qnorm(0.975)*summary(rd_fit_radj)$coefficients[2, 2], 
                              "rd_radj_p"    = summary(rd_fit_radj)$coefficients[2, 4],
                              "scale"          = "unlog")
  }
  else if (rd_fit_radj$converged==FALSE) {
    rd_res_radj <- data.frame("rd_radj_diff" = 9999,
                              "rd_radj_se"   = 9999,
                              "rd_radj_cl"   = 9999,
                              "rd_radj_cu"   = 9999, 
                              "rd_radj_p"    = 9999,
                              "scale"          = "unlog")
    
  }
  
  # Return matrix containing estimate, SE, CI and p
  return(rd_res_radj)
}


# Spline--------------------------------------

### Odds ratio
f_or_spline <- function(indata, outcome, treat, covariate, df){
 # Typical use: f_or_spline(data, "y1", "treat", "x", 4)
 
  # Form of outcome model (outcome depends on treatment and spline of single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+ ns(", covariate, ", df=", df, ")"))
  
  # Fit regression model
  lnor_fit_spline <- gam(form.y, family=binomial(link="logit"), data=indata)
  
  # Pick up estimate, SE, t and p 
  lnor_res_spline <- data.frame("lnor_spline_diff" = lnor_fit_spline$coef[2],
                                "lnor_spline_se"   = sqrt(diag(vcov(lnor_fit_spline)))[2],
                                "lnor_spline_cl"   = lnor_fit_spline$coef[2]-qnorm(0.975)*sqrt(diag(vcov(lnor_fit_spline)))[2],
                                "lnor_spline_cu"   = lnor_fit_spline$coef[2]+qnorm(0.975)*sqrt(diag(vcov(lnor_fit_spline)))[2], 
                                "lnor_spline_p"    = 2*(1-pnorm(abs(lnor_fit_spline$coef[2]/sqrt(diag(vcov(lnor_fit_spline))))))[2],
                                "scale"          = "log")
  
  # Return matrix containing estimate, SE, CI and p
  return(lnor_res_spline)
}

# IPTW-----------------------------------------
f_bin_iptw <- function(indata, outcome, treat, covariate){
  # Typical use: f_bin_iptw(data, "y1", "treat", "x")

  # Form of PS model (treatment depends on single covariate)
  form.ps <- as.formula(paste(treat, "~", covariate))
  
  # Obtain IPTW estimate
  fit_iptw <- psw(data = indata, form.ps = form.ps, 
                  weight = "ATE", wt = TRUE, 
                  out.var = outcome,
                  family = "binomial")
  
  # Log odds ratio: Pick up estimate, SE, t and p 
  lnor_res_iptw <- data.frame("lnor_iptw_diff" = fit_iptw$est.lor.wt,
                              "lnor_iptw_se"   = fit_iptw$std.lor.wt,
                              "lnor_iptw_cl"   = fit_iptw$est.lor.wt - qnorm(0.975)*fit_iptw$std.lor.wt,
                              "lnor_iptw_cu"   = fit_iptw$est.lor.wt + qnorm(0.975)*fit_iptw$std.lor.wt,
                              "lnor_iptw_p"    = 2*(1-pnorm(abs(fit_iptw$est.lor.wt/fit_iptw$std.lor.wt))),
                              "scale"          = "log")
  
  # Risk ratio: Pick up estimate, SE, t and p   (NB: Does not do log scale estimation)
  lnrr_res_iptw <- data.frame("lnrr_iptw_diff" = log(fit_iptw$est.rr.wt),
                              "lnrr_iptw_se"   = fit_iptw$std.rr.wt/(fit_iptw$est.rr.wt),
                              "lnrr_iptw_cl"   = log(fit_iptw$est.rr.wt - qnorm(0.975)*fit_iptw$std.rr.wt),
                              "lnrr_iptw_cu"   = log(fit_iptw$est.rr.wt + qnorm(0.975)*fit_iptw$std.rr.wt),
                              "lnrr_iptw_p"    = 2*(1-pnorm(abs(fit_iptw$est.rr.wt/fit_iptw$std.rr.wt))),
                              "scale"          = "unlog")
  
  # Risk difference: Pick up estimate, SE, t and p 
  rd_res_iptw <- data.frame("rd_iptw_diff" = fit_iptw$est.risk.wt,
                            "rd_iptw_se"   = fit_iptw$std.risk.wt,
                            "rd_iptw_cl"   = fit_iptw$est.risk.wt - qnorm(0.975)*fit_iptw$std.risk.wt,
                            "rd_iptw_cu"   = fit_iptw$est.risk.wt + qnorm(0.975)*fit_iptw$std.risk.wt,
                            "rd_iptw_p"    = 2*(1-pnorm(abs(fit_iptw$est.risk.wt/fit_iptw$std.risk.wt))),
                            "scale"          = "unlog")
  
  # Return matrix containing estimate, SE, CI and p
  return(list(lnor_res_iptw, lnrr_res_iptw, rd_res_iptw))
}

# AIPTW----------------------------------------
f_rd_aiptw <- function(indata, outcome, treat, covariate){
  # Typical use: f_rd_aiptw(data, "y1", "treat", "x")

  # Form of PS and outcome models (treatment/outcome depends on single covariate))
  form.ps <- as.formula(paste(treat,   "~", covariate))
  form.y  <- as.formula(paste(outcome, "~", covariate))
  
  # Fit AIPTW model, with PS and outcome models both depending on single covariate
  fit_aiptw <- psw(data = indata, form.ps = form.ps, 
                   weight = "ATE", aug = TRUE, form.outcome = form.y, 
                   family = "binomial")
  
  # Risk difference: Pick up estimate, SE, t and p 
  rd_res_aiptw <- data.frame("rd_aiptw_diff" = fit_aiptw$est.risk.aug,
                             "rd_aiptw_se"   = fit_aiptw$std.risk.aug,
                             "rd_aiptw_cl"   = fit_aiptw$est.risk.aug - qnorm(0.975)*fit_aiptw$std.risk.aug,
                             "rd_aiptw_cu"   = fit_aiptw$est.risk.aug + qnorm(0.975)*fit_aiptw$std.risk.aug,
                             "rd_aiptw_p"    = 2*(1-pnorm(abs(fit_aiptw$est.risk.aug/fit_aiptw$std.risk.aug))),
                             "scale"          = "unlog")
  
  
  # Return matrix containing estimate, SE, CI and p
  return(rd_res_aiptw)
}

# G-computation--------------------------------
f_bin_gcomp <- function(indata, outcome, treat, covariate){
 # Typical use: f_rd_aiptw(f_bin_gcomp, "y1", "treat", "x")
 
  # Pick up treatment variable
  treat <- "treat"
  
  # Form of outcome model (outcome depends linearly on treatment and single covariate)
  form.y <- as.formula(paste(outcome, "~", treat, "+", covariate))
  
  # Fit linear regression model, with outcome model depending on single covariate
  fit_gcomp_prelim <- glm(form.y, family=binomial(link="logit"), data=indata)
  
  # Standardise
  fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat")
  lnor_fit_gcomp <- summary(fit_gcomp_std, transform="logit", contrast="difference", reference=0)
  lnrr_fit_gcomp <- summary(fit_gcomp_std, transform="log",   contrast="difference", reference=0)
  rd_fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0)
  
  # Pick up estimate, SE, t and p 
  lnor_res_gcomp <- data.frame("lnor_gcomp_diff" = lnor_fit_gcomp$est.table[2,1],
                               "lnor_gcomp_se"   = lnor_fit_gcomp$est.table[2,2],
                               "lnor_gcomp_cl"   = lnor_fit_gcomp$est.table[2,3],
                               "lnor_gcomp_cu"   = lnor_fit_gcomp$est.table[2,4], 
                               "lnor_gcomp_p"    = 2*(1-pnorm(abs(lnor_fit_gcomp$est.table[2,1]/lnor_fit_gcomp$est.table[2,2]))),
                               "scale"      = "log")
  
  # Pick up estimate, SE, t and p    
  lnrr_res_gcomp <- data.frame("lnrr_gcomp_diff" = lnrr_fit_gcomp$est.table[2,1],
                               "lnrr_gcomp_se"   = lnrr_fit_gcomp$est.table[2,2],
                               "lnrr_gcomp_cl"   = lnrr_fit_gcomp$est.table[2,3],
                               "lnrr_gcomp_cu"   = lnrr_fit_gcomp$est.table[2,4], 
                               "lnrr_gcomp_p"    = 2*(1-pnorm(abs(lnrr_fit_gcomp$est.table[2,1]/lnrr_fit_gcomp$est.table[2,2]))),
                               "scale"      = "log")
  
  # Pick up estimate, SE, t and p 
  rd_res_gcomp <- data.frame("rd_gcomp_diff"   = rd_fit_gcomp$est.table[2,1],
                             "rd_gcomp_se"   = rd_fit_gcomp$est.table[2,2],
                             "rd_gcomp_cl"   = rd_fit_gcomp$est.table[2,3],
                             "rd_gcomp_cu"   = rd_fit_gcomp$est.table[2,4], 
                             "rd_gcomp_p"    = 2*(1-pnorm(abs(rd_fit_gcomp$est.table[2,1]/rd_fit_gcomp$est.table[2,2]))),
                             "scale"      = "unlog")
  
  # Return matrix containing estimate, SE, CI and p
  return(list(lnor_res_gcomp, lnrr_res_gcomp, rd_res_gcomp))
}

# TMLE----------------------------------------
f_bin_tmle <- function(indata, outcome, treat, covariate){
  # Typical use: f_bin_tmle(f_bin_gcomp, "y1", "treat", "x")

  # Pick up variables containing outcome, treatment and covariate
  Y <- indata[, outcome]
  A <- indata[, treat]
  W <- matrix(cbind(indata[, covariate], indata[, covariate]), ncol=2)
  colnames(W) <- c("W1", "W2")
  
  
  # Obtain TMLE estimate (no super learner) 
  rtmle <- tmle(Y, A, W, family="binomial", Qform = Y ~ A + W1, gform = A ~(W1) )
  
  # Pick up estimate, SE, t and p 
  
  # Risk difference
  rd_res_tmle <- data.frame(cbind(t(unlist(rtmle$estimates$ATE))), "scale"="unlog")
  names(rd_res_tmle) <- c("rd_tmle_diff","rd_tmle_se","rd_tmle_cl","rd_tmle_cu","rd_tmle_p", "scale")
  rd_res_tmle$rd_tmle_se <- sqrt(rd_res_tmle$rd_tmle_se)
  
  # Odds ratio
  lnor_res_tmle <- data.frame(cbind(t(unlist(rtmle$estimates$OR))))
  lnor_res_tmle <- data.frame(cbind(lnor_res_tmle[1,1], lnor_res_tmle[1,6], lnor_res_tmle[1,2:4], "scale"="log"))
  names(lnor_res_tmle) <- c("lnor_tmle_diff","lnor_tmle_se","lnor_tmle_cl","lnor_tmle_cu","lnor_tmle_p", "scale")
  lnor_res_tmle$lnor_tmle_se <- sqrt(lnor_res_tmle$lnor_tmle_se)
  lnor_res_tmle$lnor_tmle_diff <- log(lnor_res_tmle$lnor_tmle_diff)
  lnor_res_tmle$lnor_tmle_cl <- log(lnor_res_tmle$lnor_tmle_cl)
  lnor_res_tmle$lnor_tmle_cu <- log(lnor_res_tmle$lnor_tmle_cu)
  
  # Risk ratio
  lnrr_res_tmle <- data.frame(cbind(t(unlist(rtmle$estimates$RR))))
  lnrr_res_tmle <- data.frame(cbind(lnrr_res_tmle[1,1], lnrr_res_tmle[1,6], lnrr_res_tmle[1,2:4], "scale"="log"))
  names(lnrr_res_tmle) <- c("lnrr_tmle_diff","lnrr_tmle_se","lnrr_tmle_cl","lnrr_tmle_cu","lnrr_tmle_p", "scale")
  lnrr_res_tmle$lnrr_tmle_se <- sqrt(lnrr_res_tmle$lnrr_tmle_se)
  lnrr_res_tmle$lnrr_tmle_diff <- log(lnrr_res_tmle$lnrr_tmle_diff)
  lnrr_res_tmle$lnrr_tmle_cl <- log(lnrr_res_tmle$lnrr_tmle_cl)
  lnrr_res_tmle$lnrr_tmle_cu <- log(lnrr_res_tmle$lnrr_tmle_cu)   
  
  # Return matrix containing estimate, SE, CI and p
  return(list(lnor_res_tmle, lnrr_res_tmle, rd_res_tmle))
}

# CBPS----------------------------------------
fcbps <- function(indata, outcome, treat, covariate){
  # Typical use: fcbps(dataname, "y1", "treat", "x")

  # Form of PS and outcome models (treatment/outcome depends on single covariate))
  form.ps <- as.formula(paste(treat,   "~", covariate))
  form.y  <- as.formula(paste(outcome, "~", treat))
  
  # Estimate the PS, using the covariate-balancing condition
  psfit <- CBPS(form.ps, data = indata, ATT=0, method="exact", standardize = F)
  wt <- psfit$weights
  
  # Obtain the IPTW treatment effect estimate using the weights obtained 
  design.ps <- svydesign(ids=~1, weights = ~wt, data = indata)
  reg_cbps  <- svyglm(form.y, design = design.ps, data = indata, family="gaussian")
  
  # Pick up estimate, SE, t and p 
  res_cbps<-data.frame("cbps_diff"=reg_cbps$coef[2],
                       "cbps_se"=summary(reg_cbps)$coefficients[2, 2],
                       "cbps_cl"=reg_cbps$coef[2]-qt(0.975,reg_cbps$df.residual)*summary(reg_cbps)$coefficients[2, 2],
                       "cbps_cu"=reg_cbps$coef[2]+qt(0.975,reg_cbps$df.residual)*summary(reg_cbps)$coefficients[2, 2], 
                       "cbps_p"=summary(reg_cbps)$coefficients[2, 4])
  
  # Return matrix containing estimate, SE, CI and p
  return(res_cbps)
}





