Brain and central nervous system cancer burden in children across Asia.

Code ↔ Paper

10 matches between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 10 matches

[1] § STAR★Methods › Method details › Bayesian Age-Period-Cohort model ↔ 06_figs_s13_s24_bapc_validation_and_sensitivity.R, lines 1–55 · score 0.87 · Bayesian age period, age period cohort, retrospective validation, 1990–2013, 2014–2023, sensitivity
[2] § STAR★Methods › Method details › Bayesian Age-Period-Cohort model ↔ 05_fig4_and_figs_s10_s12_bapc_forecast.R, lines 1–78 · score 0.81 · Bayesian age period, age period cohort, central nervous system, forecasts, overdispersion, RW2
[3] § Result › Overall trends ↔ 01_table_1_and_tables_s1_s3.R, lines 52–107 · score 0.81 · S1 S3, prevalence rate, DALY rate, incidence rate, 0–14, 1990–2023
[4] § Result › BAPC projections ↔ 05_fig4_and_figs_s10_s12_bapc_forecast.R, lines 1–78 · score 0.72 · S10 S12, age standardized rates, ASPR, deaths, ASMR, ASDR
[5] § Result › BAPC projections ↔ 06_figs_s13_s24_bapc_validation_and_sensitivity.R, lines 1–55 · score 0.70 · S13 S24, Retrospective validation, Sensitivity, BAPC, prevalent, ASRs
[6] § STAR★Methods › Method details › Outcome measures › Age-standardised rate ↔ 01_table_1_and_tables_s1_s3.R, lines 52–107 · score 0.67 · prevalence rate, DALY rate, disability adjusted, incidence rate, EAPC, age
[7] § Result › Age- and sex-specific burden trends ↔ 03_fig2_and_figs_s4_s6_age_trends_and_sex_distribution.R, lines 33–120 · score 0.67 · S4 S6, 10–14, 2–4, 5–9, brain, Asia
[8] § Result › Inequality analyses ↔ 04_fig3_and_figs_s7_s9_inequality.R, lines 1–39 · score 0.63 · SDI ranked, S7, S9, S8, Inequality, slope
[9] § Result › Overall trends ↔ 02_fig1_and_figs_s1_s3_maps.R, lines 1–35 · score 0.61 · S1 S3, 1990–2023, ASPR, ASMR, ASDR, ASIR
[10] § Result › Geographical heterogeneity ↔ 02_fig1_and_figs_s1_s3_maps.R, lines 1–35 · score 0.52 · S1 S3, ASPRs, ASDRs, ASIRs, EAPCs, mortality

Paper

Loaded from Europe PMC by your browser, not stored by OSCR: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The paper is loaded by your browser, with JavaScript: read it at doi.org or on Europe PMC.

The authors' code

R · 746 lines · 31 KB · no license · 2 matches

