library(brms)        
library(dplyr)       
library(forcats)      
# install.packages("survival")
library(survival)
# install.packages("haven")
library(haven)

# Install core packages
# install.packages("brms")
# install.packages("rstan")
# install.packages("tidyverse")

library(brms)
#install.packages("bayesplot")
library(bayesplot)
library(rstan)
library(tidyverse)

# Set Stan options
rstan_options(auto_write = TRUE)
options(mc.cores = parallel::detectCores())

# Optional: Install/update tools for compiling Stan models 
# install.packages("cmdstanr", repos = c("https://mc-stan.org/r-packages/", getOption("repos")))
# cmdstanr::install_cmdstan()


mydata <- read_sav("C:/Users/Mahmud Hasan/OneDrive/Desktop/BAYESIAN/Final_dataset2.sav")

mydata <- mydata %>%
  mutate(V005 = as.numeric(V005))
factor_vars <- c(
  "V013", "V024", "V025", "V119", "V121", "V130", "V171A", "V151", "V190", "V714", 
  "V106", "V467D", "M141", "BORD01", "V218", "V159", "V158", "V157", "V155", 
  "Institutional_delivery"
)

mydata <- mydata %>%
  mutate(across(all_of(factor_vars), ~ factor(.)))

mydata <- mydata %>%
  mutate(
    weight_normalized = V005 / 1000000,  # DHS standard normalization
    weight_std = weight_normalized / mean(weight_normalized, na.rm = TRUE)
  )


summary(mydata$weight_std)
length(unique(mydata$weight_std))
head(mydata$weight_std, 20)  # check first 20

# null model
null_formula <- bf(Institutional_delivery ~ 1 + (1 | V001), family = bernoulli())


full_priors <- c(
  prior(normal(0, 2.5), class = "b"),
  prior(student_t(3, 0, 2.5), class = "Intercept"),
  prior(student_t(3, 0, 2.5), class = "sd")
)
full_priors


null_priors <- c(
  prior(student_t(3, 0, 2.5), class = "Intercept"),
  prior(student_t(3, 0, 2.5), class = "sd", group = "V001")
)

mydata_weighted <- mydata[rep(1:nrow(mydata), times = round(mydata$weight_std)), ]

library(future)
plan(multisession, workers = 4)   # 4 chains parallel

null_fit_weighted <- brm(
  formula = null_formula,
  data = mydata_weighted,
  prior = null_priors,
  sample_prior = "yes",
  chains = 4,
  iter = 2000,
  warmup = 1000,
  seed = 123,
  control = list(adapt_delta = 0.95, max_treedepth = 15),
  save_pars = save_pars(all = TRUE),
  backend = "cmdstanr"
)
null_weighted_OR_df <- data.frame(
  OR = null_weighted_OR["Estimate"],
  `2.5% CrI` = null_weighted_OR["Q2.5"],
  `97.5% CrI` = null_weighted_OR["Q97.5"]
)
print(null_weighted_OR_df)

weighted_diagnostics <- summary(null_fit_weighted)
print(weighted_diagnostics$fixed[, c("Rhat", "Bulk_ESS", "Tail_ESS")])
# Posterior predictive check for full model
pp_check(null_fit_weighted)


#Individual model

ind_formula <- bf(Institutional_delivery ~
                    V013 +V714 + V106 + M141 + BORD01 + V218 + V157+ V158 + V159+ V171A+ V155 +
                    (1 | V001), family = bernoulli())

plan(multisession, workers = 4)   # 4 chains parallel

ind_fit_weighted <- brm(
  formula = ind_formula,
  data = mydata_weighted,
  prior = full_priors,
  sample_prior = "yes",
  chains = 4,
  iter = 2000,
  warmup = 1000,
  seed = 123,
  control = list(adapt_delta = 0.95, max_treedepth = 15),
  save_pars = save_pars(all = TRUE),
  backend = "cmdstanr"
)

ind_weighted_coefs <- fixef(ind_fit_weighted, summary = TRUE)

ind_weighted_OR <- exp(ind_weighted_coefs[, c("Estimate", "Q2.5", "Q97.5")])
colnames(ind_weighted_OR) <- c("OR", "2.5% CrI", "97.5% CrI")
ind_weighted_OR_df <- as.data.frame(ind_weighted_OR)
ind_diagnostics <- summary(ind_fit_weighted)
diag_df <- ind_diagnostics$fixed[, c("Rhat", "Bulk_ESS", "Tail_ESS")]
ind_results_df <- cbind(ind_weighted_OR_df, diag_df)
print(ind_results_df)


