Fix upheno [skip ci]

DESCRIPTION

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

R/get_ontology.R

@@ -70,6 +70,7 @@ get_ontology <- function(name=c("mondo",
      !name %in% c("mondo",
                   "hp","hpo",
                   "cl","cellontology","cell-ontology",
+                  "upheno",
                   "uberon")){
     if(name %in% rols_opts){
       messager("Ontology not found via 'github.' Using method='rols'.")
@@ -114,7 +115,7 @@ get_ontology <- function(name=c("mondo",
       ont <- get_ontology_url(URL = 
         # "https://github.com/obophenotype/upheno/raw/master/upheno.owl",
         "https://purl.obolibrary.org/obo/upheno/v2/upheno.owl",
-        # import_func = simona::import_owl,
+        import_func = simona::import_owl,
         force_new = force_new, 
         save_dir = save_dir, 
         ...) 

R/get_ontology_descendants.R

@@ -14,7 +14,7 @@ get_ontology_descendants <- function(ont,
                                      include_self = TRUE,
                                      ...){
   lapply(terms, function(x){
-    message(x)
+    # message(x)
     xt <- map_ontology_terms(ont = ont,
                              terms = x,
                              to = 'id')

R/get_opentargets.R

@@ -24,7 +24,9 @@ get_opentargets <- function(release="latest",
                                         "associationByDatatypeIndirect",
 
                                         "associationByOverallDirect",
-                                        "associationByOverallIndirect"
+                                        "associationByOverallIndirect",
+
+                                        "l2g"
                             )[1],
                             server="https://ftp.ebi.ac.uk/pub/databases/opentargets/",
                             subdir=c("platform/","genetics/")[1],

R/get_ttd.R

@@ -3,6 +3,7 @@
 #' @examples
 #' ttd <- get_ttd()
 get_ttd <- function(save_dir = cache_dir(),
+                    force_new = FALSE,
                     run_map_genes = TRUE){
 
   requireNamespace("orthogene")
@@ -20,7 +21,8 @@ get_ttd <- function(save_dir = cache_dir(),
   f <- lapply(stats::setNames(files,files),
               function(x){
     loc <- file.path(save_dir,x)
-    if(!file.exists(loc)){
+    if(!file.exists(loc) & 
+       isFALSE(force_new)){
       utils::download.file(paste(domain,x,sep="/"),
                            destfile = loc)
     }
@@ -86,6 +88,8 @@ get_ttd <- function(save_dir = cache_dir(),
                                                 mthreshold = 1,
                                                 drop_na = FALSE)$name
     dat[,GENENAME3:=data.table::fcoalesce(GENENAME2,GENENAME_mapped)]
+  } else {
+    dat[,GENENAME3:=GENENAME2]
   }
   #### Convert status to ordered factor ####
   sts <- sort(unique(dat$HIGHEST_STATUS), na.last = TRUE)

R/map_upheno_data.R

@@ -15,6 +15,8 @@
 #' }
 #' @param keep_nogenes Logical indicating whether to keep mappings that do not
 #' have any orthologous genes.
+#' @param agg Aggregate the data to to phenotype-level (TRUE). 
+#' Otherwise, keep data at gene level (FALSE).
 #' @inheritParams map_upheno
 #' @returns A data.table containing the mapped data.
 #'
@@ -29,9 +31,12 @@ map_upheno_data <- function(pheno_map_method=c("upheno","monarch"),
                             fill_scores=NULL,
                             terms=NULL,
                             save_dir=cache_dir(),
+                            agg=TRUE,
                             force_new=FALSE){
   #### Check for cached data ####
-  save_path <- file.path(save_dir,"pheno_map_genes_match.rds")
+  save_path <- file.path(
+    save_dir,
+    paste0("pheno_map_genes_match",if(isFALSE(agg)) ".noAgg",".rds"))
   if(file.exists(save_path) &&
      isFALSE(force_new)){
     ## Read from cache
@@ -47,7 +52,8 @@ map_upheno_data <- function(pheno_map_method=c("upheno","monarch"),
                           gene_map_method=gene_map_method,
                           keep_nogenes=keep_nogenes,
                           fill_scores=fill_scores,
-                          terms=terms)
+                          terms=terms,
+                          agg=agg)
       }) |> data.table::rbindlist(fill=TRUE, idcol = "pheno_map_method")
     ## Save
     messager("Caching processed file -->",save_path)

R/map_upheno_data_i.R

@@ -2,7 +2,8 @@ map_upheno_data_i <- function(pheno_map_method,
                               gene_map_method,
                               keep_nogenes,
                               fill_scores,
-                              terms){
+                              terms,
+                              agg){
   hgnc <- gene_label1 <- subject <- subject_taxon_label <-
     hgnc_label <- n_phenotypes <- n_genes_intersect <-
     prop_intersect <- p1 <- p2 <- db1 <- db2 <- id1 <- id2 <-
@@ -120,6 +121,7 @@ map_upheno_data_i <- function(pheno_map_method,
     } else {
       pheno_map_genes_match <- pheno_map_genes |> data.table::copy()
     }
+    if(isFALSE(agg)) return(pheno_map_genes_match)
     pheno_map_genes_match <-
       pheno_map_genes_match[,
                             list(n_genes_intersect=data.table::uniqueN(hgnc2)),