@bgicli/bgicli 2.1.1 → 2.2.0

package/data/workflows/polygenic-risk-score-prs-catalog/scripts/load_pgs_weights.R

@@ -0,0 +1,228 @@
+###############################################################################
+# load_pgs_weights.R — Search PGS Catalog and download scoring weights
+#
+# Functions:
+#   search_pgs_catalog(trait)      — Search for available PGS scores by trait
+#   download_pgs_weights(pgs_id)   — Download a single harmonized scoring file
+#   get_demo_traits()              — Get cardiometabolic demo trait configuration
+#   load_demo_weights(data_dir)    — Download all 5 cardiometabolic demo weights
+###############################################################################
+
+library(data.table)
+
+if (!requireNamespace("jsonlite", quietly = TRUE)) {
+    install.packages("jsonlite")
+}
+
+`%||%` <- function(a, b) if (!is.null(a)) a else b
+
+# --- Search PGS Catalog ------------------------------------------------------
+
+#' Search PGS Catalog for available scores by trait name
+#' @param trait Character string (e.g. "coronary artery disease", "BMI", "LDL cholesterol")
+#' @return data.frame of matching scores with id, name, trait, variants, method, publication
+search_pgs_catalog <- function(trait) {
+    cat("Searching PGS Catalog for '", trait, "'...\n", sep = "")
+
+    trait_url <- paste0("https://www.pgscatalog.org/rest/trait/search?term=",
+                        utils::URLencode(trait))
+    trait_resp <- jsonlite::fromJSON(trait_url, flatten = TRUE)
+
+    if (length(trait_resp$results) == 0) {
+        cat("  No traits found matching '", trait, "'\n", sep = "")
+        return(data.frame())
+    }
+
+    all_pgs_ids <- unique(unlist(trait_resp$results$associated_pgs_ids))
+    if (length(all_pgs_ids) == 0) {
+        cat("  Traits found but no associated PGS scores\n")
+        return(data.frame())
+    }
+
+    cat("  Found", length(all_pgs_ids), "scores across",
+        nrow(trait_resp$results), "matching traits\n\n")
+
+    # Fetch details for top scores (limit to first 20 to avoid rate limiting)
+    fetch_ids <- head(all_pgs_ids, 20)
+    scores <- do.call(rbind, lapply(fetch_ids, function(pgs_id) {
+        score_url <- paste0("https://www.pgscatalog.org/rest/score/", pgs_id)
+        tryCatch({
+            s <- jsonlite::fromJSON(score_url, flatten = TRUE)
+            data.frame(
+                pgs_id = s$id,
+                name = s$name %||% NA_character_,
+                trait = s$trait_reported %||% NA_character_,
+                variants = s$variants_number %||% NA_integer_,
+                method = s$method_name %||% NA_character_,
+                genome_build = s$variants_genomebuild %||% NA_character_,
+                publication = paste0(s$publication$firstauthor %||% "Unknown",
+                                     " (", substr(s$publication$date_publication %||% "", 1, 4), ")"),
+                stringsAsFactors = FALSE
+            )
+        }, error = function(e) NULL)
+    }))
+
+    if (is.null(scores) || nrow(scores) == 0) {
+        cat("  Could not fetch score details\n")
+        return(data.frame())
+    }
+
+    cat("  Available PGS scores:\n")
+    cat("  ", paste(rep("-", 80), collapse = ""), "\n")
+    for (i in seq_len(min(nrow(scores), 15))) {
+        cat(sprintf("  %s | %s variants | %s | %s\n",
+                    scores$pgs_id[i],
+                    format(scores$variants[i], big.mark = ","),
+                    scores$method[i] %||% "N/A",
+                    scores$publication[i]))
+    }
+    if (nrow(scores) > 15) cat("  ... and", nrow(scores) - 15, "more\n")
+    cat("  ", paste(rep("-", 80), collapse = ""), "\n\n")
+
+    return(scores)
+}
+
+# --- Download single PGS scoring file ----------------------------------------
+
+#' Download a harmonized PGS Catalog scoring file
+#' @param pgs_id PGS Catalog ID (e.g. "PGS000018")
+#' @param genome_build "GRCh37" or "GRCh38" (default: "GRCh37" for 1000G Phase 3)
+#' @param data_dir Directory to store files (default: "data")
+#' @return list with weights (data.frame), pgs_id, score_meta
+download_pgs_weights <- function(pgs_id, genome_build = "GRCh37", data_dir = "data") {
+    cat("  Downloading", pgs_id, "...\n")
+
+    dir.create(data_dir, showWarnings = FALSE, recursive = TRUE)
+
+    # Fetch score metadata
+    score_url <- paste0("https://www.pgscatalog.org/rest/score/", pgs_id)
+    score_meta <- jsonlite::fromJSON(score_url, flatten = TRUE)
+
+    cat("    Score:", score_meta$name %||% pgs_id, "\n")
+    cat("    Trait:", score_meta$trait_reported %||% "Unknown", "\n")
+    cat("    Variants:", format(score_meta$variants_number %||% 0, big.mark = ","), "\n")
+
+    # Download harmonized scoring file
+    score_path <- file.path(data_dir, paste0(pgs_id, "_", genome_build, ".txt.gz"))
+
+    if (!file.exists(score_path)) {
+        hm_url <- paste0("https://ftp.ebi.ac.uk/pub/databases/spot/pgs/scores/",
+                         pgs_id, "/ScoringFiles/Harmonized/",
+                         pgs_id, "_hmPOS_", genome_build, ".txt.gz")
+
+        cat("    Downloading harmonized scoring file...\n")
+
+        old_timeout <- getOption("timeout")
+        options(timeout = 600)
+        on.exit(options(timeout = old_timeout), add = TRUE)
+
+        tryCatch({
+            download.file(hm_url, score_path, mode = "wb", quiet = TRUE)
+            if (!file.exists(score_path) || file.size(score_path) < 100) {
+                stop("Download produced empty file")
+            }
+        }, error = function(e) {
+            stop("Failed to download ", pgs_id, " (", genome_build, "): ", conditionMessage(e),
+                 "\n  Try: search_pgs_catalog() to find alternative score IDs")
+        })
+    } else {
+        cat("    Scoring file already cached\n")
+    }
+
+    # Parse scoring file (skip # header lines)
+    con <- gzfile(score_path)
+    header_lines <- readLines(con, n = 50)
+    close(con)
+    skip_n <- sum(grepl("^#", header_lines))
+
+    weights <- fread(score_path, skip = skip_n)
+
+    # Standardize column names
+    pgs_col_map <- c(
+        "chr_name" = "chr", "hm_chr" = "chr",
+        "chr_position" = "pos", "hm_pos" = "pos",
+        "effect_allele" = "effect_allele",
+        "other_allele" = "other_allele",
+        "effect_weight" = "weight",
+        "rsID" = "rsid", "hm_rsID" = "rsid",
+        "allelefrequency_effect" = "eaf"
+    )
+    current <- names(weights)
+    for (i in seq_along(current)) {
+        if (current[i] %in% names(pgs_col_map)) {
+            names(weights)[i] <- pgs_col_map[current[i]]
+        }
+    }
+
+    # Filter valid rows
+    weights <- weights[!is.na(chr) & !is.na(pos) & !is.na(weight)]
+    weights$chr <- as.integer(weights$chr)
+    weights$pos <- as.integer(weights$pos)
+    weights$weight <- as.numeric(weights$weight)
+
+    cat("    \u2713 Loaded", format(nrow(weights), big.mark = ","), "variant weights\n")
+
+    return(list(
+        weights = weights,
+        pgs_id = pgs_id,
+        score_meta = score_meta
+    ))
+}
+
+# --- Demo trait configuration -------------------------------------------------
+
+#' Get cardiometabolic demo trait configuration
+#' @return list of trait definitions with name, short_name, pgs_id
+get_demo_traits <- function() {
+    list(
+        list(name = "Coronary Artery Disease", short_name = "CAD", pgs_id = "PGS000018"),
+        list(name = "Type 2 Diabetes",         short_name = "T2D", pgs_id = "PGS000014"),
+        list(name = "LDL Cholesterol",         short_name = "LDL", pgs_id = "PGS000062"),
+        list(name = "Body Mass Index",         short_name = "BMI", pgs_id = "PGS000027"),
+        list(name = "Systolic Blood Pressure", short_name = "SBP", pgs_id = "PGS000299")
+    )
+}
+
+# --- Load all demo weights ----------------------------------------------------
+
+#' Download PGS Catalog weights for all 5 cardiometabolic demo traits
+#' @param data_dir Directory to store files (default: "data")
+#' @return Named list of weight data (keyed by short_name)
+load_demo_weights <- function(data_dir = "data") {
+    cat("=== Loading PGS Catalog Weights for Cardiometabolic Traits ===\n\n")
+
+    traits <- get_demo_traits()
+    trait_weights <- list()
+    failed <- character(0)
+
+    for (trait in traits) {
+        cat("[", trait$short_name, "]", trait$name, "(", trait$pgs_id, ")\n")
+        tryCatch({
+            result <- download_pgs_weights(trait$pgs_id, data_dir = data_dir)
+            trait_weights[[trait$short_name]] <- list(
+                weights = result$weights,
+                pgs_id = result$pgs_id,
+                score_meta = result$score_meta,
+                trait_name = trait$name,
+                short_name = trait$short_name
+            )
+        }, error = function(e) {
+            cat("    \u2716 FAILED:", conditionMessage(e), "\n")
+            cat("    Use search_pgs_catalog('", trait$name,
+                "') to find alternative PGS IDs\n", sep = "")
+            failed <<- c(failed, trait$short_name)
+        })
+        cat("\n")
+    }
+
+    n_loaded <- length(trait_weights)
+    n_failed <- length(failed)
+
+    cat("\u2713 PGS Catalog weights loaded: ", n_loaded, "/", n_loaded + n_failed, " traits\n", sep = "")
+    if (n_failed > 0) {
+        cat("\u2716 Failed traits: ", paste(failed, collapse = ", "), "\n")
+        cat("  Use search_pgs_catalog() to find alternative PGS IDs for failed traits\n")
+    }
+
+    return(trait_weights)
+}

