-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
13 changed files
with
441 additions
and
16 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,69 @@ | ||
| #' Get top phenotypes | ||
| #' | ||
| #' Get the most severe phenotypes per severity class: | ||
| #' Profound, Severe, Moderate, Mild. | ||
| #' The exception to this is the "Mild" class, where the \emph{least} | ||
| #' severe phenotypes will be taken instead of the most severe phenotypes. | ||
| #' @inheritParams add_ont_lvl | ||
| #' @inheritParams add_ancestor | ||
| #' @inheritParams plot_top_phenos | ||
| #' @importFrom utils head tail | ||
| #' @export | ||
| #' @examples | ||
| #' top_phenos <- get_top_phenos() | ||
| get_top_phenos <- function(res_class = gpt_annot_class(), | ||
| keep_ont_levels = seq(3,17), | ||
| keep_descendants = "Phenotypic abnormality", | ||
| n_per_class = 10, | ||
| annotation_order=NULL, | ||
| split_by_congenital=TRUE){ | ||
| congenital_onset <- is_congenital <- severity_class <- value <- NULL; | ||
|
|
||
| if(is.null(annotation_order)){ | ||
| weights_dict <- eval(formals(gpt_annot_codify)$weights_dict) | ||
| annotation_order <- gsub("_"," ",names(sort(unlist(weights_dict), | ||
| decreasing = TRUE))) | ||
| } | ||
| res_class[,is_congenital:=(congenital_onset %in% c(2,3))] | ||
| annot_melt <- data.table::melt.data.table(res_class, | ||
| id.vars = c("severity_class", | ||
| "is_congenital", | ||
| "hpo_id", | ||
| "hpo_name", | ||
| "severity_score_gpt")) | ||
| annot_melt <- annot_melt[!is.na(value),] | ||
| #### Filter out ont levels #### | ||
| annot_melt <- HPOExplorer::add_ancestor(annot_melt, | ||
| keep_descendants = keep_descendants) | ||
| data.table::setorderv(annot_melt,"severity_score_gpt",-1) | ||
| annot_melt <- HPOExplorer::add_ont_lvl(annot_melt, | ||
| keep_ont_levels = keep_ont_levels) | ||
| annot_melt$variable <- gsub("_", " ", annot_melt$variable) | ||
| annot_melt$variable <- factor(annot_melt$variable, levels = annotation_order) | ||
|
|
||
|
|
||
| if(split_by_congenital){ | ||
| dat_congenital <- lapply(unique(annot_melt$severity_class), function(s){ | ||
| sort_fun <- if(s=="mild") utils::tail else utils::head | ||
| annot_melt[severity_class== s & | ||
| is_congenital==TRUE, | ||
| sort_fun(.SD,n_per_class), by="variable"] | ||
| })|> data.table::rbindlist() | ||
| dat_noncongenital <- lapply(unique(annot_melt$severity_class), function(s){ | ||
| sort_fun <- if(s=="mild") tail else head | ||
| annot_melt[severity_class== s & | ||
| is_congenital==FALSE, | ||
| sort_fun(.SD,n_per_class), by="variable"] | ||
| })|> data.table::rbindlist() | ||
| return(list(congenital=dat_congenital, | ||
| noncongenital=dat_noncongenital) | ||
| ) | ||
| } else { | ||
| dat <- lapply(unique(annot_melt$severity_class), function(s){ | ||
| sort_fun <- if(s=="mild") tail else head | ||
| annot_melt[severity_class== s, | ||
| sort_fun(.SD,n_per_class), by="variable"] | ||
| })|> data.table::rbindlist() | ||
| return(dat) | ||
| } | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,104 @@ | ||
| #' GPT annotations: add severity class | ||
| #' | ||
| #' Convert severity annotations ot severity classes | ||
| #' (profound > severe > moderate > mild) to approximate those introduced in | ||
| #' \href{https://doi.org/10.1371/journal.pone.0114391}{Lazarin et al. 2014}. | ||
| #' | ||
| #' @param res_coded The output of list \link{gpt_annot_codify}. | ||
| #' @param tiers_dict A named list of severity tiers. | ||
| #' @param inclusion_values Numerically encoded annotation values | ||
| #' to count as hits. See the \code{gpt_annot_codify(code_dict=)} | ||
| #' argument defaults for the mappings. | ||
| #' Defaults to 2 ("often") and 3 ("always"). | ||
| #' @param add_severity_score_gpt Whether to add a continuous severity score | ||
| #' as well. | ||
| #' @returns A data.table with severity classes, as well as severity | ||
| #' scores (0-100) which can be used to rank severity within each class. | ||
| #' @export | ||
| #' @examples | ||
| #' res_coded <- gpt_annot_codify() | ||
| #' res_class <- gpt_annot_class(res_coded) | ||
| gpt_annot_class <- function(res_coded = gpt_annot_codify(), | ||
| inclusion_values=c(2,3), | ||
| tiers_dict = list( | ||
| ## Tier 1 | ||
| death=1, | ||
| intellectual_disability=1, | ||
| # congenital_onset=1, | ||
| ## Tier 2 | ||
| impaired_mobility=2, | ||
| physical_malformations=2, | ||
| ## Tier 3 | ||
| blindness=3, | ||
| sensory_impairments=3, | ||
| immunodeficiency=3, | ||
| cancer=3, | ||
| ## Tier 4 | ||
| reduced_fertility=4 | ||
| ), | ||
| add_severity_score_gpt=TRUE){ | ||
| severity_class <- NULL; | ||
| map_severity_class <- function(r, | ||
| tiers_dict, | ||
| inclusion_values, | ||
| return_score=FALSE){ | ||
| variable <- hpo_name <- value <- NULL; | ||
|
|
||
| tiers <- unique(unlist(tiers_dict)) | ||
| tier_scores <- lapply(stats::setNames(tiers,paste0("tier",tiers)), | ||
| function(x){ | ||
| tx <- tiers_dict[unname(unlist(tiers_dict)==x)] | ||
| counts <- r[,sapply(.SD, function(v){ | ||
| v %in% inclusion_values | ||
| }), | ||
| .SDcols = names(tx)] | ||
| list( | ||
| counts=counts, | ||
| proportion=sum(counts)/length(tx) | ||
| ) | ||
| }) | ||
| mean_proportion <- sapply(tier_scores, function(x)x$proportion)|>mean() | ||
| assigned_class <- if(sum(tier_scores$tier1$counts)>1){ | ||
| c("profound"=mean_proportion) | ||
| } else if (sum(tier_scores$tier1$counts)>0 || | ||
| sum(c(tier_scores$tier2$counts,tier_scores$tier3$counts))>3){ | ||
| c("severe"=mean_proportion) | ||
| } else if(sum(tier_scores$tier3$counts)>0){ | ||
| c("moderate"=mean_proportion) | ||
| } else{ | ||
| c("mild"=mean_proportion) | ||
| } | ||
| if(return_score){ | ||
| return(assigned_class) | ||
| } else{ | ||
| return(names(assigned_class)) | ||
| } | ||
| } | ||
| res_class <- data.table::copy(res_coded$annot_coded) | ||
| messager("Assigning severity classes.") | ||
| res_class[,severity_class:=map_severity_class(.SD, | ||
| inclusion_values = inclusion_values, | ||
| tiers_dict = tiers_dict), by=.I] | ||
| res_class[,severity_class:=factor(severity_class, | ||
| levels = c("profound","severe", | ||
| "moderate","mild"), | ||
| ordered = TRUE)] | ||
| # messager("Assigning severity class scores.") | ||
| # res_class[,severity_class_score:=map_severity_class(.SD, | ||
| # tiers_dict = tiers_dict, | ||
| # inclusion_values = inclusion_values, | ||
| # return_score = TRUE), by=.I] | ||
| if(isTRUE(add_severity_score_gpt) && | ||
| "annot_weighted" %in% names(res_coded) && | ||
| !"severity_score_gpt" %in% names(res_class)){ | ||
| res_class <- merge(res_class, | ||
| res_coded$annot_weighted[,c("hpo_name", | ||
| "severity_score_gpt")]) | ||
| data.table::setorderv(res_class, | ||
| c("severity_class","severity_score_gpt"),c(1,-1)) | ||
| } else{ | ||
| data.table::setorderv(res_class, | ||
| c("severity_class")) | ||
| } | ||
| return(res_class) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.