pass hpo to gpt_annot_plot

NAMESPACE

@@ -50,6 +50,7 @@ export(map_phenotypes)
 export(newlines_to_definition)
 export(per_branch_plot)
 export(phenos_to_granges)
+export(plot_arrow)
 export(plot_evidence)
 export(plot_top_phenos)
 export(search_hpo)

R/gpt_annot_plot.R

@@ -13,6 +13,7 @@
 #' @examples
 #' plots <- gpt_annot_plot()
 gpt_annot_plot <- function(annot = gpt_annot_read(),
+                           hpo = get_hpo(),
                            keep_ont_levels=seq(3,17),
                            keep_descendants="Phenotypic abnormality",
                            top_n=50,
@@ -30,14 +31,15 @@ gpt_annot_plot <- function(annot = gpt_annot_read(),
   dat1 <- gpt_annot_melt(res_coded = res_coded)
   #### Filter out ont levels  ####
   dat1 <- add_ancestor(dat1,
+                       hpo = hpo,
                        keep_descendants = keep_descendants)
   data.table::setorderv(dat1,"severity_score_gpt",-1)
   #### Get top N most severe phenotypes ####
   dat_top <- dat1[hpo_id %in% unique(dat1$hpo_id)[seq(top_n)]]
   #### Filter out onset phenotypes ####
-  dat_top <- add_ont_lvl(dat_top, keep_ont_levels = keep_ont_levels)
-
-
+  dat_top <- add_ont_lvl(dat_top,
+                         hpo = hpo,
+                         keep_ont_levels = keep_ont_levels)
   ##### Heatmap of top N most severe phenotypes ####
   gp0.1 <- ggplot2::ggplot(data = dat_top,
                            ggplot2::aes(x=variable, y=hpo_name, fill=value)) +
@@ -95,6 +97,7 @@ gpt_annot_plot <- function(annot = gpt_annot_read(),
     res_coded <- gpt_annot_codify(annot = annot)
     dat2 <- gpt_annot_melt(res_coded = res_coded)
     dat2 <- add_ancestor(dat2,
+                         hpo = hpo,
                          keep_descendants = keep_descendants)
     dat2[,mean_severity_score_gpt:=mean(severity_score_gpt, na.rm=TRUE),
                by="ancestor_name"] |>

R/plot_arrow.R

@@ -0,0 +1,45 @@
+#' Plot arrow
+#'
+#' Plot an error indicating the direction of phenotype specificity.
+#' @param labels Labels for each end of the arrow.
+#' @param labels_alpha Transparency of the labels.
+#' @param labels_size Size of the labels.
+#' @param arrrow_size Size of the arrow.
+#' @param arrow_color Colour of the arrow.
+#' @param x x-coordinate of the arrow.
+#' @param xend x-coordinate of the arrow end.
+#' @param y y-coordinate of the arrow.
+#' @param yend y-coordinate of the arrow end.
+#' @param labels_x x-coordinates of the labels.
+#' @param labels_y y-coordinates of the labels.
+#' @return ggplot2 object.
+#' @export
+#' @examples
+#' plot_arrow()
+plot_arrow <- function(x=1, xend = 1,
+                       y=0, yend = 1,
+                       labels_x=c(x,xend),
+                       labels_y=c(yend*.8, yend*.2),
+                       labels=c("Broad\nphenotypes",
+                                "Specific\nphenotypes"),
+                       labels_alpha=.8,
+                       labels_size=4,
+                       arrrow_size=2,
+                       arrow_color="grey50"){
+  requireNamespace("ggplot2")
+
+
+  ggplot2::ggplot() +
+    ggplot2::geom_segment(
+      ggplot2::aes(x=x, xend = xend , y=y, yend = yend),
+        size=arrrow_size,color=arrow_color,
+      arrow = ggplot2::arrow(ends="both", type="closed",
+                             length = ggplot2::unit(0.6,"cm"))) +
+    ggplot2::geom_label(ggplot2::aes(x=labels_x[1], y=labels_y[1],
+                                     label=labels[1]),
+                        size=labels_size, alpha=labels_alpha) +
+    ggplot2::geom_label(ggplot2::aes(x=labels_x[2], y=labels_y[2],
+                                     label=labels[2]),
+                        size=labels_size, alpha=labels_alpha) +
+    ggplot2::theme_void()
+}

R/plot_top_phenos.R

@@ -9,8 +9,11 @@
 #' @param annotation_order The order of the annotations to include.
 #' @param split_by_congenital Split the phenotypes by congenital onset
 #' (congenital = always/often, noncongenital = never/rarely).
+#' @param axis.text.x Whether to include x-axis text in top and bottom subplots.
 #' @inheritParams add_ont_lvl
 #' @inheritParams add_ancestor
+#' @inheritParams ggplot2::theme
+#' @inheritDotParams patchwork::plot_layout
 #' @export
 #' @examples
 #' res_class <- gpt_annot_class()
@@ -20,7 +23,10 @@ plot_top_phenos <- function(res_class = gpt_annot_class(),
                             keep_descendants = "Phenotypic abnormality",
                             n_per_class = 10,
                             annotation_order=NULL,
-                            split_by_congenital=TRUE){
+                            split_by_congenital=TRUE,
+                            axis.text.x=c(FALSE,TRUE),
+                            legend.position = 'right',
+                            ...){
   requireNamespace("ggplot2")
   requireNamespace("colorspace")
 
@@ -37,6 +43,8 @@ plot_top_phenos <- function(res_class = gpt_annot_class(),
                                 xlab="Clinical characteristic",
                                 ylab="HPO phenotype",
                                 direction = 1,
+                                axis.text.x=TRUE,
+                                legend.position=c('right','right'),
                                 limits=NULL){
     # devoptera::args2vars(plot_top_phenos_i, run_source_all = FALSE)
     variable <- hpo_name <- value <- NULL;
@@ -48,12 +56,14 @@ plot_top_phenos <- function(res_class = gpt_annot_class(),
                          show.legend=show.legend) +
       ggplot2::scale_y_discrete(limits=rev) +
       ggplot2::scale_fill_brewer(palette = "GnBu",
-                                 labels=c("0"="never","1"="rarely",
-                                          "2"="often","3"="always"),
+                                 labels=c(`0`="never",
+                                          `1`="rarely",
+                                          `2`="often",
+                                          `3`="always"),
                                  direction = direction) +
       ggplot2::theme_classic() +
       ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
-                     legend.position = 'right') +
+                     legend.position = legend.position[1]) +
       ggplot2::labs(x = xlab,
                     y = ylab,
                     subtitle=title,
@@ -74,10 +84,14 @@ plot_top_phenos <- function(res_class = gpt_annot_class(),
       ggplot2::guides(fill = ggplot2::guide_colorbar(reverse = TRUE)) +
       ggplot2::theme(axis.text.y = ggplot2::element_blank(),
                      axis.ticks.y = ggplot2::element_blank(),
-                     legend.position = 'right')
-    p3 <- patchwork::wrap_plots(p1, p2, ncol = 2,
+                     legend.position = legend.position[2])
+    p3 <- patchwork::wrap_plots(p1, p2,
+                                ncol = 2,
                                 widths = c(1,.2),
                                 guides = "collect")
+    if(isFALSE(axis.text.x)){
+      p3 <- p3 & ggplot2::theme(axis.text.x = ggplot2::element_blank())
+    }
     return(p3)
   }
 
@@ -90,17 +104,20 @@ plot_top_phenos <- function(res_class = gpt_annot_class(),
       plot_top_phenos_i(dt=get_top_phenos_out$congenital,
                         xlab = NULL,
                         show.legend = FALSE,
+                        axis.text.x=axis.text.x[1],
                         title="Congenital phenotypes",
                         limits=limits)
       |
         plot_top_phenos_i(get_top_phenos_out$noncongenital,
                         xlab = NULL,
                         ylab = NULL,
+                        axis.text.x=axis.text.x[2],
                         title="Non-congenital phenotypes",
                         limits=limits)
     ) + patchwork::plot_layout(guides = "collect",
                                axes = "collect",
-                               axis_titles = "collect") +
+                               axis_titles = "collect",
+                               ...) +
       patchwork::plot_annotation(tag_levels = "a")
 
   } else {
@@ -109,6 +126,9 @@ plot_top_phenos <- function(res_class = gpt_annot_class(),
     fig_top_phenos <- plot_top_phenos_i(get_top_phenos_out,
                                         limits=limits)
   }
+  fig_top_phenos <- fig_top_phenos &
+    ggplot2::theme(legend.position = legend.position)
+  #### Return ####
   return(
     list(
       data=get_top_phenos_out,