package/data/workflows/polygenic-risk-score-prs-catalog/scripts/load_reference_data.R

@@ -0,0 +1,191 @@
+###############################################################################
+# load_reference_data.R — Download 1000 Genomes Phase 3 reference genotypes
+#
+# Functions:
+#   load_reference_data(data_dir) — Master: download genotypes + population labels
+#
+# Returns: list(obj_bigsnp, pop_labels, data_dir)
+# Target: ALL 2,490 individuals across 5 super-populations (AFR, AMR, EAS, EUR, SAS)
+###############################################################################
+
+`%||%` <- function(a, b) if (!is.null(a)) a else b
+
+# --- Package management ------------------------------------------------------
+
+.ensure_packages <- function() {
+    if (length(getOption("repos")) == 0 || getOption("repos")["CRAN"] == "@CRAN@") {
+        options(repos = c(CRAN = "https://cloud.r-project.org"))
+    }
+
+    if (!requireNamespace("bigsnpr", quietly = TRUE)) {
+        cat("Installing bigsnpr (this may take a few minutes)...\n")
+        if (!requireNamespace("remotes", quietly = TRUE)) install.packages("remotes")
+        remotes::install_github("privefl/bigsnpr")
+    }
+
+    required_cran <- c("data.table", "R.utils", "dplyr", "jsonlite")
+    for (pkg in required_cran) {
+        if (!requireNamespace(pkg, quietly = TRUE)) {
+            cat("Installing", pkg, "...\n")
+            install.packages(pkg)
+        }
+    }
+
+    library(bigsnpr)
+    library(bigstatsr)
+    library(data.table)
+    library(dplyr)
+    cat("\u2713 All required packages loaded\n")
+}
+
+# --- Reference genotype download ----------------------------------------------
+
+.download_reference_genotypes <- function(data_dir = "data") {
+    bed_prefix <- file.path(data_dir, "1000G_phase3")
+    rds_path <- paste0(bed_prefix, ".rds")
+
+    if (file.exists(rds_path)) {
+        cat("  1000 Genomes Phase 3 genotypes already downloaded\n")
+        return(bed_prefix)
+    }
+
+    bed_path <- paste0(bed_prefix, ".bed")
+    if (file.exists(bed_path)) {
+        cat("  PLINK files found, converting to bigsnpr format...\n")
+        snp_readBed(bed_path)
+        cat("  \u2713 1000 Genomes genotypes ready\n")
+        return(bed_prefix)
+    }
+
+    # Check for any existing 1000G download with different naming
+    existing <- list.files(data_dir, pattern = "1000G.*\\.bed$", full.names = TRUE)
+    if (length(existing) > 0) {
+        base <- tools::file_path_sans_ext(existing[1])
+        cat("  Found existing 1000G download, linking...\n")
+        for (ext in c(".bed", ".bim", ".fam")) {
+            src <- paste0(base, ext)
+            dst <- paste0(bed_prefix, ext)
+            if (file.exists(src) && !file.exists(dst)) file.copy(src, dst)
+        }
+        if (file.exists(paste0(bed_prefix, ".bed"))) {
+            snp_readBed(paste0(bed_prefix, ".bed"))
+            cat("  \u2713 1000 Genomes genotypes ready\n")
+            return(bed_prefix)
+        }
+    }
+
+    cat("  Downloading 1000 Genomes Phase 3 genotypes...\n")
+    cat("  2,490 individuals from 26 populations (5 super-populations)\n")
+    cat("  This may take 5-10 minutes...\n")
+
+    old_timeout <- getOption("timeout")
+    options(timeout = 900)
+    on.exit(options(timeout = old_timeout), add = TRUE)
+
+    tryCatch({
+        bigsnpr::download_1000G(data_dir)
+
+        # Rename to consistent name
+        plink_files <- list.files(data_dir, pattern = "\\.bed$", full.names = TRUE)
+        if (length(plink_files) > 0) {
+            base <- tools::file_path_sans_ext(plink_files[1])
+            for (ext in c(".bed", ".bim", ".fam")) {
+                src <- paste0(base, ext)
+                dst <- paste0(bed_prefix, ext)
+                if (file.exists(src) && !file.exists(dst)) file.rename(src, dst)
+            }
+        }
+
+        snp_readBed(paste0(bed_prefix, ".bed"))
+        cat("  \u2713 1000 Genomes genotypes ready\n")
+    }, error = function(e) {
+        cat("  Note: bigsnpr::download_1000G() failed.\n")
+        cat("  You can manually provide PLINK files (.bed/.bim/.fam) in data/\n")
+        cat("  Error:", conditionMessage(e), "\n")
+        stop("Reference genotype download failed. See above for details.")
+    })
+
+    return(bed_prefix)
+}
+
+# --- Population labels --------------------------------------------------------
+
+.get_population_labels <- function(fam_path) {
+    pop_url <- "https://ftp.1000genomes.ebi.ac.uk/vol1/ftp/release/20130502/integrated_call_samples_v3.20130502.ALL.panel"
+
+    old_timeout <- getOption("timeout")
+    options(timeout = 120)
+    on.exit(options(timeout = old_timeout), add = TRUE)
+
+    tryCatch({
+        panel <- fread(pop_url, fill = TRUE, header = FALSE)
+        if (ncol(panel) >= 4) {
+            panel <- panel[, 1:4]
+            setnames(panel, c("sample", "pop", "super_pop", "gender"))
+            panel <- panel[sample != "sample"]
+        } else {
+            stop("Unexpected panel format")
+        }
+
+        fam <- fread(fam_path, header = FALSE)
+        setnames(fam, c("FID", "IID", "PAT", "MAT", "SEX", "PHENO"))
+
+        pop_labels <- merge(
+            fam[, .(IID)],
+            panel[, .(IID = sample, population = pop, super_population = super_pop)],
+            by = "IID", all.x = TRUE
+        )
+
+        n_labeled <- sum(!is.na(pop_labels$population))
+        n_pops <- length(unique(pop_labels$population[!is.na(pop_labels$population)]))
+        n_super <- length(unique(pop_labels$super_population[!is.na(pop_labels$super_population)]))
+        cat("  Population labels:", n_labeled, "individuals from",
+            n_pops, "populations (", n_super, "super-populations)\n")
+        return(pop_labels)
+    }, error = function(e) {
+        cat("  Note: Could not download population labels (non-critical)\n")
+        cat("  Error:", conditionMessage(e), "\n")
+        return(NULL)
+    })
+}
+
+# --- Master function ----------------------------------------------------------
+
+#' Load 1000 Genomes Phase 3 reference data for PRS scoring
+#' @param data_dir Directory to store downloaded files (default: "data")
+#' @return list with obj_bigsnp, pop_labels, data_dir
+load_reference_data <- function(data_dir = "data") {
+    cat("=== Loading 1000 Genomes Phase 3 Reference Data ===\n\n")
+
+    .ensure_packages()
+    dir.create(data_dir, showWarnings = FALSE, recursive = TRUE)
+
+    # Step 1: Reference genotypes
+    cat("[1/2] Reference Genotypes\n")
+    geno_prefix <- .download_reference_genotypes(data_dir)
+
+    # Step 2: Population labels
+    cat("\n[2/2] Population Labels\n")
+    fam_path <- paste0(geno_prefix, ".fam")
+    pop_labels <- .get_population_labels(fam_path)
+
+    # Load genotype data
+    rds_path <- paste0(geno_prefix, ".rds")
+    obj_bigsnp <- snp_attach(rds_path)
+    n_samples <- nrow(obj_bigsnp$fam)
+    n_variants <- ncol(obj_bigsnp$genotypes)
+
+    result <- list(
+        obj_bigsnp = obj_bigsnp,
+        pop_labels = pop_labels,
+        geno_prefix = geno_prefix,
+        data_dir = data_dir
+    )
+
+    cat("\n\u2713 Reference data loaded successfully (",
+        format(n_variants, big.mark = ","), " variants, ",
+        n_samples, " individuals)\n", sep = "")
+    cat("  Target: 1000 Genomes Phase 3 (", n_samples, " individuals, 5 super-populations)\n", sep = "")
+
+    return(result)
+}