# =============================================================================
# 06_figs_s13_s24_bapc_validation_and_sensitivity.R
# =============================================================================
# Purpose: Comprehensive BAPC (Bayesian Age-Period-Cohort) analysis including:
# - Main forecast (1990-2023 -> 2050)
# - Hold-out validation (train 1990-2013, validate 2014-2023)
# - Sensitivity analysis (multiple model specifications)
#
# Corresponding manuscript outputs:
# Supplementary:
# - Fig. S13-S14 : Sensitivity analysis + retrospective validation for incidence
# - Fig. S16-S18 : Sensitivity analysis + retrospective validation for prevalence
# - Fig. S19-S21 : Sensitivity analysis + retrospective validation for mortality
# - Fig. S22-S24 : Sensitivity analysis + retrospective validation for DALYs
#
# Inputs:
# - asia.csv : Asia-level combined Number + Rate data
# - GBDpop1990_2100 : GBD population projections (from RData)
# - dfage, age_stand : Age metadata and WHO standard weights
#
# Outputs (saved to bapc_outputs/):
# - main_forecast/ : ASR & Number forecasts, age-specific projections
# - validation/ : Validation plots & metrics (MAE, RMSE, MAPE, coverage)
# - sensitivity/ : Sensitivity comparison plots & tables
# - model_specs/ : Model specification tables
# =============================================================================
library(readr)
library(dplyr)
library(tidyr)
library(broom)
library(scales)
library(tidyverse)
library(ggrepel)
library(ggsci)
library(patchwork)
library(BAPC)
library(INLA)
library(data.table)
library(vroom)
library(car)
library(MASS)
library(mgcv)
library(splines)
library(cowplot)
library(segmented)
library(showtext)
showtext.auto()
select <- dplyr::select
# ------------------------------
# 0. Load GBD objects
# ------------------------------
load("/Users/mac/Desktop/GBD最新版本/GBD/GBD2023DeepSeekV2.3.1/GBD.RData")
check_duplicates <- function(df, name = "data") {
dup <- df %>% count(year, age_id) %>% filter(n > 1)
if (nrow(dup) > 0) {
message("Found duplicated year-age_id combinations in ", name)
print(dup)
} else {
message("No duplicated year-age_id combinations in ", name)
}
}
# ------------------------------
# 1. Read analysis data & build Asia population
# ------------------------------
df_raw <- fread("asia.csv") %>%
mutate(measure_name = if_else(
measure_name == "DALYs (Disability-Adjusted Life Years)", "DALYs", measure_name
)) %>%
filter(year >= 1990, year <= 2023)
ASIA_IDS <- c(
6, 7, 10, 11, 12, 13, 14, 17, 15, 16, 19, 20, 18,
33, 34, 35, 37, 36, 38, 39, 40, 41,
66, 67, 68, 69, 140, 77, 85,
142, 143, 144, 145, 146, 149, 150, 151, 152,
155, 156, 153, 157, 160, 161, 162, 163, 164, 165
)
p <- GBDpop1990_2100
asia_pop <- p %>%
filter(location_id %in% ASIA_IDS) %>%
group_by(sex_name, age_id, age_name, year) %>%
summarise(val = sum(val, na.rm = TRUE), .groups = "drop") %>%
mutate(location_id = 9999, location_name = "Asia") %>%
select(location_id, location_name, sex_name, age_id, age_name, year, val)
GBDpop1990_2100 <- bind_rows(p, asia_pop)
# ------------------------------
# 2. Global settings
# ------------------------------
OBS_START_YEAR <- 1990
OBS_END_YEAR <- 2023
MAIN_PREYEAR <- 2050
TARGET_AGE_IDS <- c(1, 6, 7, 8)
# ------------------------------
# 3. Utility functions
# ------------------------------
safe_filename <- function(x) {
x <- as.character(x)
x <- gsub("[/\\?<>\\:*|\"]", "_", x)
x <- gsub("\\s+", "_", x)
x <- gsub("_+", "_", x)
x
}
calc_metrics <- function(obs, pred, lower = NULL, upper = NULL) {
mae <- mean(abs(pred - obs), na.rm = TRUE)
rmse <- sqrt(mean((pred - obs)^2, na.rm = TRUE))
mape <- mean(abs(pred - obs) / ifelse(obs == 0, NA, obs), na.rm = TRUE) * 100
if (!is.null(lower) && !is.null(upper)) {
coverage <- mean(obs >= lower & obs <= upper, na.rm = TRUE) * 100
} else {
coverage <- NA_real_
}
data.frame(MAE = mae, RMSE = rmse, MAPE = mape, PI95_coverage = coverage)
}
build_standard_weights <- function(age_ids_keep) {
wstand <- c(
sum(as.numeric(age_stand$std_population[1:2])),
as.numeric(age_stand$std_population[3:21])
)
wstand <- wstand / sum(wstand)
wstandx <- data.frame(
age_id = c(1, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 31, 32, 235),
w = wstand
)
standpop <- wstandx %>%
filter(age_id %in% age_ids_keep) %>%
mutate(proportion = w / sum(w))
return(standpop)
}
get_age_name_map <- function(age_ids) {
dfage %>%
filter(age_id %in% age_ids) %>%
distinct(age_id, age_name) %>%
arrange(age_id)
}
make_full_count_matrix <- function(dfx_num, use_age_ids,
start_year = OBS_START_YEAR,
end_year = OBS_END_YEAR) {
dfx_num2 <- dfx_num %>%
filter(year %in% start_year:end_year) %>%
filter(age_id %in% use_age_ids) %>%
group_by(year, age_id) %>%
summarise(val = sum(as.numeric(val), na.rm = TRUE), .groups = "drop")
all_grid <- expand.grid(year = start_year:end_year, age_id = use_age_ids) %>% as_tibble()
out <- all_grid %>%
left_join(dfx_num2, by = c("year", "age_id")) %>%
mutate(val = ifelse(is.na(val), 0, round(val, 0))) %>%
arrange(year, age_id)
return(out)
}
make_apc_matrix <- function(full_df, future_end_year = MAIN_PREYEAR) {
mat_obs <- full_df %>%
group_by(year, age_id) %>%
summarise(val = sum(as.numeric(val), na.rm = TRUE), .groups = "drop") %>%
pivot_wider(names_from = age_id, values_from = val, values_fill = 0) %>%
arrange(year)
if (future_end_year > max(full_df$year)) {
future_years <- (max(full_df$year) + 1):future_end_year
mat_future <- expand.grid(year = future_years, age_id = unique(full_df$age_id)) %>%
as_tibble() %>% mutate(val = NA_real_) %>%
pivot_wider(names_from = age_id, values_from = val) %>% arrange(year)
mat_all <- bind_rows(mat_obs, mat_future)
} else {
mat_all <- mat_obs
}
row_years <- mat_all$year
mat_all <- mat_all %>% select(-year) %>% as.data.frame()
rownames(mat_all) <- row_years
mat_all[] <- lapply(mat_all, as.numeric)
return(mat_all)
}
make_population_matrix <- function(loc_id, sex_name_input, use_age_ids,
preyear = MAIN_PREYEAR) {
pop_df <- GBDpop1990_2100 %>%
filter(year %in% OBS_START_YEAR:preyear) %>%
filter(location_id == loc_id) %>%
filter(sex_name == sex_name_input) %>%
filter(age_id %in% use_age_ids) %>%
select(year, age_id, val) %>%
group_by(year, age_id) %>%
summarise(val = sum(as.numeric(val), na.rm = TRUE), .groups = "drop")
pop_mat <- expand.grid(year = OBS_START_YEAR:preyear, age_id = use_age_ids) %>%
as_tibble() %>%
left_join(pop_df, by = c("year", "age_id")) %>%
mutate(val = ifelse(is.na(val), 0, val)) %>%
arrange(year, age_id) %>%
pivot_wider(names_from = age_id, values_from = val, values_fill = 0) %>%
arrange(year)
row_years <- pop_mat$year
pop_mat <- pop_mat %>% select(-year) %>% as.data.frame()
rownames(pop_mat) <- row_years
pop_mat[] <- lapply(pop_mat, as.numeric)
return(pop_mat)
}
rename_matrix_by_age_names <- function(mat, use_age_ids) {
age_map <- get_age_name_map(use_age_ids)
nm <- age_map$age_name[match(as.numeric(colnames(mat)), age_map$age_id)]
colnames(mat) <- nm
mat
}
extract_agestd_rate_df <- function(glores, preyear) {
agestd.rate(glores) %>%
as_tibble() %>%
mutate(year = OBS_START_YEAR:preyear) %>%
setNames(c("pred", "sd", "year")) %>%
mutate(
pred = pred * 100000, sd = sd * 100000,
lower95 = pred - 1.96 * sd, upper95 = pred + 1.96 * sd,
lower80 = pred - 1.282 * sd, upper80 = pred + 1.282 * sd,
lower50 = pred - 0.674 * sd, upper50 = pred + 0.674 * sd
)
}
extract_agestd_number_df <- function(glores, preyear) {
agestd.proj(glores) %>%
as_tibble() %>%
mutate(year = OBS_START_YEAR:preyear) %>%
setNames(c("pred", "sd", "year")) %>%
mutate(
lower95 = pred - 1.96 * sd, upper95 = pred + 1.96 * sd,
lower80 = pred - 1.282 * sd, upper80 = pred + 1.282 * sd,
lower50 = pred - 0.674 * sd, upper50 = pred + 0.674 * sd
)
}
extract_age_specific_rate_df <- function(glores, preyear) {
dfres <- BAPC::agespec.rate(glores)
age_groups <- names(dfres)
process_age_group <- function(data, group_name) {
data %>% as_tibble() %>%
mutate(year = OBS_START_YEAR:preyear, group = group_name) %>%
setNames(c("pred", "sd", "year", "group"))
}
purrr::map2_dfr(dfres, age_groups, process_age_group) %>%
mutate(pred = pred * 100000, sd = sd * 100000,
lower95 = pred - 1.96 * sd, upper95 = pred + 1.96 * sd)
}
extract_age_specific_number_df <- function(glores, preyear) {
dfres <- BAPC::agespec.proj(glores)
age_groups <- names(dfres)
process_age_group <- function(data, group_name) {
data %>% as_tibble() %>%
mutate(year = OBS_START_YEAR:preyear, group = group_name) %>%
setNames(c("pred", "sd", "year", "group"))
}
purrr::map2_dfr(dfres, age_groups, process_age_group) %>%
mutate(lower95 = pred - 1.96 * sd, upper95 = pred + 1.96 * sd)
}
make_validation_plot <- function(val_df, ylab, title_text) {
ggplot(val_df, aes(x = year)) +
geom_ribbon(aes(ymin = lower95, ymax = upper95), fill = "#6b6ecf", alpha = 0.20) +
geom_line(aes(y = pred), color = "#a696c8", linewidth = 1) +
geom_point(aes(y = pred), color = "#a696c8", size = 2) +
geom_line(aes(y = obs), color = "black", linewidth = 1) +
geom_point(aes(y = obs), color = "black", size = 2) +
theme_classic() +
labs(x = "Year", y = ylab, title = title_text) +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.title = element_text(size = 14, face = "bold"),
axis.text = element_text(size = 12, face = "bold")
)
}
make_main_forecast_plot_asr <- function(df_asr, obs_end_year, title_text = NULL) {
ggplot(df_asr, aes(x = year, y = pred)) +
geom_ribbon(aes(ymin = lower95, ymax = upper95), fill = "#E2E2E2", alpha = 1) +
geom_ribbon(aes(ymin = lower80, ymax = upper80), fill = "#CBCDD9", alpha = 1) +
geom_ribbon(aes(ymin = lower50, ymax = upper50), fill = "#013FA5", alpha = 1) +
geom_line(color = "black", linewidth = 1) +
geom_point(color = "black", size = 1.8) +
geom_vline(xintercept = obs_end_year, linetype = "dashed", color = "grey50") +
scale_x_continuous(breaks = seq(OBS_START_YEAR, max(df_asr$year), by = 5)) +
labs(x = "Year", y = "Age-standardized rate per 100,000", title = title_text) +
theme_classic() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.title = element_text(size = 14, face = "bold"),
axis.text = element_text(size = 12, face = "bold")
)
}
make_main_forecast_plot_num <- function(df_num, obs_end_year, title_text = NULL) {
ggplot(df_num, aes(x = year, y = pred)) +
geom_ribbon(aes(ymin = lower95, ymax = upper95), fill = "#E2E2E2", alpha = 1) +
geom_ribbon(aes(ymin = lower80, ymax = upper80), fill = "#CBCDD9", alpha = 1) +
geom_ribbon(aes(ymin = lower50, ymax = upper50), fill = "#013FA5", alpha = 1) +
geom_line(color = "black", linewidth = 1) +
geom_point(color = "black", size = 1.8) +
geom_vline(xintercept = obs_end_year, linetype = "dashed", color = "grey50") +
scale_x_continuous(breaks = seq(OBS_START_YEAR, max(df_num$year), by = 5)) +
labs(x = "Year", y = "Number", title = title_text) +
theme_classic() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.title = element_text(size = 14, face = "bold"),
axis.text = element_text(size = 12, face = "bold")
)
}
build_model_spec_table <- function(location_name, measure_name, sex_name,
train_start, train_end, valid_start, valid_end,
forecast_end, age_model, period_model, cohort_model,
overdis_model, prior_main, prior_overdis,
secondDiff, standard_pop) {
data.frame(
location_name = location_name, measure_name = measure_name, sex_name = sex_name,
train_period = paste0(train_start, "-", train_end),
validation_period = paste0(valid_start, "-", valid_end),
forecast_end = forecast_end, age_model = age_model, period_model = period_model,
cohort_model = cohort_model, overdispersion_model = overdis_model,
prior_main = prior_main, prior_overdis = prior_overdis,
secondDiff = secondDiff, standard_population = standard_pop,
stringsAsFactors = FALSE
)
}
# ------------------------------
# 4. Core BAPC runner
# ------------------------------
run_bapc_core <- function(
dfx_num, full_df_for_obs, location_name, measure_name,
sex_name = "Both", location_id,
preyear = MAIN_PREYEAR, train_end_year = OBS_END_YEAR,
obs_end_year = OBS_END_YEAR, use_age_ids = TARGET_AGE_IDS,
age_model = "rw2", period_model = "rw1", cohort_model = "rw2",
secondDiff = FALSE, addzero = FALSE
) {
count_full <- make_full_count_matrix(dfx_num, use_age_ids,
start_year = OBS_START_YEAR,
end_year = obs_end_year)
check_duplicates(count_full, "count_full")
apcNum_all <- make_apc_matrix(count_full, future_end_year = preyear)
holdout_years <- integer(0)
if (train_end_year < obs_end_year) {
holdout_years <- (train_end_year + 1):obs_end_year
apcNum_all[as.character(holdout_years), ] <- NA
}
Pop17 <- make_population_matrix(loc_id = location_id,
sex_name_input = sex_name,
use_age_ids = use_age_ids, preyear = preyear)
apcNum_all <- rename_matrix_by_age_names(apcNum_all, use_age_ids)
Pop17 <- rename_matrix_by_age_names(Pop17, use_age_ids)
if (!addzero) {
age_map_present <- dfx_num %>%
distinct(age_id) %>% filter(age_id %in% use_age_ids) %>%
left_join(get_age_name_map(use_age_ids), by = "age_id") %>% arrange(age_id)
keep_age_names <- age_map_present$age_name
keep_age_ids <- age_map_present$age_id
apcNum_all <- apcNum_all %>% select(any_of(keep_age_names))
Pop17 <- Pop17 %>% select(any_of(keep_age_names))
} else {
keep_age_ids <- use_age_ids
}
standpop <- build_standard_weights(keep_age_ids)
gloAPC <- APCList(apcNum_all, Pop17, gf = 5, agelab = colnames(Pop17))
npredict <- preyear - obs_end_year
glores <- tryCatch({
BAPC(
gloAPC,
predict = list(npredict = npredict, retro = TRUE),
verbose = FALSE, secondDiff = secondDiff,
model = list(
age = list(model = age_model, prior = "loggamma", param = c(1, 0.00005)),
period = list(include = TRUE, model = period_model, prior = "loggamma", param = c(1, 0.00005)),
cohort = list(include = TRUE, model = cohort_model, prior = "loggamma", param = c(1, 0.00005)),
overdis = list(include = TRUE, model = "iid", prior = "loggamma", param = c(1, 0.005))
),
stdweight = standpop$proportion
)
}, error = function(e) {
message("Custom BAPC failed, fallback to default BAPC. Error: ", e$message)
BAPC(gloAPC, predict = list(npredict = npredict, retro = TRUE),
verbose = FALSE, secondDiff = secondDiff,
stdweight = standpop$proportion)
})
df_asr <- extract_agestd_rate_df(glores, preyear)
df_num <- extract_agestd_number_df(glores, preyear)
df_age_rate <- extract_age_specific_rate_df(glores, preyear)
df_age_num <- extract_age_specific_number_df(glores, preyear)
val_asr <- NULL; val_num <- NULL
metrics_asr <- NULL; metrics_num <- NULL
if (length(holdout_years) > 0) {
obs_asr <- full_df_for_obs %>%
filter(location_name == location_name, measure_name == measure_name,
sex_name == sex_name, year %in% holdout_years,
age_id == 27, metric_name == "Rate") %>%
select(year, obs = val) %>% distinct()
obs_num <- full_df_for_obs %>%
filter(location_name == location_name, measure_name == measure_name,
sex_name == sex_name, year %in% holdout_years,
metric_name == "Number") %>%
filter(age_id %in% use_age_ids) %>%
group_by(year) %>% summarise(obs = sum(val, na.rm = TRUE), .groups = "drop")
val_asr <- df_asr %>% filter(year %in% holdout_years) %>% left_join(obs_asr, by = "year")
val_num <- df_num %>% filter(year %in% holdout_years) %>% left_join(obs_num, by = "year")
metrics_asr <- calc_metrics(obs = val_asr$obs, pred = val_asr$pred,
lower = val_asr$lower95, upper = val_asr$upper95) %>%
mutate(outcome = "ASR", location_name = location_name, measure_name = measure_name,
sex_name = sex_name, train_period = paste0(OBS_START_YEAR, "-", train_end_year),
validation_period = paste0(train_end_year + 1, "-", obs_end_year),
age_model = age_model, period_model = period_model,
cohort_model = cohort_model, secondDiff = secondDiff)
metrics_num <- calc_metrics(obs = val_num$obs, pred = val_num$pred,
lower = val_num$lower95, upper = val_num$upper95) %>%
mutate(outcome = "Number", location_name = location_name, measure_name = measure_name,
sex_name = sex_name, train_period = paste0(OBS_START_YEAR, "-", train_end_year),
validation_period = paste0(train_end_year + 1, "-", obs_end_year),
age_model = age_model, period_model = period_model,
cohort_model = cohort_model, secondDiff = secondDiff)
}
p_main_asr <- make_main_forecast_plot_asr(df_asr, obs_end_year = obs_end_year,
title_text = paste0(location_name, " - ", measure_name, " - ASR forecast"))
p_main_num <- make_main_forecast_plot_num(df_num, obs_end_year = obs_end_year,
title_text = paste0(location_name, " - ", measure_name, " - Number forecast"))
p_val_asr <- NULL; p_val_num <- NULL
if (!is.null(val_asr)) {
p_val_asr <- make_validation_plot(val_asr, ylab = "ASR per 100,000",
title_text = paste0(location_name, " - ", measure_name, " - Validation (ASR)"))
}
if (!is.null(val_num)) {
p_val_num <- make_validation_plot(val_num, ylab = "Number",
title_text = paste0(location_name, " - ", measure_name, " - Validation (Number)"))
}
model_spec <- build_model_spec_table(
location_name = location_name, measure_name = measure_name, sex_name = sex_name,
train_start = OBS_START_YEAR, train_end = train_end_year,
valid_start = ifelse(train_end_year < obs_end_year, train_end_year + 1, NA),
valid_end = ifelse(train_end_year < obs_end_year, obs_end_year, NA),
forecast_end = preyear, age_model = age_model, period_model = period_model,
cohort_model = cohort_model, overdis_model = "iid",
prior_main = "loggamma(1, 0.00005)", prior_overdis = "loggamma(1, 0.005)",
secondDiff = secondDiff, standard_pop = "WHO standard population"
)
return(list(
apc_res = glores, df_asr = df_asr, df_num = df_num,
df_age_rate = df_age_rate, df_age_num = df_age_num,
val_asr = val_asr, val_num = val_num,
metrics_asr = metrics_asr, metrics_num = metrics_num,
p_main_asr = p_main_asr, p_main_num = p_main_num,
p_val_asr = p_val_asr, p_val_num = p_val_num,
model_spec = model_spec
))
}
# ------------------------------
# 5. Output directories
# ------------------------------
dir.create("bapc_outputs", showWarnings = FALSE)
dir.create("bapc_outputs/main_forecast", showWarnings = FALSE)
dir.create("bapc_outputs/validation", showWarnings = FALSE)
dir.create("bapc_outputs/sensitivity", showWarnings = FALSE)
dir.create("bapc_outputs/model_specs", showWarnings = FALSE)
# ------------------------------
# 6. Main analysis
# ------------------------------
all_main_metrics <- list()
all_model_specs <- list()
locs_to_run <- unique(df_raw$location_name)
measures_to_run <- unique(df_raw$measure_name)
for (loc_i in locs_to_run) {
cat("\n============================\n")
cat("Location:", loc_i, "\n")
cat("============================\n")
df_loc <- df_raw %>% filter(location_name == loc_i)
for (mea_j in unique(df_loc$measure_name)) {
cat("Measure:", mea_j, "\n")
dfx_num <- df_loc %>%
filter(measure_name == mea_j, sex_name == "Both",
age_id %in% TARGET_AGE_IDS, metric_name == "Number") %>%
select(location_id, location_name, measure_name, sex_name, age_id, age_name,
year, metric_name, val) %>% distinct()
if (nrow(dfx_num) == 0) { cat("No Number data, skip.\n"); next }
location_id_i <- unique(dfx_num$location_id)[1]
location_name_i <- unique(dfx_num$location_name)[1]
measure_name_i <- unique(dfx_num$measure_name)[1]
main_res <- run_bapc_core(
dfx_num = dfx_num, full_df_for_obs = df_raw,
location_name = location_name_i, measure_name = measure_name_i,
sex_name = "Both", location_id = location_id_i,
preyear = MAIN_PREYEAR, train_end_year = OBS_END_YEAR,
obs_end_year = OBS_END_YEAR, use_age_ids = TARGET_AGE_IDS,
age_model = "rw2", period_model = "rw1", cohort_model = "rw2",
secondDiff = FALSE, addzero = FALSE
)
base_name <- paste0(safe_filename(location_name_i), "_", safe_filename(measure_name_i))
write.csv(main_res$df_asr, file.path("bapc_outputs/main_forecast", paste0(base_name, "_forecast_asr.csv")), row.names = FALSE)
write.csv(main_res$df_num, file.path("bapc_outputs/main_forecast", paste0(base_name, "_forecast_number.csv")), row.names = FALSE)
write.csv(main_res$df_age_rate, file.path("bapc_outputs/main_forecast", paste0(base_name, "_forecast_age_specific_rate.csv")), row.names = FALSE)
write.csv(main_res$df_age_num, file.path("bapc_outputs/main_forecast", paste0(base_name, "_forecast_age_specific_number.csv")), row.names = FALSE)
ggsave(file.path("bapc_outputs/main_forecast", paste0(base_name, "_forecast_asr.pdf")),
plot = main_res$p_main_asr, width = 10, height = 8, units = "in", dpi = 300)
ggsave(file.path("bapc_outputs/main_forecast", paste0(base_name, "_forecast_number.pdf")),
plot = main_res$p_main_num, width = 10, height = 8, units = "in", dpi = 300)
write.csv(main_res$model_spec, file.path("bapc_outputs/model_specs", paste0(base_name, "_model_spec.csv")), row.names = FALSE)
all_model_specs[[base_name]] <- main_res$model_spec
}
}
if (length(all_model_specs) > 0) {
model_specs_df <- bind_rows(all_model_specs)
write.csv(model_specs_df, "bapc_outputs/model_specs/all_model_specs.csv", row.names = FALSE)
}
# ------------------------------
# 7. Hold-out validation (1990-2013 -> 2014-2023)
# ------------------------------
all_val_metrics <- list()
for (loc_i in locs_to_run) {
cat("\n============================\n")
cat("Validation Location:", loc_i, "\n")
cat("============================\n")
df_loc <- df_raw %>% filter(location_name == loc_i)
for (mea_j in unique(df_loc$measure_name)) {
cat("Validation Measure:", mea_j, "\n")
dfx_num <- df_loc %>%
filter(measure_name == mea_j, sex_name == "Both",
age_id %in% TARGET_AGE_IDS, metric_name == "Number") %>%
select(location_id, location_name, measure_name, sex_name, age_id, age_name,
year, metric_name, val) %>% distinct()
if (nrow(dfx_num) == 0) { cat("No Number data, skip validation.\n"); next }
location_id_i <- unique(dfx_num$location_id)[1]
location_name_i <- unique(dfx_num$location_name)[1]
measure_name_i <- unique(dfx_num$measure_name)[1]
val_res <- run_bapc_core(
dfx_num = dfx_num, full_df_for_obs = df_raw,
location_name = location_name_i, measure_name = measure_name_i,
sex_name = "Both", location_id = location_id_i,
preyear = MAIN_PREYEAR, train_end_year = 2013,
obs_end_year = OBS_END_YEAR, use_age_ids = TARGET_AGE_IDS,
age_model = "rw2", period_model = "rw1", cohort_model = "rw2",
secondDiff = FALSE, addzero = FALSE
)
base_name <- paste0(safe_filename(location_name_i), "_", safe_filename(measure_name_i))
if (!is.null(val_res$val_asr)) {
write.csv(val_res$val_asr, file.path("bapc_outputs/validation", paste0(base_name, "_validation_asr.csv")), row.names = FALSE)
ggsave(file.path("bapc_outputs/validation", paste0(base_name, "_validation_asr.pdf")),
plot = val_res$p_val_asr, width = 10, height = 7, units = "in", dpi = 300)
}
if (!is.null(val_res$val_num)) {
write.csv(val_res$val_num, file.path("bapc_outputs/validation", paste0(base_name, "_validation_number.csv")), row.names = FALSE)
ggsave(file.path("bapc_outputs/validation", paste0(base_name, "_validation_number.pdf")),
plot = val_res$p_val_num, width = 10, height = 7, units = "in", dpi = 300)
}
if (!is.null(val_res$metrics_asr)) {
write.csv(val_res$metrics_asr, file.path("bapc_outputs/validation", paste0(base_name, "_metrics_asr.csv")), row.names = FALSE)
all_val_metrics[[paste0(base_name, "_ASR")]] <- val_res$metrics_asr
}
if (!is.null(val_res$metrics_num)) {
write.csv(val_res$metrics_num, file.path("bapc_outputs/validation", paste0(base_name, "_metrics_number.csv")), row.names = FALSE)
all_val_metrics[[paste0(base_name, "_Number")]] <- val_res$metrics_num
}
}
}
if (length(all_val_metrics) > 0) {
all_val_metrics_df <- bind_rows(all_val_metrics)
write.csv(all_val_metrics_df, "bapc_outputs/validation/all_validation_metrics.csv", row.names = FALSE)
}
# ------------------------------
# 8. Sensitivity analysis
# ------------------------------
sensitivity_grid <- expand.grid(
train_end_year = c(2010, 2013, 2015),
period_model = c("rw1", "rw2"),
secondDiff = c(FALSE, TRUE),
stringsAsFactors = FALSE
)
all_sens_metrics <- list()
all_sens_summary <- list()
for (loc_i in locs_to_run) {
cat("\n============================\n")
cat("Sensitivity Location:", loc_i, "\n")
cat("============================\n")
df_loc <- df_raw %>% filter(location_name == loc_i)
for (mea_j in unique(df_loc$measure_name)) {
cat("Sensitivity Measure:", mea_j, "\n")
dfx_num <- df_loc %>%
filter(measure_name == mea_j, sex_name == "Both",
age_id %in% TARGET_AGE_IDS, metric_name == "Number") %>%
select(location_id, location_name, measure_name, sex_name, age_id, age_name,
year, metric_name, val) %>% distinct()
if (nrow(dfx_num) == 0) { cat("No Number data, skip sensitivity.\n"); next }
location_id_i <- unique(dfx_num$location_id)[1]
location_name_i <- unique(dfx_num$location_name)[1]
measure_name_i <- unique(dfx_num$measure_name)[1]
base_name <- paste0(safe_filename(location_name_i), "_", safe_filename(measure_name_i))
sens_plot_df <- list()
for (k in 1:nrow(sensitivity_grid)) {
g <- sensitivity_grid[k, ]
cat(" Scenario:", k, "| train_end =", g$train_end_year,
"| period_model =", g$period_model, "| secondDiff =", g$secondDiff, "\n")
sens_res <- run_bapc_core(
dfx_num = dfx_num, full_df_for_obs = df_raw,
location_name = location_name_i, measure_name = measure_name_i,
sex_name = "Both", location_id = location_id_i,
preyear = MAIN_PREYEAR, train_end_year = g$train_end_year,
obs_end_year = OBS_END_YEAR, use_age_ids = TARGET_AGE_IDS,
age_model = "rw2", period_model = g$period_model,
cohort_model = "rw2", secondDiff = g$secondDiff, addzero = FALSE
)
if (!is.null(sens_res$metrics_asr)) {
tmp_asr <- sens_res$metrics_asr %>%
mutate(scenario_id = k,
scenario = paste0("train_end_", g$train_end_year,
"_period_", g$period_model,
"_secondDiff_", g$secondDiff))
all_sens_metrics[[paste0(base_name, "_ASR_s", k)]] <- tmp_asr
}
if (!is.null(sens_res$metrics_num)) {
tmp_num <- sens_res$metrics_num %>%
mutate(scenario_id = k,
scenario = paste0("train_end_", g$train_end_year,
"_period_", g$period_model,
"_secondDiff_", g$secondDiff))
all_sens_metrics[[paste0(base_name, "_NUM_s", k)]] <- tmp_num
}
sens_summary <- sens_res$df_asr %>%
filter(year == MAIN_PREYEAR) %>%
mutate(location_name = location_name_i, measure_name = measure_name_i,
train_end_year = g$train_end_year, period_model = g$period_model,
secondDiff = g$secondDiff)
all_sens_summary[[paste0(base_name, "_summary_", k)]] <- sens_summary
sens_plot_df[[k]] <- sens_res$df_asr %>%
mutate(scenario = paste0("train_end=", g$train_end_year,
", period=", g$period_model,
", secondDiff=", g$secondDiff))
}
sens_plot_df2 <- bind_rows(sens_plot_df)
p_sens <- ggplot(sens_plot_df2, aes(x = year, y = pred, color = scenario)) +
geom_line(linewidth = 1) + theme_classic() +
labs(x = "Year", y = "ASR per 100,000",
title = paste0(location_name_i, " - ", measure_name_i, " - Sensitivity analysis")) +
theme(plot.title = element_text(size = 14, face = "bold"),
axis.title = element_text(size = 14, face = "bold"),
axis.text = element_text(size = 12, face = "bold"),
legend.title = element_blank(), legend.text = element_text(size = 10))
ggsave(file.path("bapc_outputs/sensitivity", paste0(base_name, "_sensitivity_asr.pdf")),
plot = p_sens, width = 12, height = 8, units = "in", dpi = 300)
}
}
if (length(all_sens_metrics) > 0) {
all_sens_metrics_df <- bind_rows(all_sens_metrics)
write.csv(all_sens_metrics_df, "bapc_outputs/sensitivity/all_sensitivity_metrics.csv", row.names = FALSE)
}
if (length(all_sens_summary) > 0) {
all_sens_summary_df <- bind_rows(all_sens_summary)
write.csv(all_sens_summary_df, "bapc_outputs/sensitivity/all_sensitivity_2050_summary.csv", row.names = FALSE)
}
# ------------------------------
# 9. Combine model assumptions & validation metrics
# ------------------------------
model_specs_df <- NULL
validation_metrics_df <- NULL
if (file.exists("bapc_outputs/model_specs/all_model_specs.csv")) {
model_specs_df <- fread("bapc_outputs/model_specs/all_model_specs.csv")
}
if (file.exists("bapc_outputs/validation/all_validation_metrics.csv")) {
validation_metrics_df <- fread("bapc_outputs/validation/all_validation_metrics.csv")
}
if (!is.null(model_specs_df) && !is.null(validation_metrics_df)) {
combined_table <- validation_metrics_df %>%
left_join(model_specs_df, by = c("location_name", "measure_name", "sex_name"))
write.csv(combined_table, "bapc_outputs/model_specs/model_assumptions_and_validation_metrics.csv", row.names = FALSE)
}
# ------------------------------
# 10. Done
# ------------------------------
cat("\n====================================\n")
cat("All jobs finished.\n")
cat("Main forecast outputs: bapc_outputs/main_forecast/\n")
cat("Validation outputs: bapc_outputs/validation/\n")
cat("Sensitivity outputs: bapc_outputs/sensitivity/\n")
cat("Model specs: bapc_outputs/model_specs/\n")
cat("====================================\n")
print("Corresponds to Fig. S13-S24 (supplementary)")