#Household model

hou_formula <- bf(Institutional_delivery ~ 
                    V119 + V121 + V130 + V151 + V190 + V467D + 
                    (1 | V001), family = bernoulli())

hou_fit_weighted <- brm(
  formula = hou_formula,
  data = mydata_weighted,
  prior = full_priors,
  sample_prior = "yes",
  chains = 4,
  iter = 2000,
  warmup = 1000,
  seed = 123,
  control = list(adapt_delta = 0.95, max_treedepth = 15),
  save_pars = save_pars(all = TRUE),
  backend = "cmdstanr"
)
hou_weighted_coefs <- fixef(hou_fit_weighted, summary = TRUE)

hou_weighted_OR <- exp(hou_weighted_coefs[, c("Estimate", "Q2.5", "Q97.5")])
colnames(hou_weighted_OR) <- c("OR", "2.5% CrI", "97.5% CrI")
hou_weighted_OR_df <- as.data.frame(hou_weighted_OR)
hou_diagnostics <- summary(hou_fit_weighted)
hou_diag_df <- hou_diagnostics$fixed[, c("Rhat", "Bulk_ESS", "Tail_ESS")]
hou_results_df <- cbind(hou_weighted_OR_df, hou_diag_df)
print(hou_results_df)


# Full model
full_formula <- bf(Institutional_delivery ~ 
                     V013 + V025 + V218 + V171A + V130 + V151 + V190 + V714 + V106 + V119 + V121 + V467D + 
                     M141 + BORD01 + V155 + V157 + V158 + V159 + V024 + 
                     (1 | V001), family = bernoulli())


full_fit_weighted <- brm(
  formula = full_formula,
  data = mydata_weighted,
  prior = full_priors,
  sample_prior = "yes",
  chains = 4,
  iter = 2000,
  warmup = 1000,
  seed = 123,
  control = list(adapt_delta = 0.95, max_treedepth = 15),
  save_pars = save_pars(all = TRUE),
  backend = "cmdstanr"
)

full_weighted_coefs <- fixef(full_fit_weighted, summary = TRUE)
full_weighted_OR <- exp(full_weighted_coefs[, c("Estimate", "Q2.5", "Q97.5")])
colnames(full_weighted_OR) <- c("OR", "2.5% CrI", "97.5% CrI")
full_weighted_OR_df <- as.data.frame(full_weighted_OR)
full_diagnostics <- summary(full_fit_weighted)
diag_df <- full_diagnostics$fixed[, c("Rhat", "Bulk_ESS", "Tail_ESS")]
full_results_df <- cbind(full_weighted_OR_df, diag_df)
print(full_results_df)
pp_check(full_fit_weighted)


# Community level model
community_formula <- bf(Institutional_delivery ~ V024 + V025 + (1 | V001), family = bernoulli())

community_fit_weighted <- brm(
  formula = community_formula,
  data = mydata_weighted,
  prior = full_priors,
  sample_prior = "yes",
  chains = 4,
  iter = 2000,
  warmup = 1000,
  seed = 123,
  control = list(adapt_delta = 0.95, max_treedepth = 15),
  save_pars = save_pars(all = TRUE),
  backend = "cmdstanr"
)

comm_weighted_coefs <- fixef(community_fit_weighted, summary = TRUE)

comm_weighted_OR <- exp(comm_weighted_coefs[, c("Estimate", "Q2.5", "Q97.5")])
colnames(comm_weighted_OR) <- c("OR", "2.5% CrI", "97.5% CrI")

comm_weighted_OR_df <- as.data.frame(comm_weighted_OR)

comm_diagnostics <- summary(community_fit_weighted)
comm_diag_df <- comm_diagnostics$fixed[, c("Rhat", "Bulk_ESS", "Tail_ESS")]

comm_results_df <- cbind(comm_weighted_OR_df, comm_diag_df)

print(comm_results_df)


#random effect
library(brms)
library(dplyr)
library(posterior)

