Merge pull request #434 from nuno-agostinho/dev

1.20.0

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: psichomics
 Title: Graphical Interface for Alternative Splicing Quantification, Analysis and
     Visualisation
-Version: 1.18.6
+Version: 1.20.0
 Encoding: UTF-8
 Authors@R: c(
         person("Nuno", "Saraiva-Agostinho",

NAMESPACE

@@ -102,7 +102,9 @@ exportMethods(colSums)
 importFrom(AnnotationDbi,select)
 importFrom(AnnotationHub,AnnotationHub)
 importFrom(AnnotationHub,getAnnotationHubOption)
+importFrom(AnnotationHub,mcols)
 importFrom(AnnotationHub,query)
+importFrom(AnnotationHub,setAnnotationHubOption)
 importFrom(BiocFileCache,BiocFileCache)
 importFrom(DT,JS)
 importFrom(DT,dataTableOutput)

NEWS.md

@@ -1,3 +1,14 @@
+# psichomics 1.20.0 (27 October, 2021)
+
+* Alternative splicing event annotations:
+    - Support new annotations from VAST-TOOLS for multiple species, including
+    mouse, zebrafish, fruit fly, chicken, frog, C. elegans and A. thaliana
+    - Automatically create cache directory if downloading splicing annotations
+    for the first time
+* Gene, transcript and protein annotation (visual interface):
+    - Automatically set species/genome based on selected annotation
+    - Improve species and genome selection
+
 # psichomics 1.18.6 (4 October, 2021)
 
 ## ShinyProxy support

R/analysis_information.R

@@ -54,9 +54,10 @@ queryEnsemblByGene <- function(gene, species=NULL, assembly=NULL) {
     } else {
         if (is.null(species) || is.null(assembly))
             stop("Species and assembly need to be non-NULL")
-        grch37 <- assembly == "hg19"
-        path <- paste0("lookup/symbol/", species, "/", gene)
-        info <- queryEnsembl(path, list(expand=1), grch37=grch37)
+        grch37  <- assembly == "hg19"
+        species <- gsub(" ", "_", species)
+        path    <- paste0("lookup/symbol/", species, "/", gene)
+        info    <- queryEnsembl(path, list(expand=1), grch37=grch37)
     }
     return(info)
 }
@@ -215,41 +216,37 @@ pubmedUI <- function(ns, gene, ...) {
 infoUI <- function(id) {
     ns <- NS(id)
 
-    renderSelectize <- function(option_create) {
-        render <- sprintf(
-            "{ option_create: function (data, escape) {
-                   return '<div class=\"create\">' + %s + '</div>'; }}",
-            option_create)
-        return(I(render))
-    }
-
-    species <- c(paste("human", c("hg19", "hg38")),
-                 paste("mouse", c("mm9", "mm10")),
-                 "rat rn6",
-                 "zebrafish danRer11",
-                 "Drosophila_melanogaster dm6",
-                 "Caenorhabditis_elegans ce11",
-                 "Saccharomyces_cerevisiae sacCer3")
+    species <- c(paste("Homo sapiens", c("hg19", "hg38")),
+                 paste("Mus musculus", c("mm9", "mm10")),
+                 "Rattus norvegicus rn6",
+                 "Bos taurus bosTau6",
+                 paste("Gallus gallus", c("galGal3", "galGal4")),
+                 "Xenopus tropicalis xenTro3",
+                 "Danio rerio danRer10",
+                 "Branchiostoma lanceolatum braLan2",
+                 "Strongylocentrotus purpuratus strPur4",
+                 "Drosophila melanogaster dm6",
+                 "Strigamia maritima strMar1",
+                 "Caenorhabditis elegans ce11",
+                 "Schmidtea mediterranea schMed31",
+                 "Nematostella vectensis nemVec1",
+                 "Arabidopsis thaliana araTha10")
     #setNames(paste(names(species), species),
     #         capitalize(sprintf("%s (%s assembly)", names(species), species)))
 
-    onFocus <- I('function() { this.clear(); }')
-    renderSpecies <- renderSelectize(
-        option_create=paste(
-            "'Search in <strong>' + escape(data.input).split(\" \")[0] +",
-            "' (' + escape(data.input).split(\" \")[1] + ' assembly)' +",
-            "'</strong>&hellip;'"))
+    onFocus    <- I('function() { this.clear(); }')
     selectSpecies <- selectizeInput(
         ns("selectedSpecies"), "Species", width="100%",
         choices=species, selected=species[[1]],
         options=list(placeholder="Search for a species...", highlight=FALSE,
-                     create=TRUE, onFocus=onFocus, render=renderSpecies))
+                     create=TRUE, onFocus=onFocus,
+                     render=I("{ option_create: renderAddSpecies,
+                                 option: renderSpeciesSelection,
+                                 item: renderSpeciesSelection }")))
 
-    renderGene <- renderSelectize(
-        option_create=paste(
-            "'Search for <strong>' + escape(data.input) + '</strong>&hellip;'"))
     selectGene <- selectizeGeneInput(
-        ns("selectedGene"), create=TRUE, createOnBlur=TRUE, render=renderGene,
+        ns("selectedGene"), create=TRUE, createOnBlur=TRUE,
+        render=I("{ option_create: renderAddGene }"),
         placeholder="Search for a gene symbol...")
     tagList(
         fluidRow(
@@ -797,7 +794,8 @@ prepareExternalLinks <- function(info, species, assembly, grch37, gene) {
     url$geneCards <- paste0(
         "http://www.genecards.org/cgi-bin/carddisp.pl?gene=", gene)
 
-    isHuman <- !is.null(species) && species == "human"
+    isHuman <- !is.null(species) &&
+        tolower(species) %in% c("human", "homo sapiens", "homo")
     links <- tagList(
         if (!is.null(species) && species != "")
             linkTo("Ensembl", url$ensembl),
@@ -809,11 +807,21 @@ prepareExternalLinks <- function(info, species, assembly, grch37, gene) {
 }
 
 parseSpeciesAssembly <- function(info) {
-    speciesRegex <- "(.*) (.*)"
-    species      <- tolower(gsub(speciesRegex, "\\1", info))
-    assembly     <- tolower(gsub(speciesRegex, "\\2", info))
-    if (is.null(species) || length(species) == 0 || species == "") return(NULL)
-    if (is.null(assembly)) assembly <- ""
+    info <- strsplit(info, " ")[[1]]
+    if (length(info) == 1) {
+        species <- info[[1]]
+    } else if (length(info) >= 2) {
+        species <- paste(info[[1]], info[[2]])
+    } else {
+        return(NULL)
+    }
+    species <- tolower(species)
+
+    if (length(info) >= 3) {
+        assembly <- tolower(info[[3]])
+    } else {
+        assembly <- ""
+    }
     return(list(species=species, assembly=assembly))
 }
 
@@ -843,7 +851,7 @@ infoServer <- function(input, output, session) {
         selected <- paste(species, assembly)
 
         if (is.null(selected) || selected == "" || length(selected) == 0) {
-            selected <- "human hg19"
+            selected <- "Homo sapiens hg19"
         }
         updateSelectizeInput(session, "selectedSpecies", selected=selected)
     })

R/app.R

@@ -470,7 +470,7 @@ appServer <- function(input, output, session) {
         }
     })
 
-    if (!getOption("shinyproxy", FALSE)) {
+    if (!getOption("psichomics.shinyproxy", FALSE)) {
         session$onSessionEnded(function() {
             # Stop app and print message to console
             message("\n-- psichomics was closed --")
@@ -479,17 +479,47 @@ appServer <- function(input, output, session) {
     }
 }
 
+loadTestData <- function(unparsableEvents) {
+    loadFile <- function(file) {
+        if (!file.exists(file)) {
+            # Fetch file online if not locally available
+            link <- file.path("https://github.com/nuno-agostinho/psichomics",
+                              "raw/master", file)
+            file <- url(link)
+        }
+        readRDS(file)
+    }
+    data <- NULL
+    data[["Clinical data"]]    <- loadFile("vignettes/BRCA_clinical.RDS")
+    data[["Gene expression"]]  <- loadFile("vignettes/BRCA_geneExpr.RDS")
+    psi                        <- loadFile("vignettes/BRCA_psi.RDS")
+
+    # Test events with ID that cannot be parsed
+    if (unparsableEvents) {
+        rownames(psi) <- paste0("undefASevent", seq(nrow(psi)))
+    }
+    data[["Inclusion levels"]] <- psi
+    data[["Sample metadata"]]  <- parseTCGAsampleInfo(colnames(psi))
+
+    eventData <- suppressWarnings(
+        parseSplicingEvent(rownames(psi), coords=TRUE))
+    if (!is.null(eventData)) {
+        class(eventData) <- c("eventData", class(eventData))
+        attr(data[["Inclusion levels"]], "rowData") <- eventData
+    }
+    return(data)
+}
+
 #' Start graphical interface of psichomics
 #'
 #' @inheritParams shiny::runApp
 #' @inheritDotParams shiny::runApp -appDir -launch.browser
-#' @param reset Boolean: reset Shiny session? Requires package \code{devtools}
 #' @param shinyproxy Boolean: prepare visual interface to run in Shinyproxy?
 #' @param testData Boolean: load with test data
-#' @param unparsableEvents Boolean: when testing data, load alternative splicing
-#' quantification events that cannot be parsed?
+#' @inheritParams loadAnnotationHub
 #'
 #' @importFrom shiny shinyApp runApp addResourcePath
+#' @importFrom AnnotationHub getAnnotationHubOption setAnnotationHubOption
 #'
 #' @return \code{NULL} (function is only used to modify the Shiny session's
 #' state or internal variables)
@@ -499,42 +529,16 @@ appServer <- function(input, output, session) {
 #' \dontrun{
 #' psichomics()
 #' }
-psichomics <- function(..., launch.browser=TRUE, reset=FALSE, shinyproxy=FALSE,
-                       testData=FALSE, unparsableEvents=FALSE) {
-    options(shinyproxy=shinyproxy)
-    # Add icons related to set operations
+psichomics <- function(..., launch.browser=TRUE, shinyproxy=FALSE,
+                       testData=FALSE, cache=getAnnotationHubOption("CACHE")) {
+    options("psichomics.shinyproxy"=shinyproxy)
+    setAnnotationHubOption("CACHE", cache)
+
+    # Load icons related to set operations
     addResourcePath("set-operations",
                     insideFile("shiny", "www", "set-operations"))
-    if (reset) devtools::load_all()
-
     if (testData) {
-        loadFile <- function(file) {
-            if (!file.exists(file)) {
-                # Fetch file online if not locally available
-                link <- paste0("https://github.com/",
-                               "nuno-agostinho/psichomics/raw/master/",
-                               file)
-                file <- url(link)
-            }
-            readRDS(file)
-        }
-        data <- NULL
-        data[["Clinical data"]]    <- loadFile("vignettes/BRCA_clinical.RDS")
-        data[["Gene expression"]]  <- loadFile("vignettes/BRCA_geneExpr.RDS")
-        psi                        <- loadFile("vignettes/BRCA_psi.RDS")
-
-        if (unparsableEvents) {
-            rownames(psi) <- paste0("undefASevent", seq(nrow(psi)))
-        }
-        data[["Inclusion levels"]] <- psi
-        data[["Sample metadata"]]  <- parseTCGAsampleInfo(colnames(psi))
-
-        eventData <- suppressWarnings(
-            parseSplicingEvent(rownames(psi), coords=TRUE))
-        if (!is.null(eventData)) {
-            class(eventData) <- c("eventData", class(eventData))
-            attr(data[["Inclusion levels"]], "rowData") <- eventData
-        }
+        data <- loadTestData(unparsableEvents=FALSE)
         setData(list("Test data"=data))
     }
     app <- shinyApp(appUI(), appServer)

R/data.R

@@ -276,7 +276,7 @@ processDatasetNames <- function(data) {
 #' @importFrom shinyBS bsPopover
 #' @importFrom shiny fileInput
 fileBrowserInfoInput <- function(id, label, infoContent=NULL, clearable=FALSE) {
-    if (!getOption("shinyproxy", FALSE)) {
+    if (!getOption("psichomics.shinyproxy", FALSE)) {
         input <- fileBrowserInput(
             id, label, placeholder="No file selected", clearable=clearable,
             info=TRUE, infoFUN=bsPopover, infoTitle=label,

R/data_firebrowse.R

@@ -246,7 +246,7 @@ isFirebrowseUp <- function() {
     if (is(heartbeat, "error")) {
         return(FALSE)
     } else if (http_error(heartbeat)) {
-        warn_for_status(heartbeat, "reach FireBrowse API")
+        warn_for_status(heartbeat, "reach FireBrowse")
         return(FALSE)
     } else {
         return(TRUE)
@@ -724,9 +724,9 @@ firebrowseUI <- function(id, panel) {
     panel(style="info",
           title=list(icon("plus-circle"), "TCGA data loading"),
           value="Load TCGA/FireBrowse data",
-          helpText("TCGA data are downloaded using the",
+          helpText("TCGA data downloaded from",
                    a(href="http://firebrowse.org", target="_blank",
-                     "FireBrowse"), "API."),
+                     "FireBrowse")),
           div(id=ns("firebrowseLoading"), class="progress",
               div(class="progress-bar progress-bar-striped active",
                   role="progressbar", style="width: 100%", "Loading...")),

R/data_gtex.R

@@ -36,9 +36,9 @@ gtexDataUI <- function(id, panel) {
     panel(style="info", title=list(icon("plus-circle"), "GTEx data loading"),
           value="Automatically load GTEx data",
           uiOutput(ns("modal")),
-          helpText("GTEx data are downloaded from the",
+          helpText("GTEx data downloaded from",
                    a(href="http://www.gtexportal.org", target="_blank",
-                     "GTEx Data Portal"), "website."),
+                     "GTEx Data Portal")),
           selectizeInput(ns("release"), "Version release", width="100%",
                          getGtexReleases(), selected=8),
           selectizeInput(ns("dataTypes"), "Data type", multiple=TRUE,