06_figs_s13_s24_bapc_validation_and_sensitivity.R at commit 292c7f3, no license · at the source

Overview

Authors: Weiqin Zhang¹, Wenwen Lv², Rui Chen³, Taixiang Liu⁴

Institutions: Children's Hospital of Zhejiang University (China); Zhejiang University (China); Shanghai Jiao Tong University (China)

Journal: iScience, volume 29, issue 6, article 116242

Dates: received 13 February 2026; accepted 19 May 2026; published online 4 June 2026

Type: Research article · Language: English

License: CC BY-NC-ND

Identifiers: DOI 10.1016/j.isci.2026.116242 · PMID 42305603 · PMCID PMC13266199 · OpenAlex W7163518144

Open access: gold, a free copy (OpenAlex)

Status: code verified

Categories: human (organism), other condition (population)

Methods: Statistics, Preprocessing

Keywords: health sciences, medicine, medical specialty, internal medicine, oncology, public health

Topic: Acute Lymphoblastic Leukemia research (Public Health, Environmental and Occupational Health, Medicine), according to OpenAlex

Funding: Natural Science Foundation of Zhejiang Province (ZCLY24H0301)

Citations: not cited yet (Europe PMC); 53 references in the paper

Abstract

The abstract is not reproduced here: the paper's license (CC BY-NC-ND) does not allow it. Read it in the paper, at the publisher or on Europe PMC.