extract_RE_table <- function(fit, null_var = NULL) {
  
  draws <- as_draws_df(fit)
  
  sd_draws <- draws$sd_V001__Intercept
  
  var_between <- sd_draws^2
  var_within  <- pi^2 / 3
  
  ICC <- var_between / (var_between + var_within)
  MOR <- exp(0.6745 * sqrt(2 * var_between))
  
  out <- tibble(
    cluster_sd_L  = quantile(sd_draws, 0.025),
    cluster_sd_U  = quantile(sd_draws, 0.975),
    between_var   = median(var_between),
    within_var    = var_within,
    ICC           = median(ICC),
    MOR           = median(MOR)
  )
  
  if (!is.null(null_var)) {
    out$PCV <- (null_var - out$between_var) / null_var * 100
  } else {
    out$PCV <- 0
  }
  
  return(out)
}
null_RE <- extract_RE_table(null_fit_weighted)
null_var <- null_RE$between_var
ind_RE  <- extract_RE_table(ind_fit_weighted, null_var)
hou_RE  <- extract_RE_table(hou_fit_weighted, null_var)
com_RE  <- extract_RE_table(community_fit_weighted, null_var)
full_RE <- extract_RE_table(full_fit_weighted, null_var)


RandomEffects_Table <- bind_rows(
  Null       = null_RE,
  Individual = ind_RE,
  Household  = hou_RE,
  Community  = com_RE,
  Full       = full_RE,
  .id = "Model"
) %>%
  mutate(
    `Cluster Variation` = paste0(
      "[", round(cluster_sd_L, 2), ", ", round(cluster_sd_U, 2), "]"
    ),
    `Between-Cluster Variance` = round(between_var, 4),
    `Within-Cluster Variance`  = round(within_var, 4),
    ICC  = round(ICC, 4),
    MOR  = round(MOR, 4),
    `PCV (%)` = round(PCV, 2)
  ) %>%
  select(
    Model,
    `Cluster Variation`,
    `Between-Cluster Variance`,
    `Within-Cluster Variance`,
    ICC,
    MOR,
    `PCV (%)`
  )

RandomEffects_Table



library(brms)
library(dplyr)
library(posterior)

extract_RE_table <- function(fit, null_var = NULL) {
  
  draws <- as_draws_df(fit)
  
  # Random intercept SD (cluster level)
  sd_draws <- draws$sd_V001__Intercept
  
  var_between <- median(sd_draws^2)        # Between-cluster variance
  var_within  <- pi^2 / 3                  # Logistic within-cluster variance
  
  ICC <- var_between / (var_between + var_within)
  MOR <- exp(0.6745 * sqrt(2 * var_between))
  
  PCV <- if (!is.null(null_var)) {
    round((null_var - var_between) / null_var * 100, 2)
  } else 0
  
  out <- tibble(
    cluster_sd_L  = quantile(sd_draws, 0.025),
    cluster_sd_U  = quantile(sd_draws, 0.975),
    between_var   = var_between,
    within_var    = var_within,
    ICC           = ICC,
    MOR           = MOR,
    PCV           = PCV
  )
  
  return(out)
}


null_RE <- extract_RE_table(null_fit_weighted)
null_var <- null_RE$between_var

ind_RE  <- extract_RE_table(ind_fit_weighted, null_var)
hou_RE  <- extract_RE_table(hou_fit_weighted, null_var)
com_RE  <- extract_RE_table(community_fit_weighted, null_var)
full_RE <- extract_RE_table(full_fit_weighted, null_var)
RandomEffects_Table <- bind_rows(
  Null       = null_RE,
  Individual = ind_RE,
  Household  = hou_RE,
  Community  = com_RE,
  Full       = full_RE,
  .id = "Model"
) %>%
  mutate(
    `Cluster Variation` = paste0("[", round(cluster_sd_L, 2), ", ", round(cluster_sd_U, 2), "]"),
    `Between-Cluster Variance` = round(between_var, 4),
    `Within-Cluster Variance`  = round(within_var, 4),
    ICC  = round(ICC, 4),
    MOR  = round(MOR, 4),
    `PCV (%)` = PCV
  ) %>%
  select(Model, `Cluster Variation`, `Between-Cluster Variance`, 
         `Within-Cluster Variance`, ICC, MOR, `PCV (%)`)


install.packages("cmdstanr", repos = c("https://mc-stan.org/r-packages/", getOption("repos")))
cmdstanr::check_cmdstan_toolchain(fix = TRUE)

cmdstanr::install_cmdstan()
install.packages("future")
library(future)
# Model comparison
options(future.globals.maxSize = 2 * 1024^3)  


