update before shiny app

neurogenomics · Jan 26, 2024 · b699e19 · b699e19
1 parent c822c26
commit b699e19
Show file tree

Hide file tree

Showing 27 changed files with 290 additions and 285 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -15,8 +15,8 @@ export(filter_graph)
 export(filter_kg)
 export(filter_ontology)
 export(get_alphamissense)
-export(get_bg)
 export(get_clinvar)
+export(get_data_package)
 export(get_definitions)
 export(get_gencc)
 export(get_gene_lengths)
@@ -50,7 +50,6 @@ export(map_upheno)
 export(map_upheno_data)
 export(map_variants)
 export(ontology_to)
-export(ontology_to_adjacency)
 export(plot_clinvar)
 export(plot_ggnetwork)
 export(plot_graph_3d)
@@ -70,12 +69,11 @@ import(simona)
 import(tidygraph)
 importFrom(Matrix,colSums)
 importFrom(methods,show)
-importFrom(orthogene,create_background)
 importFrom(orthogene,map_genes)
 importFrom(simona,LCA_depth)
 importFrom(stats,as.dist)
 importFrom(stats,cutree)
 importFrom(stats,hclust)
 importFrom(stringr,str_wrap)
-importFrom(tools,R_user_dir)
+importFrom(utils,data)
 importFrom(utils,download.file)
diff --git a/R/0docs.R b/R/0docs.R
@@ -1,3 +1,4 @@
+#### utils_ ####
 #' @title Utility functions
 #' 
 #' @description
@@ -8,6 +9,7 @@
 #' @name utils_
 NULL
 
+#### query_ ####
 #' @title Query functions
 #' 
 #' @description
@@ -21,7 +23,7 @@ NULL
 #' @name query_
 NULL
 
-
+#### plot_ ####
 #' @title Plot functions
 #' 
 #' @description
@@ -72,6 +74,7 @@ NULL
 #' @name plot_
 NULL
 
+#### get_ ####
 #' @title Get functions
 #' 
 #' @param force_new Create a new file instead of using any cached files.
@@ -100,7 +103,7 @@ NULL
 #' \link[orthogene]{map_genes}.
 #' @param from The designated from column in from-to mapping or relations.
 #' @inheritParams add_
-#' @inheritParams convert_
+#' @inheritParams to_
 #' @inheritParams map_
 #' @inheritParams simona::dag_ancestors
 #' @inheritParams data.table::merge.data.table
@@ -113,7 +116,7 @@ NULL
 #' @import data.table
 NULL
 
-
+#### map_ ####
 #' @title Map functions
 #' 
 #' @description
@@ -129,8 +132,7 @@ NULL
 #' @param add_definitions logical, if TRUE, add mondo definition column.  
 #' @param gr A \link[GenomicRanges]{GRanges} object.
 #' @param build Genome build to use when mapping genomic coordinates.
-#' 
-#' @inheritParams convert_
+#' @inheritParams to_
 #' @inheritParams filter_
 #' @inheritParams data.table::merge.data.table
 #' @inheritParams VariantAnnotation::locateVariants
@@ -142,6 +144,7 @@ NULL
 NULL
 
 
+#### filter_ ####
 #' @title Filter functions
 #' 
 #' @description
@@ -152,10 +155,11 @@ NULL
 #' @param use_simona Use \link[simona]{dag_filter} to filter terms.
 #' @param keep_chr Which chromosomes to keep.
 #' @param grlist Named list of \link[GenomicRanges]{GRanges} objects.
-#' @param filters A named list of filters to apply to the data. 
+#' @param node_filters A named list of filters to apply to the node data. 
 #' Names should be name of the metadata column, and values should be a vector of 
 #' valid options. For example, \code{list("type" = c("gene","variant"))} will
 #' return any rows where the "type" column contains either "gene" or "variant".
+#' @param edge_filters A named list of filters to apply to the edge data. 
 #' @param keep_descendants Terms whose descendants should be kept 
 #' (including themselves).
 #'  Set to \code{NULL} (default) to skip this filtering step.
