###############################################################
# 1. Setup
###############################################################

# Clear workspace
rm(list = ls())
gc()

# Load required packages
library(haven)
library(dplyr)
library(ggplot2)
library(survey)
library(MASS)
library(glmmTMB)
library(pscl)
library(car)
library(DHARMa)
library(performance)
library(ggeffects)
library(broom)
library(broom.mixed)
library(patchwork)
library(forcats)
library(stringr)
###############################################################
# 2. Data Import
###############################################################

data <- read_dta(
  "E:/ChildSurvival_Paper1/analysis/EDHS2019_u5death_motherlevel.dta"
)
###############################################################
# 3. Data Preparation
###############################################################

data <- data %>%
  mutate(
    
    region = factor(
      v024,
      levels = 1:11,
      labels = c(
        "Tigray",
        "Afar",
        "Amhara",
        "Oromia",
        "Somali",
        "Benishangul-Gumuz",
        "SNNPR",
        "Gambela",
        "Harari",
        "Addis Ababa",
        "Dire Dawa"
      )
    ),
    
    residence = factor(
      v025,
      levels = c(1,2),
      labels = c("Urban","Rural")
    ),
    
    education = factor(
      v106,
      levels = c(0,1,2,3),
      labels = c(
        "No education",
        "Primary",
        "Secondary",
        "Higher"
      )
    ),
    
    wealth = factor(
      v190,
      levels = 1:5,
      labels = c(
        "Poorest",
        "Poorer",
        "Middle",
        "Richer",
        "Richest"
      )
    ),
    
    delivery_place = factor(
      m15,
      levels = c(
        11,12,21,22,23,26,
        31,32,41,46,96
      ),
      labels = c(
        "Respondent home",
        "Other home",
        "Government hospital",
        "Government health center",
        "Government health post",
        "Other public facility",
        "Private hospital",
        "Private clinic",
        "NGO facility",
        "Other private facility",
        "Other"
      )
    ),
    
    birth_interval_cat = case_when(
      
      b11 < 24 ~ "<24 months",
      
      b11 >=24 & b11 <36 ~ "24–35 months",
      
      b11 >=36 ~ "≥36 months",
      
      TRUE ~ NA_character_
      
    ),
    
    birth_interval_cat = factor(
      
      birth_interval_cat,
      
      levels=c(
        "≥36 months",
        "24–35 months",
        "<24 months"
      )
      
    ),
    
    weight = v005/1000000
    
  )
###############################################################
# 4. Survey Design
###############################################################

###############################################################
# 4. Survey Design
###############################################################

dhs_design <- svydesign(
  
  ids = ~v021,
  
  strata = ~v022,
  
  weights = ~weight,
  
  data = data,
  
  nest = TRUE
  
)

###############################################################
# Survey Design Summary
###############################################################

summary(dhs_design)

length(unique(data$v021))

length(unique(data$v022))
###############################################################
# 5.1 Survey-weighted Outcome Summary
###############################################################

# Overall weighted mean

svymean(
  ~u5death,
  dhs_design
)

# Mean by region

svyby(
  ~u5death,
  ~region,
  dhs_design,
  svymean,
  vartype = "ci"
)

# Mean by household wealth

svyby(
  ~u5death,
  ~wealth,
  dhs_design,
  svymean,
  vartype = "ci"
)
###############################################################
# 5.2 Survey-weighted Sample Characteristics
###############################################################

weighted_distribution <- function(variable){
  
  round(
    
    prop.table(
      
      svytable(variable, dhs_design)
      
    ) * 100,
    
    1
    
  )
  
}
weighted_distribution(~residence)

weighted_distribution(~education)

weighted_distribution(~wealth)

weighted_distribution(~region)

weighted_distribution(~delivery_place)
svytable(~residence, dhs_design)

svytable(~education, dhs_design)

svytable(~wealth, dhs_design)

svytable(~region, dhs_design)

svytable(~delivery_place, dhs_design)
###############################################################
# 5.3 Outcome Distribution
###############################################################

table(data$u5death)

prop.table(
  table(data$u5death)
) * 100

summary(data$u5death)

mean(data$u5death)

var(data$u5death)
###############################################################
# 5.4 Survey Design Characteristics
###############################################################

# Number of observations

nrow(data)

# Number of clusters

length(unique(data$v021))

# Number of strata

length(unique(data$v022))
cluster_size <- data %>%
  group_by(v021) %>%
  summarise(
    Cluster_Size = n(),
    .groups = "drop"
  )