loo_null <- loo(null_fit_weighted, reloo = TRUE)
loo_ind <- loo(ind_fit_weighted, reloo = TRUE)
loo_hou <- loo(hou_fit_weighted, reloo = TRUE)
loo_full <- loo(full_fit_weighted, reloo = TRUE)
loo_community <- loo(community_fit_weighted, reloo = TRUE)

waic_null <- waic(null_fit_weighted)
waic_ind <- waic(ind_fit_weighted)
waic_hou <- waic(hou_fit_weighted)
waic_full <- waic(full_fit_weighted)
waic_community <- waic(community_fit_weighted)

print(waic_null)
print(waic_ind)
print(waic_hou)
print(waic_full)
print(waic_community)

print(loo_null)
print(loo_ind)
print(loo_hou)
print(loo_full)
print(loo_community)

###Trace plots

library(brms)
library(posterior)
library(tidyr)
library(dplyr)
library(ggplot2)
posterior_df <- as_draws_df(full_fit_weighted)
important_vars <- c(
  "b_Intercept",
  "b_V1902",       
  "b_M1411",       
  "b_V1061",     
  "b_BORD011",      
  "b_V0242",       
  "b_V0132",        
  "b_V0252",      
  "b_V1302"        
)

var_labels <- c(
  "b_Intercept" = "Intercept",
  "b_V1902" = "Wealth index",
  "b_M1411" = "ANC visits",
  "b_V1061" = "Educational level",
  "b_V1591" = "Watching television",
  "b_BORD011" = "Birth order",
  "b_V0242" = "Division",
  "b_V0132" = "Age in 5 year groups",
  "b_V0252" = "Residence type",
  "b_V1302" = "Religion"
)
important_vars_exist <- important_vars[important_vars %in% colnames(posterior_df)]

posterior_long <- posterior_df %>%
  select(.chain, .iteration, all_of(important_vars_exist)) %>%
  pivot_longer(cols = all_of(important_vars_exist), 
               names_to = "variable", values_to = "value")

posterior_long <- posterior_long %>%
  mutate(variable_label = recode(variable, !!!var_labels))

ggplot(posterior_long, aes(x = .iteration, y = value, color = factor(.chain))) +
  geom_line(alpha = 0.6) +
  facet_wrap(~variable_label, scales = "free_y") +
  labs(
    x = "Iteration", 
    y = "Parameter Value", 
    color = "Chain"
  ) +
  theme_minimal() +
  theme(
    strip.text = element_text(size = 10, face = "bold"),
    axis.text = element_text(size = 9),
    legend.position = "bottom"
  )




#Forest plot
library(brms)
library(ggplot2)
library(dplyr)
library(forcats)

fixef_summary <- as.data.frame(fixef(full_fit_weighted, probs = c(0.025, 0.975)))
fixef_summary$term <- rownames(fixef_summary)

max_effects <- fixef_summary %>%
  mutate(
    variable_group = case_when(
      grepl("V013", term) ~ "Age in 5 year groups",
      grepl("V714", term) ~ "Respondent working",
      grepl("V106", term) ~ "Highest education level",
      grepl("V171A", term) ~ "Use of internet",
      grepl("BORD01", term) ~ "Birth order",
      grepl("V218", term) ~ "Number of living children",
      grepl("V157", term) ~ "Reading newspaper",
      grepl("V158", term) ~ "Listening to radio",
      grepl("V467D", term) ~ "Distance to health facility",
      grepl("M141", term) ~ "ANC visits",
      grepl("V159", term) ~ "Watching television",
      grepl("V119", term) ~ "Household electricity",
      grepl("V121", term) ~ "Household television",
      grepl("V155", term) ~ "Literacy",
      grepl("V151", term) ~ "Sex of household head",
      grepl("V130", term) ~ "Religion",
      grepl("V190", term) ~ "Wealth index",
      grepl("V024", term) ~ "Division",
      grepl("V025", term) ~ "Residence type",
      TRUE ~ "Other"
    ),
    estimate_or = exp(Estimate),
    conf.low_or = exp(Q2.5),
    conf.high_or = exp(Q97.5)
  ) %>%
  group_by(variable_group) %>%
  slice(which.max(abs(estimate_or - 1))) %>%  # pick the most extreme OR for each group
  ungroup()