@@ -170,7 +174,8 @@ NULL
 #' @name filter_
 NULL
 
-#' @title Converter functions
+#### to_ ####
+#' @title To functions
 #' 
 #' @description
 #' Functions to convert one object type to another. 
@@ -184,12 +189,12 @@ NULL
 #' @inheritParams filter_
 #' @import tidygraph
 #' @import simona
-#' @family convert_ 
+#' @family to_ 
 #' @returns Converted data. 
-#' @name convert_
+#' @name to_
 NULL
 
-
+#### add_ ####
 #' @title Add functions
 #' 
 #' @description
@@ -209,6 +214,7 @@ NULL
 #' @name add_
 NULL
 
+#### cache_ ####
 #' @title Cache functions
 #' 
 #' @description
@@ -222,14 +228,15 @@ NULL
 #' @name cache_
 NULL
 
-
+#### link_ ####
 #' @title Link functions
 #' 
 #' @description
 #' Functions to merge data resources.
 #' @inheritParams get_
 #' @inheritParams map_
-#' @inheritParams convert_
+#' @inheritParams to_
+#' @inheritParams filter_
 #' @family link_ 
 #' @returns Merged data.
 #' 

diff --git a/R/dt_to_kg.R b/R/dt_to_kg.R
@@ -11,12 +11,13 @@ dt_to_kg <- function(d,
     d_sub <- d
   }
   message("object_label examples:")
-  methods::show(utils::head(d_sub$object_label))
+  methods::show(unique(utils::head(d_sub$object_label,100))[seq(5)])
   message("subject_label examples:")
-  methods::show(utils::head(d_sub$subject_label))
+  methods::show(unique(utils::head(d_sub$subhect_label,100))[seq(5)])
   if(as_tidygraph){
     d_sub <- dt_to_graph(d_sub,
                          add_hover=add_hover)
   }
+  igraph::vertex_attr(g,"name") <- igraph::vertex_attr(g,"id")
   d_sub
 } 
diff --git a/R/dt_to_matrix.R b/R/dt_to_matrix.R
@@ -1,4 +1,4 @@
-#' @describeIn convert_ convert_
+#' @describeIn to_ to_
 #' @export
 #' @examples
 #' dt <- data.table::as.data.table(mtcars, keep.rownames = TRUE)

diff --git a/R/filter_graph.R b/R/filter_graph.R
@@ -1,17 +1,41 @@
 #' @describeIn filter_ filter_
