pass tests

DESCRIPTION

@@ -32,12 +32,9 @@ Imports:
     KGExplorer,
     simona,
     ggplot2, 
-    plotly, 
     utils,
     stats,
     methods,
-    network,
-    ggnetwork,
     tools,
     data.table,
     stringr,
@@ -51,14 +48,9 @@ Suggests:
     httr,
     jsonlite,
     testthat (>= 3.0.0),
-    pals,
-    Matrix,
-    MASS,
     scales,
-    htmlwidgets,
     piggyback,
     patchwork,
-    igraph,
     tidygraph
 Remotes:
   github::neurogenomics/KGExplorer

NAMESPACE

@@ -9,6 +9,7 @@ export(add_gene_frequency)
 export(add_genes)
 export(add_hpo_definition)
 export(add_hpo_id)
+export(add_hpo_name)
 export(add_info_content)
 export(add_mondo)
 export(add_ndisease)
@@ -25,7 +26,6 @@ export(filter_descendants)
 export(get_gene_lists)
 export(get_hpo)
 export(get_hpo_id_direct)
-export(ggnetwork_plot)
 export(gpt_annot_check)
 export(gpt_annot_codify)
 export(gpt_annot_plot)
@@ -38,6 +38,7 @@ export(list_onsets)
 export(load_phenotype_to_genes)
 export(make_igraph_object)
 export(make_network_object)
+export(make_network_plot)
 export(make_phenos_dataframe)
 export(make_tiers)
 export(map_phenotypes)
@@ -47,8 +48,6 @@ export(phenos_to_granges)
 export(search_hpo)
 import(KGExplorer)
 import(data.table)
-import(ggplot2)
-import(network)
 import(simona)
 importFrom(KGExplorer,map_mondo)
 importFrom(data.table,":=")
@@ -61,10 +60,6 @@ importFrom(data.table,fread)
 importFrom(data.table,merge.data.table)
 importFrom(data.table,setnafill)
 importFrom(data.table,setnames)
-importFrom(ggnetwork,geom_edges)
-importFrom(ggnetwork,ggnetwork)
-importFrom(plotly,ggplotly)
-importFrom(plotly,layout)
 importFrom(stats,as.formula)
 importFrom(stats,cor)
 importFrom(stats,na.omit)

NEWS.md

@@ -274,7 +274,7 @@
 
 * Added a `NEWS.md` file to track changes to the package.
 * Implemented `rworkflows`
-* `ggnetwork_plot`: make interactive with `plotly`
+* `make_network_plot`: make interactive with `plotly`
 * Add simplifying wrapper functions:
   - `make_hoverboxes`
   - `make_phenos_dataframe`

R/_docs.R → R/0docs.R

@@ -73,6 +73,7 @@ NULL
 #' @inheritParams main
 #' @inheritParams make_
 #' @inheritParams get_
+#' @inheritParams filter_
 #' @inheritParams data.table::merge.data.table
 #' @returns Annotated data.
 #' @name add_
@@ -85,6 +86,7 @@ NULL
 #' Functions to filter data.table objects.
 #' @family filter_
 #' @inheritParams main
+#' @inheritParams KGExplorer::filter_
 #' @returns Filtered data.
 #' @name filter_
 NULL

R/add_ancestor.R

@@ -2,52 +2,48 @@
 #' Add ancestor
 #'
 #' Assign each HPO ID to the higher-order ancestral term that it is part of.
-#' @param remove_descendants Remove HPO terms that are descendants of a given
-#' ancestral HPO term. Ancestral terms be provided as a character vector of
-#' phenotype names (e.g. \code{c("Clinical course")}),
-#'  HPO IDs (e.g. \code{"HP:0031797" }) or a mixture of the two.
-#'  See \link{add_ancestor} for details.
-#'
 #' @export
 #' @import KGExplorer
 #' @examples
 #' phenos <- example_phenos()
 #' phenos2 <- add_ancestor(phenos = phenos, lvl=5)
 add_ancestor <- function(phenos,
-                         lvl = 3,
+                         lvl = 2,
                          hpo = get_hpo(),
-                         remove_descendants = NULL){
-  ancestor <- NULL;
+                         keep_descendants = NULL,
+                         remove_descendants = NULL,
+                         force_new = FALSE){
   #### Check for existing columns ####
+  if(force_new){
+    messager("Force new. Removing existing ancestor columns.")
+    phenos[,c("ancestor","ancestor_name"):=NULL]
+  }
   if(all(c("ancestor","ancestor_name") %in% names(phenos))){
     messager("Ancestor columns already present. Skipping.")
-    return(phenos)
-  }
-  #### Add the new columns ####
-  if("hpo_id" %in% names(phenos)){
-    messager(paste0("Adding level-",lvl),"ancestor to each HPO ID.")
-    hpo <- KGExplorer::add_ancestors(ont = hpo,
-                                     lvl = lvl)
-    ancestors <- hpo@elementMetadata[,c("id","ancestor","ancestor_name")] |>
-      unique()
-    phenos <- data.table::merge.data.table(phenos,
-                                           ancestors,
-                                 by.x = "hpo_id",
-                                 by.y = "id",
-                                 all.x = TRUE)
+  }else {
+    #### Add the new columns ####
+    if("hpo_id" %in% names(phenos)){
+      messager(paste0("Adding level-",lvl),"ancestor to each HPO ID.")
+      hpo <- KGExplorer::add_ancestors(ont = hpo,
+                                       lvl = lvl,
+                                       force_new = force_new)
+      ancestors <- hpo@elementMetadata[,c("id","ancestor","ancestor_name")] |>
+        unique()
+      phenos <- data.table::merge.data.table(phenos,
+                                             ancestors,
+                                             by.x = "hpo_id",
+                                             by.y = "id",
+                                             all.x = TRUE)
 
-  } else {
-    messager("hpo_id column not found. Cannot add ancestors.")
+    } else {
+      messager("hpo_id column not found. Cannot add ancestors.")
+    }
   }
+
   #### Filter ####
-  if(!is.null(remove_descendants)){
-    messager("Removing remove descendants of:",
-             paste(shQuote(remove_descendants),collapse = "\n -"))
-    rmd <- map_phenotypes(terms = remove_descendants,
-                          hpo = hpo,
-                          to="id",
-                          keep_order = FALSE)
-    phenos <- phenos[!ancestor %in% rmd,]
-  }
+  phenos <- filter_descendants(hpo = hpo,
+                               keep_descendants = keep_descendants,
+                               remove_descendants = remove_descendants,
+                               phenos = phenos)
   return(phenos)
 }

