a <- b %>% filter(age == "Age-standardized")
# Load required packages
library(dplyr)
library(ggplot2)
library(forcats)

# Step 1: Extract the required indicator data from the data frame a
# Assume the data frame a contains columns: measure, location, sex, cause, rei, year, val

# Extract each indicator's data and ensure each combination has only one row
deaths_data <- a %>% 
  filter(measure == "Deaths") %>%
  group_by(location, year, sex, cause) %>%
  summarise(deaths_val = mean(val, na.rm = TRUE), .groups = "drop")

incidence_data <- a %>% 
  filter(measure == "Incidence") %>%
  group_by(location, year, sex, cause) %>%
  summarise(incidence_val = mean(val, na.rm = TRUE), .groups = "drop")

prevalence_data <- a %>% 
  filter(measure == "Prevalence") %>%
  group_by(location, year, sex, cause) %>%
  summarise(prevalence_val = mean(val, na.rm = TRUE), .groups = "drop")

ylls_data <- a %>% 
  filter(measure == "YLLs (Years of Life Lost)") %>%
  group_by(location, year, sex, cause) %>%
  summarise(ylls_val = mean(val, na.rm = TRUE), .groups = "drop")

ylds_data <- a %>% 
  filter(measure == "YLDs (Years Lived with Disability)") %>%
  group_by(location, year, sex, cause) %>%
  summarise(ylds_val = mean(val, na.rm = TRUE), .groups = "drop")

dalys_data <- a %>% 
  filter(measure == "DALYs (Disability-Adjusted Life Years)") %>%
  group_by(location, year, sex, cause) %>%
  summarise(dalys_val = mean(val, na.rm = TRUE), .groups = "drop")

# Ensure we only process years, locations, and sexes that are common across all indicators
# First, get the common years, locations, and sexes across all indicators
common_years <- Reduce(intersect, list(
  unique(deaths_data$year),
  unique(incidence_data$year),
  unique(prevalence_data$year),
  unique(ylls_data$year),
  unique(ylds_data$year),
  unique(dalys_data$year)
))

common_locations <- Reduce(intersect, list(
  unique(deaths_data$location),
  unique(incidence_data$location),
  unique(prevalence_data$location),
  unique(ylls_data$location),
  unique(ylds_data$location),
  unique(dalys_data$location)
))

common_sex <- Reduce(intersect, list(
  unique(deaths_data$sex),
  unique(incidence_data$sex),
  unique(prevalence_data$sex),
  unique(ylls_data$sex),
  unique(ylds_data$sex),
  unique(dalys_data$sex)
))

# Filter each indicator's data to only include common years, locations, and sexes
deaths_common <- deaths_data %>% 
  filter(year %in% common_years, location %in% common_locations, sex %in% common_sex)

incidence_common <- incidence_data %>% 
  filter(year %in% common_years, location %in% common_locations, sex %in% common_sex)

prevalence_common <- prevalence_data %>% 
  filter(year %in% common_years, location %in% common_locations, sex %in% common_sex)

ylls_common <- ylls_data %>% 
  filter(year %in% common_years, location %in% common_locations, sex %in% common_sex)

ylds_common <- ylds_data %>% 
  filter(year %in% common_years, location %in% common_locations, sex %in% common_sex)

dalys_common <- dalys_data %>% 
  filter(year %in% common_years, location %in% common_locations, sex %in% common_sex)

# Merge data to calculate ratios - use reduce to merge step by step to avoid many-to-many relationships
merged_data <- incidence_common %>%
  select(location, year, sex, cause, incidence_val) %>%
  left_join(
    deaths_common %>% select(location, year, sex, cause, deaths_val),
    by = c("location", "year", "sex", "cause")
  ) %>%
  left_join(
    prevalence_common %>% select(location, year, sex, cause, prevalence_val),
    by = c("location", "year", "sex", "cause")
  ) %>%
  left_join(
    ylls_common %>% select(location, year, sex, cause, ylls_val),
    by = c("location", "year", "sex", "cause")
  ) %>%
  left_join(
    ylds_common %>% select(location, year, sex, cause, ylds_val),
    by = c("location", "year", "sex", "cause")
  ) %>%
  left_join(
    dalys_common %>% select(location, year, sex, cause, dalys_val),
    by = c("location", "year", "sex", "cause")
  )

