Pass checks

Author: bschilder

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: HPOExplorer
 Title: Analysis and Visualisation of the Human Phenotype Ontology
-Version: 1.0.2
+Version: 1.0.3
 Authors@R:
     c(
     person(given = "Brian",
@@ -52,7 +52,8 @@ Suggests:
     piggyback,
     patchwork,
     tidygraph,
-    colorspace
+    colorspace,
+    BiocParallel
 Remotes:
   github::neurogenomics/KGExplorer
 VignetteBuilder: knitr

NAMESPACE

@@ -27,6 +27,7 @@ export(filter_descendants)
 export(get_gene_lists)
 export(get_hpo)
 export(get_hpo_id_direct)
+export(get_mappings)
 export(get_top_phenos)
 export(gpt_annot_check)
 export(gpt_annot_class)

NEWS.md

@@ -1,3 +1,14 @@
+# HPOExplorer 1.0.3
+
+## New features
+
+* Upgrade `add_disease` to use cached definitions.
+
+## Bug fixes
+
+* Fix tests for `make_phenos_dataframe`.
+* Deprecate `hpo_api` as the HPO API was deprecated in the 2.0.0 Release (https://hpo.jax.org/data/api).
+
 # HPOExplorer 1.0.1
 
 ## New features

R/add_death.R

@@ -43,7 +43,7 @@
 add_death <- function(phenos,
                       keep_deaths = NULL,
                       all.x = TRUE,
-                      allow.cartesian = FALSE,
+                      allow.cartesian = TRUE,
                       agg_by = NULL){
 
   # devoptera::args2vars(add_death)

R/add_disease.R

@@ -1,11 +1,7 @@
 #' Add diseases
 #'
 #' Annotate each HPO term with diseases that they are associated with.
-#' @param extra_cols Extra metadata columns from the"phenotype.hpoa"
-#' annotations file to include.
-#' See
-#' \href{https://hpo-annotation-qc.readthedocs.io/en/latest/annotationFormat.html}{
-#' here for column descriptions}.
+#' @param add_descriptions Add disease names and descriptions.
 #' @inheritParams add_
 #' @inheritParams map_disease
 #'
@@ -18,7 +14,7 @@
 add_disease <- function(phenos,
                         phenotype_to_genes = load_phenotype_to_genes(),
                         hpo = get_hpo(),
-                        extra_cols = NULL,
+                        add_descriptions=FALSE,
                         all.x = TRUE,
                         use_api=FALSE,
                         workers=NULL,
@@ -34,13 +30,16 @@ add_disease <- function(phenos,
                         all.x = all.x,
                         allow.cartesian = allow.cartesian)
   }
-  phenos <- map_disease(dat=phenos,
-                        id_col="disease_id",
-                        fields=c("disease"),
-                        use_api=use_api,
-                        return_dat=TRUE,
-                        all.x = all.x,
-                        allow.cartesian = allow.cartesian,
-                        workers=workers)
+  if(isTRUE(add_descriptions)){
+    phenos <- map_disease(dat=phenos,
+                          id_col="disease_id",
+                          fields=c("disease"),
+                          use_api=use_api,
+                          return_dat=TRUE,
+                          all.x = all.x,
+                          allow.cartesian = allow.cartesian,
+                          workers=workers)
+  }
+
   return(phenos)
 }

R/add_genes.R

@@ -47,6 +47,7 @@ add_genes <- function(phenos = NULL,
                        hpo = hpo)
   #### Add Gene col to data ####
   if(!"gene_symbol" %in% names(phenos)){
+    messager("Adding genes and disease IDs.")
     by <- by[by %in% names(phenos)]
     # ## Merge with input data
     phenos <- data.table::merge.data.table(phenos,

R/annotate_phenos.R

@@ -77,7 +77,8 @@ annotate_phenos <- function(phenos,
   }
   #### Add phenotype-disease freqs ####
   if(isTRUE(add_disease_definitions)){
-    phenos <- add_mondo(phenos = phenos)
+    phenos <- add_disease(phenos = phenos,
+                          add_descriptions = TRUE)
   }
   #### Add hoverboxes ####
   if(isTRUE(add_hoverboxes)){

R/get_hpo.R

@@ -17,8 +17,7 @@
 #' @import KGExplorer
 #' @examples
 #' hpo <- get_hpo()
-get_hpo <- function(lvl,
-                    add_ancestors = 2,
+get_hpo <- function(lvl = 2,
                     force_new = FALSE,
                     terms=NULL,
                     ## rols imports the international version for some reason
@@ -29,7 +28,7 @@ get_hpo <- function(lvl,
   file <- file.path(save_dir,"hp.rds")
   if(!file.exists(file) || isTRUE(force_new)){
     ont <- KGExplorer::get_ontology(name = "hp",
-                                    add_ancestors = add_ancestors,
+                                    lvl = lvl,
                                     force_new = force_new,
                                     terms = terms,
                                     method = method,

R/get_mappings.R

@@ -0,0 +1,47 @@
+#' @describeIn get_ get_
+#' Get Human Phenotype Ontology (HPO) mappings
+#'
+#' Get mappings between HPO terms and their corresponding IDs in
+#'  other medical ontologies (e.g. SNOMED CT, UMLS, ICD-9/10).
+#' @param to Medical ontologies to provide mappings to.
+#' @param max_dist Maximum cross-ontology distance to search for mappings.
+#'  A distance of 1 means only direct mappings are returned.
+#'  Greater distances mean that mappings are found through intermediate terms
+#'   and are therefore less reliable.
+#' @inheritDotParams get_data
+#' @returns A named list of \link{data.table} objects containing mappings.
+#'
+#' @export
+#' @examples
+#' mappings <- get_mappings()
+get_mappings <- function(terms=NULL,
+                         to=c("UMLS","SNOMED","ICD9","ICD10"),
+                         max_dist=1,
+                         force_new=FALSE,
+                         save_dir=KGExplorer::cache_dir(package="HPOExplorer"),
+
+                         ...){
+  file_name <- distance <- NULL;
+
+  files <- piggyback::pb_list(repo = "neurogenomics/HPOExplorer")
+  files <- data.table::data.table(files)[grepl("*_to_HPO_dist3\\.csv\\.gz$",
+                                               file_name)]
+  files$to <- strsplit(files$file_name,"_to_HPO_dist3\\.csv\\.gz$")|>unlist()
+  opts <- intersect(toupper(unique(files$to)),
+                    toupper(to))
+  if(length(opts)==0){
+    stop("`to` must be one of: ",paste0(shQuote(opts),collapse=", "))
+  }
+  out <- lapply(stats::setNames(opts,opts), function(x){
+    f <- get_data(file=files[opts==x]$file_name[1],
+                  overwrite = force_new,
+                  save_dir = save_dir,
+                  ...)
+    d <- data.table::fread(f)
+    if(is.numeric(max_dist)){
+      d <- d[distance<=max_dist]
+    }
+    d
+  })
+  return(out)
+}

R/hpo_api.R

@@ -12,12 +12,16 @@
 #' @export
 #' @import data.table
 #' @examples
+#' \dontrun{
 #' dat <- hpo_api(hpo_id="HP:0011420", type="diseases")
+#' }
 hpo_api <- function(hpo_id,
                     type = list(NULL,"genes","diseases")[[1]],
                     url = paste("hpo.jax.org/api/hpo/term",hpo_id,type,sep="/")
                     ){
 
+  .Deprecated(msg="hpo_api is deprecated. For details, see: https://hpo.jax.org/data/api")
+  stop()
   requireNamespace("httr")
   requireNamespace("jsonlite")
 

R/map_disease.R

@@ -18,7 +18,7 @@
 map_disease <- function(dat,
                         id_col="disease_id",
                         fields=c("disease","categories","genes")[1],
-                        use_api=TRUE,
+                        use_api=FALSE,
                         return_dat=FALSE,
                         workers=NULL,
                         all.x = TRUE,
@@ -29,17 +29,17 @@ map_disease <- function(dat,
   #   httr::add_headers(accept = "application/json")
   # )
   # cont <- httr::content(res)
-
   # Define the URL and headers
   if(!id_col %in% names(dat)){
     stop("id_col not found in dat.")
   }
   if(!all(c("disease_name","disease_description") %in% names(dat))){
     messager("Adding disease_name and disease_description.")
+    requireNamespace("BiocParallel")
     #### Slow but up-to-date ####
     if(use_api || length(fields)>1){
       map_disease_i <- function(id){
-        url <- URLencode(
+        url <- utils::URLencode(
           ## encode URL
           paste0("https://ontology.jax.org/api/network/annotation/",id)
         )

R/map_phenotypes.R

@@ -25,6 +25,7 @@ map_phenotypes <- function(terms,
                                KGExplorer::map_ontology_terms
                                )$ignore_char),
                            invert = FALSE){
+  to <- match.arg(to)
   KGExplorer::map_ontology_terms(terms = terms,
                                  ont = hpo,
                                  to = to,