windowsFonts("TimesNewRoman" = windowsFont("Times New Roman"))
forest_plot_max <- ggplot(max_effects, aes(x = estimate_or, y = fct_reorder(variable_group, estimate_or))) +
  geom_vline(xintercept = 1, linetype = "dashed", color = "red", alpha = 0.7) +
  geom_pointrange(aes(xmin = conf.low_or, xmax = conf.high_or), 
                  color = "steelblue",
                  size = 0.8,
                  fatten = 2) +
  scale_x_log10(breaks = c(0.1, 0.5, 1, 2, 5, 10, 20)) +
  labs(
    title = "Forest plot of fixed effects",
    subtitle = "Posterior means and 95% credible intervals (log scale)",
    x = "Adjusted Odds Ratio (log scale)",
    y = "Predictor Variables"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "TimesNewRoman"),
    axis.title = element_text(face = "bold", size = 12),
    axis.title.y = element_text(margin = margin(r = 15)),
    axis.text.y = element_text(
      size = 11, 
      face = "bold",
      family = "TimesNewRoman"
    ),
    axis.text.x = element_text(
      family = "TimesNewRoman",
      size = 10
    ),
    panel.grid.major = element_line(color = "gray90"),
    panel.grid.minor = element_blank()
  )


# Alternative priors for sensitivity check
alt_priors <- c(
  prior(normal(0, 5), class = "b"),          
  prior(student_t(3, 0, 5), class = "Intercept"),  
  prior(student_t(3, 0, 5), class = "sd")         
)
full_formula <- bf(Institutional_delivery ~ 
                     V013 + V025 + V218 + V171A + V130 + V151 + V190 + V714 + V106 + V119 + V121 + V467D + 
                     M141 + BORD01 + V155 + V157 + V158 + V159 + V024 + 
                     (1 | V001), family = bernoulli())
full_fit_alt <- brm(
  formula = full_formula,
  data = mydata,
  prior = alt_priors,
  sample_prior = "yes",
  chains = 4,
  iter = 2000,
  warmup = 1000,
  seed = 123,
  control = list(adapt_delta = 0.95, max_treedepth = 15),
  save_pars = save_pars(all = TRUE),
  backend = "cmdstanr"
)

library(bayesplot)
library(tidybayes)
full_alt_coefs <- fixef(full_fit_alt, summary = TRUE)
full_fit_OR <- exp(full_alt_coefs[, c("Estimate", "Q2.5", "Q97.5")])
colnames(full_fit_OR) <- c("OR", "2.5% CrI", "97.5% CrI")
full_fit_OR_df <- as.data.frame(full_fit_OR)
print(full_fit_OR_df)
diagnostics <- summary(full_fit_alt)
print(diagnostics)


# CONSORT-style sample flow diagram
library(DiagrammeR)
library(DiagrammeRsvg)
library(rsvg)