# Calculate basic ratios
merged_data <- merged_data %>%
  mutate(
    MIR = deaths_val / incidence_val,           # Mortality/Incidence
    PIR = prevalence_val / incidence_val,      # Prevalence/Incidence
    YLR = ylls_val / ylds_val,                  # YLLs/YLDs
    DPR = dalys_val / prevalence_val           # DALYs/Prevalence
  )

# Handle possible infinite values and missing values
merged_data <- merged_data %>%
  mutate(
    MIR = ifelse(is.infinite(MIR) | is.na(MIR), NA, MIR),
    PIR = ifelse(is.infinite(PIR) | is.na(PIR), NA, PIR),
    YLR = ifelse(is.infinite(YLR) | is.na(YLR), NA, YLR),
    DPR = ifelse(is.infinite(DPR) | is.na(DPR), NA, DPR)
  )

# View the results
head(merged_data)

# Save the calculated results
write.csv(merged_data, "basic_ratios_calculated.csv", row.names = FALSE)

# View the data overview
summary(merged_data)

# Step 2

# Create a data frame containing only the four ratios
pca_data <- merged_data %>%
  select(YLR, DPR, MIR, PIR) %>%
  na.omit()  # Remove rows containing missing values

# View the data structure
str(pca_data)
summary(pca_data)

# Standardize the data
scaled_data <- scale(pca_data)

# View the standardized data
summary(scaled_data)

# Perform PCA
pca_result <- prcomp(scaled_data, scale = FALSE)  # Because the data has already been standardized

# View the PCA results
summary(pca_result)
print(pca_result$rotation)

# Extract the rotation matrix of the first two principal components
rotation_matrix <- pca_result$rotation[, 1:2]

# Assign weight coefficients
ω1 <- rotation_matrix["YLR", 1]
ω2 <- rotation_matrix["DPR", 1]
ω3 <- rotation_matrix["MIR", 1]
ω4 <- rotation_matrix["PIR", 1]

ω5 <- rotation_matrix["YLR", 2]
ω6 <- rotation_matrix["DPR", 2]
ω7 <- rotation_matrix["MIR", 2]
ω8 <- rotation_matrix["PIR", 2]

# Print the weight coefficients
cat("Weight coefficients:\n")
cat(sprintf("ω1 (Weight of YLR in PC1) = %.4f\n", ω1))
cat(sprintf("ω2 (Weight of DPR in PC1) = %.4f\n", ω2))
cat(sprintf("ω3 (Weight of MIR in PC1) = %.4f\n", ω3))
cat(sprintf("ω4 (Weight of PIR in PC1) = %.4f\n", ω4))
cat(sprintf("ω5 (Weight of YLR in PC2) = %.4f\n", ω5))
cat(sprintf("ω6 (Weight of DPR in PC2) = %.4f\n", ω6))
cat(sprintf("ω7 (Weight of MIR in PC2) = %.4f\n", ω7))
cat(sprintf("ω8 (Weight of PIR in PC2) = %.4f\n", ω8))

# Prepare to calculate PC1 and PC2 data (remove rows with missing values)
calc_data <- merged_data %>%
  select(location, year, sex, cause, YLR, DPR, MIR, PIR) %>%
  na.omit()

# Calculate PC1 and PC2
calc_data <- calc_data %>%
  mutate(
    PC1 = ω1 * YLR + ω2 * DPR + ω3 * MIR + ω4 * PIR,
    PC2 = ω5 * YLR + ω6 * DPR + ω7 * MIR + ω8 * PIR
  )

# View the results
head(calc_data)

# Load required packages
library(dplyr)
library(ggplot2)
library(forcats)

# Extract the variance of each principal component
variance <- pca_result$sdev^2
explained_variance <- variance / sum(variance)

# Print the results
cat(sprintf("Variance explained by PC1: %.2f%%\n", explained_variance[1] * 100))
cat(sprintf("Variance explained by PC2: %.2f%%\n", explained_variance[2] * 100))
cat(sprintf("Total variance explained by the first two principal components: %.2f%%\n", sum(explained_variance[1:2]) * 100))