R/add_hpo_name.R

@@ -0,0 +1,22 @@
+#' @describeIn add_ add_
+#' Add HPO name column to dataframe
+#'
+#' Adds the HPO term name column "hpo_name".
+#' @export
+#' @examples
+#' phenos <- example_phenos()
+#' phenos2 <- add_hpo_name(phenos=phenos)
+add_hpo_name <- function(phenos,
+                         hpo = get_hpo(),
+                         phenotype_to_genes = NULL) {
+
+  if(!"hpo_name" %in% names(phenos)){
+    messager("Adding HPO names.")
+    phenos <- add_hpo_id(phenos)
+    phenos$hpo_name <- map_phenotypes(hpo = hpo,
+                                      terms = phenos$hpo_id,
+                                      to = "name")
+  }
+  return(phenos)
+}
+

R/annotate_phenos.R

@@ -29,6 +29,11 @@ annotate_phenos <- function(phenos,
                             columns = list_columns(),
                             interactive = TRUE){
 
+  #### Add basic phenotype info ####
+  phenos <- add_hpo_id(phenos = phenos)
+  phenos <- add_hpo_name(phenos = phenos)
+  phenos <- add_hpo_definition(phenos = phenos)
+  phenos <- add_ancestor(phenos = phenos)
   #### Add ontology levels: absolute ####
   if(isTRUE(add_ont_lvl_absolute)){
     phenos <- add_ont_lvl(phenos = phenos,
@@ -46,8 +51,6 @@ annotate_phenos <- function(phenos,
     phenos <- add_info_content(phenos = phenos,
                                hpo = hpo)
   }
-  phenos <- add_hpo_definition(phenos = phenos)
-  phenos <- add_ancestor(phenos = phenos)
   if(isTRUE(add_ndiseases)){
     phenos <- add_ndisease(phenos = phenos)
   }

R/filter_descendants.R

@@ -3,37 +3,25 @@
 #'
 #' Subset a \code{phenos} data.table to only
 #' descendants of an ancestor HPO ID term.
-#' @param ancestor Phenotype names (or HPO ID) of an ancestor in the
-#'  \href{https://hpo.jax.org/}{Human Phenotype Ontology}.
-#'  Only phenotypes that are descendants of this ancestor will be kept.
-#'  Set to \code{NULL} (default) to skip this filtering step.
 #' @returns data.table of phenotypes, with additional columns:
 #' "ancestor", "ancestor_id"
 #'
 #' @export
 #' @examples
 #' phenos <- make_phenos_dataframe(ancestor = "Neurodevelopmental delay")
 #' phenos2 <- filter_descendants(phenos = phenos,
-#'                               ancestor = "Motor delay")
+#'                               keep_descendants = "Motor delay")
 filter_descendants <- function(phenos,
-                               ancestor = NULL,
+                               keep_descendants = NULL,
+                               remove_descendants = NULL,
                                hpo = get_hpo()){
-
   hpo_id <- NULL;
-
-  if(!is.null(ancestor)){
-    messager("Subsetting phenotypes to only ancestors of:",
-             paste(ancestor,collapse = ","))
-    ancestor_id <- map_phenotypes(terms = ancestor,
-                                  hpo = hpo,
-                                  to="id")
-    all_ids <- simona::dag_offspring(dag = hpo,
-                                     term=ancestor_id,
-                                     include_self = TRUE )
-    phenos <- phenos[hpo_id %in% all_ids,
-    ][,ancestor:=ancestor][,ancestor_id:=ancestor_id]
-    messager(formatC(nrow(phenos),big.mark = ","),
-             "associations remain after filtering.")
-  }
+  hpo2 <- KGExplorer::filter_ontology(
+    ont = hpo,
+    keep_descendants = keep_descendants,
+    remove_descendants = remove_descendants)
+  phenos <- phenos[hpo_id %in% hpo2@terms,]
+  messager(formatC(nrow(phenos),big.mark = ","),
+           "associations remain after filtering.")
   return(phenos)
 }

R/get_hpo.R

@@ -18,19 +18,23 @@
 #' @examples
 #' hpo <- get_hpo()
 get_hpo <- function(lvl,
-                    add_ancestors = TRUE,
+                    add_ancestors = 2,
                     force_new = FALSE,
+                    terms=NULL,
                     ...){
   save_dir <- KGExplorer::cache_dir(package = "HPOExplorer")
   file <- file.path(save_dir,"hpo.rds")
   if(!file.exists(file) || isTRUE(force_new)){
     ont <- KGExplorer::get_ontology(name = "hp",
                                     add_ancestors = add_ancestors,
                                     force_new = force_new,
+                                    terms = terms,
                                     ...)
     saveRDS(ont,file)
   } else {
     ont <- readRDS(file)
   }
+  ont <- KGExplorer::filter_ontology(ont = ont,
+                                     terms = terms)
   return(ont)
 }