svg_txt <- export_svg(
  grViz("
  digraph flowchart {

    graph [layout = dot, rankdir = TB]
    node  [shape = box, fontname = Helvetica, fontsize = 14]

    A [label = '675 EAs']
    B [label = '273 Urban EAs']
    C [label = '438 Rural EAs']

    D [label = '12,285 households']
    E [label = '19,710 households']

    F [label = '674 EAs']
    G [label = '30,330 households']
    H [label = '30,078 households included']
    I [label = 'Place of delivery\\n5,054 individuals']
    J [label = 'After excluding outliers\\nand records with missing data,\\n4,433 observations were retained\\nfor the final analysis']

    A -> B
    A -> C
    B -> D
    C -> E
    D -> F
    E -> F
    F -> G
    G -> H
    H -> I
    I -> J
  }
  ")
)



#Sankey plot

library(plotly)
library(dplyr)
library(RColorBrewer)
library(htmlwidgets)
library(webshot)

total <- 4433
place <- c("Urban", "Rural")
place_perc <- round(c(1463, 2970) / total * 100, 1)
place_inst_perc <- c(74.9, 57.8)
wealth <- c("Poorest", "Poorer", "Middle", "Richer", "Richest")
wealth_perc <- round(c(938, 883, 866, 889, 857) / total * 100, 1)
wealth_inst_perc <- c(38.8, 54.0, 63.9, 74.9, 87.5)
anc <- c("No ANC", "1-4 ANC", "4+ ANC")
anc_perc <- round(c(381, 2995, 1057) / total * 100, 1)
anc_inst_perc <- c(19.2, 61.9, 83.7)

place_labels <- paste0(
  "<b>", place, " (", place_perc, "%)</b>",
  "<br>Institutional: ", place_inst_perc, "%"
)

wealth_labels <- paste0(
  "<b>", wealth, " (", wealth_perc, "%)</b>",
  "<br>Institutional: ", wealth_inst_perc, "%"
)

anc_labels <- paste0(
  "<b>", anc, " (", anc_perc, "%)</b>",
  "<br>Institutional: ", anc_inst_perc, "%"
)

institutional_flow <- sum(anc_perc * anc_inst_perc / 100)
non_institutional_flow <- 100 - institutional_flow

delivery_labels <- c(
  paste0("<b>Institutional (", round(institutional_flow, 1), "%)</b>"),
  paste0("<b>Non-Institutional (", round(non_institutional_flow, 1), "%)</b>")
)

labels <- c(place_labels, wealth_labels, anc_labels, delivery_labels)

place_colors <- c("#2C728E", "#85C0D9")  # Professional blues
wealth_colors <- c("#1A5E67", "#278176", "#35A186", "#5EC0A5", "#8ED3C2")
anc_colors <- c("#E67C4A", "#F3A261", "#FBCA8F")  # Earth tones
outcome_colors <- c("#2E8B57", "#B22222")  # Green/red

node_colors <- c(place_colors, wealth_colors, anc_colors, outcome_colors)

adjust_alpha <- function(color, alpha = 0.6) {
  rgb_val <- col2rgb(color) / 255
  rgb(rgb_val[1], rgb_val[2], rgb_val[3], alpha)
}

sources <- c()
targets <- c()
values <- c()
link_colors <- c()

for (i in 1:length(place)) {
  for (j in 1:length(wealth)) {
    sources <- c(sources, i-1)
    targets <- c(targets, length(place) + j - 1)
    values <- c(values, place_perc[i] * wealth_perc[j] / 100)
    link_colors <- c(link_colors, adjust_alpha(place_colors[i]))
  }
}

for (j in 1:length(wealth)) {
  for (k in 1:length(anc)) {
    sources <- c(sources, length(place) + j - 1)
    targets <- c(targets, length(place) + length(wealth) + k - 1)
    values <- c(values, wealth_perc[j] * anc_perc[k] / 100)
    link_colors <- c(link_colors, adjust_alpha(wealth_colors[j]))
  }
}

for (k in 1:length(anc)) {
  sources <- c(sources, length(place) + length(wealth) + k - 1)
  targets <- c(targets, length(labels) - 2)
  values <- c(values, anc_perc[k] * anc_inst_perc[k] / 100)
  link_colors <- c(link_colors, adjust_alpha(anc_colors[k]))
  
  sources <- c(sources, length(place) + length(wealth) + k - 1)
  targets <- c(targets, length(labels) - 1)
  values <- c(values, anc_perc[k] * (100 - anc_inst_perc[k]) / 100)
  link_colors <- c(link_colors, adjust_alpha(anc_colors[k]))
}

node_x <- c(
  rep(0.05, length(place)),
  rep(0.30, length(wealth)),
  rep(0.55, length(anc)),     
  rep(0.85, 2)
)

node_y <- c(
  c(0.25, 0.75),                 # Place positions
  seq(0.05, 0.95, length.out = 5),  # Wealth positions
  c(0.15, 0.50, 0.85),           # ANC positions
  c(0.35, 0.65)                  # Outcome positions
)


fig <- plot_ly(
  type = "sankey",
  arrangement = "perpendicular",
  orientation = "h",
  node = list(
    label = labels,
    color = node_colors,
    pad = 30,  
    thickness = 40, 
    line = list(color = "black", width = 1.5),
    x = node_x,
    y = node_y,
    hovertemplate = "%{label}<extra></extra>",
    font = list(size = 18, family = "Times New Roman", face = "bold")
  ),
  link = list(
    source = sources,
    target = targets,
    value = values,
    color = link_colors,
    hovertemplate = "Flow: %{value:.1f}% of total<extra></extra>"
  )
) %>% layout(
  font = list(size = 18, family = "Arial", color = "#333333"),
  margin = list(t = 30, b = 20, l = 20, r = 20),
  plot_bgcolor = "white",
  paper_bgcolor = "white"
)

fig