summary(cluster_size$Cluster_Size)
###############################################################
# 6.1 Distribution of the Outcome
###############################################################

ggplot(data, aes(x=u5death)) +
  
  geom_histogram(
    binwidth=1,
    fill="#2C7FB8",
    color="black"
  ) +
  
  labs(
    title="Distribution of Under-Five Deaths per Mother",
    x="Number of Under-Five Deaths per Mother",
    y="Frequency"
  ) +
  
  theme_classic(base_size=12)
###############################################################
# 6.2 Regional Variation
###############################################################

region_summary <- svyby(
  ~u5death,
  ~region,
  dhs_design,
  svymean,
  vartype="ci"
)

ggplot(region_summary,
       aes(x=reorder(region,u5death), y=u5death)) +
  
  geom_point(size=4, color="#8B0000") +
  
  geom_errorbar(
    aes(ymin=ci_l, ymax=ci_u),
    width=0.2
  ) +
  
  coord_flip() +
  
  labs(
    title="Regional Variation in Under-Five Mortality in Ethiopia",
    x="Region",
    y="Mean Under-Five Deaths per Mother (95% CI)"
  ) +
  
  theme_classic(base_size=12)
###############################################################
# 7.1.1 Assessment of Overdispersion
###############################################################

mean(data$u5death)

var(data$u5death)

dispersion_ratio <-
  
  var(data$u5death) /
  mean(data$u5death)
pois_model <-
  
  glm(
    
    u5death ~
      
      region +
      residence +
      wealth +
      education +
      v012 +
      birth_interval_cat +
      m14 +
      delivery_place +
      offset(log(exposure)),
    
    family = poisson,
    
    data = data
    
  )
pearson_dispersion <-
  
  sum(
    
    residuals(
      pois_model,
      type = "pearson"
    )^2
    
  ) /
  
  df.residual(pois_model)

pearson_dispersion
###############################################################
# 7.1.2 Assessment of Excess Zeros
###############################################################

nb_model_dharma <-
  
  glmmTMB(
    
    u5death ~
      
      region +
      residence +
      wealth +
      education +
      v012 +
      birth_interval_cat +
      m14 +
      delivery_place +
      offset(log(exposure)),
    
    family = nbinom2,
    
    data = data
    
  )
sim_nb <-
  
  simulateResiduals(
    
    nb_model_dharma,
    
    plot = FALSE
    
  )

testZeroInflation(sim_nb)
## 8.6 Multicollinearity
###############################################################

library(car)

vif_results <-
  
  vif(nb_model)

vif_results
adj_gvif <-
  
  if(is.matrix(vif_results)){
    
    data.frame(
      
      Variable=rownames(vif_results),
      
      GVIF=vif_results[,1],
      
      Df=vif_results[,2],
      
      Adjusted_GVIF=
        
        vif_results[,1]^(1/(2*vif_results[,2]))
      
    )
    
  }else{
    
    data.frame(
      
      Variable=names(vif_results),
      
      Adjusted_GVIF=vif_results
      
    )
    
  }

adj_gvif
## 8.5 Vuong Test
###############################################################

library(pscl)

zinb_model <-
  
  zeroinfl(
    
    u5death ~
      
      region +
      
      residence +
      
      wealth +
      
      education +
      
      v012 +
      
      birth_interval_cat +
      
      m14 +
      
      delivery_place +
      
      offset(log(exposure))
    
    |
      
      1,
    
    dist="negbin",
    
    data=data
    
  )

vuong(
  nb_model,
  zinb_model
)
###############################################################
###############################################################
## 8.3 Candidate Models
###############################################################

library(MASS)

## Negative Binomial

nb_model <-
  
  glm.nb(
    
    u5death ~
      
      region +
      
      residence +
      
      wealth +
      
      education +
      
      v012 +
      
      birth_interval_cat +
      
      m14 +
      
      delivery_place +
      
      offset(log(exposure)),
    
    data=data
    
  )

## Survey-weighted Quasi-Poisson

library(survey)

qp_model <-
  
  svyglm(
    
    u5death ~
      
      region +
      
      residence +
      
      wealth +
      
      education +
      
      v012 +
      
      birth_interval_cat +
      
      m14 +
      
      delivery_place +
      
      offset(exposure),
    
    design=dhs_design,
    
    family=quasipoisson(link="log")
    
  )

## Multilevel NB

