export get_gencc

Author: bschilder

NAMESPACE

@@ -21,13 +21,16 @@ export(add_tier)
 export(adjacency_matrix)
 export(annotate_phenos)
 export(assign_tiers)
+export(clear_cache)
 export(example_phenos)
+export(get_gencc)
 export(get_gene_lists)
 export(get_hpo)
 export(get_hpo_id_direct)
 export(get_mondo)
 export(get_ont_lvls)
 export(get_ont_lvls2)
+export(get_version)
 export(ggnetwork_plot)
 export(gpt_annot_check)
 export(gpt_annot_codify)

NEWS.md

@@ -3,16 +3,22 @@
 ## New features
 
 * `get_hpo`
-  - Updated to lates release: 2023-08-01
+  - Updated to latest release: 2023-08-01
 * `gpt_annot_*`
   - Ensure consistent use of updated column names.
 * Add version attribute data within HPO objects
   - `get_hpo`: already built in to `ontologyIndex` objects.
   - `load_phenotypes_to_genes`: new attribute.
-* Add `update_hpo` internal function.
+  - New exported helper function: `get_version`
+  - New exported helper function: `clear_cache`
+* Add `make_hpo` internal function.
 * Ensure consistent function naming:
-  - `create_node_data` --> `make_node_data`
-* New internal function: `clear_cache`
+  - `create_node_data` --> `make_node_data` 
+* `get_gencc`
+  - Export
+  - Add version info
+* Increase code coverage throughout
+
 
 # HPOExplorer 0.99.11
 

R/clear_cache.R

@@ -1,15 +1,26 @@
 #' Clear cache
 #'
+#' Remove all data cached by \pkg{HPOExplorer}.
 #' @param save_dir Path to cache directory.
+#' @param verbose Print messages.
 #' @inheritParams base::unlink
 #' @inheritDotParams base::unlink
+#' @returns Null.
 #'
-#' @keywords internal
+#' @export
 #' @importFrom tools R_user_dir
+#' @examples
+#' \dontrun{
+#' clear_cache()
+#' }
 clear_cache <- function(save_dir=tools::R_user_dir(package = "HPOExplorer",
                                                    which = "cache"),
-                        recursive = TRUE,
+                        recursive=TRUE,
+                        verbose=TRUE,
                         ...
                         ){
+
+  f <- list.files(save_dir,recursive = recursive)
+  messager("Clearing",length(f),"cached files from:",save_dir,v=verbose)
   unlink(x = save_dir,recursive = recursive,...)
 }

R/get_gencc.R

