#####Code for Consumption Data ### Consumption for AS1 #Setup rm(list=ls()) library(dplyr) set.seed(12345) data <- read.csv("consumption_file.csv") #Data Cleaning ids <- data[, 2] ids <- data.frame(ID = ids) consumption_data <- data[, -c(1, 2)] fish_names <- colnames(consumption_data) #AS1 target_consumption <- 25 non_eating_consumption <- 25 eaters_data <- consumption_data[1:1150, ] non_eaters_data <- consumption_data[1151:2314, ] #Calculations fish_probabilities <- colSums(eaters_data) / sum(eaters_data) fish_frequencies <- colSums(eaters_data > 0) / nrow(eaters_data) zero_probabilities <- 1 - fish_frequencies zero_probabilities <- zero_probabilities / sum(zero_probabilities) #AS1 Consumption Data randomize_row <- function(row, target) { total_consumption <- sum(row) if (total_consumption == 0) { random_distribution <- rmultinom(1, size = round(non_eating_consumption * 100000), prob = fish_probabilities) / 100000 return(as.numeric(random_distribution)) } else if (total_consumption == target) { return(row) } else if (total_consumption > target) { return((row / total_consumption) * target) } else { scaled_row <- (row / total_consumption) * target shortfall <- target - sum(scaled_row) probabilities <- rep(1, length(row)) / length(row) random_distribution <- shortfall * probabilities return(scaled_row + random_distribution) } } randomized_eaters_data <- t(apply(eaters_data, 1, randomize_row, target = target_consumption)) randomized_eaters_data <- as.data.frame(randomized_eaters_data) colnames(randomized_eaters_data) <- fish_names randomize_non_eater_row <- function(row, target) { random_weights <- sample(fish_probabilities, length(fish_probabilities), replace = TRUE) random_weights <- random_weights / sum(random_weights) zero_randomizer <- runif(length(random_weights)) < zero_probabilities random_weights[zero_randomizer] <- 0 randomized_row <- random_weights * target sum_randomized <- sum(randomized_row) if (sum_randomized != target) { diff <- target - sum_randomized randomized_row <- randomized_row + diff * (randomized_row / sum(randomized_row)) } return(randomized_row) } randomized_non_eaters_data <- t(apply(non_eaters_data, 1, randomize_non_eater_row, target = non_eating_consumption)) #Data Cleaning randomized_non_eaters_data <- as.data.frame(randomized_non_eaters_data) colnames(randomized_non_eaters_data) <- fish_names final_data <- rbind( cbind(ID = ids[1:1150, ], randomized_eaters_data), cbind(ID = ids[1151:2314, ], randomized_non_eaters_data) ) final_data[final_data < 1e-5] <- 0 #Export results write.csv(final_data, "consumption_AS1.csv", row.names = FALSE) ###Consumption for AS2 #Setup rm(list=ls()) library(dplyr) set.seed(12345) data <- read.csv("consumption_file.csv") #Data Cleaning ids <- data[, 2] ids <- data.frame(ID = ids) consumption_data <- data[, -c(1, 2)] fish_names <- colnames(consumption_data) #AS2 target_consumption <- 70 non_eating_consumption <- 70 eaters_data <- consumption_data[1:1150, ] non_eaters_data <- consumption_data[1151:2314, ] #Calculations fish_probabilities <- colSums(eaters_data) / sum(eaters_data) fish_frequencies <- colSums(eaters_data > 0) / nrow(eaters_data) zero_probabilities <- 1 - fish_frequencies zero_probabilities <- zero_probabilities / sum(zero_probabilities) #AS2 Consumption Data randomize_row <- function(row, target) { total_consumption <- sum(row) if (total_consumption == 0) { random_distribution <- rmultinom(1, size = round(non_eating_consumption * 100000), prob = fish_probabilities) / 100000 return(as.numeric(random_distribution)) } else if (total_consumption == target) { return(row) } else if (total_consumption > target) { return((row / total_consumption) * target) } else { scaled_row <- (row / total_consumption) * target shortfall <- target - sum(scaled_row) probabilities <- rep(1, length(row)) / length(row) random_distribution <- shortfall * probabilities return(scaled_row + random_distribution) } } randomized_eaters_data <- t(apply(eaters_data, 1, randomize_row, target = target_consumption)) randomized_eaters_data <- as.data.frame(randomized_eaters_data) colnames(randomized_eaters_data) <- fish_names randomize_non_eater_row <- function(row, target) { random_weights <- sample(fish_probabilities, length(fish_probabilities), replace = TRUE) random_weights <- random_weights / sum(random_weights) zero_randomizer <- runif(length(random_weights)) < zero_probabilities random_weights[zero_randomizer] <- 0 randomized_row <- random_weights * target sum_randomized <- sum(randomized_row) if (sum_randomized != target) { diff <- target - sum_randomized randomized_row <- randomized_row + diff * (randomized_row / sum(randomized_row)) } return(randomized_row) } randomized_non_eaters_data <- t(apply(non_eaters_data, 1, randomize_non_eater_row, target = non_eating_consumption)) #Data Cleaning randomized_non_eaters_data <- as.data.frame(randomized_non_eaters_data) colnames(randomized_non_eaters_data) <- fish_names final_data <- rbind( cbind(ID = ids[1:1150, ], randomized_eaters_data), cbind(ID = ids[1151:2314, ], randomized_non_eaters_data) ) final_data[final_data < 1e-5] <- 0 #Export results write.csv(final_data, "consumption_AS2.csv", row.names = FALSE) ###Consumption for AS3 #Setup rm(list=ls()) library(dplyr) set.seed(12345) data <- read.csv("consumption_file.csv") #Data Cleaning ids <- data[, 2] ids <- data.frame(ID = ids) consumption_data <- data[, -c(1, 2)] fish_names <- colnames(consumption_data) #AS3 target_consumption <- 95 non_eating_consumption <- 95 eaters_data <- consumption_data[1:1150, ] non_eaters_data <- consumption_data[1151:2314, ] #Calculations fish_probabilities <- colSums(eaters_data) / sum(eaters_data) fish_frequencies <- colSums(eaters_data > 0) / nrow(eaters_data) zero_probabilities <- 1 - fish_frequencies zero_probabilities <- zero_probabilities / sum(zero_probabilities) #AS3 Consumption Data randomize_row <- function(row, target) { total_consumption <- sum(row) if (total_consumption == 0) { random_distribution <- rmultinom(1, size = round(non_eating_consumption * 100000), prob = fish_probabilities) / 100000 return(as.numeric(random_distribution)) } else if (total_consumption == target) { return(row) } else if (total_consumption > target) { return((row / total_consumption) * target) } else { scaled_row <- (row / total_consumption) * target shortfall <- target - sum(scaled_row) probabilities <- rep(1, length(row)) / length(row) random_distribution <- shortfall * probabilities return(scaled_row + random_distribution) } } randomized_eaters_data <- t(apply(eaters_data, 1, randomize_row, target = target_consumption)) randomized_eaters_data <- as.data.frame(randomized_eaters_data) colnames(randomized_eaters_data) <- fish_names randomize_non_eater_row <- function(row, target) { random_weights <- sample(fish_probabilities, length(fish_probabilities), replace = TRUE) random_weights <- random_weights / sum(random_weights) zero_randomizer <- runif(length(random_weights)) < zero_probabilities random_weights[zero_randomizer] <- 0 randomized_row <- random_weights * target sum_randomized <- sum(randomized_row) if (sum_randomized != target) { diff <- target - sum_randomized randomized_row <- randomized_row + diff * (randomized_row / sum(randomized_row)) } return(randomized_row) } randomized_non_eaters_data <- t(apply(non_eaters_data, 1, randomize_non_eater_row, target = non_eating_consumption)) #Data Cleaning randomized_non_eaters_data <- as.data.frame(randomized_non_eaters_data) colnames(randomized_non_eaters_data) <- fish_names final_data <- rbind( cbind(ID = ids[1:1150, ], randomized_eaters_data), cbind(ID = ids[1151:2314, ], randomized_non_eaters_data) ) final_data[final_data < 1e-5] <- 0 #Export results write.csv(final_data, "consumption_AS3.csv", row.names = FALSE) ##### Code for Health Benefits ## Calculations for health benefits associated with total fish intake referenced the methodology by Outzen et al. (2024). ## Outzen, M., Thomsen, S. T., Andersen, R., Jakobsen, L. S., Jakobsen, M. U., Nauta, M., Ravn-Haren, G., Sloth, J. J., Pilegaard, K. & Poulsen, M. 2024. Evaluating the health impact of increased linseed consumption in the Danish population. Food and Chemical Toxicology, 183, 114308.https://doi.org/10.1016/j.fct.2023.114308 ###All Cause Mortality #Set up install.packages("mc2d") .libPaths(c("~/R/library",.libPaths())) library(mc2d) rm(list=ls()) set.seed(123) ndvar <- 1000 ndunc <- 1000 #Calculate parameters for log-linear distribution of RR, assume log-linearity based on Barendregt and Veerman 2009 #RR is from Schwingshackl L, Schwedhelm C, Hoffmann G, et al. Food groups and risk of all-cause mortality: a systematic review and meta-analysis of prospective studies. Am J Clin Nutr. Jun 2017;105(6):1462-1473. doi:10.3945/ajcn.117.153148 #Given: RR = 0.94, 95% CI = (0.90, 0.96), increment 100 g per day RR_mean <- 0.93 RR_lower <- 0.88 RR_upper <- 0.98 logRR_mean <- log(RR_mean) logRR_lower <- log(RR_lower) logRR_upper <- log(RR_upper) logRR_sd <- (logRR_upper - logRR_lower) / (2 * 1.96) #Distribution for log-transformed RR (log-linear assumption) logRR_dist <- mcstoc(rnorm, mean = logRR_mean, sd = logRR_sd, nsv = ndvar, nsu=ndunc) RR_dist <- exp(logRR_dist) summary(RR_dist) quantiles <- quantile(RR_dist, probs = c(0.025, 0.5, 0.975)) print(quantiles) #from IHME GBD 2021 data for All Cause Mortality incidence_mean <- 414.63 incidence_upper <- 422.62 incidence_lower <- 406.89 #Incidence distribution incidence_dist <- mcstoc(rpert, min = incidence_lower, mode = incidence_mean, max = incidence_upper, nsv = ndvar, nsu = ndunc) summary(incidence_dist) quantile(incidence_dist, probs = c(0.025, 0.5, 0.975)) #from IHME GBD 2021 data for All Cause Mortality DALYS_mean <- 8137.01 DALYS_upper <- 8326.67 DALYS_lower <- 7958.58 #DALYS distribution DALY_dist <- mcstoc(rpert, min = DALYS_lower, mode = DALYS_mean, max = DALYS_upper, nsv = ndvar, nsu = ndunc) summary(DALY_dist) quantile(DALY_dist, probs = c(0.025, 0.5, 0.975)) #increment for RR increment <- 100 # Calculate beta values beta_values <- log(RR_dist)/increment #Set scenarios for consumption baseline_consumption <- 46.3 AS1 <- 25 AS2 <- 70 AS3 <-95 #Calculate RR for baseline and alternative scenarios RR_baseline <- exp(beta_values * baseline_consumption) RR_AS1<- exp(beta_values * AS1_consumption) RR_AS2 <- exp(beta_values * AS2_consumption) RR_AS3 <- exp(beta_values * AS3_consumption) # Calculate PIF for AS1 PIF_values_AS1 <- (RR_AS1 - RR_baseline)/RR_baseline # Calculate attributable incidence and DALYs for AS1 attr_incidence_AS1 <- PIF_values_AS1 * incidence_dist attr_DALYs_AS1 <- PIF_values_AS1 * DALY_dist # Convert to dataframes attr_incidence_AS1_df <- as.data.frame(attr_incidence_AS1) attr_DALYs_AS1_df <- as.data.frame(attr_DALYs_AS1) #save CSV for AS1 write.csv(attr_incidence_AS1_df, "attr_incidence_ACM_AS1.csv", row.names = FALSE) write.csv(attr_DALYs_AS1_df, "attr_DALYs_ACM_AS1.csv", row.names = FALSE) # Calculate summary statistics for AS1 # For Incidence inc_mean_AS1 <- mean(attr_incidence_AS1) inc_median_AS1 <- median(attr_incidence_AS1) inc_95CI_AS1 <- quantile(attr_incidence_AS1, probs = c(0.025, 0.975)) # For DALYs daly_mean_AS1 <- mean(attr_DALYs_AS1) daly_median_AS1 <- median(attr_DALYs_AS1) daly_95CI_AS1 <- quantile(attr_DALYs_AS1, probs = c(0.025, 0.975)) #Calculate PIF for AS2 PIF_values_AS2 <- (RR_AS2- RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS2 attr_incidence_AS2 <- PIF_values_AS2 * incidence_dist attr_DALYs_AS2 <- PIF_values_AS2 * DALY_dist #Convert to dataframes attr_incidence_AS2_df <- as.data.frame(attr_incidence_AS2) attr_DALYs_AS2_df <- as.data.frame(attr_DALYs_AS2) #save CSV for AS2 write.csv(attr_incidence_AS2_df, "attr_incidence_ACM_AS2.csv", row.names = FALSE) write.csv(attr_DALYs_AS2_df, "attr_DALYs_ACM_AS2.csv", row.names = FALSE) #Calculate summary statistics for AS2 #For Incidence inc_mean_AS2 <- mean(attr_incidence_AS2) inc_median_AS2 <- median(attr_incidence_AS2) inc_95CI_AS2 <- quantile(attr_incidence_AS2, probs = c(0.025, 0.975)) #DALYs daly_mean_AS2 <- mean(attr_DALYs_AS2) daly_median_AS2 <- median(attr_DALYs_AS2) daly_95CI_AS2 <- quantile(attr_DALYs_AS2, probs = c(0.025, 0.975)) #Calculate PIF for AS3 PIF_values_AS3 <- (RR_AS3 - RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS3 attr_incidence_AS3 <- PIF_values_AS3 * incidence_dist attr_DALYs_AS3 <- PIF_values_AS3 * DALY_dist #Convert to dataframes attr_incidence_AS3_df <- as.data.frame(attr_incidence_AS3) attr_DALYs_AS3_df <- as.data.frame(attr_DALYs_AS3) #save CSV for AS3 write.csv(attr_incidence_AS3_df, "attr_incidence_ACM_AS3.csv", row.names = FALSE) write.csv(attr_DALYs_AS3_df, "attr_DALYs_ACM_AS3.csv", row.names = FALSE) #Calculate summary statistics for AS3 # For Incidence inc_mean_AS3 <- mean(attr_incidence_AS3) inc_median_AS3 <- median(attr_incidence_AS3) inc_95CI_AS3 <- quantile(attr_incidence_AS3, probs = c(0.025, 0.975)) #For DALYs daly_mean_AS3 <- mean(attr_DALYs_AS3) daly_median_AS3 <- median(attr_DALYs_AS3) daly_95CI_AS3 <- quantile(attr_DALYs_AS3, probs = c(0.025, 0.975)) #Print all results results_table <- data.frame( Scenario = c("AS1", "AS2", "AS3"), Inc_Mean = c(inc_mean_AS1, inc_mean_AS2, inc_mean_AS3), Inc_Median = c(inc_median_AS1, inc_median_AS2, inc_median_AS3), Inc_CI_Lower = c(inc_95CI_AS1$attr_incidence_AS1[1], inc_95CI_AS2$attr_incidence_AS2[1], inc_95CI_AS3$attr_incidence_AS3[1]), Inc_CI_Upper = c(inc_95CI_AS1$attr_incidence_AS1[2], inc_95CI_AS2$attr_incidence_AS2[2], inc_95CI_AS3$attr_incidence_AS3[2]), DALY_Mean = c(daly_mean_AS1, daly_mean_AS2, daly_mean_AS3), DALY_Median = c(daly_median_AS1, daly_median_AS2, daly_median_AS3), DALY_CI_Lower = c(daly_95CI_AS1$attr_DALYs_AS1[1], daly_95CI_AS2$attr_DALYs_AS2[1], daly_95CI_AS3$attr_DALYs_AS3[1]), DALY_CI_Upper = c(daly_95CI_AS1$attr_DALYs_AS1[2], daly_95CI_AS2$attr_DALYs_AS2[2], daly_95CI_AS3$attr_DALYs_AS3[2]) ) #Print and export results print(results_table) write.csv(results_table, "ACM_results.csv", row.names = FALSE) ###CHD #Set up install.packages("mc2d") .libPaths(c("~/R/library",.libPaths())) library(mc2d) rm(list=ls()) set.seed(123) ndvar <- 1000 ndunc <- 1000 # Calculate parameters for log-linear distribution of RR, assume log-linearity based on Barendregt and Veerman 2009 #RR is from Zhang B, Xiong K, Cai J, Ma A. Fish Consumption and Coronary Heart Disease: A Meta-Analysis. Nutrients. Jul 29 2020;12(8)doi:10.3390/nu12082278 # Given: RR = 0.96, 95% CI = (0.95, 0.97), increment of 20g/day RR_mean <- 0.96 RR_lower <- 0.95 RR_upper <- 0.97 logRR_mean <- log(RR_mean) logRR_lower <- log(RR_lower) logRR_upper <- log(RR_upper) logRR_sd <- (logRR_upper - logRR_lower) / (2 * 1.96) #Distribution for log-transformed RR (log-linear assumption) logRR_dist <- mcstoc(rnorm, mean = logRR_mean, sd = logRR_sd, nsv = ndvar, nsu=ndunc) RR_dist <- exp(logRR_dist) summary(RR_dist) quantiles <- quantile(RR_dist, probs = c(0.025, 0.5, 0.975)) print(quantiles) #from IHME GBD 2021 data for Ischemic Heart Disease, assume IHD corresponding to Coronary Heart Disease. incidence_mean <- 222.23 incidence_upper <- 281.8 incidence_lower <- 172.34 #Incidence distribution incidence_dist <- mcstoc(rpert, min = incidence_lower, mode = incidence_mean, max = incidence_upper, nsv = ndvar, nsu = ndunc) summary(incidence_dist) quantile(incidence_dist, probs = c(0.025, 0.5, 0.975)) #from IHME GBD 2021 data for Ischemic Heart Disease DALYS_mean <- 1383.74 DALYS_upper <- 1457.83 DALYS_lower <- 1286.41 #DALYS distribution DALY_dist <- mcstoc(rpert, min = DALYS_lower, mode = DALYS_mean, max = DALYS_upper, nsv = ndvar, nsu = ndunc) summary(DALY_dist) quantile(DALY_dist, probs = c(0.025, 0.5, 0.975)) #increment for RR increment <- 20 # Calculate beta values beta_values <- log(RR_dist)/increment #Set scenarios for consumption baseline_consumption <- 46.3 AS1 <- 25 AS2 <- 70 AS3 <-95 #Calculate RR for baseline and alternative scenarios RR_baseline <- exp(beta_values * baseline_consumption) RR_AS1<- exp(beta_values * AS1_consumption) RR_AS2 <- exp(beta_values * AS2_consumption) RR_AS3 <- exp(beta_values * AS3_consumption) # Calculate PIF for AS1 PIF_values_AS1 <- (RR_AS1 - RR_baseline)/RR_baseline # Calculate attributable incidence and DALYs for AS1 attr_incidence_AS1 <- PIF_values_AS1 * incidence_dist attr_DALYs_AS1 <- PIF_values_AS1 * DALY_dist # Convert to dataframes attr_incidence_AS1_df <- as.data.frame(attr_incidence_AS1) attr_DALYs_AS1_df <- as.data.frame(attr_DALYs_AS1) #save CSV for AS1 write.csv(attr_incidence_AS1_df, "attr_incidence_CHD_AS1.csv", row.names = FALSE) write.csv(attr_DALYs_AS1_df, "attr_DALYs_CHD_AS1.csv", row.names = FALSE) # Calculate summary statistics for AS1 # For Incidence inc_mean_AS1 <- mean(attr_incidence_AS1) inc_median_AS1 <- median(attr_incidence_AS1) inc_95CI_AS1 <- quantile(attr_incidence_AS1, probs = c(0.025, 0.975)) # For DALYs daly_mean_AS1 <- mean(attr_DALYs_AS1) daly_median_AS1 <- median(attr_DALYs_AS1) daly_95CI_AS1 <- quantile(attr_DALYs_AS1, probs = c(0.025, 0.975)) #Calculate PIF for AS2 PIF_values_AS2 <- (RR_AS2- RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS2 attr_incidence_AS2 <- PIF_values_AS2 * incidence_dist attr_DALYs_AS2 <- PIF_values_AS2 * DALY_dist #Convert to dataframes attr_incidence_AS2_df <- as.data.frame(attr_incidence_AS2) attr_DALYs_AS2_df <- as.data.frame(attr_DALYs_AS2) #save CSV for AS2 write.csv(attr_incidence_AS2_df, "attr_incidence_CHD_AS2.csv", row.names = FALSE) write.csv(attr_DALYs_AS2_df, "attr_DALYs_CHD_AS2.csv", row.names = FALSE) #Calculate summary statistics for AS2 #For Incidence inc_mean_AS2 <- mean(attr_incidence_AS2) inc_median_AS2 <- median(attr_incidence_AS2) inc_95CI_AS2 <- quantile(attr_incidence_AS2, probs = c(0.025, 0.975)) #DALYs daly_mean_AS2 <- mean(attr_DALYs_AS2) daly_median_AS2 <- median(attr_DALYs_AS2) daly_95CI_AS2 <- quantile(attr_DALYs_AS2, probs = c(0.025, 0.975)) #Calculate PIF for AS3 PIF_values_AS3 <- (RR_AS3 - RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS3 attr_incidence_AS3 <- PIF_values_AS3 * incidence_dist attr_DALYs_AS3 <- PIF_values_AS3 * DALY_dist #Convert to dataframes attr_incidence_AS3_df <- as.data.frame(attr_incidence_AS3) attr_DALYs_AS3_df <- as.data.frame(attr_DALYs_AS3) #save CSV for AS3 write.csv(attr_incidence_AS3_df, "attr_incidence_CHD_AS3.csv", row.names = FALSE) write.csv(attr_DALYs_AS3_df, "attr_DALYs_CHD_AS3.csv", row.names = FALSE) #Calculate summary statistics for AS3 # For Incidence inc_mean_AS3 <- mean(attr_incidence_AS3) inc_median_AS3 <- median(attr_incidence_AS3) inc_95CI_AS3 <- quantile(attr_incidence_AS3, probs = c(0.025, 0.975)) #For DALYs daly_mean_AS3 <- mean(attr_DALYs_AS3) daly_median_AS3 <- median(attr_DALYs_AS3) daly_95CI_AS3 <- quantile(attr_DALYs_AS3, probs = c(0.025, 0.975)) #Print all results results_table <- data.frame( Scenario = c("AS1", "AS2", "AS3"), Inc_Mean = c(inc_mean_AS1, inc_mean_AS2, inc_mean_AS3), Inc_Median = c(inc_median_AS1, inc_median_AS2, inc_median_AS3), Inc_CI_Lower = c(inc_95CI_AS1$attr_incidence_AS1[1], inc_95CI_AS2$attr_incidence_AS2[1], inc_95CI_AS3$attr_incidence_AS3[1]), Inc_CI_Upper = c(inc_95CI_AS1$attr_incidence_AS1[2], inc_95CI_AS2$attr_incidence_AS2[2], inc_95CI_AS3$attr_incidence_AS3[2]), DALY_Mean = c(daly_mean_AS1, daly_mean_AS2, daly_mean_AS3), DALY_Median = c(daly_median_AS1, daly_median_AS2, daly_median_AS3), DALY_CI_Lower = c(daly_95CI_AS1$attr_DALYs_AS1[1], daly_95CI_AS2$attr_DALYs_AS2[1], daly_95CI_AS3$attr_DALYs_AS3[1]), DALY_CI_Upper = c(daly_95CI_AS1$attr_DALYs_AS1[2], daly_95CI_AS2$attr_DALYs_AS2[2], daly_95CI_AS3$attr_DALYs_AS3[2]) ) #Print and export results print(results_table) write.csv(results_table, "CHD_results.csv", row.names = FALSE) ### Dementia #Set up install.packages("mc2d") .libPaths(c("~/R/library",.libPaths())) library(mc2d) rm(list=ls()) set.seed(123) ndvar <- 1000 ndunc <- 1000 # Calculate parameters for log-linear distribution of RR, assume log-linearity based on Barendregt and Veerman 2009 #RR is from Kosti RI, Kasdagli MI, Kyrozis A, et al. Fish intake, n-3 fatty acid body status, and risk of cognitive decline: a systematic review and a dose-response meta-analysis of observational and experimental studies. Nutr Rev. May 9 2022;80(6):1445-1458. doi:10.1093/nutrit/nuab078 # Given: RR = 0.88, 95% CI = (0.73, 1.07), increment 250 g per week = 35.71g per day RR_mean <- 0.88 RR_lower <- 0.73 RR_upper <- 1.07 logRR_mean <- log(RR_mean) logRR_lower <- log(RR_lower) logRR_upper <- log(RR_upper) logRR_sd <- (logRR_upper - logRR_lower) / (2 * 1.96) #Distribution for log-transformed RR (log-linear assumption) logRR_dist <- mcstoc(rnorm, mean = logRR_mean, sd = logRR_sd, nsv = ndvar, nsu=ndunc) RR_dist <- exp(logRR_dist) summary(RR_dist) quantiles <- quantile(RR_dist, probs = c(0.025, 0.5, 0.975)) print(quantiles) #from IHME GBD 2021 data for Alzheimer's disease and other dementias incidence_mean <- 135.56 incidence_upper <- 149.89 incidence_lower <- 122.01 #Incidence distribution incidence_dist <- mcstoc(rpert, min = incidence_lower, mode = incidence_mean, max = incidence_upper, nsv = ndvar, nsu = ndunc) summary(incidence_dist) quantile(incidence_dist, probs = c(0.025, 0.5, 0.975)) #from IHME GBD 2021 data for Alzheimer's disease and other dementia DALYS_mean <- 468.97 DALYS_upper <- 956.39 DALYS_lower <- 229.03 #DALYS distribution DALY_dist <- mcstoc(rpert, min = DALYS_lower, mode = DALYS_mean, max = DALYS_upper, nsv = ndvar, nsu = ndunc) summary(DALY_dist) quantile(DALY_dist, probs = c(0.025, 0.5, 0.975)) #increment for RR increment <- 35.71 # Calculate beta values beta_values <- log(RR_dist)/increment #Set scenarios for consumption baseline_consumption <- 46.3 AS1 <- 25 AS2 <- 70 AS3 <-95 #Calculate RR for baseline and alternative scenarios RR_baseline <- exp(beta_values * baseline_consumption) RR_AS1<- exp(beta_values * AS1_consumption) RR_AS2 <- exp(beta_values * AS2_consumption) RR_AS3 <- exp(beta_values * AS3_consumption) # Calculate PIF for AS1 PIF_values_AS1 <- (RR_AS1 - RR_baseline)/RR_baseline # Calculate attributable incidence and DALYs for AS1 attr_incidence_AS1 <- PIF_values_AS1 * incidence_dist attr_DALYs_AS1 <- PIF_values_AS1 * DALY_dist # Convert to dataframes attr_incidence_AS1_df <- as.data.frame(attr_incidence_AS1) attr_DALYs_AS1_df <- as.data.frame(attr_DALYs_AS1) #save CSV for AS1 write.csv(attr_incidence_AS1_df, "attr_incidence_Dementia_AS1.csv", row.names = FALSE) write.csv(attr_DALYs_AS1_df, "attr_DALYs_Dementia_AS1.csv", row.names = FALSE) # Calculate summary statistics for AS1 # For Incidence inc_mean_AS1 <- mean(attr_incidence_AS1) inc_median_AS1 <- median(attr_incidence_AS1) inc_95CI_AS1 <- quantile(attr_incidence_AS1, probs = c(0.025, 0.975)) # For DALYs daly_mean_AS1 <- mean(attr_DALYs_AS1) daly_median_AS1 <- median(attr_DALYs_AS1) daly_95CI_AS1 <- quantile(attr_DALYs_AS1, probs = c(0.025, 0.975)) #Calculate PIF for AS2 PIF_values_AS2 <- (RR_AS2- RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS2 attr_incidence_AS2 <- PIF_values_AS2 * incidence_dist attr_DALYs_AS2 <- PIF_values_AS2 * DALY_dist #Convert to dataframes attr_incidence_AS2_df <- as.data.frame(attr_incidence_AS2) attr_DALYs_AS2_df <- as.data.frame(attr_DALYs_AS2) #save CSV for AS2 write.csv(attr_incidence_AS2_df, "attr_incidence_Dementia_AS2.csv", row.names = FALSE) write.csv(attr_DALYs_AS2_df, "attr_DALYs_Dementia_AS2.csv", row.names = FALSE) #Calculate summary statistics for AS2 #For Incidence inc_mean_AS2 <- mean(attr_incidence_AS2) inc_median_AS2 <- median(attr_incidence_AS2) inc_95CI_AS2 <- quantile(attr_incidence_AS2, probs = c(0.025, 0.975)) #DALYs daly_mean_AS2 <- mean(attr_DALYs_AS2) daly_median_AS2 <- median(attr_DALYs_AS2) daly_95CI_AS2 <- quantile(attr_DALYs_AS2, probs = c(0.025, 0.975)) #Calculate PIF for AS3 PIF_values_AS3 <- (RR_AS3 - RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS3 attr_incidence_AS3 <- PIF_values_AS3 * incidence_dist attr_DALYs_AS3 <- PIF_values_AS3 * DALY_dist #Convert to dataframes attr_incidence_AS3_df <- as.data.frame(attr_incidence_AS3) attr_DALYs_AS3_df <- as.data.frame(attr_DALYs_AS3) #save CSV for AS3 write.csv(attr_incidence_AS3_df, "attr_incidence_Dementia_AS3.csv", row.names = FALSE) write.csv(attr_DALYs_AS3_df, "attr_DALYs_Dementia_AS3.csv", row.names = FALSE) #Calculate summary statistics for AS3 # For Incidence inc_mean_AS3 <- mean(attr_incidence_AS3) inc_median_AS3 <- median(attr_incidence_AS3) inc_95CI_AS3 <- quantile(attr_incidence_AS3, probs = c(0.025, 0.975)) #For DALYs daly_mean_AS3 <- mean(attr_DALYs_AS3) daly_median_AS3 <- median(attr_DALYs_AS3) daly_95CI_AS3 <- quantile(attr_DALYs_AS3, probs = c(0.025, 0.975)) #Print all results results_table <- data.frame( Scenario = c("AS1", "AS2", "AS3"), Inc_Mean = c(inc_mean_AS1, inc_mean_AS2, inc_mean_AS3), Inc_Median = c(inc_median_AS1, inc_median_AS2, inc_median_AS3), Inc_CI_Lower = c(inc_95CI_AS1$attr_incidence_AS1[1], inc_95CI_AS2$attr_incidence_AS2[1], inc_95CI_AS3$attr_incidence_AS3[1]), Inc_CI_Upper = c(inc_95CI_AS1$attr_incidence_AS1[2], inc_95CI_AS2$attr_incidence_AS2[2], inc_95CI_AS3$attr_incidence_AS3[2]), DALY_Mean = c(daly_mean_AS1, daly_mean_AS2, daly_mean_AS3), DALY_Median = c(daly_median_AS1, daly_median_AS2, daly_median_AS3), DALY_CI_Lower = c(daly_95CI_AS1$attr_DALYs_AS1[1], daly_95CI_AS2$attr_DALYs_AS2[1], daly_95CI_AS3$attr_DALYs_AS3[1]), DALY_CI_Upper = c(daly_95CI_AS1$attr_DALYs_AS1[2], daly_95CI_AS2$attr_DALYs_AS2[2], daly_95CI_AS3$attr_DALYs_AS3[2]) ) #Print and export results print(results_table) write.csv(results_table, " dementia_results.csv", row.names = FALSE) ### Stroke #Set up install.packages("mc2d") .libPaths(c("~/R/library",.libPaths())) library(mc2d) rm(list=ls()) set.seed(123) ndvar <- 1000 ndunc <- 1000 # Calculate parameters for log-linear distribution of RR, assume log-linearity based on Barendregt and Veerman 2009 #RR is from Bechthold A, Boeing H, Schwedhelm C, et al. Food groups and risk of coronary heart disease, stroke and heart failure: A systematic review and dose-response meta-analysis of prospective studies. Crit Rev Food Sci Nutr. 2019;59(7):1071-1090. doi:10.1080/10408398.2017.1392288 # Given: RR = 0.86, 95% CI = (0.75, 0.99), increment 100 g per day RR_mean <- 0.86 RR_lower <- 0.75 RR_upper <- 0.99 logRR_mean <- log(RR_mean) logRR_lower <- log(RR_lower) logRR_upper <- log(RR_upper) logRR_sd <- (logRR_upper - logRR_lower) / (2 * 1.96) #Distribution for log-transformed RR (log-linear assumption) logRR_dist <- mcstoc(rnorm, mean = logRR_mean, sd = logRR_sd, nsv = ndvar, nsu=ndunc) RR_dist <- exp(logRR_dist) summary(RR_dist) quantiles <- quantile(RR_dist, probs = c(0.025, 0.5, 0.975)) print(quantiles) #from IHME GBD 2021 data for Stroke incidence_mean <- 114.26 incidence_upper <- 129.89 incidence_lower <- 101.4 #Incidence distribution incidence_dist <- mcstoc(rpert, min = incidence_lower, mode = incidence_mean, max = incidence_upper, nsv = ndvar, nsu = ndunc) summary(incidence_dist) quantile(incidence_dist, probs = c(0.025, 0.5, 0.975)) #from IHME GBD 2021 data for Stroke DALYS_mean <- 622.62 DALYS_upper <- 691.37 DALYS_lower <- 549.54 #DALYS distribution DALY_dist <- mcstoc(rpert, min = DALYS_lower, mode = DALYS_mean, max = DALYS_upper, nsv = ndvar, nsu = ndunc) summary(DALY_dist) quantile(DALY_dist, probs = c(0.025, 0.5, 0.975)) #increment for RR increment <- 100 # Calculate beta values beta_values <- log(RR_dist)/increment #Set scenarios for consumption baseline_consumption <- 46.3 AS1 <- 25 AS2 <- 70 AS3 <-95 #Calculate RR for baseline and alternative scenarios RR_baseline <- exp(beta_values * baseline_consumption) RR_AS1<- exp(beta_values * AS1_consumption) RR_AS2 <- exp(beta_values * AS2_consumption) RR_AS3 <- exp(beta_values * AS3_consumption) # Calculate PIF for AS1 PIF_values_AS1 <- (RR_AS1 - RR_baseline)/RR_baseline # Calculate attributable incidence and DALYs for AS1 attr_incidence_AS1 <- PIF_values_AS1 * incidence_dist attr_DALYs_AS1 <- PIF_values_AS1 * DALY_dist # Convert to dataframes attr_incidence_AS1_df <- as.data.frame(attr_incidence_AS1) attr_DALYs_AS1_df <- as.data.frame(attr_DALYs_AS1) #save CSV for AS1 write.csv(attr_incidence_AS1_df, "attr_incidence_Stroke_AS1.csv", row.names = FALSE) write.csv(attr_DALYs_AS1_df, "attr_DALYs_Stroke_AS1.csv", row.names = FALSE) # Calculate summary statistics for AS1 # For Incidence inc_mean_AS1 <- mean(attr_incidence_AS1) inc_median_AS1 <- median(attr_incidence_AS1) inc_95CI_AS1 <- quantile(attr_incidence_AS1, probs = c(0.025, 0.975)) # For DALYs daly_mean_AS1 <- mean(attr_DALYs_AS1) daly_median_AS1 <- median(attr_DALYs_AS1) daly_95CI_AS1 <- quantile(attr_DALYs_AS1, probs = c(0.025, 0.975)) #Calculate PIF for AS2 PIF_values_AS2 <- (RR_AS2- RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS2 attr_incidence_AS2 <- PIF_values_AS2 * incidence_dist attr_DALYs_AS2 <- PIF_values_AS2 * DALY_dist #Convert to dataframes attr_incidence_AS2_df <- as.data.frame(attr_incidence_AS2) attr_DALYs_AS2_df <- as.data.frame(attr_DALYs_AS2) #save CSV for AS2 write.csv(attr_incidence_AS2_df, "attr_incidence_Stroke_AS2.csv", row.names = FALSE) write.csv(attr_DALYs_AS2_df, "attr_DALYs_Stroke_AS2.csv", row.names = FALSE) #Calculate summary statistics for AS2 #For Incidence inc_mean_AS2 <- mean(attr_incidence_AS2) inc_median_AS2 <- median(attr_incidence_AS2) inc_95CI_AS2 <- quantile(attr_incidence_AS2, probs = c(0.025, 0.975)) #DALYs daly_mean_AS2 <- mean(attr_DALYs_AS2) daly_median_AS2 <- median(attr_DALYs_AS2) daly_95CI_AS2 <- quantile(attr_DALYs_AS2, probs = c(0.025, 0.975)) #Calculate PIF for AS3 PIF_values_AS3 <- (RR_AS3 - RR_baseline)/RR_baseline #Calculate attributable incidence and DALYs for AS3 attr_incidence_AS3 <- PIF_values_AS3 * incidence_dist attr_DALYs_AS3 <- PIF_values_AS3 * DALY_dist #Convert to dataframes attr_incidence_AS3_df <- as.data.frame(attr_incidence_AS3) attr_DALYs_AS3_df <- as.data.frame(attr_DALYs_AS3) #save CSV for AS3 write.csv(attr_incidence_AS3_df, "attr_incidence_Stroke_AS3.csv", row.names = FALSE) write.csv(attr_DALYs_AS3_df, "attr_DALYs_Stroke_AS3.csv", row.names = FALSE) #Calculate summary statistics for AS3 # For Incidence inc_mean_AS3 <- mean(attr_incidence_AS3) inc_median_AS3 <- median(attr_incidence_AS3) inc_95CI_AS3 <- quantile(attr_incidence_AS3, probs = c(0.025, 0.975)) #For DALYs daly_mean_AS3 <- mean(attr_DALYs_AS3) daly_median_AS3 <- median(attr_DALYs_AS3) daly_95CI_AS3 <- quantile(attr_DALYs_AS3, probs = c(0.025, 0.975)) #Print all results results_table <- data.frame( Scenario = c("AS1", "AS2", "AS3"), Inc_Mean = c(inc_mean_AS1, inc_mean_AS2, inc_mean_AS3), Inc_Median = c(inc_median_AS1, inc_median_AS2, inc_median_AS3), Inc_CI_Lower = c(inc_95CI_AS1$attr_incidence_AS1[1], inc_95CI_AS2$attr_incidence_AS2[1], inc_95CI_AS3$attr_incidence_AS3[1]), Inc_CI_Upper = c(inc_95CI_AS1$attr_incidence_AS1[2], inc_95CI_AS2$attr_incidence_AS2[2], inc_95CI_AS3$attr_incidence_AS3[2]), DALY_Mean = c(daly_mean_AS1, daly_mean_AS2, daly_mean_AS3), DALY_Median = c(daly_median_AS1, daly_median_AS2, daly_median_AS3), DALY_CI_Lower = c(daly_95CI_AS1$attr_DALYs_AS1[1], daly_95CI_AS2$attr_DALYs_AS2[1], daly_95CI_AS3$attr_DALYs_AS3[1]), DALY_CI_Upper = c(daly_95CI_AS1$attr_DALYs_AS1[2], daly_95CI_AS2$attr_DALYs_AS2[2], daly_95CI_AS3$attr_DALYs_AS3[2]) ) #Print and export results print(results_table) write.csv(results_table, " stroke_results.csv", row.names = FALSE) ##### Summation of Health Benefits #Setup .libPaths(c("~/R/library",.libPaths())) library(dplyr) library(readr) rm(list=ls()) #set up function to process files process_scenario_files <- function(file_prefix, scenario, conditions) { # Initialize empty list to store dataframes dfs <- list() for (condition in conditions) { filename <- paste0(file_prefix, "_", condition, "_", scenario, ".csv") df <- read_csv(filename, show_col_types = FALSE) # Added show_col_types = FALSE dfs[[condition]] <- df$x } combined <- do.call(cbind, dfs) %>% as.data.frame() %>% rowSums() stats <- list( mean = mean(combined), median = median(combined), percentile_2.5 = quantile(combined, 0.025), percentile_97.5 = quantile(combined, 0.975) ) write_csv( data.frame(sum = combined), file = paste0("combined_", file_prefix, "_", scenario, ".csv") ) return(stats) } #labels conditions <- c("ACM", "Stroke", "Dementia", "CHD") scenarios <- c("AS1", "AS2", "AS3") prefixes <- c("attr_DALYs", "attr_incidence") #processing results <- list() for (prefix in prefixes) { results[[prefix]] <- list() for (scenario in scenarios) { results[[prefix]][[scenario]] <- process_scenario_files(prefix, scenario, conditions) } } for (prefix in names(results)) { cat("\nResults for", prefix, ":\n") for (scenario in names(results[[prefix]])) { cat("\n", scenario, ":\n") stats <- results[[prefix]][[scenario]] for (stat_name in names(stats)) { cat(stat_name, ": ", stats[[stat_name]], "\n") } } } #####Code for Health Risks #Codes for calculations for health risks were obtained from Redondo et al. (2023) and adapted to local values. #Redondo, H. G., Guillier, L., Bemrah, N., Jakobsen, L. S., Thomsen, S. T. & Pires, S. M. 2023. Harmonized approach to estimate the burden of disease of dietary exposure to four chemical contaminants - A French study. Science of The Total Environment, 894, 164804.https://doi.org/10.1016/j.scitotenv.2023.164804 ###Inorganic Arsenic ##Default Simulation (repeat for all scenarios, AS1, AS2, AS3) Pop_size_male <- 1990212 #SG Resident Male Population 2022, DOS Pop_size_female <- 2083027 # SG Resident Female Population 2022, DOS Life_exp_male <- 80.7 # SG Resident Male Life Expectancy at Birth 2022, DOS Life_exp_female <-85.2 # SG Resident Female Life Expectancy at Birth 2022, DOS consumption_all <- 0 concentration_arsenic <- 0 Individualinfo <- 0 ##Exposure per food group (repeat for all scenarios, AS1, AS2, AS3) ##Exposure by Food #Load food groups Foodgroups <- read.csv("26032025 foodgroups.csv") Foodgroups <- Foodgroups[,-1] colnames(Foodgroups) anchovyfoodex2code <- Foodgroups[,1][!is.na(Foodgroups[,1])] cannedsardinefoodex2code <- Foodgroups[,2][!is.na(Foodgroups[,2])] cannedtunafoodex2code <- Foodgroups[,3][!is.na(Foodgroups[,3])] catfishfoodex2code <- Foodgroups[,4][!is.na(Foodgroups[,4])] fishheadfoodex2code <- Foodgroups[,5][!is.na(Foodgroups[,5])] grouperfoodex2code <- Foodgroups[,6][!is.na(Foodgroups[,6])] kuningandrelatedfishesfoodex2code <- Foodgroups[,7][!is.na(Foodgroups[,7])] mackerelandrelatedfishesfoodex2code <- Foodgroups[,8][!is.na(Foodgroups[,8])] salmonfoodex2code <- Foodgroups[,9][!is.na(Foodgroups[,9])] saltedfishandrelatedproductfoodex2code <- Foodgroups[,10][!is.na(Foodgroups[,10])] seabassfoodex2code <- Foodgroups[,11][!is.na(Foodgroups[,11])] snapperfoodex2code <- Foodgroups[,12][!is.na(Foodgroups[,12])] threadfinfoodex2code <- Foodgroups[,13][!is.na(Foodgroups[,13])] troutcodfoodex2code <- Foodgroups[,14][!is.na(Foodgroups[,14])] tunafoodex2code <- Foodgroups[,15][!is.na(Foodgroups[,15])] ##Classify exposure by Food group anchovyexposure <- Exposure[intersect(names(Exposure), anchovyfoodex2code)] cannedsardineexposure <- Exposure[intersect(names(Exposure), cannedsardinefoodex2code)] cannedtunaexposure <- Exposure[intersect(names(Exposure), cannedtunafoodex2code)] catfishexposure <- Exposure[intersect(names(Exposure), catfishfoodex2code)] fishheadexposure <- Exposure[intersect(names(Exposure), fishheadfoodex2code)] grouperexposure <- Exposure[intersect(names(Exposure), grouperfoodex2code)] kuningandrelatedfishesexposure <- Exposure[intersect(names(Exposure), kuningandrelatedfishesfoodex2code)] mackerelandrelatedfishesexposure <- Exposure[intersect(names(Exposure), mackerelandrelatedfishesfoodex2code)] salmonexposure <- Exposure[intersect(names(Exposure), salmonfoodex2code)] saltedfishandrelatedproductexposure <- Exposure[intersect(names(Exposure), saltedfishandrelatedproductfoodex2code)] seabassexposure <- Exposure[intersect(names(Exposure), seabassfoodex2code)] snapperexposure <- Exposure[intersect(names(Exposure), snapperfoodex2code)] threadfinexposure <- Exposure[intersect(names(Exposure), threadfinfoodex2code)] troutcodexposure<- Exposure[intersect(names(Exposure), troutcodfoodex2code)] tunaexposure <- Exposure[intersect(names(Exposure), tunafoodex2code)] #### anchovyexposure <- rowSums(anchovyexposure) cannedsardineexposure <- rowSums(cannedsardineexposure) cannedtunaexposure <- rowSums(cannedtunaexposure) catfishexposure <- rowSums(catfishexposure) fishheadexposure <- rowSums(fishheadexposure) grouperexposure <- rowSums(grouperexposure) kuningandrelatedfishesexposure<- rowSums(kuningandrelatedfishesexposure) mackerelandrelatedfishesexposure <- rowSums(mackerelandrelatedfishesexposure ) salmonexposure <- rowSums(salmonexposure) saltedfishandrelatedproductexposure <- rowSums(saltedfishandrelatedproductexposure) seabassexposure <- rowSums(seabassexposure) snapperexposure <- rowSums(snapperexposure) threadfinexposure<- rowSums(threadfinexposure) troutcodexposure<-rowSums(troutcodexposure) tunaexposure <- rowSums(tunaexposure) totalexposuredf <- cbind.data.frame(anchovyexposure,cannedsardineexposure,cannedtunaexposure, catfishexposure,fishheadexposure,grouperexposure, kuningandrelatedfishesexposure,mackerelandrelatedfishesexposure,salmonexposure, saltedfishandrelatedproductexposure,seabassexposure,snapperexposure,threadfinexposure, troutcodexposure,tunaexposure) totalexposuredf[is.na(totalexposuredf)] <- 0 totalexposure <- rowSums(totalexposuredf) summaryofexposureperfood <- (round(prop.table(colSums(totalexposuredf)) * 100,digits = 2)) summaryofexposureperfood summaryofexposureperfood_df <- as.data.frame(summaryofexposureperfood) #clipr::write_clip(as.data.frame(summaryofexposureperfood)) #totalexposure <- as.data.frame(cbind(consumption_all[,c("ID")], totalexposuredf)) #colnames(totalexposure)[1] <- "ID" #totalexposuredfmelted <- melt(data = totalexposure,id.vars = "ID") #totalexposuredfmelted$plot <- 1 #totalexposuredfmelted$variable <-gsub("exposure","",totalexposuredfmelted$variable) #library(ggplot2) #ggplot(totalexposuredfmelted, aes(x = variable, y = value, colour= variable)) + # geom_jitter() + theme_classic() #totalexposuredf <- cbind.data.frame(totalexposuredf, totalexposure) #Creation of DALYS, YLL, YLD case per file #install.packages install.packages("mc2d") install.packages("readr") install.packages("readxl") #load libraries library(mc2d) library(readr) library(readxl) rm(list=ls()) nsim <- 1000 set.seed(123) #Total Prevalence for Male, IHME GBD 2021, Singapore #lung cancer prevalence_lc_m_value <-2493.46927 prevalence_lc_m_upper <-2895.97971 prevalence_lc_m_lower <-2152.86664 #skin cancer prevalence_sc_m_value <-144.72846 prevalence_sc_m_upper <-179.08058 prevalence_sc_m_lower <-115.29904 #bladder cancer prevalence_bc_m_value <-1800.32670 prevalence_bc_m_upper <-1992.35778 prevalence_bc_m_lower <-1592.81526 #Total Prevalence for female, IHME GBD 2021,Singapore #lung cancer prevalence_lc_f_value <-1604.32024 prevalence_lc_f_upper <-1803.52863 prevalence_lc_f_lower <-1404.91856 #skin cancer prevalence_sc_f_value <-90.92660 prevalence_sc_f_upper <-109.59664 prevalence_sc_f_lower <-75.80170 #bladder cancer prevalence_bc_f_value <-552.65238 prevalence_bc_f_upper <-620.81356 prevalence_bc_f_lower <-476.21374 #function to calculate dalys per case calculate_dalys_per_case <- function(daly_min, daly_mode, daly_max, prev_min, prev_mode, prev_max) { daly_dist <- rpert(nsim, min=daly_min, mode=daly_mode, max=daly_max) prev_dist <- rpert(nsim, min=prev_min, mode=prev_mode, max=prev_max) return(daly_dist/prev_dist) } #Total DALYS for Male, IHME GBD 2021, Singapore #lung cancer DALY_lc_m_value <-18177.56512 DALY_lc_m_upper <-20526.63084 DALY_lc_m_lower <-16143.97519 #skin cancer DALY_sc_m_value <-185.03438 DALY_sc_m_upper <-201.48638 DALY_sc_m_lower <-169.48461 #bladder cancer DALY_bc_m_value <-1550.67164 DALY_bc_m_upper <-1705.80645 DALY_bc_m_lower <-1376.20711 #Calculation for DALYS per case for Male, IHME GBD 2021, Singapore #lung cancer daly_case_lc_male <- calculate_dalys_per_case( DALY_lc_m_lower, DALY_lc_m_value, DALY_lc_m_upper, prevalence_lc_m_lower, prevalence_lc_m_value, prevalence_lc_m_upper ) write.csv(data.frame(x=daly_case_lc_male), "daly_case_lc_male.csv", row.names=TRUE) #bladder cancer daly_case_bc_male <- calculate_dalys_per_case( DALY_bc_m_lower, DALY_bc_m_value, DALY_bc_m_upper, prevalence_bc_m_lower, prevalence_bc_m_value, prevalence_bc_m_upper ) write.csv(data.frame(x=daly_case_bc_male), "daly_case_bc_male.csv", row.names=TRUE) #skin cancer daly_case_sc_male <- calculate_dalys_per_case( DALY_sc_m_lower, DALY_sc_m_value, DALY_sc_m_upper, prevalence_sc_m_lower, prevalence_sc_m_value, prevalence_sc_m_upper ) write.csv(data.frame(x=daly_case_sc_male), "daly_case_sc_male.csv", row.names=TRUE) #Total DALYS for Female, IHME GBD 2021, Singapore #lung cancer DALY_lc_f_value <-9908.60016 DALY_lc_f_upper <-10995.05237 DALY_lc_f_lower <-8885.36063 #skin cancer DALY_sc_f_value <-127.27360 DALY_sc_f_upper <-140.01638 DALY_sc_f_lower <-107.44465 #bladder cancer DALY_bc_f_value <-610.49601 DALY_bc_f_upper <-698.54532 DALY_bc_f_lower <-506.14127 #Calculation for DALYS per case for Female, IHME GBD 2021, Singapore # Lung cancer daly_case_lc_female <- calculate_dalys_per_case( DALY_lc_f_lower, DALY_lc_f_value, DALY_lc_f_upper, prevalence_lc_f_lower, prevalence_lc_f_value, prevalence_lc_f_upper ) write.csv(data.frame(x=daly_case_lc_female), "daly_case_lc_female.csv", row.names=TRUE) # Bladder cancer daly_case_bc_female <- calculate_dalys_per_case( DALY_bc_f_lower, DALY_bc_f_value, DALY_bc_f_upper, prevalence_bc_f_lower, prevalence_bc_f_value, prevalence_bc_f_upper ) write.csv(data.frame(x=daly_case_bc_female), "daly_case_bc_female.csv", row.names=TRUE) # Skin cancer daly_case_sc_female <- calculate_dalys_per_case( DALY_sc_f_lower, DALY_sc_f_value, DALY_sc_f_upper, prevalence_sc_f_lower, prevalence_sc_f_value, prevalence_sc_f_upper ) write.csv(data.frame(x=daly_case_sc_female), "daly_case_sc_female.csv", row.names=TRUE) #####Calculation of YLLs #Total YLL for Male, IHME GBD 2021, Singapore #lung cancer YLL_lc_m_value <-17852.79624 YLL_lc_m_upper <-20168.06345 YLL_lc_m_lower <-15835.13726 #skin cancer YLL_sc_m_value <-180.1492033 YLL_sc_m_upper <-196.5985329 YLL_sc_m_lower <-164.7450194 #bladder cancer YLL_bc_m_value <-1392.02923 YLL_bc_m_upper <-1522.066723 YLL_bc_m_lower <-1239.945257 #Calculation for YLL per case for Male, IHME GBD 2021, Singapore #function to calculate YLL per case calculate_yll_per_case <- function(yll_min, yll_mode, yll_max, prev_min, prev_mode, prev_max) { yll_dist <- rpert(nsim, min=yll_min, mode=yll_mode, max=yll_max) prev_dist <- rpert(nsim, min=prev_min, mode=prev_mode, max=prev_max) return(yll_dist/prev_dist) } # Males calculations # Lung cancer yll_case_lc_male <- calculate_yll_per_case( YLL_lc_m_lower, YLL_lc_m_value, YLL_lc_m_upper, prevalence_lc_m_lower, prevalence_lc_m_value, prevalence_lc_m_upper ) write.csv(data.frame(x=yll_case_lc_male), "YLL_case_lc_m.csv", row.names=TRUE) # Bladder cancer yll_case_bc_male <- calculate_yll_per_case( YLL_bc_m_lower, YLL_bc_m_value, YLL_bc_m_upper, prevalence_bc_m_lower, prevalence_bc_m_value, prevalence_bc_m_upper ) write.csv(data.frame(x=yll_case_bc_male), "YLL_case_bc_m.csv", row.names=TRUE) # Skin cancer yll_case_sc_male <- calculate_yll_per_case( YLL_sc_m_lower, YLL_sc_m_value, YLL_sc_m_upper, prevalence_sc_m_lower, prevalence_sc_m_value, prevalence_sc_m_upper ) write.csv(data.frame(x=yll_case_sc_male), "YLL_case_sc_m.csv", row.names=TRUE) #Total YLL for Female, IHME GBD 2021, Singapore #lung cancer YLL_lc_f_value <-9709.285885 YLL_lc_f_upper <-10782.4927 YLL_lc_f_lower <-8720.850728 #skin cancer YLL_sc_f_value <- 124.8432916 YLL_sc_f_upper <- 137.4370799 YLL_sc_f_lower <- 104.9267162 #bladder cancer YLL_bc_f_value <-558.9654313 YLL_bc_f_upper <-638.5645608 YLL_bc_f_lower <-466.4012107 #Calculation for YLL per case for Female, IHME GBD 2021, Singapore # Females calculations # Lung cancer yll_case_lc_female <- calculate_yll_per_case( YLL_lc_f_lower, YLL_lc_f_value, YLL_lc_f_upper, prevalence_lc_f_lower, prevalence_lc_f_value, prevalence_lc_f_upper ) write.csv(data.frame(x=yll_case_lc_female), "YLL_case_lc_f.csv", row.names=TRUE) # Bladder cancer yll_case_bc_female <- calculate_yll_per_case( YLL_bc_f_lower, YLL_bc_f_value, YLL_bc_f_upper, prevalence_bc_f_lower, prevalence_bc_f_value, prevalence_bc_f_upper ) write.csv(data.frame(x=yll_case_bc_female), "YLL_case_bc_f.csv", row.names=TRUE) # Skin cancer yll_case_sc_female <- calculate_yll_per_case( YLL_sc_f_lower, YLL_sc_f_value, YLL_sc_f_upper, prevalence_sc_f_lower, prevalence_sc_f_value, prevalence_sc_f_upper ) write.csv(data.frame(x=yll_case_sc_female), "YLL_case_sc_f.csv", row.names=TRUE) #############Creation of YLD Case #Total YLD for Male, IHME GBD 2021, Singapore #lung cancer YLD_lc_m_value <-324.7688758 YLD_lc_m_upper <-431.7076794 YLD_lc_m_lower <-229.8844871 #skin cancer YLD_sc_m_value <-4.885173733 YLD_sc_m_upper <-7.715019861 YLD_sc_m_lower <-2.979278258 #bladder cancer YLD_bc_m_value <-158.642415 YLD_bc_m_upper <-217.028632 YLD_bc_m_lower <-111.5916225 #Calculation for YLD per case for Male, IHME GBD 2021, Singapore # function to calculate YLD per case calculate_yld_per_case <- function(yld_min, yld_mode, yld_max, prev_min, prev_mode, prev_max) { yld_dist <- rpert(nsim, min=yld_min, mode=yld_mode, max=yld_max) prev_dist <- rpert(nsim, min=prev_min, mode=prev_mode, max=prev_max) return(yld_dist/prev_dist) } # Males calculations # Lung cancer yld_case_lc_male <- calculate_yld_per_case( YLD_lc_m_lower, YLD_lc_m_value, YLD_lc_m_upper, prevalence_lc_m_lower, prevalence_lc_m_value, prevalence_lc_m_upper ) write.csv(data.frame(x=yld_case_lc_male), "YLD_case_lc_m.csv", row.names=TRUE) # Bladder cancer yld_case_bc_male <- calculate_yld_per_case( YLD_bc_m_lower, YLD_bc_m_value, YLD_bc_m_upper, prevalence_bc_m_lower, prevalence_bc_m_value, prevalence_bc_m_upper ) write.csv(data.frame(x=yld_case_bc_male), "YLD_case_bc_m.csv", row.names=TRUE) # Skin cancer yld_case_sc_male <- calculate_yld_per_case( YLD_sc_m_lower, YLD_sc_m_value, YLD_sc_m_upper, prevalence_sc_m_lower, prevalence_sc_m_value, prevalence_sc_m_upper ) write.csv(data.frame(x=yld_case_sc_male), "YLD_case_sc_m.csv", row.names=TRUE) #Total YLD for Female, IHME GBD 2021, Singapore #lung cancer YLD_lc_f_value <-199.3142791 YLD_lc_f_upper <- 271.6971632 YLD_lc_f_lower <-141.0072832 #skin cancer YLD_sc_f_value <- 2.430308227 YLD_sc_f_upper <- 3.705710195 YLD_sc_f_lower <- 1.454679355 #bladder cancer YLD_bc_f_value <-51.53057919 YLD_bc_f_upper <-72.22998545 YLD_bc_f_lower <-36.15086662 #Calculation for YLD per case for Female, IHME GBD 2021, Singapore # Females calculations # Lung cancer yld_case_lc_female <- calculate_yld_per_case( YLD_lc_f_lower, YLD_lc_f_value, YLD_lc_f_upper, prevalence_lc_f_lower, prevalence_lc_f_value, prevalence_lc_f_upper ) write.csv(data.frame(x=yld_case_lc_female), "YLD_case_lc_f.csv", row.names=TRUE) # Bladder cancer yld_case_bc_female <- calculate_yld_per_case( YLD_bc_f_lower, YLD_bc_f_value, YLD_bc_f_upper, prevalence_bc_f_lower, prevalence_bc_f_value, prevalence_bc_f_upper ) write.csv(data.frame(x=yld_case_bc_female), "YLD_case_bc_f.csv", row.names=TRUE) # Skin cancer yld_case_sc_female <- calculate_yld_per_case( YLD_sc_f_lower, YLD_sc_f_value, YLD_sc_f_upper, prevalence_sc_f_lower, prevalence_sc_f_value, prevalence_sc_f_upper ) write.csv(data.frame(x=yld_case_sc_female), "YLD_case_sc_f.csv", row.names=TRUE) #####Calculate mortality per case set.seed(123) #prevalence for both gender, Singapore, IHME 2022 prevalence_lc_value_mf <- 4097.78951 prevalence_lc_upper_mf <- 4640.582394 prevalence_lc_lower_mf <- 3632.602516 #skin cancer prevalence_sc_value_mf <- 235.655062 prevalence_sc_upper_mf <- 283.2244094 prevalence_sc_lower_mf <- 193.5529802 #bladder cancer prevalence_bc_value_mf <-2352.979079 prevalence_bc_upper_mf <-2584.203016 prevalence_bc_lower_mf <-2107.856888 #Mortality for both gender #lung cancer mortality_lc_value_mf <-1359.145005 mortality_lc_upper_mf <- 1516.814573 mortality_lc_lower_mf <-1220.56362 #skin cancer mortality_sc_value_mf <- 18.56941094 mortality_sc_upper_mf <- 20.35990337 mortality_sc_lower_mf <- 15.88560613 #bladder cancer mortality_bc_value_mf <-116.3710548 mortality_bc_upper_mf <-128.7995296 mortality_bc_lower_mf <-100.8121896 #function to calculate mortality/prevalence ratio calculate_mort_prev_ratio <- function(mort_min, mort_mode, mort_max, prev_min, prev_mode, prev_max) { mort_dist <- rpert(nsim, min=mort_min, mode=mort_mode, max=mort_max) prev_dist <- rpert(nsim, min=prev_min, mode=prev_mode, max=prev_max) return(mort_dist/prev_dist) } # Combined gender calculations # Lung cancer mort_prev_ratio_lc <- calculate_mort_prev_ratio( mortality_lc_lower_mf, mortality_lc_value_mf, mortality_lc_upper_mf, prevalence_lc_lower_mf, prevalence_lc_value_mf, prevalence_lc_upper_mf ) write.csv(data.frame(x=mort_prev_ratio_lc), "lc_mortality.csv", row.names=TRUE) # Bladder cancer mort_prev_ratio_bc <- calculate_mort_prev_ratio( mortality_bc_lower_mf, mortality_bc_value_mf, mortality_bc_upper_mf, prevalence_bc_lower_mf, prevalence_bc_value_mf, prevalence_bc_upper_mf ) write.csv(data.frame(x=mort_prev_ratio_bc), "bc_mortality.csv", row.names=TRUE) # Skin cancer mort_prev_ratio_sc <- calculate_mort_prev_ratio( mortality_sc_lower_mf, mortality_sc_value_mf, mortality_sc_upper_mf, prevalence_sc_lower_mf, prevalence_sc_value_mf, prevalence_sc_upper_mf ) write.csv(data.frame(x=mort_prev_ratio_sc), "sc_mortality.csv", row.names=TRUE) ##Main inorganic arsenic model code, repeat for AS1, AS2 and AS3 by changing the consumption file. #install packages install.packages("mc2d") install.packages("readr") install.packages("dplyr") install.packages("tidyr") install.packages("reshape2") install.packages("readxl") install.packages("tidyverse") install.packages("data.table") install.packages("fitdistrplus") install.packages("goftest") install.packages("grid") install.packages("gridExtra") #packages library(mc2d) library(readr) library(dplyr) library(tidyr) library(DALY) library(reshape2) library(readxl) library(tidyverse) library(data.table) library(fitdistrplus) library(goftest) library(grid) library(gridExtra) #Load function mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } nvar <- 10^5 ##Change the consumption file depending on scenario (AS1, AS2 or AS3) if(consumption_all == 0){ consumption_all <- read.csv("consumption_baseline_foodex2_26032025.csv") } else { consumption_all = consumption_all } if(concentration_arsenic == 0){ concentration_arsenic <- read.csv("04082025 inorganicarsenicconc.csv") } else { concentration_arsenic = concentration_arsenic } if(Individualinfo == 0){ Individualinfo <- read.csv("21032025 Individualinfo.csv") } else { Individualinfo = Individualinfo } #consumption data consumption_all <- as.data.frame(consumption_all[,-1]) concentration_arsenic <- na.omit(concentration_arsenic) concentration_arsenic_foodex2 <- concentration_arsenic[,c(2,3)] listoffoods <- concentration_arsenic_foodex2[,1] concentration_arsenic_foodex2 <- concentration_arsenic_foodex2[,2] concentration_arsenic_foodex2 <- t(concentration_arsenic_foodex2) concentration_arsenic_foodex2 <- as.data.frame(concentration_arsenic_foodex2) colnames(concentration_arsenic_foodex2) <- listoffoods consumption_all <- merge.data.frame(consumption_all,Individualinfo,by = "NOIND") consumption_all <- consumption_all %>% rename(ID = NOIND) # Exposure calculations exp_ias <- mapply("*", consumption_all[intersect(names(consumption_all), names(concentration_arsenic_foodex2))], concentration_arsenic_foodex2[intersect(names(consumption_all), names(concentration_arsenic_foodex2))]) exp_ias <- as.data.frame(exp_ias) Exposure <- exp_ias source("Exposureperfoodgroup.R") ias_contribution_total <- colMeans(exp_ias, na.rm = TRUE) total_exp_ias = rowSums(exp_ias) exp_ias <- as.data.frame(cbind(consumption_all[,c("ID","bw","sex","age")], total_exp_ias)) colnames(exp_ias) <- c("ID","bodyweight","Sex","Age","total_exp_ias") exp_ias <- na.omit(exp_ias) exp_ias <- exp_ias %>% rename(total_exp = total_exp_ias) %>% mutate(exp_bw = total_exp / bodyweight) round(mean(exp_ias$exp_bw), 3) round(quantile(exp_ias$exp_bw, probs = c(0.025, 0.975)), 3) #Calculating TWI percentage <- mean(exp_ias$exp_bw > 3, na.rm = TRUE) * 100 print(paste("Percentage exceeding 3:", round(percentage, 2), "%")) #exp_ias <- exp_ias[which(exp_ias$total_exp > 0),] #Variation in exposure between agegroups agebreaks <- c(0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80) agelabels= c("1-4","5-9","10-14","15-19","20-24","25-29","30-34","35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74","75-80") setDT(exp_ias)[ , age_gr:= cut(Age, breaks= agebreaks, right= FALSE, labels= agelabels)] #Variation in exposure between agegroups and sex exp_ias_f <- subset(exp_ias, Sex ==2) setDT(exp_ias_f)[ , age_gr:= cut(Age, breaks= agebreaks, right= FALSE, labels= agelabels)] exp_ias_m <- subset(exp_ias, Sex ==1) setDT(exp_ias_m)[ , age_gr:= cut(Age, breaks= agebreaks, right= FALSE, labels= agelabels)] nunc <- 1e+03 nvar <- 1e+05 #load exposure data exp_male <- exp_ias_m exp_female <- exp_ias_f #Health outcome ###probability of cancers### x_male <- mean(exp_male$exp_bw) x_female <- mean(exp_female$exp_bw) print(x_male) print(x_female) #Population_size SG 2022, DOS Total_size_pop <- Pop_size_male + Pop_size_female # Dose-Response relationship #FDA2016 r_lc_male <- (1*10^(-5))*(x_male^2)+0.001*x_male #FDA/Irisk 2016 r_bc_male <- (9*10^(-6))*(x_male^2)+0.0004*x_male #FDA/Irisk 2016 r_sc_male <- 0.00150*x_male #EPA 2001 r_lc_female <- (1*10^(-5))*(x_female^2)+0.001*x_female #FDA/Irisk 2016 r_bc_female <- (9*10^(-6))*(x_female^2)+0.0004*x_female #FDA/Irisk 2016 r_sc_female <- 0.00150*x_female #EPA 2001 Life_exp_male <- 80.7 #SG Resident Male Life Expectancy at Birth 2022, DOS Life_exp_female <- 85.2 #SG Resident Female Life Expectancy at Birth 2022, DOS # Attributable incidence - formula: annual number of cases (AC) = (population size x exposure (ug/kg bw) x CSF (Cancer slope factor)/ life exp in population) AC_lc_male <-(Pop_size_male * x_male * r_lc_male/ Life_exp_male) AC_bc_male <-(Pop_size_male * x_male * r_bc_male/ Life_exp_male) AC_sc_male <-(Pop_size_male * x_male * r_sc_male/ Life_exp_male) AC_lc_female <-(Pop_size_female * x_female * r_lc_female/ Life_exp_female) AC_bc_female <-(Pop_size_female * x_female * r_bc_female/ Life_exp_female) AC_sc_female <-(Pop_size_female * x_female * r_sc_female/ Life_exp_female) AC_sum_male <- (AC_lc_male + AC_bc_male + AC_sc_male) AC_sum_female <-(AC_lc_female + AC_bc_female + AC_sc_female) AC_sum_all <- AC_sum_male + AC_sum_female AC_lc_sum <- AC_lc_male + AC_lc_female AC_lc_sum_rel <- AC_lc_sum/Total_size_pop*1e+05 AC_bc_sum <- AC_bc_male + AC_bc_female AC_bc_sum_rel <- AC_bc_sum/Total_size_pop*1e+05 AC_sc_sum <- AC_sc_male + AC_sc_female AC_sc_sum_rel <- AC_sc_sum/Total_size_pop*1e+05 ###For AC Calculations with distributions ###probability of cancers### x_male_AC <- exp_male$exp_bw x_female_AC <- exp_female$exp_bw # Dose-Response relationship #FDA2016 r_lc_male_AC <- (1*10^(-5))*(x_male_AC^2)+0.001*x_male_AC #FDA/Irisk 2016 r_bc_male_AC <- (9*10^(-6))*(x_male_AC^2)+0.0004*x_male_AC #FDA/Irisk 2016 r_sc_male_AC <- 0.00150*x_male_AC #EPA 2001 r_lc_female_AC <- (1*10^(-5))*(x_female_AC^2)+0.001*x_female_AC #FDA/Irisk 2016 r_bc_female_AC <- (9*10^(-6))*(x_female_AC^2)+0.0004*x_female_AC #FDA/Irisk 2016 r_sc_female_AC <- 0.00150*x_female_AC #EPA 2001 # Attributable incidence - formula: annual number of cases (AC) = (population size x exposure (ug/kg bw) x CSF (Cancer slope factor)/ life exp in population) AC_lc_male_AC <-(Pop_size_male * x_male_AC * r_lc_male_AC/ Life_exp_male) AC_bc_male_AC <-(Pop_size_male * x_male_AC * r_bc_male_AC/ Life_exp_male) AC_sc_male_AC <-(Pop_size_male * x_male_AC * r_sc_male_AC/ Life_exp_male) AC_lc_female_AC <-(Pop_size_female * x_female_AC * r_lc_female_AC/ Life_exp_female) AC_bc_female_AC <-(Pop_size_female * x_female_AC * r_bc_female_AC/ Life_exp_female) AC_sc_female_AC <-(Pop_size_female * x_female_AC * r_sc_female_AC/ Life_exp_female) AC_sum_male_AC <- (AC_lc_male_AC + AC_bc_male_AC + AC_sc_male_AC) AC_sum_female_AC <-(AC_lc_female_AC + AC_bc_female_AC + AC_sc_female_AC) AC_sum_all_AC <- AC_sum_male_AC + AC_sum_female_AC AC_lc_sum_AC <- AC_lc_male_AC + AC_lc_female_AC AC_lc_sum_rel_AC <- AC_lc_sum_AC/Total_size_pop*1e+05 AC_bc_sum_AC <- AC_bc_male_AC + AC_bc_female_AC AC_bc_sum_rel_AC <- AC_bc_sum_AC/Total_size_pop*1e+05 AC_sc_sum_AC <- AC_sc_male_AC + AC_sc_female_AC AC_sc_sum_rel_AC <- AC_sc_sum_AC/Total_size_pop*1e+05 mean_median_ci(AC_sum_all_AC) ####Mortality estimations#### #load mortality data" lc_mort <- read.csv("lc_mortality.csv") bc_mort <- read.csv("bc_mortality.csv") sc_mort <- read.csv("sc_mortality.csv") #Lung cancer lc_morta <- lc_mort$x * AC_lc_sum mean_median_ci(lc_morta) lc_mort_rel <- lc_mort$x * AC_lc_sum/Total_size_pop*1e+05 mean_median_ci(lc_mort_rel) # Bladder cancer bc_morta <- bc_mort$x * AC_bc_sum mean_median_ci(bc_morta) bc_mort_rel <- bc_mort$x * AC_bc_sum/Total_size_pop*1e+05 mean_median_ci(bc_mort_rel) #Skin cancer sc_morta <- sc_mort$x * AC_sc_sum mean_median_ci(sc_morta) sc_mort_rel <- sc_mort$x * AC_sc_sum/Total_size_pop*1e+05 mean_median_ci(sc_mort_rel) ####DALY estimations#### #Load DALY per case data (from iAs_disease model) DALY_case_lc_m <- read.csv("daly_case_lc_male.csv") DALY_case_lc_f <- read.csv("daly_case_lc_female.csv") DALY_case_bc_m <- read.csv("daly_case_bc_male.csv") DALY_case_bc_f <- read.csv("daly_case_bc_female.csv") DALY_case_sc_m <- read.csv("daly_case_sc_male.csv") DALY_case_sc_f <- read.csv("daly_case_sc_female.csv") YLD_lc_m <- read.csv("YLD_case_lc_m.csv") YLL_lc_m <- read.csv("YLL_case_lc_m.csv") YLD_lc_f <- read.csv("YLD_case_lc_f.csv") YLL_lc_f <- read.csv("YLL_case_lc_f.csv") YLD_bc_m <- read.csv("YLD_case_bc_m.csv") YLL_bc_m <- read.csv("YLL_case_bc_m.csv") YLD_bc_f <- read.csv("YLD_case_bc_f.csv") YLL_bc_f <- read.csv("YLL_case_bc_f.csv") YLD_sc_m <- read.csv("YLD_case_sc_m.csv") YLL_sc_m <- read.csv("YLL_case_sc_m.csv") YLD_sc_f <- read.csv("YLD_case_sc_f.csv") YLL_sc_f <- read.csv("YLL_case_sc_f.csv") #DALY per case for each cancer (average of male and female) DALY_case_lc <- (DALY_case_lc_f$x + DALY_case_lc_m$x)/2 mean_median_ci(DALY_case_lc) DALY_case_bc <- (DALY_case_bc_f$x + DALY_case_bc_m$x)/2 mean_median_ci(DALY_case_bc) DALY_case_sc <- (DALY_case_sc_f$x + DALY_case_sc_m$x)/2 mean_median_ci(DALY_case_sc) mean_DALY_case <- (DALY_case_lc + DALY_case_bc + DALY_case_sc)/3 mean_median_ci(mean_DALY_case) #DALY for each cancer + total (add per gender and per cancer type) #Lung cancer DALY_lc_m1 <- DALY_case_lc_m$x *AC_lc_male mean_median_ci(DALY_lc_m1) DALY_lc_f1 <- DALY_case_lc_f$x *AC_lc_female mean_median_ci(DALY_lc_f1) DALY_lc1 <- (DALY_case_lc_m$x *AC_lc_male) + (DALY_case_lc_f$x *AC_lc_female) mean_median_ci(DALY_lc1) #Bladder cancer DALY_bc_m1 <- DALY_case_bc_m$x *AC_bc_male mean_median_ci(DALY_bc_m1) DALY_bc_f1 <- DALY_case_bc_f$x *AC_bc_female mean_median_ci(DALY_bc_f1) DALY_bc1 <- (DALY_case_bc_m$x *AC_bc_male) + (DALY_case_bc_f$x *AC_bc_female) mean_median_ci(DALY_bc1) #skin cancer DALY_sc_m1 <- DALY_case_sc_m$x *AC_sc_male mean_median_ci(DALY_sc_m1) DALY_sc_f1 <- DALY_case_sc_f$x *AC_sc_female mean_median_ci(DALY_sc_f1) DALY_sc1 <- (DALY_case_sc_m$x *AC_sc_male) + (DALY_case_sc_f$x *AC_sc_female) mean_median_ci(DALY_sc1) #all cancers DALY_total <- DALY_lc1 + DALY_bc1 + DALY_sc1 mean_median_ci(DALY_total) DALY_total_rel <- DALY_total/Total_size_pop*1e+05 ; DALY_total_rel #0.005801815 mean_median_ci(DALY_total_rel) ####YLD estimatations YLD_lc <- AC_lc_sum * (YLD_lc_f$x+YLD_lc_f$x)/2 mean_median_ci(YLD_lc) YLD_bc <- AC_bc_sum * (YLD_bc_f$x+YLD_bc_f$x)/2 mean_median_ci(YLD_bc) YLD_sc <- AC_sc_sum * (YLD_sc_f$x+YLD_sc_f$x)/2 mean_median_ci(YLD_sc) YLD <- ((AC_lc_sum * (YLD_lc_f$x+YLD_lc_f$x)/2)+(AC_bc_sum * (YLD_bc_f$x+YLD_bc_f$x)/2)+(AC_sc_sum * (YLD_sc_f$x+YLD_sc_f$x)/2)) mean_median_ci(YLD) ####YLL estimations YLL_lc <- AC_lc_sum * (YLL_lc_f$x+YLL_lc_f$x)/2 mean_median_ci(YLL_lc) YLL_bc <- AC_bc_sum * (YLL_bc_f$x+YLL_bc_f$x)/2 mean_median_ci(YLL_bc) YLL_sc <- AC_sc_sum * (YLL_sc_f$x+YLL_sc_f$x)/2 mean_median_ci(YLL_sc) YLL <- ((AC_lc_sum * (YLL_lc_f$x+YLL_lc_f$x)/2)+(AC_bc_sum * (YLL_bc_f$x+YLL_bc_f$x)/2)+(AC_sc_sum * (YLL_sc_f$x+YLL_sc_f$x)/2)) mean_median_ci(YLL) #LUNG CANCER #DALY for each cancer + total (add per gender and per cancer type) DALY_lc_m1 <- DALY_case_lc_m$x *AC_lc_male mean_median_ci(DALY_lc_m1) DALY_lc_f1 <- DALY_case_lc_f$x *AC_lc_female mean_median_ci(DALY_lc_f1) DALY_lc1 <- (DALY_case_lc_m$x *AC_lc_male) + (DALY_case_lc_f$x *AC_lc_female) mean_median_ci(DALY_lc1) # Bladder cancer DALY_bc_m1 <- DALY_case_bc_m$x *AC_bc_male mean_median_ci(DALY_bc_m1) DALY_bc_f1 <- DALY_case_bc_f$x *AC_bc_female mean_median_ci(DALY_bc_f1) DALY_bc1 <- (DALY_case_bc_m$x *AC_bc_male) + (DALY_case_bc_f$x *AC_bc_female) mean_median_ci(DALY_bc1) # SKIN CANCER DALY_sc_m1 <- DALY_case_sc_m$x *AC_sc_male mean_median_ci(DALY_sc_m1) DALY_sc_f1 <- DALY_case_sc_f$x *AC_sc_female mean_median_ci(DALY_sc_f1) DALY_sc1 <- (DALY_case_sc_m$x *AC_sc_male) + (DALY_case_sc_f$x *AC_sc_female) mean_median_ci(DALY_sc1) DALY_total <- DALY_lc1 + DALY_bc1 + DALY_sc1 mean_median_ci(DALY_total) DALY_total_rel <- DALY_total/Total_size_pop*1e+05 ; DALY_total_rel #0.005801815 mean_median_ci(DALY_total_rel) ####YLD estimatations YLD_lc <- AC_lc_sum * (YLD_lc_f$x+YLD_lc_f$x)/2 mean_median_ci(YLD_lc) YLD_bc <- AC_bc_sum * (YLD_bc_f$x+YLD_bc_f$x)/2 mean_median_ci(YLD_bc) YLD_sc <- AC_sc_sum * (YLD_sc_f$x+YLD_sc_f$x)/2 mean_median_ci(YLD_sc) YLD <- ((AC_lc_sum * (YLD_lc_f$x+YLD_lc_f$x)/2)+(AC_bc_sum * (YLD_bc_f$x+YLD_bc_f$x)/2)+(AC_sc_sum * (YLD_sc_f$x+YLD_sc_f$x)/2)) mean_median_ci(YLD) ####YLL estimations YLL_lc <- AC_lc_sum * (YLL_lc_f$x+YLL_lc_f$x)/2 mean_median_ci(YLL_lc) YLL_bc <- AC_bc_sum * (YLL_bc_f$x+YLL_bc_f$x)/2 mean_median_ci(YLL_bc) YLL_sc <- AC_sc_sum * (YLL_sc_f$x+YLL_sc_f$x)/2 mean_median_ci(YLL_sc) YLL <- ((AC_lc_sum * (YLL_lc_f$x+YLL_lc_f$x)/2)+(AC_bc_sum * (YLL_bc_f$x+YLL_bc_f$x)/2)+(AC_sc_sum * (YLL_sc_f$x+YLL_sc_f$x)/2)) mean_median_ci(YLL) dfsummaryDALY <- cbind(bladdercancer = DALY_bc1, skincancer = DALY_sc1, lungcancer =DALY_lc1, YLD_lungcancer = YLD_lc, YLD_bladdercancer =YLD_bc, YLD_skincancer = YLD_sc, YLL_lungcancer = YLL_lc, YLL_bladdercancer =YLL_bc, YLL_skincancer = YLL_sc, AC_sum_all = AC_sum_all_AC, TOTAL =DALY_total, TOTALper100000 = DALY_total/Total_size_pop*1e+05) outputresults <- apply(X = dfsummaryDALY,MARGIN = 2,FUN = mean_median_ci) outputresults <- t(outputresults) outputresults # Add row names as a column outputresults_df <- as.data.frame(outputresults) outputresults_df$metric <- rownames(outputresults) # Reorder columns to put metric name first outputresults_df <- outputresults_df[, c("metric", "mean", "median", "2.5%", "97.5%")] # Write to CSV, change this file name according to output write.csv(outputresults_df, file = "outputresults_baseline.csv", row.names = FALSE) ##################Save files for combined calculations # Total number of cases incidence_iAs_baseline <- data.frame( value = AC_sum_all_AC ) # Total number of DALYs TotalDALY_iAs_baseline <- data.frame( value = DALY_total ) # Total DALYs per 100,000 inhabitant DALYper100k_iAs_baseline <- data.frame( value = DALY_total_rel ) # Save as csv files write.csv(incidence_iAs_baseline, "incidence_iAs_baseline.csv", row.names = FALSE) write.csv(TotalDALY_iAs_baseline, "TotalDALY_iAs_baseline.csv", row.names = FALSE) write.csv(DALYper100k_iAs_baseline, "DALYper100k_iAs_baseline.csv", row.names = FALSE) ###Calculations for Inorganic Arsenic #clear environment rm(list=ls()) #function mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } #function to process files to compare alternative scenarios to baseline scenarios process_differences <- function(baseline_file, comparison_file, output_file) { baseline_data <- read.csv(baseline_file) comparison_data <- read.csv(comparison_file) diff_data <- data.frame(value = comparison_data$value - baseline_data$value) write.csv(diff_data, output_file, row.names = FALSE) stats <- mean_median_ci(diff_data$value) summary_stats <- data.frame( Mean = stats["mean"], Median = stats["median"], `2.5%` = stats["2.5%"], `97.5%` = stats["97.5%"] ) return(summary_stats) } types <- c("TotalDALY", "incidence", "DALYper100k") all_summaries <- data.frame() scenarios <- list( list(comp = "0.5", output = "AS1"), list(comp = "1.5", output = "AS2"), list(comp = "2", output = "AS3") ) for (scenario in scenarios) { for (type in types) { baseline_file <- sprintf("%s_iAs_baseline.csv", type) comparison_file <- sprintf("%s_iAs_%s.csv", type, scenario$comp) output_file <- sprintf("%s_iAs_%s.csv", scenario$output, type) summary_stats <- process_differences(baseline_file, comparison_file, output_file) summary_stats$Scenario <- scenario$output summary_stats$Type <- type all_summaries <- rbind(all_summaries, summary_stats) } } #export results write.csv(all_summaries, "summary_stats_iAs.csv", row.names = FALSE) ###Cadmium #Run default simulation (repeat for all scenarios, AS1, AS2, AS3) pop_size_men <- 1990212 #SG Resident Male Population 2022, DOS pop_size_women <- 2083027 # SG Resident Female Population 2022, DOS pop_agegr <- 0 LE <- 0 seyll <- 0 consumption_all <- 0 concentration_cadmium <- 0 Individualinfo <- 0 #Run exposure per food group (repeat for all scenarios, AS1, AS2, AS3) #Load food groups Foodgroups <- read.csv("26032025 foodgroups.csv") Foodgroups <- Foodgroups[,-1] colnames(Foodgroups) anchovyfoodex2code <- Foodgroups[,1][!is.na(Foodgroups[,1])] cannedsardinefoodex2code <- Foodgroups[,2][!is.na(Foodgroups[,2])] cannedtunafoodex2code <- Foodgroups[,3][!is.na(Foodgroups[,3])] catfishfoodex2code <- Foodgroups[,4][!is.na(Foodgroups[,4])] fishheadfoodex2code <- Foodgroups[,5][!is.na(Foodgroups[,5])] grouperfoodex2code <- Foodgroups[,6][!is.na(Foodgroups[,6])] kuningandrelatedfishesfoodex2code <- Foodgroups[,7][!is.na(Foodgroups[,7])] mackerelandrelatedfishesfoodex2code <- Foodgroups[,8][!is.na(Foodgroups[,8])] salmonfoodex2code <- Foodgroups[,9][!is.na(Foodgroups[,9])] saltedfishandrelatedproductfoodex2code <- Foodgroups[,10][!is.na(Foodgroups[,10])] seabassfoodex2code <- Foodgroups[,11][!is.na(Foodgroups[,11])] snapperfoodex2code <- Foodgroups[,12][!is.na(Foodgroups[,12])] threadfinfoodex2code <- Foodgroups[,13][!is.na(Foodgroups[,13])] troutcodfoodex2code <- Foodgroups[,14][!is.na(Foodgroups[,14])] tunafoodex2code <- Foodgroups[,15][!is.na(Foodgroups[,15])] ##Classify exposure by Food group anchovyexposure <- Exposure[intersect(names(Exposure), anchovyfoodex2code)] cannedsardineexposure <- Exposure[intersect(names(Exposure), cannedsardinefoodex2code)] cannedtunaexposure <- Exposure[intersect(names(Exposure), cannedtunafoodex2code)] catfishexposure <- Exposure[intersect(names(Exposure), catfishfoodex2code)] fishheadexposure <- Exposure[intersect(names(Exposure), fishheadfoodex2code)] grouperexposure <- Exposure[intersect(names(Exposure), grouperfoodex2code)] kuningandrelatedfishesexposure <- Exposure[intersect(names(Exposure), kuningandrelatedfishesfoodex2code)] mackerelandrelatedfishesexposure <- Exposure[intersect(names(Exposure), mackerelandrelatedfishesfoodex2code)] salmonexposure <- Exposure[intersect(names(Exposure), salmonfoodex2code)] saltedfishandrelatedproductexposure <- Exposure[intersect(names(Exposure), saltedfishandrelatedproductfoodex2code)] seabassexposure <- Exposure[intersect(names(Exposure), seabassfoodex2code)] snapperexposure <- Exposure[intersect(names(Exposure), snapperfoodex2code)] threadfinexposure <- Exposure[intersect(names(Exposure), threadfinfoodex2code)] troutcodexposure<- Exposure[intersect(names(Exposure), troutcodfoodex2code)] tunaexposure <- Exposure[intersect(names(Exposure), tunafoodex2code)] anchovyexposure <- rowSums(anchovyexposure) cannedsardineexposure <- rowSums(cannedsardineexposure) cannedtunaexposure <- rowSums(cannedtunaexposure) catfishexposure <- rowSums(catfishexposure) fishheadexposure <- rowSums(fishheadexposure) grouperexposure <- rowSums(grouperexposure) kuningandrelatedfishesexposure<- rowSums(kuningandrelatedfishesexposure) mackerelandrelatedfishesexposure <- rowSums(mackerelandrelatedfishesexposure ) salmonexposure <- rowSums(salmonexposure) saltedfishandrelatedproductexposure <- rowSums(saltedfishandrelatedproductexposure) seabassexposure <- rowSums(seabassexposure) snapperexposure <- rowSums(snapperexposure) threadfinexposure<- rowSums(threadfinexposure) troutcodexposure<-rowSums(troutcodexposure) tunaexposure <- rowSums(tunaexposure) totalexposuredf <- cbind.data.frame(anchovyexposure,cannedsardineexposure,cannedtunaexposure, catfishexposure,fishheadexposure,grouperexposure, kuningandrelatedfishesexposure,mackerelandrelatedfishesexposure,salmonexposure, saltedfishandrelatedproductexposure,seabassexposure,snapperexposure,threadfinexposure, troutcodexposure,tunaexposure) totalexposuredf[is.na(totalexposuredf)] <- 0 totalexposure <- rowSums(totalexposuredf) summaryofexposureperfood <- (round(prop.table(colSums(totalexposuredf)) * 100,digits = 2)) summaryofexposureperfood summaryofexposureperfood_df <- as.data.frame(summaryofexposureperfood) #clipr::write_clip(as.data.frame(summaryofexposureperfood)) #totalexposure <- as.data.frame(cbind(consumption_all[,c("ID")], totalexposuredf)) #colnames(totalexposure)[1] <- "ID" #totalexposuredfmelted <- melt(data = totalexposure,id.vars = "ID") #totalexposuredfmelted$plot <- 1 #totalexposuredfmelted$variable <-gsub("exposure","",totalexposuredfmelted$variable) #library(ggplot2) #ggplot(totalexposuredfmelted, aes(x = variable, y = value, colour= variable)) + # geom_jitter() + theme_classic() #totalexposuredf <- cbind.data.frame(totalexposuredf, totalexposure) ###Model for DALYS calculation. Code is repeated for AS1, AS2 and AS3, by reading the respective consumption files. #install packages install.packages("mc2d") install.packages("readr") install.packages("dplyr") install.packages("tidyr") install.packages("reshape2") install.packages("readxl") install.packages("tidyverse") install.packages("data.table") install.packages("xlsx") install.packages("fitdistrplus") install.packages("goftest") install.packages("grid") install.packages("gridExtra") rm(list=ls()) .libPaths(c("~/R/library",.libPaths())) #packages library(mc2d) library(readr) library(dplyr) library(tidyr) library(reshape2) library(readxl) library(tidyverse) library(data.table) library(fitdistrplus) library(goftest) library(grid) library(gridExtra) #Load function mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } nvar <- 10^5 ################################################## #change consumption file for AS1, AS2 and AS3 respectively if(consumption_all == 0){ consumption_all <- read.csv("consumption_baseline_foodex2_26032025.csv") } else { consumption_all = consumption_all } if(concentration_cadmium == 0){ concentration_cadmium <- read.csv("04082025 cadmiumconc.csv") } else { concentration_cadmium = concentration_cadmium } if(Individualinfo == 0){ Individualinfo <- read.csv("21032025 Individualinfo.csv") } else { Individualinfo = Individualinfo } if(pop_agegr == 0){ pop_agegr <- read.csv("cadmium agegr.csv") } else { pop_agegr = pop_agegr } if(LE == 0){ LE <- read.csv("cadmium LE.csv") } else { LE = LE } if(seyll == 0){ seyll <- read.csv("cadmium seyll.csv") } else { seyll = seyll } ####################################### consumption_all <- as.data.frame(consumption_all[,-1]) concentration_cadmium <- na.omit(concentration_cadmium) concentration_cadmium_foodex2 <- concentration_cadmium[,c(2,3)] listoffoods <- concentration_cadmium_foodex2[,1] concentration_cadmium_foodex2 <- concentration_cadmium_foodex2[,2] concentration_cadmium_foodex2 <- t(concentration_cadmium_foodex2) concentration_cadmium_foodex2 <- as.data.frame(concentration_cadmium_foodex2) colnames(concentration_cadmium_foodex2) <- listoffoods consumption_all <- merge.data.frame(consumption_all,Individualinfo,by = "NOIND") consumption_all <- consumption_all %>% rename(ID = NOIND) ######################################## # Exposure calculation exp_cd <- mapply("*", consumption_all[intersect(names(consumption_all), names(concentration_cadmium_foodex2))], concentration_cadmium_foodex2[intersect(names(consumption_all), names(concentration_cadmium_foodex2))]) exp_cd <- as.data.frame(exp_cd) Exposure <- exp_cd source("Exposureperfoodgroup.R") total_exp_cd = rowSums(exp_cd) exp_cd <- as.data.frame(cbind(consumption_all[,c("ID","bw","sex","age")], total_exp_cd)) exp_cd <- exp_cd %>% rename(total_exp = total_exp_cd) %>% #rename variable mutate(exp_bw = total_exp / bw) #new variable: exposure µg/kg bw/day exp_cd_40plus <- exp_cd %>% filter(age >= 40) %>% pull(exp_bw) round(mean(exp_cd_40plus), 3) round(quantile(exp_cd_40plus, probs = c(0.025, 0.975)), 3) #Calculating TWI percentage <- mean(exp_cd_40plus > 0.83, na.rm = TRUE) * 100 print(paste("Percentage exceeding 0.83:", round(percentage, 2), "%")) agebreaks <- c(0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80) agelabels= c("1-4","5-9","10-14","15-19","20-24","25-29","30-34","35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-75","75-80") setDT(exp_cd)[ , age_gr:= cut(age, breaks= agebreaks, right= FALSE, labels= agelabels)] exp_cd <- na.omit(exp_cd) # settings set.seed(123) nunc <- 1e+03 nvar <- 1e+05 mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } exp_cd <- exp_cd$exp_bw exp_cd <- mean(exp_cd) # translating cd exposure to cd in the urin (UCd) ## Defining t_half ### calculating mu and sigma for lognormal distribution describing t_half based on mean and sd sd <- 3 m <- 11.6 var <- log(1+(sd^2/exp(2*log(m)))) sigma <- sqrt(var) mu <- log(m)-sigma^2/2 exp(mu) x <- seq(0,300,by = 0.01) t_half <- rlnorm(nvar, meanlog = mu, sdlog = sigma) #years - assume that T_half is variable mean(t_half < 3) mean(t_half > 35) max(t_half) # defining aggregated physiological parameter f_k and elimination factor f_u fkfu <- 0.005 ## calculating UCd ucd <- matrix(0,ncol = 1e+05, nrow = 11) age <- c(40,45,50,55,60,65,70,75,80,85,90) for (i in 1:11) { c <- fkfu/log(2) * exp_cd * t_half * (1-exp(-(log(2) * age[i])/t_half))/(1-exp(-log(2)/t_half)) ucd[i,] <- ifelse(c < 1, 1, c) } sum(ucd > 1) #calculate glomerular filtration rate # define glumerular filtration rate gfr_se <- rnorm(nvar, mean = 90.2, sd = 18.5) # GFR for Singapore population (mean age 45.4 years). Source: Zang et al. (2019) gfr_baseline <- gfr_se - 0.8 * (-9.6) #GFR for SG population age 40 and below gfr_age <- matrix(nrow = 11, ncol = nvar) #current gfr for(i in 1:11){ if(age[i] >= 40){ gfr_age[i,] <- gfr_baseline - 0.8 * (age[i]-40) #if > 40 years, decline in gfr } if(age[i] < 40){ gfr_age[i,] <- gfr_baseline #if < 40 years, gfr stays the same } } gfr_age_plus1 <- matrix(nrow = 11, ncol = nvar) #gfr in one year for(i in 1:11){ if(age[i] >= 40){ gfr_age_plus1[i,] <- gfr_baseline - 0.8 * (age[i]-39) #if > 40 years, decline in gfr } if(age[i] < 40){ gfr_age_plus1[i,] <- gfr_baseline #if still < 40 years, gfr stays the same } } gfr_cd_age <- gfr_age*(1-0.078*(ucd-1)) gfr_cd_age_plus1 <- gfr_age_plus1*(1-0.078*(ucd-1)) ### Probability of CKD stage 4 and 5 # CKD5 probability without Cd exposure inc_rate_ckd5_age <- matrix(0, nrow = 11, ncol = 1e+05) for(i in 1:11){ prob_ckd5_age <- pnorm(15, gfr_age[i,], sd = 19, lower.tail = T) prob_ckd5_age_plus1 <- pnorm(15, gfr_age_plus1[i,], sd = 19, lower.tail = T) inc_rate_ckd5_age[i,] <- prob_ckd5_age_plus1 - prob_ckd5_age } # CKD5 probability with Cd exposure inc_rate_ckd5_age_cd <- matrix(0, nrow = 11, ncol = 1e+05) for(i in 1:11){ prob_ckd5_age_cd <- pnorm(15, gfr_cd_age[i,], sd = 19, lower.tail = T) prob_ckd5_age_cd_plus1 <- pnorm(15, gfr_cd_age_plus1[i,], sd = 19, lower.tail = T) inc_rate_ckd5_age_cd[i,] <- prob_ckd5_age_cd_plus1 - prob_ckd5_age_cd } # CKD5 probability only attributable to Cd exposure inc_rate_ckd5_cd_only <- inc_rate_ckd5_age_cd - inc_rate_ckd5_age # CKD4 probability without Cd exposure inc_rate_ckd4_age <- matrix(0, nrow = 11, ncol = 1e+05) for(i in 1:11){ prob_ckd4_age <- pnorm(30, gfr_age[i,], sd = 19, lower.tail = T) - pnorm(15, gfr_age[i,], sd = 19, lower.tail = T) prob_ckd4_age_plus1 <- pnorm(30, gfr_age_plus1[i,], sd = 19, lower.tail = T) - pnorm(15, gfr_age_plus1[i,], sd = 19, lower.tail = T) inc_rate_ckd4_age[i,] <- prob_ckd4_age_plus1 - prob_ckd4_age } # CKD4 probability with Cd exposure inc_rate_ckd4_age_cd <- matrix(0, nrow = 11, ncol = 1e+05) for(i in 1:11){ prob_ckd4_age_cd <- pnorm(30, gfr_cd_age[i,], sd = 19, lower.tail = T) - pnorm(15, gfr_cd_age[i,], sd = 19, lower.tail = T) prob_ckd4_age_cd_plus1 <- pnorm(30, gfr_cd_age_plus1[i,], sd = 19, lower.tail = T) - pnorm(15, gfr_cd_age_plus1[i,], sd = 19, lower.tail = T) inc_rate_ckd4_age_cd[i,] <- prob_ckd4_age_cd_plus1 - prob_ckd4_age_cd } # CKD4 probability only attributable to Cd exposure inc_rate_ckd4_cd_only <- inc_rate_ckd4_age_cd - inc_rate_ckd4_age mean_median_ci(inc_rate_ckd4_cd_only) # Attributable incidence ckd4 # Population_size 2022, Singapore DOS pop_size <- pop_size_women+pop_size_men pop_agegr <- pop_agegr$pop pop_agegr <- round(pop_agegr, digits = 0) #round to one digit # Attributable incidence ckd4 att_inc_ckd4_agegr <- apply(inc_rate_ckd4_cd_only, 2, function(x) x * pop_agegr) # total attributable incidence for total SG population, variability, by age group att_inc_ckd4_agegr <- rowMeans(att_inc_ckd4_agegr) # total attributable incidence for total SG population, point estimate, by age group att_inc_ckd4_total <- sum(att_inc_ckd4_agegr) # total attributable incidence for total SG population att_inc_ckd4_1e05 <- att_inc_ckd4_total/pop_size * 1e+05 #divide by total pop no. and multiply by 1e+05 to get attributable incidence/100,000 # Attributable incidence ckd5 att_inc_ckd5_agegr <- apply(inc_rate_ckd5_cd_only, 2, function(x) x * pop_agegr) # total attributable incidence for total SG population, variability, by age group att_inc_ckd5_agegr <- rowMeans(att_inc_ckd5_agegr) # total attributable incidence for total SG population, point estiamte, by age group att_inc_ckd5_total <- sum(att_inc_ckd5_agegr) # total attributable incidence for total SG population att_inc_ckd5_1e05 <- att_inc_ckd5_total/pop_size * 1e+05 #divide by total pop no. and multiply by 1e+05 to get attributable incidence/100,000 # DALY calculations LE <- round(LE$LE, digits = 1) #round to one digit seyll <- round(seyll$SEYLL, digits = 1) ## Burden CKD4 - no mortality (only YLD) dw4 <- rpert(nunc, min = 0.070, mode = 0.104, max = 0.147) daly_ckd4_pop <- matrix(0, nrow = 11, ncol = 1e+03) daly_table_ckd4_pop <- matrix(0, nrow = 11, ncol = 4) for(i in 1:11){ d <- LE[i] inc <- att_inc_ckd4_agegr[i] #total attributable incidence for total SG population, point estimate, by age group daly_pop_unc <- dw4 * inc * d #total YLD, uncertainty only daly_table_ckd4_pop[i,] <- mean_median_ci(daly_pop_unc) #aggregated results table daly_ckd4_pop[i,] <- daly_pop_unc } daly_table_ckd4_pop <- cbind(age,daly_table_ckd4_pop) daly_table_ckd4_pop <- as.data.frame(daly_table_ckd4_pop) daly_table_ckd4_pop <- daly_table_ckd4_pop %>% rename(age_gr = age, mean = V2, median = V3, LL = V4, UL = V5) daly_sum_ckd4_trial <- colMeans(daly_table_ckd4_pop) daly_sum_ckd4_trial <- daly_sum_ckd4_trial[-1] mean_median_ci(daly_sum_ckd4_trial) ################################################################### # Burden CKD5 - 20% mortality (YLD + YLL) dw5 <- rpert(nunc, min = 0.398, mode = 0.571, max = 0.725) #end-stage renal disease, on dialysis daly_ckd5_pop <- matrix(0, nrow = 11, ncol = 1e+03) daly_table_ckd5_pop <- matrix(0, nrow = 11, ncol = 4) ylltrial <- c() for(i in 1:11){ d <- LE[i] inc <- att_inc_ckd5_agegr[i] #total attributable incidence for total SG population, point estimate, by age group yld <- dw5 * inc * d #total yld, uncertainty only yll <- inc * 0.2 * seyll[i] daly_pop_unc <- yll + yld #reduce to one dimension for each age group (uncertainty only) daly_table_ckd5_pop[i,] <- mean_median_ci(daly_pop_unc) #aggregated results table daly_ckd5_pop[i,] <- daly_pop_unc ylltrial[i]<- yll } daly_table_ckd5_pop <- cbind(age,daly_table_ckd5_pop) daly_table_ckd5_pop <- as.data.frame(daly_table_ckd5_pop) daly_table_ckd5_pop <- daly_table_ckd5_pop %>% rename(age_gr = age, mean = V2, median = V3, LL = V4, UL = V5) daly_sum_ckd5_trial <- colMeans(daly_table_ckd5_pop) daly_sum_ckd5_trial <- daly_sum_ckd5_trial[-1] mean_median_ci(daly_sum_ckd5_trial) # total BoD ckd4 + ckd5 daly_total_pop <- daly_ckd4_pop + daly_ckd5_pop daly_table_total_pop <- matrix(0, nrow = 11, ncol = 4) for(i in 1:11){ daly_table_total_pop[i,] <- mean_median_ci(daly_total_pop[i,]) } daly_table_total_pop <- cbind(age,daly_table_total_pop) daly_table_total_pop <- as.data.frame(daly_table_total_pop) daly_table_total_pop <- daly_table_total_pop %>% rename(age_gr = age, mean = V2, median = V3, LL = V4, UL = V5) daly_sum_total_pop <- colMeans(daly_total_pop) mean_median_ci(daly_sum_total_pop) daly_sum_total_pop_per100000 <- daly_sum_total_pop/pop_size*1e+05 mean_median_ci(daly_sum_total_pop_per100000) daly_table_total_pop <- colMeans(daly_table_total_pop) mean_median_ci(daly_sum_total_pop) daly_table_total_pop <- daly_table_total_pop/pop_size*1e+05 mean_median_ci(daly_table_total_pop) #hist(daly_sum_total_pop,breaks = 1000,main = "DALY for cadmium exposure",xlab = "DALY") dfsummaryDALY <- rbind(DALYCKD4 = mean_median_ci(daly_sum_ckd4_trial), DALYCKD5 = mean_median_ci(daly_sum_ckd5_trial), YLD_CKD4 = mean_median_ci(daly_sum_ckd4_trial), att_inc_ckd4 = att_inc_ckd4_total, att_inc_ckd5 = att_inc_ckd5_total, TOTALDALY =mean_median_ci(daly_sum_total_pop), TOTALDALYper100000 = mean_median_ci(daly_sum_total_pop)/pop_size*1e+05) dfsummaryDALY outputresult <- dfsummaryDALY outputresult ###Lead #Default Simulation (repeat for all scenarios, AS1, AS2, AS3) consumption_all <- 0 concentration_lead <- 0 Individualinfo <- 0 #Exposure per food group (repeat for all scenarios, AS1, AS2, AS3) ##Exposure by Food #Load food groups Foodgroups <- read.csv("26032025 foodgroups.csv") Foodgroups <- Foodgroups[,-1] colnames(Foodgroups) anchovyfoodex2code <- Foodgroups[,1][!is.na(Foodgroups[,1])] cannedsardinefoodex2code <- Foodgroups[,2][!is.na(Foodgroups[,2])] cannedtunafoodex2code <- Foodgroups[,3][!is.na(Foodgroups[,3])] catfishfoodex2code <- Foodgroups[,4][!is.na(Foodgroups[,4])] fishheadfoodex2code <- Foodgroups[,5][!is.na(Foodgroups[,5])] grouperfoodex2code <- Foodgroups[,6][!is.na(Foodgroups[,6])] kuningandrelatedfishesfoodex2code <- Foodgroups[,7][!is.na(Foodgroups[,7])] mackerelandrelatedfishesfoodex2code <- Foodgroups[,8][!is.na(Foodgroups[,8])] salmonfoodex2code <- Foodgroups[,9][!is.na(Foodgroups[,9])] saltedfishandrelatedproductfoodex2code <- Foodgroups[,10][!is.na(Foodgroups[,10])] seabassfoodex2code <- Foodgroups[,11][!is.na(Foodgroups[,11])] snapperfoodex2code <- Foodgroups[,12][!is.na(Foodgroups[,12])] threadfinfoodex2code <- Foodgroups[,13][!is.na(Foodgroups[,13])] troutcodfoodex2code <- Foodgroups[,14][!is.na(Foodgroups[,14])] tunafoodex2code <- Foodgroups[,15][!is.na(Foodgroups[,15])] ##Classify exposure by Food group anchovyexposure <- Exposure[intersect(names(Exposure), anchovyfoodex2code)] cannedsardineexposure <- Exposure[intersect(names(Exposure), cannedsardinefoodex2code)] cannedtunaexposure <- Exposure[intersect(names(Exposure), cannedtunafoodex2code)] catfishexposure <- Exposure[intersect(names(Exposure), catfishfoodex2code)] fishheadexposure <- Exposure[intersect(names(Exposure), fishheadfoodex2code)] grouperexposure <- Exposure[intersect(names(Exposure), grouperfoodex2code)] kuningandrelatedfishesexposure <- Exposure[intersect(names(Exposure), kuningandrelatedfishesfoodex2code)] mackerelandrelatedfishesexposure <- Exposure[intersect(names(Exposure), mackerelandrelatedfishesfoodex2code)] salmonexposure <- Exposure[intersect(names(Exposure), salmonfoodex2code)] saltedfishandrelatedproductexposure <- Exposure[intersect(names(Exposure), saltedfishandrelatedproductfoodex2code)] seabassexposure <- Exposure[intersect(names(Exposure), seabassfoodex2code)] snapperexposure <- Exposure[intersect(names(Exposure), snapperfoodex2code)] threadfinexposure <- Exposure[intersect(names(Exposure), threadfinfoodex2code)] troutcodexposure<- Exposure[intersect(names(Exposure), troutcodfoodex2code)] tunaexposure <- Exposure[intersect(names(Exposure), tunafoodex2code)] anchovyexposure <- rowSums(anchovyexposure) cannedsardineexposure <- rowSums(cannedsardineexposure) cannedtunaexposure <- rowSums(cannedtunaexposure) catfishexposure <- rowSums(catfishexposure) fishheadexposure <- rowSums(fishheadexposure) grouperexposure <- rowSums(grouperexposure) kuningandrelatedfishesexposure<- rowSums(kuningandrelatedfishesexposure) mackerelandrelatedfishesexposure <- rowSums(mackerelandrelatedfishesexposure ) salmonexposure <- rowSums(salmonexposure) saltedfishandrelatedproductexposure <- rowSums(saltedfishandrelatedproductexposure) seabassexposure <- rowSums(seabassexposure) snapperexposure <- rowSums(snapperexposure) threadfinexposure<- rowSums(threadfinexposure) troutcodexposure<-rowSums(troutcodexposure) tunaexposure <- rowSums(tunaexposure) totalexposuredf <- cbind.data.frame(anchovyexposure,cannedsardineexposure,cannedtunaexposure, catfishexposure,fishheadexposure,grouperexposure, kuningandrelatedfishesexposure,mackerelandrelatedfishesexposure,salmonexposure,saltedfishandrelatedproductexposure,seabassexposure,snapperexposure,threadfinexposure, troutcodexposure,tunaexposure) totalexposuredf[is.na(totalexposuredf)] <- 0 totalexposure <- rowSums(totalexposuredf) summaryofexposureperfood <- (round(prop.table(colSums(totalexposuredf)) * 100,digits = 2)) summaryofexposureperfood summaryofexposureperfood_df <- as.data.frame(summaryofexposureperfood) #clipr::write_clip(as.data.frame(summaryofexposureperfood)) #totalexposure <- as.data.frame(cbind(consumption_all[,c("ID")], totalexposuredf)) #colnames(totalexposure)[1] <- "ID" #totalexposuredfmelted <- melt(data = totalexposure,id.vars = "ID") #totalexposuredfmelted$plot <- 1 #totalexposuredfmelted$variable <-gsub("exposure","",totalexposuredfmelted$variable) #library(ggplot2) #ggplot(totalexposuredfmelted, aes(x = variable, y = value, colour= variable)) + # geom_jitter() + theme_classic() #totalexposuredf <- cbind.data.frame(totalexposuredf, totalexposure) #Main model for lead, repeat for AS1,AS2 and AS3 by changing consumption file #install packages install.packages("mc2d") install.packages("readr") install.packages("dplyr") install.packages("tidyr") install.packages("reshape2") install.packages("readxl") install.packages("tidyverse") install.packages("data.table") install.packages("fitdistrplus") install.packages("goftest") install.packages("grid") install.packages("gridExtra") install.packages("clipr") #packages library(mc2d) library(readr) library(dplyr) library(tidyr) library(DALY) library(reshape2) library(readxl) library(tidyverse) library(data.table) library(fitdistrplus) library(goftest) library(grid) library(gridExtra) library(clipr) #Load function mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } nvar <- 10^5 #change consumption file according to scenario AS1, AS2, AS3 if(consumption_all == 0){ consumption_all <- read.csv("consumption_baseline_foodex2_26032025.csv") } else { consumption_all = consumption_all } if(concentration_lead == 0){ concentration_lead <- read.csv("04082025 leadconc.csv") } else { concentration_lead = concentration_lead } if(Individualinfo == 0){ Individualinfo <- read.csv("21032025 Individualinfo.csv") } else { Individualinfo = Individualinfo } consumption_all <- as.data.frame(consumption_all[,-1]) concentration_lead <- na.omit(concentration_lead) concentration_lead_foodex2 <- concentration_lead[,c(2,3)] listoffoods <- concentration_lead_foodex2[,1] concentration_lead_foodex2 <- concentration_lead_foodex2[,2] concentration_lead_foodex2 <- t(concentration_lead_foodex2) concentration_lead_foodex2 <- as.data.frame(concentration_lead_foodex2) colnames(concentration_lead_foodex2) <- listoffoods consumption_all <- merge.data.frame(consumption_all,Individualinfo,by = "NOIND") consumption_all <- consumption_all %>% rename(ID = NOIND) ## exposure to pb from food consumption_0_3 <- consumption_all %>% filter(age >= 0 & age <4) ### small children (6-36 months old) exp_pb_0_3 <- mapply('*', consumption_0_3[intersect(names(consumption_0_3), names(concentration_lead_foodex2))], concentration_lead_foodex2[intersect(names(consumption_0_3), names(concentration_lead_foodex2))]) #(g/day * mg/kg =ug/day), multiplying the columns with the same names exp_pb_0_3 <- as.data.frame(exp_pb_0_3) Exposure <- exp_pb_0_3 source("Exposureperfoodgroup.R") total_exp_0_3 = rowSums(exp_pb_0_3) exp_pb_0_3 <- as.data.frame(cbind(consumption_0_3[,c("ID","bw","sex","age")], total_exp_0_3)) exp_pb_0_3 <- na.omit(exp_pb_0_3) exp_pb_0_3 <- exp_pb_0_3 %>% rename(total_exp = total_exp_0_3) %>% #rename variable mutate(exp_bw = total_exp / bw)# %>% #new variable: exposure µg/kg bw/day #rename(age_months = age) #%>% #rename variable # mutate(age_gr, age = ifelse(age_gr == "4", "1", "2")) #if age_gr = 4 -> age = 1, else (age_gr = 5) age = 2 ### bigger children (4-7 year-olds) consumption_4_7 <- consumption_all %>% filter(age >= 4 & age <8) # intake of Pb from food exp_pb_4_7 <- mapply("*", consumption_4_7[intersect(names(consumption_4_7), names(concentration_lead_foodex2))], concentration_lead_foodex2[intersect(names(consumption_4_7), names(concentration_lead_foodex2))]) #(g/day * mg/kg =ug/day), multiplying the columns with the same names exp_pb_4_7 <- as.data.frame(exp_pb_4_7) Exposure <- exp_pb_4_7 source("Exposureperfoodgroup.R") ############### total_exp_4_7 = rowSums(exp_pb_4_7) exp_pb_4_7 <- as.data.frame(cbind(consumption_4_7[,c("ID","bw","sex","age")], total_exp_4_7)) exp_pb_4_7 <- na.omit(exp_pb_4_7) consumption_5 <- consumption_all %>% filter(age == 5) # Exposure to 5 year old kids exp_pb_5 <- mapply("*", consumption_5[intersect(names(consumption_5), names(concentration_lead_foodex2))], concentration_lead_foodex2[intersect(names(consumption_5), names(concentration_lead_foodex2))]) #(g/day * mg/kg =ug/day), multiplying the columns with the same names exp_pb_5 <- as.data.frame(exp_pb_5) Exposure <- exp_pb_5 source("Exposureperfoodgroup.R") exp_pb_4_5 <- exp_pb_4_7 %>% #make new dataset for only 4 and 5 year old children filter(age == "4" | age == "5") %>% #select only children of 4 and 5 years of age rename(total_exp = total_exp_4_7) %>% #rename variable #rename(bw = weight) %>% mutate(exp_bw = total_exp / bw) #new variable: exposure µg/kg bw/day Exposure <- exp_pb_4_5 source("Exposureperfoodgroup.R") ### exposure for 5 year-olds only exp_pb_5 <- exp_pb_4_7 %>% #make new dataset for only 4 and 5 year old children filter(age == "5") %>% #select only children of 5 years of age rename(total_exp = total_exp_4_7) %>% #rename variable #rename(bw = weight) %>% mutate(exp_bw = total_exp / bw) #new variable: exposure µg/kg bw/day round(mean(exp_pb_5$exp_bw), 3) round(quantile(exp_pb_5$exp_bw, probs = c(0.025, 0.975)), 3) #Calculating TWI percentage <- mean(exp_pb_5$exp_bw > 0.50, na.rm = TRUE) * 100 print(paste("Percentage exceeding 0.50:", round(percentage, 2), "%")) # settings set.seed(123) nunc <- 1000 # load exposure data, note that d-r relationship uses total exp not adjusted by bw # estimate mean daily exposure to Pb up to 5 years exp_pb_0_3_mean <- exp_pb_0_3 %>% group_by(age) %>% summarise(mean(total_exp)) exp_pb_4_5_mean <- exp_pb_4_5 %>% group_by(age) %>% summarise(mean(total_exp)) exp_pb_children <- rbind(exp_pb_0_3_mean, exp_pb_4_5_mean) #exposure in µg/day mean_exp_pb <- round(mean(exp_pb_children$`mean(total_exp)`), digits = 3) #mean of mean exposure for each age ### exp5 <- subset(x = exp_pb_4_5,subset = exp_pb_4_5$age == 5) exp5 <- exp5$exp_bw exp5_nozero <- exp5[exp5 > 0] fit_lnorm <- fitdist(exp5_nozero, 'lnorm') #Fit lognormal distribution to intake amounts lnorm <- exp5 #plot(ecdf(lnorm), lty=1) x <- seq(0, 25, length=1000) #lines(x, plnorm(x, meanlog=fit_lnorm$estimate["meanlog"], sdlog=fit_lnorm$estimate["sdlog"]), col="red", lty=1) #gofstat(fit_lnorm, fitnames="lnorm") fit_gamma <- fitdist(exp5, 'gamma') #Fit gamma distribution to intake amounts gamma <- exp5 #plot(ecdf(gamma), lty=1) x <- seq(0, 25, length=1000) #lines(x, pgamma(x, fit_gamma$estimate[1],fit_gamma$estimate[2]), col="red", lty=1) #gofstat(fit_gamma, fitnames="gamma") #goodness of fit tests cvm.test(x = lnorm,null = plnorm, fit_lnorm$estimate[1], fit_lnorm$estimate[2]) #Cramir-von Mises test ad.test(x = lnorm,null = plnorm, fit_lnorm$estimate[1], fit_lnorm$estimate[2]) #Anderson-Darling test cvm.test(x = lnorm,null = pgamma, fit_gamma$estimate[1], fit_gamma$estimate[2]) #Cramir-von Mises test ad.test(x = lnorm,null = pgamma, fit_gamma$estimate[1], fit_gamma$estimate[2]) #Anderson-Darling test exp_pb_lnorm <- rlnorm(10000, fit_lnorm$estimate[1], fit_lnorm$estimate[2]) exp_pb_pgamma <- rgamma(10000,shape =fit_gamma$estimate[1],rate =fit_gamma$estimate[2] ) # Conversion factor for BPb to dietary lead exposure, WHO (2011) conversion_BPb_lower <- 0.05 #µg/dL of lead in blood per 1 µg/day of dietary lead exposure conversion_BPb_upper <- 0.16 #µg/dL of lead in blood per 1 µg/day of dietary lead exposure BPb_lower <- mean_exp_pb * conversion_BPb_lower #µg/dL of lead in blood per dietary lead exposure, lower BPb_upper <- mean_exp_pb * conversion_BPb_upper #µg/dL of lead in blood per dietary lead exposure, lower # The change in IQ points per µg/dL of lead in blood (PbB), Carrington (2019) #(CI 95: 0,-1.19) (bilinear), since this IQ change is derived from a low dose billinear model a triangle distribution is used to describe IQ_change_blood <- rtriang(nunc,-1.19,-0.48,0.00) #-0.48 #plot(density(IQ_change_blood)) #checking distribution # dw from (salomon,2015) # (IQ<85) Borderline dw_border <- rpert(nunc, min=0.005, mode=0.011, max=0.020, shape=4) # (50= 85 prob_norm_border_upper <- pnorm(85-IQ_change_upper, mean = 100, sd = 15, lower.tail = T) - pnorm(85, mean = 100, sd = 15, lower.tail = T) # x >= 85 # Proportional delta delta <- (prob_norm_border_upper/pnorm(85, mean = 100, sd = 15, lower.tail = T)*100) mean_median_ci(delta) # Borderline intellectual functioning to mild intellectual disability prob_border_mild_lower <- pnorm(70-IQ_change_lower, 100, 15, lower.tail = T) - pnorm(70, 100, 15, lower.tail = T) # x >= 70 & x < 85 prob_border_mild_upper <- pnorm(70-IQ_change_upper, 100, 15, lower.tail = T) - pnorm(70, 100, 15, lower.tail = T) # x >= 70 & x < 85 # Proportional delta delta <- (prob_border_mild_upper/pnorm(70, 100, 15, lower.tail = T)*100) mean_median_ci(delta) # Mild intellectual functioning to moderate intellectual disability prob_mild_moderate_lower <- pnorm(50-IQ_change_lower, 100, 15, lower.tail = T) - pnorm(50, 100, 15, lower.tail = T) # x >= 50 & x < 70 prob_mild_moderate_upper <- pnorm(50-IQ_change_upper, 100, 15, lower.tail = T) - pnorm(50, 100, 15, lower.tail = T) # x >= 50 & x < 70 # Proportional delta delta <- (prob_mild_moderate_upper/pnorm(50, 100, 15, lower.tail = T)*100) mean_median_ci(delta) # Moderate intellectual functioning to severe intellectual disability prob_moderate_severe_lower <- pnorm(35-IQ_change_lower, 100, 15, lower.tail = T) - pnorm(35, 100, 15, lower.tail = T) # x >= 35 & x < 50 prob_moderate_severe_upper <- pnorm(35-IQ_change_upper, 100, 15, lower.tail = T) - pnorm(35, 100, 15, lower.tail = T) # x >= 35 & x < 50 # Proportional delta delta <- (prob_moderate_severe_upper/pnorm(35, 100, 15, lower.tail = T)*100) mean_median_ci(delta) # Severe intellectual functioning to profound intellectual disability prob_severe_profound_lower <- pnorm(20-IQ_change_lower, 100, 15, lower.tail = T) - pnorm(20, 100, 15, lower.tail = T) # x < 20 prob_severe_profound_upper <- pnorm(20-IQ_change_upper, 100, 15, lower.tail = T) - pnorm(20, 100, 15, lower.tail = T) # x < 20 # Proportional delta delta <- (prob_severe_profound_upper/pnorm(20, 100, 15, lower.tail = T)*100) mean_median_ci(delta) #### DALY Module-------- # Assumptions # Age of onset: 5 # duration is assumed to be life long, therefore the life expectancy - 5 years # life expectancy Female used for worst case # no remission and no increased mortality duration <- LE_5-5 #in years ## Lower ==== # Normal to borderline: # dw untreated is: dw_border <- 0.011 #(0.005-0.020) (IQ<85) from Salomon (2015) beta-pert distribution. # incidence for going from normal to borderline: incidence_lower_border <- prob_norm_border_lower*pop_size_5 mean_median_ci(incidence_lower_border) DALY_lower_border <- incidence_lower_border*dw_border*duration mean_median_ci(DALY_lower_border) DALY_lower_border_pop <- incidence_lower_border*dw_border*duration/pop_size*100000 mean_median_ci(DALY_lower_border_pop) # Borderline to Mild: # dw untreated is: dw_mild: 0.043 #(0.026-0.064) (50% rename(ID = NOIND) ######################################## # Calculation of exposure exp_mehg <- mapply("*", consumption_all[intersect(names(consumption_all), names(concentration_methylmercury_foodex2))], concentration_methylmercury_foodex2[intersect(names(consumption_all), names(concentration_methylmercury_foodex2))]) exp_mehg <- as.data.frame(exp_mehg) Exposure <- exp_mehg source("Exposureperfoodgroup.R") total_exp_mehg = rowSums(exp_mehg) exp_mehg <- as.data.frame(cbind(consumption_all[,c("ID","bw","sex","age")], total_exp_mehg)) exp_mehg <- na.omit(exp_mehg) exp_mehg <- exp_mehg %>% rename(total_exp = total_exp_mehg) %>% #rename variable mutate(exp_bw = total_exp / bw) #new variable: exposure ?g/kg bw/day # settings set.seed(123) nvar <- 1e5 nunc <- 1e3 mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } # load exposure data exp_mehg <- subset(exp_mehg, age > 14 & age < 50 & sex == "2") # Sex 2 is equal to female round(mean(exp_mehg$exp_bw), 3) round(quantile(exp_mehg$exp_bw, probs = c(0.025, 0.975)), 3) percentage <- mean(exp_mehg$exp_bw > 0.23, na.rm = TRUE) * 100 print(paste("Percentage exceeding 0.23:", round(percentage, 3), "%")) #Calculating TWI percentage <- mean(exp_mehg$exp_bw > 0.19, na.rm = TRUE) * 100 print(paste("Percentage exceeding 0.19:", round(percentage, 3), "%")) # Population_size 2022 of Singapore, all ages, Department of Statistics pop_size_men <- 1990212 #SG Resident Male Population 2022, DOS pop_size_women <- 2083027 # SG Resident Female Population 2022, DOS pop_size_all <- pop_size_women+pop_size_men #population numbers women of childbearing age pop_women_agegr <- read.csv("Mercurypopulatiion.csv") #Probability of becoming pregnant, age-dependent data for 2022 #source: Department of Statistics Singpaore, calculated based on Age-Specific Fertility rate and Singapore Female Resident Population agegr <- c("15-24", "25-29", "30-34", "35-39", "40-49") p <- c(0.0069, 0.0488,0.0867, 0.0494, 0.0051) pbaby <- as.data.frame(cbind(agegr, p)) #life expectancy at birth Singapore 2022, Department of Statistics LE <- 83 ##### DALY calculations ##### #Dose-response: r_risk <- rtriang(nunc, min = -19.5, mode = -8.5, max = -1.5) #Normal IQ distribution IQnorm <- rnorm(nvar, mean = 100, sd = 15) #Disability weights wIQ85 <- 0 wIQ70.85sim <- rpert(nunc, min=0.005, mode=0.011, max=0.020) wIQ50.69sim <- rpert(nunc, min=0.026, mode=0.043, max=0.064) wIQ35.49sim <- rpert(nunc, min=0.066, mode=0.100, max=0.142) wIQ20.34sim <- rpert(nunc, min=0.107, mode=0.160, max=0.226) wIQ20sim <- rpert(nunc, min=0.133, mode=0.200, max=0.283) ##### DALY calculations ##### agebreaks <- c(0,25,29,34,39,50) agelabels= c("15-24", "25-29", "30-34", "35-39", "40-49") setDT(exp_mehg)[ , age_gr2:= cut(age, breaks= agebreaks, right= FALSE, labels= agelabels)] #IQ decrease for each of the 7 age groups exp_agegr <- exp_mehg %>% #mehg exposure (ug/kg bw/day) in different age groups. group_by(age_gr2) %>% summarize(avg=mean(exp_bw)) expo <- exp_agegr$avg IQ_decrease <- apply(t(r_risk), 2, function(x) {x * expo}) #Mean, median and associated uncertainty around IQ decrease for children of each age group due to MeHg exposure IQ_decrease_unc <- apply(IQ_decrease, 1, function(x) mean_median_ci(x)) colnames(IQ_decrease_unc)[1:5] <- exp_agegr$age_gr2 IQ_decrease_unc <- t(IQ_decrease_unc) IQ_decrease_unc #Probability of going down an IQ class due to a given increase in IQ IQnormal <- matrix(0, nrow = nrow(IQ_decrease), ncol = nunc) IQborderline <- matrix(0, nrow = nrow(IQ_decrease), ncol = nunc) IQmild <- matrix(0, nrow = nrow(IQ_decrease), ncol = nunc) IQmoderate <- matrix(0, nrow = nrow(IQ_decrease), ncol = nunc) IQsevere <- matrix(0, nrow = nrow(IQ_decrease), ncol = nunc) IQprofound <- matrix(0, nrow = nrow(IQ_decrease), ncol = nunc) for(i in 1:nrow(IQ_decrease)){ normal <- pnorm(85-IQ_decrease[i,], mean = 100, sd = 15, lower.tail = F) - pnorm(85, mean = 100, sd = 15, lower.tail = F) # x >= 85 IQnormal[i,] <- normal borderline <- pnorm(85-IQ_decrease[i,], 100, 15, lower.tail = T) - pnorm(85, 100, 15, lower.tail = T) # x >= 70 & x < 85 IQborderline[i,] <- borderline mild <- pnorm(70-IQ_decrease[i,], 100, 15, lower.tail = T) - pnorm(70, 100, 15, lower.tail = T) #x >= 50 & x < 70 IQmild[i,] <- mild moderate <- pnorm(50-IQ_decrease[i,], 100, 15, lower.tail = T) - pnorm(50, 100, 15, lower.tail = T) #x >= 35 & x < 50 IQmoderate[i,] <- moderate severe <- pnorm(35-IQ_decrease[i,], 100, 15, lower.tail = T) - pnorm(35, 100, 15, lower.tail = T) #x >= 20 & x < 35 IQsevere[i,] <- severe profound <- pnorm(20-IQ_decrease[i,], 100, 15, lower.tail = T) - pnorm(20, 100, 15, lower.tail = T) #x < 20 IQprofound[i,] <- profound } # increase in incidence /attributable incidence of ID in the individual IQ classes accounting for the # number of individuals and probability of birth within individual age groups pop_women <- pop_women_agegr$pop IQnormal_inc <- apply(IQnormal, 2, function(x) x * pop_women * p) IQnormal_inc_unc <- apply(IQnormal_inc, 1, function(x) mean_median_ci(x)) colnames(IQnormal_inc_unc)[1:5] <- agegr IQnormal_inc_unc <- t(IQnormal_inc_unc) IQnormal_inc_unc IQnormal_inc_total <- colSums(IQnormal_inc) mean_median_ci(IQnormal_inc_total) #absolute attributable incidence IQnormal_inc_rate <- IQnormal_inc_total / pop_size_all * 1e+05 mean_median_ci(IQnormal_inc_rate) #attributable incidence per 100,000 general pop IQborderline_inc <- apply(IQborderline, 2, function(x) x * pop_women * p) IQborderline_inc_unc <- apply(IQborderline_inc, 1, function(x) mean_median_ci(x)) colnames(IQborderline_inc_unc)[1:5] <- agegr IQborderline_inc_unc <- t(IQborderline_inc_unc) IQborderline_inc_unc IQborderline_inc_total <- colSums(IQborderline_inc) #absolute attributable incidence mean_median_ci(IQborderline_inc_total) #absolute attributable incidence IQborderline_inc_rate <- IQborderline_inc_total / pop_size_all * 1e+05 mean_median_ci(IQborderline_inc_rate) #attributable incidence per 100,000 general pop IQmild_inc <- apply(IQmild, 2, function(x) x * pop_women * p) IQmild_inc_unc <- apply(IQmild_inc, 1, function(x) mean_median_ci(x)) colnames(IQmild_inc_unc)[1:5] <- agegr IQmild_inc_unc <- t(IQmild_inc_unc) IQmild_inc_unc IQmild_inc_total <- colSums(IQmild_inc) mean_median_ci(IQmild_inc_total) #absolute attributable incidence IQmild_inc_rate <- IQmild_inc_total / pop_size_all * 1e+05 mean_median_ci(IQmild_inc_rate) #attributable incidence per 100,000 general pop IQmoderate_inc <- apply(IQmoderate, 2, function(x) x * pop_women * p) IQmoderate_inc_unc <- apply(IQmoderate_inc, 1, function(x) mean_median_ci(x)) colnames(IQmoderate_inc_unc)[1:5] <- agegr IQmoderate_inc_unc <- t(IQmoderate_inc_unc) IQmoderate_inc_unc IQmoderate_inc_total <- colSums(IQmoderate_inc) mean_median_ci(IQmoderate_inc_total) #absolute attributable incidence IQmoderate_inc_rate <- IQmoderate_inc_total / pop_size_all * 1e+05 mean_median_ci(IQmoderate_inc_rate) #attributable incidence per 100,000 general pop IQsevere_inc <- apply(IQsevere, 2, function(x) x * pop_women * p) IQsevere_inc_unc <- apply(IQsevere_inc, 1, function(x) mean_median_ci(x)) colnames(IQsevere_inc_unc)[1:5] <- agegr IQsevere_inc_unc <- t(IQsevere_inc_unc) IQsevere_inc_unc IQsevere_inc_total <- colSums(IQsevere_inc) mean_median_ci(IQsevere_inc_total) #absolute attributable incidence IQsevere_inc_rate <- IQsevere_inc_total / pop_size_all * 1e+05 mean_median_ci(IQsevere_inc_rate) #attributable incidence per 100,000 general pop IQprofound_inc <- apply(IQprofound, 2, function(x) x * pop_women * p) IQprofound_inc_unc <- apply(IQprofound_inc, 1, function(x) mean_median_ci(x)) colnames(IQprofound_inc_unc)[1:5] <- agegr IQprofound_inc_unc <- t(IQprofound_inc_unc) IQprofound_inc_unc IQprofound_inc_total <- colSums(IQprofound_inc) mean_median_ci(IQprofound_inc_total) #absolute attributable incidence IQprofound_inc_rate <- IQprofound_inc_total / pop_size_all * 1e+05 mean_median_ci(IQprofound_inc_rate) #attributable incidence per 100,000 general pop #total absolute attributable incidence incidence_total <- IQborderline_inc_total + IQmild_inc_total + IQmoderate_inc_total + IQsevere_inc_total + IQprofound_inc_total mean_median_ci(incidence_total) #DALY calculation DALY_borderline <- IQborderline_inc_total * wIQ70.85sim * LE mean_median_ci(DALY_borderline) DALY_mild <- IQmild_inc_total * wIQ50.69sim * LE mean_median_ci(DALY_mild) DALY_moderate <- IQmoderate_inc_total * wIQ35.49sim * LE mean_median_ci(DALY_moderate) DALY_severe <- IQsevere_inc_total * wIQ20.34sim * LE mean_median_ci(DALY_severe) DALY_profound <- IQprofound_inc_total * wIQ20sim * LE mean_median_ci(DALY_profound) DALY_total <- DALY_borderline + DALY_mild + DALY_moderate + DALY_severe + DALY_profound mean_median_ci(DALY_total) #Absolute attributable DALYs DALY_rate <- DALY_total / pop_size_all * 1e+05 mean_median_ci(DALY_rate) dfsummaryDALY <- cbind(DALY_borderline= DALY_borderline, DALY_mild =DALY_mild, DALY_moderate= DALY_moderate, DALY_severe =DALY_severe, DALY_profound =DALY_profound, TOTAL =DALY_total, TOTALper100000 = DALY_total/pop_size_all*1e+05) outputresults <- apply(X = dfsummaryDALY,MARGIN = 2,FUN = mean_median_ci) outputresults <- t(outputresults) outputresults <- round(outputresults,digits = 3) outputresults #####Export as data frames # Total number of cases incidence_MM_baseline <- data.frame( value = incidence_total ) # Total number of DALYs TotalDALY_MM_baseline <- data.frame( value = DALY_total ) # Total DALYs per 100,000 inhabitant DALYper100k_MM_baseline <- data.frame( value = DALY_rate ) # Save individual dataframes as CSV write.csv(incidence_MM_baseline, "incidence_MM_baseline.csv", row.names = FALSE) write.csv(TotalDALY_MM_baseline, "TotalDALY_MM_baseline.csv", row.names = FALSE) write.csv(DALYper100k_MM_baseline, "DALYper100k_MM_baseline.csv", row.names = FALSE) ###Calculations for Methylmercury #clear environment rm(list=ls()) #function mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } # function to process files to compare alternative scenarios to baseline scenarios process_differences <- function(baseline_file, comparison_file, output_file) { # Read files baseline_data <- read.csv(baseline_file) comparison_data <- read.csv(comparison_file) diff_data <- data.frame(value = comparison_data$value - baseline_data$value) write.csv(diff_data, output_file, row.names = FALSE) stats <- mean_median_ci(diff_data$value) summary_stats <- data.frame( Mean = stats["mean"], Median = stats["median"], `2.5%` = stats["2.5%"], `97.5%` = stats["97.5%"] ) return(summary_stats) } #types types <- c("TotalDALY", "incidence", "DALYper100k") all_summaries <- data.frame() scenarios <- list( list(comp = "0.5", output = "AS1"), list(comp = "1.5", output = "AS2"), list(comp = "2", output = "AS3") ) for (scenario in scenarios) { for (type in types) { # Define file names baseline_file <- sprintf("%s_MM_baseline.csv", type) comparison_file <- sprintf("%s_MM_%s.csv", type, scenario$comp) output_file <- sprintf("%s_MM_%s.csv", scenario$output, type) summary_stats <- process_differences(baseline_file, comparison_file, output_file) summary_stats$Scenario <- scenario$output summary_stats$Type <- type all_summaries <- rbind(all_summaries, summary_stats) } } #export results write.csv(all_summaries, "summary_stats_MM.csv", row.names = FALSE) #####Summation of Health Risks #Set up .libPaths(c("~/R/library",.libPaths())) library(dplyr) library(readr) rm(list=ls()) #SG population sizes Pop_size_male <- 1990212 # SG Resident Male Population 2022, DOS Pop_size_female <- 2083027 # SG Resident Female Population 2022, DOS Total_pop <- Pop_size_male + Pop_size_female #statistics mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } #function to process files process_files <- function(scenario, type) { # Read and combine files if(type == "DALY") { file_pattern <- paste0(scenario, "_(iAs|lead|MM)_DALYper100k\\.csv") output_file <- paste0(scenario, "_combined_DALYper100k.csv") } else { file_pattern <- paste0(scenario, "_(iAs|lead|MM)_incidence\\.csv") output_file <- paste0(scenario, "_combined_incidence_per100k.csv") } files <- list.files(pattern = file_pattern) combined_data <- NULL for(file in files) { data <- read.csv(file) if(type == "incidence") { # Convert incidence to per 100,000 before summing data$value <- (data$value / Total_pop) * 100000 } if(is.null(combined_data)) { combined_data <- data$value } else { combined_data <- combined_data + data$value } } write.csv(data.frame(value = combined_data), output_file, row.names = FALSE) stats <- mean_median_ci(combined_data) return(stats) } results_df <- data.frame( scenario = character(), metric = character(), mean = numeric(), median = numeric(), percentile_2.5 = numeric(), percentile_97.5 = numeric(), stringsAsFactors = FALSE ) #processing scenarios <- c("AS1", "AS2", "AS3") metrics <- c("DALY", "incidence") for(scenario in scenarios) { for(metric in metrics) { stats <- process_files(scenario, metric) results_df <- rbind(results_df, data.frame( scenario = scenario, metric = metric, mean = stats["mean"], median = stats["median"], percentile_2.5 = stats["2.5%"], percentile_97.5 = stats["97.5%"] )) } } #export results write.csv(results_df, "summary_statistics.csv", row.names = FALSE) ##### Summation of Risks and Benefits #clear environment rm(list=ls()) #statistics function mean_median_ci <- function(x) { c(mean = mean(x), median = median(x), quantile(x, probs = c(0.025, 0.975))) } #set function to process and combine benefits and risk files. note: combined_attr refers to combined benefits. ASX_combined... refers to combined risks files. process_combined_files <- function(scenario, type) { if(type == "DALY") { file1 <- paste0("combined_attr_DALYs_", scenario, ".csv") file2 <- paste0(scenario, "_combined_DALYper100k.csv") output_file <- paste0(scenario, "_final_combined_DALYs.csv") } else { file1 <- paste0("combined_attr_incidence_", scenario, ".csv") file2 <- paste0(scenario, "_combined_incidence_per100k.csv") # Updated filename output_file <- paste0(scenario, "_final_combined_incidence.csv") } data1 <- read.csv(file1) data2 <- read.csv(file2) combined_data <- data1$sum + data2$value write.csv(data.frame(value = combined_data), output_file, row.names = FALSE) stats <- mean_median_ci(combined_data) return(stats) } #df to store results results_df <- data.frame( scenario = character(), metric = character(), mean = numeric(), median = numeric(), percentile_2.5 = numeric(), percentile_97.5 = numeric(), stringsAsFactors = FALSE ) #processing scenarios <- c("AS1", "AS2", "AS3") metrics <- c("DALY", "incidence") for(scenario in scenarios) { for(metric in metrics) { stats <- process_combined_files(scenario, metric) results_df <- rbind(results_df, data.frame( scenario = scenario, metric = metric, mean = stats["mean"], median = stats["median"], percentile_2.5 = stats["2.5%"], percentile_97.5 = stats["97.5%"] )) } } #export final results write.csv(results_df, "final_summary_statistics.csv", row.names = FALSE)