# Create a biplot for PCA
pca_df <- data.frame(
  PC1 = pca_result$x[, 1],
  PC2 = pca_result$x[, 2],
  Variable = rownames(pca_result$rotation)
)

# Plot the biplot
ggplot() +
  geom_point(data = as.data.frame(pca_result$x), aes(PC1, PC2), alpha = 0.3) +
  geom_segment(data = pca_df, 
               aes(x = 0, y = 0, xend = PC1 * 3, yend = PC2 * 3),
               arrow = arrow(length = unit(0.2, "cm")), color = "red") +
  geom_text(data = pca_df, 
            aes(PC1 * 3.2, PC2 * 3.2, label = Variable), 
            size = 4, vjust = 0.5, hjust = 0.5) +
  labs(title = "PCA Biplot - Principal Component Analysis Results",
       x = paste0("PC1 (", round(explained_variance[1] * 100, 1), "%)"),
       y = paste0("PC2 (", round(explained_variance[2] * 100, 1), "%)")) +
  theme_minimal() +
  theme(panel.grid.major = element_line(color = "gray80"))


# Step 3: PCA Score Calculation

# Extract the variance of PC1 and PC2 from the PCA results
var_pc1 <- pca_result$sdev[1]^2
var_pc2 <- pca_result$sdev[2]^2

# Calculate the total variance
total_var <- var_pc1 + var_pc2

# Calculate the weights
weight_pc1 <- var_pc1 / total_var
weight_pc2 <- var_pc2 / total_var

# Print the variance and weight information
cat(sprintf("Variance of PC1: %.4f\n", var_pc1))
cat(sprintf("Variance of PC2: %.4f\n", var_pc2))
cat(sprintf("Total variance: %.4f\n", total_var))
cat(sprintf("Weight of PC1: %.4f\n", weight_pc1))
cat(sprintf("Weight of PC2: %.4f\n", weight_pc2))

# Calculate the PCA score
calc_data <- calc_data %>%
  mutate(
    PCA_score = weight_pc1 * PC1 + weight_pc2 * PC2
  )

# View the calculated results
head(calc_data)

# Save the calculated results
write.csv(calc_data, "pca_scores_calculated.csv", row.names = FALSE)

# Visualize the distribution of PCA scores
ggplot(calc_data, aes(x = PCA_score)) +
  geom_histogram(bins = 30, fill = "steelblue", alpha = 0.7) +
  labs(title = "Distribution of PCA Scores",
       x = "PCA Score",
       y = "Frequency") +
  theme_minimal()

# View the distribution of PCA scores by location
ggplot(calc_data, aes(x = location, y = PCA_score)) +
  geom_boxplot(fill = "lightblue") +
  labs(title = "Distribution of PCA Scores by Location",
       x = "Location",
       y = "PCA Score") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

# View the trend of PCA scores over time
yearly_pca <- calc_data %>%
  group_by(year) %>%
  summarise(mean_pca = mean(PCA_score, na.rm = TRUE))

ggplot(yearly_pca, aes(x = year, y = mean_pca)) +
  geom_line(color = "steelblue", size = 1) +
  geom_point(color = "steelblue", size = 2) +
  labs(title = "Trend of PCA Scores Over Time",
       x = "Year",
       y = "Average PCA Score") +
  theme_minimal()


# Step 4: QCI Index Calculation

# Calculate the minimum and maximum PCA scores
min_pca_score <- min(calc_data$PCA_score, na.rm = TRUE)
max_pca_score <- max(calc_data$PCA_score, na.rm = TRUE)

# Calculate the QCI index
qci_data <- calc_data %>%
  mutate(
    QCI = (PCA_score - min_pca_score) / (max_pca_score - min_pca_score) * 100
  ) %>%
  # Ensure QCI is within the range of 0-100
  mutate(
    QCI = ifelse(QCI < 0, 0, ifelse(QCI > 100, 100, QCI))
  )

# View the calculated results
head(qci_data)

# Save the final results
write.csv(qci_data, "Age-standardized.csv", row.names = FALSE)