@@ -1,8 +1,47 @@
+#' Get GenCC
+#'
+#' Get phenotype-gene evidence score from the
+#' \href{https://thegencc.org/}{Gene Curation Coalition}.
+#' Data downloaded from \href{https://search.thegencc.org/download}{here}.\cr
+#' \emph{NOTE:} Due to licensing restrictions, a GenCC download does not
+#'  include OMIM data. OMIM data can be accessed and downloaded through
+#'  \href{https://omim.org/downloads/}{OMIM}.\cr
+#' \emph{NOTE:} GenCC does not currently have any systematic versioning.
+#' There for the \code{attr(obj,"version")} attribute is set to the date it was
+#' downloaded and cached by \link[HPOExplorer]{get_gencc}.
+#'
+#' @param dict A named vector of evidence score mappings.
+#' See \href{https://thegencc.org/faq.html#validity-termsdelphi-survey}{here}
+#' for more information.
+#' @inheritParams add_evidence
+#' @inheritParams get_data
+#' @returns \link[data.table]{data.table} with columns:
+#' \itemize{
+#' \item{"disease_id": }{Disease ID.}
+#' \item{"gene_symbol": }{Gene symbol.}
+#' \item{"evidence_score": }{Evidence score.}
+#' }
+#'
+#' @export
+#' @import data.table
+#' @importFrom utils download.file
+#' @examples
+#' d <- get_gencc()
 get_gencc <- function(agg_by=c("disease_id",
                                "gene_symbol"),
+                      dict = c("Definitive"=6,# GENCC:100001
+                                "Strong"=5, # GENCC:100002
+                                "Moderate"=4, # GENCC:100003
+                                "Supportive"=3, # GENCC:100009
+                                "Limited"=2, # GENCC:100004
+                                "Disputed Evidence"=1, # GENCC:100005
+                                "Refuted Evidence"=0, # GENCC:100006
+                                "No Known Disease Relationship"=0 # GENCC:100008
+                      ),
                       save_dir=tools::R_user_dir("HPOExplorer",
                                                  which="cache"),
                       verbose=TRUE){
+  # devoptera::args2vars(get_gencc)
 
   disease_id <- disease_original_curie <- classification_title <-
     evidence_score <- NULL;
@@ -19,16 +58,6 @@ get_gencc <- function(agg_by=c("disease_id",
   d <- data.table::fread(f)
   d[,disease_id:=gsub("^Orphanet","ORPHA",disease_original_curie)]
   #### Encode evidence numerically ####
-  # https://thegencc.org/faq.html#validity-termsdelphi-survey
-  dict <- c("Definitive"=6,# GENCC:100001
-            "Strong"=5, # GENCC:100002
-            "Moderate"=4, # GENCC:100003
-            "Supportive"=3, # GENCC:100009
-            "Limited"=2, # GENCC:100004
-            "Disputed Evidence"=1, # GENCC:100005
-            "Refuted Evidence"=0, # GENCC:100006
-            "No Known Disease Relationship"=0 # GENCC:100008
-            )
   d[,evidence_score:=dict[classification_title]]
   #### Aggregate so that there's 1 entry/gene/disease ####
   if(!is.null(agg_by)){
@@ -37,5 +66,9 @@ get_gencc <- function(agg_by=c("disease_id",
                  evidence_score_mean=mean(evidence_score, na.rm=TRUE)),
                by=agg_by]
   }
+  #### Add version ####
+  attr(d,"version") <- format(file.info(f)$mtime, "%Y-%m-%d")
+  get_version(obj=d, verbose=verbose)
+  #### Return ####
   return(d)
 }

R/get_version.R

@@ -0,0 +1,34 @@
+#' Get version
+#'
+#' Extract the precise version of the HPO release that the data object
+#' was built from. All HPO Releases can be found at the official
+#' \href{https://github.com/obophenotype/human-phenotype-ontology/releases}{
+#' HPO GitHub Releases page}.
+#' @param obj An object from
+#' \link[HPOExplorer]{get_hpo} or
+#' \link[HPOExplorer]{load_phenotype_to_genes}.
+#' @param verbose Print messages.
+#' @param return_version Return the version as a character string.
+#' @returns HPO Release version a character string.
+#'
+#' @export
+#' @examples
+#' obj <- get_hpo()
+#' get_version(obj=obj)
+get_version <- function(obj,
+                        return_version = FALSE,
+                        verbose = TRUE){
+  ## Extract
+  if(methods::is(obj,"ontology_index")){
+    x <- grep("data-version:",attr(obj,"version"),value=TRUE)
+    v <- paste0("v",
+                trimws(gsub("data-version:|hp/releases/|/hp-base.owl","",x))
+                )
+  } else {
+    v <- attr(obj,"version")
+  }
+  ## Print
+  messager("+ Version:",v,v=verbose)
+  ## Return
+  if(isTRUE(return_version))  return(v)
+}

R/hpo_api.R

@@ -10,13 +10,17 @@
 #' @returns A named list or data.frame of metadata for a given HPO ID.
 #'
 #' @export
+#' @import data.table
 #' @examples
 #' 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="/")
                     ){
 
+  requireNamespace("httr")
+  requireNamespace("jsonlite")
+
   hpo_termdetails <- tryCatch(expr = {
     httr::GET(url = url)
   },
@@ -26,5 +30,7 @@ hpo_api <- function(hpo_id,
   })
   hpo_termdetails_char <- rawToChar(hpo_termdetails$content)
   hpo_termdetails_data <- jsonlite::fromJSON(hpo_termdetails_char)
+  hpo_termdetails_data$diseases <-
+    data.table::data.table(hpo_termdetails_data$diseases)
   return(hpo_termdetails_data)
 }

R/load_phenotype_to_genes.R

@@ -46,7 +46,7 @@ load_phenotype_to_genes <- function(file = c("phenotype_to_genes.txt",
      !overwrite){
     messager("Reading cached RDS file:",file,v=verbose)
     obj <- readRDS(path_rds)
-    messager("+ Version:",attr(obj,"version"),v=verbose)
+    get_version(obj,verbose=verbose)
     return(obj)
   }
   #### Stored in GitHub Releases ####
@@ -66,8 +66,10 @@ load_phenotype_to_genes <- function(file = c("phenotype_to_genes.txt",
   } else {
     phenotype_to_genes <- data.table::fread(input = f)
   }
+  #### Add version ####
   if(!is.null(attr(f,"version"))){
     attr(phenotype_to_genes,"version") <- attr(f,"version")
+    get_version(phenotype_to_genes,verbose=verbose)
   }
   #### Save RDS ####
   ## This lets up keep track of the version of the data without having to

man/clear_cache.Rd

@@ -0,0 +1,11 @@
+test_that("add_disease works", {
+
+  phenos <- example_phenos()
+  phenos2 <- add_disease(phenos = phenos, add_definitions = TRUE)
+  testthat::expect_true(
+    all(phenos$hpo_id %in% phenos2$hpo_id)
+  )
+  testthat::expect_gte(
+    nrow(phenos2),7000
+  )
+})

man/get_gencc.Rd

@@ -0,0 +1,4 @@
+test_that("get_gencc works", {
+
+  d <- get_gencc()
+})

man/get_version.Rd

@@ -0,0 +1,8 @@
+test_that("gpt_annot_check works", {
+
+  checks <- gpt_annot_check()
+  testthat::expect_true(all(
+    c("annot","annot_mean","annot_consist","annot_check","checkable_rate",
+      "checkable_count","true_pos_rate","false_neg_rate") %in% names(checks)
+  ))
+})

tests/testthat/test-add_disease.R

@@ -0,0 +1,9 @@
+test_that("gpt_annot_codify works", {
+
+  coded <- gpt_annot_codify()
+  testthat::expect_true(
+    all(
+      c("annot","annot_coded","annot_weighted") %in% names(coded)
+    )
+  )
+})

tests/testthat/test-get_gencc.R

@@ -0,0 +1,10 @@
+test_that("hpo_api works", {
+
+  dat <- hpo_api(hpo_id="HP:0011420", type="diseases")
+  testthat::expect_true(
+    all(c("diseases","diseaseCount","offset","max" ) %in% names(dat))
+  )
+  testthat::expect_true(
+    methods::is(dat$diseases,"data.table")
+  )
+})