Repository

Its files are read in the Code ↔ Paper reader above, with 10 matches between paragraphs and lines of code.

Z-C-Q/CNS

License: none: the authors keep all their rights

State: the link answers, verified on 27 September 2026

Evidence: files inventoried

Commit: 292c7f3cd41a36d0a5f0b310797a697c1d3caa80, 10 May 2026

Languages: R (7)

Size: 9 files, 7 scripts

Software Heritage: not archived

Found in: “Data and code availability”

Holds: README

Not found: license file, CITATION.cff, environment file, tests, continuous integration, documentation

Tools: tidyverse (7 files), data.table (6 files), cowplot (4 files), broom (3 files), car (3 files), ggplot2 (3 files), mgcv (3 files), patchwork (2 files)

Availability: 1 check, the latest on 27 September 2026: the link answers

27 September 2026: the link answers

8 files

00_data_preparation.R, R, 146 lines
01_table_1_and_tables_s1_s3.R, R, 190 lines, 2 matches
02_fig1_and_figs_s1_s3_maps.R, R, 231 lines, 2 matches
03_fig2_and_figs_s4_s6_age_trends_and_sex_distribution.R, R, 253 lines, 1 match
04_fig3_and_figs_s7_s9_inequality.R, R, 389 lines, 1 match
05_fig4_and_figs_s10_s12_bapc_forecast.R, R, 311 lines, 2 matches
06_figs_s13_s24_bapc_validation_and_sensitivity.R, R, 746 lines, 2 matches
README.md, Text, 198 lines

