|
| 1 | +#' Compute enrichment of IMPACT scores |
| 2 | +#' |
| 3 | +#' Conduct IMPACT enrichment between SNP groups and fine-mapping methods. |
| 4 | +#' Enrichment is computed as the ratio of IMPACT signal in a SNP group |
| 5 | +#' to the proportion of SNPs in that group. |
| 6 | +#' |
| 7 | +#' @param annot_melt A melted \code{data.table} of IMPACT annotations |
| 8 | +#' with columns including IMPACT_score, SNP, TF, Tissue, Cell, CellDeriv, |
| 9 | +#' and various fine-mapping result columns. |
| 10 | +#' @param locus Optional locus name to add to the output. |
| 11 | +#' |
| 12 | +#' @return A \code{data.table} of enrichment results per SNP group and |
| 13 | +#' annotation. |
| 14 | +#' |
| 15 | +#' @export |
| 16 | +#' @family IMPACT |
| 17 | +#' @importFrom dplyr group_by summarise arrange n_distinct |
| 18 | +#' @importFrom data.table rbindlist |
| 19 | +#' @examples |
| 20 | +#' \dontrun{ |
| 21 | +#' enrich <- IMPACT_compute_enrichment(annot_melt = annot_melt, |
| 22 | +#' locus = "BST1") |
| 23 | +#' } |
| 24 | +IMPACT_compute_enrichment <- function(annot_melt, |
| 25 | + locus = NULL) { |
| 26 | + |
| 27 | + TF <- Tissue <- Cell <- CellDeriv <- IMPACT_score <- SNP <- NULL; |
| 28 | + leadSNP <- Support <- ABF.CS <- FINEMAP.CS <- SUSIE.CS <- NULL; |
| 29 | + POLYFUN_SUSIE.CS <- Consensus_SNP <- enrichment <- SNP.group <- NULL; |
| 30 | + |
| 31 | + annot_melt[is.na(annot_melt$IMPACT_score), "IMPACT_score"] <- 0 |
| 32 | + |
| 33 | + SNP.groups <- list( |
| 34 | + "leadGWAS" = annot_melt |> |
| 35 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 36 | + dplyr::summarise( |
| 37 | + enrichment = (sum(IMPACT_score[leadSNP], na.rm = TRUE) / |
| 38 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 39 | + (dplyr::n_distinct(SNP[leadSNP], na.rm = TRUE) / |
| 40 | + dplyr::n_distinct(SNP, na.rm = TRUE))), |
| 41 | + "UCS" = annot_melt |> |
| 42 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 43 | + dplyr::summarise( |
| 44 | + enrichment = (sum(IMPACT_score[Support > 0], na.rm = TRUE) / |
| 45 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 46 | + (dplyr::n_distinct(SNP[Support > 0], na.rm = TRUE) / |
| 47 | + dplyr::n_distinct(SNP, na.rm = TRUE))), |
| 48 | + "ABF_CS" = annot_melt |> |
| 49 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 50 | + dplyr::summarise( |
| 51 | + enrichment = (sum(IMPACT_score[ABF.CS > 0], na.rm = TRUE) / |
| 52 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 53 | + (dplyr::n_distinct(SNP[ABF.CS > 0], na.rm = TRUE) / |
| 54 | + dplyr::n_distinct(SNP, na.rm = TRUE))), |
| 55 | + "FINEMAP_CS" = annot_melt |> |
| 56 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 57 | + dplyr::summarise( |
| 58 | + enrichment = (sum(IMPACT_score[FINEMAP.CS > 0], |
| 59 | + na.rm = TRUE) / |
| 60 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 61 | + (dplyr::n_distinct(SNP[FINEMAP.CS > 0], na.rm = TRUE) / |
| 62 | + dplyr::n_distinct(SNP, na.rm = TRUE))), |
| 63 | + "SUSIE_CS" = annot_melt |> |
| 64 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 65 | + dplyr::summarise( |
| 66 | + enrichment = (sum(IMPACT_score[SUSIE.CS > 0], |
| 67 | + na.rm = TRUE) / |
| 68 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 69 | + (dplyr::n_distinct(SNP[SUSIE.CS > 0], na.rm = TRUE) / |
| 70 | + dplyr::n_distinct(SNP, na.rm = TRUE))), |
| 71 | + "POLYFUN_CS" = annot_melt |> |
| 72 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 73 | + dplyr::summarise( |
| 74 | + enrichment = (sum(IMPACT_score[POLYFUN_SUSIE.CS > 0], |
| 75 | + na.rm = TRUE) / |
| 76 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 77 | + (dplyr::n_distinct(SNP[POLYFUN_SUSIE.CS > 0], |
| 78 | + na.rm = TRUE) / |
| 79 | + dplyr::n_distinct(SNP, na.rm = TRUE))), |
| 80 | + "Consensus" = annot_melt |> |
| 81 | + dplyr::group_by(TF, Tissue, Cell, CellDeriv) |> |
| 82 | + dplyr::summarise( |
| 83 | + enrichment = (sum(IMPACT_score[Consensus_SNP], |
| 84 | + na.rm = TRUE) / |
| 85 | + sum(IMPACT_score, na.rm = TRUE)) / |
| 86 | + (dplyr::n_distinct(SNP[Consensus_SNP], na.rm = TRUE) / |
| 87 | + dplyr::n_distinct(SNP, na.rm = TRUE))) |
| 88 | + ) |
| 89 | + enrich <- data.table::rbindlist(SNP.groups, idcol = "SNP.group") |> |
| 90 | + dplyr::arrange(-enrichment) |
| 91 | + enrich <- cbind(Locus = locus, enrich) |
| 92 | + enrich$TF <- factor(enrich$TF, ordered = TRUE) |
| 93 | + enrich$SNP.group <- factor(enrich$SNP.group, |
| 94 | + levels = names(SNP.groups), |
| 95 | + ordered = TRUE) |
| 96 | + return(enrich) |
| 97 | +} |
| 98 | + |
| 99 | + |
| 100 | +#' Iterate IMPACT enrichment tests |
| 101 | +#' |
| 102 | +#' Run \code{\link{IMPACT_compute_enrichment}} across all unique loci |
| 103 | +#' in the ANNOT_MELT dataset. |
| 104 | +#' |
| 105 | +#' @param ANNOT_MELT A melted \code{data.table} of IMPACT annotations |
| 106 | +#' that must include a \code{Locus} column. |
| 107 | +#' @param verbose Print messages. |
| 108 | +#' |
| 109 | +#' @return A \code{data.table} of enrichment results across all loci. |
| 110 | +#' |
| 111 | +#' @export |
| 112 | +#' @family IMPACT |
| 113 | +#' @importFrom data.table rbindlist |
| 114 | +#' @examples |
| 115 | +#' \dontrun{ |
| 116 | +#' ENRICH <- IMPACT_iterate_enrichment(ANNOT_MELT = ANNOT_MELT) |
| 117 | +#' } |
| 118 | +IMPACT_iterate_enrichment <- function(ANNOT_MELT, |
| 119 | + verbose = TRUE) { |
| 120 | + |
| 121 | + Locus <- NULL; |
| 122 | + |
| 123 | + ENRICH <- lapply(unique(ANNOT_MELT$Locus), function(locus) { |
| 124 | + messager("+ IMPACT:: Locus =", locus, v = verbose) |
| 125 | + annot_melt <- subset(ANNOT_MELT, Locus == locus) |
| 126 | + enrich <- IMPACT_compute_enrichment(annot_melt = annot_melt, |
| 127 | + locus = locus) |
| 128 | + return(enrich) |
| 129 | + }) |
| 130 | + ENRICH <- data.table::rbindlist(ENRICH) |
| 131 | + return(ENRICH) |
| 132 | +} |
0 commit comments