multilevel_nb <-
  
  glmmTMB(
    
    u5death ~
      
      region +
      
      residence +
      
      wealth +
      
      education +
      
      v012 +
      
      birth_interval_cat +
      
      m14 +
      
      delivery_place +
      
      offset(log(exposure)) +
      
      (1|v021),
    
    family=nbinom2,
    
    data=data
    
  )
# Predicted Mortality by region
pred_region <- ggpredict(qp_model, terms="region")

ggplot(pred_region,
       aes(x=x, y=predicted)) +
  
  geom_point(size=3, color="purple") +
  
  geom_errorbar(
    aes(ymin=conf.low, ymax=conf.high),
    width=.2
  ) +
  
  coord_flip() +
  
  labs(
    title="Predicted Under-Five Mortality by Region",
    x="Region",
    y="Predicted Deaths per Mother (95% CI)"
  ) +
  
  theme_classic(base_size=13)

#Forest plot using IRR

library(broom)
library(dplyr)
library(stringr)
library(ggplot2)

forest_data <- tidy(qp_model, exponentiate = TRUE, conf.int = TRUE)

forest_data <- forest_data %>%
  filter(term != "(Intercept)") %>%
  
  # Remove variable names and keep only category labels
  mutate(term = str_replace(term, "region", ""),
         term = str_replace(term, "residence", ""),
         term = str_replace(term, "wealth", ""),
         term = str_replace(term, "education", ""),
         term = str_replace(term, "delivery_place", ""),
         term = str_replace(term, "m14", ""),
         term = str_replace(term, "b11", ""),
         term = str_replace(term, "v012", "")) %>%
  
  mutate(term = str_trim(term))  # remove extra spaces

ggplot(forest_data,
       aes(x = estimate,
           y = reorder(term, estimate))) +
  
  geom_point(size = 3, color = "darkblue") +
  
  geom_errorbarh(
    aes(xmin = conf.low, xmax = conf.high),
    height = .2
  ) +
  
  # Decision/reference line at IRR = 1
  geom_vline(xintercept = 1,
             linetype = "dashed",
             color = "red") +
  
  # Add x-axis scale labels including decision point
  scale_x_continuous(
    breaks = seq(0, 6, by = 1)
  ) +
  
  labs(
    title = "Adjusted Incidence Rate Ratios For Under-Five Mortality",
    
    subtitle = paste(
      "Reference categories: Tigray, Urban,",
      "Poorest, No education,",
      "and Respondent home"
    ),
    
    x = "Incidence Rate Ratio (IRR)",
    y = "Predictors"
  ) +
  
  theme_classic(base_size = 11)
#Birt interval Risk curve
library(ggeffects)
library(ggplot2)

# Predicted values from final model
pred_interval <- ggpredict(
  qp_model,
  terms = "birth_interval_cat"
)

# Ensure ordering
pred_interval$x <- factor(
  pred_interval$x,
  levels = c("≥36 months",
             "24–35 months",
             "<24 months")
)

ggplot(pred_interval,
       aes(x = x,
           y = predicted,
           group = 1)) +
  
  # Confidence band
  geom_ribbon(
    aes(ymin = conf.low,
        ymax = conf.high),
    alpha = 0.18,
    fill = "pink"
  ) +
  
  # Trend line
  geom_line(
    colour = "red",
    linewidth = 1.2
  ) +
  
  # Predicted means
  geom_point(
    colour = "red",
    size = 4
  ) +
  
  labs(
    title = "Predicted under-five child death rates",
    subtitle = "Predicted mortality by WHO-recommended birth interval categories",
    x = "Preceding Birth Interval",
    y = "Predicted Deaths per Mother"
  ) +
  
  coord_cartesian(
    ylim = c(0.02,
             max(pred_interval$conf.high) * 1.05)
  ) +
  
  theme_classic(base_size = 11) +
  
  theme(
    plot.title = element_text(face = "bold"),
    plot.subtitle = element_text(size = 10),
    axis.title = element_text(face = "bold"),
    axis.text = element_text(size = 10)
  )

#Marginal effect plot of maternal age

library(ggeffects)

pred_age <- ggpredict(qp_model, terms="v012 [all]")

ggplot(pred_age,
       aes(x=x, y=predicted)) +
  
  geom_line(size=1.2, color="darkblue") +
  
  geom_ribbon(
    aes(ymin=conf.low, ymax=conf.high),
    alpha=0.2,
    fill="lightblue"
  ) +
  
  labs(
    title="Marginal Effect of Maternal Age on Under-Five Mortality",
    x="Maternal Age (years)",
    y="Predicted Under-Five Deaths per Mother"
  ) +
  
  theme_classic(base_size=13)
