update map_ontology_terms

.Rbuildignore

@@ -1,7 +1,7 @@
 Icon?
 .*\.Rproj$
 ^\.Rproj\.user$
-^README.Rmd
+^README\.Rmd$
 ^\.github$
 ^doc$
 ^Meta$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: KGExplorer
 Type: Package
 Title: Biomedical Knowledge Network Construction and Analysis
-Version: 0.99.02
+Version: 0.99.03
 Authors@R:
     c(
     person(given = "Brian",

NEWS.md

@@ -1,3 +1,11 @@
+# KGExplorer 0.99.03
+
+## New features
+
+* `map_ontology_terms`: 
+  - Can now recognize `alternative_terms` slot in simona object (https://github.com/jokergoo/simona/issues/6)
+  - Automatically uses "short_id" when "id" is set, as the "id" column can sometimes contain long ID formats (http://purl.obolibrary.org/obo/MONDO_0100229 vs. MONDO:0100229)
+
 # KGExplorer 0.99.01
 
 ## Bug fixes

R/add_ontology_metadata.R

@@ -9,7 +9,8 @@
 #' ont <- get_ontology("hp", terms=10)
 #' ont2 <- add_ontology_metadata(ont)
 add_ontology_metadata <- function(ont,
-                                  add_ancestors=2,
+                                  lvl=2,
+                                  force_new = FALSE,
                                   add_n_edges=TRUE,
                                   add_ontology_levels=TRUE){
   messager("Adding term metadata.")
@@ -21,7 +22,8 @@ add_ontology_metadata <- function(ont,
   simona::mcols(ont)$n_offspring <- simona::n_offspring(ont)
   simona::mcols(ont)$n_connected_leaves <- simona::n_connected_leaves(ont) 
   ont <- add_ancestors(ont = ont, 
-                       lvl = add_ancestors)
+                       force_new = force_new,
+                       lvl = lvl)
   if(isTRUE(add_n_edges)){
     adj <- ontology_to(ont = ont,
                        to="adjacency")

R/get_ontology.R

@@ -19,6 +19,8 @@
 #' via the \link{get_ontology_github}/link{get_ontology_url} functions. 
 #' @param add_metadata Add metadata to the resulting ontology object.
 #' @param filetype File type to search for.
+#' @param import_func Function to import the ontology with. 
+#' If \code{NULL}, automatically tries to choose the correct function.
 #' @inheritDotParams get_ontology_github
 #' @returns \link[simona]{ontology_DAG}
 #' 
@@ -39,9 +41,10 @@ get_ontology <- function(name=c("mondo",
                          method=c("github",
                                   "rols")[1], 
                          filetype=".obo",
+                         import_func=NULL,
                          terms=NULL,
                          add_metadata=TRUE,
-                         add_ancestors=2,
+                         lvl=2,
                          add_n_edges=TRUE,
                          add_ontology_levels=TRUE,
                          save_dir=cache_dir(),
@@ -84,6 +87,7 @@ get_ontology <- function(name=c("mondo",
     ol_ont <- ol[[name]]
     ont <- get_ontology_url(
       URL = ol_ont@config$fileLocation,
+      import_func=import_func,
       force_new = force_new, 
       save_dir = save_dir, 
       ...) 
@@ -132,7 +136,7 @@ get_ontology <- function(name=c("mondo",
   if(isTRUE(add_metadata)) {
     ont <- add_ontology_metadata(ont,
                                  add_n_edges=add_n_edges,
-                                 add_ancestors=add_ancestors, 
+                                 lvl=lvl, 
                                  add_ontology_levels=add_ontology_levels)
   }
   #### Cache RDS object ####

R/get_ontology_dict.R

@@ -1,17 +1,22 @@
 #' @describeIn get_ get_
 #' 
 #' @param as_datatable Return as a data.table instead of a named vector.
+#' @param include_alternative_terms Include alternative terms in the dictionary.
 #' @export
 #' @examples
 #' ont <- get_ontology("hp", terms=10)
 #' dict <- get_ontology_dict(ont)
 get_ontology_dict <- function(ont, 
-                              from="id",
+                              from="short_id",
                               to=c("name","label","term"),
                               include_self=FALSE,
+                              include_alternative_terms=TRUE,
                               as_datatable=FALSE){
-
   to <- intersect(to,colnames(ont@elementMetadata))[1]
+
+  if(from=="id") from <- "short_id"
+  if(to=="id") to <- "short_id"
+
   ## Check from col exists
   if(!from %in% colnames(ont@elementMetadata)){
     stopper("Column",from,"not found in ontology metadata.")
@@ -26,6 +31,14 @@ get_ontology_dict <- function(ont,
     dict <- data.table::as.data.table(
       ont@elementMetadata
       )[,from:=get(from)][,to:=get(to)][,c("from","to")]
+    if(isTRUE(include_alternative_terms) &&
+       "alternative_terms" %in% methods::slotNames(ont)){
+      data.table::setkeyv(dict, c("from")) 
+      tmp <- data.table::data.table(
+        from=gsub("_",":",basename(names(ont@alternative_terms))),
+        to=dict[unname(ont@alternative_terms)]$to)
+      dict <- rbind(dict,tmp)
+    }
     if(isTRUE(include_self)){
       dict <- rbind(dict,
                     data.table::as.data.table(

R/get_ontology_url.R

@@ -3,6 +3,14 @@ get_ontology_url <- function(URL,
                              import_func=simona::import_ontology,
                              force_new=FALSE,
                              ...){
+  ## import_owl works better for OWL files
+  if(is.null(import_func)){
+    if(grepl("\\.owl$",URL, ignore.case = TRUE)){
+      import_func <- simona::import_owl
+    } else {
+      import_func <- simona::import_ontology
+    } 
+  } 
   save_path <- file.path(save_dir,basename(URL))
   if(file.exists(save_path) && !isTRUE(force_new)){
     messager("Importing cached file:",save_path)

R/map_ontology_terms.R

@@ -27,7 +27,7 @@
 #' term_ids <- map_ontology_terms(ont=ont, terms=terms, to="id")
 map_ontology_terms <- function(ont,
                                terms = NULL,
-                               to=c("name","id"),
+                               to=c("name","id","short_id"),
                                keep_order = TRUE,
                                invert = FALSE,
                                ignore_case=TRUE,
@@ -37,10 +37,13 @@ map_ontology_terms <- function(ont,
   to <- match.arg(to)
   if(!is.null(terms)) terms <- as.character(terms)
   terms_og <- terms
+
+  if(to=="id") to <- "short_id"
+
   # terms <- unique(terms)
   # new_to_old <- stats::setNames(unique(terms_og),terms)
   #### to IDs ###
-  if(to=="id"){
+  if(to %in% c("id","short_id")){
     messager("Translating ontology terms to ids.",v=verbose)
     map <- get_ontology_dict(ont,
                              from="name",
@@ -51,7 +54,7 @@ map_ontology_terms <- function(ont,
     #### to names ###
     messager("Translating ontology terms to names.",v=verbose)
     map <- get_ontology_dict(ont,
-                             from="id",
+                             from="short_id",
                              to=to,
                              as_datatable=TRUE,
                              include_self=TRUE)

R/plot_graph_visnetwork.R

@@ -7,6 +7,8 @@
 #' @param degree The number of degrees away from the selected nodes
 #'  to highlight.
 #' @param highlight_color Colour to highlight selected nodes.
+#' @param node_opacity Node opacity.
+#' @param edge_opacity Edge opacity.
 #' @inheritParams map_colors
 #' @inheritParams visNetwork::visIgraph
 #' @inheritParams visNetwork::visIgraphLayout
@@ -26,6 +28,8 @@ plot_graph_visnetwork <- function(g,
                                   colour_var = size_var,
                                   invert_colour_var = TRUE,
                                   columns = get_graph_colnames(g),
+                                  node_opacity = .75,
+                                  edge_opacity = .5,
                                   preferred_palettes = NULL,
                                   selectedBy = label_var,
                                   show_plot = TRUE,
@@ -107,7 +111,7 @@ plot_graph_visnetwork <- function(g,
     ),
     shadow = list(enabled=TRUE,
                   size = 10),
-    opacity = 0.75,
+    opacity = node_opacity,
     borderWidth=3,
     borderWidthSelected=6,
     color = list(hover = list(background="rgba(0,0,0,.5)"),
@@ -119,7 +123,7 @@ plot_graph_visnetwork <- function(g,
     visNetwork::visEdges(shadow = list(enabled=FALSE),
                          smooth = smooth,
                          arrows = arrows,
-                         color = list(opacity = 0.5)) |>
+                         color = list(opacity = edge_opacity)) |>
     # visNetwork::visLegend() |>
     # visNetwork::visClusteringByConnection(nodes = unique(top_targets[[group_var]])) |>
     # visNetwork::visGroups(groupname = unique(igraph::vertex_attr(g,"group"))[[2]],