-#' Filter a tbl_graph.
+#' Filter a \link[tidygraph]{tbl_graph}.
 #' @export
 filter_graph <- function(g,
-                         filters){
-  for(nm in names(filters)){
-    f <- filters[[nm]]
+                         node_filters=list(),
+                         edge_filters=list(),
+                         rm_isolated=TRUE,
+                         size=NULL){
+  ##### Filter nodes #####
+  for(nm in names(node_filters)){
+    f <- node_filters[[nm]]
     if(is.null(f)){
       next
     }
-    ## filter just that column in the nodes of the graph
     g <- g|> 
       tidygraph::activate("nodes") |>
       tidygraph::filter(get(eval(nm)) %in% f)
   }
+  ##### Filter edges #####
+  for(nm in names(edge_filters)){
+    f <- edge_filters[[nm]]
+    if(is.null(f)){
+      next
+    }
+    g <- g|> 
+      tidygraph::activate("edges") |>
+      tidygraph::filter(get(eval(nm)) %in% f)
+  }
+  #### Sample graph ####
+  if(!is.null(size)){
+    g <- tidygraph::sample_n(g,size = min(size,length(g)))
+  }
+  #### Remove isolated nodes ####
+  if(isTRUE(rm_isolated)){
+    messager("Removing isolated nodes.")
+    g <- g |> 
+      tidygraph::activate("nodes") |>
+      tidygraph::filter(!tidygraph::node_is_isolated())
+  }
   return(g)
 }
diff --git a/R/get_bg.R b/R/get_bg.R
diff --git a/R/get_data_package.R b/R/get_data_package.R
@@ -1,4 +1,7 @@
-#' @describeIn utils_ utils_
+#' @describeIn get_ get_
+#' @inheritParams utils::data
+#' @export
+#' @importFrom utils data
 get_data_package <- function(name,
                              package = "KGExplorer"){
   utils::data(list=name, package = package)

diff --git a/R/get_ontology.R b/R/get_ontology.R
@@ -25,7 +25,9 @@
 #' upheno <- get_ontology(name="upheno")
 get_ontology <- function(name=c("mondo",
                                 "hpo",
-                                "upheno"),
+                                "upheno",
+                                "uberon",
+                                "cl"),
                          terms=NULL,
                          filetype="-base.obo",
                          method=c("github",
@@ -54,31 +56,39 @@ get_ontology <- function(name=c("mondo",
                                  save_dir=save_dir,
                                  force_new=force_new,
                                  ...)
-    } else if (name=="cellontology"){
+    } else if (name %in% c("cl","cellontology","cell-ontology") ){
       ont <- get_ontology_github(file=paste0(name,filetype), 
                                  repo="obophenotype/cell-ontology",
                                  save_dir=save_dir,
                                  force_new=force_new,
                                  ...)
-    }else if(name=="upheno"){
+    } else if(name=="upheno"){
+      get_ontology_robot()
       ont <- get_ontology_url(
-        "https://github.com/obophenotype/upheno-dev/raw/master/upheno.obo", 
+        # "https://github.com/obophenotype/upheno/raw/master/upheno.owl",
+        "https://purl.obolibrary.org/obo/upheno/v2/upheno.owl",
+        import_func = simona::import_owl,
         force_new = force_new, 
         save_dir = save_dir, 
         ...) 
-    }
+    } else if (name %in% c("uberon") ){
+      ont <- get_ontology_github(file=paste0(name,filetype), 
+                                 repo="obophenotype/uberon",
+                                 save_dir=save_dir,
+                                 force_new=force_new,
+                                 ...)
+    }  
   } 
-
-  #### Subset ontology ####
-  ont <- filter_ontology(ont = ont, 
-                         terms = terms)
   #### Add metadata #### 
   if(isTRUE(add_metadata)) {
     ont <- add_ontology_metadata(ont,
                                  add_n_edges=add_n_edges,
                                  add_ancestors=add_ancestors, 
                                  add_ontology_levels=add_ontology_levels)
   }
+  #### Subset ontology ####
+  ont <- filter_ontology(ont = ont, 
+                         terms = terms) 
   #### Return ####
   return(ont)
 }
diff --git a/R/get_ontology_robot.R b/R/get_ontology_robot.R
@@ -0,0 +1,12 @@
+#' Get ontology robot
+#' 
+#' Download the ontology \href{https://github.com/ontodev/robot}{robot} tool
+#'  and set its path so that it's accessible by \pkg{simona}.
+#' @inheritDotParams get_data
+#' @keywords internal 
+get_ontology_robot <- function(...){
+  robot <- get_data(file = "robot.jar",
+                    repo = "ontodev/robot",
+                    ...)
+  simona_opt$robot_jar <- robot
+}
diff --git a/R/get_ontology_url.R b/R/get_ontology_url.R
@@ -1,5 +1,6 @@
 get_ontology_url <- function(URL,
                              save_dir=cache_dir(),
+                             import_func=simona::import_ontology,
                              force_new=FALSE,
                              ...){
   path <- file.path(save_dir,basename(URL))
@@ -8,7 +9,7 @@ get_ontology_url <- function(URL,
     ont <- readRDS(path)
     return(ont)
   }
-  ont <- simona::import_ontology(URL, ...)
+  ont <- import_func(URL, ...)
   saveRDS(ont, path)
   return(ont)
 }