# Model Diagnostiocs
summary(qp_model)$dispersion
##########################################################
## Observed vs Predicted
##########################################################

model_data <- model.frame(qp_model)

pred <- predict(
  qp_model,
  type="response"
)

obs <- model.response(model_data)

plot(
  
  pred,
  
  obs,
  
  pch=16,
  
  xlab="Predicted counts",
  
  ylab="Observed counts"
  
)

abline(0,1,col="red")
abline(
  0,
  1,
  col = "red",
  lwd = 2
) 
pearson <- residuals(
  qp_model,
  type = "pearson"
)

library(ggplot2)

data.frame(
  Pred=fitted(qp_model),
  Residual=pearson
) |>
  
  ggplot(aes(Pred,Residual))+
  
  geom_point(alpha=.5)+
  
  geom_smooth(se=FALSE)+
  
  geom_hline(yintercept=0,lty=2)
abline(
  h = 0,
  lty = 2,
  col = "red"
)
dev <- residuals(
  qp_model,
  type = "deviance"
)

plot(
  fitted(qp_model),
  dev,
  pch=16
)

abline(
  h = 0,
  lty = 2
)
std.res <- rstandard(qp_model)

plot(
  std.res,
  pch = 16
)

abline(
  h = c(-3,3),
  col = "red",
  lty = 2
)

which(abs(std.res) > 3)
cook <- cooks.distance(qp_model)

plot(
  cook,
  type = "h",
  ylab = "Cook's distance"
)

abline(
  h = 4/length(cook),
  col = "red"
)
length(pred)

length(data$u5death)
## Dataset actually used by svyglm
model_data <- model.frame(qp_model)

## Observed outcome
Observed <- model.response(model_data)

## Predicted values
Predicted <- predict(qp_model, type = "response")

length(Observed)
length(Predicted)
diag_df <- data.frame(
  Observed = Observed,
  Predicted = Predicted
)

head(diag_df)
library(ggplot2)

ggplot(diag_df,
       aes(x = Predicted, y = Observed)) +
  
  geom_point(alpha = 0.4) +
  
  geom_smooth(method = "loess", se = FALSE) +
  
  geom_abline(intercept = 0,
              slope = 1,
              colour = "red") +
  
  labs(
    x = "Predicted counts",
    y = "Observed counts"
  ) +
  
  theme_classic()
###############################################################
## 8.4 Likelihood-based Model Comparison
###############################################################

comparison <-
  
  data.frame(
    
    Model=
      
      c(
        
        "Negative Binomial",
        
        "Multilevel Negative Binomial"
        
      ),
    
    LogLikelihood=
      
      c(
        
        logLik(nb_model),
        
        logLik(multilevel_nb)
        
      ),
    
    AIC=
      
      c(
        
        AIC(nb_model),
        
        AIC(multilevel_nb)
        
      ),
    
    BIC=
      
      c(
        
        BIC(nb_model),
        
        BIC(multilevel_nb)
        
      )
    
  )

comparison
anova(
  nb_model_dharma,
  multilevel_nb
)
library(performance)

icc(multilevel_nb)
DHARMa::testZeroInflation()

library(broom)
library(broom.mixed)

qp_results <-
  tidy(
    qp_model,
    exponentiate = TRUE,
    conf.int = TRUE
  )

nb_results <-
  tidy(
    nb_model,
    exponentiate = TRUE,
    conf.int = TRUE
  )

ml_results <-
  tidy(
    multilevel_nb,
    effects = "fixed",
    exponentiate = TRUE,
    conf.int = TRUE
  )
comparison <- data.frame(
  
  Model = c(
    "Survey-weighted Quasi-Poisson",
    "Negative Binomial",
    "Multilevel Negative Binomial"
  ),
  
  AIC = c(
    NA,
    AIC(nb_model),
    AIC(multilevel_nb)
  ),
  
  BIC = c(
    NA,
    BIC(nb_model),
    BIC(multilevel_nb)
  )
  
)

comparison
library(dplyr)

qp_sig <-
  qp_results %>%
  dplyr::filter(p.value < 0.05) %>%
  dplyr::select(term, estimate, p.value)
print(qp_sig)
nb_sig <-
  nb_results %>%
  dplyr::filter(p.value < 0.05) %>%
  dplyr::select(term, estimate, p.value)
print(nb_sig)
ml_sig <-
  ml_results %>%
  dplyr::filter(p.value < 0.05) %>%
  dplyr::select(term, estimate, p.value)
print(ml_sig)