package/data/workflows/polygenic-risk-score-prs-catalog/scripts/score_traits.R

@@ -0,0 +1,216 @@
+###############################################################################
+# score_traits.R — Score individuals using PGS Catalog weights
+#
+# Expects in environment:
+#   ref_data      — from load_reference_data()
+#   trait_weights  — from load_demo_weights() or manual download_pgs_weights()
+#
+# Creates in environment:
+#   all_results   — list with per-trait scores, combined scores, match reports
+###############################################################################
+
+cat("=== Multi-Trait PRS Scoring ===\n\n")
+
+# --- Validate inputs ----------------------------------------------------------
+
+if (!exists("ref_data") || !is.list(ref_data)) {
+    stop("'ref_data' not found. Run load_reference_data() first:\n",
+         "  source('scripts/load_reference_data.R')\n",
+         "  ref_data <- load_reference_data()")
+}
+
+if (!exists("trait_weights") || !is.list(trait_weights) || length(trait_weights) == 0) {
+    stop("'trait_weights' not found. Run load_demo_weights() first:\n",
+         "  source('scripts/load_pgs_weights.R')\n",
+         "  trait_weights <- load_demo_weights()")
+}
+
+library(bigsnpr)
+library(bigstatsr)
+library(data.table)
+library(dplyr)
+
+obj_bigsnp <- ref_data$obj_bigsnp
+pop_labels <- ref_data$pop_labels
+G <- obj_bigsnp$genotypes
+fam <- obj_bigsnp$fam
+map <- obj_bigsnp$map
+n_samples <- nrow(fam)
+
+cat("  Reference panel:", n_samples, "individuals\n")
+cat("  Traits to score:", length(trait_weights), "\n")
+cat("  Traits:", paste(names(trait_weights), collapse = ", "), "\n\n")
+
+# --- Helper: match and score a single trait -----------------------------------
+
+.match_and_score <- function(weights_data, obj_bigsnp, pop_labels) {
+    weights <- weights_data$weights
+    map <- obj_bigsnp$map
+    G <- obj_bigsnp$genotypes
+    fam <- obj_bigsnp$fam
+
+    # Prepare reference map
+    map_df <- data.frame(
+        chr = as.integer(map$chromosome),
+        pos = as.integer(map$physical.pos),
+        a0 = map$allele2,
+        a1 = map$allele1,
+        map_idx = seq_len(nrow(map)),
+        stringsAsFactors = FALSE
+    )
+
+    # Prepare weights
+    weights_match <- data.frame(
+        chr = weights$chr,
+        pos = weights$pos,
+        a1 = toupper(weights$effect_allele),
+        a0 = if ("other_allele" %in% names(weights)) toupper(weights$other_allele) else NA_character_,
+        weight = weights$weight,
+        stringsAsFactors = FALSE
+    )
+    if ("rsid" %in% names(weights)) weights_match$rsid <- weights$rsid
+
+    # Match by chr:pos
+    merged <- merge(weights_match, map_df, by = c("chr", "pos"),
+                    suffixes = c("_wt", "_ref"), allow.cartesian = FALSE)
+
+    if (nrow(merged) > 0) {
+        direct <- toupper(merged$a1_wt) == toupper(merged$a1_ref)
+        flipped <- toupper(merged$a1_wt) == toupper(merged$a0_ref)
+        merged$weight_aligned <- merged$weight
+        merged$weight_aligned[flipped] <- -merged$weight[flipped]
+        matched <- merged[direct | flipped, ]
+        matched <- matched[!duplicated(matched$map_idx), ]
+    } else {
+        matched <- merged
+    }
+
+    n_input <- nrow(weights)
+    n_matched <- nrow(matched)
+    match_rate <- round(100 * n_matched / n_input, 1)
+
+    # Score
+    prs_raw <- big_prodVec(G, matched$weight_aligned, ind.col = matched$map_idx)
+    prs_z <- (prs_raw - mean(prs_raw)) / sd(prs_raw)
+
+    scores <- data.frame(
+        FID = fam$family.ID,
+        IID = fam$sample.ID,
+        prs_raw = prs_raw,
+        prs_zscore = prs_z,
+        prs_percentile = rank(prs_z) / length(prs_z) * 100,
+        stringsAsFactors = FALSE
+    )
+
+    if (!is.null(pop_labels)) {
+        scores <- merge(scores, pop_labels, by = "IID", all.x = TRUE)
+    }
+
+    match_report <- data.frame(
+        step = c("Input weights", "Matched to genotypes", "Unmatched"),
+        n = c(n_input, n_matched, n_input - n_matched),
+        pct = c(100, match_rate, round(100 - match_rate, 1))
+    )
+
+    snp_weights_out <- data.frame(
+        chr = matched$chr,
+        pos = matched$pos,
+        a1 = matched$a1_wt,
+        a0 = matched$a0_ref,
+        weight_original = matched$weight,
+        weight_aligned = matched$weight_aligned
+    )
+    if ("rsid" %in% names(matched)) snp_weights_out$rsid <- matched$rsid
+
+    list(scores = scores, match_report = match_report, snp_weights = snp_weights_out)
+}
+
+# --- Score all traits ---------------------------------------------------------
+
+per_trait <- list()
+match_reports <- list()
+snp_weights_all <- list()
+
+for (trait_name in names(trait_weights)) {
+    tw <- trait_weights[[trait_name]]
+    cat("[", trait_name, "] Scoring", tw$trait_name, "(", tw$pgs_id, ")\n")
+
+    result <- .match_and_score(tw, obj_bigsnp, pop_labels)
+
+    mr <- result$match_report
+    cat("  Matched:", format(mr$n[2], big.mark = ","), "/",
+        format(mr$n[1], big.mark = ","), "weights (", mr$pct[2], "%)\n")
+    cat("  PRS range: z =", round(min(result$scores$prs_zscore), 2),
+        "to", round(max(result$scores$prs_zscore), 2), "\n")
+
+    per_trait[[trait_name]] <- result$scores
+    match_reports[[trait_name]] <- result$match_report
+    snp_weights_all[[trait_name]] <- result$snp_weights
+
+    # Population summary
+    if ("super_population" %in% names(result$scores)) {
+        pop_sum <- result$scores %>%
+            group_by(super_population) %>%
+            summarise(n = n(), mean_z = round(mean(prs_zscore), 3), .groups = "drop") %>%
+            arrange(desc(mean_z))
+        cat("  Population means (super-pop):\n")
+        for (r in seq_len(nrow(pop_sum))) {
+            cat("    ", pop_sum$super_population[r], ": z =",
+                sprintf("%+.3f", pop_sum$mean_z[r]),
+                "(n =", pop_sum$n[r], ")\n")
+        }
+    }
+    cat("\n")
+}
+
+# --- Build combined scores matrix ---------------------------------------------
+
+cat("=== Building Combined Scores ===\n\n")
+
+# Create wide-format combined scores
+base_df <- per_trait[[1]][, c("IID", "FID")]
+if ("population" %in% names(per_trait[[1]])) base_df$population <- per_trait[[1]]$population
+if ("super_population" %in% names(per_trait[[1]])) base_df$super_population <- per_trait[[1]]$super_population
+
+for (trait_name in names(per_trait)) {
+    col_name <- paste0("prs_", trait_name)
+    base_df[[col_name]] <- per_trait[[trait_name]]$prs_zscore[
+        match(base_df$IID, per_trait[[trait_name]]$IID)]
+}
+
+# Composite risk: mean z-score across all traits
+prs_cols <- grep("^prs_", names(base_df), value = TRUE)
+base_df$composite_risk <- rowMeans(base_df[, prs_cols, drop = FALSE], na.rm = TRUE)
+base_df$composite_percentile <- rank(base_df$composite_risk) / nrow(base_df) * 100
+
+combined_scores <- base_df
+
+# Correlation matrix
+prs_matrix <- as.matrix(combined_scores[, prs_cols])
+colnames(prs_matrix) <- sub("^prs_", "", colnames(prs_matrix))
+cor_matrix <- cor(prs_matrix, use = "pairwise.complete.obs")
+
+cat("  Combined scores for", nrow(combined_scores), "individuals across",
+    length(prs_cols), "traits\n")
+cat("  Composite risk range: z =", round(min(combined_scores$composite_risk), 2),
+    "to", round(max(combined_scores$composite_risk), 2), "\n\n")
+
+cat("  PRS Correlation Matrix:\n")
+print(round(cor_matrix, 3))
+
+# --- Build all_results --------------------------------------------------------
+
+all_results <- list(
+    per_trait = per_trait,
+    combined_scores = combined_scores,
+    cor_matrix = cor_matrix,
+    match_reports = match_reports,
+    snp_weights = snp_weights_all,
+    trait_weights = trait_weights,
+    n_traits = length(per_trait),
+    n_individuals = nrow(combined_scores),
+    trait_names = names(per_trait)
+)
+
+cat("\n\u2713 Multi-trait PRS scoring completed successfully! (",
+    length(per_trait), " traits, ", nrow(combined_scores), " individuals)\n", sep = "")