At the source: github.com/Z-C-Q/CNS

The paper's code and data availability statement is in the Data section.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

1 repository of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
7 scripts, each with its path and the digest of its content;
10 matches between paragraphs of the paper and lines of the code (method lexical-v1);
neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

No dataset and no data link were found in the paper.

Code and data availability statement

The paper has a code and data availability statement. Its license (CC BY-NC-ND) does not allow reproducing it here; in short, from what the harvester recognized in it:

it points to the authors' code: Z-C-Q/CNS

Read it in the paper: doi.org/10.1016/j.isci.2026.116242.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 1, 27 September 2026: the first record

Recorded: type, language, journal, volume, issue, pages, dates, 4 authors, 6 keywords, 1 funder, 53 references.

Cite

This paper

Zhang, W., Lv, W., Chen, R., & Liu, T. (2026). Brain and central nervous system cancer burden in children across Asia. iScience, 29(6), 116242. https://doi.org/10.1016/j.isci.2026.116242

BibTeX

@article{zhang2026brain, author = {Zhang, Weiqin and Lv, Wenwen and Chen, Rui and Liu, Taixiang}, title = {{Brain and central nervous system cancer burden in children across Asia}}, journal = {iScience}, year = {2026}, month = jun, volume = {29}, number = {6}, pages = {116242}, publisher = {Elsevier}, issn = {2589-0042}, doi = {10.1016/j.isci.2026.116242}, url = {https://doi.org/10.1016/j.isci.2026.116242}, pmid = {42305603}, pmcid = {PMC13266199} }

RIS

TY - JOUR AU - Zhang, Weiqin AU - Lv, Wenwen AU - Chen, Rui AU - Liu, Taixiang TI - Brain and central nervous system cancer burden in children across Asia T2 - iScience J2 - iScience PY - 2026 DA - 2026/06/04 VL - 29 IS - 6 SP - 116242 SN - 2589-0042 PB - Elsevier DO - 10.1016/j.isci.2026.116242 UR - https://doi.org/10.1016/j.isci.2026.116242 LA - en ER -

CSL-JSON

{ "id": "10.1016/j.isci.2026.116242", "type": "article-journal", "title": "Brain and central nervous system cancer burden in children across Asia", "container-title": "iScience", "author": [ { "family": "Zhang", "given": "Weiqin" }, { "family": "Lv", "given": "Wenwen" }, { "family": "Chen", "given": "Rui" }, { "family": "Liu", "given": "Taixiang" } ], "container-title-short": "iScience", "volume": "29", "issue": "6", "page": "116242", "DOI": "10.1016/j.isci.2026.116242", "PMID": "42305603", "PMCID": "PMC13266199", "ISSN": "2589-0042", "publisher": "Elsevier", "URL": "https://doi.org/10.1016/j.isci.2026.116242", "language": "en", "issued": { "date-parts": [ [ 2026, 6, 4 ] ] } }

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: questions and error reports about this paper and its code, from signed-in readers and its authors. It opens with sign-in.

Reproductions: reports from readers who ran the authors' code: what they reproduced, with which environment, commit and data. It opens with sign-in.

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.