From cc0ddc5999ac10060c83dcff1cdf35356e5e5aa7 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 30 Oct 2018 18:29:53 +0000 Subject: [PATCH 01/46] Fix word break-related visual issues --- R/data.R | 3 +-- R/utils.R | 3 ++- man/prepareWordBreak.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/data.R b/R/data.R index f8d5fc7f..33208216 100644 --- a/R/data.R +++ b/R/data.R @@ -474,8 +474,7 @@ createDataTab <- function(index, data, name, session, input, output) { settings <- attr(table, "settings") if (!is.null(settings)) { settingsDf <- data.frame(names(settings), sapply( - settings, function(item) - prepareWordBreak(paste(item, collapse=", ")))) + sapply(settings, paste, collapse=", "), prepareWordBreak)) colnames(settingsDf) <- c("Attribute", "Item") settings <- table2html( settingsDf, rownames=FALSE, thead=TRUE, diff --git a/R/utils.R b/R/utils.R index 2e565499..edaec197 100644 --- a/R/utils.R +++ b/R/utils.R @@ -339,7 +339,8 @@ trimWhitespace <- function(word) { #' @importFrom shiny HTML #' #' @return String containing HTML elements -prepareWordBreak <- function(str, pattern=c(".", "-", "\\", "/", "_")) { +prepareWordBreak <- function(str, pattern=c(".", "-", "\\", "/", "_", ",", + " ")) { res <- str # wbr: word break opportunity for (p in pattern) res <- gsub(p, paste0(p, ""), res, fixed=TRUE) diff --git a/man/prepareWordBreak.Rd b/man/prepareWordBreak.Rd index e3c3f7a5..711a34ed 100644 --- a/man/prepareWordBreak.Rd +++ b/man/prepareWordBreak.Rd @@ -4,7 +4,7 @@ \alias{prepareWordBreak} \title{Create word break opportunities (for HTML) using given characters} \usage{ -prepareWordBreak(str, pattern = c(".", "-", "\\\\", "/", "_")) +prepareWordBreak(str, pattern = c(".", "-", "\\\\", "/", "_", ",", " ")) } \arguments{ \item{str}{Character: text} From 757f821eacadef804a39c948dc8752bec86bba88 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 30 Oct 2018 18:37:13 +0000 Subject: [PATCH 02/46] Fix link for AS annotation creation and loading --- R/data_inclusionLevels.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index 4e808e97..6aac751f 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -223,15 +223,14 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { observe({ ns <- session$ns if (input$annotation == "loadAnnotation") { - url <- "http://rpubs.com/nuno-agostinho/alt-splicing-annotation" + url <- "http://rpubs.com/nuno-agostinho/preparing-AS-annotation" updateSelectizeInput(session, "annotation", selected=listSplicingAnnotations()) infoModal(session, "Load alternative splicing annotation", - helpText("Load alternative splicing annotation from a", - "RDS file. To learn more on how to create a", - "custom splicing annotation,", - tags$a(href=url, target="_blank", + helpText("To learn how to create and load custom", + "alternative splicing annotations,", + tags$a(href=url, target="_blank", "click here.")), fileInput(ns("customAnnot"), "Choose RDS file", accept=".rds"), From af7d87997ca811bc3dae0c9bca5e964eb92ff713 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 31 Oct 2018 17:37:25 +0000 Subject: [PATCH 03/46] Load pre-made gene lists and improvements to correlation analyses - Display correlation results in a table - Display correlation analyses progress - Load those groups by default and allow to create them in the group interface - Initial support for RBPs in Sebestyen et al. 2016 - Allow to use such groups in correlation analyses - Improvements to interface for correlation analyses - Minor copy-editing and interface improvements --- NAMESPACE | 4 + NEWS | 22 ++ R/analysis_correlation.R | 207 +++++------- R/analysis_survival.R | 2 +- R/app.R | 14 +- R/globalAccess.R | 63 ++++ R/groups.R | 421 ++++++++++++++++--------- inst/extdata/Sebestyen_et_al_2016.RDS | Bin 0 -> 5317 bytes inst/shiny/www/functions.js | 63 +++- man/createGroup.Rd | 9 +- man/createGroupFromInput.Rd | 11 +- man/getGeneList.Rd | 17 + man/groupByPreMadeList.Rd | 21 ++ man/matchGroupASeventsAndGenes.Rd | 19 ++ man/matchGroupPatientsAndSamples.Rd | 7 +- man/plotCorrelation.Rd | 39 ++- man/preparePreMadeGroupForSelection.Rd | 17 + man/print.geneList.Rd | 17 + man/selectGroupsUI.Rd | 3 +- man/selectPreMadeGroup.Rd | 19 ++ 20 files changed, 657 insertions(+), 318 deletions(-) create mode 100644 inst/extdata/Sebestyen_et_al_2016.RDS create mode 100644 man/getGeneList.Rd create mode 100644 man/groupByPreMadeList.Rd create mode 100644 man/matchGroupASeventsAndGenes.Rd create mode 100644 man/preparePreMadeGroupForSelection.Rd create mode 100644 man/print.geneList.Rd create mode 100644 man/selectPreMadeGroup.Rd diff --git a/NAMESPACE b/NAMESPACE index 89f2d473..3f6cc1aa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,8 @@ # Generated by roxygen2: do not edit by hand +S3method(as.table,GEandAScorrelation) +S3method(plot,GEandAScorrelation) +S3method(print,GEandAScorrelation) export(assignValuePerPatient) export(assignValuePerSubject) export(calculateLoadingsContribution) @@ -15,6 +18,7 @@ export(getDownloadsFolder) export(getFirebrowseCohorts) export(getFirebrowseDataTypes) export(getFirebrowseDates) +export(getGeneList) export(getGenesFromSplicingEvents) export(getGtexTissues) export(getMatchingSamples) diff --git a/NEWS b/NEWS index d74c9701..1d1be6b7 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,25 @@ +# 1.6.3 (30 October, 2018) + +* Correlation analyses: + - Allow to use groups of genes and alternative splicing events for + correlation analyses + - Display progress for correlation analyses + - Allow to sort results based on correlation estimate (or their absolute + value), p-value or q-value (visual interface) + - Allow to display correlation results as a table (using the `as.table` + function) +* Groups: + - By default, load pre-made lists of genes when loading gene expression or + loading/performing alternative splicing quantification + - Added pre-made list of genes that encode for RNA-binding proteins + (Sebestyen et al. 2016), useful to postulate about splicing regulators based + on gene expression and PSI correlation analyses + +## Bug fixes and minor changes + +* Groups: + - Minor improvements to the group creation interface + # 1.6.2 (2 October, 2018) * Update citations to link to article in Nucleic Acids Research: diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index cafb0709..baffc6d8 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -11,15 +11,11 @@ correlationUI <- function(id) { value="corrParams", style="info", selectizeInput(ns("geneExpr"), "Gene expression", choices=NULL, width="100%"), - selectizeGeneInput(ns("gene"), multiple=TRUE), - # actionLink(ns("addRBPs"), - # "Add RBPs from (Sebestyen et al., 2016)..."), - selectizeInput( - ns("ASevents"), "Alternative splicing events", choices=NULL, - multiple=TRUE, width="100%", - options=list(plugins=list('remove_button', 'drag_drop'))), - hr(), - selectizeInput( + selectGroupsUI(ns("genes"), label="Genes from selected groups"), + selectGroupsUI( + ns("ASevents"), + label="Alternative splicing events from selected groups"), + hr(), selectizeInput( ns("method"), "Correlation method", width="100%", c("Pearson's product-moment correlation"="pearson", "Kendall's rank correlation tau"="kendall", @@ -87,7 +83,7 @@ correlationUI <- function(id) { sliderInput(ns("alpha"), "Point opacity", min=0, max=100, value=20, step=1, post="%", width="100%"), bsCollapse(generalPlotOptions, loessOptions, densityOptions), - processButton(ns("applyPlotStyle"), label="Apply")) + processButton(ns("applyPlotStyle"), label="Plot")) options <- div(id=ns("options"), bsCollapse(open=c("corrParams"), corrParams, scatterParams)) @@ -100,9 +96,9 @@ correlationUI <- function(id) { buttonIcon="plus-circle", buttonId=ns("loadData")), hidden(options)), mainPanel( - uiOutput(ns("correlations")), hidden(dataTableOutput(ns("corTable"))), - hidden(downloadButton(ns("saveTable"), "Save table", "btn-info")))) + hidden(downloadButton(ns("saveTable"), "Save table", "btn-info")), + uiOutput(ns("correlations")))) } #' Subset gene expression based on (full or partial) matching genes @@ -211,6 +207,8 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { # Calculate correlation betwenn GE and AS event(s) corrPerGene <- function(gene, ASevent, geneExpr, psi, ...) { + updateProgress("Performing correlation analysis", console=FALSE) + expr <- geneExpr[gene, ] exprNum <- as.numeric(expr) names(exprNum) <- colnames(expr) @@ -239,6 +237,9 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { return(res) } + updateProgress("Performing correlation analyses", + divisions=length(gene) * length(ASevents)) + res <- lapply(ASevents, function(ASevent) { gene <- rownames(geneExprSubset) corr <- lapply(gene, corrPerGene, ASevent, geneExprSubset, psi, ...) @@ -250,11 +251,10 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { return(res) } -#' Plot correlations -#' -#' Plot correlation results from \code{\link{correlateGEandAS}} +#' Display results of correlation analyses #' -#' @param corr List of correlations +#' @param corr \code{GEandAScorrelation} object (obtained after running +#' \code{\link{correlateGEandAS}}) #' @param loessSmooth Boolean: plot a smooth curve computed by #' \code{stats::loess.smooth}? #' @param autoZoom Boolean: automatically set the range of PSI values based on @@ -283,7 +283,7 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' @importFrom stats loess.smooth #' #' @export -#' @return Renders plots for each correlation in \code{corr} +#' @return Plots, summary tables or results of correlation analyses #' #' @examples #' annot <- readFile("ex_splicing_annotation.RDS") @@ -293,10 +293,17 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' geneExpr <- readFile("ex_gene_expression.RDS") #' corr <- correlateGEandAS(geneExpr, psi, "ALDOA") #' +#' # Quick display of the correlation results per splicing event and gene +#' print(corr) +#' +#' # Table summarising the correlation analysis results +#' as.table(corr) +#' +#' # Correlation analysis plots #' colourGroups <- list(Normal=paste("Normal", 1:3), #' Tumour=paste("Cancer", 1:3)) #' attr(colourGroups, "Colour") <- c(Normal="#00C65A", Tumour="#EEE273") -#' plotCorrelation(corr, colourGroups=colourGroups, alpha=1) +#' plot(corr, colourGroups=colourGroups, alpha=1) plotCorrelation <- function(corr, autoZoom=FALSE, loessSmooth=TRUE, loessFamily=c("gaussian", "symmetric"), colour="black", alpha=0.2, size=1.5, @@ -382,10 +389,13 @@ plotCorrelation <- function(corr, autoZoom=FALSE, loessSmooth=TRUE, } #' @rdname plotCorrelation +#' @export plot.GEandAScorrelation <- plotCorrelation -print.GEandAScorrelation <- function(object) { - for (item in object) { +#' @rdname plotCorrelation +#' @export +print.GEandAScorrelation <- function(corr) { + for (item in corr) { for (elem in item) { consoleWidth <- options("width") cat(paste(rep("=", consoleWidth), collapse=""), fill=TRUE) @@ -399,12 +409,57 @@ print.GEandAScorrelation <- function(object) { } } +#' @rdname plotCorrelation +#' @param pvalueAdjust Character: method used to adjust p-values (see Details) +#' +#' @details +#' The following methods for p-value adjustment are supported by using the +#' respective string in the \code{pvalueAdjust} argument: +#' \itemize{ +#' \item{\code{none}: do not adjust p-values} +#' \item{\code{BH}: Benjamini-Hochberg's method (false discovery rate)} +#' \item{\code{BY}: Benjamini-Yekutieli's method (false discovery rate)} +#' \item{\code{bonferroni}: Bonferroni correction (family-wise error rate)} +#' \item{\code{holm}: Holm's method (family-wise error rate)} +#' \item{\code{hochberg}: Hochberg's method (family-wise error rate)} +#' \item{\code{hommel}: Hommel's method (family-wise error rate)} +#' } +#' @export +as.table.GEandAScorrelation <- function (corr, pvalueAdjust="BH") { + prepareCol <- function(object, FUN) unlist(lapply(object, lapply, FUN)) + + gene <- prepareCol(corr, function(i) i[["gene"]]) + gene <- prepareCol(corr, function(i) i[["gene"]]) + eventID <- prepareCol(corr, function(i) i[["eventID"]]) + eventID <- gsub("_", " ", eventID, fixed=TRUE) + + estimate <- prepareCol(corr, function(i) i[["cor"]][["estimate"]][[1]]) + pvalue <- prepareCol(corr, function(i) i[["cor"]][["p.value"]]) + method <- prepareCol(corr, function(i) i[["cor"]][["method"]]) + qvalue <- p.adjust(pvalue, method=pvalueAdjust) + qvalueLabel <- sprintf("p-value (%s adjusted)", pvalueAdjust) + + data <- data.frame(eventID, gene, method, estimate, pvalue, qvalue) + if (length(unique(method)) > 1) { + statCols <- c("Method", "Statistical value") + } else { + data$method <- NULL + statCols <- unique(method) + } + colnames(data) <- c("Alternative splicing event", "Gene", statCols, + "p-value", qvalueLabel) + rownames(data) <- NULL + return(data) +} + #' @rdname appServer #' #' @importFrom shiny renderUI observeEvent isolate tagList tags #' @importFrom highcharter renderHighchart #' @importFrom shinyjs show hide toggle correlationServer <- function(input, output, session) { + selectGroupsServer(session, "ASevents", "ASevents") + selectGroupsServer(session, "genes", "Genes") selectGroupsServer(session, "groupFilter", "Samples") selectGroupsServer(session, "groupColour", "Samples") @@ -430,14 +485,6 @@ correlationServer <- function(input, output, session) { hide("colour", anim=TRUE) } }) - - # Update available gene choices depending on gene expression data loaded - # Reactive avoids updating if the input remains the same - updateGeneChoices <- reactive({ - geneExpr <- getGeneExpression()[[input$geneExpr]] - genes <- rownames(geneExpr) - updateSelectizeInput(session, "gene", choices=genes, server=TRUE) - }) # Update gene expression data observe({ @@ -448,76 +495,6 @@ correlationServer <- function(input, output, session) { } }) - # Update gene choices - observe({ - geneExpr <- getGeneExpression() - if ( !is.null(geneExpr) ) { - updateGeneChoices() - show("gene") - } else { - hide("gene") - } - }) - - # Update alternative splicing events - observe({ - psi <- getInclusionLevels() - if (!is.null(psi)) { - updateSelectizeInput( - session, "ASevents", - choices=c("Type to search for a splicing event..."="", - rownames(psi))) - } - }) - - # Update selected alternative splicing events based on selected gene - observeEvent(input$gene, { - geneExpr <- getGeneExpression()[[input$geneExpr]] - gene <- input$gene - ASevents <- isolate(input$ASevents) - psi <- getInclusionLevels() - - if (is.null(psi)) return(NULL) - - allEvents <- rownames(psi) - names(allEvents) <- parseSplicingEvent(allEvents, char=TRUE) - - if (!is.null(ASevents)) return(NULL) - - # Automatically change AS events to those of selected genes if no AS - # event has yet been selected - if (!is.null(geneExpr) && !is.null(gene) && !identical(gene, "")) { - - isTcgaStyle <- all(grepl("|", head(rownames(geneExpr)), fixed=TRUE)) - - query <- gene - if (isTcgaStyle) query <- strsplit(gene, "|", fixed=TRUE)[[1]][[1]] - - if ( !identical(query, "?") ) { - query <- sprintf("_%s|%s$|/%s/", query, query, query) - ASevents <- grep(query, allEvents, value=TRUE) - } else { - ASevents <- character(0) - } - - if (length(ASevents) == 0) { - choices <- c("No events found for the selected gene"="") - selected <- NULL - } else { - choices <- c("Select an alternative splicing event"="") - selected <- ASevents - } - - choices <- c(choices, allEvents) - updateSelectizeInput(session, "ASevents", choices=choices, - selected=selected, server=TRUE) - } else { - choices <- c("Select an alternative splicing event"="", allEvents) - updateSelectizeInput(session, "ASevents", choices=choices, - server=TRUE) - } - }) - # Plot correlation analyses plotShinyCorr <- reactive({ ns <- session$ns @@ -581,8 +558,8 @@ correlationServer <- function(input, output, session) { if ( length(cols) > 0 && height > 0 ) { height <- paste0(height, "px") tagList( - distributeByCol(ns("plot"), length(plots), cols, height), - hr()) + hr(), + distributeByCol(ns("plot"), length(plots), cols, height)) } }) @@ -593,26 +570,7 @@ correlationServer <- function(input, output, session) { displayCorrTable <- reactive({ corr <- getCorrelation() if (is.null(corr)) return(NULL) - - # Prepare table with correlation analyses - eventID <- unlist(lapply(corr, lapply, "[[", "eventID")) - gene <- unlist(lapply(corr, lapply, "[[", "gene")) - estimate <- unlist(lapply(corr, lapply, - function(i) i[["cor"]][["estimate"]][[1]])) - pvalue <- unlist(lapply(corr, lapply, - function(i) i[["cor"]][["p.value"]])) - method <- unlist(lapply(corr, lapply, - function(i) i[["cor"]][["method"]])) - qvalue <- p.adjust(pvalue) - - method <- unique(method) - if (length(method) != 1) - stop("Only one correlation method is currently supported.") - - data <- data.frame(gsub("_", " ", eventID, fixed=TRUE), - gene, estimate, pvalue, qvalue) - colnames(data) <- c("Alternative splicing event", "Protein", - method, "p-value", "p-value (BH adjusted)") + data <- as.table(corr) show("corTable") output$corTable <- renderDataTable( @@ -628,12 +586,16 @@ correlationServer <- function(input, output, session) { observeEvent(input$correlate, { ns <- session$ns - isolate({ geneExpr <- getGeneExpression()[[input$geneExpr]] psi <- getInclusionLevels() gene <- input$gene - ASevents <- input$ASevents + ASevents <- getSelectedGroups(input, "ASevents", "ASevents", + filter=rownames(psi)) + ASevents <- unlist(ASevents) + gene <- getSelectedGroups(input, "genes", "Genes", + filter=rownames(geneExpr)) + gene <- unlist(gene) method <- input$method alternative <- input$alternative }) @@ -673,7 +635,6 @@ correlationServer <- function(input, output, session) { correlateGEandAS(geneExpr, psi, gene, ASevents, method=method, alternative=alternative)) setCorrelation(corr) - plotShinyCorr() displayCorrTable() endProcess("correlate") }) diff --git a/R/analysis_survival.R b/R/analysis_survival.R index ba88f2e1..a509a778 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -66,7 +66,7 @@ survivalUI <- function(id) { sprintf("input[id='%s'] == '%s'", ns("modelTerms"), "formula"), textAreaInput( ns("formula"), "Formula with clinical attributes", - placeholder="Start typing for suggested clinical attributes"), + placeholder="Type to show attribute suggestions"), uiOutput(ns("formulaSuggestions")), helpText( "To analyse a series of attributes, separate each", diff --git a/R/app.R b/R/app.R index a8dfd7d3..be4d3bdf 100644 --- a/R/app.R +++ b/R/app.R @@ -359,16 +359,12 @@ psichomics <- function(..., reset=FALSE, testData=FALSE) { if (reset) devtools::load_all() if (testData) { - clinical <- readRDS("vignettes/BRCA_clinical.RDS") - geneExpr <- readRDS("vignettes/BRCA_geneExpr.RDS") - psi <- readRDS("vignettes/BRCA_psi.RDS") - sampleInfo <- parseTcgaSampleInfo(colnames(psi)) - data <- NULL - data[["Clinical data"]] <- clinical - data[["Gene expression"]] <- geneExpr - data[["Inclusion levels"]] <- psi - data[["Sample metadata"]] <- sampleInfo + data[["Clinical data"]] <- readRDS("vignettes/BRCA_clinical.RDS") + data[["Gene expression"]] <- readRDS("vignettes/BRCA_geneExpr.RDS") + data[["Inclusion levels"]] <- readRDS("vignettes/BRCA_psi.RDS") + data[["Sample metadata"]] <- parseTcgaSampleInfo(colnames( + data[["Inclusion levels"]])) setData(list("Test data"=data)) } diff --git a/R/globalAccess.R b/R/globalAccess.R index bd82763e..3eecde43 100644 --- a/R/globalAccess.R +++ b/R/globalAccess.R @@ -140,6 +140,69 @@ getGenes <- function() { return(genes) } +#' Get pre-created gene list +#' +#' @return List of genes +#' @export +#' +#' @examples +#' getGeneList() +getGeneList <- function() { + prepareCitation <- function(attr) { + if (length(attr$Author) == 1) + authors <- attr$Author[[1]] + else + authors <- paste(attr$Author[[1]], "et al.") + + title <- attr$`Article Title` + journal <- attr$Journal + year <- attr$Date + volume <- attr$Volume + issue <- attr$Issue + pages <- attr$Pages + + sprintf("%s (%s). %s. %s, %s(%s), %s", + authors, year, title, journal, volume, issue, pages) + } + + # Sebestyen et al. 2016 + rbps <- readFile("Sebestyen_et_al_2016.RDS") + rbpSF <- rbps$`RNA-binding proteins that are splicing factors` + rbpNonSF <- rbps$`RNA-binding proteins that are not splicing factors` + sebestyen2016 <- list( + "RNA-binding protein splicing factors"=rbpSF, + "RNA-binding proteins"=sort(c(rbpSF, rbpNonSF))) + attr(sebestyen2016, "citation") <- prepareCitation(attributes(rbps)) + + res <- list("Sebestyen et al. 2016"=sebestyen2016) + class(res) <- c("geneList", class(res)) + return(res) +} + +#' Print gene list +#' +#' @param object \code{geneList} +#' +#' @return Print available gene lists +print.geneList <- function(object) { + for (set in names(object)) { + cat(sprintf(set), fill=TRUE) + for (item in names(object[[set]])) { + ll <- object[[set]][[item]] + sample <- 4 + genes <- paste(head(ll, n=sample), collapse=", ") + if (length(ll) > sample) genes <- paste0(genes, ", ...") + cat(sprintf(" -> %s [%s genes]: %s", + item, length(ll), genes), fill=TRUE) + } + cat(fill=TRUE) + cat("Source:", attr(object[[set]], "citation"), fill=TRUE) + + consoleWidth <- options("width") + cat(paste(rep("=", consoleWidth), collapse=""), fill=TRUE) + } +} + #' @rdname getEvent getCategories <- reactive(names(getData())) diff --git a/R/groups.R b/R/groups.R index 1fe21b40..a7acc9a5 100644 --- a/R/groups.R +++ b/R/groups.R @@ -25,7 +25,7 @@ #' #' @return \code{selectGroupsUI}: Interface for group selection selectGroupsUI <- function ( - id, label, placeholder="Click 'Groups' to create or edit groups", + id, label, placeholder="Type to search for groups", noGroupsLabel=NULL, groupsLabel=NULL, maxItems=NULL, returnAllDataLabel=NULL, returnAllDataValue=FALSE) { @@ -33,10 +33,9 @@ selectGroupsUI <- function ( groupSelect <- selectizeInput( id, label, choices=NULL, multiple=TRUE, width="auto", options=list( plugins=list('remove_button', 'drag_drop'), maxItems=maxItems, - searchField=list("value", "label"), - placeholder=placeholder, render = I( - '{ option: renderGroupSelection, - item: renderGroupSelection }'))) + searchField=list("value", "label"), placeholder=placeholder, + render=I( + '{option: renderGroupSelection, item: renderGroupSelection}'))) if ( !is.null(label) ) { if ( is.null(noGroupsLabel) ) { @@ -104,8 +103,8 @@ selectGroupsServer <- function(session, id, type, preference=NULL) { # Disable selection and animate button when clicking disabled input groups <- list() disable(id) - onclick(id, runjs(paste0("$('#", ns(editId), - "').animateCss('rubberBand');"))) + onclick(id, runjs( + paste0("$('#", ns(editId), "').animateCss('rubberBand');"))) } else { enable(id) onclick(id, NULL) @@ -126,27 +125,31 @@ selectGroupsServer <- function(session, id, type, preference=NULL) { if (elem2 %in% colnames(groupTable)) elem2Number <- sapply(groupTable[ , elem2], length) - elem1 <- gsub("ASevents", "AS events", elem1) - if (!is.null(elem1Number) && !is.null(elem2Number)) - ns <- sprintf("%s %s, %s %s", elem1Number, elem1, elem2Number, - elem2) - else if (!is.null(elem1Number)) - ns <- sprintf("%s %s", elem1Number, elem1) - else if (!is.null(elem2Number)) - ns <- sprintf("%s %s", elem2Number, elem2) + ns1 <- ns2 <- NULL + if (!is.null(elem1Number)) { + elem1 <- gsub("ASevents", "AS events", elem1) + elem1 <- ifelse(elem1Number == 1, gsub(".$", "", elem1), elem1) + ns1 <- sprintf("%s %s", elem1Number, elem1) + } + if (!is.null(elem2Number)) { + elem2 <- ifelse(elem2Number == 1, gsub(".$", "", elem2), elem2) + ns2 <- sprintf("%s %s", elem2Number, elem2) + } + + if (!is.null(ns1) && !is.null(ns2)) { + ns <- paste(ns1, ns2, sep=", ") + } else if (!is.null(ns1)) { + ns <- ns1 + } else if (!is.null(ns2)) { + ns <- ns2 + } + names(groups) <- paste(ns, unlist(groupTable[ , "Colour"])) } - currentSelection <- isolate(input[[id]]) - if (is.null(currentSelection)) { - if (is.null(preference)) - selected <- groups - else - selected <- groups[groups %in% preference] - } else { - selected <- currentSelection[currentSelection %in% groups] - if (length(selected) == 0) selected <- groups - } + selected <- isolate(input[[id]]) + selected <- selected[selected %in% groups] + if ( is.null(selected) ) selected <- character() updateSelectizeInput(session, id, choices=groups, selected=selected) }) } @@ -180,17 +183,23 @@ groupManipulationInput <- function(id, type) { } cols <- c("No attributes available"="") - indexIdentifiersUI <- groupById(ns, id) + identifierUI <- groupById(ns, id) if (id %in% c("Patients", "Samples")) { navbarMenu( title, tabPanel("Attribute", groupByAttribute(ns, cols, id, example)), - tabPanel("Index/Identifier", indexIdentifiersUI), + tabPanel("Index/Identifier", identifierUI), "----", "Advanced options", tabPanel("Subset expression", groupByExpression(ns, id)), tabPanel("Regular expression", groupByGrep(ns, cols, id))) + } else if (id == "Genes") { + navbarMenu( + title, + tabPanel("Gene names", identifierUI), + tabPanel("Pre-made gene lists", + groupByPreMadeList(ns, getGeneList(), id))) } else { - tabPanel(title, indexIdentifiersUI) + tabPanel(title, identifierUI) } } @@ -470,14 +479,71 @@ groupByAttribute <- function(ns, cols, id, example) { helpText("Automatically create groups according to the unique values", "for the selected attribute.", example), selectizeInput(ns(paste0("groupAttribute", id)), "Select attribute", - width="auto", choices=cols, - options=list(lockOptgroupOrder=TRUE)), + width="auto", choices=cols, options=list( + lockOptgroupOrder=TRUE, + placeholder="Type to search attributes")), actionButton(ns(paste0("createGroupAttribute", id)), "Create groups", class ="btn-primary"), uiOutput(ns(paste0("previewGroups", id))) ) } +#' User interface to use pre-made groups +#' +#' @param ns Namespace function +#' @param data List: list of groups with elements +#' @param id Character: identifier +#' +#' @importFrom shiny helpText tags +#' +#' @return HTML elements +groupByPreMadeList <- function(ns, data, id) { + cols <- preparePreMadeGroupForSelection(data) + + tagList( + helpText("Load pre-made, literature-based lists of genes."), + selectizeInput(ns(paste0("groupAttribute", id)), "Select gene list", + width="auto", choices=cols, options=list( + lockOptgroupOrder=TRUE, placeholder="Gene list")), + tags$small(tags$b("Source:"), + helpText(textOutput(ns(paste0("geneListSource", id))))), + actionButton(ns(paste0("loadPreMadeGroup", id)), "Load as group", + class="btn-primary") + ) +} + +#' Prepare list of pre-made groups for a selectize element +#' +#' @param groups List of list of characters +#' +#' @return List +preparePreMadeGroupForSelection <- function(groups) { + res <- lapply(groups, names) + for (ns in names(res)) { + tmp <- res[[ns]] + res[[ns]] <- paste(ns, res[[ns]], sep="|||") + names(res[[ns]]) <- tmp + } + return(res) +} + +#' Select pre-made groups from a selected item +#' +#' @param group List of list of characters +#' @param selected Character: selected item +#' +#' @return Elements of selected item +selectPreMadeGroup <- function(groups, selected) { + selected <- strsplit(selected, "|||", fixed=TRUE)[[1]] + first <- selected[[1]] + second <- selected[[2]] + + res <- groups[[first]][[second]] + attr(res, "title") <- sprintf("%s (%s)", second, first) + attr(res, "citation") <- attr(groups[[first]], "citation") + return(res) +} + #' User interface to group by row #' #' @inheritParams groupByAttribute @@ -494,12 +560,13 @@ groupById <- function(ns, id) { ns(paste0("groupRows", id)), paste(sid, "indexes or identifiers"), choices=NULL, multiple=TRUE, width="auto", options=list( create=TRUE, createOnBlur=TRUE, # Allow to add new items - plugins=list('remove_button'), persist=FALSE)), + plugins=list('remove_button'), persist=FALSE, + placeholder="Type to search identifiers")), helpText("Example: ", tags$kbd("1:6, 8, 10:19"), "creates a group with", "items 1 to 6, 8 and 10 to 19. You can also input identifiers", "instead of indexes."), textInput(ns(paste0("groupNameRows", id)), "Group label", width="auto", - placeholder="Unnamed"), + placeholder="Unlabelled group"), actionButton(ns(paste0("createGroupRows", id)), "Create group", class="btn-primary") ) @@ -515,7 +582,7 @@ groupById <- function(ns, id) { groupByExpression <- function(ns, id) { tagList ( textInput(ns(paste0("groupExpression", id)), "Subset expression", - width="auto"), + width="auto", placeholder="Insert subset expression"), helpText( 'Examples: ', tags$ul( tags$li( @@ -537,7 +604,7 @@ groupByExpression <- function(ns, id) { ' (ignores case) in Z.'))), uiOutput(ns(paste0("groupExpressionSuggestions", id))), textInput(ns(paste0("groupNameSubset", id)), "Group label", - width="auto", placeholder="Unnamed"), + width="auto", placeholder="Unlabelled group"), actionButton(ns(paste0("createGroupSubset", id)), "Create group", class="btn-primary") ) @@ -553,38 +620,37 @@ groupByExpression <- function(ns, id) { groupByGrep <- function(ns, cols, id) { tagList ( textInput(ns(paste0("grepExpression", id)), "Regular expression", - width="auto"), + width="auto", placeholder="Insert regular expression"), selectizeInput(ns(paste0("grepColumn", id)), "Select attribute to GREP", - choices=cols, width="auto"), + choices=cols, width="auto", options=list( + placeholder="Type to search attributes")), textInput(ns(paste0("groupNameRegex", id)), "Group label", width="auto", - placeholder="Unnamed"), + placeholder="Unlabelled group"), actionButton(ns(paste0("createGroupRegex", id)), "Create group", class="btn-primary")) } #' Prepare to create group according to specific details -#' @param session Shiny session -#' @param input Shiny input +#' #' @param output Shiny output -#' @param id Character: identifier of the group selection -#' @param type Character: type of group to create +#' @inheritParams createGroupFromInput #' #' @return NULL (this function is used to modify the Shiny session's state) -createGroup <- function(session, input, output, id, type) { +createGroup <- function(session, input, output, id, type, selected=NULL, + expr=NULL, groupNames=NULL) { removeAlert(output, alertId="alert-side") - if (id == "Patients") + if (id == "Patients") { dataset <- getClinicalData() - else if (id == "Samples") + } else if (id == "Samples") { dataset <- getSampleInfo() - else + } else { dataset <- NULL + } - new <- createGroupFromInput(session, input, output, dataset, id, type) + new <- createGroupFromInput(session, input, dataset, id, type, selected, + expr, groupNames) if (!is.null(new)) appendNewGroups(id, new) - - updateSelectizeInput(session, paste0("groupAttribute", id), - selected=character()) } #' Assign colours to groups @@ -652,11 +718,10 @@ appendNewGroups <- function(type, new, clearOld=FALSE) { #' Match patients and samples in a group #' -#' @param id Character: identifier (\code{Patients} or \code{Samples}) -#' @param group Data frame: group containing either \code{Patients} or -#' \code{Samples} +#' @param id Character: identifier +#' @param group Data frame: group #' -#' @return Data frame with groups containing matching patients and samples +#' @return Data frame with groups containing matching elements matchGroupPatientsAndSamples <- function(id, group) { patients <- getPatientId() samples <- getSampleId() @@ -685,40 +750,71 @@ matchGroupPatientsAndSamples <- function(id, group) { return(group) } +#' Match AS events and genes in a group +#' +#' @inheritParams matchGroupPatientsAndSamples +#' +#' @return Data frame with groups containing matching elements +matchGroupASeventsAndGenes <- function(id, group, ASevents) { + # Match AS events with genes (or vice-versa) + if (!is.null(ASevents)) { + if (id == "ASevents") { + ASevents <- group[ , "ASevents"] + genes <- lapply(group[ , "ASevents"], parseSplicingEvent) + genes <- lapply(genes, "[[", "gene") + group <- cbind(group, "Genes"=lapply( + genes, function(i) unique(unlist(i)))) + } else if (id == "Genes") { + genes <- group[ , "Genes"] + ASeventGenes <- matchSplicingEventsWithGenes(ASevents) + filterBasedOnGenes <- function(gene, ASeventGenes) + ASeventGenes[names(ASeventGenes) %in% gene] + + # Process TCGA gene ID + genes <- lapply(genes, function(gene) gsub("\\|.*$", "", gene)) + ASevents <- lapply(genes, filterBasedOnGenes, ASeventGenes) + group <- cbind(group, ASevents) + group <- group[ , c(1:3, 5, 4), drop=FALSE] + } + } else if (id == "Genes") { + ASevents <- lapply(seq(nrow(group)), function(i) character(0)) + group <- cbind(group, ASevents) + group <- group[ , c(1:3, 5, 4), drop=FALSE] + } + return(group) +} + #' Set new groups according to the user input #' #' @param session Shiny session #' @param input Shiny input -#' @param output Shiny output #' @param dataset Data frame or matrix: dataset of interest #' @param id Character: identifier of the group selection #' @param type Character: type of group to create +#' @param selected Character: selected item +#' @param expr Character: expression +#' @param groupNames Character: group names #' #' @return Matrix with the group names and respective elements -createGroupFromInput <- function (session, input, output, dataset, id, type) { +createGroupFromInput <- function (session, input, dataset, id, type, + selected=NULL, expr=NULL, groupNames=NULL) { if (type == "Attribute") { - col <- input[[paste0("groupAttribute", id)]] - if (col == "") return(NULL) - group <- createGroupByAttribute(col, dataset) - group <- cbind(names(group), type, col, group) + if (selected == "") return(NULL) + group <- createGroupByAttribute(selected, dataset) + group <- cbind(names(group), type, selected, group) } else if (type == "Index/Identifier") { - rows <- input[[paste0("groupRows", id)]] - strRows <- paste(rows, collapse=", ") - + strRows <- paste(selected, collapse=", ") identifiers <- switch(id, "Patients"=getPatientId(), "Samples"=getSampleId(), "ASevents"=getASevents(), "Genes"=getGenes()) - allRows <- createGroupById(session, rows, identifiers) - group <- cbind(input[[paste0("groupNameRows", id)]], type, strRows, - list(allRows)) + allRows <- createGroupById(session, selected, identifiers) + group <- cbind(groupNames, type, strRows, list(allRows)) } else if (type == "Subset") { - # Subset dataset using the given expression - expr <- input[[paste0("groupExpression", id)]] # Test expression before running set <- tryCatch(subset(dataset, eval(parse(text=expr))), error=return) - # Show error to the user + # Display error if ("simpleError" %in% class(set)) { errorAlert(session, title="Error in the subset expression.", "Check if column names are correct.", br(), @@ -729,13 +825,10 @@ createGroupFromInput <- function (session, input, output, dataset, id, type) { rows <- match(rownames(set), rownames(dataset)) rows <- rownames(dataset)[rows] - group <- cbind(input[[paste0("groupNameSubset", id)]], type, expr, - list(rows)) + group <- cbind(groupNames, type, expr, list(rows)) } else if (type == "Regex") { # Subset dataset column using given regular expression - col <- input[[paste0("grepColumn", id)]] - colData <- as.character(dataset[[col]]) - expr <- input[[paste0("grepExpression", id)]] + colData <- as.character(dataset[[selected]]) # Test expression before running set <- tryCatch(grep(expr, colData), error=return) @@ -749,51 +842,31 @@ createGroupFromInput <- function (session, input, output, dataset, id, type) { } set <- rownames(dataset)[set] - strRows <- sprintf('"%s" in %s', expr, col) - group <- cbind(input[[paste0("groupNameRegex", id)]], "GREP", strRows, - list(set)) + strRows <- sprintf('"%s" in %s', expr, selected) + group <- cbind(groupNames, "GREP", strRows, list(set)) + } else if (type == "PreMadeList") { + group <- selectPreMadeGroup(getGeneList(), selected) + groupNames <- attr(group, "title") + selected <- gsub("|||", " ~ ", selected, fixed=TRUE) + group <- cbind(groupNames, type, selected, list(group)) } # Name group if empty - if (group[[1]] == "") group[[1]] <- "Unnamed" + if (group[[1]] == "") group[[1]] <- "Unlabelled group" # Standardise rows ns <- c("Names", "Subset", "Input", id) - if (is.matrix(group)) + if (is.matrix(group)) { colnames(group) <- ns - else + } else { names(group) <- ns + } rownames(group) <- NULL if (id %in% c("Patients", "Samples")) { group <- matchGroupPatientsAndSamples(id, group) } else if (id %in% c("ASevents", "Genes")) { - # Match AS events with genes (or vice-versa) - ASevents <- getASevents() - if (!is.null(ASevents)) { - if (id == "ASevents") { - ASevents <- group[ , "ASevents"] - genes <- lapply(group[ , "ASevents"], parseSplicingEvent) - genes <- lapply(genes, "[[", "gene") - uniqueUnlist <- function(i) unique(unlist(i)) - group <- cbind(group, "Genes"=lapply(genes, uniqueUnlist)) - } else if (id == "Genes") { - genes <- group[ , "Genes"] - ASeventGenes <- matchSplicingEventsWithGenes(ASevents) - filterBasedOnGenes <- function(gene, ASeventGenes) - ASeventGenes[names(ASeventGenes) %in% gene] - - # Process TCGA gene ID - genes <- lapply(genes, function(gene) gsub("\\|.*$", "", gene)) - ASevents <- lapply(genes, filterBasedOnGenes, ASeventGenes) - group <- cbind(group, ASevents) - group <- group[ , c(1:3, 5, 4), drop=FALSE] - } - } else if (id == "Genes") { - ASevents <- lapply(seq(nrow(group)), function(i) character(0)) - group <- cbind(group, ASevents) - group <- group[ , c(1:3, 5, 4), drop=FALSE] - } + group <- matchGroupASeventsAndGenes(id, group, getASevents()) } return(group) } @@ -1186,17 +1259,16 @@ groupManipulation <- function(input, output, session, type) { if (!is.null(suggestedCols)) { suggestedIndex <- match(suggestedCols, attrs) suggestedIndex <- suggestedIndex[!is.na(suggestedIndex)] - cols <- list("Start typing to search for attributes"="", - "Suggested attributes"=attrs[suggestedIndex], + cols <- list("Suggested attributes"=attrs[suggestedIndex], "Other attributes"=attrs[-suggestedIndex]) } else { - cols <- c("Start typing to search for attributes"="", attrs) + cols <- attrs } updateSelectizeInput(session, paste0("groupAttribute", id), - choices=cols) + choices=cols, selected=character()) updateSelectizeInput(session, paste0("grepColumn", id), - choices=cols) + choices=cols, selected=character()) } observe(updateAttributes("Samples")) @@ -1218,26 +1290,57 @@ groupManipulation <- function(input, output, session, type) { } }) - # Create new group(s) createGroupOptions <- function(id, hasAttributes=TRUE) { - collapse <- "groupCollapse" - panel <- "Data groups" + clearSelection <- function(session, element) { + updateSelectizeInput(session, element, selected=character()) + } + # Group based on index or identifiers ---------------------------------- observeEvent(input[[paste0("createGroupRows", id)]], { - createGroup(session, input, output, id, type="Index/Identifier") - updateCollapse(session, collapse, open=panel) + isolate({ + selected <- input[[paste0("groupRows", id)]] + groupNames <- input[[paste0("groupNameRows", id)]] + }) + createGroup(session, input, output, id, type="Index/Identifier", + selected=selected, groupNames=groupNames) + clearSelection(session, paste0("groupRows", id)) + clearSelection(session, paste0("groupNameRows", id)) }) + # Remaining code is unneeded unless attributes are available if (!hasAttributes) return(NULL) + # Group by attribute --------------------------------------------------- observeEvent(input[[paste0("createGroupAttribute", id)]], { - createGroup(session, input, output, id, type="Attribute") - updateCollapse(session, collapse, open=panel) + selected <- isolate(input[[paste0("groupAttribute", id)]]) + createGroup(session, input, output, id, type="Attribute", + selected=selected) + clearSelection(session, paste0("groupAttribute", id)) }) + # Pre-made list of genes ----------------------------------------------- + observeEvent(input[[paste0("loadPreMadeGroup", id)]], { + selected <- isolate(input$groupAttributeGenes) + createGroup(session, input, output, id, type="PreMadeList", + selected=selected) + }) + + output[[paste0("geneListSource", id)]] <- renderText({ + selected <- input$groupAttributeGenes + group <- selectPreMadeGroup(getGeneList(), selected) + return(attr(group, "citation")) + }) + + # Group subset --------------------------------------------------------- observeEvent(input[[paste0("createGroupSubset", id)]], { - createGroup(session, input, output, id, type="Subset") - updateCollapse(session, collapse, open=panel) + isolate({ + expr <- input[[paste0("groupExpression", id)]] + groupNames <- input[[paste0("groupNameSubset", id)]] + }) + createGroup(session, input, output, id, type="Subset", + expr=expr, groupNames=groupNames) + clearSelection(session, paste0("groupExpression", id)) + clearSelection(session, paste0("groupNameSubset", id)) }) # Update available attributes to suggest in the subset expression @@ -1250,12 +1353,21 @@ groupManipulation <- function(input, output, session, type) { textSuggestions(ns(paste0("groupExpression", id)), attrs) }) + # Group based on regular expression ------------------------------------ observeEvent(input[[paste0("createGroupRegex", id)]], { - createGroup(session, input, output, id, type="Regex") - updateCollapse(session, collapse, open=panel) + isolate({ + selected <- input[[paste0("grepColumn", id)]] + expr <- input[[paste0("groupExpression", id)]] + groupNames <- input[[paste0("groupNameSubset", id)]] + }) + createGroup(session, input, output, id, type="Regex", + selected=selected, expr=expr, groupNames=groupNames) + clearSelection(session, paste0("groupNameRegex", id)) + clearSelection(session, paste0("groupNameRegex", id)) + clearSelection(session, paste0("groupNameRegex", id)) }) - # Preview group creation + # Preview groups to be created output[[paste0("previewGroups", id)]] <- renderUI({ col <- input[[paste0("groupAttribute", id)]] if (is.null(col) || col == "") return(NULL) @@ -1290,7 +1402,7 @@ groupManipulation <- function(input, output, session, type) { groupsToPreview, totalGroups)) } - tagList(tags$hr(), tags$label("Group preview"), + tagList(tags$hr(), tags$label("Groups to be created"), table2html(table, rownames=FALSE, style="margin-bottom: 0;", class="table table-condensed table-striped", thead=TRUE), @@ -1324,40 +1436,11 @@ groupManipulation <- function(input, output, session, type) { mf <- matrix(ncol=5, dimnames=list(NA, cols)) return(mf[-1, ]) }, style="bootstrap", escape=FALSE, server=TRUE, rownames=FALSE, - options=list( - pageLength=10, lengthChange=FALSE, scrollX=TRUE, ordering=FALSE, - columnDefs = list( - list(orderable=FALSE, className='details-control', targets=0)), - language=list(zeroRecords="No groups available to display")), - callback = JS( - "var plus = '';", - "var minus = '';", - "var cols = table.columns()[0].slice(-2);", - "table.columns(cols).visible(false, false);", - "table.columns.adjust().draw(false);", - "var format = function(d) { - return ''+ - ''+ - ''+ - ''+ - ''+ - ''+ - ''+ - ''+ - ''+ - '
Subset:'+ d[d.length - 2] +'
Input:' + d[d.length - 1] + '
'; -};", - "table.on('click', 'td.details-control', function() { - var td = $(this), - row = table.row(td.closest('tr')); - if (row.child.isShown()) { - row.child.hide(); - td.html(plus); - } else { - row.child( format(row.data()), 'no-padding' ).show(); - td.html(minus); - } - });")) + callback=JS("renderGroupTable(table);"), + options=list(pageLength=10, lengthChange=FALSE, scrollX=TRUE, + ordering=FALSE, columnDefs = list(list( + orderable=FALSE, className='details-control', targets=0)), + language=list(zeroRecords="No groups available to display"))) # Remove selected groups removeId <- "removeGroups" @@ -1880,6 +1963,30 @@ groupsServerOnce <- function(input, output, session) { } }) + # Create groups based on pre-made list of genes when loading gene or + # splicing data + observe({ + geneExp <- getGeneExpression() + psi <- getInclusionLevels() + + if (!is.null(geneExp) || !is.null(psi)) { + groups <- unlist(getGeneList(), recursive=F) + groupNames <- unlist(lapply(getGeneList(), names)) + selected <- unlist(lapply(names(getGeneList()), function(i) + paste(i, names(getGeneList()[[i]]), sep=" ~ "))) + groups <- cbind(groupNames, "PreMadeList", selected, groups) + + # Standardise rows + ns <- c("Names", "Subset", "Input", "Genes") + colnames(groups) <- ns + rownames(groups) <- NULL + groups <- matchGroupASeventsAndGenes("Genes", groups, getASevents()) + + if (!is.null(groups)) + isolate( appendNewGroups("Genes", groups, clearOld=TRUE) ) + } + }) + # Create groups by sample types when loading TCGA data observe({ sampleInfo <- getSampleInfo() diff --git a/inst/extdata/Sebestyen_et_al_2016.RDS b/inst/extdata/Sebestyen_et_al_2016.RDS new file mode 100644 index 0000000000000000000000000000000000000000..8f1e8522bf9597a9814de4d527872c3fd29ac381 GIT binary patch literal 5317 zcmV;$6gul4iwFP!000001AUxJb0jx%$GPfe_sI5oH)6wgegVl{uYTMXg?dg`RYL%p zZ1Tn(Q6t(EsUSJ)(8>EvHhi*u@WG!!-^*d3nw|Lv9brXiCV!oHWTEg#Bv5nso3pdC zug)gt?$3!A|1k2|+3(%||9&<-``Z0I6_Kpo zoJ^H@gb*Vn2&X)=Lfi;-$}}rGaoL3w2b2UvHJ8KgKsA>}s{qK1^2+FwW?JXUB%qwZ}?72&E$Hx z&P^0z93pkVZR0w{$*8U!;+^xk8zDwGC7br9rBuW2QUpM~#Jxl%qkxit z(tt9gfr?ZTdZC9Hfh<=_Q(beVRh2G8h&d&-Sfb?;C*N(`(<5rpU7rlndBub6NO3@9 zh0gnEfe;~NoXJ6ssue(tCB!iTRurcQ8N!;LBJVLvvPRfIDl98Sqf@Lu#ahxO0zN>R zL&+J)OOP=G_eKW>tEVpPvmBuP4%AQQj;HtW}l*Y$JpiAz{#cgb*VH$)IR9dp5!%pimcM zwg3`@p!5u3iLgRgBW$RNt_P`Gnxd@GMSh~GZMl)1%rlhLA{GeL@$BAGs(mcz(dQ%Z zGU}0r{}tt#UgrmtX}I6Wq~VquiORZ>n%@8HW~i1l+-5gg4D1`+XkL^@h|fl6X8PAt zl|tB4zdRSYB=e^t=jReq&}8eN9XOS=IVLJu^cEx z#hpYngV+*m+0_|=T4aRN8u~$WMH8**EzdnK`K3GD35GhNbwqUAydh7-`F*;exzxFV zDxv;yq@3v>cy{&_BdqArRN0V1mE0?YYBMrl?ebD4`8$^HxO&G8HRX4j>d+G2qvnn) zbW@jz-Lh5G_k@wOxK4#J{3@-=L_m_C+8&0ORSr%sWSWaQWtqo?lPQOn*%KRy+Ax>G z07xF%x$Jm2p69KUTsY7D(|o5`)`g`Ey5)C}8?t7aTb`TpeGwrfoa5T?Gu~W9AfHP5 zAfxE%`3K7L#>+Kx>^MDD@U@Im$5FO?_rr3@Is6ZC6!Iov&Kzf8!P4_8NgCv^q_CJ3UIjzaK(ni zBXcXn{ymVhGneuB8VD1wT?V-1Em@k=B0QJl`$_{$`Ry#na>?_SzHu`)!?$GwxyQDq z!6-$iSso6QOeoD$_PHA`67m@8@KOq1ETqhNyC7vDqXo^VBZkU24KP_@+BBdn3uuG1 z=FP98K((P+LQ0!}%v)q>mox{<0(LZxl2Ry2=uF~9br6?4zj>QF&bN)o!#npBBP5V+ zVE;gtxw;`$UGpYjCL77|f~k{Zkh#k=C2gXnvW2(OY8pN>2TjD4wx(d?+?vPj)omk? zV~`V&X^$kk!BDwQqae4HBoFL1$zfpIhn?jyx$B~o7X`V~JFr*{B?KS0TZ$5)bq5z-WFiYZFA(hOU2-JME90~mI9oD3E_;NIrJqKZ3;9R_wj zJmu_U$}1UV0K6mf5NLQJJK(%FEd*^;ovaPZHxbA&$dLYq`b?2ir<)bhEu*w2DP+MS z`DI1HF(NN75LO6lfEbg-SOD)oJ){U&T8yP7SOD!gM>qhan2a}_9+n7LPr88z%|Mai z6J%I&h9zhC1X)nP5=vfD%a#-oDr%|O^DmkMcM%UufOrFtED&OZ1Obaqu;>Jf=KZ__ z=x)tn4KhvGMJqS}c3!l_j(bzv+lV})qUC*ev1Ny`=%sAbu!wH|BXY znwF9>PRoKOkx5xn_@HzSIPXe4)s&;;nWn7lo|lla<&C$O1$BE*r-^IsAQsygQpPe0 zDAXlLCP>Mix1&TLNJy8+4pjw0iBKan2ptp$E6PZ5KnY}{_|OO?rYk8-Jkk)hU0R0} zR8a?2G|>DRC^7+gGJ!3{5xKGxlHXrnbH5mN{Q4CHYf8;wiAkxscHPoQDtRrPmKGlD zurnOHJklai#sQ@PEd$z+4L2vR^Ft;2Xu)x+x#yUpqeqm832kL(4q*@NC|x3D3#83D zBx=ygEqVfh0yUK|11pT(vKXE_VosghiM(B{a&3sF6@*x-LK#Zc zs)#*-Y6}5p5412>-5@}wL0xs%SCS4HX4O#0L~1Jisrgu@DGx2Z>JLq8tXpaGcP!s=@s7)oX_}ri9P4g6@ePfprlUyc ztm*5Rk8vFF*{g>bA%RTNplS$!)`n(x$f?6O+Bp~$PH9XLt#W!vj@4!%L=-X{XnN*o zszX8ht0UzB(G2A&Ls%iK5jFtO3`P|QB?2v%^TrAbUA);}al*E0*?o0DU3>&O&1v}< z-OIGdwS8|{R`5G-=G(y<>Tj*uQOKq>?gjHy(3)#%Q$32r!aq4i;jK8k?0L|wWU@ZkBDjg=sHCX zO^3E=f9lGlA*SSsqDa%uun*N4KD_cW&3zu|$n8iuWQsvfKu$rsGw1Te`II_{A;FJg6EqKTgBm(ED;Do2&wlr4eBT(Gm z=`8mVpPRJ1#wV8 z9Hv|aw8kO>OOha45@bsPO9GSAz>+kuBn^s8gX+?-l;FWR7~*LIDigG&iQ<6LfM_Zo zX)RG1w3vyLfP!KuYJa3vKx?FA5l~PA$4xv1utI=#wmX_lded?bwG{R^?`^5cBk65Z z86FF^tsoC?6?>~F&OPt1bLa8#IJ+((({;lwf4z&~n$GnuL*Q9#a7$FiAZbmS4t&ry z8wBiRj+Ambj=BuO@<1AL#rFix2fT?hz)hUVz>$PO?#P9i4aL5?q=|E=_~dS=i-Bd$ za>K_1UgkZ*(9-fY9k$e*PUhD!_|=JX^aa=5m+(9L@WW2V9YBJR0(8(0JDy!e;0E9E zGU4PU$SaW7keN?Ehg}b)_PYRL1gK-!v4TTlBS7s6vMY*hjsUipmK#;|5y)KOcRT*w zu=g{V{SW|mfxX<4$MIp<7dBc#KXe=eRV|ph@8M$E9wy^qZ+Ov}43`wQ91gsV-w8hH z-E~~j&h889`6}f#T8Ws>yywUJX&vJ>YT?qDP!w#KIdJ6%L~e@`ysK2`){PLe%5s#! zUu)x=anddE3o^q|&91+ad~e5r*|Mg9E2gTD1*CJdVrV%s=OIO)j-pB)`BTNW5S*gs zaiPi%Q}J28s`yHSYB>I>8V<)f1)UmARm-_3w2e|~f2AP&kCqox^5F;cA-1(J? zBn2itXxP{tY`N~IdAhxm^A4zGr4K0cc(-O8A5R5;zXkN{dR!1CfD zL*Un<-O{=ah)1uZ1XT%`;b<*F%!9N+F)6Bev*>AwK)X_<`8KdJIOmyOA{0DT7zG+D zivVH-F4`*SSC*D=r_g*vrS{d5oPV|FHOa|55$v@9IR}}0;vQzBJ-L5Vbp?awid_$# zGzEt>N22HOH-l+!t!X&9-#HF9)8ew^2-`?pfb;+G?kqdhBjl*Ud%01NX#)_WhL2+X zCEwusFP3J&p8f!!dc*c8Oy_SqBG4<)l7o(LadYAZ5EWG_xb33L19{qWU2l30f4m{r z+VZWinRc!!T|0Et!@B7|3`hXj>(IkK6;{xA)jP@eEi}8*6Rr48wBkwA$(&r(wEGV> zog)ZTMF=rMf|-&aQ;LuwtT59$$g}~7v0B=e&PV719a<3wR>WupbS~W4ju2#8BS1s) z?C#|S0@{;c6VcvnHUic|C*Y%sPou^Sw18?;kTZ~%Ag`d{6&AJX;PrR-XllU<=+SPC zf!C$*IZYHmgb*Vn2q^+IhXaACCBh0}jX*KY5x}4Gdum7+qpjGPOpNAX7cuzc2K$S_ z{$gTmVMiS%T!TGW5q3gmXLl!Ksn8`27_#RZT1QF(;^)+&<|#yD3&Ph| z8vS|?8A1*KeO0S9$ZV&Ena^|)FRa?|*DfP)m9YL!wS`HHZ+_2Rhg=BiII|IHv=~v5 znO>&G89#~0fed$lzaitB{chKz0Jwko?o9MD6M zj1I2(8l5Xl^X%~Tk=PwOs>8%tKy>kSBp!Jqu2C6tkk%u0MezRSX4_u!_3o+R!^FAi zWV96Ax}A(OzFI#>YWkZa!Cz?OERQhax?1LZ${TV3>a3Cg_Jkf@aV1z(d6hExb$r zB~HAc4fT<;5LW>vp*9WkrsTqpU-dw(TIHyMuHZ3)J9jZr}Eb}@pC73T^uae z04p|J(+8DK)|MW^@c1@Zhv91xQv;vc82n7uSg{X)UyyAvndU3X4)_q=*aNHqX3qz{ zW-mLw%whHr%k#j^yH_?^Hk?h_EFjYPq?btt#c22}%K@!_1}w(Xcod3H6sCc@t zqV71ZVsqL!JGq13*^jfircl|rl_gKR4&WY(l@+@a9x{d<&-Yexd)q=&pP$&076@DN z_0_4ZL{Ew;j}T(|6xaIOJ6uUcN0n1s^GAlZ*~tK6gajc)$PktYz{7|pA^l6NBTe^M3L(J;HtUb@0*6sXgp7KE3*^%h{ zYHCfz9l{J0Z*&U&(B1OQ@TuMB+}eA}JhfMpW^S)qW9eeo#2#oSbYjQH)+14A`<#~q zCv$*d1d1Z;bIFP_E+9|IkwFhU20aZ3JBEr~zz+HA@1*Vd zn?Ns9gY6AZCH^Yz0)Q_ld!W;-y>(-;L*h0YiCk+>8NwQXrxOn}%R4}sE{0r6>R4Af zOa@mRVxM2-MrwAKM&vvGSB0jrFm;fCA_-s#kfMezu>1U&YLy|Z0M_(0S8YyFtSigM zUI)P=yD3yX4kf1FYHJ$QWfZ` zP)E&lebtB(p+;yBPB$SYH}sw9>?XH4yPV@^xg75uF$pLOh&q_36jiIBkX4Qe*I1pn zgxX~zqj$IpFosGTCIKx2S_QNYhz8e91)(`dZbVW)b3|QpJ_3I^e?&UQy{Ra)b<^{Q zo+Bg(+3Jcr__(PKi$2Y9sd!Tuik$A)-6Wg{OSJj`}@bw7e7Bgz24nFzFfTi zc>8*B`+Rrt^7F&}C$IY9_S5Ur^UGVV`2WxK`1JaJbB4yu#Fy6}pPt{W`EYjj7ys+; z%g66seslMyyO-Bre*MqKx72@^-~Q?T_4dNJ0)Ko<`}g_XgG+JI-~amGw~x1{U&T+i z-~akwFBj_e^RNGLviEn@^X=oOyO&S57ya$)-P7C8f9UT&f4O_O5RaeTpX$p$aXG*H z_~rKT;_~+4)35*b{ORuDEyr)m@4wtWfB$q*{_=eL{+WI&o?q`jJ=|T```3rNw?{iE z|Fye){(Se1Gr=Wr^*sFYa{qGi^uxvHyT_-W{7>IsygDmiK0V+6{5t;f@Ot-r`+EQ6 zn)d$j;-@bUulGN@%&%X5a_xEX$cJS@xfBWNK|8jQxFGw^0`1Ix3S^DltepeqY)^{&=x6hw`e3xrd?AmuZ z{vld?8%2xgA3r~T8*Mh5By*U(@1E|BQTHShR!RKLDox+_p3A3)FF(C+;;-D;dsk-r X^77?\u25CF " + - escape(item.value) + " " + escape(description) + - ""; -} - /** * Change active tab to the Data panel and collapse data panels * @param {String} modal Identifier of the modal to close (optional) @@ -62,14 +51,62 @@ function showGroups(type) { $("a[data-value='Groups']")[0].click(); var mode; - if (type === "Samples") { + if (type === "Samples" | type === "Patients") { mode = 0; - } else if (type === "ASevents") { + } else if (type === "ASevents" || type === "Genes") { mode = 1; } $("#groupsTypeTab a")[mode].click(); } +/** + * Render group DataTable + * + * @param table DataTable + */ +function renderGroupTable(table) { + var getIcon = function(symbol) { + return ''; + }; + var plusIcon = getIcon("plus-circle"); + var minusIcon = getIcon("minus-circle"); + + var cols = table.columns()[0].slice(-2); + table.columns(cols).visible(false, false); + table.columns.adjust().draw(false); + + var format = function(data) { + return '' + '' + + '' + '' + '' + + '' + '' + '' + + '' + '
Subset:'+ data[data.length - 2] + '
Input:' + data[data.length - 1] + '
'; + }; + + table.on('click', 'td.details-control', function() { + var td = $(this), row = table.row(td.closest('tr')); + if (row.child.isShown()) { + // Hide extra information + row.child.hide(); + td.html(plusIcon); + } else { + // Show extra information + row.child( format(row.data()), 'no-padding' ).show(); + td.html(minusIcon); + } + }); +} + +/** + * Prepare interface for group selection + */ +function renderGroupSelection (item, escape) { + var description = item.label.split(" #")[0]; + var colour = "#" + item.label.split(" #")[1]; + return "
\u25CF " + + escape(item.value) + " " + escape(description) + + "
"; +} + /** * Change selected event * @param {String} event Alternative splicing event diff --git a/man/createGroup.Rd b/man/createGroup.Rd index 47b06b16..1c19fff8 100644 --- a/man/createGroup.Rd +++ b/man/createGroup.Rd @@ -4,7 +4,8 @@ \alias{createGroup} \title{Prepare to create group according to specific details} \usage{ -createGroup(session, input, output, id, type) +createGroup(session, input, output, id, type, selected = NULL, + expr = NULL, groupNames = NULL) } \arguments{ \item{session}{Shiny session} @@ -16,6 +17,12 @@ createGroup(session, input, output, id, type) \item{id}{Character: identifier of the group selection} \item{type}{Character: type of group to create} + +\item{selected}{Character: selected item} + +\item{expr}{Character: expression} + +\item{groupNames}{Character: group names} } \value{ NULL (this function is used to modify the Shiny session's state) diff --git a/man/createGroupFromInput.Rd b/man/createGroupFromInput.Rd index 7438dce9..ce7acbb5 100644 --- a/man/createGroupFromInput.Rd +++ b/man/createGroupFromInput.Rd @@ -4,20 +4,25 @@ \alias{createGroupFromInput} \title{Set new groups according to the user input} \usage{ -createGroupFromInput(session, input, output, dataset, id, type) +createGroupFromInput(session, input, dataset, id, type, selected = NULL, + expr = NULL, groupNames = NULL) } \arguments{ \item{session}{Shiny session} \item{input}{Shiny input} -\item{output}{Shiny output} - \item{dataset}{Data frame or matrix: dataset of interest} \item{id}{Character: identifier of the group selection} \item{type}{Character: type of group to create} + +\item{selected}{Character: selected item} + +\item{expr}{Character: expression} + +\item{groupNames}{Character: group names} } \value{ Matrix with the group names and respective elements diff --git a/man/getGeneList.Rd b/man/getGeneList.Rd new file mode 100644 index 00000000..485e8320 --- /dev/null +++ b/man/getGeneList.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/globalAccess.R +\name{getGeneList} +\alias{getGeneList} +\title{Get pre-created gene list} +\usage{ +getGeneList() +} +\value{ +List of genes +} +\description{ +Get pre-created gene list +} +\examples{ +getGeneList() +} diff --git a/man/groupByPreMadeList.Rd b/man/groupByPreMadeList.Rd new file mode 100644 index 00000000..7d15a25f --- /dev/null +++ b/man/groupByPreMadeList.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groups.R +\name{groupByPreMadeList} +\alias{groupByPreMadeList} +\title{User interface to use pre-made groups} +\usage{ +groupByPreMadeList(ns, data, id) +} +\arguments{ +\item{ns}{Namespace function} + +\item{data}{List: list of groups with elements} + +\item{id}{Character: identifier} +} +\value{ +HTML elements +} +\description{ +User interface to use pre-made groups +} diff --git a/man/matchGroupASeventsAndGenes.Rd b/man/matchGroupASeventsAndGenes.Rd new file mode 100644 index 00000000..66d01c90 --- /dev/null +++ b/man/matchGroupASeventsAndGenes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groups.R +\name{matchGroupASeventsAndGenes} +\alias{matchGroupASeventsAndGenes} +\title{Match AS events and genes in a group} +\usage{ +matchGroupASeventsAndGenes(id, group, ASevents) +} +\arguments{ +\item{id}{Character: identifier} + +\item{group}{Data frame: group} +} +\value{ +Data frame with groups containing matching elements +} +\description{ +Match AS events and genes in a group +} diff --git a/man/matchGroupPatientsAndSamples.Rd b/man/matchGroupPatientsAndSamples.Rd index f479159f..e05b3221 100644 --- a/man/matchGroupPatientsAndSamples.Rd +++ b/man/matchGroupPatientsAndSamples.Rd @@ -7,13 +7,12 @@ matchGroupPatientsAndSamples(id, group) } \arguments{ -\item{id}{Character: identifier (\code{Patients} or \code{Samples})} +\item{id}{Character: identifier} -\item{group}{Data frame: group containing either \code{Patients} or -\code{Samples}} +\item{group}{Data frame: group} } \value{ -Data frame with groups containing matching patients and samples +Data frame with groups containing matching elements } \description{ Match patients and samples in a group diff --git a/man/plotCorrelation.Rd b/man/plotCorrelation.Rd index 40539c94..df8ba44d 100644 --- a/man/plotCorrelation.Rd +++ b/man/plotCorrelation.Rd @@ -3,7 +3,9 @@ \name{plotCorrelation} \alias{plotCorrelation} \alias{plot.GEandAScorrelation} -\title{Plot correlations} +\alias{print.GEandAScorrelation} +\alias{as.table.GEandAScorrelation} +\title{Display results of correlation analyses} \usage{ plotCorrelation(corr, autoZoom = FALSE, loessSmooth = TRUE, loessFamily = c("gaussian", "symmetric"), colour = "black", @@ -18,9 +20,14 @@ plotCorrelation(corr, autoZoom = FALSE, loessSmooth = TRUE, loessAlpha = 1, loessWidth = 0.5, fontSize = 12, ..., colourGroups = NULL, legend = FALSE, showAllData = TRUE, density = FALSE, densityColour = "blue", densityWidth = 0.5) + +\method{print}{GEandAScorrelation}(corr) + +\method{as.table}{GEandAScorrelation}(corr, pvalueAdjust = "BH") } \arguments{ -\item{corr}{List of correlations} +\item{corr}{\code{GEandAScorrelation} object (obtained after running +\code{\link{correlateGEandAS}})} \item{autoZoom}{Boolean: automatically set the range of PSI values based on available data? If \code{FALSE}, the axis relative to PSI values will range @@ -66,12 +73,27 @@ group (coloured based on the \code{colour} argument)} \item{densityColour}{Character: line colour of contours} \item{densityWidth}{Numeric: line width of contours} + +\item{pvalueAdjust}{Character: method used to adjust p-values (see Details)} } \value{ -Renders plots for each correlation in \code{corr} +Plots, summary tables or results of correlation analyses } \description{ -Plot correlation results from \code{\link{correlateGEandAS}} +Display results of correlation analyses +} +\details{ +The following methods for p-value adjustment are supported by using the +respective string in the \code{pvalueAdjust} argument: +\itemize{ + \item{\code{none}: do not adjust p-values} + \item{\code{BH}: Benjamini-Hochberg's method (false discovery rate)} + \item{\code{BY}: Benjamini-Yekutieli's method (false discovery rate)} + \item{\code{bonferroni}: Bonferroni correction (family-wise error rate)} + \item{\code{holm}: Holm's method (family-wise error rate)} + \item{\code{hochberg}: Hochberg's method (family-wise error rate)} + \item{\code{hommel}: Hommel's method (family-wise error rate)} +} } \examples{ annot <- readFile("ex_splicing_annotation.RDS") @@ -81,8 +103,15 @@ psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) geneExpr <- readFile("ex_gene_expression.RDS") corr <- correlateGEandAS(geneExpr, psi, "ALDOA") +# Quick display of the correlation results per splicing event and gene +print(corr) + +# Table summarising the correlation analysis results +as.table(corr) + +# Correlation analysis plots colourGroups <- list(Normal=paste("Normal", 1:3), Tumour=paste("Cancer", 1:3)) attr(colourGroups, "Colour") <- c(Normal="#00C65A", Tumour="#EEE273") -plotCorrelation(corr, colourGroups=colourGroups, alpha=1) +plot(corr, colourGroups=colourGroups, alpha=1) } diff --git a/man/preparePreMadeGroupForSelection.Rd b/man/preparePreMadeGroupForSelection.Rd new file mode 100644 index 00000000..e1498264 --- /dev/null +++ b/man/preparePreMadeGroupForSelection.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groups.R +\name{preparePreMadeGroupForSelection} +\alias{preparePreMadeGroupForSelection} +\title{Prepare list of pre-made groups for a selectize element} +\usage{ +preparePreMadeGroupForSelection(groups) +} +\arguments{ +\item{groups}{List of list of characters} +} +\value{ +List +} +\description{ +Prepare list of pre-made groups for a selectize element +} diff --git a/man/print.geneList.Rd b/man/print.geneList.Rd new file mode 100644 index 00000000..8abef9cf --- /dev/null +++ b/man/print.geneList.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/globalAccess.R +\name{print.geneList} +\alias{print.geneList} +\title{Print gene list} +\usage{ +\method{print}{geneList}(object) +} +\arguments{ +\item{object}{\code{geneList}} +} +\value{ +Print available gene lists +} +\description{ +Print gene list +} diff --git a/man/selectGroupsUI.Rd b/man/selectGroupsUI.Rd index d0767e51..02f80f23 100644 --- a/man/selectGroupsUI.Rd +++ b/man/selectGroupsUI.Rd @@ -6,8 +6,7 @@ \alias{getSelectedGroups} \title{Group selection} \usage{ -selectGroupsUI(id, label, - placeholder = "Click 'Groups' to create or edit groups", +selectGroupsUI(id, label, placeholder = "Type to search for groups", noGroupsLabel = NULL, groupsLabel = NULL, maxItems = NULL, returnAllDataLabel = NULL, returnAllDataValue = FALSE) diff --git a/man/selectPreMadeGroup.Rd b/man/selectPreMadeGroup.Rd new file mode 100644 index 00000000..fba74f94 --- /dev/null +++ b/man/selectPreMadeGroup.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groups.R +\name{selectPreMadeGroup} +\alias{selectPreMadeGroup} +\title{Select pre-made groups from a selected item} +\usage{ +selectPreMadeGroup(groups, selected) +} +\arguments{ +\item{selected}{Character: selected item} + +\item{group}{List of list of characters} +} +\value{ +Elements of selected item +} +\description{ +Select pre-made groups from a selected item +} From 950fead2c87b45eef1c57ba0ecc5221405648e07 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 5 Nov 2018 17:43:56 +0000 Subject: [PATCH 04/46] Change which AS event types are quantified by default --- NEWS | 4 ++++ R/data_inclusionLevels.R | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 1d1be6b7..8e9c0ab9 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,10 @@ value), p-value or q-value (visual interface) - Allow to display correlation results as a table (using the `as.table` function) +* Alternative splicing quantification: + - By default, quantify skipped exons, mutually exclusive exons, alternative + 3' and 5' splice sites, and alternative first and last exons; this default + option is now consistent across the visual and command-line interfaces) * Groups: - By default, load pre-made lists of genes when loading gene expression or loading/performing alternative splicing quantification diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index 6aac751f..357daefe 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -53,7 +53,8 @@ inclusionLevelsInterface <- function(ns) { "Alternative splicing junction quantification"), selectizeInput(ns("annotation"), choices=listAllAnnotations(), "Alternative splicing event annotation", width = "100%"), - selectizeInput(ns("eventType"), "Event type(s)", selected = "SE", + selectizeInput(ns("eventType"), "Event type(s)", + selected = c("SE", "MXE", "A5SS", "A3SS", "AFE", "ALE"), choices=eventTypes, multiple = TRUE, width = "100%", options=list(plugins=list("remove_button"))), numericInput(ns("minReads"), width = "100%", From e81cee95712934e4ba04b8100e7cee13d99874cb Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 6 Nov 2018 15:44:19 +0000 Subject: [PATCH 05/46] Decrease loading time after alternative splicing quantification --- NEWS | 4 ++- R/app.R | 96 +++++++++++++++++++++++++++------------------------------ 2 files changed, 48 insertions(+), 52 deletions(-) diff --git a/NEWS b/NEWS index 8e9c0ab9..3bb37bd8 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -# 1.6.3 (30 October, 2018) +# 1.6.3 (6 November, 2018) * Correlation analyses: - Allow to use groups of genes and alternative splicing events for @@ -8,6 +8,8 @@ value), p-value or q-value (visual interface) - Allow to display correlation results as a table (using the `as.table` function) +* Data: + - Decrease loading time after quantifying alternative splicing * Alternative splicing quantification: - By default, quantify skipped exons, mutually exclusive exons, alternative 3' and 5' splice sites, and alternative first and last exons; this default diff --git a/R/app.R b/R/app.R index be4d3bdf..4340579a 100644 --- a/R/app.R +++ b/R/app.R @@ -110,20 +110,16 @@ getUiFunctions <- function(ns, loader, ..., priority=NULL) { #' @return HTML element for a global selectize input globalSelectize <- function(id, placeholder) { elem <- paste0(id, "Elem") - hideElem <- paste0("$('#", id, "')[0].style.display = 'none';") + hideElem <- sprintf("$('#%s')[0].style.display = 'none';", id) - select <- selectizeInput( - elem, "", choices=NULL, - options=list( - onItemAdd=I(paste0("function(value, $item) {", hideElem, "}")), - onBlur=I(paste0("function() {", hideElem, "}")), - placeholder=placeholder), - width="auto") + select <- selectizeInput(elem, "", choices=NULL, width="auto", options=list( + onItemAdd=I(paste0("function(value, $item) {", hideElem, "}")), + onBlur=I(paste0("function() {", hideElem, "}")), + placeholder=placeholder)) select[[3]][[1]] <- NULL - select <- tagAppendAttributes( - select, id=id, - style=paste("width: 95%;", "position: absolute;", - "margin-top: 5px !important;", "display: none;")) + select <- tagAppendAttributes(select, id=id, style=paste( + "display: none;", + "width: 95%;", "position: absolute;", "margin-top: 5px !important;")) return(select) } @@ -138,8 +134,7 @@ navSelectize <- function(id, label, placeholder=label) { style="margin-top: 5px !important; margin-bottom: 0px !important;", globalSelectize(id, placeholder), tags$small(tags$b(label), tags$a( - "Change...", - onclick=paste0( + "Change...", onclick=paste0( '$("#', id, '")[0].style.display = "block";', '$("#', id, ' > div > select")[0].selectize.clear();', '$("#', id, ' > div > select")[0].selectize.focus();'))), @@ -271,43 +266,38 @@ appServer <- function(input, output, session) { getServerFunctions("app", priority=c("dataServer", "analysesServer")) browserHistory("nav", input, session) - # Update selectize input to show available categories - observe({ - data <- getData() - if (!is.null(data)) { - updateSelectizeInput(session, "selectizeCategoryElem", - choices=names(data)) - - # Set the category of the data - observeEvent(input$selectizeCategoryElem, - if (input$selectizeCategoryElem != "") - setCategory(input$selectizeCategoryElem)) + updateSelectizeChoices <- function(session, id, choices, server=FALSE) { + if (!is.null(choices)) { + selected <- choices[[1]] } else { - updateSelectizeInput(session, "selectizeCategoryElem", - choices=list(), selected=list()) + choices <- list() + selected <- list() } + updateSelectizeInput(session, id, choices=choices, selected=selected, + server=server) + } + + # Update available categories + observe(updateSelectizeChoices(session, "selectizeCategoryElem", + names(getData()), server=FALSE)) + + # Set data category + observeEvent(input$selectizeCategoryElem, { + selected <- input$selectizeCategoryElem + if (!is.null(selected) && selected != "") setCategory(selected) }) - # Update selectize event to show available events - observe({ - ASevents <- getASevents() - if (!is.null(ASevents)) { - updateSelectizeInput(session, "selectizeEventElem", - choices=ASevents) - - # Set the selected alternative splicing event - observeEvent(input$selectizeEventElem, - if (input$selectizeEventElem != "") - setEvent(input$selectizeEventElem)) - } else { - # Replace with empty list since NULLs are dropped - updateSelectizeInput(session, "selectizeEventElem", choices=list(), - selected=list()) - setEvent(NULL) - } + # Update available events + observe(updateSelectizeChoices(session, "selectizeEventElem", + getASevents(), server=TRUE)) + + # Set alternative splicing event + observeEvent(input[["selectizeEventElem"]], { + selected <- input[["selectizeEventElem"]] + if (!is.null(selected) && selected != "") setEvent(selected) }) - # Show the selected category + # Display selected category output$selectizeCategoryValue <- renderUI({ category <- getCategory() if (is.null(category)) @@ -318,15 +308,19 @@ appServer <- function(input, output, session) { return(category) }) - # Show the selected event + # Display selected event output$selectizeEventValue <- renderUI({ - event <- getEvent() - if (is.null(event)) + areEventsLoaded <- !is.null(getASevents()) + + selected <- getASevent() + isSelectionValid <- !is.null(selected) && selected != "" + + if (!areEventsLoaded) return("No events quantified") - else if (event == "") - return("No event selected") + else if (!isSelectionValid) + return("No event is selected") else - return(parseSplicingEvent(event, char=TRUE)) + return(parseSplicingEvent(selected, char=TRUE)) }) session$onSessionEnded(function() { From 09210d45c4a69f37355299acff1d074e3e3c2349 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 7 Nov 2018 11:21:38 +0000 Subject: [PATCH 06/46] Improve console logging of alerts --- NEWS | 1 + R/data_geNormalisationFiltering.R | 16 +++++++----- R/data_inclusionLevels.R | 25 +++++++++++-------- R/groups.R | 22 ++++++++++------- R/utils.R | 41 ++++++++++++++++++------------- man/showAlert.Rd | 16 +++++++----- 6 files changed, 73 insertions(+), 48 deletions(-) diff --git a/NEWS b/NEWS index 3bb37bd8..8f126d94 100644 --- a/NEWS +++ b/NEWS @@ -25,6 +25,7 @@ * Groups: - Minor improvements to the group creation interface +* Improve console logging of error and warning alerts # 1.6.2 (2 October, 2018) diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 2ecfea72..22660c6a 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -213,14 +213,18 @@ loadGeneExpressionSet <- function(session, input, output) { if (is(geneExpr, "error")) { if (geneExpr$message == paste("'file' must be a character string", "or connection")) - errorAlert(session, title="Error", "No file was provided", - alertId="alertGeneExpr") + errorAlert(session, title="No file provided", + "Please provide a file", alertId="alertGeneExpr", + caller="Gene expression normalisation and filtering") else - errorAlert(session, title="Error", - geneExpr$message, alertId="alertGeneExpr") + errorAlert(session, title="An error was raised", + geneExpr$message, alertId="alertGeneExpr", + caller="Gene expression normalisation and filtering", + caller="Gene expression normalisation and filtering") } else if (is(geneExpr, "warning")) { - warningAlert(session, title="Warning", - geneExpr$message, alertId="alertGeneExpr") + warningAlert(session, title="A warning was raised", + geneExpr$message, alertId="alertGeneExpr", + caller="Gene expression normalisation and filtering") } else { removeAlert(output, "alertGeneExpr") diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index 357daefe..85999e30 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -251,11 +251,13 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { observeEvent(input$loadCustom, { customAnnot <- input$customAnnot if (is.null(customAnnot)) { - errorAlert(session, title="No file provided.", - "Please select a RDS file.") + errorAlert(session, title="No file provided", + "Please select a RDS file.", + caller="Custom alternative splicing annotation") } else if (!grepl("\\.rds$", customAnnot$name, ignore.case=TRUE)) { - errorAlert(session, title="File format not allowed.", - "Please select a RDS file.") + errorAlert(session, title="File format not supported", + "Please select a RDS file.", + caller="Custom alternative splicing annotation") } else { custom <- customAnnot$datapath names(custom) <- sprintf("%s (%s, %s)", customAnnot$name, @@ -308,14 +310,17 @@ loadSplicingQuantificationSet <- function(session, input, output) { if (is(psi, "error")) { if (psi$message == paste("'file' must be a character string or", "connection")) - errorAlert(session, title="Error", "No file was provided", - alertId="alertIncLevels") + errorAlert(session, title="No file provided", + "Please provide a file.", alertId="alertIncLevels", + caller="Alternative splicing quantification") else - errorAlert(session, title="Error", - psi$message, alertId="alertIncLevels") + errorAlert(session, title="An error was raised", + psi$message, alertId="alertIncLevels", + caller="Alternative splicing quantification") } else if (is(psi, "warning")) { - warningAlert(session, title="Warning", - psi$message, alertId="alertIncLevels") + warningAlert(session, title="A warning was raised", + psi$message, alertId="alertIncLevels", + caller="Alternative splicing quantification") } else { removeAlert(output, "alertIncLevels") diff --git a/R/groups.R b/R/groups.R index a7acc9a5..0a49ab2c 100644 --- a/R/groups.R +++ b/R/groups.R @@ -816,10 +816,11 @@ createGroupFromInput <- function (session, input, dataset, id, type, # Display error if ("simpleError" %in% class(set)) { - errorAlert(session, title="Error in the subset expression.", + errorAlert(session, title="Issue with subset expression", "Check if column names are correct.", br(), "The following error was raised:", - tags$code(set$message), alertId="alert-side") + tags$code(set$message), alertId="alert-side", + caller="Data grouping") return(NULL) } @@ -835,9 +836,10 @@ createGroupFromInput <- function (session, input, dataset, id, type, # Show error to the user if ("simpleError" %in% class(set)) { - errorAlert(session, title="GREP expression error", + errorAlert(session, title="Issue with GREP expression", "The following error was raised:", br(), - tags$code(set$message), alertId="alert-side") + tags$code(set$message), alertId="alert-side", + caller="Data grouping") return(NULL) } @@ -942,9 +944,10 @@ createGroupById <- function(session, rows, identifiers) { invalid <- union(rows[!matched][!parsable], parsed[!valid]) if (length(invalid) > 0) { discarded <- paste(invalid, collapse=", ") - warningAlert( - session, "The following ", length(invalid), - " indexes or identifiers were discarded:", tags$code(discarded)) + warningAlert(session, title="Discarded values", sprintf( + "The following %s indexes or identifiers were discarded:", + length(invalid)), tags$code(discarded), + caller="Data grouping", alertId="alert-main") } rows <- identifiers[unique(union(match, parsed[valid]))] return(rows) @@ -1801,8 +1804,9 @@ groupManipulation <- function(input, output, session, type) { if (!is.null(imported) && !is(imported, "error")) appendNewGroups(type, imported) else - errorAlert(session, title="Error loading the file.", - imported$message, alertId="alert-main") + errorAlert(session, title="Groups file could not be loaded", + imported$message, alertId="alert-main", + caller="Data grouping") }) if (type == "Samples") { diff --git a/R/utils.R b/R/utils.R index edaec197..0ae7edbe 100644 --- a/R/utils.R +++ b/R/utils.R @@ -795,18 +795,18 @@ infoModal <- function(session, title, ..., size="small", footer=NULL, #' @param session Shiny session #' @param ... Arguments to render as elements of alert #' @param title Character: title of the alert (optional) -#' @param style Character: style of the alert ("alert-danger", "alert-warning" -#' or NULL) +#' @param style Character: style of the alert ("error", "warning" or NULL) #' @param dismissible Boolean: is the alert dismissible? TRUE by default #' @param alertId Character: alert identifier +#' @param iconName Character: FontAwesome icon name to appear with the title +#' @param caller Character: label to identify the module calling for the alert +#' (relevant for error and warning alerts) #' #' @seealso \code{\link{showModal}} #' @importFrom shiny span h3 renderUI div tagList #' @return NULL (this function is used to modify the Shiny session's state) -showAlert <- function(session, ..., title=NULL, style=NULL, dismissible=TRUE, - alertId="alert") { - ns <- session$ns - +showAlert <- function(session, ..., title, style=NULL, dismissible=TRUE, + alertId="alert", iconName=NULL, caller=NULL) { if (dismissible) { dismissible <- "alert-dismissible" dismiss <- tags$button(type="button", class="close", @@ -817,29 +817,36 @@ showAlert <- function(session, ..., title=NULL, style=NULL, dismissible=TRUE, dismiss <- NULL } - if (!is.null(title)) title <- h4(title) + # Log information + if (style == "info") style <- "Information" + msg <- sprintf("%s: %s", capitalize(style), title) + if (!is.null(caller)) msg <- sprintf('%s (in "%s")', msg, caller) + message(msg, "\n ", paste(lapply(args, format), collapse=" ")) + + style <- switch(style, "error"="alert-danger", "warning"="alert-warning") output <- session$output output[[alertId]] <- renderUI({ - tagList( - div(title, id="myAlert", class="alert", class=style, role="alert", - class="animated bounceInUp", class=dismissible, dismiss, ...) - ) + tagList(div(h4(icon(iconName), title), id="myAlert", class="alert", + class=style, role="alert", class="animated bounceInUp", + class=dismissible, dismiss, ...)) }) } #' @rdname showAlert errorAlert <- function(session, ..., title=NULL, dismissible=TRUE, - alertId="alert") { - showAlert(session, ..., style="alert-danger", title=title, - dismissible=dismissible, alertId=alertId) + alertId="alert", caller=NULL) { + showAlert(session, ..., style="error", title=title, + iconName="times-circle", dismissible=dismissible, + alertId=alertId, caller=caller) } #' @rdname showAlert warningAlert <- function(session, ..., title=NULL, dismissible=TRUE, - alertId="alert") { - showAlert(session, ..., style="alert-warning", title=title, - dismissible=dismissible, alertId=alertId) + alertId="alert", caller=NULL) { + showAlert(session, ..., style="warning", title=title, + iconName="exclamation-circle", dismissible=dismissible, + alertId=alertId, caller=caller) } #' @rdname showAlert diff --git a/man/showAlert.Rd b/man/showAlert.Rd index 8ab12461..0b6542eb 100644 --- a/man/showAlert.Rd +++ b/man/showAlert.Rd @@ -7,14 +7,14 @@ \alias{removeAlert} \title{Show or remove an alert} \usage{ -showAlert(session, ..., title = NULL, style = NULL, - dismissible = TRUE, alertId = "alert") +showAlert(session, ..., title, style = NULL, dismissible = TRUE, + alertId = "alert", iconName = NULL, caller = NULL) errorAlert(session, ..., title = NULL, dismissible = TRUE, - alertId = "alert") + alertId = "alert", caller = NULL) warningAlert(session, ..., title = NULL, dismissible = TRUE, - alertId = "alert") + alertId = "alert", caller = NULL) removeAlert(output, alertId = "alert") } @@ -25,13 +25,17 @@ removeAlert(output, alertId = "alert") \item{title}{Character: title of the alert (optional)} -\item{style}{Character: style of the alert ("alert-danger", "alert-warning" -or NULL)} +\item{style}{Character: style of the alert ("error", "warning" or NULL)} \item{dismissible}{Boolean: is the alert dismissible? TRUE by default} \item{alertId}{Character: alert identifier} +\item{iconName}{Character: FontAwesome icon name to appear with the title} + +\item{caller}{Character: label to identify the module calling for the alert +(relevant for error and warning alerts)} + \item{output}{Shiny output} } \value{ From 661a73a2bc12c54227a97c0003eccb022dfdab28 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 7 Nov 2018 11:24:40 +0000 Subject: [PATCH 07/46] Copy-edit tutorial on custom alternative splicing annotation preparation --- NEWS | 2 + vignettes/AS_events_preparation.Rmd | 61 ++++++++++++++++------------- 2 files changed, 36 insertions(+), 27 deletions(-) diff --git a/NEWS b/NEWS index 8f126d94..dcdfb08e 100644 --- a/NEWS +++ b/NEWS @@ -20,6 +20,8 @@ - Added pre-made list of genes that encode for RNA-binding proteins (Sebestyen et al. 2016), useful to postulate about splicing regulators based on gene expression and PSI correlation analyses +* Tutorials: + - Copy-edit tutorial on custom alternative splicing annotation preparation ## Bug fixes and minor changes diff --git a/vignettes/AS_events_preparation.Rmd b/vignettes/AS_events_preparation.Rmd index 439d5d9d..9fde36e4 100644 --- a/vignettes/AS_events_preparation.Rmd +++ b/vignettes/AS_events_preparation.Rmd @@ -3,7 +3,9 @@ title: 'Preparing an Alternative Splicing Annotation for psichomics' author: "Nuno Saraiva Agostinho" date: "`r Sys.Date()`" bibliography: refs.bib -output: rmarkdown::html_vignette +output: + rmarkdown::html_vignette: + toc: true vignette: > %\VignetteIndexEntry{Preparing alternative splicing annotations} %\VignetteEngine{knitr::rmarkdown} @@ -11,21 +13,19 @@ vignette: > --- --- - -psichomics currently quantifies alternative splicing based on an alternative -splicing annotation for Human (hg19). This annotation was created based on the + +# Creating custom alternative splicing annotation + +psichomics quantifies alternative splicing based on alternative splicing event annotations from [MISO][miso], [SUPPA][suppa], [VAST-TOOLS][vasttools] and -[rMATS][rmats]. - -The preparation of a new alternative splicing annotation for usage in psichomics -starts by parsing the alternative splicing events. Currently, events from -[SUPPA][suppa], [rMATS][rmats], [MISO][miso] and [VAST-TOOLS][vasttools] are -parsable. Support can be extended for alternative splicing events from other -programs. - -Also, start by loading the following packages: +[rMATS][rmats]. New alternative splicing annotation may be prepared and used in +psichomics by parsing alternative splicing events from those tools. Please +contact me if you would like to see support for other tools. -```{r, results='hide'} +This tutorial will guide you on how to parse alternative splicing events from +different tools. To do so, start by loading the following packages: + +```{r message=FALSE} library(psichomics) library(plyr) ``` @@ -33,7 +33,7 @@ library(plyr) ## SUPPA annotation [SUPPA][suppa] generates alternative splicing events based on a transcript annotation. Start by running SUPPA's `generateEvents` script with a transcript -file (GTF format) for all event types, if desired. See [SUPPA's page][suppa] for +file (GTF format) for all event types, if desired. See [SUPPA's page][suppa] for more information. The resulting output will include a directory containing tab-delimited files @@ -49,6 +49,8 @@ suppaFile <- tempfile(fileext=".RDS") ``` ```{r} +# suppaOutput <- "path/to/SUPPA/output" + # Replace `genome` for the string with the identifier before the first # underscore in the filenames of that directory (for instance, if one of your # filenames of interest is "hg19_A3.ioe", the string would be "hg19") @@ -75,6 +77,7 @@ matsFile <- tempfile("mats", fileext=".RDS") ``` ```{r} +# matsOutput <- "path/to/rMATS/output" mats <- parseMatsAnnotation( matsOutput, # Output directory from rMATS genome = "fromGTF", # Identifier of the filenames @@ -87,7 +90,7 @@ saveRDS(annot, file=matsFile) ## MISO annotation Simply retrieve [MISO's alternative splicing annotation][misoAnnot] and give the -path to the downlaoded folder as input. +path to the downloaded folder as input. ```{r, include=FALSE} misoAnnotation <- system.file("extdata/eventsAnnotSample/miso_annotation", @@ -96,6 +99,7 @@ misoFile <- tempfile("miso", fileext=".RDS") ``` ```{r} +# misoAnnotation <- "path/to/MISO/annotation" miso <- parseMisoAnnotation(misoAnnotation) annot <- prepareAnnotationFromEvents(miso) @@ -105,7 +109,7 @@ saveRDS(annot, file=misoFile) ## VAST-TOOLS annotation Simply retrieve [VAST-TOOLS's alternative splicing annotation][vastAnnot] and -give the path to the downlaoded folder as input. Note that, however, complex +give the path to the downloaded folder as input. Note that, however, complex events (i.e. alternative coordinates for the exon ends) are not yet parseable. ```{r, include=FALSE} @@ -115,7 +119,8 @@ vastFile <- tempfile("vast", fileext=".RDS") ``` ```{r} -vast <- parseVastToolsAnnotation(vastAnnotation) +# vastAnnotation <- "path/to/VASTDB/libs/TEMPLATES" +vast <- parseVastToolsAnnotation(vastAnnotation, genome="Hsa") annot <- prepareAnnotationFromEvents(vast) # vastFile <- "vast_AS_annotation_hg19.RDS" @@ -124,7 +129,7 @@ saveRDS(annot, file=vastFile) ## Combining annotation from different sources To combine the annotation from different sources, provide the parsed annotations -of interest simultasneously to the function `prepareAnnotationFromEvents`: +of interest simultaneously to the function `prepareAnnotationFromEvents`: ```{r, include=FALSE} annotFile <- tempfile(fileext=".RDS") @@ -143,12 +148,13 @@ annot <- prepareAnnotationFromEvents(suppa, vast, mats, miso) saveRDS(annot, file=annotFile) ``` -## Quantifying alternative splicing using the created annotation -The created alternative splicing annotation can then be used when quantifying -alternative splicing events. To do so, when using the GUI version of psichomics, -be sure to select the **Load annotation from file...** option, click the button -that appears below and select the recently created RDS file. Otherwise, if you -are using the CLI version, perform the following steps: +# Quantifying alternative splicing using the custom annotation +The created alternative splicing annotation can be used in psichomics for +alternative splicing quantification. To do so, when using the GUI version of +psichomics, be sure to select the **Load annotation from file...** option, click +the button that appears below and select the recently created RDS file. + +Otherwise, if you are using the CLI version, perform the following steps: ```{r} annot <- readRDS(annotFile) # "file" is the path to the annotation file @@ -166,11 +172,12 @@ this tutorial) is welcome. Please send any suggestions and comments to: > Nuno Saraiva-Agostinho (nunoagostinho@medicina.ulisboa.pt) > -> [Disease Transcriptomics Lab, Instituto de Medicina Molecular (Portugal)][iMM] +> [Disease Transcriptomics Lab, Instituto de Medicina Molecular (Portugal)][distrans] [suppa]: https://bitbucket.org/regulatorygenomicsupf/suppa [rmats]: http://rnaseq-mats.sourceforge.net [miso]: http://genes.mit.edu/burgelab/miso/ [vasttools]: https://github.com/vastgroup/vast-tools [misoAnnot]: https://miso.readthedocs.io/en/fastmiso/annotation.html -[vastAnnot]: http://vastdb.crg.eu/libs/ \ No newline at end of file +[vastAnnot]: http://vastdb.crg.eu/libs/ +[distrans]: http://imm.medicina.ulisboa.pt/group/distrans/ \ No newline at end of file From 65cc716dd58d1ea9a577e34d898c24b92308853a Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 7 Nov 2018 11:25:38 +0000 Subject: [PATCH 08/46] Ask before replacing correlation analyses --- R/analysis_correlation.R | 169 ++++++++++++++++++++++----------------- 1 file changed, 97 insertions(+), 72 deletions(-) diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index baffc6d8..25595e17 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -89,6 +89,7 @@ correlationUI <- function(id) { corrParams, scatterParams)) tagList( + uiOutput(ns("modal")), sidebar( errorDialog(paste("No alternative splicing quantification or gene", "expression data are available."), @@ -495,6 +496,102 @@ correlationServer <- function(input, output, session) { } }) + displayCorrTable <- reactive({ + corr <- getCorrelation() + if (is.null(corr)) return(NULL) + data <- as.table(corr) + + show("corTable") + output$corTable <- renderDataTable( + data, style="bootstrap", server=TRUE, rownames=FALSE, + selection="none", options=list(scrollX=TRUE)) + + show("saveTable") + output$saveTable <- downloadHandler( + filename=function() paste(getCategory(), "Correlations"), + content=function(con) + write.table(data, con, quote=FALSE, sep="\t", row.names=FALSE)) + }) + + performCorrelationAnalyses <- reactive({ + isolate({ + psi <- getInclusionLevels() + ASevents <- getSelectedGroups(input, "ASevents", "ASevents", + filter=rownames(psi)) + ASevents <- unlist(ASevents) + + geneExpr <- getGeneExpression()[[input$geneExpr]] + gene <- getSelectedGroups(input, "genes", "Genes", + filter=rownames(geneExpr)) + gene <- unlist(gene) + + method <- input$method + alternative <- input$alternative + }) + # Filter samples based on groups + groupFilter <- isolate(getSelectedGroups( + input, "groupFilter", "Samples", + filter=intersect(colnames(geneExpr), colnames(psi)))) + groupFilter <- unname(unlist(groupFilter)) + if (is.null(groupFilter)) groupFilter <- TRUE + geneExpr <- geneExpr[ , groupFilter, drop=FALSE] + psi <- psi[ , groupFilter, drop=FALSE] + + # Perform correlation analyses + startProcess("correlate") + corr <- suppressWarnings( + correlateGEandAS(geneExpr, psi, gene, ASevents, method=method, + alternative=alternative)) + setCorrelation(corr) + displayCorrTable() + endProcess("correlate") + }) + + observeEvent(input$correlate, { + ns <- session$ns + isolate({ + psi <- getInclusionLevels() + ASevents <- getSelectedGroups(input, "ASevents", "ASevents", + filter=rownames(psi)) + ASevents <- unlist(ASevents) + + geneExpr <- getGeneExpression()[[input$geneExpr]] + gene <- getSelectedGroups(input, "genes", "Genes", + filter=rownames(geneExpr)) + gene <- unlist(gene) + + cor <- getCorrelation() + }) + + if (is.null(psi)) { + missingDataModal(session, "Inclusion levels", + ns("missingInclusionLevels")) + } else if (is.null(geneExpr)) { + errorModal(session, "No gene expression selected", + "Please selected gene expression data", + caller="Correlation analysis") + } else if (is.null(gene) || identical(gene, "")) { + errorModal(session, "No gene selected", "Please select a gene", + caller="Correlation analysis") + } else if (is.null(ASevents) || identical(ASevents, "")) { + errorModal(session, "No alternative splicing event selected", + "Please select one or more alternative splicing events", + caller="Correlation analysis") + } else if (!is.null(cor)) { + warningModal(session, "Correlation analyses already performed", + "Do you wish to discard the current results?", + footer=actionButton(ns("replace"), "Discard", + class="btn-warning", + "data-dismiss"="modal"), + caller="Correlation analyses") + } else { + performCorrelationAnalyses() + } + }) + + # Replace previously performed differential analyses + observeEvent(input$replace, performCorrelationAnalyses()) + # Plot correlation analyses plotShinyCorr <- reactive({ ns <- session$ns @@ -567,78 +664,6 @@ correlationServer <- function(input, output, session) { output[[paste0("plot", i)]] <- renderPlot(plots[[i]])) }) - displayCorrTable <- reactive({ - corr <- getCorrelation() - if (is.null(corr)) return(NULL) - data <- as.table(corr) - - show("corTable") - output$corTable <- renderDataTable( - data, style="bootstrap", server=TRUE, rownames=FALSE, - selection="none", options=list(scrollX=TRUE)) - - show("saveTable") - output$saveTable <- downloadHandler( - filename=function() paste(getCategory(), "Correlations"), - content=function(con) - write.table(data, con, quote=FALSE, sep="\t", row.names=FALSE)) - }) - - observeEvent(input$correlate, { - ns <- session$ns - isolate({ - geneExpr <- getGeneExpression()[[input$geneExpr]] - psi <- getInclusionLevels() - gene <- input$gene - ASevents <- getSelectedGroups(input, "ASevents", "ASevents", - filter=rownames(psi)) - ASevents <- unlist(ASevents) - gene <- getSelectedGroups(input, "genes", "Genes", - filter=rownames(geneExpr)) - gene <- unlist(gene) - method <- input$method - alternative <- input$alternative - }) - - if (is.null(psi)) { - missingDataModal(session, "Inclusion levels", - ns("missingInclusionLevels")) - return(NULL) - } else if (is.null(geneExpr)) { - errorModal(session, "No gene expression selected", - "Please selected gene expression data", - caller="Correlation analysis") - return(NULL) - } else if (is.null(gene) || identical(gene, "")) { - errorModal(session, "No gene selected", "Please select a gene", - caller="Correlation analysis") - return(NULL) - } else if (is.null(ASevents) || identical(ASevents, "")) { - errorModal(session, "No alternative splicing event selected", - "Please select one or more alternative splicing events", - caller="Correlation analysis") - return(NULL) - } - - # Filter samples based on groups - groupFilter <- isolate(getSelectedGroups( - input, "groupFilter", "Samples", - filter=intersect(colnames(geneExpr), colnames(psi)))) - groupFilter <- unname(unlist(groupFilter)) - if (is.null(groupFilter)) groupFilter <- TRUE - geneExpr <- geneExpr[ , groupFilter, drop=FALSE] - psi <- psi[ , groupFilter, drop=FALSE] - - # Perform correlation analyses - startProcess("correlate") - corr <- suppressWarnings( - correlateGEandAS(geneExpr, psi, gene, ASevents, method=method, - alternative=alternative)) - setCorrelation(corr) - displayCorrTable() - endProcess("correlate") - }) - observeEvent(input$applyPlotStyle, { startProcess("applyPlotStyle") plotShinyCorr() From 23e38acd50866c16438a4dc6399173d98e52259b Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 7 Nov 2018 11:47:25 +0000 Subject: [PATCH 09/46] Minor improvements - Bump version number - Allow to show dataset icons in "Data" - Improve data grouping interface - Fix inconsistent group names when creating groups based on pre-made gene lists - Avoid error when user cancels file browser dialog to load groups from a file - Copy-editing code and documentation --- DESCRIPTION | 25 +++---- NEWS | 13 ++-- R/analysis_dimReduction_ica.R | 4 +- R/analysis_dimReduction_pca.R | 4 +- R/data.R | 40 ++++++----- R/data_geNormalisationFiltering.R | 35 +--------- R/data_inclusionLevels.R | 1 + R/groups.R | 66 ++++++++----------- R/utils.R | 25 +++---- inst/shiny/www/functions.js | 35 ++++++++++ man/survdiff.survTerms.Rd | 2 + man/tabDataset.Rd | 2 +- man/testSurvival.Rd | 2 + .../{custom-data.Rmd => custom_data.Rmd} | 0 14 files changed, 126 insertions(+), 128 deletions(-) rename vignettes/{custom-data.Rmd => custom_data.Rmd} (100%) diff --git a/DESCRIPTION b/DESCRIPTION index 5a697421..d2815955 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,17 +1,20 @@ Package: psichomics Title: Graphical Interface for Alternative Splicing Quantification, Analysis and Visualisation -Version: 1.6.2 +Version: 1.8.1 Encoding: UTF-8 -Authors@R: c( person("Nuno", "Saraiva-Agostinho", , - "nunodanielagostinho@gmail.com", role = c("aut", "cre")), - person(c("Nuno", "Luís"), "Barbosa-Morais", - role=c("aut", "led", "ths")), - person("André", "Falcão", role="ths"), person("Lina", - "Gallego Paez", role="ctb"), person("Marie", "Bordone", - role="ctb"), person("Teresa", "Maia", role="ctb"), - person("Mariana", "Ferreira", role="ctb"), person("Ana Carolina", - "Leote", role="ctb"), person("Bernardo", "de Almeida", role="ctb")) +Authors@R: c( + person("Nuno", "Saraiva-Agostinho", + email="nunodanielagostinho@gmail.com", role = c("aut", "cre")), + person(c("Nuno", "Luís"), "Barbosa-Morais", + role=c("aut", "led", "ths")), + person("André", "Falcão", role="ths"), + person("Lina", "Gallego Paez", role="ctb"), + person("Marie", "Bordone", role="ctb"), + person("Teresa", "Maia", role="ctb"), + person("Mariana", "Ferreira", role="ctb"), + person("Ana Carolina", "Leote", role="ctb"), + person("Bernardo", "de Almeida", role="ctb")) Description: Interactive R package with an intuitive Shiny-based graphical interface for alternative splicing quantification and integrative analyses of alternative splicing and gene expression based on The Cancer Genome Atlas @@ -28,7 +31,7 @@ Depends: shinyBS License: MIT + file LICENSE LazyData: true -RoxygenNote: 6.1.0 +RoxygenNote: 6.1.1 Imports: AnnotationHub, cluster, diff --git a/NEWS b/NEWS index dcdfb08e..9b208ede 100644 --- a/NEWS +++ b/NEWS @@ -1,13 +1,10 @@ -# 1.6.3 (6 November, 2018) +# 1.8.1 (7 November, 2018) * Correlation analyses: - - Allow to use groups of genes and alternative splicing events for - correlation analyses - - Display progress for correlation analyses - - Allow to sort results based on correlation estimate (or their absolute - value), p-value or q-value (visual interface) - - Allow to display correlation results as a table (using the `as.table` - function) + - Allow to use groups of genes and alternative splicing events + - Display progress + - Display correlation results in a table (in the command-line interface, use + the `as.table` function) * Data: - Decrease loading time after quantifying alternative splicing * Alternative splicing quantification: diff --git a/R/analysis_dimReduction_ica.R b/R/analysis_dimReduction_ica.R index 0f00e45c..7396ad4c 100644 --- a/R/analysis_dimReduction_ica.R +++ b/R/analysis_dimReduction_ica.R @@ -126,8 +126,8 @@ icaUI <- function(id) { icaOptions <- div( id=ns("icaOptions"), - selectizeInput(ns("dataForICA"), "Data to perform ICA on", width="100%", - choices=NULL, options=list( + selectizeInput(ns("dataForICA"), "Dataset to perform ICA on", + width="100%", choices=NULL, options=list( placeholder="No data available")), sliderInput(ns("componentNumber"), "Number of components", width="100%", value=5, min=2, max=10), diff --git a/R/analysis_dimReduction_pca.R b/R/analysis_dimReduction_pca.R index a2adde30..de676991 100644 --- a/R/analysis_dimReduction_pca.R +++ b/R/analysis_dimReduction_pca.R @@ -35,8 +35,8 @@ pcaUI <- function(id) { pcaOptions <- div( id=ns("pcaOptions"), - selectizeInput(ns("dataForPCA"), "Data to perform PCA on", width="100%", - choices=NULL, options=list( + selectizeInput(ns("dataForPCA"), "Dataset to perform PCA on", + width="100%", choices=NULL, options=list( placeholder="No data available")), checkboxGroupInput(ns("preprocess"), "Preprocessing", c("Center values"="center", "Scale values"="scale"), diff --git a/R/data.R b/R/data.R index 33208216..7b261b35 100644 --- a/R/data.R +++ b/R/data.R @@ -351,7 +351,7 @@ dataUI <- function(id, tab) { #' #' @return HTML elements tabDataset <- function(ns, title, tableId, columns, visCols, data, - description=NULL) { + description=NULL, icon=NULL) { tablename <- ns(paste("table", tableId, sep="-")) downloadId <- paste(tablename, "download", sep="-") @@ -388,15 +388,25 @@ tabDataset <- function(ns, title, tableId, columns, visCols, data, # role="progressbar", style="width:100%", # "Loading summary plots"))) - tabPanel(title, br(), download, br(), - bsCollapse( - open="Summary", - bsCollapsePanel( - tagList(icon("table"), "Data table"), value="Data table", - visibleColumns, hr(), dataTableOutput(tablename)), - bsCollapsePanel( - tagList(icon("pie-chart"), "Summary"), value="Summary", - multiHighchartsPlots))) + if (is.null(icon)) { + name <- title + } else { + colour <- switch(icon$colour, + "green"="progress-bar-success", + "blue"="progress-bar-info", + "orange"="progress-bar-warning", + "red"="progress-bar-danger") + name <- tags$div( + tags$span(class=paste("badge", colour), icon(icon$symbol)), title) + } + + tabPanel(title=name, value=title, br(), download, br(), bsCollapse( + open="Summary", + bsCollapsePanel(tagList(icon("table"), "Data table"), + value="Data table", visibleColumns, hr(), + dataTableOutput(tablename)), + bsCollapsePanel(tagList(icon("pie-chart"), "Summary"), value="Summary", + multiHighchartsPlots))) } #' Render a specific data tab (including data table and related interface) @@ -538,10 +548,9 @@ dataServer <- function(input, output, session) { category <- getCategory() dataTablesUI <- lapply( - seq_along(categoryData), - function(i) { + seq_along(categoryData), function(i) { data <- categoryData[[i]] - tabDataset(ns, names(categoryData)[i], + tabDataset(ns, names(categoryData)[i], icon=attr(data, "icon"), paste(category, i, sep="-"), names(data), attr(data, "show"), data, description=attr(data, "description")) @@ -551,16 +560,15 @@ dataServer <- function(input, output, session) { # Change the active dataset observe( setActiveDataset(input$datasetTab) ) - + # Match clinical data with sample information observe({ patients <- getPatientId() samples <- getSampleId() - sampleInfo <- getSampleInfo() if ( !is.null(patients) && !is.null(samples) ) { startProgress("Matching subjects to their samples...", 1) match <- getSubjectFromSample(samples, patients, - sampleInfo=sampleInfo) + sampleInfo=getSampleInfo()) setClinicalMatchFrom("Inclusion levels", match) closeProgress("Matching process concluded") } diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 22660c6a..67ee6506 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -59,39 +59,7 @@ geNormalisationFilteringInterface <- function(ns) { "Relative log expression (RLE)"="RLE", "Upper-quartile normalisation"="upperquartile", "No normalisation"="none"), - options = list(render = I( - '{ option: function(item, escape) { - var description; - switch(item.value) { - case "TMM": - description = "This method is recommended" + - " for most RNAseq data where more " + - "than half of the genes are believed " + - "not differentially expressed " + - "between any pair of the samples."; - break; - case "RLE": - description = "The median library is " + - "calculated from the geometric mean " + - "of all columns and the median ratio " + - "of each sample to the median library" + - " is taken as the scale factor."; - break; - case "upperquartile": - description = "The scale factors are " + - "calculated from a given quantile of " + - "the counts for each library, after " + - "removing genes with zero counts in " + - "all libraries."; - break; - case "none": - description = ""; - break; - } - return "
" + - escape(item.label) + - "
" + "" + description + - "
"; } }'))), + options=list(render=I('{ option: renderGEnormOptions }'))), conditionalPanel( sprintf("input[id='%s'] == '%s'", ns("normalisation"), "upperquartile"), @@ -471,6 +439,7 @@ geNormalisationFilteringServer <- function(input, output, session) { "Perform log2 transformation"=if (log2transform) "Yes" else "No", "Average count to add per observation"=priorCount)) attr(geneExprNorm, "settings") <- settings + attr(geneExprNorm, "icon") <- list(symbol="cogs", colour="green") setNormalisedGeneExpression(geneExprNorm) endProcess("processGeneExpr", time=time) diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index 85999e30..d0280e05 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -490,6 +490,7 @@ quantifySplicingSet <- function(session, input) { "Selected genes for splicing event quantification"=if (is.null( filter)) "All available genes" else filter) attr(psi, "settings") <- settings + attr(psi, "icon") <- list(symbol="calculator", colour="green") setInclusionLevels(psi) endProcess("calcIncLevels", time) diff --git a/R/groups.R b/R/groups.R index 0a49ab2c..fcc09049 100644 --- a/R/groups.R +++ b/R/groups.R @@ -246,15 +246,14 @@ groupManipulationInput <- function(id, type) { groupsUI <- function(id, tab) { ns <- NS(id) - tab(icon="object-group", title="Groups", - tabsetPanel( - id="groupsTypeTab", - tabPanel("Patient and sample groups", - groupManipulationInput(ns("sampleGroupModule"), - "Samples")), - tabPanel("Splicing event and gene groups", - groupManipulationInput(ns("ASeventGroupModule"), - "ASevents")))) + tab(icon="object-group", title="Groups", tabsetPanel( + id="groupsTypeTab", + tabPanel( + "Patient and sample groups", + groupManipulationInput(ns("sampleGroupModule"), "Samples")), + tabPanel( + "Splicing event and gene groups", + groupManipulationInput(ns("ASeventGroupModule"), "ASevents")))) } #' Render group interface @@ -311,31 +310,22 @@ renderGroupInterface <- function(ns, multiFisherTests=TRUE) { # Set operations complementLink <- operationLink( "Complement", id=ns(complementId), - helpText("Create a group with the elements outside the", - "selected group(s)"), - icon=setOperationIcon("complement-AB"), - disable=FALSE) + icon=setOperationIcon("complement-AB"), disable=FALSE) subtractLink <- operationLink( "Subtract elements from upper-selected group", - helpText("Create a group with the exclusive", - "elements from the upper-selected group"), - id=ns(subtractId), - icon=setOperationIcon("difference-AB")) + helpText("Select two groups for subtraction operations"), + id=ns(subtractId), icon=setOperationIcon("difference-AB")) subtract2Link <- operationLink( "Subtract elements from lower-selected group", - helpText("Create a group with the exclusive", - "elements from the lower-selected group"), - id=ns(subtract2Id), - icon=setOperationIcon("difference-BA")) + helpText("Select two groups for subtraction operations"), + id=ns(subtract2Id), icon=setOperationIcon("difference-BA")) symDiffLink <- operationLink( "Symmetric difference", - helpText("Create a group with the non-intersecting", - "elements of selected groups"), - id=ns(symDiffId), - icon=setOperationIcon("symmetric-difference")) + helpText("Select two or more groups for symmetric difference"), + id=ns(symDiffId), icon=setOperationIcon("symmetric-difference")) operations <- div( id=ns("setOperations"), class="btn-group", @@ -354,29 +344,24 @@ renderGroupInterface <- function(ns, multiFisherTests=TRUE) { # Save and load groups saveSelectedGroupsLink <- downloadContent( - icon("user"), class=NULL, - "Save elements from selected group(s)", - helpText("Export a file containing identifiers by select groups"), + icon("user"), class=NULL, "Save selected groups", id=ns(saveSelectedGroupsId)) saveAllGroupsLink <- downloadContent( - icon("users"), class=NULL, "Save elements from all groups", - helpText("Export a file containing identifiers by every group"), - id=ns(saveAllGroupsId), + icon("users"), class=NULL, "Save all groups", id=ns(saveAllGroupsId), disable=FALSE) loadGroupsLink <- operationLink( - "Load groups", - helpText("Import a file containing identifiers by group"), - id=ns(loadGroupsId), icon=icon("plus-circle"), disable=FALSE) + "Load groups", id=ns(loadGroupsId), icon=icon("plus-circle"), + disable=FALSE) saveLoadGroups <- tags$div( class="btn-group", role="group", - tags$button(icon("folder-open"), id=ns(saveLoadId), + tags$button("Save and load", icon("folder-open"), id=ns(saveLoadId), tags$span(class="caret"), class="btn btn-default dropdown-toggle", - "data-toggle"="dropdown", - "aria-haspopup"="true", "aria-expanded"="true"), + "data-toggle"="dropdown", "aria-haspopup"="true", + "aria-expanded"="true"), tags$ul(class="dropdown-menu dropdown-menu-right", saveSelectedGroupsLink, saveAllGroupsLink, tags$li(role="separator", class="divider"), loadGroupsLink)) @@ -1777,12 +1762,12 @@ groupManipulation <- function(input, output, session, type) { return(imported) } else { - stop(paste("The provided file does not seem to have group", - "information.")) + stop("File does not contain group data.") } } groupsFile <- fileBrowser() + if (is.na(groupsFile)) return(NULL) # Action cancelled by the user isolate({ if (type == "Samples") { @@ -1975,7 +1960,8 @@ groupsServerOnce <- function(input, output, session) { if (!is.null(geneExp) || !is.null(psi)) { groups <- unlist(getGeneList(), recursive=F) - groupNames <- unlist(lapply(getGeneList(), names)) + groupNames <- unlist(lapply(names(getGeneList()), function(i) + sprintf("%s (%s)", names(getGeneList()[[i]]), i))) selected <- unlist(lapply(names(getGeneList()), function(i) paste(i, names(getGeneList()[[i]]), sep=" ~ "))) groups <- cbind(groupNames, "PreMadeList", selected, groups) diff --git a/R/utils.R b/R/utils.R index 0ae7edbe..09f239de 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1413,19 +1413,15 @@ uniqueBy <- function(data, ...) { #' #' @return A \code{highcharts} object with an export button export_highcharts <- function(hc, fill="transparent", text="Export") { + createJSExport <- function(type) { + JS(paste0("function () { this.exportChart({ type: '", type, "' }); }")) + } + export <- list( - list(text="PNG image", - onclick=JS("function () { - this.exportChart({ type: 'image/png' }); }")), - list(text="JPEG image", - onclick=JS("function () { - this.exportChart({ type: 'image/jpeg' }); }")), - list(text="SVG vector image", - onclick=JS("function () { - this.exportChart({ type: 'image/svg+xml' }); }")), - list(text="PDF document", - onclick=JS("function () { - this.exportChart({ type: 'application/pdf' }); }")), + list(text="PNG image", onclick=createJSExport("image/png")), + list(text="JPEG image", onclick=createJSExport("image/jpeg")), + list(text="SVG vector image", onclick=createJSExport("image/svg+xml")), + list(text="PDF document", onclick=createJSExport("application/pdf")), list(separator=TRUE), list(text="CSV document", onclick=JS("function () { this.downloadCSV(); }")), @@ -1433,9 +1429,8 @@ export_highcharts <- function(hc, fill="transparent", text="Export") { onclick=JS("function () { this.downloadXLS(); }"))) hc_exporting(hc, enabled=TRUE, formAttributes=list(target="_blank"), - buttons=list(contextButton=list(text=text, - theme=list(fill=fill), - menuItems=export))) + buttons=list(contextButton=list(text=text, menuItems=export, + theme=list(fill=fill)))) } #' Create scatter plot diff --git a/inst/shiny/www/functions.js b/inst/shiny/www/functions.js index 7222e6d5..88b8e15d 100644 --- a/inst/shiny/www/functions.js +++ b/inst/shiny/www/functions.js @@ -124,6 +124,41 @@ function setTranscript (transcript) { .setValue(transcript); } +/** + * Render gene expression normalisation options + */ +function renderGEnormOptions (item, escape) { + var description; + switch(item.value) { + case "TMM": + description = "This method is recommended" + + " for most RNAseq data where more " + + "than half of the genes are believed " + + "not differentially expressed " + + "between any pair of the samples."; + break; + case "RLE": + description = "The median library is " + + "calculated from the geometric mean " + + "of all columns and the median ratio " + + "of each sample to the median library" + + " is taken as the scale factor."; + break; + case "upperquartile": + description = "The scale factors are " + + "calculated from a given quantile of " + + "the counts for each library, after " + + "removing genes with zero counts in " + + "all libraries."; + break; + case "none": + description = ""; + break; + } + return "
" + escape(item.label) + + "
" + "" + description + "
"; +} + /** * Navigate user to differential splicing of a given alternative splicing event * @param {String} event Alternative splicing event diff --git a/man/survdiff.survTerms.Rd b/man/survdiff.survTerms.Rd index 6e5b752d..addf6a72 100644 --- a/man/survdiff.survTerms.Rd +++ b/man/survdiff.survTerms.Rd @@ -26,6 +26,8 @@ subset argument has been used. Default is \code{options()$na.action}. \item{rho}{ a scalar parameter that controls the type of test. } + \item{timefix}{process times through the \code{aeqSurv} function to + eliminate potential roundoff issues.} }} } \value{ diff --git a/man/tabDataset.Rd b/man/tabDataset.Rd index 796f2843..955f0294 100644 --- a/man/tabDataset.Rd +++ b/man/tabDataset.Rd @@ -6,7 +6,7 @@ description} \usage{ tabDataset(ns, title, tableId, columns, visCols, data, - description = NULL) + description = NULL, icon = NULL) } \arguments{ \item{ns}{Namespace function} diff --git a/man/testSurvival.Rd b/man/testSurvival.Rd index 88ec3189..516e8e68 100644 --- a/man/testSurvival.Rd +++ b/man/testSurvival.Rd @@ -26,6 +26,8 @@ subset argument has been used. Default is \code{options()$na.action}. \item{rho}{ a scalar parameter that controls the type of test. } + \item{timefix}{process times through the \code{aeqSurv} function to + eliminate potential roundoff issues.} }} } \value{ diff --git a/vignettes/custom-data.Rmd b/vignettes/custom_data.Rmd similarity index 100% rename from vignettes/custom-data.Rmd rename to vignettes/custom_data.Rmd From 19fea9e64f53c3e0479b61db08adee359ced772d Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 7 Nov 2018 15:46:13 +0000 Subject: [PATCH 10/46] Improve documentation of exported and internal functions - Minor code copy-editing - Minor tutorial copy-editing --- NAMESPACE | 1 + NEWS | 3 + R/analysis.R | 823 ++++++++++--------- R/analysis_correlation.R | 26 +- R/analysis_diffExpression_table.R | 1 + R/analysis_diffSplicing_table.R | 7 +- R/analysis_dimReduction.R | 2 + R/analysis_dimReduction_ica.R | 6 +- R/analysis_dimReduction_pca.R | 19 +- R/analysis_information.R | 100 ++- R/analysis_survival.R | 2 + R/app.R | 22 +- R/data.R | 12 +- R/data_firebrowse.R | 94 +-- R/data_geNormalisationFiltering.R | 9 +- R/data_gtex.R | 5 +- R/data_inclusionLevels.R | 19 +- R/data_local.R | 5 +- R/data_recount.R | 1 + R/events.R | 11 + R/events_mats.R | 4 + R/events_miso.R | 10 +- R/events_suppa.R | 3 + R/events_vastTools.R | 4 + R/formats.R | 9 +- R/globalAccess.R | 106 ++- R/groups.R | 54 +- R/utils.R | 300 ++++--- man/ASquantFileInput.Rd | 1 + man/addObjectAttrs.Rd | 1 + man/addTCGAdata.Rd | 1 + man/analysesPlotSet.Rd | 32 - man/analysesTableSet.Rd | 25 +- man/appServer.Rd | 1 + man/appUI.Rd | 1 + man/appendNewGroups.Rd | 1 + man/areSplicingEvents.Rd | 3 +- man/articleUI.Rd | 1 + man/assignColours.Rd | 1 + man/basicStats.Rd | 1 + man/blendColours.Rd | 1 + man/browserHistory.Rd | 1 + man/bsModal2.Rd | 1 + man/calculateInclusionLevels.Rd | 1 + man/checkFileFormat.Rd | 1 + man/checkFirebrowse.Rd | 1 + man/checkIntegrity.Rd | 1 + man/checkSurvivalInput.Rd | 1 + man/closeProgress.Rd | 20 - man/clusterICAset.Rd | 1 + man/clusterSet.Rd | 1 + man/colourInputMod.Rd | 1 + man/createDataTab.Rd | 1 + man/createDensitySparklines.Rd | 1 + man/createEventPlotting.Rd | 1 + man/createGroup.Rd | 1 + man/createGroupById.Rd | 1 + man/createGroupFromInput.Rd | 1 + man/createJunctionsTemplate.Rd | 1 + man/createOptimalSurvData.Rd | 1 + man/createSparklines.Rd | 1 + man/diffAnalyses.Rd | 5 - man/diffExpressionSet.Rd | 1 + man/diffSplicingSet.Rd | 1 + man/disableTab.Rd | 1 + man/display.Rd | 1 + man/downloadFiles.Rd | 1 + man/endProcess.Rd | 24 - man/escape.Rd | 1 + man/eventPlotOptions.Rd | 1 + man/export_highcharts.Rd | 1 + man/fileBrowser.Rd | 3 +- man/fileBrowserInput.Rd | 1 + man/findASeventsFromGene.Rd | 1 + man/fisher.Rd | 21 - man/fligner.Rd | 24 - man/geNormalisationFilteringInterface.Rd | 1 + man/geneExprFileInput.Rd | 1 + man/geneExprSurvSet.Rd | 1 + man/getASevent.Rd | 3 +- man/getASevents.Rd | 3 +- man/getClinicalDataForSurvival.Rd | 1 + man/getClinicalMatchFrom.Rd | 3 +- man/getData.Rd | 1 + man/getDataRows.Rd | 1 + man/getDifferentialExpression.Rd | 3 +- man/getDifferentialSplicing.Rd | 3 +- man/getEvent.Rd | 162 ---- man/getFirebrowseCohorts.Rd | 27 - man/getFirebrowseDateFormat.Rd | 1 + man/getFirebrowseDates.Rd | 17 +- man/getGeneList.Rd | 8 +- man/getGenes.Rd | 19 - man/getGenesFromSplicingEvents.Rd | 18 - man/getGlobal.Rd | 146 +++- man/getGroups.Rd | 3 +- man/getGtexTissues.Rd | 3 - man/getHidden.Rd | 1 + man/getHighlightedPoints.Rd | 3 +- man/getNumerics.Rd | 1 + man/getServerFunctions.Rd | 1 + man/getSplicingEventCoordinates.Rd | 1 + man/getSplicingEventFromGenes.Rd | 32 +- man/getSplicingEventTypes.Rd | 2 +- man/getUiFunctions.Rd | 1 + man/getValidEvents.Rd | 1 + man/ggplotServer.Rd | 1 + man/ggplotTooltip.Rd | 1 + man/ggplotUI.Rd | 1 + man/globalSelectize.Rd | 1 + man/groupByAttribute.Rd | 18 +- man/groupByExpression.Rd | 19 - man/groupByGrep.Rd | 21 - man/groupById.Rd | 19 - man/groupByPreMadeList.Rd | 21 - man/groupManipulation.Rd | 1 + man/groupManipulationInput.Rd | 1 + man/groupsServerOnce.Rd | 1 + man/hc_scatter.Rd | 1 + man/hchart.survfit.Rd | 1 + man/inclusionLevelsInterface.Rd | 1 + man/inlineDialog.Rd | 1 + man/insideFile.Rd | 1 + man/is.whole.Rd | 1 + man/isFile.Rd | 1 + man/isFirebrowseUp.Rd | 3 - man/isRStudioServer.Rd | 1 + man/joinEventsPerType.Rd | 1 + man/junctionString.Rd | 1 + man/kruskal.Rd | 24 - man/levene.Rd | 24 - man/leveneTest.Rd | 1 + man/linkToArticle.Rd | 5 +- man/linkToRunJS.Rd | 1 + man/listAllAnnotations.Rd | 1 + man/loadBy.Rd | 1 + man/loadCustomSplicingAnnotationSet.Rd | 1 + man/loadFile.Rd | 1 + man/loadFileFormats.Rd | 7 +- man/loadFirebrowseData.Rd | 8 - man/loadFirebrowseFolders.Rd | 7 +- man/loadGeneExpressionSet.Rd | 1 + man/loadGtexDataShiny.Rd | 1 + man/loadGtexFile.Rd | 1 + man/loadSplicingQuantificationSet.Rd | 1 + man/loadTCGAsampleMetadata.Rd | 1 + man/loadedDataModal.Rd | 5 +- man/matchGroupASeventsAndGenes.Rd | 1 + man/matchGroupPatientsAndSamples.Rd | 1 + man/matchSplicingEventsWithGenes.Rd | 1 + man/missingDataModal.Rd | 1 + man/modTabPanel.Rd | 1 + man/navSelectize.Rd | 1 + man/noinfo.Rd | 1 + man/operateOnGroups.Rd | 1 + man/optimSurvDiffSet.Rd | 3 +- man/parseDateResponse.Rd | 1 + man/parseFirebrowseMetadata.Rd | 7 +- man/parseMatsEvent.Rd | 1 + man/parseMatsGeneric.Rd | 1 + man/parseMisoEvent.Rd | 1 + man/parseMisoEventID.Rd | 3 +- man/parseMisoGeneric.Rd | 1 + man/parseMisoId.Rd | 1 + man/parseSuppaEvent.Rd | 1 + man/parseSuppaGeneric.Rd | 1 + man/parseUniprotXML.Rd | 1 + man/parseUrlsFromFirebrowseResponse.Rd | 4 +- man/parseValidFile.Rd | 1 + man/parseVastToolsEvent.Rd | 1 + man/parseVastToolsSE.Rd | 1 + man/patientMultiMatchWarning.Rd | 1 + man/performPCA.Rd | 2 +- man/plotClusters.Rd | 1 + man/plotCorrelation.Rd | 10 +- man/plotDistribution.Rd | 4 - man/plotPCA.Rd | 10 +- man/plotPointsStyle.Rd | 1 + man/plotSingleICA.Rd | 1 + man/plotVariance.Rd | 8 +- man/plottableXranges.Rd | 1 + man/prepareEventPlotOptions.Rd | 1 + man/prepareFileBrowser.Rd | 1 + man/prepareFirebrowseArchives.Rd | 7 +- man/prepareJunctionQuantSTAR.Rd | 43 + man/preparePreMadeGroupForSelection.Rd | 1 + man/prepareSRAmetadata.Rd | 7 - man/prepareWordBreak.Rd | 1 + man/print.geneList.Rd | 1 + man/processButton.Rd | 1 + man/processDatasetNames.Rd | 1 + man/processSurvData.Rd | 1 + man/processSurvival.Rd | 1 + man/psichomics.Rd | 3 +- man/pubmedUI.Rd | 1 + man/quantifySplicingSet.Rd | 1 + man/queryEnsembl.Rd | 1 + man/queryEnsemblByEvent.Rd | 29 - man/queryEnsemblByGene.Rd | 19 +- man/queryFirebrowseData.Rd | 7 +- man/queryPubMed.Rd | 1 + man/queryUniprot.Rd | 1 + man/readAnnot.Rd | 1 + man/reduceDimensionality.Rd | 1 + man/renameDuplicated.Rd | 1 + man/renameGroups.Rd | 1 + man/renderDataTableSparklines.Rd | 1 + man/renderGeneticInfo.Rd | 1 + man/renderGroupInterface.Rd | 1 + man/renderProteinInfo.Rd | 1 + man/rm.null.Rd | 1 + man/roundDigits.Rd | 1 + man/roundMinDown.Rd | 1 + man/rowMeans.Rd | 12 +- man/rowVars.Rd | 23 - man/selectGroupsUI.Rd | 1 + man/selectPreMadeGroup.Rd | 5 +- man/selectizeGeneInput.Rd | 1 + man/setFirebrowseData.Rd | 1 + man/setLocalData.Rd | 1 + man/setOperation.Rd | 1 + man/setOperationIcon.Rd | 1 + man/showAlert.Rd | 17 +- man/showGroupsTable.Rd | 1 + man/sidebar.Rd | 1 + man/signifDigits.Rd | 1 + man/singleDiffAnalyses.Rd | 1 + man/sortCoordinates.Rd | 1 + man/spearman.Rd | 21 - man/startProcess.Rd | 23 +- man/startProgress.Rd | 27 +- man/styleModal.Rd | 38 +- man/subsetGeneExpressionFromMatchingGenes.Rd | 1 + man/tabDataset.Rd | 1 + man/table2html.Rd | 1 + man/tableRow.Rd | 1 + man/testSingleIndependence.Rd | 1 + man/testSurvivalCutoff.Rd | 1 + man/textSuggestions.Rd | 1 + man/toJSarray.Rd | 1 + man/transformData.Rd | 1 + man/transformOptions.Rd | 1 + man/transformValues.Rd | 1 + man/trimWhitespace.Rd | 1 + man/ttest.Rd | 24 - man/uniqueBy.Rd | 1 + man/updateClinicalParams.Rd | 1 + man/updateFileBrowserInput.Rd | 1 + man/updateProgress.Rd | 37 - man/vennEvents.Rd | 1 + man/wilcox.Rd | 34 +- tests/testthat/testGeneInfo.R | 2 +- vignettes/CLI_tutorial.Rmd | 13 +- 253 files changed, 1527 insertions(+), 1523 deletions(-) delete mode 100644 man/analysesPlotSet.Rd delete mode 100644 man/closeProgress.Rd delete mode 100644 man/endProcess.Rd delete mode 100644 man/fisher.Rd delete mode 100644 man/fligner.Rd delete mode 100644 man/getEvent.Rd delete mode 100644 man/getFirebrowseCohorts.Rd delete mode 100644 man/getGenes.Rd delete mode 100644 man/getGenesFromSplicingEvents.Rd delete mode 100644 man/groupByExpression.Rd delete mode 100644 man/groupByGrep.Rd delete mode 100644 man/groupById.Rd delete mode 100644 man/groupByPreMadeList.Rd delete mode 100644 man/kruskal.Rd delete mode 100644 man/levene.Rd create mode 100644 man/prepareJunctionQuantSTAR.Rd delete mode 100644 man/queryEnsemblByEvent.Rd delete mode 100644 man/rowVars.Rd delete mode 100644 man/spearman.Rd delete mode 100644 man/ttest.Rd delete mode 100644 man/updateProgress.Rd diff --git a/NAMESPACE b/NAMESPACE index 3f6cc1aa..611f8972 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,6 +41,7 @@ export(loadAnnotation) export(loadFirebrowseData) export(loadGtexData) export(loadLocalFiles) +export(loadSRAproject) export(normaliseGeneExpression) export(optimalPSIcutoff) export(optimalSurvivalCutoff) diff --git a/NEWS b/NEWS index 9b208ede..1b8a686b 100644 --- a/NEWS +++ b/NEWS @@ -25,6 +25,9 @@ * Groups: - Minor improvements to the group creation interface * Improve console logging of error and warning alerts +* Documentation: + - Export functions mentioned in the documentation + - Hide documentation of internal functions from the PDF reference manual # 1.6.2 (2 October, 2018) diff --git a/R/analysis.R b/R/analysis.R index 1fea4fd5..71ee89cc 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -8,6 +8,9 @@ NULL #' @param buttonId Character: identifier of button to take user to load missing #' data #' +#' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal +#' #' @examples #' \dontrun{ #' session <- session$ns @@ -17,7 +20,6 @@ NULL #' missingDataModal(session, buttonId, dataType) #' observeEvent(input[[buttonInput]], missingDataGuide(dataType)) #' } -#' @return NULL (this function is used to modify the Shiny session's state) missingDataModal <- function(session, dataType, buttonId) { template <- function(buttonLabel) { errorModal( @@ -45,6 +47,7 @@ missingDataGuide <- function(dataType) { #' @inheritParams shiny::selectizeInput #' #' @return HTML elements +#' @keywords internal selectizeGeneInput <- function(id, label="Gene", choices=NULL, multiple=FALSE) { onFocus <- NULL onChange <- NULL @@ -69,6 +72,8 @@ selectizeGeneInput <- function(id, label="Gene", choices=NULL, multiple=FALSE) { #' #' @importFrom shinyBS bsTooltip #' @importFrom shiny NS div icon fluidRow column tags +#' +#' @keywords internal analysesUI <- function(id, tab) { ns <- NS(id) uiList <- getUiFunctions( @@ -101,6 +106,8 @@ analysesUI <- function(id, tab) { #' #' @importFrom shiny observe observeEvent #' @importFrom shinyjs hide show +#' +#' @keywords internal analysesServer <- function(input, output, session) { # Run server logic from the scripts getServerFunctions("analysis", @@ -117,6 +124,7 @@ analysesServer <- function(input, output, session) { #' when performing survival analysis #' #' @return Character +#' @keywords internal patientMultiMatchWarning <- function() { paste("While stratifying patients for survival analysis, patients", "with multipe samples are assigned the average value of their", @@ -131,6 +139,7 @@ patientMultiMatchWarning <- function() { #' @param formulaStr Character: right-side of the formula for survival analysis #' #' @return Filtered clinical data +#' @keywords internal getClinicalDataForSurvival <- function(..., formulaStr=NULL) { cols <- unlist(list(...)) if (!is.null(formulaStr) && formulaStr != "") { @@ -225,6 +234,7 @@ getPSIperPatient <- function(psi, match, clinical=NULL, patients=NULL, ...) { #' of this function. #' #' @return Data frame with terms needed to calculate survival curves +#' @keywords internal processSurvData <- function(event, timeStart, timeStop, followup, group, clinical, survTime=NULL) { if ( is.null(survTime) ) { @@ -267,7 +277,6 @@ processSurvData <- function(event, timeStart, timeStop, followup, group, #' @param followup Character: name of column containing follow up time #' #' @return Data frame containing the time for the given columns -#' #' @export #' #' @examples @@ -308,6 +317,7 @@ getColumnsTime <- function(clinical, event, timeStart, timeStop=NULL, #' #' @importFrom shiny observe updateSelectizeInput #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal updateClinicalParams <- function(session, attrs) { if (!is.null(attrs)) { # Allow the user to select any "days_to" attribute available @@ -535,6 +545,7 @@ survdiff.survTerms <- function(survTerms, ...) { #' #' @return Plot of survival curves #' @export +#' #' @examples #' require("survival") #' fit <- survfit(Surv(time, status) ~ x, data = aml) @@ -582,7 +593,9 @@ plotSurvivalCurves <- function(surv, mark=TRUE, interval=FALSE, pvalue=NULL, #' @inheritDotParams processSurvTerms #' #' @importFrom shiny tags +#' #' @return List with survival analysis results +#' @keywords internal processSurvival <- function(session, ...) { # Calculate survival curves survTerms <- tryCatch(processSurvTerms(...), error=return) @@ -700,6 +713,7 @@ labelBasedOnCutoff <- function (data, cutoff, label=NULL, gte=TRUE) { #' #' @importFrom survival survdiff #' @return p-value of the survival difference +#' @keywords internal testSurvivalCutoff <- function(cutoff, data, filter=TRUE, clinical, ..., session=NULL, survivalInfo=FALSE) { group <- labelBasedOnCutoff(data, cutoff, label="Inclusion levels") @@ -812,6 +826,7 @@ optimalPSIcutoff <- function(clinical, psi, censoring, event, timeStart, #' @param labelsPanel Tab panel containing options to label points #' #' @return HTML elements +#' @keywords internal prepareEventPlotOptions <- function(id, ns, labelsPanel=NULL) { createAxisPanel <- function(ns, axis) { upper <- toupper(axis) @@ -864,17 +879,31 @@ prepareEventPlotOptions <- function(id, ns, labelsPanel=NULL) { div(id=id, tabsetPanel(xAxisPanel, yAxisPanel, labelsPanel, plotStyle)) } -#' Perform Wilcoxon analysis and return interface to show the results +#' Perform and display statistical analysis +#' +#' Includes interface containing the results #' #' @inheritParams plotDistribution #' @param stat Data frame or matrix: values of the analyses to be performed (if #' NULL, the analyses will be performed) #' +#' @details +#' \itemize{ +#' \item{\code{ttest}: unpaired t-test} +#' \item{\code{wilcox}: Wilcoxon test} +#' \item{\code{levene}: Levene's test} +#' \item{\code{fligner}: Fligner-Killeen test} +#' \item{\code{kruskal}: Kruskal test} +#' \item{\code{fisher}: Fisher's exact test} +#' \item{\code{spearman}: Spearman's test} +#' } +#' #' @importFrom shiny tagList tags h4 br #' @importFrom stats wilcox.test #' @importFrom R.utils capitalize #' #' @return HTML elements +#' @keywords internal wilcox <- function(data, groups, stat=NULL) { warn <- NULL group <- unique(groups) @@ -932,16 +961,11 @@ wilcox <- function(data, groups, stat=NULL) { tags$b("p-value: "), signifDigits(p.value), br(), adjusted)) } -#' Perform unpaired t-test analysis and return interface to show the results -#' @inheritParams wilcox -#' @param stat Data frame or matrix: values of the analyses to be performed (if -#' NULL, the analyses will be performed) +#' @rdname wilcox #' #' @importFrom shiny tagList tags h4 br #' @importFrom stats t.test #' @importFrom R.utils capitalize -#' -#' @return HTML elements ttest <- function(data, groups, stat=NULL) { warn <- NULL group <- unique(groups) @@ -1030,11 +1054,8 @@ ttest <- function(data, groups, stat=NULL) { tags$b("p-value: "), signifDigits(p.value), br(), adjusted)) } - -#' Perform Levene's test and return interface to show the results -#' @inheritParams wilcox +#' @rdname wilcox #' @importFrom shiny tagList tags h4 br -#' @return HTML elements levene <- function(data, groups, stat=NULL) { p.value <- NULL if (!is.null(stat)) { @@ -1095,11 +1116,9 @@ levene <- function(data, groups, stat=NULL) { nonBootstrap)) } -#' Perform Fligner-Killeen test and return interface to show the results -#' @inheritParams wilcox +#' @rdname wilcox #' @importFrom shiny tagList tags h4 br #' @importFrom stats fligner.test -#' @return HTML elements fligner <- function(data, groups, stat=NULL) { len <- length(unique(groups)) @@ -1147,11 +1166,10 @@ fligner <- function(data, groups, stat=NULL) { tags$b("p-value: "), signifDigits(p.value), br(), adjusted)) } -#' Perform Kruskal's test and return interface to show the results -#' @inheritParams wilcox +#' @rdname wilcox +#' #' @importFrom shiny tagList tags h4 br #' @importFrom stats kruskal.test -#' @return HTML elements kruskal <- function(data, groups, stat=NULL) { len <- length(unique(groups)) @@ -1193,14 +1211,11 @@ kruskal <- function(data, groups, stat=NULL) { tags$b("p-value: "), signifDigits(p.value), br(), adjusted)) } -#' Perform Fisher's exact test and return interface to show the results -#' @inheritParams wilcox +#' @rdname wilcox #' #' @importFrom shiny tagList tags h4 br #' @importFrom stats fisher.test #' @importFrom R.utils evalWithTimeout -#' -#' @return HTML elements fisher <- function(data, groups) { stat <- try(evalWithTimeout( fisher.test(data, factor(groups)), @@ -1221,11 +1236,10 @@ fisher <- function(data, groups) { } } -#' Perform Spearman's test and return interface to show the results -#' @inheritParams wilcox +#' @rdname wilcox +#' #' @importFrom shiny tagList tags h4 br #' @importFrom stats var cor -#' @return HTML elements spearman <- function(data, groups) { group <- unique(groups) len <- length(group) @@ -1255,6 +1269,7 @@ spearman <- function(data, groups) { #' element to sort differentially analysis #' #' @return HTML elements +#' @keywords internal eventPlotOptions <- function(session, df, xAxis, yAxis, labelSortBy) { # Only allow to select numeric columns cols <- colnames(df) @@ -1336,6 +1351,7 @@ eventPlotOptions <- function(session, df, xAxis, yAxis, labelSortBy) { #' @importFrom shiny tagList br h4 #' #' @return HTML elements +#' @keywords internal basicStats <- function(data, groups) { data <- lapply(unique(groups), function(g) data[groups == g]) @@ -1373,6 +1389,7 @@ basicStats <- function(data, groups) { #' @return Named vector with filtered elements from valid groups. The group of #' the respective element is given in the name. #' @export +#' #' @examples #' # Removes groups with less than two elements #' filterGroups(1:4, c("A", "B", "B", "D"), threshold=2) @@ -1386,7 +1403,6 @@ filterGroups <- function(vector, group, threshold=1) { return(unlist(vector)) } - #' Create plot for events #' #' @param df Data frame @@ -1412,6 +1428,7 @@ filterGroups <- function(vector, group, threshold=1) { #' @importFrom ggrepel geom_label_repel #' #' @return List containing HTML elements and highlighted points +#' @keywords internal createEventPlotting <- function(df, x, y, params, highlightX, highlightY, highlightParams, selected, selectedParams, labelled, labelledParams, xlim, ylim) { @@ -1482,6 +1499,7 @@ createEventPlotting <- function(df, x, y, params, highlightX, highlightY, #' NULL (by default) to show all variable transformations #' #' @return Character labelling variable transformation(s) +#' @keywords internal transformOptions <- function(label, type=NULL) { transform <- c("No transformation"="no", "|%s|"="abs", @@ -1510,6 +1528,7 @@ transformOptions <- function(label, type=NULL) { #' default #' #' @return Integer containing transformed values +#' @keywords internal transformValues <- function(val, type, avoidZero=TRUE) { # Remove NAs if (avoidZero) { @@ -1536,6 +1555,7 @@ transformValues <- function(val, type, avoidZero=TRUE) { #' #' @return Data frame with transformed data in new columns and respective name #' of created columns +#' @keywords internal transformData <- function(input, df, x, y) { xTrans <- input$xTransform xLabel <- transformOptions(x, xTrans) @@ -1563,6 +1583,7 @@ transformData <- function(input, df, x, y) { #' @importFrom shiny tagList h4 helpText sliderInput #' #' @return HTML elements +#' @keywords internal plotPointsStyle <- function(ns, id, description, help=NULL, size=2, colour="black", alpha=1.0) { id2 <- function(att) ns(paste0(id, att)) @@ -1602,6 +1623,7 @@ plotPointsStyle <- function(ns, id, description, help=NULL, size=2, #' #' @return Highcharter object with density plot #' @export +#' #' @examples #' data <- sample(20, rep=TRUE)/20 #' groups <- c(rep("A", 10), rep("B", 10)) @@ -1704,9 +1726,6 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, return(hc) } -#' @rdname plotDistribution -plotDensity <- plotDistribution - #' Levene's test #' #' Performs a Levene's test to assess the equality of variances @@ -1726,6 +1745,8 @@ plotDensity <- plotDistribution #' \item{method}{the type of test applied.} #' \item{data.name}{a character string giving the names of the data.} #' +#' @keywords internal +#' #' @examples #' #' vals <- sample(30, replace=TRUE) @@ -1770,6 +1791,8 @@ leveneTest <- function(x, g, centers=median) { #' @inherit createSparklines #' @param areSplicingEvents Boolean: are these splicing events (TRUE) or gene #' expression (FALSE)? +#' +#' @keywords internal createDensitySparklines <- function(data, events, areSplicingEvents=TRUE, groups=NULL, geneExpr=NULL) { if (areSplicingEvents) { @@ -1820,6 +1843,7 @@ createDensitySparklines <- function(data, events, areSplicingEvents=TRUE, #' @importFrom jsonlite toJSON #' #' @return HTML element with sparkline data +#' @keywords internal createSparklines <- function(hc, data, events, FUN, groups=NULL, geneExpr=NULL) { hc <- as.character(toJSON(hc$x$hc_opts, auto_unbox=TRUE)) @@ -1871,6 +1895,7 @@ createSparklines <- function(hc, data, events, FUN, groups=NULL, #' @importFrom methods is #' #' @return A row from a data frame with the results +#' @keywords internal singleDiffAnalyses <- function(vector, group, threshold=1, step=100, analyses=c("wilcoxRankSum", "ttest", "kruskal", "levene", "fligner")) { @@ -2199,141 +2224,395 @@ diffAnalyses <- function(data, groups=NULL, return(df) } -#' @rdname diffAnalyses -diffAnalysis <- diffAnalyses - -#' Set of functions to plot differential analyses +#' Set of functions to render differential analyses (plot and table) #' #' @inherit diffSplicingTableServer -#' @inheritParams analysesTableSet #' -#' @importFrom stringr str_split -#' @importFrom shinyjs toggleState -analysesPlotSet <- function(session, input, output, analysesType, analysesID, - getAnalysesData, getAnalysesFiltered, - getAnalysesSurvival) { - ns <- session$ns - - # Toggle visibility of elements regarding event options +#' @param analysesType Character: type of analyses (\code{GE} or \code{PSI}) +#' @param analysesID Character: identifier +#' @param getAnalysesData Function: get analyses data +#' @param getAnalysesFiltered Function: get filtered analyses data +#' @param setAnalysesFiltered Function: set filtered analyses data +#' @param getAnalysesSurvival Function: get survival data +#' @param getAnalysesColumns Function: get columns +#' @param setAnalysesColumns Function: set columns +#' @param getResetPaging Function: get toggle of reset paging +#' @param setResetPaging Function: set toggle of reset paging +#' +#' @importFrom DT dataTableProxy selectRows replaceData +#' @importFrom shinyjs toggleElement toggleState +#' @importFrom utils write.table +#' +#' @keywords internal +analysesTableSet <- function(session, input, output, analysesType, analysesID, + getAnalysesData, getAnalysesFiltered, + setAnalysesFiltered, getAnalysesSurvival, + getAnalysesColumns, setAnalysesColumns, + getResetPaging, setResetPaging) { + # Save selected points in the table observe({ - stats <- getAnalysesData() - if (is.null(stats)) { - show("missingDiffAnalyses") - hide("eventOptions") - } else { - hide("missingDiffAnalyses") - show("eventOptions") - } + selected <- input$statsTable_rows_selected + setSelectedPoints(analysesID, selected) }) - # Update columns available to plot - observe({ + if (analysesType == "PSI") { + searchableCols <- 5 + visibleCols <- 6:8 + extraRender <- JS("linkToShowSurv") + } else if (analysesType == "GE") { + searchableCols <- 1 + visibleCols <- 5:6 + extraRender <- NULL + } + + # Render table with sparklines + output$statsTable <- renderDataTableSparklines({ stats <- getAnalysesData() - optimSurv <- getAnalysesSurvival() - if (!is.null(optimSurv)) { - optimSurvCols <- sprintf( - c("Optimal %s cutoff", "Log rank p-value"), analysesType) - stats[[optimSurvCols[1]]] <- optimSurv[[1]] - stats[[optimSurvCols[2]]] <- optimSurv[[2]] - - # Show these columns at the end - names <- colnames(stats) - colsMatch <- match(optimSurvCols, names) - stats <- stats[c(names[-colsMatch], names[colsMatch])] + if (!is.null(stats)) { + # Discard columns of no interest + cols <- colnames(stats) + cols <- cols[!grepl("method|data.name", cols)] + setAnalysesColumns(cols) + return(stats[ , cols]) } - eventPlotOptions(session, stats, isolate(input$xAxis), - isolate(input$yAxis), isolate(input$labelSortBy)) - }) + }, style="bootstrap", filter="top", server=TRUE, extensions="Buttons", + options=list(pageLength=10, dom="Bfrtip", buttons=I("colvis"), + columnDefs=list( + list(targets=searchableCols, searchable=FALSE), + list(targets=visibleCols, visible=FALSE, + render=extraRender)))) - # Update alternative splicing events and genes available to label + # Update table with filtered information + proxy <- dataTableProxy("statsTable") observe({ - diffAnalyses <- getAnalysesData() - if (!is.null(diffAnalyses)) { - if (analysesType == "PSI") { - ASevents <- rownames(diffAnalyses) - names(ASevents) <- gsub("_", " ", ASevents) - updateSelectizeInput(session, "labelEvents", server=TRUE, - choices=ASevents, selected=character(0)) - allGenes <- sort(unique(unlist( - str_split(diffAnalyses$Gene, "/")))) - updateSelectizeInput(session, "labelGenes", server=TRUE, - choices=allGenes, selected=character(0)) - } else if (analysesType == "GE") { - updateSelectizeInput(session, "labelGenes", server=TRUE, - choices=rownames(diffAnalyses), - selected=character(0)) - } - } else { - if (analysesType == "PSI") { - updateSelectizeInput(session, "labelEvents", server=TRUE, - choices=character(0), - selected=character(0)) - } - - updateSelectizeInput(session, "labelGenes", server=TRUE, - choices=character(0), selected=character(0)) - } - }) - - # Interface elements to highlight values in the plot - lapply(c("x", "y"), function(axis) { - observe({ - highlightUI <- function(label, min, max) { - highlightId <- ns(paste0(label, "Highlight")) - sliderMinId <- ns(paste0(label, "SliderMin")) - sliderMaxId <- ns(paste0(label, "SliderMax")) - sliderInvId <- ns(paste0(label, "SliderInv")) - - # Round max and min numbers with two decimal points - max <- ceiling(max*100)/100 - min <- floor(min*100)/100 - - conditionalPanel( - sprintf("input[id='%s']", highlightId), - fluidRow( - column(6, textInput(sliderMinId, "Lower limit \u2265", - placeholder=min, width="100%")), - column(6, textInput(sliderMaxId, "Upper limit \u2264", - placeholder=max, width="100%"))), - checkboxInput(sliderInvId, "Invert highlighted values"), - helpText("The data in the table is also filtered", - "according to highlighted events.")) - } - - stats <- getAnalysesData() + stats <- getAnalysesData() + + if (!is.null(stats)) { + # Bind preview of survival curves based on PSI cutoff optimSurv <- getAnalysesSurvival() if (!is.null(optimSurv)) { - cols <- sprintf(c("Optimal %s cutoff", "Log-rank p-value"), - analysesType) + cols <- sprintf(c("Optimal %s cutoff", "Log-rank p-value", + "Survival by %s cutoff"), analysesType) stats[[cols[[1]]]] <- optimSurv[[1]] stats[[cols[[2]]]] <- optimSurv[[2]] + stats[[cols[[3]]]] <- optimSurv[[3]] } - value <- input[[paste0(axis, "Axis")]] - if (is.null(stats) || is.null(value)) { - output[[paste0(axis, "HighlightValues")]] <- renderUI(NULL) - return(NULL) + # Filter by highlighted events and events in the zoomed area + events <- getHighlightedPoints(analysesID) + zoom <- getZoom(analysesID) + + zoomed <- NULL + if (!is.null(zoom)) { + x <- input$xAxis + y <- input$yAxis + if (!is.null(x) && !is.null(y)) { + res <- transformData(input, stats, x, y) + if (!is.null(res)) { + stats <- res$data + xLabel <- res$xLabel + yLabel <- res$yLabel + + xStats <- stats[[xLabel]] + xZoom <- zoom$xmin <= xStats & xStats <= zoom$xmax + yStats <- stats[[yLabel]] + yZoom <- zoom$ymin <= yStats & yStats <= zoom$ymax + zoomed <- intersect(which(xZoom), which(yZoom)) + } + } } - trans <- input[[paste0(axis, "Transform")]] - label <- transformOptions(value, trans) - if (!value %in% colnames(stats)) { - output[[paste0(axis, "HighlightValues")]] <- renderUI(NULL) - return(NULL) + # Filter rows based on highlighted and/or zoomed in events + if (!is.null(events) && !is.null(zoomed)) { + rowFilter <- intersect(events, zoomed) + } else if (!is.null(events)) { + rowFilter <- events + } else if (!is.null(zoomed)) { + rowFilter <- zoomed + } else { + rowFilter <- TRUE } - vals <- transformValues(stats[[value]], trans) - rangeNos <- range(vals, na.rm=TRUE) - minNo <- min(rangeNos) - maxNo <- max(rangeNos) + stats <- stats[rowFilter, ] - output[[paste0(axis, "HighlightValues")]] <- renderUI( - highlightUI(axis, minNo, maxNo) ) - }) + # Keep previously selected rows if possible + before <- isolate(getAnalysesFiltered()) + selected <- isolate(input$statsTable_rows_selected) + selected <- rownames(before)[isolate(selected)] + selected <- which(rownames(stats) %in% selected) + if (length(selected) < 1) selected <- NULL + + # Set new data + setAnalysesFiltered(stats) + + # Properly display event identifiers + rownames(stats) <- parseSplicingEvent(rownames(stats), char=TRUE) + + # Keep columns from data table (else, no data will be rendered) + cols <- getAnalysesColumns() + stats <- stats[ , cols] + + # Check if paging should be reset + resetPaging <- isolate(getResetPaging()) + if (is.null(resetPaging)) resetPaging <- TRUE + setResetPaging(TRUE) + + # Round numbers based on significant digits + cols <- colnames(stats) + type <- sapply(cols, function(i) class(stats[[i]])) + numericCols <- cols[type == "numeric"] + + # Round numbers based on significant digits + if (nrow(stats) > 0) { + for (col in numericCols) { + stats[ , col] <- suppressWarnings( + as.numeric(signifDigits(stats[ , col]))) + } + } + replaceData(proxy, stats, resetPaging=resetPaging, + clearSelection="none") + } }) - # Disable labelling elements as appropriate - observe(toggleState("labelTopOptions", input$labelTopEnable)) - observe(toggleState("labelGenes", input$labelGeneEnable)) + # Hide table toolbar if statistical table is not displayed + observe(toggleElement( + "tableToolbar", condition=!is.null(getAnalysesData()))) + + # Discard columns from data frame containing information to render plots + discardPlotsFromTable <- function(df) { + plotCols <- TRUE + if (!is.null(df)) { + ns <- sprintf(c("%s distribution", "Survival by %s cutoff"), + analysesType) + plotCols <- -match(ns, colnames(df)) + plotCols <- plotCols[!is.na(plotCols)] + if (length(plotCols) == 0) plotCols <- TRUE + } + return(df[ , plotCols]) + } + + if (analysesType == "PSI") { + filenameText <- "Differential splicing analyses" + rownamesCol <- "AS event" + } else if (analysesType == "GE") { + filenameText <- "Differential expression analyses" + rownamesCol <- "Gene" + } + + # Download whole table + output$downloadAll <- downloadHandler( + filename=paste(getCategory(), filenameText), + content=function(file) { + stats <- getAnalysesData() + stats <- discardPlotsFromTable(stats) + + # Include updated survival analyses + optimSurv <- getAnalysesSurvival() + if (!is.null(optimSurv)) { + cols <- sprintf(c("Optimal %s cutoff", "Log-rank p-value"), + analysesType) + stats[[cols[[1]]]] <- optimSurv[[1]] + stats[[cols[[2]]]] <- optimSurv[[2]] + } + + stats <- cbind(rownames(stats), stats) + colnames(stats)[[1]] <- rownamesCol + write.table(stats, file, quote=FALSE, sep="\t", row.names=FALSE) + } + ) + + # Download filtered table + output$downloadSubset <- downloadHandler( + filename=paste(getCategory(), filenameText), + content=function(file) { + stats <- getAnalysesFiltered() + stats <- discardPlotsFromTable(stats) + stats <- stats[input$statsTable_rows_all, ] + + stats <- cbind(rownames(stats), stats) + colnames(stats)[[1]] <- rownamesCol + write.table(stats, file, quote=FALSE, sep="\t", row.names=FALSE) + } + ) + + # Create groups based on a given filter + groupBasedOnAnalysis <- function(filter, description="") { + stats <- getAnalysesFiltered() + stats <- discardPlotsFromTable(stats) + stats <- stats[filter, ] + + if (analysesType == "PSI") { + ASevents <- rownames(stats) + genes <- unique(names(getGenesFromSplicingEvents(ASevents))) + origin <- "Selection from differential splicing analysis" + } else if (analysesType == "GE") { + genes <- rownames(stats) + + ASevents <- getASevents() + if ( !is.null(ASevents) ) + ASevents <- getSplicingEventFromGenes(genes, ASevents) + else + ASevents <- character(0) + + origin <- "Selection from differential expression analysis" + } + + group <- cbind("Names"="DFS selection", "Subset"=origin, "Input"=origin, + "ASevents"=list(ASevents), "Genes"=list(genes)) + appendNewGroups("ASevents", group) + infoModal( + session, title="New group created", + "New group created", description, "and containing:", + div(style="font-size: 22px;", length(ASevents), "splicing events"), + div(style="font-size: 22px;", length(genes), "genes")) + } + + if (analysesType == "PSI") groupedElements <- "splicing events" + else if (analysesType == "GE") groupedElements <- "genes" + groupsText <- sprintf(c("based on the %s shown in the table", + "based on selected %s"), groupedElements) + + # Create groups based on splicing events displayed in the table + observeEvent(input$groupByDisplayed, groupBasedOnAnalysis( + input$statsTable_rows_all, groupsText[[1]])) + + # Create groups based on selected splicing events + observeEvent(input$groupBySelected, groupBasedOnAnalysis( + input$statsTable_rows_selected, groupsText[[2]])) + + # Disable groups based on selected AS events when no groups are selected + observe(toggleState("groupBySelectedContainer", + !is.null(input$statsTable_rows_selected))) +} + +#' @rdname analysesTableSet +#' +#' @importFrom stringr str_split +#' @importFrom shinyjs toggleState +analysesPlotSet <- function(session, input, output, analysesType, analysesID, + getAnalysesData, getAnalysesFiltered, + getAnalysesSurvival) { + ns <- session$ns + + # Toggle visibility of elements regarding event options + observe({ + stats <- getAnalysesData() + if (is.null(stats)) { + show("missingDiffAnalyses") + hide("eventOptions") + } else { + hide("missingDiffAnalyses") + show("eventOptions") + } + }) + + # Update columns available to plot + observe({ + stats <- getAnalysesData() + optimSurv <- getAnalysesSurvival() + if (!is.null(optimSurv)) { + optimSurvCols <- sprintf( + c("Optimal %s cutoff", "Log rank p-value"), analysesType) + stats[[optimSurvCols[1]]] <- optimSurv[[1]] + stats[[optimSurvCols[2]]] <- optimSurv[[2]] + + # Show these columns at the end + names <- colnames(stats) + colsMatch <- match(optimSurvCols, names) + stats <- stats[c(names[-colsMatch], names[colsMatch])] + } + eventPlotOptions(session, stats, isolate(input$xAxis), + isolate(input$yAxis), isolate(input$labelSortBy)) + }) + + # Update alternative splicing events and genes available to label + observe({ + diffAnalyses <- getAnalysesData() + if (!is.null(diffAnalyses)) { + if (analysesType == "PSI") { + ASevents <- rownames(diffAnalyses) + names(ASevents) <- gsub("_", " ", ASevents) + updateSelectizeInput(session, "labelEvents", server=TRUE, + choices=ASevents, selected=character(0)) + allGenes <- sort(unique(unlist( + str_split(diffAnalyses$Gene, "/")))) + updateSelectizeInput(session, "labelGenes", server=TRUE, + choices=allGenes, selected=character(0)) + } else if (analysesType == "GE") { + updateSelectizeInput(session, "labelGenes", server=TRUE, + choices=rownames(diffAnalyses), + selected=character(0)) + } + } else { + if (analysesType == "PSI") { + updateSelectizeInput(session, "labelEvents", server=TRUE, + choices=character(0), + selected=character(0)) + } + + updateSelectizeInput(session, "labelGenes", server=TRUE, + choices=character(0), selected=character(0)) + } + }) + + # Interface elements to highlight values in the plot + lapply(c("x", "y"), function(axis) { + observe({ + highlightUI <- function(label, min, max) { + highlightId <- ns(paste0(label, "Highlight")) + sliderMinId <- ns(paste0(label, "SliderMin")) + sliderMaxId <- ns(paste0(label, "SliderMax")) + sliderInvId <- ns(paste0(label, "SliderInv")) + + # Round max and min numbers with two decimal points + max <- ceiling(max*100)/100 + min <- floor(min*100)/100 + + conditionalPanel( + sprintf("input[id='%s']", highlightId), + fluidRow( + column(6, textInput(sliderMinId, "Lower limit \u2265", + placeholder=min, width="100%")), + column(6, textInput(sliderMaxId, "Upper limit \u2264", + placeholder=max, width="100%"))), + checkboxInput(sliderInvId, "Invert highlighted values"), + helpText("The data in the table is also filtered", + "according to highlighted events.")) + } + + stats <- getAnalysesData() + optimSurv <- getAnalysesSurvival() + if (!is.null(optimSurv)) { + cols <- sprintf(c("Optimal %s cutoff", "Log-rank p-value"), + analysesType) + stats[[cols[[1]]]] <- optimSurv[[1]] + stats[[cols[[2]]]] <- optimSurv[[2]] + } + + value <- input[[paste0(axis, "Axis")]] + if (is.null(stats) || is.null(value)) { + output[[paste0(axis, "HighlightValues")]] <- renderUI(NULL) + return(NULL) + } + + trans <- input[[paste0(axis, "Transform")]] + label <- transformOptions(value, trans) + if (!value %in% colnames(stats)) { + output[[paste0(axis, "HighlightValues")]] <- renderUI(NULL) + return(NULL) + } + vals <- transformValues(stats[[value]], trans) + rangeNos <- range(vals, na.rm=TRUE) + minNo <- min(rangeNos) + maxNo <- max(rangeNos) + + output[[paste0(axis, "HighlightValues")]] <- renderUI( + highlightUI(axis, minNo, maxNo) ) + }) + }) + + # Disable labelling elements as appropriate + observe(toggleState("labelTopOptions", input$labelTopEnable)) + observe(toggleState("labelGenes", input$labelGeneEnable)) if (analysesType == "PSI") observe(toggleState("labelEvents", input$labelEventEnable)) @@ -2500,263 +2779,5 @@ analysesPlotSet <- function(session, input, output, analysesType, analysesID, ggplotAuxServer(input, output, analysesID) } -#' Set of functions to render data table for differential analyses -#' -#' @inherit diffSplicingTableServer -#' -#' @param analysesType Character: type of analyses (\code{GE} or \code{PSI}) -#' @param analysesID Character: identifier of analyses -#' @param getAnalysesData Function: used to get analyses data -#' @param getAnalysesFiltered Function: used to get filtered analyses data -#' @param setAnalysesFiltered Function: used to set filtered analyses data -#' @param getAnalysesSurvival Function: used to get survival data -#' @param getAnalysesColumns Function: used to get columns -#' @param setAnalysesColumns Function: used to set columns -#' @param getResetPaging Function: used to get reset paging toggle -#' @param setResetPaging Function: used to set reset paging toggle -#' -#' @importFrom DT dataTableProxy selectRows replaceData -#' @importFrom shinyjs toggleElement toggleState -#' @importFrom utils write.table -analysesTableSet <- function(session, input, output, analysesType, analysesID, - getAnalysesData, getAnalysesFiltered, - setAnalysesFiltered, getAnalysesSurvival, - getAnalysesColumns, setAnalysesColumns, - getResetPaging, setResetPaging) { - # Save selected points in the table - observe({ - selected <- input$statsTable_rows_selected - setSelectedPoints(analysesID, selected) - }) - - if (analysesType == "PSI") { - searchableCols <- 5 - visibleCols <- 6:8 - extraRender <- JS("linkToShowSurv") - } else if (analysesType == "GE") { - searchableCols <- 1 - visibleCols <- 5:6 - extraRender <- NULL - } - - # Render table with sparklines - output$statsTable <- renderDataTableSparklines({ - stats <- getAnalysesData() - if (!is.null(stats)) { - # Discard columns of no interest - cols <- colnames(stats) - cols <- cols[!grepl("method|data.name", cols)] - setAnalysesColumns(cols) - return(stats[ , cols]) - } - }, style="bootstrap", filter="top", server=TRUE, extensions="Buttons", - options=list(pageLength=10, dom="Bfrtip", buttons=I("colvis"), - columnDefs=list( - list(targets=searchableCols, searchable=FALSE), - list(targets=visibleCols, visible=FALSE, - render=extraRender)))) - - # Update table with filtered information - proxy <- dataTableProxy("statsTable") - observe({ - stats <- getAnalysesData() - - if (!is.null(stats)) { - # Bind preview of survival curves based on PSI cutoff - optimSurv <- getAnalysesSurvival() - if (!is.null(optimSurv)) { - cols <- sprintf(c("Optimal %s cutoff", "Log-rank p-value", - "Survival by %s cutoff"), analysesType) - stats[[cols[[1]]]] <- optimSurv[[1]] - stats[[cols[[2]]]] <- optimSurv[[2]] - stats[[cols[[3]]]] <- optimSurv[[3]] - } - - # Filter by highlighted events and events in the zoomed area - events <- getHighlightedPoints(analysesID) - zoom <- getZoom(analysesID) - - zoomed <- NULL - if (!is.null(zoom)) { - x <- input$xAxis - y <- input$yAxis - if (!is.null(x) && !is.null(y)) { - res <- transformData(input, stats, x, y) - if (!is.null(res)) { - stats <- res$data - xLabel <- res$xLabel - yLabel <- res$yLabel - - xStats <- stats[[xLabel]] - xZoom <- zoom$xmin <= xStats & xStats <= zoom$xmax - yStats <- stats[[yLabel]] - yZoom <- zoom$ymin <= yStats & yStats <= zoom$ymax - zoomed <- intersect(which(xZoom), which(yZoom)) - } - } - } - - # Filter rows based on highlighted and/or zoomed in events - if (!is.null(events) && !is.null(zoomed)) { - rowFilter <- intersect(events, zoomed) - } else if (!is.null(events)) { - rowFilter <- events - } else if (!is.null(zoomed)) { - rowFilter <- zoomed - } else { - rowFilter <- TRUE - } - stats <- stats[rowFilter, ] - - # Keep previously selected rows if possible - before <- isolate(getAnalysesFiltered()) - selected <- isolate(input$statsTable_rows_selected) - selected <- rownames(before)[isolate(selected)] - selected <- which(rownames(stats) %in% selected) - if (length(selected) < 1) selected <- NULL - - # Set new data - setAnalysesFiltered(stats) - - # Properly display event identifiers - rownames(stats) <- parseSplicingEvent(rownames(stats), char=TRUE) - - # Keep columns from data table (else, no data will be rendered) - cols <- getAnalysesColumns() - stats <- stats[ , cols] - - # Check if paging should be reset - resetPaging <- isolate(getResetPaging()) - if (is.null(resetPaging)) resetPaging <- TRUE - setResetPaging(TRUE) - - # Round numbers based on significant digits - cols <- colnames(stats) - type <- sapply(cols, function(i) class(stats[[i]])) - numericCols <- cols[type == "numeric"] - - # Round numbers based on significant digits - if (nrow(stats) > 0) { - for (col in numericCols) { - stats[ , col] <- suppressWarnings( - as.numeric(signifDigits(stats[ , col]))) - } - } - replaceData(proxy, stats, resetPaging=resetPaging, - clearSelection="none") - } - }) - - # Hide table toolbar if statistical table is not displayed - observe(toggleElement( - "tableToolbar", condition=!is.null(getAnalysesData()))) - - # Discard columns from data frame containing information to render plots - discardPlotsFromTable <- function(df) { - plotCols <- TRUE - if (!is.null(df)) { - ns <- sprintf(c("%s distribution", "Survival by %s cutoff"), - analysesType) - plotCols <- -match(ns, colnames(df)) - plotCols <- plotCols[!is.na(plotCols)] - if (length(plotCols) == 0) plotCols <- TRUE - } - return(df[ , plotCols]) - } - - if (analysesType == "PSI") { - filenameText <- "Differential splicing analyses" - rownamesCol <- "AS event" - } else if (analysesType == "GE") { - filenameText <- "Differential expression analyses" - rownamesCol <- "Gene" - } - - # Download whole table - output$downloadAll <- downloadHandler( - filename=paste(getCategory(), filenameText), - content=function(file) { - stats <- getAnalysesData() - stats <- discardPlotsFromTable(stats) - - # Include updated survival analyses - optimSurv <- getAnalysesSurvival() - if (!is.null(optimSurv)) { - cols <- sprintf(c("Optimal %s cutoff", "Log-rank p-value"), - analysesType) - stats[[cols[[1]]]] <- optimSurv[[1]] - stats[[cols[[2]]]] <- optimSurv[[2]] - } - - stats <- cbind(rownames(stats), stats) - colnames(stats)[[1]] <- rownamesCol - write.table(stats, file, quote=FALSE, sep="\t", row.names=FALSE) - } - ) - - # Download filtered table - output$downloadSubset <- downloadHandler( - filename=paste(getCategory(), filenameText), - content=function(file) { - stats <- getAnalysesFiltered() - stats <- discardPlotsFromTable(stats) - stats <- stats[input$statsTable_rows_all, ] - - stats <- cbind(rownames(stats), stats) - colnames(stats)[[1]] <- rownamesCol - write.table(stats, file, quote=FALSE, sep="\t", row.names=FALSE) - } - ) - - # Create groups based on a given filter - groupBasedOnAnalysis <- function(filter, description="") { - stats <- getAnalysesFiltered() - stats <- discardPlotsFromTable(stats) - stats <- stats[filter, ] - - if (analysesType == "PSI") { - ASevents <- rownames(stats) - genes <- unique(names(getGenesFromSplicingEvents(ASevents))) - origin <- "Selection from differential splicing analysis" - } else if (analysesType == "GE") { - genes <- rownames(stats) - - ASevents <- getASevents() - if ( !is.null(ASevents) ) - ASevents <- getSplicingEventFromGenes(genes, ASevents) - else - ASevents <- character(0) - - origin <- "Selection from differential expression analysis" - } - - group <- cbind("Names"="DFS selection", "Subset"=origin, "Input"=origin, - "ASevents"=list(ASevents), "Genes"=list(genes)) - appendNewGroups("ASevents", group) - infoModal( - session, title="New group created", - "New group created", description, "and containing:", - div(style="font-size: 22px;", length(ASevents), "splicing events"), - div(style="font-size: 22px;", length(genes), "genes")) - } - - if (analysesType == "PSI") groupedElements <- "splicing events" - else if (analysesType == "GE") groupedElements <- "genes" - groupsText <- sprintf(c("based on the %s shown in the table", - "based on selected %s"), groupedElements) - - # Create groups based on splicing events displayed in the table - observeEvent(input$groupByDisplayed, groupBasedOnAnalysis( - input$statsTable_rows_all, groupsText[[1]])) - - # Create groups based on selected splicing events - observeEvent(input$groupBySelected, groupBasedOnAnalysis( - input$statsTable_rows_selected, groupsText[[2]])) - - # Disable groups based on selected AS events when no groups are selected - observe(toggleState("groupBySelectedContainer", - !is.null(input$statsTable_rows_selected))) -} - attr(analysesUI, "loader") <- "app" attr(analysesServer, "loader") <- "app" \ No newline at end of file diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index 25595e17..89dbd19e 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -108,6 +108,7 @@ correlationUI <- function(id) { #' @param gene Character: genes to look for #' #' @return Gene expression subset for the input genes +#' @keywords internal subsetGeneExpressionFromMatchingGenes <- function(geneExpr, gene) { # Start by matching input genes with genes in gene expression exactMatch <- match(gene, rownames(geneExpr)) @@ -145,6 +146,7 @@ subsetGeneExpressionFromMatchingGenes <- function(geneExpr, gene) { #' @param gene Character: gene #' #' @return Character vector containing alternative splicing events +#' @keywords internal findASeventsFromGene <- function(psi, gene) { # If no AS events are discriminated, find AS events for the given genes ASevents <- rownames(psi) @@ -254,7 +256,7 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' Display results of correlation analyses #' -#' @param corr \code{GEandAScorrelation} object (obtained after running +#' @param x \code{GEandAScorrelation} object (obtained after running #' \code{\link{correlateGEandAS}}) #' @param loessSmooth Boolean: plot a smooth curve computed by #' \code{stats::loess.smooth}? @@ -305,7 +307,7 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' Tumour=paste("Cancer", 1:3)) #' attr(colourGroups, "Colour") <- c(Normal="#00C65A", Tumour="#EEE273") #' plot(corr, colourGroups=colourGroups, alpha=1) -plotCorrelation <- function(corr, autoZoom=FALSE, loessSmooth=TRUE, +plotCorrelation <- function(x, autoZoom=FALSE, loessSmooth=TRUE, loessFamily=c("gaussian", "symmetric"), colour="black", alpha=0.2, size=1.5, loessColour="red", loessAlpha=1, loessWidth=0.5, @@ -386,7 +388,7 @@ plotCorrelation <- function(corr, autoZoom=FALSE, loessSmooth=TRUE, return(plot + theme_light(fontSize)) } - lapply(corr, lapply, plotCorrPerASevent) + lapply(x, lapply, plotCorrPerASevent) } #' @rdname plotCorrelation @@ -395,8 +397,8 @@ plot.GEandAScorrelation <- plotCorrelation #' @rdname plotCorrelation #' @export -print.GEandAScorrelation <- function(corr) { - for (item in corr) { +print.GEandAScorrelation <- function(x, ...) { + for (item in x) { for (elem in item) { consoleWidth <- options("width") cat(paste(rep("=", consoleWidth), collapse=""), fill=TRUE) @@ -426,17 +428,17 @@ print.GEandAScorrelation <- function(corr) { #' \item{\code{hommel}: Hommel's method (family-wise error rate)} #' } #' @export -as.table.GEandAScorrelation <- function (corr, pvalueAdjust="BH") { +as.table.GEandAScorrelation <- function (x, pvalueAdjust="BH", ...) { prepareCol <- function(object, FUN) unlist(lapply(object, lapply, FUN)) - gene <- prepareCol(corr, function(i) i[["gene"]]) - gene <- prepareCol(corr, function(i) i[["gene"]]) - eventID <- prepareCol(corr, function(i) i[["eventID"]]) + gene <- prepareCol(x, function(i) i[["gene"]]) + gene <- prepareCol(x, function(i) i[["gene"]]) + eventID <- prepareCol(x, function(i) i[["eventID"]]) eventID <- gsub("_", " ", eventID, fixed=TRUE) - estimate <- prepareCol(corr, function(i) i[["cor"]][["estimate"]][[1]]) - pvalue <- prepareCol(corr, function(i) i[["cor"]][["p.value"]]) - method <- prepareCol(corr, function(i) i[["cor"]][["method"]]) + estimate <- prepareCol(x, function(i) i[["cor"]][["estimate"]][[1]]) + pvalue <- prepareCol(x, function(i) i[["cor"]][["p.value"]]) + method <- prepareCol(x, function(i) i[["cor"]][["method"]]) qvalue <- p.adjust(pvalue, method=pvalueAdjust) qvalueLabel <- sprintf("p-value (%s adjusted)", pvalueAdjust) diff --git a/R/analysis_diffExpression_table.R b/R/analysis_diffExpression_table.R index 0519df4a..f7b56bd2 100644 --- a/R/analysis_diffExpression_table.R +++ b/R/analysis_diffExpression_table.R @@ -160,6 +160,7 @@ diffExpressionTableUI <- function(id) { #' @importFrom limma eBayes lmFit topTable #' #' @inherit diffExpressionTableServer +#' @keywords internal diffExpressionSet <- function(session, input, output) { ns <- session$ns diff --git a/R/analysis_diffSplicing_table.R b/R/analysis_diffSplicing_table.R index 5377b47c..ab7a7f96 100644 --- a/R/analysis_diffSplicing_table.R +++ b/R/analysis_diffSplicing_table.R @@ -205,6 +205,7 @@ diffSplicingTableUI <- function(id) { #' #' @return Survival data including optimal PSI cutoff, minimal survival p-value #' and HTML element required to plot survival curves +#' @keywords internal createOptimalSurvData <- function(eventPSI, clinical, censoring, event, timeStart, timeStop, match, patients, samples) { @@ -245,6 +246,7 @@ createOptimalSurvData <- function(eventPSI, clinical, censoring, event, #' @param output Shiny output #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal optimSurvDiffSet <- function(session, input, output) { ns <- session$ns @@ -286,8 +288,8 @@ optimSurvDiffSet <- function(session, input, output) { } }) - #' Calculate optimal survival cutoff for the inclusion levels of a given - #' alternative splicing event + # Calculate optimal survival cutoff for the inclusion levels of a given + # alternative splicing event observeEvent(input$survival, { time <- startProcess("survival") isolate({ @@ -419,6 +421,7 @@ optimSurvDiffSet <- function(session, input, output) { #' @importFrom shinyBS updateCollapse #' #' @inherit diffSplicingTableServer +#' @keywords internal diffSplicingSet <- function(session, input, output) { ns <- session$ns diff --git a/R/analysis_dimReduction.R b/R/analysis_dimReduction.R index dd73f9c2..3a50ec29 100644 --- a/R/analysis_dimReduction.R +++ b/R/analysis_dimReduction.R @@ -18,6 +18,7 @@ #' #' @return PCA result in a \code{prcomp} object or ICA result #' object +#' @keywords internal reduceDimensionality <- function(data, type=c("pca", "ica"), center=TRUE, scale.=FALSE, naTolerance=NULL, missingValues=round(0.05 * ncol(data)), ...) { @@ -91,6 +92,7 @@ reduceDimensionality <- function(data, type=c("pca", "ica"), center=TRUE, #' @importFrom grDevices chull #' #' @return \code{highcharter} object +#' @keywords internal plotClusters <- function(hc, data, clustering) { for ( each in sort(unique(clustering)) ) { df <- data[clustering == each, , drop=FALSE] diff --git a/R/analysis_dimReduction_ica.R b/R/analysis_dimReduction_ica.R index 7396ad4c..7a9ff4a8 100644 --- a/R/analysis_dimReduction_ica.R +++ b/R/analysis_dimReduction_ica.R @@ -33,9 +33,10 @@ performICA <- function(data, n.comp=min(5, ncol(data)), center=TRUE, #' @inheritDotParams pairsD3::pairsD3 -x #' #' @importFrom pairsD3 pairsD3 -#' @return Multiple scatterplots as a \code{pairsD3} object #' +#' @return Multiple scatterplots as a \code{pairsD3} object #' @export +#' #' @examples #' data <- scale(USArrests) #' ica <- fastICA::fastICA(data, n.comp=4) @@ -67,7 +68,9 @@ plotICA <- function(ica, components=seq(10), groups=NULL, ...) { #' samples (use clinical or sample groups) #' #' @importFrom highcharter highchart hc_chart hc_xAxis hc_yAxis hc_tooltip %>% +#' #' @return Scatterplot as an \code{highcharter} object +#' @keywords internal #' #' @examples #' ica <- performICA(USArrests, scale=TRUE) @@ -257,6 +260,7 @@ icaUI <- function(id) { #' @importFrom pairsD3 renderPairsD3 #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal clusterICAset <- function(session, input, output) { clusterICA <- reactive({ algorithm <- input$clusteringMethod diff --git a/R/analysis_dimReduction_pca.R b/R/analysis_dimReduction_pca.R index de676991..67b94d72 100644 --- a/R/analysis_dimReduction_pca.R +++ b/R/analysis_dimReduction_pca.R @@ -12,7 +12,7 @@ #' @export #' #' @seealso \code{\link{plotPCA}}, \code{\link{performICA}} and -#' \code{\link{plotICA}} +#' \code{\link{plotICA}} #' #' @examples #' performPCA(USArrests) @@ -166,15 +166,15 @@ pcaUI <- function(id) { ) } -#' Create the explained variance plot +#' Create the explained variance plot from a PCA #' -#' @param pca PCA values +#' @param pca \code{prcomp} object #' #' @importFrom highcharter highchart hc_chart hc_title hc_add_series #' hc_plotOptions hc_xAxis hc_yAxis hc_legend hc_tooltip hc_exporting #' @importFrom shiny tags #' -#' @return Plot variance as an Highcharter object +#' @return Plot variance as an \code{highchart} object #' @export #' @examples #' pca <- prcomp(USArrests) @@ -279,16 +279,16 @@ calculateLoadingsContribution <- function(pca, pcX=1, pcY=2) { #' @param pcY Character: name of the Y axis of interest from the PCA #' @param groups Matrix: groups to plot indicating the index of interest of the #' samples (use clinical or sample groups) -#' @param individuals Boolean: plot PCA individuals (TRUE by default) -#' @param loadings Boolean: plot PCA loadings/rotations (FALSE by default) +#' @param individuals Boolean: plot PCA individuals +#' @param loadings Boolean: plot PCA loadings/rotations #' @param nLoadings Integer: Number of variables to plot, ordered by those that #' most contribute to selected principal components (this allows for faster -#' performance as only the variables that most contribute are rendered); if -#' NULL, all variables are plotted +#' performance as only the most contributing variables are rendered); if +#' \code{NULL}, all variables are plotted #' #' @importFrom highcharter highchart hc_chart hc_xAxis hc_yAxis hc_tooltip %>% #' tooltip_table -#' @return Scatterplot as an \code{highcharter} object +#' @return Scatterplot as an \code{highchart} object #' #' @export #' @examples @@ -382,6 +382,7 @@ plotPCA <- function(pca, pcX=1, pcY=2, groups=NULL, individuals=TRUE, #' @importFrom shiny renderTable tableOutput #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal clusterSet <- function(session, input, output) { clusterPCA <- reactive({ algorithm <- input$clusteringMethod diff --git a/R/analysis_information.R b/R/analysis_information.R index cd81da33..96b53b82 100644 --- a/R/analysis_information.R +++ b/R/analysis_information.R @@ -11,6 +11,7 @@ #' @importFrom jsonlite fromJSON #' #' @return Parsed response or NULL if there's no response +#' @keywords internal #' #' @examples #' path <- "overlap/region/human/7:140424943-140624564" @@ -31,6 +32,48 @@ queryEnsembl <- function(path, query, grch37 = TRUE) { return(fromJSON(r)) } +#' Query information from Ensembl +#' +#' @param gene Character: gene +#' @param species Character: species (may be \code{NULL} for an Ensembl +#' identifier) +#' @param assembly Character: assembly version (may be NULL for an Ensembl +#' identifier) +#' +#' @return Information from Ensembl +#' @export +#' +#' @examples +#' queryEnsemblByGene("BRCA1", "human", "hg19") +#' queryEnsemblByGene("ENSG00000139618") +queryEnsemblByGene <- function(gene, species=NULL, assembly=NULL) { + if ( grepl("^ENSG", gene) ) { + path <- paste0("lookup/id/", gene) + info <- queryEnsembl(path, list(expand=1)) + } 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) + } + return(info) +} + +#' @rdname queryEnsemblByGene +#' +#' @param event Character: alternative splicing event +#' +#' @export +#' @examples +#' event <- "SE_17_-_41251792_41249306_41249261_41246877_BRCA1" +#' queryEnsemblByEvent(event, species="human", assembly="hg19") +queryEnsemblByEvent <- function(event, species, assembly) { + gene <- parseSplicingEvent(event)$gene[[1]] + if (gene == "Hypothetical") stop("This event has no associated gene") + return(queryEnsemblByGene(gene, species, assembly)) +} + #' Query the UniProt REST API #' #' @param molecule Character: protein or transcript to query @@ -40,7 +83,8 @@ queryEnsembl <- function(path, query, grch37 = TRUE) { #' @importFrom jsonlite fromJSON #' #' @return Parsed response -#' +#' @keywords internal +#' #' @examples #' protein <- "P51587" #' format <- "xml" @@ -71,6 +115,7 @@ queryUniprot <- function(molecule, format="xml") { #' @importFrom jsonlite fromJSON #' #' @return Parsed response +#' @keywords internal #' #' @examples #' psichomics:::queryPubMed("BRCA1", "cancer", "adrenocortical carcinoma") @@ -109,6 +154,7 @@ queryPubMed <- function(primary, ..., top=3, field="abstract", #' #' @return UniProt protein identifier #' @export +#' #' @examples #' gene <- "ENSG00000173262" #' ensemblToUniprot(gene) @@ -162,6 +208,7 @@ infoUI <- function(id) { #' @importFrom shiny renderUI h3 br tags #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal noinfo <- function(output, description=paste( "No information available for this gene."), ...) { output$info <- renderUI( @@ -175,6 +222,7 @@ noinfo <- function(output, description=paste( #' @importFrom XML xmlTreeParse xmlRoot xmlAttrs xmlToList xmlName xmlChildren #' @importFrom plyr ldply #' @return List containing protein length and data frame of protein features +#' @keywords internal parseUniprotXML <- function(xml) { doc <- xmlTreeParse(xml) root <- xmlRoot(doc)[[1]] @@ -311,6 +359,7 @@ plotProtein <- function(molecule) { #' @importFrom jsonlite toJSON #' #' @return HTML elements +#' @keywords internal plottableXranges <- function(hc, shiny=FALSE) { hc <- toJSON(hc$x$hc_opts, auto_unbox=TRUE) hc <- gsub('"---|---"', "", hc) @@ -533,7 +582,9 @@ plotTranscripts <- function(info, eventPosition=NULL, event=NULL, shiny=FALSE) { #' @param grch37 Boolean: use version GRCh37 of the genome? FALSE by default #' #' @importFrom shiny renderUI h2 h3 plotOutput +#' #' @return HTML elements to render gene, protein and transcript annotation +#' @keywords internal renderGeneticInfo <- function(output, ns, info, species=NULL, assembly=NULL, grch37=FALSE) { start <- as.numeric(info$start) @@ -609,50 +660,6 @@ renderGeneticInfo <- function(output, ns, info, species=NULL, assembly=NULL, highchartOutput(ns("plotProtein"), height="200px")) } -#' Query information from Ensembl by a given alternative splicing event -#' -#' @param event Character: alternative splicing event identifier -#' @inheritDotParams queryEnsemblByGene -gene -#' -#' @return Information from Ensembl -#' @export -#' @examples -#' event <- c("SE_17_-_41251792_41249306_41249261_41246877_BRCA1") -#' queryEnsemblByEvent(event, species="human", assembly="hg19") -queryEnsemblByEvent <- function(event, ...) { - gene <- parseEvent(event)$gene[[1]] - if (gene == "Hypothetical") - stop("This event has no associated gene") - return(queryEnsemblByGene(gene, ...)) -} - -#' Query information from Ensembl by a given gene -#' -#' @param gene Character: gene identifier -#' @param species Character: species (can be NULL when handling an Ensembl -#' identifier) -#' @param assembly Character: assembly version (can be NULL when handling an -#' Ensembl identifier) -#' -#' @return Information from Ensembl -#' @export -#' @examples -#' queryEnsemblByGene("BRCA1", "human", "hg19") -#' queryEnsemblByGene("ENSG00000139618") -queryEnsemblByGene <- function(gene, species=NULL, assembly=NULL) { - if ( grepl("^ENSG", gene) ) { - path <- paste0("lookup/id/", gene) - info <- queryEnsembl(path, list(expand=1)) - } 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) - } - return(info) -} - #' Return the interface to display an article #' #' @param article PubMed article @@ -660,6 +667,7 @@ queryEnsemblByGene <- function(gene, species=NULL, assembly=NULL) { #' @importFrom shiny tags h5 #' #' @return HTML to render an article's interface +#' @keywords internal articleUI <- function(article) { authors <- article$authors$name if (length(authors) > 2) { @@ -693,6 +701,7 @@ articleUI <- function(article) { #' @inheritDotParams queryPubMed -primary #' #' @return HTML interface of relevant PubMed articles +#' @keywords internal pubmedUI <- function(gene, ...) { pubmed <- queryPubMed(gene, ...) articles <- pubmed[-1] @@ -721,6 +730,7 @@ pubmedUI <- function(gene, ...) { #' @param assembly Character: assembly #' #' @return HTML elements +#' @keywords internal renderProteinInfo <- function(protein, transcript, species, assembly) { if (!is.null(protein)) { # Prepare protein name and length diff --git a/R/analysis_survival.R b/R/analysis_survival.R index a509a778..6bfe2245 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -147,6 +147,7 @@ survivalUI <- function(id) { #' @param coxph Boolean: prepare data for Cox models? FALSE by default #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal checkSurvivalInput <- function (session, input, coxph=FALSE) { ns <- session$ns @@ -285,6 +286,7 @@ checkSurvivalInput <- function (session, input, coxph=FALSE) { #' @importFrom shinyjs show hide #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal geneExprSurvSet <- function(session, input, output) { # Update available gene expression data choices observe({ diff --git a/R/app.R b/R/app.R index 4340579a..46ec4814 100644 --- a/R/app.R +++ b/R/app.R @@ -11,10 +11,12 @@ options(shiny.maxRequestSize = MB * 1024^5) # Sanitize errors options(shiny.sanitize.errors = TRUE) -#' Interface that directs users to original article +#' psichomics article's link interface #' #' @importFrom shiny tags icon +#' #' @return HTML elements +#' @keywords internal linkToArticle <- function() { authors <- c("Nuno Saraiva-Agostinho", "Nuno L Barbosa-Morais") title <- paste("psichomics: graphical application for alternative", @@ -35,6 +37,7 @@ linkToArticle <- function() { #' @param loader Character: name of the file responsible to load such function #' @param FUN Function #' @return Boolean vector +#' @keywords internal loadBy <- function(loader, FUN) { attribute <- attr(FUN, "loader") if (is.null(attribute)) @@ -49,6 +52,7 @@ loadBy <- function(loader, FUN) { #' #' @importFrom shiny callModule #' @return Invisible TRUE +#' @keywords internal getServerFunctions <- function(loader, ..., priority=NULL) { # Get all functions ending with "Server" server <- ls(getNamespace("psichomics"), all.names=TRUE, pattern="Server$") @@ -77,6 +81,7 @@ getServerFunctions <- function(loader, ..., priority=NULL) { #' then remaining functions #' #' @return List of functions related to the given loader +#' @keywords internal getUiFunctions <- function(ns, loader, ..., priority=NULL) { # Get all functions ending with "UI" ui <- ls(getNamespace("psichomics"), all.names=TRUE, pattern="UI$") @@ -108,6 +113,7 @@ getUiFunctions <- function(ns, loader, ..., priority=NULL) { #' @importFrom shiny selectizeInput tagAppendAttributes #' #' @return HTML element for a global selectize input +#' @keywords internal globalSelectize <- function(id, placeholder) { elem <- paste0(id, "Elem") hideElem <- sprintf("$('#%s')[0].style.display = 'none';", id) @@ -124,9 +130,12 @@ globalSelectize <- function(id, placeholder) { } #' Create a special selectize input in the navigation bar +#' #' @inheritParams globalSelectize #' @param label Character: input label +#' #' @return HTML element to be included in a navigation bar +#' @keywords internal navSelectize <- function(id, label, placeholder=label) { value <- paste0(id, "Value") tags$li( tags$div( @@ -151,7 +160,9 @@ navSelectize <- function(id, label, placeholder=label) { #' @param menu Boolean: create a dropdown menu-like tab? FALSE by default #' #' @importFrom shiny navbarMenu tabPanel +#' #' @return HTML interface +#' @keywords internal modTabPanel <- function(title, ..., icon=NULL, menu=FALSE) { if (is.null(icon)) display <- title @@ -224,6 +235,7 @@ appUI <- function() { #' @importFrom shiny observe parseQueryString updateTabsetPanel #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal browserHistory <- function(navId, input, session) { # Update browser history when user changes the active tab observeEvent(input[[navId]], { @@ -333,18 +345,18 @@ appServer <- function(input, output, session) { #' Start graphical interface of psichomics #' #' @inheritDotParams shiny::runApp -appDir -launch.browser -#' @param reset Boolean: reset Shiny session? requires the package -#' \code{devtools} to reset data +#' @param reset Boolean: reset Shiny session? Requires package \code{devtools} #' @param testData Boolean: auto-start with test data #' #' @importFrom shiny shinyApp runApp addResourcePath #' +#' @return NULL (this function is used to modify the Shiny session's state) #' @export -#' @examples +#' +#' @examples #' \dontrun{ #' psichomics() #' } -#' @return NULL (this function is used to modify the Shiny session's state) psichomics <- function(..., reset=FALSE, testData=FALSE) { # Add icons related to set operations addResourcePath("set-operations", diff --git a/R/data.R b/R/data.R index 7b261b35..8af3c7e7 100644 --- a/R/data.R +++ b/R/data.R @@ -31,6 +31,7 @@ getFirehoseDataTypes <- getFirebrowseDataTypes #' @param ... Named parameters to convert to attributes #' #' @return Object with attributes set +#' @keywords internal #' #' @examples #' ll <- list(a="hey", b="there") @@ -87,6 +88,7 @@ parseTCGAsampleInfo <- parseTcgaSampleInfo #' @param data List of list of data frames #' #' @return List of list of data frames +#' @keywords internal loadTCGAsampleMetadata <- function(data) { for (i in seq(data)) { # Retrieve sample metadata from junction quantification @@ -120,12 +122,15 @@ loadTCGAsampleMetadata <- function(data) { return(data) } -#' Create a modal warning the user of already loaded data +#' Warn user about loaded data +#' #' @param modalId Character: identifier of the modal #' @param replaceButtonId Character: identifier of the button to replace data #' @param keepButtonId Character: identifier of the button to append data #' @param session Shiny session +#' #' @return HTML elements for a warning modal reminding data is loaded +#' @keywords internal loadedDataModal <- function(session, modalId, replaceButtonId, keepButtonId) { ns <- session$ns warningModal(session, "Data already loaded", @@ -147,6 +152,7 @@ loadedDataModal <- function(session, modalId, replaceButtonId, keepButtonId) { #' @param data List of lists of data frames #' #' @return Processed list of lists of data frames +#' @keywords internal processDatasetNames <- function(data) { newData <- data # Avoid duplicate names in categories @@ -185,6 +191,7 @@ processDatasetNames <- function(data) { #' @param geneExprFileId Character: identifier for gene expression input #' #' @return HTML elements +#' @keywords internal geneExprFileInput <- function(geneExprFileId) { fileBrowserInput( geneExprFileId, @@ -214,6 +221,7 @@ geneExprFileInput <- function(geneExprFileId) { #' @param assemblyId Character: identifier for genome assembly selection input #' #' @return HTML elements +#' @keywords internal ASquantFileInput <- function(ASquantFileId, speciesId, assemblyId){ tagList( fileBrowserInput( @@ -350,6 +358,7 @@ dataUI <- function(id, tab) { #' downloadButton #' #' @return HTML elements +#' @keywords internal tabDataset <- function(ns, title, tableId, columns, visCols, data, description=NULL, icon=NULL) { tablename <- ns(paste("table", tableId, sep="-")) @@ -425,6 +434,7 @@ tabDataset <- function(ns, title, tableId, columns, visCols, data, #' @importFrom shinyjs show hide #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal createDataTab <- function(index, data, name, session, input, output) { tablename <- paste("table", name, index, sep="-") diff --git a/R/data_firebrowse.R b/R/data_firebrowse.R index 1a9c7a75..75c49584 100644 --- a/R/data_firebrowse.R +++ b/R/data_firebrowse.R @@ -1,6 +1,7 @@ #' Returns the date format used by the Firebrowse web API #' #' @return Named list with Firebrowse web API's date formats +#' @keywords internal #' #' @examples #' format <- psichomics:::getFirebrowseDateFormat() @@ -16,12 +17,12 @@ getFirebrowseDateFormat <- function() { return(list(query=query, response=response)) } -#' @aliases getFirebrowseDateFormat -getFirehoseDateFormat <- getFirebrowseDateFormat - #' Parse the date from a response +#' #' @param string Character: dates +#' #' @return Parsed date +#' @keywords internal parseDateResponse <- function(string) { format <- getFirebrowseDateFormat()$response date <- strsplit(string, " ") @@ -36,13 +37,13 @@ parseDateResponse <- function(string) { #' this is not the status code obtained from the API, the function will raise a #' warning with the status code and a brief explanation. #' +#' @importFrom httr GET warn_for_status http_error +#' @importFrom methods is +#' #' @return Invisible TRUE if the Firebrowse web API is working; otherwise, #' raises a warning #' @export #' -#' @importFrom httr GET warn_for_status http_error -#' @importFrom methods is -#' #' @examples #' isFirebrowseUp() isFirebrowseUp <- function() { @@ -58,9 +59,6 @@ isFirebrowseUp <- function() { } } -#' @rdname isFirebrowseUp -isFirehoseUp <- isFirebrowseUp - #' Query the Firebrowse web API for TCGA data #' #' @param format Character: response format as \code{JSON} (default), \code{CSV} @@ -82,9 +80,10 @@ isFirehoseUp <- isFirebrowseUp #' @param sort_by String: column used to sort the data (by default, it sorts by #' cohort) #' -#' @return Response from the Firebrowse web API (it needs to be parsed) -#' #' @importFrom httr GET +#' +#' @return Response from the Firebrowse web API (it needs to be parsed) +#' @keywords internal #' #' @examples #' cohort <- psichomics:::getFirebrowseCohorts()[1] @@ -122,18 +121,16 @@ queryFirebrowseData <- function(format = "json", date = NULL, cohort = NULL, return(response) } -#' @rdname queryFirebrowseData -queryFirehoseData <- queryFirebrowseData - #' Query the Firebrowse web API for metadata #' #' @param type Character: metadata to retrieve #' @param ... Character: parameters to pass to query (optional) -#' -#' @return List with parsed response -#' +#' #' @importFrom httr GET content #' @importFrom jsonlite fromJSON +#' +#' @return List with parsed response +#' @keywords internal #' #' @examples #' psichomics:::parseFirebrowseMetadata("Dates") @@ -159,15 +156,9 @@ parseFirebrowseMetadata <- function(type, ...) { return(response) } -#' @rdname parseFirebrowseMetadata -parseFirehoseMetadata <- parseFirebrowseMetadata - -#' @rdname parseFirebrowseMetadata -parseTCGAmetadata <- parseFirebrowseMetadata - -#' Query the Firebrowse web API for the available data datestamps +#' Query the Firebrowse web API #' -#' @return Parsed date with datestamps of the data available +#' @return Parsed response #' @export #' #' @examples @@ -180,17 +171,8 @@ getFirebrowseDates <- function() { } #' @rdname getFirebrowseDates -getFirehoseDates <- getFirebrowseDates - -#' @rdname getFirebrowseDates -getTCGAdates <- getFirebrowseDates - -#' Query the Firebrowse web API for available cohorts -#' -#' @param cohort Character: filter by given cohorts (optional) #' -#' @return Character with cohort abbreviations (as values) and description (as -#' names) +#' @param cohort Character: filter results by given cohorts (optional) #' @export #' #' @examples @@ -202,12 +184,6 @@ getFirebrowseCohorts <- function(cohort = NULL) { return(cohorts) } -#' @rdname getFirebrowseCohorts -getFirehoseCohorts <- getFirebrowseCohorts - -#' @rdname getFirebrowseCohorts -getTCGAcohorts <- getFirebrowseCohorts - #' Download files to a given directory #' #' @param url Character: download links @@ -218,7 +194,8 @@ getTCGAcohorts <- getFirebrowseCohorts #' @importFrom utils download.file #' #' @return Invisible TRUE if every file was successfully downloaded -#' +#' @keywords internal +#' #' @examples #' \dontrun{ #' url <- paste0("https://unsplash.it/400/300/?image=", 570:572) @@ -249,6 +226,7 @@ downloadFiles <- function(url, folder, download = download.file, ...) { #' #' @return Logical vector showing TRUE for files with matching \code{md5sums} #' and \code{FALSE} for files with non-matching \code{md5sums} +#' @keywords internal checkIntegrity <- function(filesToCheck, md5file) { if (is.na(md5file)) return(FALSE) md5sums <- digest(file = filesToCheck) @@ -271,6 +249,7 @@ checkIntegrity <- function(filesToCheck, md5file) { #' @importFrom utils untar #' #' @return Invisible TRUE if successful +#' @keywords internal #' #' @examples #' file <- paste0( @@ -333,21 +312,16 @@ prepareFirebrowseArchives <- function(archive, md5, folder, outdir) { return(invisible(TRUE)) } -#' @rdname prepareFirebrowseArchives -prepareFirehoseArchives <- prepareFirebrowseArchives - -#' @rdname prepareFirebrowseArchives -prepareTCGAarchives <- prepareFirebrowseArchives - #' Retrieve URLs from a response to a Firebrowse data query #' #' @param res Response from \code{httr::GET} to a Firebrowse data query -#' -#' @return Named character with URLs #' #' @importFrom jsonlite fromJSON #' @importFrom httr content #' +#' @return Named character with URLs +#' @keywords internal +#' #' @examples #' res <- psichomics:::queryFirebrowseData(cohort = "ACC") #' url <- psichomics:::parseUrlsFromFirebrowseResponse(res) @@ -370,9 +344,6 @@ parseUrlsFromFirebrowseResponse <- function(res) { return(link) } -#' @rdname parseUrlsFromFirebrowseResponse -parseUrlsFromFirehoseResponse <- parseUrlsFromFirebrowseResponse - #' Load Firebrowse folders #' #' Loads the files present in each folder as a data.frame. @@ -387,6 +358,7 @@ parseUrlsFromFirehoseResponse <- parseUrlsFromFirebrowseResponse #' @param exclude Character: files to exclude from the loading #' #' @return List with loaded data.frames +#' @keywords internal loadFirebrowseFolders <- function(folder, exclude="") { # Retrieve full path of the files inside the given folders files <- dir(folder, full.names=TRUE) @@ -409,12 +381,6 @@ loadFirebrowseFolders <- function(folder, exclude="") { return(loaded) } -#' @rdname loadFirebrowseFolders -loadFirehoseFolders <- loadFirebrowseFolders - -#' @rdname loadFirebrowseFolders -loadTCGAfolders <- loadFirebrowseFolders - #' Downloads and processes data from the Firebrowse web API and loads it into R #' #' @param folder Character: directory to store the downloaded archives (by @@ -552,17 +518,13 @@ loadFirebrowseData <- function(folder=NULL, data=NULL, return(loaded) } -#' @rdname loadFirebrowseData -loadFirehoseData <- loadFirebrowseData - -#' @rdname loadFirebrowseData -loadTCGAdata <- loadFirebrowseData - #' Creates a UI set with options to add data from TCGA/Firebrowse #' @param ns Namespace function #' #' @importFrom shiny tagList uiOutput selectizeInput actionButton textAreaInput +#' #' @return A UI set that can be added to a UI definition +#' @keywords internal addTCGAdata <- function(ns) { cohorts <- getFirebrowseCohorts() acronyms <- names(cohorts) @@ -640,6 +602,7 @@ firebrowseUI <- function(id, panel) { #' @importFrom shinyjs hide #' #' @return HTML elements +#' @keywords internal checkFirebrowse <- function(ns) { startProgress("Checking Firebrowse API to retrieve TCGA data...", 1) if (isFirebrowseUp()) { @@ -668,6 +631,7 @@ checkFirebrowse <- function(ns) { #' @importFrom shinyBS bsTooltip #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal setFirebrowseData <- function(input, output, session, replace=TRUE) { ns <- session$ns time <- startProcess("getFirebrowseData") diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 67ee6506..51ff6658 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -7,6 +7,7 @@ #' @importFrom shinyjs hidden #' #' @return HTML elements +#' @keywords internal geNormalisationFilteringInterface <- function(ns) { filters <- div( id=ns("filteringInterface"), @@ -144,9 +145,12 @@ normaliseGeneExpression <- function(geneExpr, geneFilter=NULL, method="TMM", #' Set of functions to load splicing quantification #' +#' @inherit geNormalisationFilteringServer +#' #' @importFrom shiny tags #' @importFrom shinyBS bsPopover -#' @inherit geNormalisationFilteringServer +#' +#' @keywords internal loadGeneExpressionSet <- function(session, input, output) { ns <- session$ns @@ -187,7 +191,6 @@ loadGeneExpressionSet <- function(session, input, output) { else errorAlert(session, title="An error was raised", geneExpr$message, alertId="alertGeneExpr", - caller="Gene expression normalisation and filtering", caller="Gene expression normalisation and filtering") } else if (is(geneExpr, "warning")) { warningAlert(session, title="A warning was raised", @@ -228,6 +231,8 @@ loadGeneExpressionSet <- function(session, input, output) { #' @importFrom shinyjs enable disable hide show #' @importFrom data.table fread #' @importFrom highcharter hcboxplot hc_plotOptions hc_xAxis hc_chart +#' +#' @keywords internal geNormalisationFilteringServer <- function(input, output, session) { ns <- session$ns observeEvent(input$missing, missingDataGuide("Gene expression")) diff --git a/R/data_gtex.R b/R/data_gtex.R index 8fbccd30..4eab14b4 100644 --- a/R/data_gtex.R +++ b/R/data_gtex.R @@ -67,9 +67,6 @@ getGtexTissues <- function(sampleMetadata) { return(tissues) } -#' @rdname getGtexTissues -getGTExTissues <- getGtexTissues - #' Load GTEx file #' #' @param path Character: path to file @@ -77,6 +74,7 @@ getGTExTissues <- getGtexTissues #' @param samples Character: samples to filter datasets #' #' @return Loaded file as a data frame +#' @keywords internal loadGtexFile <- function(path, pattern, samples=NULL) { if (!is.null(path)) { if (!is.character(path) && !is.null(path$datapath)) @@ -222,6 +220,7 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, #' @param replace Boolean: replace loaded data? TRUE by default #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal loadGtexDataShiny <- function(session, input, replace=TRUE) { tissue <- input$tissues diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index d0280e05..2975e5b1 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -20,6 +20,8 @@ listSplicingAnnotations <- function() { #' @param ... Custom annotation loaded #' #' @return Named character vector with splicing annotation files available#' +#' @keywords internal +#' #' @examples #' psichomics:::listAllAnnotations() listAllAnnotations <- function(...) { @@ -37,6 +39,7 @@ listAllAnnotations <- function(...) { #' @importFrom shinyjs hidden disabled #' #' @return HTML elements +#' @keywords internal inclusionLevelsInterface <- function(ns) { eventTypes <- getSplicingEventTypes() names(eventTypes) <- sprintf("%s (%s)", names(eventTypes), eventTypes) @@ -130,11 +133,11 @@ inclusionLevelsUI <- function(id, panel) { #' of associated splicing events is performed (by default, all splicing events #' undergo splicing quantification) #' +#' @importFrom fastmatch %fin% +#' #' @return Data frame with the quantification of the alternative splicing events #' @export #' -#' @importFrom fastmatch %fin% -#' #' @examples #' # Calculate PSI for skipped exon (SE) and mutually exclusive (MXE) events #' annot <- readFile("ex_splicing_annotation.RDS") @@ -203,6 +206,7 @@ quantifySplicing <- function(annotation, junctionQuant, #' @return List of data frames containing the alternative splicing annotation #' per event type #' @export +#' #' @examples #' human <- listSplicingAnnotations()[[1]] #' \dontrun{ @@ -219,6 +223,8 @@ loadAnnotation <- function(annotation) { #' #' @importFrom shiny tags fileInput #' @inherit inclusionLevelsServer +#' +#' @keywords internal loadCustomSplicingAnnotationSet <- function(session, input, output) { # Show modal for loading custom splicing annotation observe({ @@ -274,9 +280,12 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { #' Set of functions to load splicing quantification #' +#' @inherit inclusionLevelsServer +#' #' @importFrom shiny tags #' @importFrom shinyBS bsPopover -#' @inherit inclusionLevelsServer +#' +#' @keywords internal loadSplicingQuantificationSet <- function(session, input, output) { ns <- session$ns @@ -391,9 +400,12 @@ loadSplicingQuantificationSet <- function(session, input, output) { } #' Read custom or remote annotation +#' #' @inherit inclusionLevelsServer #' @param annotation Character: chosen annotation #' @param showProgress Boolean: show progress? FALSE by default +#' +#' @keywords internal readAnnot <- function(session, annotation, showProgress=FALSE) { annot <- NULL if (grepl("^/var/folders/", annotation)) { # if custom annotation @@ -418,6 +430,7 @@ readAnnot <- function(session, annotation, showProgress=FALSE) { #' #' @importFrom shiny tags #' @inherit inclusionLevelsServer +#' @keywords internal quantifySplicingSet <- function(session, input) { ns <- session$ns diff --git a/R/data_local.R b/R/data_local.R index c0a3de29..a201d5fd 100644 --- a/R/data_local.R +++ b/R/data_local.R @@ -179,7 +179,7 @@ prepareJunctionQuant <- function(..., output="psichomics_junctions.txt", return(junctionQuant) } -#' @rdname prepareSRAmetadata +#' @inherit prepareSRAmetadata #' @importFrom data.table fread setnames setkeyv setorderv prepareJunctionQuantSTAR <- function(..., startOffset=-1, endOffset=+1) { if (is.null(startOffset)) startOffset <- -1 @@ -263,7 +263,7 @@ prepareGeneQuant <- function(..., output="psichomics_gene_counts.txt", return(geneQuant) } -#' @rdname prepareSRAmetadata +#' @rdname prepareJunctionQuantSTAR #' @importFrom data.table fread setnames setkeyv setorderv prepareGeneQuantSTAR <- function(..., strandedness=c("unstranded", "stranded", "stranded (reverse)")) { @@ -358,6 +358,7 @@ loadLocalFiles <- function(folder, ignore=c(".aux.", ".mage-tab."), #' @importFrom shinyjs disable enable #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal setLocalData <- function(input, output, session, replace=TRUE) { time <- startProcess("acceptFile") diff --git a/R/data_recount.R b/R/data_recount.R index 045bb76f..e40da5e9 100644 --- a/R/data_recount.R +++ b/R/data_recount.R @@ -36,6 +36,7 @@ recountDataUI <- function(id, panel) { #' @importFrom SummarizedExperiment assay seqnames start end strand #' #' @return List containing downloaded projects +#' @export loadSRAproject <- function(project, outdir=getDownloadsFolder()) { data <- list() diff --git a/R/events.R b/R/events.R index 88e037b6..c7172c14 100644 --- a/R/events.R +++ b/R/events.R @@ -14,6 +14,7 @@ NULL #' @param id Character: events' ID #' #' @return A data frame with the junctions coordinate names pre-filled with NAs +#' @keywords internal #' #' @examples #' psichomics:::createJunctionsTemplate(nrow = 8) @@ -46,6 +47,7 @@ createJunctionsTemplate <- function(nrow, program = character(0), #' #' @return Coordinates of interest according to the alternative splicing event #' type +#' @keywords internal getSplicingEventCoordinates <- function(type, sorting=FALSE) { coords <- switch(type, "SE" = c("C1.end", "A1.start", "A1.end", "C2.start"), @@ -79,6 +81,8 @@ getSplicingEventCoordinates <- function(type, sorting=FALSE) { #' default) #' #' @return Processed data matrix +#' @keywords internal +#' #' @examples #' event <- read.table(text = "ABC123 + 250 300 350 #' DEF456 - 900 800 700") @@ -112,6 +116,7 @@ getNumerics <- function(table, by = NULL, toNumeric = FALSE) { #' @param types Character: alternative splicing types #' #' @return List of events joined by alternative splicing event type +#' @keywords internal joinEventsPerType <- function(events, types) { if (missing(types)) types <- names(events) joint <- lapply(types, function(type, events) { @@ -174,6 +179,7 @@ joinEventsPerType <- function(events, types) { #' @return List of data frames with the annotation from different data frames #' joined by event type #' @export +#' #' @examples #' # Load sample files (SUPPA annotation) #' folder <- "extdata/eventsAnnotSample/suppa_output/suppaEvents" @@ -301,6 +307,7 @@ prepareAnnotationFromEvents <- function(...) { #' @param eventType Character: type of event #' #' @return Venn diagrams for a given event type +#' @keywords internal vennEvents <- function(join, eventType) { join <- join[[eventType]] @@ -321,6 +328,7 @@ vennEvents <- function(join, eventType) { #' @param showStrand Boolean: include strand? #' #' @return Formatted character string +#' @keywords internal junctionString <- function(chr, strand, junc5, junc3, showStrand) { plus <- strand == "+" first <- ifelse(plus, junc5, junc3) @@ -354,6 +362,7 @@ colsAsNumbers <- function(type, annotation) { #' #' @return List of data frames with alternative splicing events for a given #' program +#' @keywords internal sortCoordinates <- function(events) { types <- names(events) for (type in types) { @@ -388,7 +397,9 @@ sortCoordinates <- function(events) { #' quantification as valid (10 by default) #' #' @importFrom fastmatch fmatch +#' #' @return Matrix with inclusion levels +#' @keywords internal calculateInclusionLevels <- function(eventType, junctionQuant, annotation, minReads = 10) { # Immediately return NULL if ALE and AFE events are missing coordinates diff --git a/R/events_mats.R b/R/events_mats.R index 4ceac627..5b777fe4 100644 --- a/R/events_mats.R +++ b/R/events_mats.R @@ -1,7 +1,9 @@ #' @rdname parseMisoAnnotation +#' #' @param novelEvents Boolean: parse events dedected due to novel splice sites #' (TRUE by default) #' @export +#' #' @examples #' # Load sample files #' folder <- "extdata/eventsAnnotSample/mats_output/ASEvents" @@ -64,6 +66,7 @@ parseMatsAnnotation <- function( #' } #' #' @return List containing the event attributes and junctions +#' @keywords internal #' #' @examples #' # MATS event (alternative 3' splice site) @@ -141,6 +144,7 @@ parseMatsEvent <- function(event, event_type) { #' @seealso \code{\link{parseMatsEvent}} #' #' @return Data frame with parsed junctions +#' @keywords internal #' #' @examples #' # Parse generic event (in this case, an exon skipping event) diff --git a/R/events_miso.R b/R/events_miso.R index 441704d9..0b3d64e6 100644 --- a/R/events_miso.R +++ b/R/events_miso.R @@ -24,6 +24,7 @@ #' @return Retrieve data frame with events based on a given alternative splicing #' annotation #' @export +#' #' @examples #' # Load sample files #' folder <- "extdata/eventsAnnotSample/miso_annotation" @@ -67,6 +68,7 @@ parseMisoAnnotation <- function( #' #' @return Data frame subset from two row indexes (returns NA if the first row #' index is NA) +#' @keywords internal getDataRows <- function(i, data, firstRow, lastRow) { first <- firstRow[i] last <- lastRow[i] @@ -100,7 +102,8 @@ getDataRows <- function(i, data, firstRow, lastRow) { #' #' @importFrom fastmatch fmatch #' -#' @return Data frame of the matching events (or NA when nothing is matched) +#' @return Data frame of the matching events (or \code{NA} when nothing matches) +#' @keywords internal #' #' @examples #' eventID <- c("114785@uc001sok.1@uc001soj.1", "114784@uc001bxm.1@uc001bxn.1") @@ -143,6 +146,7 @@ parseMisoEventID <- function(eventID, annotation, IDcolumn) { #' elements \code{c("gene", "mRNA", "exon", "exon", "exon")}. #' #' @return Data.frame with valid events +#' @keywords internal #' #' @examples #' event <- read.table(text = " @@ -230,6 +234,7 @@ getValidEvents <- function(event, validator, areMultipleExonsValid = FALSE) { #' #' @return List with event attributes and junction positions for the exons #' (depends on the events) +#' @keywords internal #' #' @examples #' # example of alternative splicing event: skipped exon (SE) @@ -281,6 +286,7 @@ parseMisoEvent <- function(event) { #' @seealso \code{\link{parseMisoEvent}} #' #' @return List of parsed junctions +#' @keywords internal parseMisoGeneric <- function(event, validator, eventType, coord, plusIndex, minusIndex) { # Filter out events that aren't valid @@ -330,6 +336,8 @@ parseMisoGeneric <- function(event, validator, eventType, coord, plusIndex, #' @param id Character: MISO alternative splicing event identifier #' #' @return Character with the parsed ID +#' @keywords internal +#' #' @examples #' id <- paste0( #' "ID=ENSMUSG00000026150.chr1:82723803:82723911:+@chr1:82724642:82724813:", diff --git a/R/events_suppa.R b/R/events_suppa.R index a54e93f0..16e21aa3 100644 --- a/R/events_suppa.R +++ b/R/events_suppa.R @@ -1,5 +1,6 @@ #' @rdname parseMisoAnnotation #' @export +#' #' @examples #' # Load sample files #' folder <- "extdata/eventsAnnotSample/suppa_output/suppaEvents" @@ -47,6 +48,7 @@ parseSuppaAnnotation <- function( #' #' @return List with the event attributes (chromosome, strand, event type and #' the position of the exon boundaries) +#' @keywords internal #' #' @examples #' event <- "ENSG00000000419;A3:20:49557492-49557642:49557470-49557642:-" @@ -116,6 +118,7 @@ parseSuppaEvent <- function(event) { #' @seealso \code{\link{parseSuppaEvent}} #' #' @return Data frame of parsed junctions +#' @keywords internal #' #' @examples #' # Parse generic event (in this case, an exon skipping event) diff --git a/R/events_vastTools.R b/R/events_vastTools.R index 975eb6f2..a3db0d55 100644 --- a/R/events_vastTools.R +++ b/R/events_vastTools.R @@ -1,6 +1,8 @@ #' @rdname parseMisoAnnotation +#' #' @param complexEvents Boolean: should complex events in A3SS and A5SS be #' parsed? FALSE by default +#' #' @export #' @examples #' # Load sample files @@ -90,6 +92,7 @@ parseVastToolsAnnotation <- function( #' #' @return List with the event attributes (chromosome, strand, event type and #' the position of the exon boundaries) +#' @keywords internal #' #' @examples #' event <- read.table(text = @@ -173,6 +176,7 @@ parseVastToolsEvent <- function(event) { #' @seealso \code{\link{parseVastToolsEvent}} #' #' @return List of parsed junctions +#' @keywords internal #' #' @examples #' junctions <- read.table(text = "41040823 41046768 41046903 41051785") diff --git a/R/formats.R b/R/formats.R index ae58b62e..80147300 100644 --- a/R/formats.R +++ b/R/formats.R @@ -8,6 +8,7 @@ #' @param filename Character: name of the file #' #' @return TRUE if the file is of the given format; otherwise, returns FALSE +#' @keywords internal checkFileFormat <- function(format, head, filename="") { # If file name is of importance, check if the filename matches if (isTRUE(format$matchName) && !identical(filename, "") && @@ -48,6 +49,7 @@ checkFileFormat <- function(format, head, filename="") { #' @importFrom stringr str_split_fixed #' #' @return Data frame with the loaded file +#' @keywords internal loadFile <- function(format, file, ...) { ## TODO(NunoA): account for the comment character delim <- ifelse(!is.null(format$delim), format$delim, "\t") @@ -132,8 +134,10 @@ loadFile <- function(format, file, ...) { return(loaded) } -#' Loads file formats -#' @return Loaded file formats available +#' Load supported file formats +#' +#' @return Supported file formats +#' @keywords internal loadFileFormats <- function() { # Get all functions ending with "UI" fun <- ls(getNamespace("psichomics"), all.names=TRUE, pattern="Format$") @@ -172,6 +176,7 @@ loadFileFormats <- function() { #' #' @return Data frame with the contents of the given file if the file format is #' recognised; otherwise, returns NULL +#' @keywords internal parseValidFile <- function(file, formats, ...) { if (!is.list(formats[[1]])) formats <- list(formats) diff --git a/R/globalAccess.R b/R/globalAccess.R index 3eecde43..bf0322fe 100644 --- a/R/globalAccess.R +++ b/R/globalAccess.R @@ -13,6 +13,7 @@ sharedData <- reactiveValues() #' #' @return Getters return hidden globally accessible data, whereas setters #' return NULL as they are only used to modify the state of hidden elements +#' @keywords internal getHidden <- function() .hidden$elem #' @rdname getHidden @@ -28,11 +29,12 @@ setHidden <- function(val) .hidden$elem <- val #' #' @note Needs to be called inside a reactive function #' -#' @seealso \code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +#' @seealso \code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, #' \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} #' #' @return Getters return globally accessible data, whereas setters return NULL #' as they are only used to modify the Shiny session's state +#' @keywords internal getGlobal <- function(category=getCategory(), ..., sep="_") { sharedData[[paste(category, ..., sep=sep)]] } @@ -44,7 +46,9 @@ setGlobal <- function(category=getCategory(), ..., value, sep="_") { } #' Get global data +#' #' @return Variable containing all data of interest +#' @keywords internal getData <- reactive(sharedData$data) #' @rdname getGlobal @@ -91,6 +95,7 @@ getPrecision <- function() { setPrecision <- function(integer) setGlobal("precision", value=integer) #' @inherit getGlobal +#' @keywords internal getASevents <- function() { psi <- getInclusionLevels() if (!is.null(psi)) { @@ -101,19 +106,20 @@ getASevents <- function() { } #' @inherit getGlobal +#' @keywords internal getASevent <- reactive(sharedData$event) -#' @rdname getEvent +#' @rdname getGlobal #' @param event Character: alternative splicing event setASevent <- function(event) setGlobal("event", value=event) -#' @inherit getGlobal +#' @rdname getGlobal getEvent <- getASevent -#' @rdname getEvent +#' @rdname getGlobal setEvent <- setASevent -#' @inherit getGlobal +#' @rdname getGlobal getGenes <- function() { genes <- NULL @@ -140,12 +146,18 @@ getGenes <- function() { return(genes) } -#' Get pre-created gene list +#' Get pre-created, literature-based gene list +#' +#' Available gene lists: +#' \itemize{ +#' \item{\strong{Sebestyen et al., 2016}: 1350 genes encoding RNA-binding +#' proteins, 167 of which are splicing factors} +#' } #' #' @return List of genes #' @export #' -#' @examples +#' @examples #' getGeneList() getGeneList <- function() { prepareCitation <- function(attr) { @@ -184,6 +196,7 @@ getGeneList <- function() { #' @param object \code{geneList} #' #' @return Print available gene lists +#' @keywords internal print.geneList <- function(object) { for (set in names(object)) { cat(sprintf(set), fill=TRUE) @@ -203,27 +216,27 @@ print.geneList <- function(object) { } } -#' @rdname getEvent +#' @rdname getGlobal getCategories <- reactive(names(getData())) -#' @rdname getEvent +#' @rdname getGlobal getCategory <- reactive(sharedData$category) -#' @rdname getEvent +#' @rdname getGlobal setCategory <- function(category) setGlobal("category", value=category) -#' @rdname getEvent +#' @rdname getGlobal getCategoryData <- reactive( if(!is.null(getCategory())) getData()[[getCategory()]]) -#' @rdname getEvent +#' @rdname getGlobal getActiveDataset <- reactive(sharedData$activeDataset) -#' @rdname getEvent +#' @rdname getGlobal #' @param dataset Character: dataset name setActiveDataset <- function(dataset) setGlobal("activeDataset", value=dataset) -#' @rdname getEvent +#' @rdname getGlobal #' @param attrs Character: name of attributes to retrieve (if NULL, the whole #' dataset is returned) getClinicalData <- function(attrs=NULL) { @@ -241,7 +254,7 @@ getClinicalData <- function(attrs=NULL) { return(clinical) } -#' @rdname getEvent +#' @rdname getGlobal getPatientId <- function() { clinical <- getClinicalData() if ( !is.null(clinical) ) { @@ -251,7 +264,7 @@ getPatientId <- function() { } } -#' @rdname getEvent +#' @rdname getGlobal getPatientAttributes <- function() { clinical <- getClinicalData() if ( !is.null(clinical) ) { @@ -263,14 +276,14 @@ getPatientAttributes <- function() { } } -#' @rdname getEvent +#' @rdname getGlobal getSampleInfo <- reactive(getCategoryData()[["Sample metadata"]]) -#' @rdname getEvent +#' @rdname getGlobal setSampleInfo <- function(value, category = getCategory()) setDataTable("Sample metadata", value, category) -#' @rdname getEvent +#' @rdname getGlobal getSampleId <- function() { sampleInfo <- getSampleInfo() if ( !is.null(sampleInfo) ) { @@ -280,7 +293,7 @@ getSampleId <- function() { } } -#' @rdname getEvent +#' @rdname getGlobal getSampleAttributes <- function() { sampleInfo <- getSampleInfo() if ( !is.null(sampleInfo) ) { @@ -292,7 +305,7 @@ getSampleAttributes <- function() { } } -#' @rdname getEvent +#' @rdname getGlobal getJunctionQuantification <- function(category=getCategory()) { if (!is.null(category)) { data <- getData()[[category]] @@ -301,7 +314,7 @@ getJunctionQuantification <- function(category=getCategory()) { } } -#' @rdname getEvent +#' @rdname getGlobal getGeneExpression <- function(category=getCategory()) { if (!is.null(category)) { data <- getData()[[category]] @@ -310,7 +323,7 @@ getGeneExpression <- function(category=getCategory()) { } } -#' @rdname getEvent +#' @rdname getGlobal #' @param geneExpr Data frame or matrix: normalised gene expression setNormalisedGeneExpression <- function(geneExpr, category=getCategory()) { ns <- names(getData()[[category]]) @@ -329,46 +342,46 @@ setNormalisedGeneExpression <- function(geneExpr, category=getCategory()) { setDataTable(ns, geneExpr, category) } -#' @rdname getEvent +#' @rdname getGlobal getInclusionLevels <- reactive(getCategoryData()[["Inclusion levels"]]) -#' @rdname getEvent +#' @rdname getGlobal #' @param incLevels Data frame or matrix: inclusion levels setInclusionLevels <- function(incLevels, category=getCategory()) setDataTable("Inclusion levels", incLevels, category) -#' @rdname getEvent +#' @rdname getGlobal getPCA <- function(category=getCategory()) getGlobal(category, "PCA") -#' @rdname getEvent +#' @rdname getGlobal #' @param pca \code{prcomp} object (principal component analysis) setPCA <- function(pca, category=getCategory()) setGlobal(category, "PCA", value=pca) -#' @rdname getEvent +#' @rdname getGlobal getICA <- function(category=getCategory()) getGlobal(category, "ICA") -#' @rdname getEvent +#' @rdname getGlobal #' @param ica Object containing independent component analysis setICA <- function(ica, category=getCategory()) setGlobal(category, "ICA", value=ica) -#' @rdname getEvent +#' @rdname getGlobal getCorrelation <- function(category=getCategory()) getGlobal(category, "correlation") -#' @rdname getEvent +#' @rdname getGlobal #' @param correlation \code{prcomp} object (correlation analyses) setCorrelation <- function(correlation, category=getCategory()) setGlobal(category, "correlation", value=correlation) -#' @rdname getEvent +#' @rdname getGlobal getGroupIndependenceTesting <- function(category=getCategory()) getGlobal(category, "groupIndependenceTesting") -#' @rdname getEvent +#' @rdname getGlobal #' @param groupIndependenceTesting Object containing group independence testing #' results setGroupIndependenceTesting <- function(groupIndependenceTesting, @@ -377,43 +390,44 @@ setGroupIndependenceTesting <- function(groupIndependenceTesting, value=groupIndependenceTesting) } -#' @rdname getEvent +#' @rdname getGlobal getSpecies <- function(category=getCategory()) getGlobal(category, "species") -#' @rdname getEvent +#' @rdname getGlobal #' @param species Character: species setSpecies <- function(species, category=getCategory()) setGlobal(category, "species", value=species) -#' @rdname getEvent +#' @rdname getGlobal getAssemblyVersion <- function(category=getCategory()) getGlobal(category, "assemblyVersion") -#' @rdname getEvent +#' @rdname getGlobal #' @param assembly Character: assembly version setAssemblyVersion <- function(assembly, category=getCategory()) setGlobal(category, "assemblyVersion", value=assembly) -#' @rdname getEvent +#' @rdname getGlobal getAnnotationName <- function(category=getCategory()) getGlobal(category, "annotName") -#' @rdname getEvent +#' @rdname getGlobal #' @param annotName Character: annotation name setAnnotationName <- function(annotName, category=getCategory()) setGlobal(category, "annotName", value=annotName) -#' @rdname getEvent +#' @rdname getGlobal getURLtoDownload <- function() getGlobal("URLtoDownload") -#' @rdname getEvent +#' @rdname getGlobal #' @param url Character: URL links to download setURLtoDownload <- function(url) setGlobal("URLtoDownload", value=url) #' Get or set clinical matches from a given data type #' @inherit getGlobal #' @param dataset Character: data set name (e.g. "Junction quantification") +#' @keywords internal getClinicalMatchFrom <- function(dataset, category=getCategory()) getGlobal(category, dataset, "clinicalMatch") @@ -423,12 +437,15 @@ setClinicalMatchFrom <- function(dataset, matches, category=getCategory()) setGlobal(category, dataset, "clinicalMatch", value=matches) #' Get or set groups +#' #' @inherit getGlobal #' #' @param type Character: type of groups (either "Patients", "Samples", #' "ASevents" or "Genes") #' @param complete Boolean: return all the information on groups (TRUE) or just #' the group names and respective indexes (FALSE)? FALSE by default +#' +#' @keywords internal getGroups <- function(type=c("Patients", "Samples", "ASevents", "Genes"), complete=FALSE, category=getCategory()) { type <- match.arg(type) @@ -473,7 +490,10 @@ setGroups <- function(type=c("Patients", "Samples", "ASevents", "Genes"), # Plot points or regions -------------------------------------------------- #' Get or set points or regions for plots +#' #' @inherit getGlobal +#' +#' @keywords internal getHighlightedPoints <- function(id, category=getCategory()) getGlobal(category, id, "highlighted") @@ -513,6 +533,7 @@ setLabelledPoints <- function(id, events, category=getCategory()) #' Get or set differential expression' elements for a data category #' @inherit getGlobal +#' @keywords internal getDifferentialExpression <- function(category=getCategory()) getGlobal(category, "differentialExpression") @@ -561,7 +582,10 @@ setDifferentialExpressionColumns <- function(columns, category=getCategory()) # Differential splicing --------------------------------------------------- #' Get or set differential splicing' elements for a data category +#' #' @inherit getGlobal +#' +#' @keywords internal getDifferentialSplicing <- function(category=getCategory()) getGlobal(category, "differentialSplicing") diff --git a/R/groups.R b/R/groups.R index fcc09049..f6c7c040 100644 --- a/R/groups.R +++ b/R/groups.R @@ -24,6 +24,7 @@ #' \code{noGroupsLabel} and \code{groupsLabel} arguments. #' #' @return \code{selectGroupsUI}: Interface for group selection +#' @keywords internal selectGroupsUI <- function ( id, label, placeholder="Type to search for groups", noGroupsLabel=NULL, groupsLabel=NULL, maxItems=NULL, @@ -160,6 +161,7 @@ selectGroupsServer <- function(session, id, type, preference=NULL) { #' @param type Character: type of data for each the interface is intended #' #' @return HTML elements +#' @keywords internal groupManipulationInput <- function(id, type) { ns <- NS(id) @@ -267,6 +269,7 @@ groupsUI <- function(id, tab) { #' @importFrom colourpicker colourInput #' #' @return HTML elements +#' @keywords internal renderGroupInterface <- function(ns, multiFisherTests=TRUE) { renameId <- "renameGroupName" setColourId <- "setGroupColour" @@ -449,7 +452,7 @@ renderGroupInterface <- function(ns, multiFisherTests=TRUE) { uiOutput(ns(paste0(groupTestId, "-tooltip")))) } -#' User interface to group by attribute +#' Data grouping interface #' #' @param ns Namespace function #' @param cols Character or list: name of columns to show @@ -473,15 +476,11 @@ groupByAttribute <- function(ns, cols, id, example) { ) } -#' User interface to use pre-made groups +#' @rdname groupByAttribute #' -#' @param ns Namespace function #' @param data List: list of groups with elements -#' @param id Character: identifier #' #' @importFrom shiny helpText tags -#' -#' @return HTML elements groupByPreMadeList <- function(ns, data, id) { cols <- preparePreMadeGroupForSelection(data) @@ -502,6 +501,7 @@ groupByPreMadeList <- function(ns, data, id) { #' @param groups List of list of characters #' #' @return List +#' @keywords internal preparePreMadeGroupForSelection <- function(groups) { res <- lapply(groups, names) for (ns in names(res)) { @@ -514,10 +514,11 @@ preparePreMadeGroupForSelection <- function(groups) { #' Select pre-made groups from a selected item #' -#' @param group List of list of characters +#' @param groups List of list of characters #' @param selected Character: selected item #' #' @return Elements of selected item +#' @keywords internal selectPreMadeGroup <- function(groups, selected) { selected <- strsplit(selected, "|||", fixed=TRUE)[[1]] first <- selected[[1]] @@ -529,13 +530,8 @@ selectPreMadeGroup <- function(groups, selected) { return(res) } -#' User interface to group by row -#' -#' @inheritParams groupByAttribute -#' +#' @rdname groupByAttribute #' @importFrom shiny textInput -#' -#' @return HTML elements groupById <- function(ns, id) { sid <- gsub("s$", "", id) sid <- gsub("ASevent", "Splicing event", sid) @@ -557,13 +553,8 @@ groupById <- function(ns, id) { ) } -#' User interface to group by subset expression -#' -#' @inheritParams groupByAttribute -#' +#' @rdname groupByAttribute #' @importFrom shiny textInput -#' -#' @return HTML elements groupByExpression <- function(ns, id) { tagList ( textInput(ns(paste0("groupExpression", id)), "Subset expression", @@ -595,13 +586,8 @@ groupByExpression <- function(ns, id) { ) } -#' User interface to group by grep expression -#' -#' @inheritParams groupByAttribute -#' +#' @rdname groupByAttribute #' @importFrom shiny textInput -#' -#' @return HTML elements groupByGrep <- function(ns, cols, id) { tagList ( textInput(ns(paste0("grepExpression", id)), "Regular expression", @@ -617,10 +603,11 @@ groupByGrep <- function(ns, cols, id) { #' Prepare to create group according to specific details #' -#' @param output Shiny output #' @inheritParams createGroupFromInput +#' @param output Shiny output #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal createGroup <- function(session, input, output, id, type, selected=NULL, expr=NULL, groupNames=NULL) { removeAlert(output, alertId="alert-side") @@ -644,6 +631,7 @@ createGroup <- function(session, input, output, id, type, selected=NULL, #' @param groups Matrix: groups to check which colours are already assigned #' #' @return Groups with an added column to state the colour +#' @keywords internal assignColours <- function(new, groups=NULL) { strong <- c("#08419E", "#EF9636", "#D33E6A", "#00C652", "#4C71DB", "#8F033B", "#F89CD1", "#05CFC0") @@ -682,6 +670,7 @@ assignColours <- function(new, groups=NULL) { #' @param clearOld Boolean: clear old groups? #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal appendNewGroups <- function(type, new, clearOld=FALSE) { # Rename duplicated group names if (clearOld) @@ -707,6 +696,7 @@ appendNewGroups <- function(type, new, clearOld=FALSE) { #' @param group Data frame: group #' #' @return Data frame with groups containing matching elements +#' @keywords internal matchGroupPatientsAndSamples <- function(id, group) { patients <- getPatientId() samples <- getSampleId() @@ -740,6 +730,7 @@ matchGroupPatientsAndSamples <- function(id, group) { #' @inheritParams matchGroupPatientsAndSamples #' #' @return Data frame with groups containing matching elements +#' @keywords internal matchGroupASeventsAndGenes <- function(id, group, ASevents) { # Match AS events with genes (or vice-versa) if (!is.null(ASevents)) { @@ -781,6 +772,7 @@ matchGroupASeventsAndGenes <- function(id, group, ASevents) { #' @param groupNames Character: group names #' #' @return Matrix with the group names and respective elements +#' @keywords internal createGroupFromInput <- function (session, input, dataset, id, type, selected=NULL, expr=NULL, groupNames=NULL) { if (type == "Attribute") { @@ -907,7 +899,9 @@ createGroupByAttribute <- function(col, dataset) { #' @param identifiers Character: available identifiers #' #' @importFrom shiny tags +#' #' @return Character: values based on given row indexes or identifiers +#' @keywords internal createGroupById <- function(session, rows, identifiers) { # Check which strings match available identifiers matched <- rows %in% identifiers @@ -946,6 +940,7 @@ createGroupById <- function(session, rows, identifiers) { #' @param old Matrix: pre-existing groups #' #' @return Character with no duplicated group names +#' @keywords internal renameGroups <- function(new, old) { groupNames <- 1 @@ -980,6 +975,7 @@ renameGroups <- function(new, old) { #' default #' #' @return Matrix containing groups (new group is in the first row) +#' @keywords internal setOperation <- function(operation, groups, selected, symbol=" ", groupName=NULL, first=NULL, second=NULL, matches=NULL, type="Samples", assignColoursToGroups=FALSE) { @@ -1116,6 +1112,7 @@ setOperation <- function(operation, groups, selected, symbol=" ", #' @inheritParams setOperation #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal operateOnGroups <- function(input, session, operation, buttonId, symbol=" ", type, sharedData=sharedData) { # Operate on selected groups when pressing the corresponding button @@ -1157,6 +1154,7 @@ operateOnGroups <- function(input, session, operation, buttonId, symbol=" ", #' @importFrom shiny tags #' #' @return Matrix with groups ordered (or NULL if no groups exist) +#' @keywords internal showGroupsTable <- function(type) { groups <- getGroups(type, complete=TRUE) @@ -1231,6 +1229,7 @@ showGroupsTable <- function(type) { #' @importFrom colourpicker updateColourInput #' #' @return HTML elements +#' @keywords internal groupManipulation <- function(input, output, session, type) { ns <- session$ns @@ -1920,6 +1919,7 @@ groupsServer <- function(input, output, session) { #' @inheritParams groupsServer #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal groupsServerOnce <- function(input, output, session) { # Update groups according to the availability of sample identifiers observe({ @@ -2102,6 +2102,8 @@ parseCategoricalGroups <- function(df) { #' groups} #' \item{table}{Contigency table used for testing} #' \item{pvalue}{Fisher's exact test's p-value} +#' +#' @keywords internal testSingleIndependence <- function(ref, groups, elements, pvalueAdjust="BH") { # Number of intersections between reference and groups of interest updateProgress("Calculating intersections", diff --git a/R/utils.R b/R/utils.R index 09f239de..e8c39aa5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -11,6 +11,7 @@ #' @param digits Numeric: number of maximum digits #' #' @return Rounded numeric value +#' @keywords internal roundMinDown <- function(x, digits=0) floor (min(x) * 10^digits) / 10^digits #' @rdname roundMinDown @@ -19,6 +20,7 @@ roundMaxUp <- function(x, digits=0) ceiling(max(x) * 10^digits) / 10^digits #' Get psichomics file inside a given directory #' @inheritParams base::system.file #' @return Loaded file +#' @keywords internal insideFile <- function(...) { return(system.file(..., package="psichomics")) } @@ -28,6 +30,7 @@ insideFile <- function(...) { #' @param files Character: vector of filepaths to check #' #' @return Boolean vector stating whether each file exists or not +#' @keywords internal isFile <- function(files) { fileExists <- file.exists(files) & !dir.exists(files) names(fileExists) <- files @@ -41,6 +44,8 @@ isFile <- function(files) { #' @importFrom shiny div tags #' #' @inherit shiny::sidebarPanel +#' +#' @keywords internal sidebar <- function(..., width=4) { div(class = paste0("col-sm-", width), tags$form(...)) } @@ -63,6 +68,7 @@ readFile <- function(file) { #' @param code Character: JavaScript code #' #' @return HTML elements +#' @keywords internal linkToRunJS <- function(text, code) { HTML(sprintf('%s', code, text)) } @@ -73,6 +79,7 @@ linkToRunJS <- function(text, code) { #' @param th Boolean: is this row the table head? #' #' @return HTML elements +#' @keywords internal tableRow <- function (..., th=FALSE) { args <- list(...) if (th) row <- tags$th @@ -86,6 +93,7 @@ tableRow <- function (..., th=FALSE) { #' @importFrom colourpicker colourInput #' #' @return HTML elements +#' @keywords internal colourInputMod <- function(...) { colourSelector <- colourInput(...) colourSelector[[2]][["style"]] <- "width: 100%;" @@ -94,7 +102,7 @@ colourInputMod <- function(...) { #' Splicing event types available #' -#' @param acronymsAsNames Boolean: return acronyms as names? FALSE by default +#' @param acronymsAsNames Boolean: return acronyms as names? #' #' @return Named character vector with splicing event types #' @export @@ -125,7 +133,8 @@ getSplicingEventTypes <- function(acronymsAsNames=FALSE) { #' @param num Integer: number of elements to check #' #' @return TRUE if first elements of the vector identify splicing events; FALSE, -#' otherwise +#' otherwise +#' @keywords internal areSplicingEvents <- function(char, num=6) { all(sapply(head(char, num), function (i) sum(charToRaw(i) == charToRaw("_")) > 3)) @@ -145,6 +154,7 @@ areSplicingEvents <- function(char, num=6) { #' #' @return Parsed event #' @export +#' #' @examples #' events <- c("SE_1_-_123_456_789_1024_TST", #' "MXE_3_+_473_578_686_736_834_937_HEY/YOU") @@ -256,14 +266,13 @@ parseSplicingEvent <- function(event, char=FALSE, pretty=FALSE, extra=NULL, return(parsed) } -parseEvent <- parseSplicingEvent - #' Match splicing events with respective genes #' #' @param ASevents Character: alternative splicing events to be matched #' #' @return Named character vector containing the splicing events and their #' respective gene as their name +#' @keywords internal matchSplicingEventsWithGenes <- function(ASevents) { ASeventParsed <- parseSplicingEvent(ASevents)$gene ASeventGenes <- rep(ASevents, sapply(ASeventParsed, length)) @@ -271,12 +280,19 @@ matchSplicingEventsWithGenes <- function(ASevents) { return(ASeventGenes) } -#' Retrieve alternative splicing events based on given genes +#' Get alternative splicing events from genes or vice-versa +#' +#' @details +#' A list of alternative splicing events is required to run +#' \code{getSplicingEventFromGenes} #' #' @param genes Character: gene symbols (or TCGA-styled gene symbols) -#' @inheritParams matchSplicingEventsWithGenes +#' @param ASevents Character: alternative splicing events +#' +#' @return Named character containing alternative splicing events or genes and +#' their respective genes or alternative splicing events as names (depending on +#' the function in use) #' -#' @return Character containing respective alternative splicing events #' @export #' #' @examples @@ -286,7 +302,20 @@ matchSplicingEventsWithGenes <- function(ASevents) { #' "SE_1_+_181019422_181022709_181022813_181024361_MR1", #' "SE_1_+_181695298_181700311_181700367_181701520_CACNA1E") #' genes <- c("NAV1", "SMG7", "MR1", "HELLO") -#' getSplicingEventFromGenes(genes, ASevents) +#' +#' # Get splicing events from genes +#' matchedASevents <- getSplicingEventFromGenes(genes, ASevents) +#' +#' # Names of matched events are the matching input genes +#' names(matchedASevents) +#' matchedASevents +#' +#' # Get genes from splicing events +#' matchedGenes <- getGenesFromSplicingEvents (ASevents) +#' +#' # Names of matched genes are the matching input alternative splicing events +#' names(matchedGenes) +#' matchedGenes getSplicingEventFromGenes <- function(genes, ASevents) { if (!is(ASevents, "matched")) ASeventGenes <- matchSplicingEventsWithGenes(ASevents) @@ -298,12 +327,7 @@ getSplicingEventFromGenes <- function(genes, ASevents) { return(ASeventGenes) } -#' Retrieve genes based on given alternative splicing events -#' -#' @param ASevents Character: alternative splicing events -#' -#' @return Named character containing alternative splicing events and their -#' respective genes as names +#' @rdname getSplicingEventFromGenes #' @export getGenesFromSplicingEvents <- function(ASevents) { genes <- parseSplicingEvent(ASevents)$gene @@ -317,6 +341,7 @@ getGenesFromSplicingEvents <- function(ASevents) { #' @param word Character to trim #' #' @return Character without whitespace +#' @keywords internal #' #' @examples #' psichomics:::trimWhitespace(" hey there ") @@ -339,6 +364,7 @@ trimWhitespace <- function(word) { #' @importFrom shiny HTML #' #' @return String containing HTML elements +#' @keywords internal prepareWordBreak <- function(str, pattern=c(".", "-", "\\", "/", "_", ",", " ")) { res <- str @@ -354,6 +380,7 @@ prepareWordBreak <- function(str, pattern=c(".", "-", "\\", "/", "_", ",", #' @return Filtered vector or list with no NULL elements; if the input is a #' vector composed of only NULL elements, it returns a NULL (note that it will #' returns an empty list if the input is a list with only NULL elements) +#' @keywords internal rm.null <- function(v) Filter(Negate(is.null), v) #' Escape symbols for use in regular expressions @@ -361,6 +388,7 @@ rm.null <- function(v) Filter(Negate(is.null), v) #' @param ... Characters to be pasted with no space #' #' @return Escaped string +#' @keywords internal escape <- function(...) { # return(gsub("/[\-\[\]\/\{\}\(\)\*\+\?\.\\\^\$\|]", "\\$&", string)) return(gsub("(\\W)", "\\\\\\1", paste0(...))) @@ -371,6 +399,7 @@ escape <- function(...) { #' @param values Character vector #' #' @return Character with valid JavaScript array +#' @keywords internal toJSarray <- function(values) { paste0("[", paste0(paste0("\'", values, "\'"), collapse=", "), "]") } @@ -381,21 +410,23 @@ toJSarray <- function(values) { #' @param tol Numeric: tolerance used for comparison #' #' @return TRUE if number is whole; otherwise, FALSE +#' @keywords internal is.whole <- function(x, tol=.Machine$double.eps^0.5) { abs(x - round(x)) < tol } -#' Calculate mean for each row of a matrix +#' Calculate mean or variance for each row of a matrix #' #' @param mat Matrix -#' @param na.rm Boolean: remove NAs? +#' @param na.rm Boolean: remove missing values (\code{NA})? #' -#' @return Vector of means +#' @return Vector of means or variances #' @export #' #' @examples #' df <- rbind("Gene 1"=c(3, 5, 7), "Gene 2"=c(8, 2, 4), "Gene 3"=c(9:11)) #' rowMeans(df) +#' rowVars(df) rowMeans <- function(mat, na.rm=FALSE) { if ( !is.null(dim(mat)) ) { nas <- 0 @@ -406,16 +437,8 @@ rowMeans <- function(mat, na.rm=FALSE) { } } -#' Calculate variance for each row of a matrix -#' -#' @inheritParams rowMeans -#' -#' @return Vector of variances +#' @rdname rowMeans #' @export -#' -#' @examples -#' df <- rbind("Gene 1"=c(3, 5, 7), "Gene 2"=c(8, 2, 4), "Gene 3"=c(9:11)) -#' rowVars(df) rowVars <- function(mat, na.rm=FALSE) { if ( !is.null(dim(mat)) ) { means <- rowMeans(mat, na.rm=na.rm) @@ -443,7 +466,8 @@ rowVars <- function(mat, na.rm=FALSE) { #' #' @return Character vector with renamed values if duplicated; else, it #' returns the usual values. It does not return the comparator values. -#' +#' @keywords internal +#' #' @examples #' psichomics:::renameDuplicated(check = c("blue", "red"), comp = c("green", #' "blue")) @@ -480,7 +504,9 @@ renameDuplicated <- function(check, comp) { #' #' @importFrom shinyjs hidden #' @importFrom shiny tags actionButton +#' #' @return HTML for a button +#' @keywords internal processButton <- function(id, label, ..., class="btn-primary") { spinner <- tags$i(id=paste0(id, "Loading"), class="fa fa-spinner fa-spin") button <- actionButton(id, class=class, type="button", @@ -488,37 +514,46 @@ processButton <- function(id, label, ..., class="btn-primary") { return(button) } -#' Signal the program that a process is starting +#' Set the status of a process to style a given button #' -#' Style button to show processing is in progress +#' \itemize{ +#' \item{\code{startProcess}: Style button to show a process is in progress} +#' \item{\code{endProcess}: Style button to show a process finished; also, +#' closes the progress bar (if \code{closeProgressbar} is \code{TRUE}) and +#' prints the difference between the current time and \code{time}} +#' } #' #' @param id Character: button identifier #' @importFrom shinyjs show -#' @return Start time of the process +#' +#' @return \code{startProcess} returns the start time of the process (may be +#' used as the \code{time} argument to \code{endProcess}), whereas +#' \code{endProcess} returns the difference between current time and \code{time} +#' (or \code{NULL} if \code{time} is not specified) +#' @keywords internal startProcess <- function(id) { disable(id) show(paste0(id, "Loading")) return(Sys.time()) } -#' Signal the program that a process has ended -#' -#' Style button to show processing is not occurring. Also, close the progress -#' bar (if TRUE) and print the difference between the current time and a given -#' time (if given time is not NULL) +#' @rdname startProcess #' -#' @param id Character: button identifier #' @param time \code{POSIXct} object: start time needed to show the interval #' time (if NULL, the time interval is not displayed) #' @param closeProgressBar Boolean: close progress bar? TRUE by default #' -#' @importFrom shinyjs hide -#' @return NULL (this function is used to modify the Shiny session's state) +#' @importFrom shinyjs enable hide endProcess <- function(id, time=NULL, closeProgressBar=TRUE) { enable(id) hide(paste0(id, "Loading")) if (closeProgressBar) suppressWarnings(closeProgress()) - if (!is.null(time)) display(Sys.time() - time, "Process finished in") + if (!is.null(time)) { + diffTime <- Sys.time() - time + display(diffTime, "Process finished in") + return(diffTime) + } + return(NULL) } #' Get patients from given samples @@ -710,41 +745,40 @@ groupPerSample <- function(groups, samples, includeOuterGroup=FALSE, } #' @rdname missingDataModal +#' #' @param modal Character: modal identifier +#' +#' @keywords internal loadRequiredData <- function( modal=NULL ) { modal <- ifelse(is.null(modal), "null", modal) return(sprintf("showDataPanel('#%s');", modal)) } -#' Style and show a modal -#' -#' You can also use \code{errorModal} and \code{warningModal} to use a template -#' modal already stylised to show errors and warnings, respectively. -#' -#' @param session Current Shiny session -#' @param title Character: modal title -#' @param ... Extra arguments to pass to \code{shiny::modalDialog} -#' @param style Character: style of the modal (NULL, "warning", "error" or -#' "info"; NULL by default) -#' @param iconName Character: FontAwesome icon name to appear with the title +#' Create a modal window +#' +#' @param session Shiny session +#' @param title Character: title +#' @inheritDotParams shiny::modalDialog -title -size -footer +#' @param style Character: style (\code{NULL}, \code{warning}, \code{error} or +#' \code{info}) +#' @param iconName Character: icon name #' @param footer HTML elements to use in footer -#' @param echo Boolean: print to console? FALSE by default -#' @param size Character: size of the modal - "medium" (default), "small" or -#' "large" -#' @param dismissButton Boolean: show dismiss button in footer? TRUE by default -#' @param caller Character: label to identify the module calling for the modal -#' (relevant for error and warning modals) -#' +#' @param echo Boolean: print to console? +#' @param size Character: size of the modal (\code{small}, \code{medium} or +#' \code{large}) +#' @param dismissButton Boolean: show dismiss button in footer? +#' @param caller Character: caller module identifier +#' #' @importFrom shiny renderUI div icon showModal modalButton modalDialog #' @importFrom shinyBS toggleModal #' @importFrom R.utils capitalize -#' +#' #' @seealso \code{\link{showAlert}} #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal styleModal <- function(session, title, ..., style=NULL, iconName="exclamation-circle", footer=NULL, echo=FALSE, size="medium", dismissButton=TRUE, caller=NULL) { - size <- switch(size, "small"="s", "large"="l", "medium"="m") if (dismissButton) footer <- tagList(modalButton("Dismiss"), footer) @@ -789,22 +823,17 @@ infoModal <- function(session, title, ..., size="small", footer=NULL, #' Show or remove an alert #' -#' You can also use \code{errorAlert} and \code{warningAlert} to use template -#' alerts already stylised to show errors and warnings respectively. -#' -#' @param session Shiny session +#' @inheritParams styleModal #' @param ... Arguments to render as elements of alert -#' @param title Character: title of the alert (optional) -#' @param style Character: style of the alert ("error", "warning" or NULL) -#' @param dismissible Boolean: is the alert dismissible? TRUE by default -#' @param alertId Character: alert identifier -#' @param iconName Character: FontAwesome icon name to appear with the title -#' @param caller Character: label to identify the module calling for the alert -#' (relevant for error and warning alerts) +#' @param style Character: style (\code{error}, \code{warning} or \code{NULL}) +#' @param dismissible Boolean: is the alert dismissible? +#' @param alertId Character: identifier #' #' @seealso \code{\link{showModal}} #' @importFrom shiny span h3 renderUI div tagList +#' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal showAlert <- function(session, ..., title, style=NULL, dismissible=TRUE, alertId="alert", iconName=NULL, caller=NULL) { if (dismissible) { @@ -870,6 +899,7 @@ removeAlert <- function(output, alertId="alert") { #' @importFrom shiny icon div actionButton #' #' @return HTML elements +#' @keywords internal inlineDialog <- function(description, ..., buttonLabel=NULL, buttonIcon=NULL, buttonId=NULL, id=NULL, type=c("error", "warning"), bigger=FALSE) { @@ -935,18 +965,37 @@ getDownloadsFolder <- function() { #' #' @return Types of the TCGA samples #' @export +#' #' @examples #' parseSampleGroups(c("TCGA-01A-Tumour", "TCGA-10B-Normal")) -parseSampleGroups <- function(sample, - filename = system.file("extdata", - "TCGAsampleType.RDS", - package="psichomics")) { +parseSampleGroups <- function(sample, filename = system.file( + "extdata", "TCGAsampleType.RDS", package="psichomics")) { typeList <- readRDS(filename) type <- gsub(".*?-([0-9]{2}).-.*", "\\1", sample, perl = TRUE) return(typeList[type]) } -#' Create a progress object +#' Display characters in the command-line +#' +#' @param char Character: message +#' @param timeStr Character: message when a \code{difftime} object is passed to +#' the \code{char} argument +#' +#' @importFrom shiny isRunning +#' +#' @return NULL (display message in command-line) +#' @keywords internal +display <- function(char, timeStr="Time difference of") { + if (!isRunning()) cat("", fill=TRUE) + if (is(char, "difftime")) { + message(timeStr, " ", format(unclass(char), digits=3), " ", + attr(char, "units")) + } else { + cat(char, fill=TRUE) + } +} + +#' Create, set and terminate a progress object #' #' @param message Character: progress message #' @param divisions Integer: number of divisions in the progress bar @@ -957,6 +1006,7 @@ parseSampleGroups <- function(sample, #' #' @return NULL (this function is used to modify the Shiny session's state or #' internal hidden variables) +#' @keywords internal startProgress <- function(message, divisions, global=if (isRunning()) sharedData else getHidden()) { display(message) @@ -970,32 +1020,29 @@ startProgress <- function(message, divisions, return(invisible(global)) } -#' Update a progress object +#' @rdname startProgress #' -#' @details If \code{divisions} is not NULL, a progress bar is started with the -#' given divisions. If \code{value} is NULL, the progress bar will be -#' incremented by one; otherwise, the progress bar will be incremented by the -#' integer given in value. +#' @details If \code{divisions} is not \code{NULL}, a progress bar starts with +#' the given divisions. If \code{value} is \code{NULL}, the progress bar +#' increments one unit; otherwise, the progress bar increments \code{value}. #' -#' @inheritParams startProgress #' @param value Integer: current progress value #' @param max Integer: maximum progress value #' @param detail Character: detailed message -#' @param console Boolean: print message to console? (TRUE by default) +#' @param console Boolean: print message to console? #' #' @importFrom shiny isRunning Progress #' @importFrom utils setTxtProgressBar -#' -#' @return NULL (this function is used to modify the Shiny session's state) updateProgress <- function(message="Loading...", value=NULL, max=NULL, detail=NULL, divisions=NULL, global=if (isRunning()) sharedData else getHidden(), console=TRUE) { + isGUIversion <- isRunning() if (!interactive()) return(NULL) if (!is.null(divisions)) { - if (!isRunning()) # CLI version + if (!isGUIversion) setHidden(startProgress(message, divisions, new.env())) - else # GUI version + else startProgress(message, divisions, global) return(NULL) } @@ -1015,75 +1062,58 @@ updateProgress <- function(message="Loading...", value=NULL, max=NULL, # Print message to console if (console) { + msg <- message if (!is.null(detail) && !identical(detail, "")) - display(paste(message, detail, sep=": ")) - else - display(message) + msg <- paste(msg, detail, sep=": ") + display(msg) } # Increment progress - if (!isRunning()) { # CLI version + if (!isGUIversion) { if (!is.null(global)) { value <- min(global$progress$getVal() + amount, 1) setTxtProgressBar(global$progress, value) setHidden(global) } - } else { # GUI version + } else { if (is.null(detail)) detail <- "" global$progress$inc(amount=amount, message=message, detail=detail) } return(invisible(TRUE)) } -#' Close the progress even if there's an error -#' -#' @param message Character: message to show in progress bar -#' @param global Global Shiny variable where all data is stored -#' +#' @rdname startProgress #' @importFrom shiny isRunning Progress -#' -#' @return NULL (this function is used to modify the Shiny session's state) closeProgress <- function(message=NULL, global=if (isRunning()) sharedData else getHidden()) { # Close the progress even if there's an error if (!is.null(message)) display(message) - if (isRunning()) + isGUIversion <- isRunning() + if (isGUIversion) global$progress$close() else close(global$progress) } -#' Display characters in the command-line -#' -#' @param char Character: message -#' @param timeStr Character: message when a \code{difftime} object is passed to -#' the \code{char} argument -#' -#' @importFrom shiny isRunning -#' -#' @return NULL (display message in command-line) -display <- function(char, timeStr="Time difference of") { - if (!isRunning()) cat("", fill=TRUE) - if (is(char, "difftime")) { - message(timeStr, " ", format(unclass(char), digits=3), " ", - attr(char, "units")) - } else { - cat(char, fill=TRUE) - } -} - #' Get number of significant digits +#' #' @param n Numeric: number to round +#' #' @importFrom shiny isolate +#' #' @return Formatted number with a given number of significant digits +#' @keywords internal signifDigits <- function(n) { return(isolate(formatC(n, getSignificant(), format="g"))) } #' Round by the given number of digits +#' #' @param n Numeric: number to round +#' #' @return Formatted number with a given numeric precision +#' @keywords internal roundDigits <- function(n) { return(isolate(formatC(n, getPrecision(), format="f"))) } @@ -1104,6 +1134,7 @@ roundDigits <- function(n) { #' @importFrom shinyBS bsModal #' #' @return HTML elements +#' @keywords internal bsModal2 <- function (id, title, trigger, ..., size=NULL, footer=NULL, style = NULL) { if (is.null(size)) @@ -1124,9 +1155,13 @@ bsModal2 <- function (id, title, trigger, ..., size=NULL, footer=NULL, } #' Enable or disable a tab from the \code{navbar} -#' @importFrom shinyjs disable addClass +#' #' @param tab Character: tab +#' +#' @importFrom shinyjs disable addClass +#' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal disableTab <- function(tab) { # Style item as disabled addClass(selector = paste0(".navbar li:has(a[data-value=", tab, "])"), @@ -1155,6 +1190,7 @@ enableTab <- function(tab) { #' @param char Character to succeed accepted word #' #' @return HTML string with the JavaScript script prepared to run +#' @keywords internal #' #' @examples #' words <- c("tumor_stage", "age", "gender") @@ -1194,6 +1230,8 @@ textSuggestions <- function(id, words, novalue="No matching value", char=" ") { #' @source Code modified from \url{https://stackoverflow.com/questions/5560248} #' #' @return Character representing an HEX colour +#' @keywords internal +#' #' @examples #' psichomics:::blendColours("#3f83a3", "#f48000") blendColours <- function (colour1, colour2, colour1Percentage=0.5) { @@ -1241,6 +1279,7 @@ blendColours <- function (colour1, colour2, colour1Percentage=0.5) { #' @importFrom stats setNames #' #' @return \code{highcharter} object to plot survival curves +#' @keywords internal #' #' @examples #' @@ -1380,11 +1419,13 @@ hchart.survfit <- function(object, ..., fun = NULL, markTimes = TRUE, #' calls a JavaScript function to convert the sparkline HTML elements to #' interactive Highcharts #' -#' @importFrom DT renderDataTable JS -#' #' @inheritDotParams shiny::renderDataTable -options -escape -env #' @param options List of options to pass to \code{\link{renderDataTable}} +#' +#' @importFrom DT renderDataTable JS +#' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal renderDataTableSparklines <- function(..., options=NULL) { # Escape is set to FALSE to render the Sparkline HTML elements renderDataTable(..., escape=FALSE, env=parent.frame(n=1), options=c( @@ -1397,6 +1438,7 @@ renderDataTableSparklines <- function(..., options=NULL) { #' @param ... Name of columns #' #' @return Data frame with unique values based on set of columns +#' @keywords internal uniqueBy <- function(data, ...) { sub <- subset(data, select=c(...)) uniq <- !duplicated(sub) @@ -1412,6 +1454,7 @@ uniqueBy <- function(data, ...) { #' @importFrom highcharter hc_exporting JS #' #' @return A \code{highcharts} object with an export button +#' @keywords internal export_highcharts <- function(hc, fill="transparent", text="Export") { createJSExport <- function(type) { JS(paste0("function () { this.exportChart({ type: '", type, "' }); }")) @@ -1449,6 +1492,7 @@ export_highcharts <- function(hc, fill="transparent", text="Export") { #' @importFrom highcharter hc_add_series list_parse #' #' @return \code{highcharter} object containing information for a scatter plot +#' @keywords internal hc_scatter <- function (hc, x, y, z=NULL, label=NULL, showInLegend=FALSE, ...) { df <- data.frame(x, y) if (!is.null(z)) df <- cbind(df, z=z) @@ -1491,6 +1535,7 @@ hc_scatter <- function (hc, x, y, z=NULL, label=NULL, showInLegend=FALSE, ...) { #' @importFrom htmltools htmlDependency htmlDependencies htmlDependencies<- #' #' @return Icon element +#' @keywords internal setOperationIcon <- function (name, class=NULL, ...) { if (length(list(...)) == 0) { style <- paste("font-size: 20px;", "line-height: 0;", @@ -1515,6 +1560,7 @@ setOperationIcon <- function (name, class=NULL, ...) { #' Check if running in RStudio Server #' #' @return Boolean stating whether running in RStudio Server +#' @keywords internal isRStudioServer <- function() { tryCatch( rstudioapi::isAvailable() && rstudioapi::versionInfo()$mode == "server", @@ -1547,7 +1593,8 @@ isRStudioServer <- function() { #' @source Original code by wleepang: #' \url{https://github.com/wleepang/shiny-directory-input} #' -#' @return A length one character vector, character NA if 'Cancel' was selected. +#' @return A length one character vector, character NA if 'Cancel' was selected +#' @keywords internal fileBrowser <- function(default=NULL, caption=NULL, multiple=FALSE, directory=FALSE) { system <- Sys.info()['sysname'] @@ -1640,7 +1687,8 @@ fileBrowser <- function(default=NULL, caption=NULL, multiple=FALSE, #' \url{https://github.com/wleepang/shiny-directory-input} #' #' @return HTML elements for a file browser input -#' +#' @keywords internal +#' #' @seealso #' \code{\link{updateFileBrowserInput}} and \code{\link{prepareFileBrowser}} fileBrowserInput <- function(id, label, value=NULL, placeholder=NULL, @@ -1714,6 +1762,7 @@ fileBrowserInput <- function(id, label, value=NULL, placeholder=NULL, #' \url{https://github.com/wleepang/shiny-directory-input} #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal updateFileBrowserInput <- function(session, id, ..., value=NULL) { if (is.null(value)) value <- fileBrowser(...) @@ -1731,6 +1780,7 @@ updateFileBrowserInput <- function(session, id, ..., value=NULL) { #' @param modalId Character: modal window identifier #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal prepareFileBrowser <- function(session, input, id, modalId="modal", ...) { buttonId <- sprintf("%sButton", id) observeEvent(input[[buttonId]], { @@ -1768,6 +1818,7 @@ prepareFileBrowser <- function(session, input, id, modalId="modal", ...) { #' @importFrom shiny HTML #' #' @return HTML elements +#' @keywords internal table2html <- function(data, rownames=TRUE, colnames=TRUE, class=NULL, style=NULL, thead=FALSE) { table <- xtable(data) @@ -1801,6 +1852,7 @@ table2html <- function(data, rownames=TRUE, colnames=TRUE, class=NULL, #' @importFrom shinyjs hidden #' #' @return HTML elements +#' @keywords internal ggplotUI <- function(id) { idd <- function(str) paste(id, str, sep="-") plotId <- idd("plot") @@ -1836,6 +1888,7 @@ ggplotUI <- function(id) { #' @importFrom shiny tags nearPoints wellPanel #' #' @return HTML elements +#' @keywords internal ggplotTooltip <- function(df, hover, x, y) { point <- nearPoints(df, hover, threshold=10, maxpoints=1, addDist=TRUE, xvar=x, yvar=y) @@ -1896,6 +1949,7 @@ ggplotTooltip <- function(df, hover, x, y) { #' @importFrom shiny renderPlot renderUI #' #' @return NULL (this function is used to modify the Shiny session's state) +#' @keywords internal ggplotServer <- function(input, output, id, plot=NULL, df=NULL, x=NULL, y=NULL) { idd <- function(str) paste(id, str, sep="-") diff --git a/man/ASquantFileInput.Rd b/man/ASquantFileInput.Rd index 43e897db..8c5bfbdb 100644 --- a/man/ASquantFileInput.Rd +++ b/man/ASquantFileInput.Rd @@ -20,3 +20,4 @@ HTML elements \description{ File input for alternative splicing quantification } +\keyword{internal} diff --git a/man/addObjectAttrs.Rd b/man/addObjectAttrs.Rd index 5a65ee02..1b6a0e19 100644 --- a/man/addObjectAttrs.Rd +++ b/man/addObjectAttrs.Rd @@ -21,3 +21,4 @@ Set attributes to an object ll <- list(a="hey", b="there") psichomics:::addObjectAttrs(ll, "words"=2, "language"="English") } +\keyword{internal} diff --git a/man/addTCGAdata.Rd b/man/addTCGAdata.Rd index bdb165f0..3e98300b 100644 --- a/man/addTCGAdata.Rd +++ b/man/addTCGAdata.Rd @@ -15,3 +15,4 @@ A UI set that can be added to a UI definition \description{ Creates a UI set with options to add data from TCGA/Firebrowse } +\keyword{internal} diff --git a/man/analysesPlotSet.Rd b/man/analysesPlotSet.Rd deleted file mode 100644 index 28c19e50..00000000 --- a/man/analysesPlotSet.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{analysesPlotSet} -\alias{analysesPlotSet} -\title{Set of functions to plot differential analyses} -\usage{ -analysesPlotSet(session, input, output, analysesType, analysesID, - getAnalysesData, getAnalysesFiltered, getAnalysesSurvival) -} -\arguments{ -\item{session}{Session object} - -\item{input}{Input object} - -\item{output}{Output object} - -\item{analysesType}{Character: type of analyses (\code{GE} or \code{PSI})} - -\item{analysesID}{Character: identifier of analyses} - -\item{getAnalysesData}{Function: used to get analyses data} - -\item{getAnalysesFiltered}{Function: used to get filtered analyses data} - -\item{getAnalysesSurvival}{Function: used to get survival data} -} -\value{ -NULL (this function is used to modify the Shiny session's state) -} -\description{ -Instructions to build the Shiny app -} diff --git a/man/analysesTableSet.Rd b/man/analysesTableSet.Rd index 0098c783..0b0922d6 100644 --- a/man/analysesTableSet.Rd +++ b/man/analysesTableSet.Rd @@ -2,12 +2,16 @@ % Please edit documentation in R/analysis.R \name{analysesTableSet} \alias{analysesTableSet} -\title{Set of functions to render data table for differential analyses} +\alias{analysesPlotSet} +\title{Set of functions to render differential analyses (plot and table)} \usage{ analysesTableSet(session, input, output, analysesType, analysesID, getAnalysesData, getAnalysesFiltered, setAnalysesFiltered, getAnalysesSurvival, getAnalysesColumns, setAnalysesColumns, getResetPaging, setResetPaging) + +analysesPlotSet(session, input, output, analysesType, analysesID, + getAnalysesData, getAnalysesFiltered, getAnalysesSurvival) } \arguments{ \item{session}{Session object} @@ -18,23 +22,23 @@ analysesTableSet(session, input, output, analysesType, analysesID, \item{analysesType}{Character: type of analyses (\code{GE} or \code{PSI})} -\item{analysesID}{Character: identifier of analyses} +\item{analysesID}{Character: identifier} -\item{getAnalysesData}{Function: used to get analyses data} +\item{getAnalysesData}{Function: get analyses data} -\item{getAnalysesFiltered}{Function: used to get filtered analyses data} +\item{getAnalysesFiltered}{Function: get filtered analyses data} -\item{setAnalysesFiltered}{Function: used to set filtered analyses data} +\item{setAnalysesFiltered}{Function: set filtered analyses data} -\item{getAnalysesSurvival}{Function: used to get survival data} +\item{getAnalysesSurvival}{Function: get survival data} -\item{getAnalysesColumns}{Function: used to get columns} +\item{getAnalysesColumns}{Function: get columns} -\item{setAnalysesColumns}{Function: used to set columns} +\item{setAnalysesColumns}{Function: set columns} -\item{getResetPaging}{Function: used to get reset paging toggle} +\item{getResetPaging}{Function: get toggle of reset paging} -\item{setResetPaging}{Function: used to set reset paging toggle} +\item{setResetPaging}{Function: set toggle of reset paging} } \value{ NULL (this function is used to modify the Shiny session's state) @@ -42,3 +46,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/appServer.Rd b/man/appServer.Rd index 751187e4..4da5fa29 100644 --- a/man/appServer.Rd +++ b/man/appServer.Rd @@ -96,3 +96,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/appUI.Rd b/man/appUI.Rd index be19e1d1..8ea4dd53 100644 --- a/man/appUI.Rd +++ b/man/appUI.Rd @@ -97,3 +97,4 @@ HTML elements The user interface (UI) controls the layout and appearance of the app. All CSS modifications are in the file \code{shiny/www/styles.css} } +\keyword{internal} diff --git a/man/appendNewGroups.Rd b/man/appendNewGroups.Rd index 2437ffe7..5bd2ea1d 100644 --- a/man/appendNewGroups.Rd +++ b/man/appendNewGroups.Rd @@ -21,3 +21,4 @@ NULL (this function is used to modify the Shiny session's state) Retrieve previous groups, rename duplicated group names in the new groups and append new groups to the previous ones } +\keyword{internal} diff --git a/man/areSplicingEvents.Rd b/man/areSplicingEvents.Rd index 2a9e4f4c..c9233b34 100644 --- a/man/areSplicingEvents.Rd +++ b/man/areSplicingEvents.Rd @@ -13,8 +13,9 @@ areSplicingEvents(char, num = 6) } \value{ TRUE if first elements of the vector identify splicing events; FALSE, - otherwise + otherwise } \description{ Check if string identifies splicing events } +\keyword{internal} diff --git a/man/articleUI.Rd b/man/articleUI.Rd index f707cf45..e0d3259f 100644 --- a/man/articleUI.Rd +++ b/man/articleUI.Rd @@ -15,3 +15,4 @@ HTML to render an article's interface \description{ Return the interface to display an article } +\keyword{internal} diff --git a/man/assignColours.Rd b/man/assignColours.Rd index 330386ad..0704c963 100644 --- a/man/assignColours.Rd +++ b/man/assignColours.Rd @@ -17,3 +17,4 @@ Groups with an added column to state the colour \description{ Assign colours to groups } +\keyword{internal} diff --git a/man/basicStats.Rd b/man/basicStats.Rd index 4a8eb585..5b318bfc 100644 --- a/man/basicStats.Rd +++ b/man/basicStats.Rd @@ -20,3 +20,4 @@ HTML elements Variance and median of each group. If data has 2 groups, also calculates the delta variance and delta median. } +\keyword{internal} diff --git a/man/blendColours.Rd b/man/blendColours.Rd index ad7df9db..ab5ead8c 100644 --- a/man/blendColours.Rd +++ b/man/blendColours.Rd @@ -26,3 +26,4 @@ Blend two HEX colours \examples{ psichomics:::blendColours("#3f83a3", "#f48000") } +\keyword{internal} diff --git a/man/browserHistory.Rd b/man/browserHistory.Rd index 67eb17a1..63acb528 100644 --- a/man/browserHistory.Rd +++ b/man/browserHistory.Rd @@ -21,3 +21,4 @@ Navigate app according to the location given by the navigation bar. Code and logic adapted from \url{https://github.com/daattali/advanced-shiny/blob/master/navigate-history} } +\keyword{internal} diff --git a/man/bsModal2.Rd b/man/bsModal2.Rd index 29ec74b9..caa5961f 100644 --- a/man/bsModal2.Rd +++ b/man/bsModal2.Rd @@ -31,3 +31,4 @@ HTML elements \code{bsModal} is used within the UI to create a modal window. This allows to modify the modal footer. } +\keyword{internal} diff --git a/man/calculateInclusionLevels.Rd b/man/calculateInclusionLevels.Rd index 780a1eae..d3810fea 100644 --- a/man/calculateInclusionLevels.Rd +++ b/man/calculateInclusionLevels.Rd @@ -27,3 +27,4 @@ Matrix with inclusion levels Calculate inclusion levels using alternative splicing event annotation and junction quantification for many samples } +\keyword{internal} diff --git a/man/checkFileFormat.Rd b/man/checkFileFormat.Rd index 0ea76113..bbc6d7a7 100644 --- a/man/checkFileFormat.Rd +++ b/man/checkFileFormat.Rd @@ -23,3 +23,4 @@ Checks the format of a file The name of the file may also be required to be considered of a certain format. } +\keyword{internal} diff --git a/man/checkFirebrowse.Rd b/man/checkFirebrowse.Rd index 488667da..0806b135 100644 --- a/man/checkFirebrowse.Rd +++ b/man/checkFirebrowse.Rd @@ -17,3 +17,4 @@ If the API is working, it'll be loaded. Else, a message will appear warning the user that the API is down and that will let check again if the API is back online. } +\keyword{internal} diff --git a/man/checkIntegrity.Rd b/man/checkIntegrity.Rd index b0336399..7cacf8f3 100644 --- a/man/checkIntegrity.Rd +++ b/man/checkIntegrity.Rd @@ -20,3 +20,4 @@ and \code{FALSE} for files with non-matching \code{md5sums} Compute the 32-byte \code{MD5} hashes of one or more files and check with given \code{md5} file } +\keyword{internal} diff --git a/man/checkSurvivalInput.Rd b/man/checkSurvivalInput.Rd index 3ba3254f..93057c85 100644 --- a/man/checkSurvivalInput.Rd +++ b/man/checkSurvivalInput.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Prepare survival terms in case of valid input } +\keyword{internal} diff --git a/man/closeProgress.Rd b/man/closeProgress.Rd deleted file mode 100644 index 65763686..00000000 --- a/man/closeProgress.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{closeProgress} -\alias{closeProgress} -\title{Close the progress even if there's an error} -\usage{ -closeProgress(message = NULL, global = if (isRunning()) sharedData else - getHidden()) -} -\arguments{ -\item{message}{Character: message to show in progress bar} - -\item{global}{Global Shiny variable where all data is stored} -} -\value{ -NULL (this function is used to modify the Shiny session's state) -} -\description{ -Close the progress even if there's an error -} diff --git a/man/clusterICAset.Rd b/man/clusterICAset.Rd index 5c7865e3..38184fa4 100644 --- a/man/clusterICAset.Rd +++ b/man/clusterICAset.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Server logic for clustering ICA data } +\keyword{internal} diff --git a/man/clusterSet.Rd b/man/clusterSet.Rd index c3b3c083..580bc58d 100644 --- a/man/clusterSet.Rd +++ b/man/clusterSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Server logic for clustering PCA data } +\keyword{internal} diff --git a/man/colourInputMod.Rd b/man/colourInputMod.Rd index cf3f266b..b088925e 100644 --- a/man/colourInputMod.Rd +++ b/man/colourInputMod.Rd @@ -34,3 +34,4 @@ HTML elements \description{ Modified colour input with 100\% width } +\keyword{internal} diff --git a/man/createDataTab.Rd b/man/createDataTab.Rd index a23d917d..82ddd1f4 100644 --- a/man/createDataTab.Rd +++ b/man/createDataTab.Rd @@ -25,3 +25,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Render a specific data tab (including data table and related interface) } +\keyword{internal} diff --git a/man/createDensitySparklines.Rd b/man/createDensitySparklines.Rd index fa74c868..4e9ee464 100644 --- a/man/createDensitySparklines.Rd +++ b/man/createDensitySparklines.Rd @@ -25,3 +25,4 @@ HTML element with sparkline data \description{ Create density sparklines for inclusion levels } +\keyword{internal} diff --git a/man/createEventPlotting.Rd b/man/createEventPlotting.Rd index f2976ce8..127a61e1 100644 --- a/man/createEventPlotting.Rd +++ b/man/createEventPlotting.Rd @@ -45,3 +45,4 @@ List containing HTML elements and highlighted points \description{ Create plot for events } +\keyword{internal} diff --git a/man/createGroup.Rd b/man/createGroup.Rd index 1c19fff8..34cbe6b1 100644 --- a/man/createGroup.Rd +++ b/man/createGroup.Rd @@ -30,3 +30,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Prepare to create group according to specific details } +\keyword{internal} diff --git a/man/createGroupById.Rd b/man/createGroupById.Rd index 00a255f3..dc2d82b3 100644 --- a/man/createGroupById.Rd +++ b/man/createGroupById.Rd @@ -19,3 +19,4 @@ Character: values based on given row indexes or identifiers \description{ Create groups based on given row indexes or identifiers } +\keyword{internal} diff --git a/man/createGroupFromInput.Rd b/man/createGroupFromInput.Rd index ce7acbb5..877a0c67 100644 --- a/man/createGroupFromInput.Rd +++ b/man/createGroupFromInput.Rd @@ -30,3 +30,4 @@ Matrix with the group names and respective elements \description{ Set new groups according to the user input } +\keyword{internal} diff --git a/man/createJunctionsTemplate.Rd b/man/createJunctionsTemplate.Rd index 44e8c896..8425304a 100644 --- a/man/createJunctionsTemplate.Rd +++ b/man/createJunctionsTemplate.Rd @@ -30,3 +30,4 @@ Creates a template of alternative splicing junctions \examples{ psichomics:::createJunctionsTemplate(nrow = 8) } +\keyword{internal} diff --git a/man/createOptimalSurvData.Rd b/man/createOptimalSurvData.Rd index f0fe7d33..a20e8b8c 100644 --- a/man/createOptimalSurvData.Rd +++ b/man/createOptimalSurvData.Rd @@ -40,3 +40,4 @@ and HTML element required to plot survival curves \description{ Data is presented in the table for statistical analyses } +\keyword{internal} diff --git a/man/createSparklines.Rd b/man/createSparklines.Rd index 70975734..1042be17 100644 --- a/man/createSparklines.Rd +++ b/man/createSparklines.Rd @@ -25,3 +25,4 @@ HTML element with sparkline data \description{ Create sparkline charts to be used in a data table } +\keyword{internal} diff --git a/man/diffAnalyses.Rd b/man/diffAnalyses.Rd index 4c8586c0..f8add023 100644 --- a/man/diffAnalyses.Rd +++ b/man/diffAnalyses.Rd @@ -2,16 +2,11 @@ % Please edit documentation in R/analysis.R \name{diffAnalyses} \alias{diffAnalyses} -\alias{diffAnalysis} \title{Perform statistical analyses} \usage{ diffAnalyses(data, groups = NULL, analyses = c("wilcoxRankSum", "ttest", "kruskal", "levene", "fligner"), pvalueAdjust = "BH", geneExpr = NULL, psi = NULL) - -diffAnalysis(data, groups = NULL, analyses = c("wilcoxRankSum", - "ttest", "kruskal", "levene", "fligner"), pvalueAdjust = "BH", - geneExpr = NULL, psi = NULL) } \arguments{ \item{data}{Data frame or matrix: gene expression or alternative splicing diff --git a/man/diffExpressionSet.Rd b/man/diffExpressionSet.Rd index 71586718..8bb5e7a0 100644 --- a/man/diffExpressionSet.Rd +++ b/man/diffExpressionSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/diffSplicingSet.Rd b/man/diffSplicingSet.Rd index 0ff64f96..8e6347a4 100644 --- a/man/diffSplicingSet.Rd +++ b/man/diffSplicingSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/disableTab.Rd b/man/disableTab.Rd index 8cbd3dc8..bcf77873 100644 --- a/man/disableTab.Rd +++ b/man/disableTab.Rd @@ -18,3 +18,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Enable or disable a tab from the \code{navbar} } +\keyword{internal} diff --git a/man/display.Rd b/man/display.Rd index f8326e74..7da08c9e 100644 --- a/man/display.Rd +++ b/man/display.Rd @@ -18,3 +18,4 @@ NULL (display message in command-line) \description{ Display characters in the command-line } +\keyword{internal} diff --git a/man/downloadFiles.Rd b/man/downloadFiles.Rd index 382cb00e..391f345e 100644 --- a/man/downloadFiles.Rd +++ b/man/downloadFiles.Rd @@ -30,3 +30,4 @@ downloadFiles(url, "~/Pictures") downloadFiles(url, "~/Pictures", quiet = TRUE) } } +\keyword{internal} diff --git a/man/endProcess.Rd b/man/endProcess.Rd deleted file mode 100644 index 2a4b7371..00000000 --- a/man/endProcess.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{endProcess} -\alias{endProcess} -\title{Signal the program that a process has ended} -\usage{ -endProcess(id, time = NULL, closeProgressBar = TRUE) -} -\arguments{ -\item{id}{Character: button identifier} - -\item{time}{\code{POSIXct} object: start time needed to show the interval -time (if NULL, the time interval is not displayed)} - -\item{closeProgressBar}{Boolean: close progress bar? TRUE by default} -} -\value{ -NULL (this function is used to modify the Shiny session's state) -} -\description{ -Style button to show processing is not occurring. Also, close the progress -bar (if TRUE) and print the difference between the current time and a given -time (if given time is not NULL) -} diff --git a/man/escape.Rd b/man/escape.Rd index 7be04d0f..25c1cdbb 100644 --- a/man/escape.Rd +++ b/man/escape.Rd @@ -15,3 +15,4 @@ Escaped string \description{ Escape symbols for use in regular expressions } +\keyword{internal} diff --git a/man/eventPlotOptions.Rd b/man/eventPlotOptions.Rd index 5f377eda..caabc499 100644 --- a/man/eventPlotOptions.Rd +++ b/man/eventPlotOptions.Rd @@ -24,3 +24,4 @@ HTML elements \description{ Options for event plotting } +\keyword{internal} diff --git a/man/export_highcharts.Rd b/man/export_highcharts.Rd index 6c48acee..cdacf81d 100644 --- a/man/export_highcharts.Rd +++ b/man/export_highcharts.Rd @@ -19,3 +19,4 @@ A \code{highcharts} object with an export button \description{ Add an exporting feature to a \code{highcharts} object } +\keyword{internal} diff --git a/man/fileBrowser.Rd b/man/fileBrowser.Rd index 56833662..01d55a8b 100644 --- a/man/fileBrowser.Rd +++ b/man/fileBrowser.Rd @@ -21,7 +21,7 @@ fileBrowser(default = NULL, caption = NULL, multiple = FALSE, \item{directory}{Boolean: allow to select directories instead of files?} } \value{ -A length one character vector, character NA if 'Cancel' was selected. +A length one character vector, character NA if 'Cancel' was selected } \description{ Interactive folder selection using a native dialogue @@ -40,3 +40,4 @@ Pltaform-dependent implementation: If for some reason an error occurs (e.g. when using a remote server), the dialog fallbacks to an alternative, non-native file browser. } +\keyword{internal} diff --git a/man/fileBrowserInput.Rd b/man/fileBrowserInput.Rd index 305fb1fa..69915e97 100644 --- a/man/fileBrowserInput.Rd +++ b/man/fileBrowserInput.Rd @@ -53,3 +53,4 @@ hosted applications (e.g. from \url{https://www.shinyapps.io}). \seealso{ \code{\link{updateFileBrowserInput}} and \code{\link{prepareFileBrowser}} } +\keyword{internal} diff --git a/man/findASeventsFromGene.Rd b/man/findASeventsFromGene.Rd index bf363b4f..875a23a2 100644 --- a/man/findASeventsFromGene.Rd +++ b/man/findASeventsFromGene.Rd @@ -17,3 +17,4 @@ Character vector containing alternative splicing events \description{ Find splicing events based on given genes } +\keyword{internal} diff --git a/man/fisher.Rd b/man/fisher.Rd deleted file mode 100644 index 0d8a1bcd..00000000 --- a/man/fisher.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{fisher} -\alias{fisher} -\title{Perform Fisher's exact test and return interface to show the results} -\usage{ -fisher(data, groups) -} -\arguments{ -\item{data}{Numeric, data frame or matrix: data for one gene or alternative -splicing event} - -\item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} -} -\value{ -HTML elements -} -\description{ -Perform Fisher's exact test and return interface to show the results -} diff --git a/man/fligner.Rd b/man/fligner.Rd deleted file mode 100644 index bc37be53..00000000 --- a/man/fligner.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{fligner} -\alias{fligner} -\title{Perform Fligner-Killeen test and return interface to show the results} -\usage{ -fligner(data, groups, stat = NULL) -} -\arguments{ -\item{data}{Numeric, data frame or matrix: data for one gene or alternative -splicing event} - -\item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} - -\item{stat}{Data frame or matrix: values of the analyses to be performed (if -NULL, the analyses will be performed)} -} -\value{ -HTML elements -} -\description{ -Perform Fligner-Killeen test and return interface to show the results -} diff --git a/man/geNormalisationFilteringInterface.Rd b/man/geNormalisationFilteringInterface.Rd index 748fe557..926faa78 100644 --- a/man/geNormalisationFilteringInterface.Rd +++ b/man/geNormalisationFilteringInterface.Rd @@ -15,3 +15,4 @@ HTML elements \description{ Interface to normalise and filter gene expression } +\keyword{internal} diff --git a/man/geneExprFileInput.Rd b/man/geneExprFileInput.Rd index fc848907..5814b2ef 100644 --- a/man/geneExprFileInput.Rd +++ b/man/geneExprFileInput.Rd @@ -15,3 +15,4 @@ HTML elements \description{ File input for gene expression } +\keyword{internal} diff --git a/man/geneExprSurvSet.Rd b/man/geneExprSurvSet.Rd index 766290ca..54686a37 100644 --- a/man/geneExprSurvSet.Rd +++ b/man/geneExprSurvSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Logic set to perform survival analysis based on gene expression cut-offs } +\keyword{internal} diff --git a/man/getASevent.Rd b/man/getASevent.Rd index 84c53003..cd578b05 100644 --- a/man/getASevent.Rd +++ b/man/getASevent.Rd @@ -14,6 +14,7 @@ as they are only used to modify the Shiny session's state Get or set globally accessible elements } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getASevents.Rd b/man/getASevents.Rd index e6d4f2ee..ca0f29d3 100644 --- a/man/getASevents.Rd +++ b/man/getASevents.Rd @@ -14,6 +14,7 @@ as they are only used to modify the Shiny session's state Get or set globally accessible elements } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getClinicalDataForSurvival.Rd b/man/getClinicalDataForSurvival.Rd index f454fecd..db534eb9 100644 --- a/man/getClinicalDataForSurvival.Rd +++ b/man/getClinicalDataForSurvival.Rd @@ -17,3 +17,4 @@ Filtered clinical data \description{ Retrieve clinical data based on attributes required for survival analysis } +\keyword{internal} diff --git a/man/getClinicalMatchFrom.Rd b/man/getClinicalMatchFrom.Rd index b62ab773..01417876 100644 --- a/man/getClinicalMatchFrom.Rd +++ b/man/getClinicalMatchFrom.Rd @@ -25,6 +25,7 @@ as they are only used to modify the Shiny session's state Get or set clinical matches from a given data type } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getData.Rd b/man/getData.Rd index 6b11604d..fe2f0ab4 100644 --- a/man/getData.Rd +++ b/man/getData.Rd @@ -12,3 +12,4 @@ Variable containing all data of interest \description{ Get global data } +\keyword{internal} diff --git a/man/getDataRows.Rd b/man/getDataRows.Rd index e93120ab..8e868730 100644 --- a/man/getDataRows.Rd +++ b/man/getDataRows.Rd @@ -30,3 +30,4 @@ Get rows of a data frame between two row indexes For a given iteration i, returns data from \code{firstRow[i]} to \code{lastRow[i]} } +\keyword{internal} diff --git a/man/getDifferentialExpression.Rd b/man/getDifferentialExpression.Rd index 9ff2f07a..6dc2a0f8 100644 --- a/man/getDifferentialExpression.Rd +++ b/man/getDifferentialExpression.Rd @@ -53,6 +53,7 @@ as they are only used to modify the Shiny session's state Get or set differential expression' elements for a data category } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getDifferentialSplicing.Rd b/man/getDifferentialSplicing.Rd index f04002c5..2fc587a8 100644 --- a/man/getDifferentialSplicing.Rd +++ b/man/getDifferentialSplicing.Rd @@ -53,6 +53,7 @@ as they are only used to modify the Shiny session's state Get or set differential splicing' elements for a data category } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getEvent.Rd b/man/getEvent.Rd deleted file mode 100644 index 06bd3011..00000000 --- a/man/getEvent.Rd +++ /dev/null @@ -1,162 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/globalAccess.R -\name{setASevent} -\alias{setASevent} -\alias{getEvent} -\alias{setEvent} -\alias{getCategories} -\alias{getCategory} -\alias{setCategory} -\alias{getCategoryData} -\alias{getActiveDataset} -\alias{setActiveDataset} -\alias{getClinicalData} -\alias{getPatientId} -\alias{getPatientAttributes} -\alias{getSampleInfo} -\alias{setSampleInfo} -\alias{getSampleId} -\alias{getSampleAttributes} -\alias{getJunctionQuantification} -\alias{getGeneExpression} -\alias{setNormalisedGeneExpression} -\alias{getInclusionLevels} -\alias{setInclusionLevels} -\alias{getPCA} -\alias{setPCA} -\alias{getICA} -\alias{setICA} -\alias{getCorrelation} -\alias{setCorrelation} -\alias{getGroupIndependenceTesting} -\alias{setGroupIndependenceTesting} -\alias{getSpecies} -\alias{setSpecies} -\alias{getAssemblyVersion} -\alias{setAssemblyVersion} -\alias{getAnnotationName} -\alias{setAnnotationName} -\alias{getURLtoDownload} -\alias{setURLtoDownload} -\title{Get or set globally accessible elements} -\usage{ -setASevent(event) - -getEvent() - -setEvent(event) - -getCategories() - -getCategory() - -setCategory(category) - -getCategoryData() - -getActiveDataset() - -setActiveDataset(dataset) - -getClinicalData(attrs = NULL) - -getPatientId() - -getPatientAttributes() - -getSampleInfo() - -setSampleInfo(value, category = getCategory()) - -getSampleId() - -getSampleAttributes() - -getJunctionQuantification(category = getCategory()) - -getGeneExpression(category = getCategory()) - -setNormalisedGeneExpression(geneExpr, category = getCategory()) - -getInclusionLevels() - -setInclusionLevels(incLevels, category = getCategory()) - -getPCA(category = getCategory()) - -setPCA(pca, category = getCategory()) - -getICA(category = getCategory()) - -setICA(ica, category = getCategory()) - -getCorrelation(category = getCategory()) - -setCorrelation(correlation, category = getCategory()) - -getGroupIndependenceTesting(category = getCategory()) - -setGroupIndependenceTesting(groupIndependenceTesting, - category = getCategory()) - -getSpecies(category = getCategory()) - -setSpecies(species, category = getCategory()) - -getAssemblyVersion(category = getCategory()) - -setAssemblyVersion(assembly, category = getCategory()) - -getAnnotationName(category = getCategory()) - -setAnnotationName(annotName, category = getCategory()) - -getURLtoDownload() - -setURLtoDownload(url) -} -\arguments{ -\item{event}{Character: alternative splicing event} - -\item{category}{Character: data category (e.g. "Carcinoma 2016"); by default, -it uses the selected data category} - -\item{dataset}{Character: dataset name} - -\item{attrs}{Character: name of attributes to retrieve (if NULL, the whole -dataset is returned)} - -\item{value}{Value to attribute to an element} - -\item{geneExpr}{Data frame or matrix: normalised gene expression} - -\item{incLevels}{Data frame or matrix: inclusion levels} - -\item{pca}{\code{prcomp} object (principal component analysis)} - -\item{ica}{Object containing independent component analysis} - -\item{correlation}{\code{prcomp} object (correlation analyses)} - -\item{groupIndependenceTesting}{Object containing group independence testing -results} - -\item{species}{Character: species} - -\item{assembly}{Character: assembly version} - -\item{annotName}{Character: annotation name} - -\item{url}{Character: URL links to download} -} -\value{ -Getters return globally accessible data, whereas setters return NULL -as they are only used to modify the Shiny session's state -} -\description{ -Get or set globally accessible elements -} -\seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, -\code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} -} diff --git a/man/getFirebrowseCohorts.Rd b/man/getFirebrowseCohorts.Rd deleted file mode 100644 index a8be7023..00000000 --- a/man/getFirebrowseCohorts.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_firebrowse.R -\name{getFirebrowseCohorts} -\alias{getFirebrowseCohorts} -\alias{getFirehoseCohorts} -\alias{getTCGAcohorts} -\title{Query the Firebrowse web API for available cohorts} -\usage{ -getFirebrowseCohorts(cohort = NULL) - -getFirehoseCohorts(cohort = NULL) - -getTCGAcohorts(cohort = NULL) -} -\arguments{ -\item{cohort}{Character: filter by given cohorts (optional)} -} -\value{ -Character with cohort abbreviations (as values) and description (as -names) -} -\description{ -Query the Firebrowse web API for available cohorts -} -\examples{ -if (isFirebrowseUp()) getFirebrowseCohorts() -} diff --git a/man/getFirebrowseDateFormat.Rd b/man/getFirebrowseDateFormat.Rd index e2b5fe9a..6d7d70ee 100644 --- a/man/getFirebrowseDateFormat.Rd +++ b/man/getFirebrowseDateFormat.Rd @@ -21,3 +21,4 @@ format$query # date format to parse a date in a response from Firebrowse web API format$response } +\keyword{internal} diff --git a/man/getFirebrowseDates.Rd b/man/getFirebrowseDates.Rd index 22694c21..d96200b9 100644 --- a/man/getFirebrowseDates.Rd +++ b/man/getFirebrowseDates.Rd @@ -2,22 +2,23 @@ % Please edit documentation in R/data_firebrowse.R \name{getFirebrowseDates} \alias{getFirebrowseDates} -\alias{getFirehoseDates} -\alias{getTCGAdates} -\title{Query the Firebrowse web API for the available data datestamps} +\alias{getFirebrowseCohorts} +\title{Query the Firebrowse web API} \usage{ getFirebrowseDates() -getFirehoseDates() - -getTCGAdates() +getFirebrowseCohorts(cohort = NULL) +} +\arguments{ +\item{cohort}{Character: filter results by given cohorts (optional)} } \value{ -Parsed date with datestamps of the data available +Parsed response } \description{ -Query the Firebrowse web API for the available data datestamps +Query the Firebrowse web API } \examples{ if (isFirebrowseUp()) getFirebrowseDates() +if (isFirebrowseUp()) getFirebrowseCohorts() } diff --git a/man/getGeneList.Rd b/man/getGeneList.Rd index 485e8320..28a2dc47 100644 --- a/man/getGeneList.Rd +++ b/man/getGeneList.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/globalAccess.R \name{getGeneList} \alias{getGeneList} -\title{Get pre-created gene list} +\title{Get pre-created, literature-based gene list} \usage{ getGeneList() } @@ -10,7 +10,11 @@ getGeneList() List of genes } \description{ -Get pre-created gene list +Available gene lists: +\itemize{ + \item{\strong{Sebestyen et al., 2016}: 1350 genes encoding RNA-binding + proteins, 167 of which are splicing factors} +} } \examples{ getGeneList() diff --git a/man/getGenes.Rd b/man/getGenes.Rd deleted file mode 100644 index 563a2672..00000000 --- a/man/getGenes.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/globalAccess.R -\name{getGenes} -\alias{getGenes} -\title{Get or set globally accessible elements} -\usage{ -getGenes() -} -\value{ -Getters return globally accessible data, whereas setters return NULL -as they are only used to modify the Shiny session's state -} -\description{ -Get or set globally accessible elements -} -\seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, -\code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} -} diff --git a/man/getGenesFromSplicingEvents.Rd b/man/getGenesFromSplicingEvents.Rd deleted file mode 100644 index 09f816f2..00000000 --- a/man/getGenesFromSplicingEvents.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{getGenesFromSplicingEvents} -\alias{getGenesFromSplicingEvents} -\title{Retrieve genes based on given alternative splicing events} -\usage{ -getGenesFromSplicingEvents(ASevents) -} -\arguments{ -\item{ASevents}{Character: alternative splicing events} -} -\value{ -Named character containing alternative splicing events and their -respective genes as names -} -\description{ -Retrieve genes based on given alternative splicing events -} diff --git a/man/getGlobal.Rd b/man/getGlobal.Rd index 51e25ab8..50d08bbf 100644 --- a/man/getGlobal.Rd +++ b/man/getGlobal.Rd @@ -13,6 +13,44 @@ \alias{setSignificant} \alias{getPrecision} \alias{setPrecision} +\alias{setASevent} +\alias{getEvent} +\alias{setEvent} +\alias{getGenes} +\alias{getCategories} +\alias{getCategory} +\alias{setCategory} +\alias{getCategoryData} +\alias{getActiveDataset} +\alias{setActiveDataset} +\alias{getClinicalData} +\alias{getPatientId} +\alias{getPatientAttributes} +\alias{getSampleInfo} +\alias{setSampleInfo} +\alias{getSampleId} +\alias{getSampleAttributes} +\alias{getJunctionQuantification} +\alias{getGeneExpression} +\alias{setNormalisedGeneExpression} +\alias{getInclusionLevels} +\alias{setInclusionLevels} +\alias{getPCA} +\alias{setPCA} +\alias{getICA} +\alias{setICA} +\alias{getCorrelation} +\alias{setCorrelation} +\alias{getGroupIndependenceTesting} +\alias{setGroupIndependenceTesting} +\alias{getSpecies} +\alias{setSpecies} +\alias{getAssemblyVersion} +\alias{setAssemblyVersion} +\alias{getAnnotationName} +\alias{setAnnotationName} +\alias{getURLtoDownload} +\alias{setURLtoDownload} \title{Get or set globally accessible elements} \usage{ getGlobal(category = getCategory(), ..., sep = "_") @@ -38,6 +76,83 @@ setSignificant(integer) getPrecision() setPrecision(integer) + +setASevent(event) + +getEvent() + +setEvent(event) + +getGenes() + +getCategories() + +getCategory() + +setCategory(category) + +getCategoryData() + +getActiveDataset() + +setActiveDataset(dataset) + +getClinicalData(attrs = NULL) + +getPatientId() + +getPatientAttributes() + +getSampleInfo() + +setSampleInfo(value, category = getCategory()) + +getSampleId() + +getSampleAttributes() + +getJunctionQuantification(category = getCategory()) + +getGeneExpression(category = getCategory()) + +setNormalisedGeneExpression(geneExpr, category = getCategory()) + +getInclusionLevels() + +setInclusionLevels(incLevels, category = getCategory()) + +getPCA(category = getCategory()) + +setPCA(pca, category = getCategory()) + +getICA(category = getCategory()) + +setICA(ica, category = getCategory()) + +getCorrelation(category = getCategory()) + +setCorrelation(correlation, category = getCategory()) + +getGroupIndependenceTesting(category = getCategory()) + +setGroupIndependenceTesting(groupIndependenceTesting, + category = getCategory()) + +getSpecies(category = getCategory()) + +setSpecies(species, category = getCategory()) + +getAssemblyVersion(category = getCategory()) + +setAssemblyVersion(assembly, category = getCategory()) + +getAnnotationName(category = getCategory()) + +setAnnotationName(annotName, category = getCategory()) + +getURLtoDownload() + +setURLtoDownload(url) } \arguments{ \item{category}{Character: data category (e.g. "Carcinoma 2016"); by default, @@ -56,6 +171,34 @@ it uses the selected data category} \item{auto}{Boolean: enable automatic navigation of browser history?} \item{integer}{Integer: value of the setting} + +\item{event}{Character: alternative splicing event} + +\item{dataset}{Character: dataset name} + +\item{attrs}{Character: name of attributes to retrieve (if NULL, the whole +dataset is returned)} + +\item{geneExpr}{Data frame or matrix: normalised gene expression} + +\item{incLevels}{Data frame or matrix: inclusion levels} + +\item{pca}{\code{prcomp} object (principal component analysis)} + +\item{ica}{Object containing independent component analysis} + +\item{correlation}{\code{prcomp} object (correlation analyses)} + +\item{groupIndependenceTesting}{Object containing group independence testing +results} + +\item{species}{Character: species} + +\item{assembly}{Character: assembly version} + +\item{annotName}{Character: annotation name} + +\item{url}{Character: URL links to download} } \value{ Getters return globally accessible data, whereas setters return NULL @@ -68,6 +211,7 @@ Get or set globally accessible elements Needs to be called inside a reactive function } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getGroups.Rd b/man/getGroups.Rd index a957f3c3..1d55e9dc 100644 --- a/man/getGroups.Rd +++ b/man/getGroups.Rd @@ -31,6 +31,7 @@ as they are only used to modify the Shiny session's state Get or set groups } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getGtexTissues.Rd b/man/getGtexTissues.Rd index 748bbef3..49397455 100644 --- a/man/getGtexTissues.Rd +++ b/man/getGtexTissues.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/data_gtex.R \name{getGtexTissues} \alias{getGtexTissues} -\alias{getGTExTissues} \title{Get GTEx tissues from given GTEx sample attributes} \usage{ getGtexTissues(sampleMetadata) - -getGTExTissues(sampleMetadata) } \arguments{ \item{sampleMetadata}{Character: path to sample attributes} diff --git a/man/getHidden.Rd b/man/getHidden.Rd index e281510b..6eaeb1fe 100644 --- a/man/getHidden.Rd +++ b/man/getHidden.Rd @@ -19,3 +19,4 @@ return NULL as they are only used to modify the state of hidden elements \description{ Get or set hidden globally accessible elements } +\keyword{internal} diff --git a/man/getHighlightedPoints.Rd b/man/getHighlightedPoints.Rd index 19a6db2f..72e721fc 100644 --- a/man/getHighlightedPoints.Rd +++ b/man/getHighlightedPoints.Rd @@ -45,6 +45,7 @@ as they are only used to modify the Shiny session's state Get or set points or regions for plots } \seealso{ -\code{\link{getEvent}}, \code{\link{getClinicalMatchFrom}}, +\code{\link{getGlobal}}, \code{\link{getClinicalMatchFrom}}, \code{\link{getGroups}} and \code{\link{getDifferentialSplicing}} } +\keyword{internal} diff --git a/man/getNumerics.Rd b/man/getNumerics.Rd index 3f799c2e..c8db4ded 100644 --- a/man/getNumerics.Rd +++ b/man/getNumerics.Rd @@ -37,3 +37,4 @@ event <- psichomics:::getNumerics(event, by = c("Strand", "C1.end", "A1.end", # Let's check if the same column is now integer is.numeric(event[ , "C1.end"]) } +\keyword{internal} diff --git a/man/getServerFunctions.Rd b/man/getServerFunctions.Rd index f71b3353..8ff0836f 100644 --- a/man/getServerFunctions.Rd +++ b/man/getServerFunctions.Rd @@ -21,3 +21,4 @@ Invisible TRUE \description{ Matches server functions from a given loader } +\keyword{internal} diff --git a/man/getSplicingEventCoordinates.Rd b/man/getSplicingEventCoordinates.Rd index 203710c1..6522c4ee 100644 --- a/man/getSplicingEventCoordinates.Rd +++ b/man/getSplicingEventCoordinates.Rd @@ -19,3 +19,4 @@ type \description{ Returns the coordinates of interest for a given event type } +\keyword{internal} diff --git a/man/getSplicingEventFromGenes.Rd b/man/getSplicingEventFromGenes.Rd index 20563498..6c66049d 100644 --- a/man/getSplicingEventFromGenes.Rd +++ b/man/getSplicingEventFromGenes.Rd @@ -2,20 +2,29 @@ % Please edit documentation in R/utils.R \name{getSplicingEventFromGenes} \alias{getSplicingEventFromGenes} -\title{Retrieve alternative splicing events based on given genes} +\alias{getGenesFromSplicingEvents} +\title{Get alternative splicing events from genes or vice-versa} \usage{ getSplicingEventFromGenes(genes, ASevents) + +getGenesFromSplicingEvents(ASevents) } \arguments{ \item{genes}{Character: gene symbols (or TCGA-styled gene symbols)} -\item{ASevents}{Character: alternative splicing events to be matched} +\item{ASevents}{Character: alternative splicing events} } \value{ -Character containing respective alternative splicing events +Named character containing alternative splicing events or genes and +their respective genes or alternative splicing events as names (depending on +the function in use) } \description{ -Retrieve alternative splicing events based on given genes +Get alternative splicing events from genes or vice-versa +} +\details{ +A list of alternative splicing events is required to run +\code{getSplicingEventFromGenes} } \examples{ ASevents <- c("SE_1_+_201763003_201763300_201763374_201763594_NAV1", @@ -24,5 +33,18 @@ ASevents <- c("SE_1_+_201763003_201763300_201763374_201763594_NAV1", "SE_1_+_181019422_181022709_181022813_181024361_MR1", "SE_1_+_181695298_181700311_181700367_181701520_CACNA1E") genes <- c("NAV1", "SMG7", "MR1", "HELLO") -getSplicingEventFromGenes(genes, ASevents) + +# Get splicing events from genes +matchedASevents <- getSplicingEventFromGenes(genes, ASevents) + +# Names of matched events are the matching input genes +names(matchedASevents) +matchedASevents + +# Get genes from splicing events +matchedGenes <- getGenesFromSplicingEvents (ASevents) + +# Names of matched genes are the matching input alternative splicing events +names(matchedGenes) +matchedGenes } diff --git a/man/getSplicingEventTypes.Rd b/man/getSplicingEventTypes.Rd index ad9519ec..be773049 100644 --- a/man/getSplicingEventTypes.Rd +++ b/man/getSplicingEventTypes.Rd @@ -7,7 +7,7 @@ getSplicingEventTypes(acronymsAsNames = FALSE) } \arguments{ -\item{acronymsAsNames}{Boolean: return acronyms as names? FALSE by default} +\item{acronymsAsNames}{Boolean: return acronyms as names?} } \value{ Named character vector with splicing event types diff --git a/man/getUiFunctions.Rd b/man/getUiFunctions.Rd index f8cfa5d1..7b6707b9 100644 --- a/man/getUiFunctions.Rd +++ b/man/getUiFunctions.Rd @@ -23,3 +23,4 @@ List of functions related to the given loader \description{ Matches user interface (UI) functions from a given loader } +\keyword{internal} diff --git a/man/getValidEvents.Rd b/man/getValidEvents.Rd index 46f6310f..8cb109dd 100644 --- a/man/getValidEvents.Rd +++ b/man/getValidEvents.Rd @@ -54,3 +54,4 @@ event <- read.table(text = " validator <- c("gene", "mRNA", rep("exon", 3), "mRNA", rep("exon", 2)) psichomics:::getValidEvents(event, validator) } +\keyword{internal} diff --git a/man/ggplotServer.Rd b/man/ggplotServer.Rd index 0303c0ad..3caf677e 100644 --- a/man/ggplotServer.Rd +++ b/man/ggplotServer.Rd @@ -35,3 +35,4 @@ Logic set to create an interactive ggplot Insert \code{ggplotAuxSet} outside any observer (so it is only run once) } +\keyword{internal} diff --git a/man/ggplotTooltip.Rd b/man/ggplotTooltip.Rd index 638f8f4d..0900060f 100644 --- a/man/ggplotTooltip.Rd +++ b/man/ggplotTooltip.Rd @@ -22,3 +22,4 @@ HTML elements \description{ Create the interface for the tooltip of a plot } +\keyword{internal} diff --git a/man/ggplotUI.Rd b/man/ggplotUI.Rd index a66befbe..dfebf78b 100644 --- a/man/ggplotUI.Rd +++ b/man/ggplotUI.Rd @@ -15,3 +15,4 @@ HTML elements \description{ Interface for interactive ggplot } +\keyword{internal} diff --git a/man/globalSelectize.Rd b/man/globalSelectize.Rd index b5ada9de..0f4891bb 100644 --- a/man/globalSelectize.Rd +++ b/man/globalSelectize.Rd @@ -17,3 +17,4 @@ HTML element for a global selectize input \description{ Create a selectize input available from any page } +\keyword{internal} diff --git a/man/groupByAttribute.Rd b/man/groupByAttribute.Rd index a165d9c3..a8c9a302 100644 --- a/man/groupByAttribute.Rd +++ b/man/groupByAttribute.Rd @@ -2,9 +2,21 @@ % Please edit documentation in R/groups.R \name{groupByAttribute} \alias{groupByAttribute} -\title{User interface to group by attribute} +\alias{groupByPreMadeList} +\alias{groupById} +\alias{groupByExpression} +\alias{groupByGrep} +\title{Data grouping interface} \usage{ groupByAttribute(ns, cols, id, example) + +groupByPreMadeList(ns, data, id) + +groupById(ns, id) + +groupByExpression(ns, id) + +groupByGrep(ns, cols, id) } \arguments{ \item{ns}{Namespace function} @@ -14,10 +26,12 @@ groupByAttribute(ns, cols, id, example) \item{id}{Character: identifier} \item{example}{Character: text to show as an example} + +\item{data}{List: list of groups with elements} } \value{ HTML elements } \description{ -User interface to group by attribute +Data grouping interface } diff --git a/man/groupByExpression.Rd b/man/groupByExpression.Rd deleted file mode 100644 index 4fde9cfc..00000000 --- a/man/groupByExpression.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/groups.R -\name{groupByExpression} -\alias{groupByExpression} -\title{User interface to group by subset expression} -\usage{ -groupByExpression(ns, id) -} -\arguments{ -\item{ns}{Namespace function} - -\item{id}{Character: identifier} -} -\value{ -HTML elements -} -\description{ -User interface to group by subset expression -} diff --git a/man/groupByGrep.Rd b/man/groupByGrep.Rd deleted file mode 100644 index d5e856e2..00000000 --- a/man/groupByGrep.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/groups.R -\name{groupByGrep} -\alias{groupByGrep} -\title{User interface to group by grep expression} -\usage{ -groupByGrep(ns, cols, id) -} -\arguments{ -\item{ns}{Namespace function} - -\item{cols}{Character or list: name of columns to show} - -\item{id}{Character: identifier} -} -\value{ -HTML elements -} -\description{ -User interface to group by grep expression -} diff --git a/man/groupById.Rd b/man/groupById.Rd deleted file mode 100644 index 342358c3..00000000 --- a/man/groupById.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/groups.R -\name{groupById} -\alias{groupById} -\title{User interface to group by row} -\usage{ -groupById(ns, id) -} -\arguments{ -\item{ns}{Namespace function} - -\item{id}{Character: identifier} -} -\value{ -HTML elements -} -\description{ -User interface to group by row -} diff --git a/man/groupByPreMadeList.Rd b/man/groupByPreMadeList.Rd deleted file mode 100644 index 7d15a25f..00000000 --- a/man/groupByPreMadeList.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/groups.R -\name{groupByPreMadeList} -\alias{groupByPreMadeList} -\title{User interface to use pre-made groups} -\usage{ -groupByPreMadeList(ns, data, id) -} -\arguments{ -\item{ns}{Namespace function} - -\item{data}{List: list of groups with elements} - -\item{id}{Character: identifier} -} -\value{ -HTML elements -} -\description{ -User interface to use pre-made groups -} diff --git a/man/groupManipulation.Rd b/man/groupManipulation.Rd index ae933392..306a0dd4 100644 --- a/man/groupManipulation.Rd +++ b/man/groupManipulation.Rd @@ -21,3 +21,4 @@ HTML elements \description{ Logic server to manipulate data grouping } +\keyword{internal} diff --git a/man/groupManipulationInput.Rd b/man/groupManipulationInput.Rd index 6271372f..1b742e5b 100644 --- a/man/groupManipulationInput.Rd +++ b/man/groupManipulationInput.Rd @@ -17,3 +17,4 @@ HTML elements \description{ Interface to manipulate data grouping } +\keyword{internal} diff --git a/man/groupsServerOnce.Rd b/man/groupsServerOnce.Rd index b7067616..504a2ba9 100644 --- a/man/groupsServerOnce.Rd +++ b/man/groupsServerOnce.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ These functions only run once instead of running for every instance of groups } +\keyword{internal} diff --git a/man/hc_scatter.Rd b/man/hc_scatter.Rd index 74951db5..6d3c5045 100644 --- a/man/hc_scatter.Rd +++ b/man/hc_scatter.Rd @@ -32,3 +32,4 @@ default} \description{ Create a scatter plot using \code{highcharter} } +\keyword{internal} diff --git a/man/hchart.survfit.Rd b/man/hchart.survfit.Rd index 611a74e5..09b7a779 100644 --- a/man/hchart.survfit.Rd +++ b/man/hchart.survfit.Rd @@ -56,3 +56,4 @@ fit <- coxph(Surv(futime, fustat) ~ age, data = ovarian) ovarian.surv <- survfit(fit, newdata=data.frame(age=60)) hchart(ovarian.surv, ranges = TRUE) } +\keyword{internal} diff --git a/man/inclusionLevelsInterface.Rd b/man/inclusionLevelsInterface.Rd index ff5f67cb..73b08daa 100644 --- a/man/inclusionLevelsInterface.Rd +++ b/man/inclusionLevelsInterface.Rd @@ -15,3 +15,4 @@ HTML elements \description{ Interface to quantify alternative splicing } +\keyword{internal} diff --git a/man/inlineDialog.Rd b/man/inlineDialog.Rd index 72da93e4..30bbfd1d 100644 --- a/man/inlineDialog.Rd +++ b/man/inlineDialog.Rd @@ -37,3 +37,4 @@ HTML elements \description{ Alert in the style of a dialogue box with a button } +\keyword{internal} diff --git a/man/insideFile.Rd b/man/insideFile.Rd index 9484de86..049ce389 100644 --- a/man/insideFile.Rd +++ b/man/insideFile.Rd @@ -17,3 +17,4 @@ Loaded file \description{ Get psichomics file inside a given directory } +\keyword{internal} diff --git a/man/is.whole.Rd b/man/is.whole.Rd index 558fb320..7dbf856f 100644 --- a/man/is.whole.Rd +++ b/man/is.whole.Rd @@ -17,3 +17,4 @@ TRUE if number is whole; otherwise, FALSE \description{ Check if a number is whole } +\keyword{internal} diff --git a/man/isFile.Rd b/man/isFile.Rd index 8953e6e5..b247592b 100644 --- a/man/isFile.Rd +++ b/man/isFile.Rd @@ -15,3 +15,4 @@ Boolean vector stating whether each file exists or not \description{ Check if files exist } +\keyword{internal} diff --git a/man/isFirebrowseUp.Rd b/man/isFirebrowseUp.Rd index c2974b05..15388c72 100644 --- a/man/isFirebrowseUp.Rd +++ b/man/isFirebrowseUp.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/data_firebrowse.R \name{isFirebrowseUp} \alias{isFirebrowseUp} -\alias{isFirehoseUp} \title{Check whether the Firebrowse web API is running} \usage{ isFirebrowseUp() - -isFirehoseUp() } \value{ Invisible TRUE if the Firebrowse web API is working; otherwise, diff --git a/man/isRStudioServer.Rd b/man/isRStudioServer.Rd index b4f78e5d..9969078a 100644 --- a/man/isRStudioServer.Rd +++ b/man/isRStudioServer.Rd @@ -12,3 +12,4 @@ Boolean stating whether running in RStudio Server \description{ Check if running in RStudio Server } +\keyword{internal} diff --git a/man/joinEventsPerType.Rd b/man/joinEventsPerType.Rd index aa9e6506..e653951d 100644 --- a/man/joinEventsPerType.Rd +++ b/man/joinEventsPerType.Rd @@ -17,3 +17,4 @@ List of events joined by alternative splicing event type \description{ Full outer join all given events based on select columns } +\keyword{internal} diff --git a/man/junctionString.Rd b/man/junctionString.Rd index ee4015ea..60993299 100644 --- a/man/junctionString.Rd +++ b/man/junctionString.Rd @@ -23,3 +23,4 @@ Formatted character string \description{ String used to search for matches in a junction quantification file } +\keyword{internal} diff --git a/man/kruskal.Rd b/man/kruskal.Rd deleted file mode 100644 index fb885559..00000000 --- a/man/kruskal.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{kruskal} -\alias{kruskal} -\title{Perform Kruskal's test and return interface to show the results} -\usage{ -kruskal(data, groups, stat = NULL) -} -\arguments{ -\item{data}{Numeric, data frame or matrix: data for one gene or alternative -splicing event} - -\item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} - -\item{stat}{Data frame or matrix: values of the analyses to be performed (if -NULL, the analyses will be performed)} -} -\value{ -HTML elements -} -\description{ -Perform Kruskal's test and return interface to show the results -} diff --git a/man/levene.Rd b/man/levene.Rd deleted file mode 100644 index d2aff026..00000000 --- a/man/levene.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{levene} -\alias{levene} -\title{Perform Levene's test and return interface to show the results} -\usage{ -levene(data, groups, stat = NULL) -} -\arguments{ -\item{data}{Numeric, data frame or matrix: data for one gene or alternative -splicing event} - -\item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} - -\item{stat}{Data frame or matrix: values of the analyses to be performed (if -NULL, the analyses will be performed)} -} -\value{ -HTML elements -} -\description{ -Perform Levene's test and return interface to show the results -} diff --git a/man/leveneTest.Rd b/man/leveneTest.Rd index 1d439dff..523a6be1 100644 --- a/man/leveneTest.Rd +++ b/man/leveneTest.Rd @@ -42,3 +42,4 @@ psichomics:::leveneTest(vals, group) ## Using Levene's test based on the mean psichomics:::leveneTest(vals, group, mean) } +\keyword{internal} diff --git a/man/linkToArticle.Rd b/man/linkToArticle.Rd index 80fe508a..020f0bb3 100644 --- a/man/linkToArticle.Rd +++ b/man/linkToArticle.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/app.R \name{linkToArticle} \alias{linkToArticle} -\title{Interface that directs users to original article} +\title{psichomics article's link interface} \usage{ linkToArticle() } @@ -10,5 +10,6 @@ linkToArticle() HTML elements } \description{ -Interface that directs users to original article +psichomics article's link interface } +\keyword{internal} diff --git a/man/linkToRunJS.Rd b/man/linkToRunJS.Rd index 49302395..7ee52f13 100644 --- a/man/linkToRunJS.Rd +++ b/man/linkToRunJS.Rd @@ -17,3 +17,4 @@ HTML elements \description{ Link to run arbitrary JavaScript code } +\keyword{internal} diff --git a/man/listAllAnnotations.Rd b/man/listAllAnnotations.Rd index 4157ce60..223a5ed0 100644 --- a/man/listAllAnnotations.Rd +++ b/man/listAllAnnotations.Rd @@ -20,3 +20,4 @@ annotation \examples{ psichomics:::listAllAnnotations() } +\keyword{internal} diff --git a/man/loadBy.Rd b/man/loadBy.Rd index f51328af..a13f684a 100644 --- a/man/loadBy.Rd +++ b/man/loadBy.Rd @@ -17,3 +17,4 @@ Boolean vector \description{ Check if a given function should be loaded by the calling module } +\keyword{internal} diff --git a/man/loadCustomSplicingAnnotationSet.Rd b/man/loadCustomSplicingAnnotationSet.Rd index ce834775..317d2eb6 100644 --- a/man/loadCustomSplicingAnnotationSet.Rd +++ b/man/loadCustomSplicingAnnotationSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/loadFile.Rd b/man/loadFile.Rd index 29b91d44..fa4732d9 100644 --- a/man/loadFile.Rd +++ b/man/loadFile.Rd @@ -23,3 +23,4 @@ Loads a file according to its format The resulting data frame includes the attribute \code{tablename} with the name of the data frame } +\keyword{internal} diff --git a/man/loadFileFormats.Rd b/man/loadFileFormats.Rd index 704ad7c9..7e356405 100644 --- a/man/loadFileFormats.Rd +++ b/man/loadFileFormats.Rd @@ -2,13 +2,14 @@ % Please edit documentation in R/formats.R \name{loadFileFormats} \alias{loadFileFormats} -\title{Loads file formats} +\title{Load supported file formats} \usage{ loadFileFormats() } \value{ -Loaded file formats available +Supported file formats } \description{ -Loads file formats +Load supported file formats } +\keyword{internal} diff --git a/man/loadFirebrowseData.Rd b/man/loadFirebrowseData.Rd index 92aa34e3..7f253cfc 100644 --- a/man/loadFirebrowseData.Rd +++ b/man/loadFirebrowseData.Rd @@ -2,18 +2,10 @@ % Please edit documentation in R/data_firebrowse.R \name{loadFirebrowseData} \alias{loadFirebrowseData} -\alias{loadFirehoseData} -\alias{loadTCGAdata} \title{Downloads and processes data from the Firebrowse web API and loads it into R} \usage{ loadFirebrowseData(folder = NULL, data = NULL, exclude = c(".aux.", ".mage-tab.", "MANIFEST.txt"), ..., download = TRUE) - -loadFirehoseData(folder = NULL, data = NULL, exclude = c(".aux.", - ".mage-tab.", "MANIFEST.txt"), ..., download = TRUE) - -loadTCGAdata(folder = NULL, data = NULL, exclude = c(".aux.", - ".mage-tab.", "MANIFEST.txt"), ..., download = TRUE) } \arguments{ \item{folder}{Character: directory to store the downloaded archives (by diff --git a/man/loadFirebrowseFolders.Rd b/man/loadFirebrowseFolders.Rd index 9c750267..f4f3a9ae 100644 --- a/man/loadFirebrowseFolders.Rd +++ b/man/loadFirebrowseFolders.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/data_firebrowse.R \name{loadFirebrowseFolders} \alias{loadFirebrowseFolders} -\alias{loadFirehoseFolders} -\alias{loadTCGAfolders} \title{Load Firebrowse folders} \usage{ loadFirebrowseFolders(folder, exclude = "") - -loadFirehoseFolders(folder, exclude = "") - -loadTCGAfolders(folder, exclude = "") } \arguments{ \item{folder}{Character: folder(s) in which to look for Firebrowse files} @@ -28,3 +22,4 @@ For faster execution, this function uses the \code{readr} library. This function ignores subfolders of the given folder (which means that files inside subfolders are NOT loaded). } +\keyword{internal} diff --git a/man/loadGeneExpressionSet.Rd b/man/loadGeneExpressionSet.Rd index 70817062..42ede02e 100644 --- a/man/loadGeneExpressionSet.Rd +++ b/man/loadGeneExpressionSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/loadGtexDataShiny.Rd b/man/loadGtexDataShiny.Rd index e24bba68..5916ccd9 100644 --- a/man/loadGtexDataShiny.Rd +++ b/man/loadGtexDataShiny.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Shiny wrapper to load GTEx data } +\keyword{internal} diff --git a/man/loadGtexFile.Rd b/man/loadGtexFile.Rd index 90f6ae64..2f9dc775 100644 --- a/man/loadGtexFile.Rd +++ b/man/loadGtexFile.Rd @@ -22,3 +22,4 @@ Loaded file as a data frame \description{ Load GTEx file } +\keyword{internal} diff --git a/man/loadSplicingQuantificationSet.Rd b/man/loadSplicingQuantificationSet.Rd index 10c37ef6..2f0533e8 100644 --- a/man/loadSplicingQuantificationSet.Rd +++ b/man/loadSplicingQuantificationSet.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/loadTCGAsampleMetadata.Rd b/man/loadTCGAsampleMetadata.Rd index ff95c84c..1152869c 100644 --- a/man/loadTCGAsampleMetadata.Rd +++ b/man/loadTCGAsampleMetadata.Rd @@ -15,3 +15,4 @@ List of list of data frames \description{ If no TCGA datasets apply, the input is returned } +\keyword{internal} diff --git a/man/loadedDataModal.Rd b/man/loadedDataModal.Rd index 99b5b4bd..33ffbe07 100644 --- a/man/loadedDataModal.Rd +++ b/man/loadedDataModal.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/data.R \name{loadedDataModal} \alias{loadedDataModal} -\title{Create a modal warning the user of already loaded data} +\title{Warn user about loaded data} \usage{ loadedDataModal(session, modalId, replaceButtonId, keepButtonId) } @@ -19,5 +19,6 @@ loadedDataModal(session, modalId, replaceButtonId, keepButtonId) HTML elements for a warning modal reminding data is loaded } \description{ -Create a modal warning the user of already loaded data +Warn user about loaded data } +\keyword{internal} diff --git a/man/matchGroupASeventsAndGenes.Rd b/man/matchGroupASeventsAndGenes.Rd index 66d01c90..2f2ba189 100644 --- a/man/matchGroupASeventsAndGenes.Rd +++ b/man/matchGroupASeventsAndGenes.Rd @@ -17,3 +17,4 @@ Data frame with groups containing matching elements \description{ Match AS events and genes in a group } +\keyword{internal} diff --git a/man/matchGroupPatientsAndSamples.Rd b/man/matchGroupPatientsAndSamples.Rd index e05b3221..d97364e2 100644 --- a/man/matchGroupPatientsAndSamples.Rd +++ b/man/matchGroupPatientsAndSamples.Rd @@ -17,3 +17,4 @@ Data frame with groups containing matching elements \description{ Match patients and samples in a group } +\keyword{internal} diff --git a/man/matchSplicingEventsWithGenes.Rd b/man/matchSplicingEventsWithGenes.Rd index 0c267960..5efb559f 100644 --- a/man/matchSplicingEventsWithGenes.Rd +++ b/man/matchSplicingEventsWithGenes.Rd @@ -16,3 +16,4 @@ respective gene as their name \description{ Match splicing events with respective genes } +\keyword{internal} diff --git a/man/missingDataModal.Rd b/man/missingDataModal.Rd index 4cab186d..6ecac5d9 100644 --- a/man/missingDataModal.Rd +++ b/man/missingDataModal.Rd @@ -38,3 +38,4 @@ Missing information modal template observeEvent(input[[buttonInput]], missingDataGuide(dataType)) } } +\keyword{internal} diff --git a/man/modTabPanel.Rd b/man/modTabPanel.Rd index 02c99b33..09de883a 100644 --- a/man/modTabPanel.Rd +++ b/man/modTabPanel.Rd @@ -24,3 +24,4 @@ Modified \code{tabPanel} function to show icon and title \note{ Icon is hidden at small viewports } +\keyword{internal} diff --git a/man/navSelectize.Rd b/man/navSelectize.Rd index ada0e2ef..afb77ed4 100644 --- a/man/navSelectize.Rd +++ b/man/navSelectize.Rd @@ -19,3 +19,4 @@ HTML element to be included in a navigation bar \description{ Create a special selectize input in the navigation bar } +\keyword{internal} diff --git a/man/noinfo.Rd b/man/noinfo.Rd index c64250d8..e680eca3 100644 --- a/man/noinfo.Rd +++ b/man/noinfo.Rd @@ -28,3 +28,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Interface when no information could be retrieved } +\keyword{internal} diff --git a/man/operateOnGroups.Rd b/man/operateOnGroups.Rd index 2d8cdef1..b14c5e2c 100644 --- a/man/operateOnGroups.Rd +++ b/man/operateOnGroups.Rd @@ -29,3 +29,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ This function can be used on groups to merge, intersect, subtract, etc. } +\keyword{internal} diff --git a/man/optimSurvDiffSet.Rd b/man/optimSurvDiffSet.Rd index d173765d..f716798c 100644 --- a/man/optimSurvDiffSet.Rd +++ b/man/optimSurvDiffSet.Rd @@ -16,10 +16,9 @@ optimSurvDiffSet(session, input, output) } \value{ NULL (this function is used to modify the Shiny session's state) -Calculate optimal survival cutoff for the inclusion levels of a given -alternative splicing event } \description{ Optimal survival difference given an inclusion level cutoff for a specific alternative splicing event } +\keyword{internal} diff --git a/man/parseDateResponse.Rd b/man/parseDateResponse.Rd index 17c019a8..32cb7105 100644 --- a/man/parseDateResponse.Rd +++ b/man/parseDateResponse.Rd @@ -15,3 +15,4 @@ Parsed date \description{ Parse the date from a response } +\keyword{internal} diff --git a/man/parseFirebrowseMetadata.Rd b/man/parseFirebrowseMetadata.Rd index 6e63ebf9..70f481c2 100644 --- a/man/parseFirebrowseMetadata.Rd +++ b/man/parseFirebrowseMetadata.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/data_firebrowse.R \name{parseFirebrowseMetadata} \alias{parseFirebrowseMetadata} -\alias{parseFirehoseMetadata} -\alias{parseTCGAmetadata} \title{Query the Firebrowse web API for metadata} \usage{ parseFirebrowseMetadata(type, ...) - -parseFirehoseMetadata(type, ...) - -parseTCGAmetadata(type, ...) } \arguments{ \item{type}{Character: metadata to retrieve} @@ -33,3 +27,4 @@ psichomics:::parseFirebrowseMetadata("Cohorts") # Get the abbreviation and description of the selected cohorts psichomics:::parseFirebrowseMetadata("Cohorts", cohort = c("ACC", "BRCA")) } +\keyword{internal} diff --git a/man/parseMatsEvent.Rd b/man/parseMatsEvent.Rd index 5f1885d4..03877781 100644 --- a/man/parseMatsEvent.Rd +++ b/man/parseMatsEvent.Rd @@ -36,3 +36,4 @@ event <- read.table(text = " ") psichomics:::parseMatsEvent(event, "A3SS") } +\keyword{internal} diff --git a/man/parseMatsGeneric.Rd b/man/parseMatsGeneric.Rd index 3e4599a5..3d928a7a 100644 --- a/man/parseMatsGeneric.Rd +++ b/man/parseMatsGeneric.Rd @@ -111,3 +111,4 @@ psichomics:::parseMatsAFE(junctions, strand = "+") \seealso{ \code{\link{parseMatsEvent}} } +\keyword{internal} diff --git a/man/parseMisoEvent.Rd b/man/parseMisoEvent.Rd index 3ddbe321..a5a0c997 100644 --- a/man/parseMisoEvent.Rd +++ b/man/parseMisoEvent.Rd @@ -35,3 +35,4 @@ event <- read.table(text = " chr1 SE exon 17915 18061 . - .") psichomics:::parseMisoEvent(event) } +\keyword{internal} diff --git a/man/parseMisoEventID.Rd b/man/parseMisoEventID.Rd index 3dffe75a..dd26d72b 100644 --- a/man/parseMisoEventID.Rd +++ b/man/parseMisoEventID.Rd @@ -16,7 +16,7 @@ parseMisoEventID(eventID, annotation, IDcolumn) alternative event annotation file} } \value{ -Data frame of the matching events (or NA when nothing is matched) +Data frame of the matching events (or \code{NA} when nothing matches) } \description{ Match MISO's splicing event IDs with the IDs present in the alternative @@ -42,3 +42,4 @@ annotation <- read.delim(gff3, header=FALSE, comment.char="#") IDcolumn <- 9 psichomics:::parseMisoEventID(eventID, annotation, IDcolumn) } +\keyword{internal} diff --git a/man/parseMisoGeneric.Rd b/man/parseMisoGeneric.Rd index 923a7716..0cb5367e 100644 --- a/man/parseMisoGeneric.Rd +++ b/man/parseMisoGeneric.Rd @@ -156,3 +156,4 @@ psichomics:::parseMisoALE(event) \seealso{ \code{\link{parseMisoEvent}} } +\keyword{internal} diff --git a/man/parseMisoId.Rd b/man/parseMisoId.Rd index 4e666827..ae107497 100644 --- a/man/parseMisoId.Rd +++ b/man/parseMisoId.Rd @@ -22,3 +22,4 @@ id <- paste0( "82723911:+@chr1:82724642:82724813:+@chr1:82725791:82726011:+") psichomics:::parseMisoId(id) } +\keyword{internal} diff --git a/man/parseSuppaEvent.Rd b/man/parseSuppaEvent.Rd index 724733b1..884d09e9 100644 --- a/man/parseSuppaEvent.Rd +++ b/man/parseSuppaEvent.Rd @@ -39,3 +39,4 @@ It only allows to parse one event type at once. event <- "ENSG00000000419;A3:20:49557492-49557642:49557470-49557642:-" psichomics:::parseSuppaEvent(event) } +\keyword{internal} diff --git a/man/parseSuppaGeneric.Rd b/man/parseSuppaGeneric.Rd index ff049af4..5ef9f3d5 100644 --- a/man/parseSuppaGeneric.Rd +++ b/man/parseSuppaGeneric.Rd @@ -91,3 +91,4 @@ psichomics:::parseSuppaA5SS(junctions, "+") \seealso{ \code{\link{parseSuppaEvent}} } +\keyword{internal} diff --git a/man/parseUniprotXML.Rd b/man/parseUniprotXML.Rd index b8cc58b0..a7e7e7cc 100644 --- a/man/parseUniprotXML.Rd +++ b/man/parseUniprotXML.Rd @@ -15,3 +15,4 @@ List containing protein length and data frame of protein features \description{ Parse XML from UniProt's RESTful service } +\keyword{internal} diff --git a/man/parseUrlsFromFirebrowseResponse.Rd b/man/parseUrlsFromFirebrowseResponse.Rd index 83ef555a..1d53d37a 100644 --- a/man/parseUrlsFromFirebrowseResponse.Rd +++ b/man/parseUrlsFromFirebrowseResponse.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/data_firebrowse.R \name{parseUrlsFromFirebrowseResponse} \alias{parseUrlsFromFirebrowseResponse} -\alias{parseUrlsFromFirehoseResponse} \title{Retrieve URLs from a response to a Firebrowse data query} \usage{ parseUrlsFromFirebrowseResponse(res) - -parseUrlsFromFirehoseResponse(res) } \arguments{ \item{res}{Response from \code{httr::GET} to a Firebrowse data query} @@ -22,3 +19,4 @@ Retrieve URLs from a response to a Firebrowse data query res <- psichomics:::queryFirebrowseData(cohort = "ACC") url <- psichomics:::parseUrlsFromFirebrowseResponse(res) } +\keyword{internal} diff --git a/man/parseValidFile.Rd b/man/parseValidFile.Rd index a6f7c637..9d6bbf87 100644 --- a/man/parseValidFile.Rd +++ b/man/parseValidFile.Rd @@ -25,3 +25,4 @@ accordingly. The resulting data frame includes the attribute \code{tablename} with the name of the data frame } +\keyword{internal} diff --git a/man/parseVastToolsEvent.Rd b/man/parseVastToolsEvent.Rd index 5f1913c8..7fb5ba0f 100644 --- a/man/parseVastToolsEvent.Rd +++ b/man/parseVastToolsEvent.Rd @@ -30,3 +30,4 @@ event <- read.table(text = ) psichomics:::parseVastToolsEvent(event) } +\keyword{internal} diff --git a/man/parseVastToolsSE.Rd b/man/parseVastToolsSE.Rd index 83287b8e..6bceab21 100644 --- a/man/parseVastToolsSE.Rd +++ b/man/parseVastToolsSE.Rd @@ -63,3 +63,4 @@ psichomics:::parseVastToolsA5SS(junctions) \seealso{ \code{\link{parseVastToolsEvent}} } +\keyword{internal} diff --git a/man/patientMultiMatchWarning.Rd b/man/patientMultiMatchWarning.Rd index d81b9be3..08ab14ba 100644 --- a/man/patientMultiMatchWarning.Rd +++ b/man/patientMultiMatchWarning.Rd @@ -14,3 +14,4 @@ Character Helper text to explain what happens when a patient matches multiple samples when performing survival analysis } +\keyword{internal} diff --git a/man/performPCA.Rd b/man/performPCA.Rd index 0259f24c..393e7b51 100644 --- a/man/performPCA.Rd +++ b/man/performPCA.Rd @@ -42,5 +42,5 @@ performPCA(USArrests) } \seealso{ \code{\link{plotPCA}}, \code{\link{performICA}} and -\code{\link{plotICA}} + \code{\link{plotICA}} } diff --git a/man/plotClusters.Rd b/man/plotClusters.Rd index efb3f0a9..a91dda6d 100644 --- a/man/plotClusters.Rd +++ b/man/plotClusters.Rd @@ -19,3 +19,4 @@ plotClusters(hc, data, clustering) \description{ Clusters are added as coloured polygons. } +\keyword{internal} diff --git a/man/plotCorrelation.Rd b/man/plotCorrelation.Rd index df8ba44d..3ea5e900 100644 --- a/man/plotCorrelation.Rd +++ b/man/plotCorrelation.Rd @@ -7,26 +7,26 @@ \alias{as.table.GEandAScorrelation} \title{Display results of correlation analyses} \usage{ -plotCorrelation(corr, autoZoom = FALSE, loessSmooth = TRUE, +plotCorrelation(x, autoZoom = FALSE, loessSmooth = TRUE, loessFamily = c("gaussian", "symmetric"), colour = "black", alpha = 0.2, size = 1.5, loessColour = "red", loessAlpha = 1, loessWidth = 0.5, fontSize = 12, ..., colourGroups = NULL, legend = FALSE, showAllData = TRUE, density = FALSE, densityColour = "blue", densityWidth = 0.5) -\method{plot}{GEandAScorrelation}(corr, autoZoom = FALSE, +\method{plot}{GEandAScorrelation}(x, autoZoom = FALSE, loessSmooth = TRUE, loessFamily = c("gaussian", "symmetric"), colour = "black", alpha = 0.2, size = 1.5, loessColour = "red", loessAlpha = 1, loessWidth = 0.5, fontSize = 12, ..., colourGroups = NULL, legend = FALSE, showAllData = TRUE, density = FALSE, densityColour = "blue", densityWidth = 0.5) -\method{print}{GEandAScorrelation}(corr) +\method{print}{GEandAScorrelation}(x, ...) -\method{as.table}{GEandAScorrelation}(corr, pvalueAdjust = "BH") +\method{as.table}{GEandAScorrelation}(x, pvalueAdjust = "BH", ...) } \arguments{ -\item{corr}{\code{GEandAScorrelation} object (obtained after running +\item{x}{\code{GEandAScorrelation} object (obtained after running \code{\link{correlateGEandAS}})} \item{autoZoom}{Boolean: automatically set the range of PSI values based on diff --git a/man/plotDistribution.Rd b/man/plotDistribution.Rd index caa98ee9..376ac6ca 100644 --- a/man/plotDistribution.Rd +++ b/man/plotDistribution.Rd @@ -2,14 +2,10 @@ % Please edit documentation in R/analysis.R \name{plotDistribution} \alias{plotDistribution} -\alias{plotDensity} \title{Plot distribution through a density plot} \usage{ plotDistribution(data, groups = "All samples", rug = TRUE, vLine = TRUE, ..., title = NULL, psi = NULL) - -plotDensity(data, groups = "All samples", rug = TRUE, vLine = TRUE, - ..., title = NULL, psi = NULL) } \arguments{ \item{data}{Numeric, data frame or matrix: data for one gene or alternative diff --git a/man/plotPCA.Rd b/man/plotPCA.Rd index 9aca06a6..3f7cb11e 100644 --- a/man/plotPCA.Rd +++ b/man/plotPCA.Rd @@ -17,17 +17,17 @@ plotPCA(pca, pcX = 1, pcY = 2, groups = NULL, individuals = TRUE, \item{groups}{Matrix: groups to plot indicating the index of interest of the samples (use clinical or sample groups)} -\item{individuals}{Boolean: plot PCA individuals (TRUE by default)} +\item{individuals}{Boolean: plot PCA individuals} -\item{loadings}{Boolean: plot PCA loadings/rotations (FALSE by default)} +\item{loadings}{Boolean: plot PCA loadings/rotations} \item{nLoadings}{Integer: Number of variables to plot, ordered by those that most contribute to selected principal components (this allows for faster -performance as only the variables that most contribute are rendered); if -NULL, all variables are plotted} +performance as only the most contributing variables are rendered); if +\code{NULL}, all variables are plotted} } \value{ -Scatterplot as an \code{highcharter} object +Scatterplot as an \code{highchart} object } \description{ Create a scatterplot from a PCA object diff --git a/man/plotPointsStyle.Rd b/man/plotPointsStyle.Rd index 2c4bdbd0..ded75a24 100644 --- a/man/plotPointsStyle.Rd +++ b/man/plotPointsStyle.Rd @@ -28,3 +28,4 @@ HTML elements \description{ Interface to modify the style of the plot points } +\keyword{internal} diff --git a/man/plotSingleICA.Rd b/man/plotSingleICA.Rd index 5ac429c6..c1bee83a 100644 --- a/man/plotSingleICA.Rd +++ b/man/plotSingleICA.Rd @@ -34,3 +34,4 @@ groups$ozEntrance <- c("Kansas") groups$novel <- c("New Mexico", "New York", "New Hampshire", "New Jersey") psichomics:::plotSingleICA(ica, groups=groups) } +\keyword{internal} diff --git a/man/plotVariance.Rd b/man/plotVariance.Rd index 1ce815d8..e3c4dad7 100644 --- a/man/plotVariance.Rd +++ b/man/plotVariance.Rd @@ -2,18 +2,18 @@ % Please edit documentation in R/analysis_dimReduction_pca.R \name{plotVariance} \alias{plotVariance} -\title{Create the explained variance plot} +\title{Create the explained variance plot from a PCA} \usage{ plotVariance(pca) } \arguments{ -\item{pca}{PCA values} +\item{pca}{\code{prcomp} object} } \value{ -Plot variance as an Highcharter object +Plot variance as an \code{highchart} object } \description{ -Create the explained variance plot +Create the explained variance plot from a PCA } \examples{ pca <- prcomp(USArrests) diff --git a/man/plottableXranges.Rd b/man/plottableXranges.Rd index 81d6708e..92bcf667 100644 --- a/man/plottableXranges.Rd +++ b/man/plottableXranges.Rd @@ -18,3 +18,4 @@ HTML elements \description{ HTML code to plot a X-ranges series } +\keyword{internal} diff --git a/man/prepareEventPlotOptions.Rd b/man/prepareEventPlotOptions.Rd index 1f7da08d..a4df5575 100644 --- a/man/prepareEventPlotOptions.Rd +++ b/man/prepareEventPlotOptions.Rd @@ -19,3 +19,4 @@ HTML elements \description{ Prepare event plot options } +\keyword{internal} diff --git a/man/prepareFileBrowser.Rd b/man/prepareFileBrowser.Rd index c9057d4a..ec8f97f1 100644 --- a/man/prepareFileBrowser.Rd +++ b/man/prepareFileBrowser.Rd @@ -31,3 +31,4 @@ NULL (this function is used to modify the Shiny session's state) Prepare file browser dialogue and update the input's value accordingly to selected file or directory } +\keyword{internal} diff --git a/man/prepareFirebrowseArchives.Rd b/man/prepareFirebrowseArchives.Rd index 544418ca..f5e6af9d 100644 --- a/man/prepareFirebrowseArchives.Rd +++ b/man/prepareFirebrowseArchives.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/data_firebrowse.R \name{prepareFirebrowseArchives} \alias{prepareFirebrowseArchives} -\alias{prepareFirehoseArchives} -\alias{prepareTCGAarchives} \title{Prepares Firebrowse archives in a given directory} \usage{ prepareFirebrowseArchives(archive, md5, folder, outdir) - -prepareFirehoseArchives(archive, md5, folder, outdir) - -prepareTCGAarchives(archive, md5, folder, outdir) } \arguments{ \item{archive}{Character: path to downloaded archives} @@ -40,3 +34,4 @@ md5 <- paste0(file, ".md5") prepareFirebrowseArchives(archive = file, md5 = paste0(file, ".md5")) } } +\keyword{internal} diff --git a/man/prepareJunctionQuantSTAR.Rd b/man/prepareJunctionQuantSTAR.Rd new file mode 100644 index 00000000..399b6410 --- /dev/null +++ b/man/prepareJunctionQuantSTAR.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_local.R +\name{prepareJunctionQuantSTAR} +\alias{prepareJunctionQuantSTAR} +\alias{prepareGeneQuantSTAR} +\title{Prepare files to be loaded into psichomics} +\usage{ +prepareJunctionQuantSTAR(..., startOffset = -1, endOffset = +1) + +prepareGeneQuantSTAR(..., strandedness = c("unstranded", "stranded", + "stranded (reverse)")) +} +\arguments{ +\item{...}{Character: path to file(s) to read} + +\item{startOffset}{Numeric: value to offset start position} + +\item{endOffset}{Numeric: value to offset end position} + +\item{strandedness}{Character: strandedness of RNA-seq protocol; may be one +of the following: \code{unstraded}, \code{stranded} or +\code{stranded (reverse)}} +} +\value{ +Prepared file +} +\description{ +Prepare files to be loaded into psichomics +} +\examples{ +\dontrun{ +prepareJunctionQuant("Control rep1"=junctionFile1, + "Control rep2"=junctionFile2, + "KD rep1"=junctionFile3, + "KD rep2"=junctionFile4) +} +\dontrun{ +prepareGeneQuant("Control rep1"=geneCountFile1, + "Control rep2"=geneCountFile2, + "KD rep1"=geneCountFile3, + "KD rep2"=geneCountFile4) +} +} diff --git a/man/preparePreMadeGroupForSelection.Rd b/man/preparePreMadeGroupForSelection.Rd index e1498264..0b831fca 100644 --- a/man/preparePreMadeGroupForSelection.Rd +++ b/man/preparePreMadeGroupForSelection.Rd @@ -15,3 +15,4 @@ List \description{ Prepare list of pre-made groups for a selectize element } +\keyword{internal} diff --git a/man/prepareSRAmetadata.Rd b/man/prepareSRAmetadata.Rd index 77daf8ac..67c317ea 100644 --- a/man/prepareSRAmetadata.Rd +++ b/man/prepareSRAmetadata.Rd @@ -3,9 +3,7 @@ \name{prepareSRAmetadata} \alias{prepareSRAmetadata} \alias{prepareJunctionQuant} -\alias{prepareJunctionQuantSTAR} \alias{prepareGeneQuant} -\alias{prepareGeneQuantSTAR} \title{Prepare files to be loaded into psichomics} \usage{ prepareSRAmetadata(file, output = "psichomics_metadata.txt") @@ -13,13 +11,8 @@ prepareSRAmetadata(file, output = "psichomics_metadata.txt") prepareJunctionQuant(..., output = "psichomics_junctions.txt", startOffset = NULL, endOffset = NULL) -prepareJunctionQuantSTAR(..., startOffset = -1, endOffset = +1) - prepareGeneQuant(..., output = "psichomics_gene_counts.txt", strandedness = c("unstranded", "stranded", "stranded (reverse)")) - -prepareGeneQuantSTAR(..., strandedness = c("unstranded", "stranded", - "stranded (reverse)")) } \arguments{ \item{file}{Character: path to file} diff --git a/man/prepareWordBreak.Rd b/man/prepareWordBreak.Rd index 711a34ed..8aeb3a86 100644 --- a/man/prepareWordBreak.Rd +++ b/man/prepareWordBreak.Rd @@ -18,3 +18,4 @@ String containing HTML elements \description{ Create word break opportunities (for HTML) using given characters } +\keyword{internal} diff --git a/man/print.geneList.Rd b/man/print.geneList.Rd index 8abef9cf..198b786b 100644 --- a/man/print.geneList.Rd +++ b/man/print.geneList.Rd @@ -15,3 +15,4 @@ Print available gene lists \description{ Print gene list } +\keyword{internal} diff --git a/man/processButton.Rd b/man/processButton.Rd index b7c03803..860e40be 100644 --- a/man/processButton.Rd +++ b/man/processButton.Rd @@ -26,3 +26,4 @@ HTML for a button \description{ Style button used to initiate a process } +\keyword{internal} diff --git a/man/processDatasetNames.Rd b/man/processDatasetNames.Rd index ab0fd777..a15e52bf 100644 --- a/man/processDatasetNames.Rd +++ b/man/processDatasetNames.Rd @@ -19,3 +19,4 @@ Process dataset names Avoid duplicated names and append the technology used for junction quantification } +\keyword{internal} diff --git a/man/processSurvData.Rd b/man/processSurvData.Rd index dfd5dc78..ade0d0ef 100644 --- a/man/processSurvData.Rd +++ b/man/processSurvData.Rd @@ -44,3 +44,4 @@ consider running the function \code{\link{getAttributesTime}} to retrieve the time of such columns once and hand the result to the \code{survTime} argument of this function. } +\keyword{internal} diff --git a/man/processSurvival.Rd b/man/processSurvival.Rd index 02235fe9..e010b20e 100644 --- a/man/processSurvival.Rd +++ b/man/processSurvival.Rd @@ -37,3 +37,4 @@ List with survival analysis results \description{ Check if survival analyses successfully completed or returned errors } +\keyword{internal} diff --git a/man/psichomics.Rd b/man/psichomics.Rd index 670cfd88..9b34c93c 100644 --- a/man/psichomics.Rd +++ b/man/psichomics.Rd @@ -30,8 +30,7 @@ only used for recording or running automated tests. Defaults to the \code{shiny.testmode} option, or FALSE if the option is not set.} }} -\item{reset}{Boolean: reset Shiny session? requires the package -\code{devtools} to reset data} +\item{reset}{Boolean: reset Shiny session? Requires package \code{devtools}} \item{testData}{Boolean: auto-start with test data} } diff --git a/man/pubmedUI.Rd b/man/pubmedUI.Rd index 315e9450..798de0be 100644 --- a/man/pubmedUI.Rd +++ b/man/pubmedUI.Rd @@ -23,3 +23,4 @@ HTML interface of relevant PubMed articles \description{ Return the interface of relevant PubMed articles for a given gene } +\keyword{internal} diff --git a/man/quantifySplicingSet.Rd b/man/quantifySplicingSet.Rd index 43ad5417..8ce02e3a 100644 --- a/man/quantifySplicingSet.Rd +++ b/man/quantifySplicingSet.Rd @@ -17,3 +17,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/queryEnsembl.Rd b/man/queryEnsembl.Rd index aebf0c8a..fbe801a4 100644 --- a/man/queryEnsembl.Rd +++ b/man/queryEnsembl.Rd @@ -29,3 +29,4 @@ path <- "lookup/symbol/human/BRCA2" query <- list(expand=1) psichomics:::queryEnsembl(path, query, grch37 = TRUE) } +\keyword{internal} diff --git a/man/queryEnsemblByEvent.Rd b/man/queryEnsemblByEvent.Rd deleted file mode 100644 index 345a406d..00000000 --- a/man/queryEnsemblByEvent.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis_information.R -\name{queryEnsemblByEvent} -\alias{queryEnsemblByEvent} -\title{Query information from Ensembl by a given alternative splicing event} -\usage{ -queryEnsemblByEvent(event, ...) -} -\arguments{ -\item{event}{Character: alternative splicing event identifier} - -\item{...}{Arguments passed on to \code{queryEnsemblByGene} -\describe{ - \item{species}{Character: species (can be NULL when handling an Ensembl -identifier)} - \item{assembly}{Character: assembly version (can be NULL when handling an -Ensembl identifier)} -}} -} -\value{ -Information from Ensembl -} -\description{ -Query information from Ensembl by a given alternative splicing event -} -\examples{ -event <- c("SE_17_-_41251792_41249306_41249261_41246877_BRCA1") -queryEnsemblByEvent(event, species="human", assembly="hg19") -} diff --git a/man/queryEnsemblByGene.Rd b/man/queryEnsemblByGene.Rd index eab44e61..b9b5a561 100644 --- a/man/queryEnsemblByGene.Rd +++ b/man/queryEnsemblByGene.Rd @@ -2,26 +2,33 @@ % Please edit documentation in R/analysis_information.R \name{queryEnsemblByGene} \alias{queryEnsemblByGene} -\title{Query information from Ensembl by a given gene} +\alias{queryEnsemblByEvent} +\title{Query information from Ensembl} \usage{ queryEnsemblByGene(gene, species = NULL, assembly = NULL) + +queryEnsemblByEvent(event, species, assembly) } \arguments{ -\item{gene}{Character: gene identifier} +\item{gene}{Character: gene} + +\item{species}{Character: species (may be \code{NULL} for an Ensembl +identifier)} -\item{species}{Character: species (can be NULL when handling an Ensembl +\item{assembly}{Character: assembly version (may be NULL for an Ensembl identifier)} -\item{assembly}{Character: assembly version (can be NULL when handling an -Ensembl identifier)} +\item{event}{Character: alternative splicing event} } \value{ Information from Ensembl } \description{ -Query information from Ensembl by a given gene +Query information from Ensembl } \examples{ queryEnsemblByGene("BRCA1", "human", "hg19") queryEnsemblByGene("ENSG00000139618") +event <- "SE_17_-_41251792_41249306_41249261_41246877_BRCA1" +queryEnsemblByEvent(event, species="human", assembly="hg19") } diff --git a/man/queryFirebrowseData.Rd b/man/queryFirebrowseData.Rd index c4c8780b..63306b2e 100644 --- a/man/queryFirebrowseData.Rd +++ b/man/queryFirebrowseData.Rd @@ -2,18 +2,12 @@ % Please edit documentation in R/data_firebrowse.R \name{queryFirebrowseData} \alias{queryFirebrowseData} -\alias{queryFirehoseData} \title{Query the Firebrowse web API for TCGA data} \usage{ queryFirebrowseData(format = "json", date = NULL, cohort = NULL, data_type = NULL, tool = NULL, platform = NULL, center = NULL, level = NULL, protocol = NULL, page = NULL, page_size = NULL, sort_by = NULL) - -queryFirehoseData(format = "json", date = NULL, cohort = NULL, - data_type = NULL, tool = NULL, platform = NULL, center = NULL, - level = NULL, protocol = NULL, page = NULL, page_size = NULL, - sort_by = NULL) } \arguments{ \item{format}{Character: response format as \code{JSON} (default), \code{CSV} @@ -62,3 +56,4 @@ dates <- format(dates, psichomics:::getFirebrowseDateFormat()$query) psichomics:::queryFirebrowseData(date = dates[2], cohort = cohort) } +\keyword{internal} diff --git a/man/queryPubMed.Rd b/man/queryPubMed.Rd index 62ef6a4a..324f3671 100644 --- a/man/queryPubMed.Rd +++ b/man/queryPubMed.Rd @@ -28,3 +28,4 @@ Query the PubMed REST API \examples{ psichomics:::queryPubMed("BRCA1", "cancer", "adrenocortical carcinoma") } +\keyword{internal} diff --git a/man/queryUniprot.Rd b/man/queryUniprot.Rd index 8e635632..30692124 100644 --- a/man/queryUniprot.Rd +++ b/man/queryUniprot.Rd @@ -26,3 +26,4 @@ transcript <- "ENST00000488540" format <- "xml" psichomics:::queryUniprot(transcript, format) } +\keyword{internal} diff --git a/man/readAnnot.Rd b/man/readAnnot.Rd index 9fbd507c..749de8ac 100644 --- a/man/readAnnot.Rd +++ b/man/readAnnot.Rd @@ -19,3 +19,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Instructions to build the Shiny app } +\keyword{internal} diff --git a/man/reduceDimensionality.Rd b/man/reduceDimensionality.Rd index 05b45187..49791b42 100644 --- a/man/reduceDimensionality.Rd +++ b/man/reduceDimensionality.Rd @@ -37,3 +37,4 @@ object \description{ Reduce dimensionality after processing missing values from data frame } +\keyword{internal} diff --git a/man/renameDuplicated.Rd b/man/renameDuplicated.Rd index 43a8f265..f9cc067b 100644 --- a/man/renameDuplicated.Rd +++ b/man/renameDuplicated.Rd @@ -23,3 +23,4 @@ prepare unique values in two vectors before a merge, for instance. psichomics:::renameDuplicated(check = c("blue", "red"), comp = c("green", "blue")) } +\keyword{internal} diff --git a/man/renameGroups.Rd b/man/renameGroups.Rd index e319af6c..8bb39c1a 100644 --- a/man/renameGroups.Rd +++ b/man/renameGroups.Rd @@ -20,3 +20,4 @@ Rename duplicated names from a new group \note{ The names of pre-existing groups are not modified. } +\keyword{internal} diff --git a/man/renderDataTableSparklines.Rd b/man/renderDataTableSparklines.Rd index c1602691..172f173b 100644 --- a/man/renderDataTableSparklines.Rd +++ b/man/renderDataTableSparklines.Rd @@ -35,3 +35,4 @@ This slightly modified version of \code{\link{renderDataTable}} calls a JavaScript function to convert the sparkline HTML elements to interactive Highcharts } +\keyword{internal} diff --git a/man/renderGeneticInfo.Rd b/man/renderGeneticInfo.Rd index 3e789f31..f58b5d52 100644 --- a/man/renderGeneticInfo.Rd +++ b/man/renderGeneticInfo.Rd @@ -26,3 +26,4 @@ HTML elements to render gene, protein and transcript annotation \description{ Render genetic information } +\keyword{internal} diff --git a/man/renderGroupInterface.Rd b/man/renderGroupInterface.Rd index 06b1ef5d..e729db14 100644 --- a/man/renderGroupInterface.Rd +++ b/man/renderGroupInterface.Rd @@ -18,3 +18,4 @@ HTML elements \description{ Render group interface } +\keyword{internal} diff --git a/man/renderProteinInfo.Rd b/man/renderProteinInfo.Rd index 9198f6d9..301b29ce 100644 --- a/man/renderProteinInfo.Rd +++ b/man/renderProteinInfo.Rd @@ -22,3 +22,4 @@ HTML elements \description{ Render protein information } +\keyword{internal} diff --git a/man/rm.null.Rd b/man/rm.null.Rd index 5493dba0..e09712c2 100644 --- a/man/rm.null.Rd +++ b/man/rm.null.Rd @@ -17,3 +17,4 @@ returns an empty list if the input is a list with only NULL elements) \description{ Filter NULL elements from vector or list } +\keyword{internal} diff --git a/man/roundDigits.Rd b/man/roundDigits.Rd index a976c61c..08485e42 100644 --- a/man/roundDigits.Rd +++ b/man/roundDigits.Rd @@ -15,3 +15,4 @@ Formatted number with a given numeric precision \description{ Round by the given number of digits } +\keyword{internal} diff --git a/man/roundMinDown.Rd b/man/roundMinDown.Rd index ef4e506a..38577b5d 100644 --- a/man/roundMinDown.Rd +++ b/man/roundMinDown.Rd @@ -20,3 +20,4 @@ Rounded numeric value \description{ Round down/up the minimum/maximum value } +\keyword{internal} diff --git a/man/rowMeans.Rd b/man/rowMeans.Rd index 3badea64..0e472115 100644 --- a/man/rowMeans.Rd +++ b/man/rowMeans.Rd @@ -2,22 +2,26 @@ % Please edit documentation in R/utils.R \name{rowMeans} \alias{rowMeans} -\title{Calculate mean for each row of a matrix} +\alias{rowVars} +\title{Calculate mean or variance for each row of a matrix} \usage{ rowMeans(mat, na.rm = FALSE) + +rowVars(mat, na.rm = FALSE) } \arguments{ \item{mat}{Matrix} -\item{na.rm}{Boolean: remove NAs?} +\item{na.rm}{Boolean: remove missing values (\code{NA})?} } \value{ -Vector of means +Vector of means or variances } \description{ -Calculate mean for each row of a matrix +Calculate mean or variance for each row of a matrix } \examples{ df <- rbind("Gene 1"=c(3, 5, 7), "Gene 2"=c(8, 2, 4), "Gene 3"=c(9:11)) rowMeans(df) +rowVars(df) } diff --git a/man/rowVars.Rd b/man/rowVars.Rd deleted file mode 100644 index 6e09d20e..00000000 --- a/man/rowVars.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{rowVars} -\alias{rowVars} -\title{Calculate variance for each row of a matrix} -\usage{ -rowVars(mat, na.rm = FALSE) -} -\arguments{ -\item{mat}{Matrix} - -\item{na.rm}{Boolean: remove NAs?} -} -\value{ -Vector of variances -} -\description{ -Calculate variance for each row of a matrix -} -\examples{ -df <- rbind("Gene 1"=c(3, 5, 7), "Gene 2"=c(8, 2, 4), "Gene 3"=c(9:11)) -rowVars(df) -} diff --git a/man/selectGroupsUI.Rd b/man/selectGroupsUI.Rd index 02f80f23..5d0df02c 100644 --- a/man/selectGroupsUI.Rd +++ b/man/selectGroupsUI.Rd @@ -65,3 +65,4 @@ Group selection interface and logic To allow the user to (explicitly) select no groups, pass the \code{noGroupsLabel} and \code{groupsLabel} arguments. } +\keyword{internal} diff --git a/man/selectPreMadeGroup.Rd b/man/selectPreMadeGroup.Rd index fba74f94..4fca3476 100644 --- a/man/selectPreMadeGroup.Rd +++ b/man/selectPreMadeGroup.Rd @@ -7,9 +7,9 @@ selectPreMadeGroup(groups, selected) } \arguments{ -\item{selected}{Character: selected item} +\item{groups}{List of list of characters} -\item{group}{List of list of characters} +\item{selected}{Character: selected item} } \value{ Elements of selected item @@ -17,3 +17,4 @@ Elements of selected item \description{ Select pre-made groups from a selected item } +\keyword{internal} diff --git a/man/selectizeGeneInput.Rd b/man/selectizeGeneInput.Rd index e0bd2adf..6341e4fd 100644 --- a/man/selectizeGeneInput.Rd +++ b/man/selectizeGeneInput.Rd @@ -28,3 +28,4 @@ HTML elements \description{ Create input to select a gene } +\keyword{internal} diff --git a/man/setFirebrowseData.Rd b/man/setFirebrowseData.Rd index 4616989d..bff39c84 100644 --- a/man/setFirebrowseData.Rd +++ b/man/setFirebrowseData.Rd @@ -21,3 +21,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Set data from Firebrowse } +\keyword{internal} diff --git a/man/setLocalData.Rd b/man/setLocalData.Rd index aeeefef1..29d68d97 100644 --- a/man/setLocalData.Rd +++ b/man/setLocalData.Rd @@ -24,3 +24,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Load local files } +\keyword{internal} diff --git a/man/setOperation.Rd b/man/setOperation.Rd index 4ebc074a..f7cb8f71 100644 --- a/man/setOperation.Rd +++ b/man/setOperation.Rd @@ -41,3 +41,4 @@ Matrix containing groups (new group is in the first row) \description{ Perform set operations on selected groups } +\keyword{internal} diff --git a/man/setOperationIcon.Rd b/man/setOperationIcon.Rd index abca1368..25351092 100644 --- a/man/setOperationIcon.Rd +++ b/man/setOperationIcon.Rd @@ -19,3 +19,4 @@ Icon element \description{ Based on the \code{\link[shiny]{icon}} function } +\keyword{internal} diff --git a/man/showAlert.Rd b/man/showAlert.Rd index 0b6542eb..33ea6748 100644 --- a/man/showAlert.Rd +++ b/man/showAlert.Rd @@ -23,18 +23,17 @@ removeAlert(output, alertId = "alert") \item{...}{Arguments to render as elements of alert} -\item{title}{Character: title of the alert (optional)} +\item{title}{Character: title} -\item{style}{Character: style of the alert ("error", "warning" or NULL)} +\item{style}{Character: style (\code{error}, \code{warning} or \code{NULL})} -\item{dismissible}{Boolean: is the alert dismissible? TRUE by default} +\item{dismissible}{Boolean: is the alert dismissible?} -\item{alertId}{Character: alert identifier} +\item{alertId}{Character: identifier} -\item{iconName}{Character: FontAwesome icon name to appear with the title} +\item{iconName}{Character: icon name} -\item{caller}{Character: label to identify the module calling for the alert -(relevant for error and warning alerts)} +\item{caller}{Character: caller module identifier} \item{output}{Shiny output} } @@ -42,9 +41,9 @@ removeAlert(output, alertId = "alert") NULL (this function is used to modify the Shiny session's state) } \description{ -You can also use \code{errorAlert} and \code{warningAlert} to use template -alerts already stylised to show errors and warnings respectively. +Show or remove an alert } \seealso{ \code{\link{showModal}} } +\keyword{internal} diff --git a/man/showGroupsTable.Rd b/man/showGroupsTable.Rd index c9e8cf50..6e306284 100644 --- a/man/showGroupsTable.Rd +++ b/man/showGroupsTable.Rd @@ -16,3 +16,4 @@ Matrix with groups ordered (or NULL if no groups exist) \description{ Present groups table } +\keyword{internal} diff --git a/man/sidebar.Rd b/man/sidebar.Rd index 6563c55e..10b29e88 100644 --- a/man/sidebar.Rd +++ b/man/sidebar.Rd @@ -29,3 +29,4 @@ sidebarPanel( numericInput("obs", "Observations:", 10) ) } +\keyword{internal} diff --git a/man/signifDigits.Rd b/man/signifDigits.Rd index 28801fc2..c1056596 100644 --- a/man/signifDigits.Rd +++ b/man/signifDigits.Rd @@ -15,3 +15,4 @@ Formatted number with a given number of significant digits \description{ Get number of significant digits } +\keyword{internal} diff --git a/man/singleDiffAnalyses.Rd b/man/singleDiffAnalyses.Rd index 0678f975..e67da576 100644 --- a/man/singleDiffAnalyses.Rd +++ b/man/singleDiffAnalyses.Rd @@ -38,3 +38,4 @@ respective string in the \code{analysis} argument: \item{\code{fligner} - Fligner-Killeen test (2 or more groups)} } } +\keyword{internal} diff --git a/man/sortCoordinates.Rd b/man/sortCoordinates.Rd index 44988a54..b093d280 100644 --- a/man/sortCoordinates.Rd +++ b/man/sortCoordinates.Rd @@ -19,3 +19,4 @@ Some programs sort the coordinates of specific event types differently. To make them all comparable across programs, the coordinates are ordered by increasing (plus strand) or decreasing order (minus strand) } +\keyword{internal} diff --git a/man/spearman.Rd b/man/spearman.Rd deleted file mode 100644 index 02f99826..00000000 --- a/man/spearman.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{spearman} -\alias{spearman} -\title{Perform Spearman's test and return interface to show the results} -\usage{ -spearman(data, groups) -} -\arguments{ -\item{data}{Numeric, data frame or matrix: data for one gene or alternative -splicing event} - -\item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} -} -\value{ -HTML elements -} -\description{ -Perform Spearman's test and return interface to show the results -} diff --git a/man/startProcess.Rd b/man/startProcess.Rd index ec33ed8d..bbd2ba86 100644 --- a/man/startProcess.Rd +++ b/man/startProcess.Rd @@ -2,16 +2,33 @@ % Please edit documentation in R/utils.R \name{startProcess} \alias{startProcess} -\title{Signal the program that a process is starting} +\alias{endProcess} +\title{Set the status of a process to style a given button} \usage{ startProcess(id) + +endProcess(id, time = NULL, closeProgressBar = TRUE) } \arguments{ \item{id}{Character: button identifier} + +\item{time}{\code{POSIXct} object: start time needed to show the interval +time (if NULL, the time interval is not displayed)} + +\item{closeProgressBar}{Boolean: close progress bar? TRUE by default} } \value{ -Start time of the process +\code{startProcess} returns the start time of the process (may be +used as the \code{time} argument to \code{endProcess}), whereas +\code{endProcess} returns the difference between current time and \code{time} +(or \code{NULL} if \code{time} is not specified) } \description{ -Style button to show processing is in progress +\itemize{ + \item{\code{startProcess}: Style button to show a process is in progress} + \item{\code{endProcess}: Style button to show a process finished; also, + closes the progress bar (if \code{closeProgressbar} is \code{TRUE}) and + prints the difference between the current time and \code{time}} } +} +\keyword{internal} diff --git a/man/startProgress.Rd b/man/startProgress.Rd index b9cd2296..e3e744f0 100644 --- a/man/startProgress.Rd +++ b/man/startProgress.Rd @@ -2,10 +2,19 @@ % Please edit documentation in R/utils.R \name{startProgress} \alias{startProgress} -\title{Create a progress object} +\alias{updateProgress} +\alias{closeProgress} +\title{Create, set and terminate a progress object} \usage{ startProgress(message, divisions, global = if (isRunning()) sharedData else getHidden()) + +updateProgress(message = "Loading...", value = NULL, max = NULL, + detail = NULL, divisions = NULL, global = if (isRunning()) + sharedData else getHidden(), console = TRUE) + +closeProgress(message = NULL, global = if (isRunning()) sharedData else + getHidden()) } \arguments{ \item{message}{Character: progress message} @@ -13,11 +22,25 @@ startProgress(message, divisions, global = if (isRunning()) sharedData \item{divisions}{Integer: number of divisions in the progress bar} \item{global}{Shiny's global variable} + +\item{value}{Integer: current progress value} + +\item{max}{Integer: maximum progress value} + +\item{detail}{Character: detailed message} + +\item{console}{Boolean: print message to console?} } \value{ NULL (this function is used to modify the Shiny session's state or internal hidden variables) } \description{ -Create a progress object +Create, set and terminate a progress object +} +\details{ +If \code{divisions} is not \code{NULL}, a progress bar starts with +the given divisions. If \code{value} is \code{NULL}, the progress bar +increments one unit; otherwise, the progress bar increments \code{value}. } +\keyword{internal} diff --git a/man/styleModal.Rd b/man/styleModal.Rd index dc04fd3d..9c2c234b 100644 --- a/man/styleModal.Rd +++ b/man/styleModal.Rd @@ -5,7 +5,7 @@ \alias{errorModal} \alias{warningModal} \alias{infoModal} -\title{Style and show a modal} +\title{Create a modal window} \usage{ styleModal(session, title, ..., style = NULL, iconName = "exclamation-circle", footer = NULL, echo = FALSE, @@ -21,36 +21,44 @@ infoModal(session, title, ..., size = "small", footer = NULL, caller = NULL) } \arguments{ -\item{session}{Current Shiny session} +\item{session}{Shiny session} -\item{title}{Character: modal title} +\item{title}{Character: title} -\item{...}{Extra arguments to pass to \code{shiny::modalDialog}} +\item{...}{Arguments passed on to \code{shiny::modalDialog} +\describe{ + \item{easyClose}{If \code{TRUE}, the modal dialog can be dismissed by +clicking outside the dialog box, or be pressing the Escape key. If +\code{FALSE} (the default), the modal dialog can't be dismissed in those +ways; instead it must be dismissed by clicking on the dismiss button, or +from a call to \code{\link{removeModal}} on the server.} + \item{fade}{If \code{FALSE}, the modal dialog will have no fade-in animation +(it will simply appear rather than fade in to view).} +}} -\item{style}{Character: style of the modal (NULL, "warning", "error" or -"info"; NULL by default)} +\item{style}{Character: style (\code{NULL}, \code{warning}, \code{error} or +\code{info})} -\item{iconName}{Character: FontAwesome icon name to appear with the title} +\item{iconName}{Character: icon name} \item{footer}{HTML elements to use in footer} -\item{echo}{Boolean: print to console? FALSE by default} +\item{echo}{Boolean: print to console?} -\item{size}{Character: size of the modal - "medium" (default), "small" or -"large"} +\item{size}{Character: size of the modal (\code{small}, \code{medium} or +\code{large})} -\item{dismissButton}{Boolean: show dismiss button in footer? TRUE by default} +\item{dismissButton}{Boolean: show dismiss button in footer?} -\item{caller}{Character: label to identify the module calling for the modal -(relevant for error and warning modals)} +\item{caller}{Character: caller module identifier} } \value{ NULL (this function is used to modify the Shiny session's state) } \description{ -You can also use \code{errorModal} and \code{warningModal} to use a template -modal already stylised to show errors and warnings, respectively. +Create a modal window } \seealso{ \code{\link{showAlert}} } +\keyword{internal} diff --git a/man/subsetGeneExpressionFromMatchingGenes.Rd b/man/subsetGeneExpressionFromMatchingGenes.Rd index a4f73603..f2aec371 100644 --- a/man/subsetGeneExpressionFromMatchingGenes.Rd +++ b/man/subsetGeneExpressionFromMatchingGenes.Rd @@ -17,3 +17,4 @@ Gene expression subset for the input genes \description{ Subset gene expression based on (full or partial) matching genes } +\keyword{internal} diff --git a/man/tabDataset.Rd b/man/tabDataset.Rd index 955f0294..dfdf7954 100644 --- a/man/tabDataset.Rd +++ b/man/tabDataset.Rd @@ -30,3 +30,4 @@ HTML elements Creates a \code{tabPanel} template for a \code{datatable} with a title and description } +\keyword{internal} diff --git a/man/table2html.Rd b/man/table2html.Rd index c79760a1..5424a738 100644 --- a/man/table2html.Rd +++ b/man/table2html.Rd @@ -26,3 +26,4 @@ HTML elements \description{ Create HTML table from data frame or matrix } +\keyword{internal} diff --git a/man/tableRow.Rd b/man/tableRow.Rd index 14afc37f..ffb95e92 100644 --- a/man/tableRow.Rd +++ b/man/tableRow.Rd @@ -17,3 +17,4 @@ HTML elements \description{ Create a row for a HTML table } +\keyword{internal} diff --git a/man/testSingleIndependence.Rd b/man/testSingleIndependence.Rd index d9f558e1..2f663dd3 100644 --- a/man/testSingleIndependence.Rd +++ b/man/testSingleIndependence.Rd @@ -40,3 +40,4 @@ the respective string in the \code{pvalueAdjust} argument: \item{\code{hommel}: Hommel's method (family-wise error rate)} } } +\keyword{internal} diff --git a/man/testSurvivalCutoff.Rd b/man/testSurvivalCutoff.Rd index 8dcf6398..d7bfab66 100644 --- a/man/testSurvivalCutoff.Rd +++ b/man/testSurvivalCutoff.Rd @@ -46,3 +46,4 @@ p-value of the survival difference \description{ Test the survival difference between two survival groups given a cutoff } +\keyword{internal} diff --git a/man/textSuggestions.Rd b/man/textSuggestions.Rd index 7bdab39c..4d4b627d 100644 --- a/man/textSuggestions.Rd +++ b/man/textSuggestions.Rd @@ -25,3 +25,4 @@ Uses the JavaScript library \code{jquery.textcomplete} words <- c("tumor_stage", "age", "gender") psichomics:::textSuggestions("textareaid", words) } +\keyword{internal} diff --git a/man/toJSarray.Rd b/man/toJSarray.Rd index 18b56762..3b3f0710 100644 --- a/man/toJSarray.Rd +++ b/man/toJSarray.Rd @@ -15,3 +15,4 @@ Character with valid JavaScript array \description{ Convert vector of values to JavaScript array } +\keyword{internal} diff --git a/man/transformData.Rd b/man/transformData.Rd index 9c4b25b6..2b1d3ffa 100644 --- a/man/transformData.Rd +++ b/man/transformData.Rd @@ -22,3 +22,4 @@ of created columns \description{ Transform data in data frame } +\keyword{internal} diff --git a/man/transformOptions.Rd b/man/transformOptions.Rd index 50cc946a..b75c2647 100644 --- a/man/transformOptions.Rd +++ b/man/transformOptions.Rd @@ -18,3 +18,4 @@ Character labelling variable transformation(s) \description{ Show variable transformation(s) } +\keyword{internal} diff --git a/man/transformValues.Rd b/man/transformValues.Rd index b7625986..e7826def 100644 --- a/man/transformValues.Rd +++ b/man/transformValues.Rd @@ -22,3 +22,4 @@ Integer containing transformed values \description{ Transform values as per a given type of transformation } +\keyword{internal} diff --git a/man/trimWhitespace.Rd b/man/trimWhitespace.Rd index 302a53b6..49a28df6 100644 --- a/man/trimWhitespace.Rd +++ b/man/trimWhitespace.Rd @@ -20,3 +20,4 @@ psichomics:::trimWhitespace(" hey there ") psichomics:::trimWhitespace(c("pineapple ", "one two three", " sunken ship ")) } +\keyword{internal} diff --git a/man/ttest.Rd b/man/ttest.Rd deleted file mode 100644 index 99fa5590..00000000 --- a/man/ttest.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis.R -\name{ttest} -\alias{ttest} -\title{Perform unpaired t-test analysis and return interface to show the results} -\usage{ -ttest(data, groups, stat = NULL) -} -\arguments{ -\item{data}{Numeric, data frame or matrix: data for one gene or alternative -splicing event} - -\item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} - -\item{stat}{Data frame or matrix: values of the analyses to be performed (if -NULL, the analyses will be performed)} -} -\value{ -HTML elements -} -\description{ -Perform unpaired t-test analysis and return interface to show the results -} diff --git a/man/uniqueBy.Rd b/man/uniqueBy.Rd index 07ecda21..e3a10c11 100644 --- a/man/uniqueBy.Rd +++ b/man/uniqueBy.Rd @@ -17,3 +17,4 @@ Data frame with unique values based on set of columns \description{ Check unique rows of a data frame based on a set of its columns } +\keyword{internal} diff --git a/man/updateClinicalParams.Rd b/man/updateClinicalParams.Rd index 5f95e6f0..2b052f07 100644 --- a/man/updateClinicalParams.Rd +++ b/man/updateClinicalParams.Rd @@ -17,3 +17,4 @@ NULL (this function is used to modify the Shiny session's state) \description{ Update available clinical attributes when the clinical data changes } +\keyword{internal} diff --git a/man/updateFileBrowserInput.Rd b/man/updateFileBrowserInput.Rd index d966ce25..a46fba43 100644 --- a/man/updateFileBrowserInput.Rd +++ b/man/updateFileBrowserInput.Rd @@ -32,3 +32,4 @@ object. For \code{fileBrowserInput} objects, this changes the value displayed in the text-field and triggers a client-side change event. A directory selection dialogue is not displayed. } +\keyword{internal} diff --git a/man/updateProgress.Rd b/man/updateProgress.Rd deleted file mode 100644 index fc4778c2..00000000 --- a/man/updateProgress.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{updateProgress} -\alias{updateProgress} -\title{Update a progress object} -\usage{ -updateProgress(message = "Loading...", value = NULL, max = NULL, - detail = NULL, divisions = NULL, global = if (isRunning()) - sharedData else getHidden(), console = TRUE) -} -\arguments{ -\item{message}{Character: progress message} - -\item{value}{Integer: current progress value} - -\item{max}{Integer: maximum progress value} - -\item{detail}{Character: detailed message} - -\item{divisions}{Integer: number of divisions in the progress bar} - -\item{global}{Shiny's global variable} - -\item{console}{Boolean: print message to console? (TRUE by default)} -} -\value{ -NULL (this function is used to modify the Shiny session's state) -} -\description{ -Update a progress object -} -\details{ -If \code{divisions} is not NULL, a progress bar is started with the -given divisions. If \code{value} is NULL, the progress bar will be -incremented by one; otherwise, the progress bar will be incremented by the -integer given in value. -} diff --git a/man/vennEvents.Rd b/man/vennEvents.Rd index 22bb5826..365c3220 100644 --- a/man/vennEvents.Rd +++ b/man/vennEvents.Rd @@ -17,3 +17,4 @@ Venn diagrams for a given event type \description{ Compare the number of events from the different programs in a Venn diagram } +\keyword{internal} diff --git a/man/wilcox.Rd b/man/wilcox.Rd index 0312880f..22a7e7db 100644 --- a/man/wilcox.Rd +++ b/man/wilcox.Rd @@ -2,9 +2,27 @@ % Please edit documentation in R/analysis.R \name{wilcox} \alias{wilcox} -\title{Perform Wilcoxon analysis and return interface to show the results} +\alias{ttest} +\alias{levene} +\alias{fligner} +\alias{kruskal} +\alias{fisher} +\alias{spearman} +\title{Perform and display statistical analysis} \usage{ wilcox(data, groups, stat = NULL) + +ttest(data, groups, stat = NULL) + +levene(data, groups, stat = NULL) + +fligner(data, groups, stat = NULL) + +kruskal(data, groups, stat = NULL) + +fisher(data, groups) + +spearman(data, groups) } \arguments{ \item{data}{Numeric, data frame or matrix: data for one gene or alternative @@ -20,5 +38,17 @@ NULL, the analyses will be performed)} HTML elements } \description{ -Perform Wilcoxon analysis and return interface to show the results +Includes interface containing the results +} +\details{ +\itemize{ + \item{\code{ttest}: unpaired t-test} + \item{\code{wilcox}: Wilcoxon test} + \item{\code{levene}: Levene's test} + \item{\code{fligner}: Fligner-Killeen test} + \item{\code{kruskal}: Kruskal test} + \item{\code{fisher}: Fisher's exact test} + \item{\code{spearman}: Spearman's test} +} } +\keyword{internal} diff --git a/tests/testthat/testGeneInfo.R b/tests/testthat/testGeneInfo.R index a516429a..24158194 100644 --- a/tests/testthat/testGeneInfo.R +++ b/tests/testthat/testGeneInfo.R @@ -2,7 +2,7 @@ context("Gene, transcript and protein annotation") test_that("Query Ensembl API by event", { event <- "SE_12_-_7985318_7984360_7984200_7982602_SLC2A14" - parsed <- parseEvent(event) + parsed <- parseSplicingEvent(event) expect_is(parsed, "data.frame") expect_equal(parsed$type, "SE") expect_equal(parsed$chrom, "12") diff --git a/vignettes/CLI_tutorial.Rmd b/vignettes/CLI_tutorial.Rmd index b5540327..19f2793a 100644 --- a/vignettes/CLI_tutorial.Rmd +++ b/vignettes/CLI_tutorial.Rmd @@ -44,6 +44,8 @@ library(psichomics) * `psichomics`: Start the visual interface of *psichomics* * `parseSplicingEvent`: Parse splicing events +* `getSplicingEventFromGenes`: Get alternative splicing events from genes +* `getGenesFromSplicingEvents`: Get genes from alternative splicing events ### Data retrieval @@ -56,6 +58,7 @@ library(psichomics) * `getFirebrowseDates`: Query the Firebrowse web API for processing dates * `loadFirebrowseData`: Download and load TCGA data through the Firebrowse web API +* `parseTcgaSampleInfo`: Parse sample information from TCGA samples **GTEx** @@ -70,7 +73,7 @@ metadata * `loadSRAproject`: Download and load [SRA][SRA] projects through the [*recount*][recount] R package -**Custom files** +**Custom and/or local files** * `loadLocalFiles`: Load local files from a given folder * `prepareSRAmetadata`: Prepare metadata from [SRA][SRA] (as obtained from Run @@ -83,8 +86,8 @@ aligners (currently, psichomics supports the output of the splice-aware aligner [STAR][STAR]) ### Gene expression pre-processing -* `rowMeans`: Calculate mean per row (useful for filtering gene expression) -* `rowVars`: Calculate variance per row (useful for filtering gene expression) +* `rowMeans`: Calculate mean per row (useful to filter gene expression) +* `rowVars`: Calculate variance per row (useful to filter gene expression) * `normaliseGeneExpression`: Normalise gene expression data ### PSI quantification @@ -104,6 +107,7 @@ files [VAST-TOOLS][VAST-TOOLS] ### Data Grouping +* `getGeneList`: Get pre-created, literature-based lists of genes * `createGroupByAttribute`: Split elements into groups based on a given attribute * `getSampleFromSubject`: Get samples matching the given patients @@ -152,6 +156,7 @@ and gene expression) * `correlateGEandAS`: Test for association between paired samples' gene expression (for any genes of interest) and alternative splicing quantification * `plotCorrelation`: Scatter plots of the correlation results +* `as.table`: Table of the correlation results ### Annotation retrieval * `queryEnsemblByEvent`: Query Ensembl based on an alternative splicing event @@ -543,7 +548,7 @@ library(survival) # Assign alternative splicing quantification to patients based on their samples samples <- colnames(psi) -match <- getPatientFromSample(samples, clinical, sampleInfo=sampleInfo) +match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) survPlots <- list() for (event in events) { From bb78b2be6e8c9457b5772435a574e728c870504e Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 8 Nov 2018 16:59:27 +0000 Subject: [PATCH 11/46] Fix progress bar when quantifying alternative splicing --- NEWS | 2 ++ src/psiFastCalc.cpp | 14 +++++++------- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index 1b8a686b..a24e3966 100644 --- a/NEWS +++ b/NEWS @@ -28,6 +28,8 @@ * Documentation: - Export functions mentioned in the documentation - Hide documentation of internal functions from the PDF reference manual +* Alternative splicing quantification: + - Fix progress bar # 1.6.2 (2 October, 2018) diff --git a/src/psiFastCalc.cpp b/src/psiFastCalc.cpp index cd299f1a..42138b0f 100644 --- a/src/psiFastCalc.cpp +++ b/src/psiFastCalc.cpp @@ -6,15 +6,15 @@ void progressBar(double progress) { // Create progress bar int barWidth=40; - printf(" |"); + Rprintf(" |"); // Print completed progress int complete = round(progress * barWidth); - for (int i=0; i < complete; i++) printf("="); + for (int i=0; i < complete; i++) Rprintf("="); // Print remaining progress - for (int i=complete; i < barWidth; i++) printf(" "); - printf("| %3.0f%% \r", progress * 100); - fflush(stdout); // Avoids output buffering problems + for (int i=complete; i < barWidth; i++) Rprintf(" "); + Rprintf("| %3.0f%% \r", progress * 100); + if (progress == 1) Rprintf("\n"); } // [[Rcpp::export]] @@ -44,7 +44,7 @@ NumericMatrix psiFastCalc(const NumericMatrix& mat, } if (mat.ncol() > 1) { - progress = col / (mat.ncol() - 1); + progress = double(col) / double(mat.ncol() - 1); progressBar(progress); } } @@ -80,7 +80,7 @@ NumericMatrix psiFastCalc2(const NumericMatrix& mat, } if (mat.ncol() > 1) { - progress = col / (mat.ncol() - 1); + progress = double(col) / double(mat.ncol() - 1); progressBar(progress); } } From 5bf83e4e96ac73180b6187239c7d2f570da21c1e Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 8 Nov 2018 16:59:39 +0000 Subject: [PATCH 12/46] Fix R CMD check and BiocCheck errors and warnings --- R/analysis.R | 2 +- R/data_firebrowse.R | 2 +- R/groups.R | 2 +- tests/testthat/testCorrelationGEandAS.R | 2 +- tests/testthat/testDifferentialSplicing.R | 2 +- tests/testthat/testFilterGroups.R | 2 +- tests/testthat/testFirebrowse.R | 2 +- tests/testthat/testGeneInfo.R | 2 +- tests/testthat/testICA.R | 1 - tests/testthat/testLoadBy.R | 2 +- tests/testthat/testMatsEvents.R | 2 +- tests/testthat/testMisoEvents.R | 2 +- tests/testthat/testPCA.R | 1 - tests/testthat/testRenameDuplicated.R | 4 +--- tests/testthat/testRowVar.R | 1 - tests/testthat/testSurvival.R | 2 +- tests/testthat/testUtils.R | 2 +- 17 files changed, 14 insertions(+), 19 deletions(-) diff --git a/R/analysis.R b/R/analysis.R index 71ee89cc..f8aa6677 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -1222,7 +1222,7 @@ fisher <- function(data, groups) { timeout = 1, onTimeout = "error")) - if (class(stat) != "try-error") { + if (!is(stat, "try-error")) { tagList( h4(stat$method), tags$b("p-value: "), stat$p.value, br(), diff --git a/R/data_firebrowse.R b/R/data_firebrowse.R index 75c49584..eae07f75 100644 --- a/R/data_firebrowse.R +++ b/R/data_firebrowse.R @@ -642,7 +642,7 @@ setFirebrowseData <- function(input, output, session, replace=TRUE) { date = gsub("-", "_", input$firebrowseDate), data = input$firebrowseData, download = FALSE) - areDataMissing <- any(class(data) == "missing") + areDataMissing <- any(is(data, "missing")) if (areDataMissing) { updateProgress(divisions = 1) setURLtoDownload(data) diff --git a/R/groups.R b/R/groups.R index f6c7c040..828972fe 100644 --- a/R/groups.R +++ b/R/groups.R @@ -1959,7 +1959,7 @@ groupsServerOnce <- function(input, output, session) { psi <- getInclusionLevels() if (!is.null(geneExp) || !is.null(psi)) { - groups <- unlist(getGeneList(), recursive=F) + groups <- unlist(getGeneList(), recursive=FALSE) groupNames <- unlist(lapply(names(getGeneList()), function(i) sprintf("%s (%s)", names(getGeneList()[[i]]), i))) selected <- unlist(lapply(names(getGeneList()), function(i) diff --git a/tests/testthat/testCorrelationGEandAS.R b/tests/testthat/testCorrelationGEandAS.R index e746ac4c..6a6c3c2c 100644 --- a/tests/testthat/testCorrelationGEandAS.R +++ b/tests/testthat/testCorrelationGEandAS.R @@ -77,4 +77,4 @@ test_that("Correctly match genes based on TCGA-styled gene expression", { # Test with only non-matching genes gene <- c("ALLSPAM", "SPAMSAMPLE", "SOMEMORESPAM") expect_error(subsetGeneExpressionFromMatchingGenes(geneExpr, gene)) -}) \ No newline at end of file +}) diff --git a/tests/testthat/testDifferentialSplicing.R b/tests/testthat/testDifferentialSplicing.R index d19ddfb2..548b126b 100644 --- a/tests/testthat/testDifferentialSplicing.R +++ b/tests/testthat/testDifferentialSplicing.R @@ -123,4 +123,4 @@ test_that("Label groups based on a cutoff", { group <- gsub("<", "<", group) expect_equal(group, paste(label, c(">=", "<", "<", ">=", ">=", ">="), cutoff)) -}) \ No newline at end of file +}) diff --git a/tests/testthat/testFilterGroups.R b/tests/testthat/testFilterGroups.R index 281e98d6..a8f46b3b 100644 --- a/tests/testthat/testFilterGroups.R +++ b/tests/testthat/testFilterGroups.R @@ -37,4 +37,4 @@ test_that("Groups are ignored with less non-missing values than the threshold", # Order by "red" than "blue" and ignore "yellow" ordered <- vector[3:12][order(names(vector[3:12]), decreasing = TRUE)] expect_identical(filtered, ordered) -}) \ No newline at end of file +}) diff --git a/tests/testthat/testFirebrowse.R b/tests/testthat/testFirebrowse.R index 5a7cf7fe..071f103b 100644 --- a/tests/testthat/testFirebrowse.R +++ b/tests/testthat/testFirebrowse.R @@ -128,4 +128,4 @@ test_that("Parse the URLs from a Firebrowse response", { # expect_true(file.exists(file)) # # Remove folder after testing # unlink(file, recursive = TRUE) -# }) \ No newline at end of file +# }) diff --git a/tests/testthat/testGeneInfo.R b/tests/testthat/testGeneInfo.R index 24158194..b3559fff 100644 --- a/tests/testthat/testGeneInfo.R +++ b/tests/testthat/testGeneInfo.R @@ -78,4 +78,4 @@ test_that("Plot UniProt protein", { expect_equal(plot$x$hc_opts$chart$type, "area") expect_equal(plot$x$hc_opts$chart$zoomType, "x") expect_length(plot$x$hc_opts$series, 9) -}) \ No newline at end of file +}) diff --git a/tests/testthat/testICA.R b/tests/testthat/testICA.R index 333ab52a..27f64f42 100644 --- a/tests/testthat/testICA.R +++ b/tests/testthat/testICA.R @@ -65,4 +65,3 @@ test_that("Plot ICA individuals and colour two groups", { subset <- ica$S[unlist(groups[2:3]), 1:2] expect_true(all(subset == hc$x$data)) }) - diff --git a/tests/testthat/testLoadBy.R b/tests/testthat/testLoadBy.R index b24aba43..ef89d131 100644 --- a/tests/testthat/testLoadBy.R +++ b/tests/testthat/testLoadBy.R @@ -32,4 +32,4 @@ test_that("Gives boolean value depending on the responsible party", { expect_false(loadBy("woodstock", f)) expect_false(loadBy("woodstock", g)) expect_true (loadBy("woodstock", h)) -}) \ No newline at end of file +}) diff --git a/tests/testthat/testMatsEvents.R b/tests/testthat/testMatsEvents.R index 6a607ac7..b98b35fb 100644 --- a/tests/testthat/testMatsEvents.R +++ b/tests/testthat/testMatsEvents.R @@ -122,7 +122,7 @@ test_that("parseMatsEvent parses exon skipping events", { 4626 ENSG00000151422 FER chr5 + 108168470 108168644 108133824 108134090 108171408 108171508 4626 16 0 0 4 112 56 0.000164083368228 0.0164083368228 1 0 1 16170 ENSG00000151914 DST chr6 - 56463273 56463507 56462537 56462804 56464866 56465019 16170 53 7 64 2 112 56 0.062949258326 0.796580100354 0.791 0.941 -0.15 ") - event <- as.data.frame(rbind(event, deparse.level = F)) + event <- as.data.frame(rbind(event, deparse.level=FALSE)) parsed <- parseMatsEvent(event, "SE") expect_is(parsed, "data.frame") diff --git a/tests/testthat/testMisoEvents.R b/tests/testthat/testMisoEvents.R index 5898a470..1312cb23 100644 --- a/tests/testthat/testMisoEvents.R +++ b/tests/testthat/testMisoEvents.R @@ -657,4 +657,4 @@ test_that("parseMisoALE doesn't parse unrecognized events", { # expect_is(new, "list") # expect_equal(length(new), 2) # expect_equal(new, mRNA[1:2]) -# }) \ No newline at end of file +# }) diff --git a/tests/testthat/testPCA.R b/tests/testthat/testPCA.R index f8dd3616..aff6f25b 100644 --- a/tests/testthat/testPCA.R +++ b/tests/testthat/testPCA.R @@ -138,4 +138,3 @@ test_that("Plot PCA loadings", { expect_equal(hc$x$hc_opts$series[[2]]$name, "Loadings") expect_equal(hc$x$hc_opts$series[[2]]$type, "bubble") }) - diff --git a/tests/testthat/testRenameDuplicated.R b/tests/testthat/testRenameDuplicated.R index 6d273d3f..5eab115f 100644 --- a/tests/testthat/testRenameDuplicated.R +++ b/tests/testthat/testRenameDuplicated.R @@ -52,6 +52,4 @@ test_that("Return renamed vector with no duplicates", { comp <- c("cat") res <- renameDuplicated(check, comp) expect_equal(res, c("cat (1)", "mouse", "cat (2)")) - - -}) \ No newline at end of file +}) diff --git a/tests/testthat/testRowVar.R b/tests/testthat/testRowVar.R index 6e017020..0936615d 100644 --- a/tests/testthat/testRowVar.R +++ b/tests/testthat/testRowVar.R @@ -55,4 +55,3 @@ test_that("Calculate variance for a multi-row matrix", { res2 <- apply(mat, 1, var, na.rm = FALSE) # R way expect_equal(signif(res1, 16), signif(res2, 16)) }) - diff --git a/tests/testthat/testSurvival.R b/tests/testthat/testSurvival.R index 314f3509..f1724e4c 100644 --- a/tests/testthat/testSurvival.R +++ b/tests/testthat/testSurvival.R @@ -150,4 +150,4 @@ test_that("Plot survival curves with no separation", { expect_match(plot$x$hc_opts$subtitle$text, "NA") expect_equal(plot$x$hc_opts$chart$zoomType, "xy") expect_length(plot$x$hc_opts$series, 1) -}) \ No newline at end of file +}) diff --git a/tests/testthat/testUtils.R b/tests/testthat/testUtils.R index 3f7f1714..2a8c990b 100644 --- a/tests/testthat/testUtils.R +++ b/tests/testthat/testUtils.R @@ -144,4 +144,4 @@ test_that("Parse alternative splicing event from identifiers", { expect_equal(tail(colnames(parsed), 4), c("constitutive1", "alternative1", "alternative2", "constitutive2")) -}) \ No newline at end of file +}) From 676ecb0b64f593ce3a9b4d3d5fbc4adae17fd1d2 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 29 Nov 2018 23:10:02 +0000 Subject: [PATCH 13/46] Fix crash when loading psichomics with test data that is not locally available --- NEWS | 2 ++ R/app.R | 17 ++++++++++++++--- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index a24e3966..ac67dee2 100644 --- a/NEWS +++ b/NEWS @@ -30,6 +30,8 @@ - Hide documentation of internal functions from the PDF reference manual * Alternative splicing quantification: - Fix progress bar +* Fix crash by downloading test data if not locally available when loading +psichomics with said data # 1.6.2 (2 October, 2018) diff --git a/R/app.R b/R/app.R index 46ec4814..f194dd05 100644 --- a/R/app.R +++ b/R/app.R @@ -365,10 +365,21 @@ psichomics <- function(..., reset=FALSE, testData=FALSE) { 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"]] <- readRDS("vignettes/BRCA_clinical.RDS") - data[["Gene expression"]] <- readRDS("vignettes/BRCA_geneExpr.RDS") - data[["Inclusion levels"]] <- readRDS("vignettes/BRCA_psi.RDS") + data[["Clinical data"]] <- loadFile("vignettes/BRCA_clinical.RDS") + data[["Gene expression"]] <- loadFile("vignettes/BRCA_geneExpr.RDS") + data[["Inclusion levels"]] <- loadFile("vignettes/BRCA_psi.RDS") data[["Sample metadata"]] <- parseTcgaSampleInfo(colnames( data[["Inclusion levels"]])) setData(list("Test data"=data)) From 7536285cb2fcea357ff945ce96192b6aff815396 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 7 Feb 2019 17:46:53 +0000 Subject: [PATCH 14/46] Fix wrong information in table of differential splicing results --- NEWS | 8 ++++++-- R/analysis.R | 6 +++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index ac67dee2..93386cdf 100644 --- a/NEWS +++ b/NEWS @@ -30,8 +30,12 @@ - Hide documentation of internal functions from the PDF reference manual * Alternative splicing quantification: - Fix progress bar -* Fix crash by downloading test data if not locally available when loading -psichomics with said data +* Fix crash when loading psichomics with test data that is not locally available +(by automatically downloading said data if not found) +* Differential analyses: + - Fix wrong information in the table of differential splicing results (only + occurs when the first splicing event is one for which there is not enough + information to calculate statistical tests) # 1.6.2 (2 October, 2018) diff --git a/R/analysis.R b/R/analysis.R index f8aa6677..7d304358 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -2119,15 +2119,15 @@ diffAnalyses <- function(data, groups=NULL, ll <- lapply(ll, unlist) ldf <- lapply(seq_along(uniq), function(k) { elems <- match == k - df2 <- t(as.data.frame(ll[elems])) + df2 <- t(data.frame(ll[elems], stringsAsFactors=FALSE)) cols <- colnames(df2) - df2 <- data.frame(df2) + df2 <- data.frame(df2, stringsAsFactors=FALSE) colnames(df2) <- cols rownames(df2) <- names(stats)[elems] return(df2) }) - df <- do.call(rbind.fill, ldf) + df <- rbind.fill(ldf) rownames(df) <- unlist(lapply(ldf, rownames)) # Convert numeric columns to numeric From 808b219acfb5b317afc0fe232cb268a49a51cd52 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 13 Feb 2019 17:05:57 +0000 Subject: [PATCH 15/46] Fix colours/opacity in the rug plot within the distribution plot --- NEWS | 3 +++ R/analysis.R | 19 ++++++++++++++++--- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 93386cdf..0bebd9d4 100644 --- a/NEWS +++ b/NEWS @@ -33,6 +33,9 @@ * Fix crash when loading psichomics with test data that is not locally available (by automatically downloading said data if not found) * Differential analyses: + - Fix group colours and opacity for rug plot points within the distribution + plot (occured in the command-line version and when exporting plots in the + visual interface) - Fix wrong information in the table of differential splicing results (only occurs when the first splicing event is one for which there is not enough information to calculate statistical tests) diff --git a/R/analysis.R b/R/analysis.R index 7d304358..22fab45e 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -1690,7 +1690,7 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, colour <- unname(attr(groups, "Colour")[group]) if (is.null(colour)) - colour <- JS("Highcharts.getOptions().colors[", count, "]") + colour <- JS(paste0("Highcharts.getOptions().colors[", count, "]")) # Calculate the density of inclusion levels for each sample group den <- tryCatch(density(row, na.rm=TRUE, ...), error=return, @@ -1704,10 +1704,23 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, } # Rug plot if (rug) { + isHexColour <- function(string) { + # Explicitely ignores HEX colour codes with opacity + grepl("^#{0,1}([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$", string) + } + + opacity <- 60 + if (is(colour, "JS_EVAL")) { + fill <- JS(sprintf("%s + \"%s\"", colour, opacity)) + } else if (isHexColour(colour)) { + fill <- sprintf("%s%s", colour, opacity) + } else { + fill <- colour + } + hc <- hc_scatter( hc, row, rep(0, length(row)), name=group, marker=list( - enabled=TRUE, symbol="circle", radius=4, - fillColor=paste0(colour, "60")), # Add opacity + enabled=TRUE, symbol="circle", radius=4, fillColor=fill), median=med, var=vari, samples=samples, max=max, min=min) } # Save plot line with information From 2fb74587d87c9a8a6fc2e85c1c429faf4ea1d3b6 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 18 Feb 2019 11:02:33 +0000 Subject: [PATCH 16/46] Update copyright references to 2019 --- R/data.R | 2 +- R/help.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/data.R b/R/data.R index 8af3c7e7..67941582 100644 --- a/R/data.R +++ b/R/data.R @@ -331,7 +331,7 @@ dataUI <- function(id, tab) { target="_blank", "Disease Transcriptomics Lab, iMM"), "(", tags$a(href="mailto:nunodanielagostinho@gmail.com", "Nuno Saraiva-Agostinho", icon("envelope-o")), - ", 2015-2018)", + ", 2015-2019)", br(), "Special thanks to my lab colleagues for their work-related", br(), "support and supporting chatter.")) diff --git a/R/help.R b/R/help.R index 2480c6a3..ad7e7eb6 100644 --- a/R/help.R +++ b/R/help.R @@ -122,7 +122,7 @@ helpUI <- function(id, tab) { tags$small(class="help-block", style="text-align: right;", style="margin: 0;", - "2015-2018"))))), + "2015-2019"))))), column( 4, div( class="panel", class="panel-default", From 161f9c2da7bf5139bda1a56c0bd8aebf76268b9e Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 18 Feb 2019 11:03:53 +0000 Subject: [PATCH 17/46] Minor copyediting --- R/data_geNormalisationFiltering.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 51ff6658..951a08f8 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -441,8 +441,8 @@ geNormalisationFilteringServer <- function(input, output, session) { "Original gene expression (label)"=isolate(input$geneExpr) ), geneFilterSettings, list( "Normalisation method"=method, - "Perform log2 transformation"=if (log2transform) "Yes" else "No", - "Average count to add per observation"=priorCount)) + "Log2-transformed"=if (log2transform) "Yes" else "No", + "Average count added per observation"=priorCount)) attr(geneExprNorm, "settings") <- settings attr(geneExprNorm, "icon") <- list(symbol="cogs", colour="green") From 795d17597f7d639681aa2cf33937ecd8a0c7eea8 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 18 Feb 2019 11:15:56 +0000 Subject: [PATCH 18/46] Improve SRA data loading - Accept a vector of files as the first argument (easier to use with `list.files()`) - Ask to overwrite file if one exists with the same name as the output file --- NEWS | 4 ++ R/data_local.R | 98 ++++++++++++++++++++++-------------- man/prepareSRAmetadata.Rd | 4 +- man/processAndSaveSRAdata.Rd | 24 +++++++++ 4 files changed, 89 insertions(+), 41 deletions(-) create mode 100644 man/processAndSaveSRAdata.Rd diff --git a/NEWS b/NEWS index 0bebd9d4..a5e374b7 100644 --- a/NEWS +++ b/NEWS @@ -22,6 +22,10 @@ ## Bug fixes and minor changes +* Loading SRA data: + - Accept a vector of files as the first argument (easier to use with + `list.files()`) + - Ask to overwrite file if one exists with the same name as the output file * Groups: - Minor improvements to the group creation interface * Improve console logging of error and warning alerts diff --git a/R/data_local.R b/R/data_local.R index a201d5fd..9d02bb2b 100644 --- a/R/data_local.R +++ b/R/data_local.R @@ -122,8 +122,8 @@ localDataUI <- function(id, panel) { #' Prepare files to be loaded into psichomics #' #' @param file Character: path to file -#' @param output Character: path of output file (if NULL, only returns the data -#' without saving it to a file) +#' @param output Character: path of output file (if \code{NULL}, only returns +#' the data without saving it to a file) #' #' @importFrom data.table fread fwrite #' @@ -136,6 +136,53 @@ prepareSRAmetadata <- function(file, output="psichomics_metadata.txt") { return(data) } +#' Process and save SRA quantification data +#' +#' @param files Character: path to SRA quantification files +#' @param data Data frame: processed quantification data +#' @param output Character: output filename (if \code{NULL}, no file is saved) +#' @param IDcolname Character: name of the column containing the identifiers +#' +#' @return Process file and save its output +#' @keywords internal +processAndSaveSRAdata <- function(files, data, output, IDcolname) { + # Add sample names + samples <- names(files) + if (is.null(samples)) { + # Remove STAR filename end + if (IDcolname == "Gene ID") + filenameSuffix <- "ReadsPerGene" + else if (IDcolname == "Junction ID") + filenameSuffix <- "SJ" + filenameSuffix <- paste0(filenameSuffix, "\\.out\\.tab$") + + samples <- gsub(filenameSuffix, "", unlist(files)) + samples <- basename(samples) + } + colnames(data) <- as.character(samples) + + quant <- cbind(rownames(data), data) + setnames(quant, "V1", IDcolname) + + # Save data to given path + if (!is.null(output)) { + if (file.exists(output)) { + msg <- sprintf( + "File %s already exists. Do you want to overwrite it?", output) + allowOverwrite <- askYesNo(msg, default=FALSE, + prompts=c("Overwrite", "No", "Cancel")) + if (!allowOverwrite || is.na(allowOverwrite)) + return(invisible(NULL)) + } else { + allowOverwrite <- FALSE + } + fwrite(quant, output, sep="\t", na=0, quote=FALSE) + message(sprintf("File %s was %s", output, + ifelse(allowOverwrite, "overwritten", "created"))) + } + return(quant) +} + #' @rdname prepareSRAmetadata #' #' @param ... Character: path to file(s) to read @@ -159,24 +206,10 @@ prepareJunctionQuant <- function(..., output="psichomics_junctions.txt", files <- list(...) # Prepare junction quantification accordingly - data <- prepareJunctionQuantSTAR(..., startOffset=startOffset, - endOffset=endOffset) - - # Add sample names - samples <- names(files) - if (is.null(samples)) { - # Remove STAR filename end - samples <- gsub("SJ\\.out\\.tab$", "", unlist(files)) - } - colnames(data) <- as.character(samples) - - # Save data to given path - if (!is.null(output)) { - junctionQuant <- cbind(rownames(data), data) - setnames(junctionQuant, "V1", "Junction ID") - fwrite(junctionQuant, output, sep="\t", na=0, quote=FALSE) - } - return(junctionQuant) + data <- prepareJunctionQuantSTAR(..., startOffset=startOffset, + endOffset=endOffset) + quant <- processAndSaveSRAdata(files, data, output, "Junction ID") + return(quant) } #' @inherit prepareSRAmetadata @@ -186,6 +219,7 @@ prepareJunctionQuantSTAR <- function(..., startOffset=-1, endOffset=+1) { if (is.null(endOffset)) endOffset <- +1 files <- list(...) + if (length(files) == 1) files <- unlist(files) joint <- NULL for (file in files) { cat(sprintf("Processing %s...", file), fill=TRUE) @@ -244,23 +278,9 @@ prepareGeneQuant <- function(..., output="psichomics_gene_counts.txt", files <- list(...) # Prepare file accordingly - data <- prepareGeneQuantSTAR(..., strandedness=strandedness) - - # Add sample names - samples <- names(files) - if (is.null(samples)) { - # Remove STAR filename end - samples <- gsub("ReadsPerGene\\.out\\.tab$", "", unlist(files)) - } - colnames(data) <- as.character(samples) - - # Save data to given path - if (!is.null(output)) { - geneQuant <- cbind(rownames(data), data) - setnames(geneQuant, "V1", "Gene ID") - fwrite(geneQuant, output, sep="\t", na=0, quote=FALSE) - } - return(geneQuant) + data <- prepareGeneQuantSTAR(..., strandedness=strandedness) + quant <- processAndSaveSRAdata(files, data, output, "Gene ID") + return(quant) } #' @rdname prepareJunctionQuantSTAR @@ -272,12 +292,12 @@ prepareGeneQuantSTAR <- function(..., strandedness=c("unstranded", "stranded", "unstranded"=2, "stranded"=3, "stranded (reverse)"=4) files <- list(...) + if (length(files) == 1) files <- unlist(files) joint <- NULL for (file in files) { cat(sprintf("Processing %s...", file), fill=TRUE) table <- fread(file, skip=4) - strand <- match("strandedness", colnames(table)) - table <- table[ , c(1, strand, with=FALSE)] + table <- table[ , c(1, strandedness), with=FALSE] joint <- c(joint, list(table)) } diff --git a/man/prepareSRAmetadata.Rd b/man/prepareSRAmetadata.Rd index 67c317ea..180b26fb 100644 --- a/man/prepareSRAmetadata.Rd +++ b/man/prepareSRAmetadata.Rd @@ -17,8 +17,8 @@ prepareGeneQuant(..., output = "psichomics_gene_counts.txt", \arguments{ \item{file}{Character: path to file} -\item{output}{Character: path of output file (if NULL, only returns the data -without saving it to a file)} +\item{output}{Character: path of output file (if \code{NULL}, only returns +the data without saving it to a file)} \item{...}{Character: path to file(s) to read} diff --git a/man/processAndSaveSRAdata.Rd b/man/processAndSaveSRAdata.Rd new file mode 100644 index 00000000..fec0b9cb --- /dev/null +++ b/man/processAndSaveSRAdata.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_local.R +\name{processAndSaveSRAdata} +\alias{processAndSaveSRAdata} +\title{Process and save SRA quantification data} +\usage{ +processAndSaveSRAdata(files, data, output, IDcolname) +} +\arguments{ +\item{files}{Character: path to SRA quantification files} + +\item{data}{Data frame: processed quantification data} + +\item{output}{Character: output filename (if \code{NULL}, no file is saved)} + +\item{IDcolname}{Character: name of the column containing the identifiers} +} +\value{ +Process file and save its output +} +\description{ +Process and save SRA quantification data +} +\keyword{internal} From ad81788ad9241386b34349bb6d912824a7ff51e8 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 28 Feb 2019 11:57:54 +0000 Subject: [PATCH 19/46] Improve gene expression filtering and normalisation and PSI filtering - Plot distribution of gene expression per sample - Plot distribution of library sizes - Plot gene-wise expression mean and variance across samples - Plot PSI mean, variance and range - Filter PSI values - Perform voom and respective normalisation if desired - Sample filtering - Filter lowly expressed genes using edgeR::filterByExpr - Convert ENSEMBL identifiers to gene symbols - Show labels for distribution plots Bug fixes: - Fix distribution plots requiring all samples in a group - Show sample names in distribution plots - Fix inconsistency of delta median and variance --- DESCRIPTION | 3 +- NAMESPACE | 15 + NEWS | 31 +- R/analysis.R | 115 ++++-- R/analysis_correlation.R | 4 +- R/analysis_diffExpression_event.R | 6 +- R/analysis_diffExpression_table.R | 20 +- R/analysis_dimReduction_ica.R | 4 +- R/analysis_dimReduction_pca.R | 4 +- R/analysis_survival.R | 16 +- R/data.R | 87 +++- R/data_geNormalisationFiltering.R | 540 ++++++++++++++++++------- R/data_inclusionLevels.R | 414 ++++++++++++++----- R/globalAccess.R | 23 +- R/groups.R | 16 + inst/shiny/www/functions.js | 8 +- man/convertCoordinates.Rd | 18 + man/convertGeneIdentifiers.Rd | 42 ++ man/discardOutsideSamplesFromGroups.Rd | 22 + man/filterGeneExpr.Rd | 31 ++ man/getGlobal.Rd | 9 +- man/normaliseGeneExpression.Rd | 18 +- man/plotDistribution.Rd | 17 +- man/plotGeneExprPerSample.Rd | 32 ++ man/plotMeanVariance.Rd | 17 + man/plotPSI.Rd | 39 ++ man/quantifySplicing.Rd | 4 +- man/renderBoxplot.Rd | 28 ++ man/tabDataset.Rd | 4 + 29 files changed, 1231 insertions(+), 356 deletions(-) create mode 100644 man/convertCoordinates.Rd create mode 100644 man/convertGeneIdentifiers.Rd create mode 100644 man/discardOutsideSamplesFromGroups.Rd create mode 100644 man/filterGeneExpr.Rd create mode 100644 man/plotGeneExprPerSample.Rd create mode 100644 man/plotMeanVariance.Rd create mode 100644 man/plotPSI.Rd create mode 100644 man/renderBoxplot.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d2815955..d41c4a42 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -76,7 +76,8 @@ Suggests: gplots, covr, car, - rstudioapi + rstudioapi, + org.Hs.eg.db LinkingTo: Rcpp VignetteBuilder: knitr Collate: diff --git a/NAMESPACE b/NAMESPACE index 611f8972..7b327b73 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,11 +6,13 @@ S3method(print,GEandAScorrelation) export(assignValuePerPatient) export(assignValuePerSubject) export(calculateLoadingsContribution) +export(convertGeneIdentifiers) export(correlateGEandAS) export(createGroupByAttribute) export(createGroupByColumn) export(diffAnalyses) export(ensemblToUniprot) +export(filterGeneExpr) export(filterGroups) export(getAttributesTime) export(getColumnsTime) @@ -57,9 +59,12 @@ export(performICA) export(performPCA) export(plotCorrelation) export(plotDistribution) +export(plotGeneExprPerSample) export(plotGroupIndependence) export(plotICA) +export(plotMeanVariance) export(plotPCA) +export(plotPSI) export(plotProtein) export(plotSurvivalCurves) export(plotTranscripts) @@ -80,6 +85,8 @@ export(survdiff.survTerms) export(survfit.survTerms) export(testGroupIndependence) export(testSurvival) +exportMethods(colSums) +importFrom(AnnotationDbi,select) importFrom(AnnotationHub,AnnotationHub) importFrom(AnnotationHub,query) importFrom(DT,JS) @@ -107,6 +114,7 @@ importFrom(cluster,pam) importFrom(cluster,silhouette) importFrom(colourpicker,colourInput) importFrom(colourpicker,updateColourInput) +importFrom(data.table,data.table) importFrom(data.table,fread) importFrom(data.table,fwrite) importFrom(data.table,setkeyv) @@ -116,6 +124,7 @@ importFrom(digest,digest) importFrom(edgeR,DGEList) importFrom(edgeR,calcNormFactors) importFrom(edgeR,cpm) +importFrom(edgeR,filterByExpr) importFrom(fastICA,fastICA) importFrom(fastmatch,"%fin%") importFrom(fastmatch,fmatch) @@ -126,9 +135,11 @@ importFrom(ggplot2,coord_equal) importFrom(ggplot2,element_blank) importFrom(ggplot2,element_text) importFrom(ggplot2,geom_density_2d) +importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_tile) +importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggtitle) importFrom(ggplot2,labs) @@ -137,6 +148,8 @@ importFrom(ggplot2,scale_fill_gradient2) importFrom(ggplot2,theme) importFrom(ggplot2,theme_light) importFrom(ggplot2,unit) +importFrom(ggplot2,ylab) +importFrom(ggplot2,ylim) importFrom(ggrepel,geom_label_repel) importFrom(grDevices,chull) importFrom(highcharter,"%>%") @@ -176,6 +189,7 @@ importFrom(jsonlite,toJSON) importFrom(limma,eBayes) importFrom(limma,lmFit) importFrom(limma,topTable) +importFrom(limma,voom) importFrom(methods,is) importFrom(miscTools,colMedians) importFrom(miscTools,rowMedians) @@ -186,6 +200,7 @@ importFrom(plyr,dlply) importFrom(plyr,ldply) importFrom(plyr,rbind.fill) importFrom(recount,download_study) +importFrom(reshape2,melt) importFrom(shiny,HTML) importFrom(shiny,NS) importFrom(shiny,Progress) diff --git a/NEWS b/NEWS index a5e374b7..0f36ab1b 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -# 1.8.1 (7 November, 2018) +# 1.8.1 (4 March, 2019) * Correlation analyses: - Allow to use groups of genes and alternative splicing events @@ -11,6 +11,24 @@ - By default, quantify skipped exons, mutually exclusive exons, alternative 3' and 5' splice sites, and alternative first and last exons; this default option is now consistent across the visual and command-line interfaces) + - Allow to discard samples before alternative splicing quantification + - In alternative splicing quantification dataset summary, plot + quantification based on median, variance and range per splicing event across + samples to provide tools to filter quantification (`plotPSI()`) +* Gene expression filtering and normalisation: + - Allow to discard samples before filtering and normalisation + - Filter low read counts using `edgeR::filterByExpr()` + - Allow to perform `limma::voom()` on gene expression data (without design + matrix) and to apply its normalisation methods + - In gene expression dataset summary, plot distribution of gene expression + per sample, distribution of library sizes and gene-wise mean and variance of + gene expression across samples to provide the user tools to assess gene + expression normalisation (`plotGeneExprPerSample()`, `plotDistribution` and + `plotMeanVariance()`, respectively) + - Convert between different gene identifiers (the original identifier is + kept in some conditions, read `convertGeneIdentifiers`); in the visual + interface, when filtering and normalising gene expression, ENSEMBL + identifiers are converted to gene symbols, by default * Groups: - By default, load pre-made lists of genes when loading gene expression or loading/performing alternative splicing quantification @@ -37,12 +55,19 @@ * Fix crash when loading psichomics with test data that is not locally available (by automatically downloading said data if not found) * Differential analyses: + - Allow distribution plots to show the name of the samples when hovering or + when a rug plot is rendered if `rugLabels = TRUE` (function + `plotDistribution()`) + - Fix distribution plots requiring all samples in a group when using + function `plotDistribution()` - Fix group colours and opacity for rug plot points within the distribution - plot (occured in the command-line version and when exporting plots in the - visual interface) + plot (occured in the command-line version; function `plotDistribution()`) - Fix wrong information in the table of differential splicing results (only occurs when the first splicing event is one for which there is not enough information to calculate statistical tests) + - Fix inconsistency when presenting median and variance differences between + gene expression and alternative splicing quantification + - Fix error when groups contain samples outside the data being analysed # 1.6.2 (2 October, 2018) diff --git a/R/analysis.R b/R/analysis.R index 22fab45e..ac561b41 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -1607,7 +1607,9 @@ plotPointsStyle <- function(ns, id, description, help=NULL, size=2, #' @param data Numeric, data frame or matrix: data for one gene or alternative #' splicing event #' @param groups List of characters (list of groups containing data identifiers) -#' or character vector (group of each value in \code{data}) +#' or character vector (group of each value in \code{data}); if \code{NULL} or a +#' character vector of length 1, all data points will be considered of the same +#' group #' @param rug Boolean: include rug plot to better visualise data distribution #' @param vLine Boolean: include vertical plot lines to display descriptive #' statistics for each group @@ -1616,6 +1618,7 @@ plotPointsStyle <- function(ns, id, description, help=NULL, size=2, #' @param title Character: plot title #' @param psi Boolean: are data composed of PSI values? Automatically set to #' \code{TRUE} if all \code{data} values are between 0 and 1 +#' @param rugLabels Boolean: plot names or colnames of \code{data} in the rug? #' #' @importFrom highcharter highchart hc_chart hc_xAxis hc_plotOptions hc_tooltip #' JS @@ -1625,11 +1628,12 @@ plotPointsStyle <- function(ns, id, description, help=NULL, size=2, #' @export #' #' @examples -#' data <- sample(20, rep=TRUE)/20 -#' groups <- c(rep("A", 10), rep("B", 10)) -#' plotDistribution(data, groups) -plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, - ..., title=NULL, psi=NULL) { +#' data <- sample(20, rep=TRUE)/20 +#' groups <- paste("Group", c(rep("A", 10), rep("B", 10))) +#' label <- paste("Sample", 1:20) +#' plotDistribution(data, groups, label=label) +plotDistribution <- function(data, groups=NULL, rug=TRUE, vLine=TRUE, + ..., title=NULL, psi=NULL, rugLabels=FALSE) { if (is.null(psi)) psi <- min(data, na.rm=TRUE) >= 0 && max(data, na.rm=TRUE) <= 1 @@ -1652,9 +1656,11 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, hc_plotOptions(series = list(fillOpacity=0.3, marker=list(enabled=FALSE))) %>% hc_tooltip( - headerFormat = paste(span(style="color:{point.color}", "\u25CF "), - tags$b("{series.name}"), br()), + headerFormat=NULL, pointFormat = paste( + "{point.label}", br(), + span(style="color:{point.color}", "\u25CF "), + tags$b("{series.name}"), br(), id, "{point.x:.2f}", br(), "Number of samples: {series.options.samples}", br(), "Median: {series.options.median}", br(), @@ -1664,7 +1670,8 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, if (!is.null(title)) hc <- hc %>% hc_title(text=title) - if (is.list(groups)) + if (is.null(groups)) groups <- "All samples" + if (is.list(groups)) ns <- names(groups) else ns <- groups @@ -1677,10 +1684,20 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, else filter <- groups == group - if (is.vector(data)) - row <- as.numeric(data[filter]) - else - row <- as.numeric(data[ , filter]) + if (is.vector(data)) { + row <- data[filter] + } else if (isTRUE(filter)) { + row <- data + } else { + filter <- filter[filter %in% colnames(data)] + row <- data[ , filter] + } + + label <- names(row) + if (is.null(label)) label <- colnames(row) + + row <- as.numeric(row) + if (length(row) == 0) next med <- roundDigits(median(row, na.rm=TRUE)) vari <- roundDigits(var(row, na.rm=TRUE)) @@ -1709,7 +1726,11 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, grepl("^#{0,1}([A-Fa-f0-9]{6}|[A-Fa-f0-9]{3})$", string) } - opacity <- 60 + convertOpacityToHex <- function(opacity) { + sprintf("%02x", round(opacity/100 * 255)) + } + opacity <- convertOpacityToHex(60) # Opacity in percentage + if (is(colour, "JS_EVAL")) { fill <- JS(sprintf("%s + \"%s\"", colour, opacity)) } else if (isHexColour(colour)) { @@ -1718,16 +1739,16 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, fill <- colour } - hc <- hc_scatter( - hc, row, rep(0, length(row)), name=group, marker=list( - enabled=TRUE, symbol="circle", radius=4, fillColor=fill), - median=med, var=vari, samples=samples, max=max, min=min) + hc <- hc %>% + hc_scatter( + row, rep(0, length(row)), name=group, label=label, + marker=list(enabled=TRUE, radius=4, fillColor=fill), + median=med, var=vari, samples=samples, max=max, min=min) } - # Save plot line with information + # Plot line with basic statistics if (vLine) { plotLines[[count + 1]] <- list( - label = list(text = paste("Median:", med, "/ Variance:", vari)), - # Colour the same as the series + label=list(text=paste("Median:", med, "/ Variance:", vari)), color=colour, dashStyle="shortdash", width=2, value=med, zIndex=7) } @@ -1736,6 +1757,53 @@ plotDistribution <- function(data, groups="All samples", rug=TRUE, vLine=TRUE, # Add plotLines with information if (vLine) hc <- hc %>% hc_xAxis(plotLines = plotLines) + + # Show or hide rug labels + rugSeries <- which(sapply(hc$x$hc_opts$series, "[[", "type") == "scatter") + for (k in rugSeries) + hc$x$hc_opts$series[[k]]$dataLabels$enabled <- rugLabels + return(hc) +} + +#' Render boxplot +#' +#' @param data Data frame or matrix +#' @param outliers Boolean: draw outliers? +#' @param sortByMedian Boolean: sort box plots based on ascending median? +#' @param showXlabels Boolean: show labels in X axis? +#' +#' @importFrom reshape2 melt +#' @importFrom miscTools colMedians +#' +#' @return Box plot +#' @keywords internal +#' +#' @examples +#' renderBoxplot(data.frame(a=1:10, b=10:19, c=45:54)) +renderBoxplot <- function(data, outliers=FALSE, sortByMedian=TRUE, + showXlabels=TRUE, title=NULL, + seriesName="Gene expression") { + if (sortByMedian) { + medians <- colMedians(data) + data <- data[ , order(medians)] + } + + # Remove matrix rownames from melted data + melted <- suppressMessages(melt(data)) + if (ncol(melted) == 3) { + melted[[1]] <- NULL + colnames(melted)[[1]] <- "variable" + } + + hc <- hcboxplot(melted$value, melted$variable, outliers=outliers) %>% + hc_chart(zoomType="x", type="column") %>% + hc_plotOptions(boxplot=list(color="black", fillColor="orange")) %>% + hc_xAxis(labels=list(enabled=showXlabels)) %>% + hc_title(text=title) + if (min(melted$value) >= 0) hc <- hc %>% hc_yAxis(min=0) + + hc <- hc %>% export_highcharts() + hc$x$hc_opts$series[[1]]$name <- seriesName return(hc) } @@ -2096,6 +2164,7 @@ diffAnalyses <- function(data, groups=NULL, ids <- names(data) groups <- parseSampleGroups(ids) } else if (is.list(groups)) { + groups <- discardOutsideSamplesFromGroups(groups, colnames(data)) data <- data[ , unlist(groups)] colour <- attr(groups, "Colour") @@ -2168,9 +2237,9 @@ diffAnalyses <- function(data, groups=NULL, if (ncol(deltaVar) == 2) { updateProgress("Calculating delta variance and median") time <- Sys.time() - deltaVar <- deltaVar[, 2] - deltaVar[, 1] + deltaVar <- deltaVar[ , 1] - deltaVar[ , 2] deltaMed <- df[, grepl("Median", colnames(df))] - deltaMed <- deltaMed[, 2] - deltaMed[, 1] + deltaMed <- deltaMed[ , 1] - deltaMed[ , 2] df <- cbind(df, "\u2206 Variance"=deltaVar, "\u2206 Median"=deltaMed) display(Sys.time() - time) } diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index 89dbd19e..9abf7003 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -522,7 +522,7 @@ correlationServer <- function(input, output, session) { filter=rownames(psi)) ASevents <- unlist(ASevents) - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) gene <- getSelectedGroups(input, "genes", "Genes", filter=rownames(geneExpr)) gene <- unlist(gene) @@ -557,7 +557,7 @@ correlationServer <- function(input, output, session) { filter=rownames(psi)) ASevents <- unlist(ASevents) - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) gene <- getSelectedGroups(input, "genes", "Genes", filter=rownames(geneExpr)) gene <- unlist(gene) diff --git a/R/analysis_diffExpression_event.R b/R/analysis_diffExpression_event.R index 2d6448b6..580b6e19 100644 --- a/R/analysis_diffExpression_event.R +++ b/R/analysis_diffExpression_event.R @@ -76,7 +76,7 @@ diffExpressionEventServer <- function(input, output, session) { selectGroupsServer(session, "diffGroups", "Samples") observeEvent(input$analyse, { - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) if (is.null(geneExpr)) { missingDataModal(session, "Gene expression", ns("missingGeneExpr")) return(NULL) @@ -163,7 +163,7 @@ diffExpressionEventServer <- function(input, output, session) { # Update available gene choices depending on gene expression data loaded # Reactive avoids updating if the input remains the same updateGeneChoices <- reactive({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) genes <- rownames(geneExpr) updateSelectizeInput(session, "gene", choices=genes, server=TRUE) }) @@ -182,7 +182,7 @@ diffExpressionEventServer <- function(input, output, session) { # Show options if gene expression data is available, update available gene # expression data choices and update available genes for selection observe({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) if (is.null(geneExpr)) { hide("singleGeneOptions") hide("survivalButton") diff --git a/R/analysis_diffExpression_table.R b/R/analysis_diffExpression_table.R index f7b56bd2..b8e1e720 100644 --- a/R/analysis_diffExpression_table.R +++ b/R/analysis_diffExpression_table.R @@ -41,11 +41,6 @@ diffExpressionTableUI <- function(id) { "compute moderated t-tests and log-odds of differential", "expression by empirical Bayes moderation of the standard", "errors towards a common value."), - radioButtons( - ns("ebayesPriorVar"), "Prior gene-wise variance modelling", - list("Constant pooled variance"="constant", - "Mean-variance trend (limma-trend)"="trend"), - selected="trend"), sliderInput( ns("ebayesProportion"), min=0, max=1, value=0.01, step=0.01, width="100%", @@ -178,15 +173,18 @@ diffExpressionSet <- function(session, input, output) { }) performDiffExpression <- reactive({ - geneExpr <- getGeneExpression()[[input$geneExpr]] - + geneExpr <- getGeneExpression(input$geneExpr) totalTime <- startProcess("startAnalyses") # Prepare groups of samples to analyse and filter samples not available # in the selected groups from the gene expression data groups <- getSelectedGroups(input, "diffGroups", "Samples", filter=colnames(geneExpr)) - geneExpr <- geneExpr[ , unlist(groups), drop=FALSE] + groups <- discardOutsideSamplesFromGroups(groups, colnames(geneExpr)) + if (is(geneExpr, "EList")) + geneExpr <- geneExpr[ , unlist(groups), drop=FALSE] + else + geneExpr <- geneExpr[ , unlist(groups)] isFromGroup1 <- colnames(geneExpr) %in% groups[[1]] design <- cbind(1, ifelse(isFromGroup1, 1, 0)) @@ -197,16 +195,16 @@ diffExpressionSet <- function(session, input, output) { ebayesProportion <- input$ebayesProportion ebayesStdevMin <- input$ebayesStdevMin ebayesStdevMax <- input$ebayesStdevMax - ebayesPriorVar <- input$ebayesPriorVar - limmaTrend <- identical(ebayesPriorVar, "trend") - stats <- eBayes(fit, proportion=ebayesProportion, trend=limmaTrend, + stats <- eBayes(fit, proportion=ebayesProportion, + trend=!is(geneExpr, "EList"), stdev.coef.lim=c(ebayesStdevMin, ebayesStdevMax)) # Prepare data summary pvalueAdjust <- input$pvalueAdjust summary <- topTable(stats, number=nrow(fit), coef=2, sort.by="none", adjust.method=pvalueAdjust, confint=TRUE) + summary$ID <- NULL names(summary) <- c( "log2 Fold-Change", "CI (low)", "CI (high)", "Average expression", "moderated t-statistics", "p-value", diff --git a/R/analysis_dimReduction_ica.R b/R/analysis_dimReduction_ica.R index 7a9ff4a8..26ab789c 100644 --- a/R/analysis_dimReduction_ica.R +++ b/R/analysis_dimReduction_ica.R @@ -421,7 +421,7 @@ icaServer <- function(input, output, session) { if (selectedDataForICA == "Inclusion levels") dataForICA <- isolate(getInclusionLevels()) else if (grepl("^Gene expression", selectedDataForICA)) - dataForICA <- isolate(getGeneExpression()[[selectedDataForICA]]) + dataForICA <- isolate(getGeneExpression(selectedDataForICA)) else return(NULL) val <- ncol(dataForICA) @@ -440,7 +440,7 @@ icaServer <- function(input, output, session) { dataType <- "Inclusion levels" groups2Type <- "ASevents" } else if (grepl("^Gene expression", selectedDataForICA)) { - dataForICA <- isolate(getGeneExpression()[[selectedDataForICA]]) + dataForICA <- isolate(getGeneExpression(selectedDataForICA)) dataType <- "Gene expression" groups2Type <- "Genes" } else { diff --git a/R/analysis_dimReduction_pca.R b/R/analysis_dimReduction_pca.R index 67b94d72..0bd0a91c 100644 --- a/R/analysis_dimReduction_pca.R +++ b/R/analysis_dimReduction_pca.R @@ -587,7 +587,7 @@ pcaServer <- function(input, output, session) { if (selectedDataForPCA == "Inclusion levels") dataForPCA <- isolate(getInclusionLevels()) else if (grepl("^Gene expression", selectedDataForPCA)) - dataForPCA <- isolate(getGeneExpression()[[selectedDataForPCA]]) + dataForPCA <- isolate(getGeneExpression(selectedDataForPCA)) if (is.null(dataForPCA)) NULL groups <- getSelectedGroups(input, "dataGroups", "Samples", @@ -655,7 +655,7 @@ pcaServer <- function(input, output, session) { dataType <- "Inclusion levels" groups2Type <- "ASevents" } else if (grepl("^Gene expression", selectedDataForPCA)) { - dataForPCA <- isolate(getGeneExpression()[[selectedDataForPCA]]) + dataForPCA <- isolate(getGeneExpression(selectedDataForPCA)) dataType <- "Gene expression" groups2Type <- "Genes" } else { diff --git a/R/analysis_survival.R b/R/analysis_survival.R index 6bfe2245..30b20fbf 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -192,7 +192,7 @@ checkSurvivalInput <- function (session, input, coxph=FALSE) { formulaStr <- NULL } else if (modelTerms == "geCutoff") { isolate({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) gene <- input$gene geCutoff <- input$geCutoff }) @@ -303,14 +303,14 @@ geneExprSurvSet <- function(session, input, output) { # Update available gene choices depending on gene expression data loaded # Reactive avoids updating if the input remains the same updateGeneChoices <- reactive({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) genes <- rownames(geneExpr) updateSelectizeInput(session, "gene", choices=genes, server=TRUE) }) # Update available gene choices depending on gene expression data loaded observe({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) if (!is.null(geneExpr) && input$modelTerms == "geCutoff") { show("loadingGenes") hide("gene") @@ -331,7 +331,7 @@ geneExprSurvSet <- function(session, input, output) { # # Update selected gene based on currently selected splicing event # observe({ - # geneExpr <- getGeneExpression()[[input$geneExpr]] + # geneExpr <- getGeneExpression(input$geneExpr) # event <- getEvent() # if (isolate(input$modelTerms) == "geCutoff" && !is.null(geneExpr) && # !is.null(event)) { @@ -345,7 +345,7 @@ geneExprSurvSet <- function(session, input, output) { # Update gene expression cutoff values based on selected gene # Reactive avoids updating if the input remains the same updateGEcutoffSlider <- reactive({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) ge <- as.numeric(geneExpr[input$gene, ]) updateSliderInput(session, "geCutoff", min=roundMinDown(ge, 2), max=roundMaxUp(ge, 2), value=round(mean(ge), 2)) @@ -353,7 +353,7 @@ geneExprSurvSet <- function(session, input, output) { # Update gene expression cutoff values based on selected gene observeEvent(input$gene, { - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) if (!is.null(geneExpr) && input$gene != "" && input$modelTerms == "geCutoff") { updateGEcutoffSlider() @@ -365,7 +365,7 @@ geneExprSurvSet <- function(session, input, output) { # Update gene information based on selected gene observe({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) gene <- input$gene terms <- input$modelTerms @@ -441,7 +441,7 @@ geneExprSurvSet <- function(session, input, output) { observe({ patients <- getPatientId() - geneExpr <- getGeneExpression()[input$geneExpr] + geneExpr <- getGeneExpression(input$geneExpr) gene <- input$gene if (is.null(patients)) { diff --git a/R/data.R b/R/data.R index 67941582..4568f29d 100644 --- a/R/data.R +++ b/R/data.R @@ -347,10 +347,13 @@ dataUI <- function(id, tab) { #' @param ns Namespace function #' @param title Character: tab title #' @param tableId Character: id of the \code{datatable} -#' @param description Character: description of the table (optional) #' @param columns Character: column names of the \code{datatable} #' @param visCols Boolean: visible columns #' @param data Data frame: dataset of interest +#' @param description Character: description of the table (optional) +#' @param icon Character: list containing an item named \code{symbol} +#' (FontAwesome icon name) and another one named \code{colour} (background +#' colour) #' #' @importFrom shinyBS bsTooltip bsCollapse bsCollapsePanel #' @importFrom DT dataTableOutput @@ -432,10 +435,12 @@ tabDataset <- function(ns, title, tableId, columns, visCols, data, #' @importFrom shiny downloadHandler br #' @importFrom utils write.table #' @importFrom shinyjs show hide +#' @importFrom ggplot2 ylab #' #' @return NULL (this function is used to modify the Shiny session's state) #' @keywords internal createDataTab <- function(index, data, name, session, input, output) { + ns <- session$ns tablename <- paste("table", name, index, sep="-") table <- data[[index]] @@ -463,22 +468,8 @@ createDataTab <- function(index, data, name, session, input, output) { multiPlotId <- paste(tablename, "multiPlot", sep="-") loadingMultiPlotId <- paste(tablename, "loadingMultiPlot", sep="-") - output[[multiPlotId]] <- renderUI({ - # gethc <- function(dfname = "cars") { - # # function to return the chart in a column div - # df <- get(dfname) - # hc <- highchart(height=100) %>% - # hc_title(text = dfname) %>% - # hc_xAxis(title = list(text = names(df)[1])) %>% - # hc_yAxis(title = list(text = names(df)[2])) %>% - # highcharter::hc_add_series_scatter(df[ , 1], df[ , 2]) - # column(width=3, hc) - # } - # - # data <- c("cars", "mtcars", "iris", "Puromycin", "ChickWeight") - # charts <- suppressWarnings(lapply(rep(data, 3), gethc)) - # do.call(tagList, charts) - + + createInfoInterface <- function(output, table) { rows <- attr(table, "rows") rows <- ifelse(!is.null(rows), rows, "rows") cols <- attr(table, "columns") @@ -515,10 +506,68 @@ createDataTab <- function(index, data, name, session, input, output) { settings) } - tags$div(tags$h4(paste(ncol(table), cols)), + plots <- NULL + if (is.null(attr(table, "plots"))) { + isGeneExpr <- !is.null(attr(table, "dataType")) && + attr(table, "dataType") == "Gene expression" + isPSI <- !is.null(attr(table, "dataType")) && + attr(table, "dataType") == "Inclusion levels" + if (isGeneExpr) { + if (is(table, "EList")) table <- table$E + geneExprPerSamplePlot <- plotGeneExprPerSample( + table, sortByMedian=TRUE) + + librarySizePlot <- suppressWarnings( + plotDistribution(log10(colSums(table)), + rugLabels=TRUE, vLine=FALSE) %>% + hc_xAxis(title=list(text="log10(Library sizes)")) %>% + hc_yAxis(title=list(text="Density")) %>% + hc_legend(enabled=FALSE)) + librarySizePlot$x$hc_opts$series[[1]]$color <- NULL + librarySizePlot$x$hc_opts$series[[2]]$marker$fillColor <- NULL + + plots <- list(plot=plotMeanVariance(table), + highchart=geneExprPerSamplePlot, + highchart=librarySizePlot) + } else if (isPSI) { + medianVar <- plotPSI(table, x="median", y="var") + rangeVar <- plotPSI(table, x="range", y="log10(var)") + plots <- list(plot=medianVar, plot=rangeVar) + } + attr(table, "plots") <- plots + } + # lapply(seq(plots), function(i, tablename) { + # FUN <- switch(names(plots)[[i]], + # highchart=renderHighchart, plot=renderPlot) + # id <- paste(tablename, "plot", i, sep="-") + # output[[id]] <- FUN(plots[[i]]) + # }, tablename=attr(table, "tablenameID")) + # + # plotOutputs <- lapply(seq(plots), function(i, tablename) { + # FUN <- switch(names(plots)[[i]], + # highchart=highchartOutput, plot=plotOutput) + # id <- paste(tablename, "plot", i, sep="-") + # FUN(ns(id), height="200px") + # }, tablename=attr(table, "tablenameID")) + + tablename <- attr(table, "tablenameID") + plots <- attr(table, "plots") + + renderedPlots <- lapply(seq(plots), function(i) { + FUN <- switch(names(plots)[[i]], + highchart=renderHighchart, plot=renderPlot) + FUN(plots[[i]]) + }) + + tags$div(tags$h4(paste(ncol(table), cols)), tags$h4(paste(nrow(table), rows)), + # do.call(tagList, plotOutputs), + renderedPlots, extra) - }) + } + + attr(table, "tablenameID") <- tablename + output[[multiPlotId]] <- renderUI(createInfoInterface(output, table)) } #' @rdname appServer diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 951a08f8..93f0990d 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -1,11 +1,11 @@ #' Interface to normalise and filter gene expression -#' +#' #' @param ns Namespace function -#' -#' @importFrom shiny numericInput div column fluidRow tags helpText -#' selectizeInput +#' +#' @importFrom shiny numericInput div column fluidRow tags helpText +#' selectizeInput checkboxInput #' @importFrom shinyjs hidden -#' +#' #' @return HTML elements #' @keywords internal geNormalisationFilteringInterface <- function(ns) { @@ -14,52 +14,59 @@ geNormalisationFilteringInterface <- function(ns) { fluidRow( column(6, numericInput(ns("minMean"), "Min mean >", min=-1, max=100, value=0, width="100%")), - column(6, numericInput(ns("maxMean"), "Max mean <", + column(6, numericInput(ns("maxMean"), "Max mean <", min=-1, max=100, value=100, width="100%"))), fluidRow( - column(6, numericInput(ns("minVar"), "Min variance >", + column(6, numericInput(ns("minVar"), "Min variance >", min=-1, max=100, value=0, width="100%")), - column(6, numericInput(ns("maxVar"), "Max variance <", + column(6, numericInput(ns("maxVar"), "Max variance <", min=-1, max=100, value=100, width="100%"))), fluidRow( - column(6, numericInput(ns("minCounts"), "At least X counts...", + column(6, numericInput(ns("minCounts"), "Min counts", min=0, max=100, value=10, width="100%")), - column(6, numericInput(ns("minSamples"), "...in \u2265 N samples", - min=0, max=100, value=10, width="100%"))), + column(6, numericInput(ns("minTotalCounts"), "Min total counts", + min=0, max=100, value=15, width="100%"))), helpText(textOutput(ns("filteredGenes")))) - + filteringAssistant <- NULL # filteringAssistant <- div( # id=ns("assistantInterface"), - # hr(), h4("Filtering assistant"), + # hr(), h4("Filtering assistant"), # selectizeInput(ns("assistantPlot"), "Plot type", width="100%", - # c("Boxplot of the mean expression"="mean", + # c("Boxplot of the mean expression"="mean", # "Boxplot of the variance expression"="var")), # highchartOutput(ns("filteringAssistant"), height="150px") # ) - + options <- div( id=ns("options"), selectizeInput(ns("geneExpr"), "Gene expression dataset", width="100%", choices=NULL), bsCollapse( + bsCollapsePanel( + tagList(icon("filter"), "Sample filtering"), + value="Sample filtering", + selectizeInput(ns("sampleFilter"), "Samples to discard", + multiple=TRUE, width="100%", + choices=character(0))), bsCollapsePanel( tagList(icon("filter"), "Gene filtering"), value="Filtering", checkboxInput(ns("enableFiltering"), value=TRUE, width="100%", "Enable gene-wise filtering"), filters, filteringAssistant), bsCollapsePanel( - tagList(icon("balance-scale"), "Normalisation"), + tagList(icon("balance-scale"), "Normalisation"), value="Normalisation", - helpText("Calculate normalisation factors to scale the raw", - "library sizes using the function", - tags$code("edgeR::calcNormFactors")), + helpText("Scale raw library sizes using the function", + tags$code("edgeR::calcNormFactors"), ", unless the", + tags$code("quantile"), "method is selected."), selectizeInput( ns("normalisation"), "Normalisation method", width="100%", c("Weighted trimmed mean of M-values (TMM)"="TMM", "Relative log expression (RLE)"="RLE", "Upper-quartile normalisation"="upperquartile", - "No normalisation"="none"), + "No normalisation"="none", + "Quantile"="quantile"), options=list(render=I('{ option: renderGEnormOptions }'))), conditionalPanel( sprintf("input[id='%s'] == '%s'", ns("normalisation"), @@ -67,27 +74,35 @@ geNormalisationFilteringInterface <- function(ns) { sliderInput(ns("upperquartilePercentile"), width="100%", paste("Percentile of the counts used to", "calculate scale factors"), - min=0, max=1, value=0.75, step=0.01))), + min=0, max=1, value=0.75, step=0.01)), + checkboxInput(ns("voom"), width="100%", + "Perform mean-variance modelling using voom"), + helpText("If library sizes are very different,", + tags$code("limma::voom"), "should be more powerful", + "and preferred.")), bsCollapsePanel( - tagList(icon("retweet"), "Compute CPM and log-transform"), + tagList(icon("retweet"), "Compute CPM and log-transform"), value="Log-transformation", - helpText("Compute counts per million (CPM) and log2-transform", - "values using", tags$code("edgeR::cpm")), - checkboxInput( - ns("log2transformation"), value=TRUE, width="100%", - paste("Perform log2 transformation")), + helpText("Compute log2-transformed counts per million", + "(log2CPM) using", tags$code("edgeR::cpm"), "(or", + tags$code("limma::voom"), ", if selected)."), numericInput( ns("priorCount"), value=0.25, width="100%", paste("Average count to add to each observation to avoid", - "zeroes after log-transformation"))))) - + "zeroes after log-transformation")), + helpText())), + checkboxInput( + ns("convertToGeneSymbol"), width="100%", + paste("Replace unambiguous ENSEMBL gene identifiers with their", + "gene symbols"), value=TRUE)) + tagList( uiOutput(ns("modal")), errorDialog("No gene expression data is loaded.", id=ns("missingData"), style="margin: 10px;"), hidden(options), actionButton(ns("loadGeneExpr"), "Load from file..."), - disabled(processButton(ns("processGeneExpr"), + disabled(processButton(ns("processGeneExpr"), "Filter and normalise gene expression"))) } @@ -100,43 +115,63 @@ geNormalisationFilteringUI <- function(id, panel) { } #' Filter and normalise gene expression -#' +#' #' @param geneExpr Matrix or data frame: gene expression #' @param geneFilter Boolean: filtered genes +#' @param method Character: normalisation method, including \code{TMM}, +#' \code{RLE}, \code{upperquartile}, \code{none} or \code{quantile} (see +#' Details) #' @inheritParams edgeR::calcNormFactors #' @param log2transform Boolean: perform log2-transformation? -#' @param priorCount Average count to add to each observation to avoid zeroes +#' @param priorCount Average count to add to each observation to avoid zeroes #' after log-transformation -#' +#' +#' @details \code{edgeR::calcNormFactors} will be used to normalise gene +#' expression if one of the followin methods is set: \code{TMM}, \code{RLE}, +#' \code{upperquartile} or \code{none}. However, \code{limma::voom} will be +#' used for normalisation if \code{performVoom = TRUE} and the selected method +#' is \code{quantile}. +#' #' @importFrom edgeR DGEList calcNormFactors cpm -#' -#' @return Gene expression filtered and normalised +#' @importFrom limma voom +#' +#' @return Filtered and normalised gene expression #' @export -#' -#' @examples +#' +#' @examples #' geneExpr <- readFile("ex_gene_expression.RDS") #' normaliseGeneExpression(geneExpr) -normaliseGeneExpression <- function(geneExpr, geneFilter=NULL, method="TMM", - p=0.75, log2transform=TRUE, - priorCount=0.25) { +normaliseGeneExpression <- function(geneExpr, geneFilter=NULL, method="TMM", + p=0.75, log2transform=TRUE, + priorCount=0.25, performVoom=FALSE) { updateProgress("Processing gene expression", divisions=3) - + updateProgress("Filtering gene expression") if (is.null(geneFilter)) geneFilter <- TRUE else if (!any(geneFilter)) return(NULL) - geneExprNorm <- DGEList(geneExpr[geneFilter, , drop=FALSE]) - + + geneExpr <- DGEList(geneExpr) + geneExprNorm <- geneExpr[geneFilter, , keep.lib.sizes=TRUE] + updateProgress("Normalising gene expression") - geneExprNorm <- calcNormFactors(geneExprNorm, method=method, p=p) - geneExprNorm <- cpm(geneExprNorm, log=log2transform, - prior.count=priorCount) - + if (!performVoom && method == "quantile") method <- "none" + if (method != "quantile") + geneExprNorm <- calcNormFactors(geneExprNorm, method=method, p=p) + + if (!performVoom) { + geneExprNorm <- cpm(geneExprNorm, log=log2transform, + prior.count=priorCount) + } else { + norm <- if (method == "quantile") "quantile" else "none" + geneExprNorm <- voom(geneExprNorm, normalize.method=norm) + } + updateProgress("Preparing gene expression data") - geneExprNorm <- data.frame(geneExprNorm) + if (!is(geneExprNorm, "EList")) geneExprNorm <- data.frame(geneExprNorm) colnames(geneExprNorm) <- colnames(geneExpr) - + # Pass attributes from original gene expression table (except for names) - notNames <- !names(attributes(geneExpr)) %in% + notNames <- !names(attributes(geneExpr)) %in% c(names(attributes(geneExprNorm)), "names", "row.names", "class") attributes(geneExprNorm) <- c(attributes(geneExprNorm), attributes(geneExpr)[notNames]) @@ -144,16 +179,16 @@ normaliseGeneExpression <- function(geneExpr, geneFilter=NULL, method="TMM", } #' Set of functions to load splicing quantification -#' +#' #' @inherit geNormalisationFilteringServer -#' +#' #' @importFrom shiny tags #' @importFrom shinyBS bsPopover #' #' @keywords internal loadGeneExpressionSet <- function(session, input, output) { ns <- session$ns - + # Show modal for loading gene expression data observeEvent(input$loadGeneExpr, { infoModal( @@ -162,55 +197,55 @@ loadGeneExpressionSet <- function(session, input, output) { uiOutput(ns("alertGeneExpr")), footer=processButton(ns("loadCustomGE"), "Load quantification")) }) - + observeEvent(input$loadGeneExpr, { prepareFileBrowser(session, input, "customGeneExpr") }, once=TRUE) - + observeEvent(input$loadCustomGE, loadGeneExpression()) - + # Load alternative splicing quantification loadGeneExpression <- reactive({ time <- startProcess("loadGeneExpr") - + updateProgress("Wait a moment", divisions=2) updateProgress("Loading gene expression") - + allFormats <- loadFileFormats() - formats <- allFormats[sapply(allFormats, "[[", + formats <- allFormats[sapply(allFormats, "[[", "dataType") == "Gene expression"] - + geneExpr <- tryCatch(parseValidFile(input$customGeneExpr, formats), warning=return, error=return) if (is(geneExpr, "error")) { if (geneExpr$message == paste("'file' must be a character string", "or connection")) - errorAlert(session, title="No file provided", + errorAlert(session, title="No file provided", "Please provide a file", alertId="alertGeneExpr", caller="Gene expression normalisation and filtering") else - errorAlert(session, title="An error was raised", + errorAlert(session, title="An error was raised", geneExpr$message, alertId="alertGeneExpr", caller="Gene expression normalisation and filtering") } else if (is(geneExpr, "warning")) { - warningAlert(session, title="A warning was raised", + warningAlert(session, title="A warning was raised", geneExpr$message, alertId="alertGeneExpr", caller="Gene expression normalisation and filtering") } else { removeAlert(output, "alertGeneExpr") - + if ( is.null(getData()) ) { name <- file_path_sans_ext( basename(input$customGeneExpr) ) name <- gsub(" Gene expression.*$", "", name) if (name == "") name <- "Unnamed" - + data <- setNames(list(list("Gene expression"=geneExpr)), name) data <- processDatasetNames(data) setData(data) setCategory(name) - + samples <- colnames(geneExpr) - parsed <- parseTcgaSampleInfo(samples) + parsed <- parseTcgaSampleInfo(samples) if ( !is.null(parsed) ) setSampleInfo(parsed) } else { name <- renameDuplicated("Gene expression", @@ -223,20 +258,165 @@ loadGeneExpressionSet <- function(session, input, output) { }) } +#' Convert gene identifiers +#' +#' @param annotation OrgDb: genome wide annotation for an organism, e.g. +#' \code{org.Hs.eg.db} +#' @param genes Character: genes to be converted +#' @param key Character: type of identifier used, e.g. \code{ENSEMBL}; read +#' \code{?AnnotationDbi::columns} +#' @param target Character: type of identifier to convert to; read +#' \code{?AnnotationDbi::columns} +#' @param ignoreDuplicatedTargets Boolean: if \code{TRUE}, identifiers that +#' share targets with other identifiers will not be converted +#' +#' @importFrom AnnotationDbi select +#' @importFrom data.table data.table +#' +#' @return Character vector of the respective targets of gene identifiers. The +#' previous identifiers remain other identifiers have the same target (in case +#' \code{ignoreDuplicatedTargets = TRUE}) or if no target was found. +#' @export +#' +#' @examples +#' if ( require("org.Hs.eg.db") ) { +#' columns(org.Hs.eg.db) +#' +#' genes <- c("ENSG00000012048", "ENSG00000083093", "ENSG00000141510", +#' "ENSG00000051180") +#' convertGeneIdentifiers(org.Hs.eg.db, genes, +#' key="ENSEMBL", target="SYMBOL") +#' } +convertGeneIdentifiers <- function(annotation, genes, key="ENSEMBL", + target="SYMBOL", + ignoreDuplicatedTargets=TRUE) { + stopifnot(is(annotation, "OrgDb")) + + if (key == "ENSEMBL") { + # Remove ENSEMBL identifiers + genesClean <- gsub("\\..*", "", genes) + # Keep version for gene identifier containing the string "PAR_Y" + par_y <- grep("PAR", genes) + genesClean[par_y] <- genes[par_y] + } else { + genesClean <- genes + } + + match <- tryCatch( + suppressMessages(select(annotation, genesClean, target, key)), + error=return) + + if (is(match, "error")) return(setNames(genes, genes)) + match <- data.table(match, key=key) + + # Ignore missing values + match <- match[!is.na(match[[target]]), ] + + # Collapse genes with more than one matching target + colnames(match)[2] <- "target" + collapsed <- match[ + , list(target=paste(unique(target), collapse="/")), by=key] + + if (ignoreDuplicatedTargets) { + # Ignore genes sharing the same target + geneTargets <- collapsed[["target"]] + collapsed <- collapsed[ + !geneTargets %in% unique(geneTargets[duplicated(geneTargets)]), ] + } + + # Replace identifiers by their matching targets (if possible) + converted <- collapsed[["target"]][match(genesClean, collapsed[[key]])] + genes[!is.na(converted)] <- converted[!is.na(converted)] + names(genes) <- genesClean + return(genes) +} + +#' Filter genes based on their expression +#' +#' @param geneExpr Data frame or matrix: gene expression +#' @param minMean Numeric: minimum of read count mean per gene +#' @param maxMean Numeric: maximum of read count mean per gene +#' @param minVar Numeric: minimum of read count variance per gene +#' @param maxVar Numeric: maximum of read count variance per gene +#' @param minCounts Numeric: minimum number of read counts per gene for at least +#' some samples +#' @param minTotalCounts Numeric: minimum total number of read counts per gene +#' +#' @importFrom edgeR filterByExpr +#' +#' @return Boolean vector indicating which genes have sufficiently large counts +#' @export +filterGeneExpr <- function(geneExpr, minMean=0, maxMean=Inf, minVar=0, + maxVar=Inf, minCounts=10, minTotalCounts=15) { + geneExprMean <- rowMeans(geneExpr) + geneExprVar <- rowVars(geneExpr) + + varMeanFilter <- geneExprMean > minMean & geneExprMean < maxMean & + geneExprVar > minVar & geneExprVar < maxVar + + lowCountFilter <- filterByExpr(geneExpr[varMeanFilter, ], + min.count=minCounts, + min.total.count=minTotalCounts) + filteredGenes <- varMeanFilter + filteredGenes[names(lowCountFilter[!lowCountFilter])] <- FALSE + return(filteredGenes) +} + +#' Plot distribution of gene expression per sample +#' +#' @param geneExpr Data frame or matrix: gene expression +#' @inheritDotParams renderBoxplot +#' +#' @importFrom highcharter %>% hc_yAxis +#' +#' @return Gene expression distribution plots +#' @export +#' +#' @examples +#' df <- data.frame(geneA=c(2, 4, 5), +#' geneB=c(20, 3, 5), +#' geneC=c(5, 10, 21)) +#' colnames(df) <- paste("Sample", 1:3) +#' plotGeneExprPerSample(df) +plotGeneExprPerSample <- function(geneExpr, ...) { + if (is(geneExpr, "EList")) geneExpr <- geneExpr$E + renderBoxplot(geneExpr, ...) %>% + hc_yAxis(title=list(text="Gene expression")) +} + +#' Render mean-variance plot +#' +#' @param data Data frame or matrix: gene expression or junction quantification +#' +#' @return Mean-variance plot +#' @export +plotMeanVariance <- function(data) { + df <- data.frame(Mean=rowMeans(data), Variance=rowVars(data)) + ggplot(df, aes_string("Mean", "Variance^(1/4)")) + + geom_point() + + ggtitle("Mean-variance plot") + + ylab("Square Root of the Standard Deviation") +} + +#' @export +setMethod("colSums", signature="EList", function(x, na.rm=FALSE, dims=1) { + colSums(x$E, na.rm=na.rm, dims=dims) +}) + #' @rdname appServer -#' +#' #' @importFrom shiny reactive observeEvent helpText removeModal #' updateNumericInput #' @importFrom tools file_path_sans_ext #' @importFrom shinyjs enable disable hide show #' @importFrom data.table fread #' @importFrom highcharter hcboxplot hc_plotOptions hc_xAxis hc_chart -#' +#' #' @keywords internal geNormalisationFilteringServer <- function(input, output, session) { ns <- session$ns observeEvent(input$missing, missingDataGuide("Gene expression")) - + # Warn user if gene expression is not loaded observe({ if (is.null(getGeneExpression())) { @@ -249,7 +429,7 @@ geNormalisationFilteringServer <- function(input, output, session) { hide("missingData") } }) - + # Update available gene expression data according to loaded files observe({ geneExpr <- getGeneExpression() @@ -263,90 +443,96 @@ geNormalisationFilteringServer <- function(input, output, session) { choices=c("No gene expression data loaded"="")) } }) - - # Update label of numeric input according to input itself (more intuitive) - observeEvent(input$minCounts, { - label <- sprintf("At least %s counts...", input$minCounts) - updateNumericInput(session, "minCounts", label=label) - }) - - observeEvent(input$minSamples, { - label <- sprintf("...in \u2265 %s samples", input$minSamples) - updateNumericInput(session, "minSamples", label=label) - }) - + getFilter <- reactive({ geneExpr <- isolate(input$geneExpr) if (is.null(geneExpr) || geneExpr == "") return(NULL) - geneExpr <- isolate(getGeneExpression()[[geneExpr]]) - - minMean <- input$minMean - maxMean <- input$maxMean - minVar <- input$minVar - maxVar <- input$maxVar - minCounts <- input$minCounts - minSamples <- input$minSamples - - if (is.na(minMean) || is.na(maxMean) || - is.na(minVar) || is.na(maxVar) || - is.na(minCounts) || is.na(minSamples)) { + geneExpr <- isolate(getGeneExpression(geneExpr)) + + minMean <- input$minMean + maxMean <- input$maxMean + minVar <- input$minVar + maxVar <- input$maxVar + minCounts <- input$minCounts + minTotalCounts <- input$minTotalCounts + + sampleFilter <- input$sampleFilter + + if (is.na(minMean) || is.na(maxMean) || + is.na(minVar) || is.na(maxVar) || + is.na(minCounts) || is.na(minTotalCounts)) { return(NULL) + } else { + if (!is.null(sampleFilter) && sampleFilter != "") { + samplesToKeep <- !colnames(geneExpr) %in% sampleFilter + geneExpr <- geneExpr[ , samplesToKeep] + } + + filtered <- filterGeneExpr(geneExpr, minMean, maxMean, minVar, + maxVar, minCounts, minTotalCounts) + return(filtered) } - - # Check if min. counts are available in at least N samples - checkCounts <- rowSums(geneExpr >= minCounts) >= minSamples - - geneExprMean <- rowMeans(geneExpr) - geneExprVar <- rowVars(geneExpr) - filter <- geneExprMean > minMean & geneExprMean < maxMean & - geneExprVar > minVar & geneExprVar < maxVar & checkCounts - return(filter) }) - + output$filteredGenes <- renderText({ geneExpr <- input$geneExpr if (is.null(geneExpr) || geneExpr == "") return(NULL) - geneExpr <- isolate(getGeneExpression()[[geneExpr]]) - + geneExpr <- isolate(getGeneExpression(geneExpr)) + filter <- sum(getFilter()) total <- nrow(geneExpr) ratio <- filter/total * 100 - + if (input$enableFiltering) { - msg <- sprintf("Selecting %s genes (%s%%) out of %s.", + msg <- sprintf("Selecting %s genes (%s%%) out of %s.", filter, round(ratio), total) } else { msg <- sprintf("Selecting all %s genes.", total) } return(msg) }) - + + # Update sample filtering options + observeEvent(input$geneExpr, { + geneExpr <- isolate(input$geneExpr) + if (is.null(geneExpr) || geneExpr == "") return(NULL) + geneExpr <- isolate(getGeneExpression(geneExpr)) + + updateSelectizeInput( + session, "sampleFilter", server=TRUE, + choices=colnames(geneExpr), + options=list(placeholder="Select samples to discard", + plugins=list("remove_button"))) + }) + # Update filtering options based on selected gene expression data observeEvent(input$geneExpr, { geneExpr <- isolate(input$geneExpr) if (is.null(geneExpr) || geneExpr == "") return(NULL) - geneExpr <- isolate(getGeneExpression()[[geneExpr]]) - + geneExpr <- isolate(getGeneExpression(geneExpr)) + + sampleFilter <- isolate(input$sampleFilter) + if (!is.null(sampleFilter) && sampleFilter != "") { + samplesToKeep <- !colnames(geneExpr) %in% sampleFilter + geneExpr <- geneExpr[ , samplesToKeep] + } + # Update mean range geneExprMean <- rowMeans(geneExpr) maxMean <- ceiling( max(geneExprMean, na.rm=TRUE) ) updateNumericInput(session, "minMean", max=maxMean) updateNumericInput(session, "maxMean", max=maxMean, value=maxMean) - + # Update variance range geneExprVar <- rowVars(geneExpr) maxVar <- ceiling( max(geneExprVar, na.rm=TRUE) ) updateNumericInput(session, "minVar", max=maxVar) updateNumericInput(session, "maxVar", max=maxVar, value=maxVar) - - # Update minimum samples based on available samples - updateNumericInput(session, "minSamples", - value=min(ncol(geneExpr)/2, 10)) - + # output$filteringAssistant <- renderHighchart({ # type <- input$assistantPlot # if (type == "") return(NULL) - # + # # filter <- getFilter() # if (type == "mean") { # arg <- geneExprMean[filter] @@ -355,7 +541,7 @@ geNormalisationFilteringServer <- function(input, output, session) { # arg <- geneExprVar[filter] # description <- "Variance per gene" # } - # + # # hc <- tryCatch({ # hcboxplot(arg) %>% # hc_chart(zoomType="y") %>% @@ -364,14 +550,14 @@ geNormalisationFilteringServer <- function(input, output, session) { # hc_yAxis(title=list(text=description)) %>% # hc_plotOptions(series=list(animation=FALSE)) # }, error=return, warning=return) - # + # # if (is(hc, "error") || is(hc, "warning")) # return(NULL) # else # return(hc) # }) }) - + # Disable interface for gene filtering observeEvent(input$enableFiltering, { filter <- input$enableFiltering @@ -383,68 +569,114 @@ geNormalisationFilteringServer <- function(input, output, session) { # hide("assistantInterface", anim=TRUE) } }) - + # Disable option to add counts to observations if not log2-transforming observe({ - filter <- input$log2transformation - if (filter) { - enable("priorCount") - # show("assistantInterface", anim=TRUE) - } else { - disable("priorCount") - # hide("assistantInterface", anim=TRUE) - } + # filter <- input$log2transformation + # if (filter) { + enable("priorCount") + # show("assistantInterface", anim=TRUE) + # } else { + # disable("priorCount") + # hide("assistantInterface", anim=TRUE) + # } }) - + # Filter and normalise gene expression observeEvent(input$processGeneExpr, { time <- startProcess("processGeneExpr") - + isolate({ - geneExpr <- getGeneExpression()[[input$geneExpr]] + geneExpr <- getGeneExpression(input$geneExpr) method <- input$normalisation percentile <- input$upperquartilePercentile + sampleFilter <- input$sampleFilter filter <- input$enableFiltering - log2transform <- input$log2transformation priorCount <- input$priorCount - - minMean <- input$minMean - maxMean <- input$maxMean - minVar <- input$minVar - maxVar <- input$maxVar - minCounts <- input$minCounts - minSamples <- input$minSamples + + minMean <- input$minMean + maxMean <- input$maxMean + minVar <- input$minVar + maxVar <- input$maxVar + minCounts <- input$minCounts + minTotalCounts <- input$minTotalCounts + + voom <- input$voom + + convertToGeneSymbol <- input$convertToGeneSymbol }) - - if (filter) + + if (!is.null(sampleFilter) && sampleFilter != "") { + samplesToKeep <- !colnames(geneExpr) %in% sampleFilter + geneExpr <- geneExpr[ , samplesToKeep] + } + + if (filter) { geneFilter <- getFilter() - else + } else { geneFilter <- NULL - + } + geneExprNorm <- normaliseGeneExpression( - geneExpr, geneFilter, method, percentile, log2transform, priorCount) - + geneExpr, geneFilter, method, percentile, log2transform=TRUE, + priorCount, performVoom=voom) + + if (convertToGeneSymbol) { + if (require(org.Hs.eg.db)) { + rownames(geneExprNorm) <- convertGeneIdentifiers( + org.Hs.eg.db, rownames(geneExprNorm)) + } else { + warning(paste( + "Gene identifiers not converted:", + "Install 'org.Hs.eg.db' to convert human genes")) + } + } + attr(geneExprNorm, "filename") <- NULL + if (!is.null(sampleFilter) && sampleFilter != "") { + sampleFilterText <- paste(sampleFilter, collapse=", ") + } else { + sampleFilterText <- "None" + } + sampleFilterSettings <- c("Discarded samples"=sampleFilterText) + if (filter) { geneFilterSettings <- c( "Gene filtering"="Enabled", "Minimum mean >"=minMean, "Maximum mean <"=maxMean, "Minimum variance >"=minVar, "Maximum variance <"=maxVar, - "At least X counts..."=paste("X =", minCounts), - "...in >= Y samples"=paste("Y = ", minSamples)) + "Minimum counts for at least some samples"=minCounts, + "Minimum total counts across samples"=minTotalCounts) } else { geneFilterSettings <- c("Gene filtering"="Disabled") } - + + if (!voom) { + avgCountPerObservationText <- priorCount + names(avgCountPerObservationText) <- c( + "Average count added per observation") + } else { + avgCountPerObservationText <- NULL + } + + convertToGeneSymbolText <- if (convertToGeneSymbol) "Yes" else "no" + names(convertToGeneSymbolText) <- paste( + "Replace unambiguous ENSEMBL gene identifiers with their gene", + "symbols") + settings <- c(list( "Original gene expression (file)"=attr(geneExpr, "filename"), "Original gene expression (label)"=isolate(input$geneExpr) - ), geneFilterSettings, list( + ), sampleFilterSettings, geneFilterSettings, list( "Normalisation method"=method, - "Log2-transformed"=if (log2transform) "Yes" else "No", - "Average count added per observation"=priorCount)) + "Mean-variance modelling (voom)"=if (voom) "Yes" else "No", + "Log2-transformation"="Yes"), + avgCountPerObservationText, + convertToGeneSymbolText) attr(geneExprNorm, "settings") <- settings attr(geneExprNorm, "icon") <- list(symbol="cogs", colour="green") + attr(geneExprNorm, "description") <- "Gene expression (normalised)" + attr(geneExprNorm, "dataType") <- "Gene expression" setNormalisedGeneExpression(geneExprNorm) endProcess("processGeneExpr", time=time) diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index 2975e5b1..b7899dcc 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -1,8 +1,8 @@ #' List the alternative splicing annotation files available -#' +#' #' @return Named character vector with splicing annotation files available #' @export -#' +#' #' @examples #' listSplicingAnnotations() listSplicingAnnotations <- function() { @@ -14,14 +14,14 @@ listSplicingAnnotations <- function() { "annotationHub_alternativeSplicingEvents.hg38_V2.rda") } -#' List alternative splicing annotation files available, as well as custom +#' List alternative splicing annotation files available, as well as custom #' annotation -#' +#' #' @param ... Custom annotation loaded -#' -#' @return Named character vector with splicing annotation files available#' +#' +#' @return Named character vector with splicing annotation files available#' #' @keywords internal -#' +#' #' @examples #' psichomics:::listAllAnnotations() listAllAnnotations <- function(...) { @@ -31,25 +31,25 @@ listAllAnnotations <- function(...) { } #' Interface to quantify alternative splicing -#' +#' #' @param ns Namespace function -#' +#' #' @importFrom shiny tagList uiOutput selectizeInput numericInput actionButton #' @importFrom shinyBS bsTooltip #' @importFrom shinyjs hidden disabled -#' +#' #' @return HTML elements #' @keywords internal inclusionLevelsInterface <- function(ns) { eventTypes <- getSplicingEventTypes() names(eventTypes) <- sprintf("%s (%s)", names(eventTypes), eventTypes) - + filterGenesSelectize <- selectizeInput( ns("filterGenes"), label=NULL, selected=NULL, multiple=TRUE, width="100%", choices=c("Type to search for genes..."=""), options=list( # Allow to add new items create=TRUE, createOnBlur=TRUE, plugins=list("remove_button"))) - + options <- div( id=ns("options"), selectizeInput(ns("junctionQuant"), choices=NULL, width = "100%", @@ -60,13 +60,19 @@ inclusionLevelsInterface <- function(ns) { selected = c("SE", "MXE", "A5SS", "A3SS", "AFE", "ALE"), choices=eventTypes, multiple = TRUE, width = "100%", options=list(plugins=list("remove_button"))), - numericInput(ns("minReads"), width = "100%", + numericInput(ns("minReads"), width = "100%", div("Minimum read counts' threshold", icon("question-circle")), value = 10), bsCollapse( + bsCollapsePanel( + tagList(icon("filter"), "Sample filtering"), + value="Sample filtering", + selectizeInput(ns("sampleFilter"), "Samples to discard", + multiple=TRUE, width="100%", + choices=character(0))), bsCollapsePanel( title=tagList(icon("filter"), - "Filter splicing events by genes"), + "Filter splicing events by genes"), value="Filter by genes", radioButtons( ns("filter"), NULL, @@ -84,7 +90,7 @@ inclusionLevelsInterface <- function(ns) { div(id=ns("geneLoadingIcon"), style="position: relative;", # div(class="fa fa-spinner fa-spin", - # style="position:absolute;", + # style="position:absolute;", # style="right:6px;", # style="bottom: 24px;", style="z-index: 2;")), helpText("Presented genes are based on the selected", @@ -95,12 +101,40 @@ inclusionLevelsInterface <- function(ns) { placeholder="No file selected"), helpText("Provide a file with gene symbols separated by a", "space, comma, tab or new line. For instance: ", - tags$code("BRCA1, BRAF, ABL"))))), - bsTooltip(ns("minReads"), placement = "right", + tags$code("BRCA1, BRAF, ABL")))), + bsCollapsePanel( + tagList(icon("filter"), "PSI filtering"), value="PSI filtering", + checkboxInput( + ns("enablePSIfiltering"), + "Filter splicing events based on their PSI values", + value=FALSE), + fluidRow( + column(6, numericInput( + ns("minMedian"), "Min median >=", + min=0, max=1, value=0, width="100%")), + column(6, numericInput( + ns("maxMedian"), "Max median <=", + min=0, max=1, value=1, width="100%"))), + fluidRow( + column(6, numericInput( + ns("minLogVar"), "Min log10(variance) >=", + min=-10, max=0, value=-10, width="100%")), + column(6, numericInput( + ns("maxLogVar"), "Max log10(variance) <=", + min=-10, max=0, value=0, width="100%"))), + fluidRow( + column(6, numericInput( + ns("minRange"), "Min range >=", + min=0, max=1, value=0, width="100%")), + column(6, numericInput( + ns("maxRange"), "Max range <=", + min=0, max=1, value=1, width="100%"))) + )), + bsTooltip(ns("minReads"), placement = "right", options = list(container = "body"), paste("Discard alternative splicing quantified using a", "number of reads below this threshold."))) - + tagList( uiOutput(ns("modal")), helpText("Exon inclusion levels are measured from exon-exon junction", @@ -122,36 +156,36 @@ inclusionLevelsUI <- function(id, panel) { } #' Quantify alternative splicing events -#' +#' #' @param annotation List of data frames: annotation for each alternative #' splicing event type #' @param junctionQuant Data frame: junction quantification #' @param eventType Character: splicing event types to quantify #' @param minReads Integer: discard alternative splicing quantified using a #' number of reads below this threshold -#' @param genes Character: gene symbols for which the splicing quantification -#' of associated splicing events is performed (by default, all splicing events +#' @param genes Character: gene symbols for which the splicing quantification +#' of associated splicing events is performed (by default, all splicing events #' undergo splicing quantification) -#' +#' #' @importFrom fastmatch %fin% -#' +#' #' @return Data frame with the quantification of the alternative splicing events #' @export -#' -#' @examples +#' +#' @examples #' # Calculate PSI for skipped exon (SE) and mutually exclusive (MXE) events #' annot <- readFile("ex_splicing_annotation.RDS") #' junctionQuant <- readFile("ex_junctionQuant.RDS") -#' +#' #' psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) -quantifySplicing <- function(annotation, junctionQuant, - eventType=c("SE", "MXE", "ALE", "AFE", "A3SS", - "A5SS"), +quantifySplicing <- function(annotation, junctionQuant, + eventType=c("SE", "MXE", "ALE", "AFE", "A3SS", + "A5SS"), minReads=10, genes=NULL) { if (!is.null(genes)) { # Filter for given gene symbols filterByGenes <- function(df, genes) { - # Check which genes are desired by unlisting them all (register the + # Check which genes are desired by unlisting them all (register the # respective event's index for each gene) allGenes <- df$Gene valid <- as.vector(unlist(allGenes)) %fin% genes @@ -159,38 +193,38 @@ quantifySplicing <- function(annotation, junctionQuant, eventIndex <- rep(seq(allGenes), eventGenes) return(df[unique(eventIndex[valid]), ]) } - + genes <- unique(genes) annotation <- lapply(annotation, filterByGenes, genes) } - + # Convert data frame to matrix if needed (faster) mJunctionQuant <- junctionQuant if (!is(mJunctionQuant, "matrix")) mJunctionQuant <- as.matrix(junctionQuant) - + psi <- NULL for (acronym in eventType) { eventTypes <- getSplicingEventTypes() type <- names(eventTypes)[[match(acronym, eventTypes)]] thisAnnot <- annotation[[type]] - updateProgress("Calculating inclusion levels", type, value=acronym, + updateProgress("Calculating inclusion levels", type, value=acronym, max=length(eventType)) - + if (!is.null(thisAnnot) && nrow(thisAnnot) > 0) { psi <- rbind(psi, calculateInclusionLevels( acronym, mJunctionQuant, thisAnnot, minReads)) } } - + # Convert matrix to data frame colns <- colnames(psi) psi <- data.frame(psi) colnames(psi) <- colns - + if (is.null(psi)) psi <- data.frame(NULL) psi <- addObjectAttrs( - psi, rowNames=TRUE, + psi, rowNames=TRUE, description="PSI values per alternative splicing events", dataType="Inclusion levels", tablename="Inclusion levels", rows="alternative splicing events", columns="samples") @@ -198,16 +232,16 @@ quantifySplicing <- function(annotation, junctionQuant, } #' Load alternative splicing annotation from \code{AnnotationHub} -#' +#' #' @param annotation Character: annotation to load -#' +#' #' @importFrom AnnotationHub AnnotationHub query -#' +#' #' @return List of data frames containing the alternative splicing annotation #' per event type #' @export -#' -#' @examples +#' +#' @examples #' human <- listSplicingAnnotations()[[1]] #' \dontrun{ #' annot <- loadAnnotation(human) @@ -220,10 +254,10 @@ loadAnnotation <- function(annotation) { } #' Set of functions to load a custom alternative splicing annotation -#' +#' #' @importFrom shiny tags fileInput #' @inherit inclusionLevelsServer -#' +#' #' @keywords internal loadCustomSplicingAnnotationSet <- function(session, input, output) { # Show modal for loading custom splicing annotation @@ -231,18 +265,18 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { ns <- session$ns if (input$annotation == "loadAnnotation") { url <- "http://rpubs.com/nuno-agostinho/preparing-AS-annotation" - - updateSelectizeInput(session, "annotation", + + updateSelectizeInput(session, "annotation", selected=listSplicingAnnotations()) infoModal(session, "Load alternative splicing annotation", helpText("To learn how to create and load custom", - "alternative splicing annotations,", - tags$a(href=url, target="_blank", + "alternative splicing annotations,", + tags$a(href=url, target="_blank", "click here.")), fileInput(ns("customAnnot"), "Choose RDS file", accept=".rds"), - selectizeInput(ns("customSpecies"), "Species", - choices="Human", + selectizeInput(ns("customSpecies"), "Species", + choices="Human", options=list(create=TRUE)), selectizeInput(ns("customAssembly"), "Assembly", choices=c("hg19", "hg38"), @@ -252,7 +286,7 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { class="btn-primary")) } }) - + # Load custom splicing annotation observeEvent(input$loadCustom, { customAnnot <- input$customAnnot @@ -277,18 +311,18 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { } }) } - + #' Set of functions to load splicing quantification -#' +#' #' @inherit inclusionLevelsServer -#' +#' #' @importFrom shiny tags #' @importFrom shinyBS bsPopover -#' +#' #' @keywords internal loadSplicingQuantificationSet <- function(session, input, output) { ns <- session$ns - + # Show modal for loading alternative splicing quantification observeEvent(input$loadIncLevels, { infoModal( @@ -298,53 +332,53 @@ loadSplicingQuantificationSet <- function(session, input, output) { uiOutput(ns("alertIncLevels")), footer=processButton(ns("loadASquant"), "Load quantification")) }) - + observeEvent(input$loadIncLevels, { prepareFileBrowser(session, input, "customASquant") }, once=TRUE) - + # Load alternative splicing quantification loadSplicing <- reactive({ time <- startProcess("loadIncLevels") - + startProgress("Wait a moment", divisions=2) updateProgress("Loading alternative splicing quantification") - + allFormats <- loadFileFormats() - formats <- allFormats[sapply(allFormats, "[[", + formats <- allFormats[sapply(allFormats, "[[", "dataType") == "Inclusion levels"] - + psi <- tryCatch(parseValidFile(input$customASquant, formats), warning=return, error=return) if (is(psi, "error")) { if (psi$message == paste("'file' must be a character string or", "connection")) - errorAlert(session, title="No file provided", + errorAlert(session, title="No file provided", "Please provide a file.", alertId="alertIncLevels", caller="Alternative splicing quantification") else - errorAlert(session, title="An error was raised", + errorAlert(session, title="An error was raised", psi$message, alertId="alertIncLevels", caller="Alternative splicing quantification") } else if (is(psi, "warning")) { - warningAlert(session, title="A warning was raised", + warningAlert(session, title="A warning was raised", psi$message, alertId="alertIncLevels", caller="Alternative splicing quantification") } else { removeAlert(output, "alertIncLevels") - + if ( is.null(getData()) ) { name <- file_path_sans_ext( basename(input$customASquant) ) name <- gsub(" Inclusion levels.*$", "", name) if (name == "") name <- "Unnamed" - + data <- setNames(list(list("Inclusion levels"=psi)), name) data <- processDatasetNames(data) setData(data) setCategory(name) - + samples <- colnames(psi) - parsed <- parseTcgaSampleInfo(samples) + parsed <- parseTcgaSampleInfo(samples) if ( !is.null(parsed) ) setSampleInfo(parsed) } else { setInclusionLevels(psi) @@ -355,7 +389,7 @@ loadSplicingQuantificationSet <- function(session, input, output) { } endProcess("loadIncLevels", time) }) - + # Show warnings if needed before loading splicing quantification observeEvent(input$loadASquant, { if (!is.null(getInclusionLevels())) { @@ -381,14 +415,14 @@ loadSplicingQuantificationSet <- function(session, input, output) { loadSplicing() } }) - + # Replace previous splicing quantification observeEvent(input$replace2, { setGroups("Samples", NULL) setGroups("AS events", NULL) loadSplicing() }) - + # Discard differential analyses and replace previous splicing quantification observeEvent(input$discard2, { setDifferentialSplicing(NULL) @@ -400,11 +434,11 @@ loadSplicingQuantificationSet <- function(session, input, output) { } #' Read custom or remote annotation -#' +#' #' @inherit inclusionLevelsServer #' @param annotation Character: chosen annotation #' @param showProgress Boolean: show progress? FALSE by default -#' +#' #' @keywords internal readAnnot <- function(session, annotation, showProgress=FALSE) { annot <- NULL @@ -416,7 +450,7 @@ readAnnot <- function(session, annotation, showProgress=FALSE) { if (showProgress) updateProgress("Downloading alternative splicing annotation") annot <- loadAnnotation(annotation) - + # Set species and assembly version allAnnot <- listSplicingAnnotations() annotID <- names(allAnnot)[match(annotation, allAnnot)] @@ -427,37 +461,51 @@ readAnnot <- function(session, annotation, showProgress=FALSE) { } #' Set of functions to quantify alternative splicing -#' +#' #' @importFrom shiny tags #' @inherit inclusionLevelsServer #' @keywords internal quantifySplicingSet <- function(session, input) { ns <- session$ns - - + + # Calculate inclusion levels calcSplicing <- reactive({ eventType <- input$eventType minReads <- input$minReads annotation <- input$annotation + # PSI filtering options + enablePSIfiltering <- input$enablePSIfiltering + minMedian <- input$minMedian + if (is.na(minMedian)) minMedian <- -Inf + maxMedian <- input$maxMedian + if (is.na(maxMedian)) maxMedian <- Inf + minLogVar <- input$minLogVar + if (is.na(minLogVar)) minLogVar <- -Inf + maxLogVar <- input$maxLogVar + if (is.na(maxLogVar)) maxLogVar <- Inf + minRange <- input$minRange + if (is.na(minRange)) minRange <- -Inf + maxRange <- input$maxRange + if (is.na(maxRange)) maxRange <- Inf + if (is.null(eventType) || is.null(minReads) || is.null(annotation)) { return(NULL) - } else { - if (input$junctionQuant == "") { - errorModal(session, "Select junction quantification", - "Select a junction quantification dataset", - caller="Alternative splicing quantification") - endProcess("calcIncLevels") - return(NULL) - } + } else if (input$junctionQuant == "") { + errorModal(session, "Select junction quantification", + "Select a junction quantification dataset", + caller="Alternative splicing quantification") + endProcess("calcIncLevels") + return(NULL) } + time <- startProcess("calcIncLevels") startProgress("Quantifying alternative splicing", divisions=4) # Read annotation annot <- readAnnot(session, annotation, showProgress=TRUE) junctionQuant <- getJunctionQuantification()[[input$junctionQuant]] - + # Filter alternative splicing events based on their genes filter <- NULL if (input$filter == "select") { @@ -475,12 +523,19 @@ quantifySplicingSet <- function(session, input) { filter <- NULL } } - + + # Discard samples + sampleFilter <- input$sampleFilter + if (!is.null(sampleFilter) && sampleFilter != "") { + samplesToKeep <- !colnames(junctionQuant) %in% sampleFilter + junctionQuant <- junctionQuant[ , samplesToKeep] + } + # Quantify splicing with splicing annotation and junction quantification updateProgress("Calculating inclusion levels") - psi <- quantifySplicing(annot, junctionQuant, eventType, minReads, + psi <- quantifySplicing(annot, junctionQuant, eventType, minReads, genes=filter) - + if (nrow(psi) == 0) { errorModal(session, "No splicing events returned", "The total reads of the alternative splicing events are", @@ -489,7 +544,7 @@ quantifySplicingSet <- function(session, input) { endProcess("calcIncLevels") return(NULL) } - + # Include settings used for alternative splicing quantification allEventTypes <- getSplicingEventTypes() eventTypeName <- names(allEventTypes[allEventTypes %in% eventType]) @@ -504,11 +559,28 @@ quantifySplicingSet <- function(session, input) { filter)) "All available genes" else filter) attr(psi, "settings") <- settings attr(psi, "icon") <- list(symbol="calculator", colour="green") - - setInclusionLevels(psi) + + # Filter PSI + if (enablePSIfiltering) { + medians <- rowMedians(psi, na.rm=TRUE) + medianThres <- medians >= minMedian & medians <= maxMedian + + vars <- log10(rowVars(psi, na.rm=TRUE)) + varThres <- vars >= minLogVar & vars <= maxLogVar + + ranges <- apply(psi, 1, max, na.rm=TRUE) - apply(psi, 1, min, + na.rm=TRUE) + rangeThres <- ranges >= minRange & ranges <= maxRange + + thres <- which(medianThres & varThres & rangeThres) + filteredPSI <- psi[thres, ] + } else { + filteredPSI <- psi + } + setInclusionLevels(filteredPSI) endProcess("calcIncLevels", time) }) - + # Show warnings if needed before quantifying alternative splicing observeEvent(input$calcIncLevels, { if (is.null(getData()) || is.null(getJunctionQuantification())) { @@ -536,7 +608,7 @@ quantifySplicingSet <- function(session, input) { calcSplicing() } }) - + observeEvent(input$replace, calcSplicing()) observeEvent(input$discard, { setDifferentialSplicing(NULL) @@ -545,8 +617,84 @@ quantifySplicingSet <- function(session, input) { }) } +#' Plot alternative splicing quantification +#' +#' @param psi Data frame or matrix: alternative splicing quantification +#' @param x Character: \code{median}, \code{var} or \code{range} (or +#' transformations of those variables, such as \code{log10(var)}) +#' @param y Character: \code{median}, \code{var} or \code{range} (or +#' transformations of those variables, such as \code{log10(var)}) +#' @param minX Numeric: minimum X to subset data +#' @param maxX Numeric: maximum X to subset data +#' @param minY Numeric: minimum Y to subset data +#' @param maxY Numeric: maximum Y to subset data +#' @param xlim Numeric: minimum and maximum X to display +#' @param ylim Numeric: minimum and maximum Y to display +#' +#' @importFrom ggplot2 geom_vline geom_hline ylim +#' +#' @return Plot with the variables chosen in \code{x} and \code{y}. Also +#' includes an attribute \code{threshold}: a boolean vector stating which genes +#' pass the threshold based on \code{minX}, \code{maxX}, \code{minY} and +#' \code{maxY}. +#' @export +plotPSI <- function(psi, x, y, minX=NULL, maxX=NULL, minY=NULL, + maxY=NULL, xlim=NULL, ylim=NULL) { + stats <- c("range", "var", "median") + if (!any(sapply(stats, grepl, x)) || !any(sapply(stats, grepl, y))) { + stop("x and y require to contain one of the strings:", + "median, var, range") + } + + if (any(grepl("var", c(x, y)))) { + message("Calculating variance per splicing event...") + var <- rowVars(psi, na.rm=TRUE) + } + + if (any(grepl("median", c(x, y)))) { + message("Calculating median per splicing event...") + median <- rowMedians(psi, na.rm=TRUE) + } + + if (any(grepl("range", c(x, y)))) { + message("Calculating range per splicing event...") + range <- apply(psi, 1, max, na.rm=TRUE) - apply(psi, 1, min, na.rm=TRUE) + } + + message("Plotting...") + plot <- ggplot(mapping=aes_string(x=x, y=y)) + + # geom_hex(na.rm=TRUE) + + geom_point(size=1, na.rm=TRUE, alpha=0.5) + + geom_density_2d(colour="orange", na.rm=TRUE) + + if (!is.null(xlim)) plot <- plot + ylim(xlim) + if (!is.null(ylim)) plot <- plot + ylim(ylim) + + xThreshold1 <- xThreshold2 <- yThreshold1 <- yThreshold2 <- TRUE + if (!is.null(minX)) { + plot <- plot + geom_vline(xintercept=minX, colour="red") + xThreshold1 <- eval(parse(text=x)) > minX + } + if (!is.null(maxX)) { + plot <- plot + geom_vline(xintercept=maxX, colour="red") + xThreshold2 <- eval(parse(text=x)) < maxX + } + if (!is.null(minY)) { + plot <- plot + geom_hline(yintercept=minY, colour="red") + yThreshold1 <- eval(parse(text=y)) > minY + } + if (!is.null(maxY)) { + plot <- plot + geom_hline(yintercept=maxY, colour="red") + yThreshold2 <- eval(parse(text=y)) > maxY + } + subset <- xThreshold1 & xThreshold2 & yThreshold1 & yThreshold2 + message(sprintf("%s splicing events subset to %s", nrow(psi), sum(subset))) + attr(plot, "threshold") <- subset + return(plot) +} + #' @rdname appServer -#' +#' #' @importFrom shiny reactive observeEvent helpText removeModal #' @importFrom tools file_path_sans_ext #' @importFrom shinyjs enable disable hide show @@ -556,7 +704,7 @@ inclusionLevelsServer <- function(input, output, session) { observeEvent(input$missing, missingDataGuide("Junction quantification")) prepareFileBrowser(session, input, "filterGenesFile") - + # Update available junction quantification according to loaded files observe({ junctionQuant <- getJunctionQuantification() @@ -570,7 +718,7 @@ inclusionLevelsServer <- function(input, output, session) { choices=c("No junction quantification loaded"="")) } }) - + # Warn user if junction quantification is not loaded observe({ if (is.null(getData()) || is.null(getJunctionQuantification())) { @@ -583,20 +731,20 @@ inclusionLevelsServer <- function(input, output, session) { hide("missingData") } }) - + # Update gene symbols for filtering based on selected annotation observe({ annotation <- input$annotation filter <- input$filter - + # Avoid loading if already loaded if (filter == "select" && !is.null(annotation) && - !annotation %in% c("", "loadAnnotation") && + !annotation %in% c("", "loadAnnotation") && !identical(annotation, getAnnotationName())) { # Show loading bar show("geneOptionsLoading") hide("geneOptions") - + annotation <- input$annotation startProgress("Loading alternative splicing annotation", divisions=2) @@ -606,21 +754,65 @@ inclusionLevelsServer <- function(input, output, session) { updateSelectizeInput(session, "filterGenes", choices=genes, selected=character(0), server=TRUE) closeProgress("Gene list prepared") - + setAnnotationName(annotation) # Show gene options set hide("geneOptionsLoading") show("geneOptions") } }) + + # Toggle visibility of loading icon + observe({ + toggle("geneLoadingIcon", + selector = paste0( + '$("#data-inclusionLevels-filterGenes").parent()', + '.children("div.selectize-control").hasClass("loading")')) + }) + + # Update default AS event annotation based on selected dataset + observe({ + data <- getCategoryData() + isRecountData <- !is.null(data) && !is.null(attr(data, "source")) && + attr(data, "source") == "recount" + if (isRecountData) { + selected <- grep("hg38", listSplicingAnnotations(), value=TRUE)[[1]] + } else { + selected <- grep("hg19", listSplicingAnnotations(), value=TRUE)[[1]] + } + updateSelectizeInput(session, "annotation", selected=selected) + }) + + # Update sample filtering options + observeEvent(input$junctionQuant, { + junctionQuant <- getJunctionQuantification()[[input$junctionQuant]] + if (!is.null(junctionQuant)) { + updateSelectizeInput( + session, "sampleFilter", server=TRUE, + choices=colnames(junctionQuant), + options=list(placeholder="Select samples to discard", + plugins=list("remove_button"))) + } + }) - # # Toggle visibility of loading icon - # observe({ - # toggle("geneLoadingIcon", - # selector = paste0( - # '$("#data-inclusionLevels-filterGenes").parent()', - # '.children("div.selectize-control").hasClass("loading")')) - # }) + # Enable or disable PSI filtering options + observe({ + if (input$enablePSIfiltering) { + enable("minMedian") + enable("maxMedian") + enable("minLogVar") + enable("maxLogVar") + enable("minRange") + enable("maxRange") + } else { + disable("minMedian") + disable("maxMedian") + disable("minLogVar") + disable("maxLogVar") + disable("minRange") + disable("maxRange") + } + }) quantifySplicingSet(session, input) loadCustomSplicingAnnotationSet(session, input, output) diff --git a/R/globalAccess.R b/R/globalAccess.R index bf0322fe..81fa400a 100644 --- a/R/globalAccess.R +++ b/R/globalAccess.R @@ -315,11 +315,30 @@ getJunctionQuantification <- function(category=getCategory()) { } #' @rdname getGlobal -getGeneExpression <- function(category=getCategory()) { +#' @param item Character: name of specific item to retrieve (if \code{NULL}, the +#' whole list is returned) +#' @param EList Boolean: return gene expression datasets as \code{EList} if +#' possible or as data frames? +getGeneExpression <- function(item=NULL, category=getCategory(), EList=FALSE) { if (!is.null(category)) { data <- getData()[[category]] match <- sapply(data, attr, "dataType") == "Gene expression" - if (any(match)) return(data[match]) + if (any(match)) { + df <- data[match] + if (!is.null(item)) { + res <- df[[item]] + if (!EList && is(res, "EList")) { + # Convert EList object to data frame + res <- data.frame(res) + } + } else if (!EList) { + # Convert EList objects to data frames + res <- lapply(data[match], function(i) { + if (is(i, "EList")) data.frame(i) else i + }) + } + return(res) + } } } diff --git a/R/groups.R b/R/groups.R index 828972fe..c1cea6ab 100644 --- a/R/groups.R +++ b/R/groups.R @@ -2227,6 +2227,22 @@ testGroupIndependence <- function(ref, groups, elements, pvalueAdjust="BH") { return(df) } +#' Discard grouped samples if not within a sample vector +#' +#' @param groups Named list of samples +#' @param samples Character: vector with all available samples +#' @param clean Boolean: clean results? +#' +#' @return Groups without samples not found in \code{samples} +#' @keywords internal +discardOutsideSamplesFromGroups <- function(groups, samples, clean=FALSE) { + getMatchingSamples <- function(i) ifelse(i %in% samples, i, NA) + g <- lapply(groups, getMatchingSamples) + g <- lapply(g, na.omit) + if (clean) g <- lapply(g, as.character) + return(g) +} + #' Plot -log10(p-values) of the results obtained after multiple group #' independence testing #' diff --git a/inst/shiny/www/functions.js b/inst/shiny/www/functions.js index 88b8e15d..58a7fda3 100644 --- a/inst/shiny/www/functions.js +++ b/inst/shiny/www/functions.js @@ -154,9 +154,13 @@ function renderGEnormOptions (item, escape) { case "none": description = ""; break; + case "quantile": + description = "Forces the entire empirical distribution of each " + + "column to be identical (only performed if " + + "voom is selected)."; } - return "
" + escape(item.label) + - "
" + "" + description + "
"; + return "
" + escape(item.label) + "
" + + "" + description + "
"; } /** diff --git a/man/convertCoordinates.Rd b/man/convertCoordinates.Rd new file mode 100644 index 00000000..de85b7df --- /dev/null +++ b/man/convertCoordinates.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis_information.R +\name{convertCoordinates} +\alias{convertCoordinates} +\title{Convert genome coordinates between assemblies} +\usage{ +convertCoordinates(ASevents, from = "hg38", to = "hg19") +} +\value{ +Character vector with converted coordinates +} +\description{ +Convert genome coordinates between assemblies +} +\examples{ +convertCoordinates("SE_1_+_207785682_207790253_207790345_207793519_CD46", + from="hg38", to="hg19") +} diff --git a/man/convertGeneIdentifiers.Rd b/man/convertGeneIdentifiers.Rd new file mode 100644 index 00000000..dbf371d8 --- /dev/null +++ b/man/convertGeneIdentifiers.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_geNormalisationFiltering.R +\name{convertGeneIdentifiers} +\alias{convertGeneIdentifiers} +\title{Convert gene identifiers} +\usage{ +convertGeneIdentifiers(annotation, genes, key = "ENSEMBL", + target = "SYMBOL", ignoreDuplicatedTargets = TRUE) +} +\arguments{ +\item{annotation}{OrgDb: genome wide annotation for an organism, e.g. +\code{org.Hs.eg.db}} + +\item{genes}{Character: genes to be converted} + +\item{key}{Character: type of identifier used, e.g. \code{ENSEMBL}; read +\code{?AnnotationDbi::columns}} + +\item{target}{Character: type of identifier to convert to; read +\code{?AnnotationDbi::columns}} + +\item{ignoreDuplicatedTargets}{Boolean: if \code{TRUE}, identifiers that +share targets with other identifiers will not be converted} +} +\value{ +Character vector of the respective targets of gene identifiers. The +previous identifiers remain other identifiers have the same target (in case +\code{ignoreDuplicatedTargets = TRUE}) or if no target was found. +} +\description{ +Convert gene identifiers +} +\examples{ +if ( require("org.Hs.eg.db") ) { + columns(org.Hs.eg.db) + + genes <- c("ENSG00000012048", "ENSG00000083093", "ENSG00000141510", + "ENSG00000051180") + convertGeneIdentifiers(org.Hs.eg.db, genes, + key="ENSEMBL", target="SYMBOL") +} +} diff --git a/man/discardOutsideSamplesFromGroups.Rd b/man/discardOutsideSamplesFromGroups.Rd new file mode 100644 index 00000000..eb3fa2db --- /dev/null +++ b/man/discardOutsideSamplesFromGroups.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groups.R +\name{discardOutsideSamplesFromGroups} +\alias{discardOutsideSamplesFromGroups} +\title{Discard grouped samples if not within a sample vector} +\usage{ +discardOutsideSamplesFromGroups(groups, samples, clean = FALSE) +} +\arguments{ +\item{groups}{Named list of samples} + +\item{samples}{Character: vector with all available samples} + +\item{clean}{Boolean: clean results?} +} +\value{ +Groups without samples not found in \code{samples} +} +\description{ +Discard grouped samples if not within a sample vector +} +\keyword{internal} diff --git a/man/filterGeneExpr.Rd b/man/filterGeneExpr.Rd new file mode 100644 index 00000000..8f466a04 --- /dev/null +++ b/man/filterGeneExpr.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_geNormalisationFiltering.R +\name{filterGeneExpr} +\alias{filterGeneExpr} +\title{Filter genes based on their expression} +\usage{ +filterGeneExpr(geneExpr, minMean = 0, maxMean = Inf, minVar = 0, + maxVar = Inf, minCounts = 10, minTotalCounts = 15) +} +\arguments{ +\item{geneExpr}{Data frame or matrix: gene expression} + +\item{minMean}{Numeric: minimum of read count mean per gene} + +\item{maxMean}{Numeric: maximum of read count mean per gene} + +\item{minVar}{Numeric: minimum of read count variance per gene} + +\item{maxVar}{Numeric: maximum of read count variance per gene} + +\item{minCounts}{Numeric: minimum number of read counts per gene for at least +some samples} + +\item{minTotalCounts}{Numeric: minimum total number of read counts per gene} +} +\value{ +Boolean vector indicating which genes have sufficiently large counts +} +\description{ +Filter genes based on their expression +} diff --git a/man/getGlobal.Rd b/man/getGlobal.Rd index 50d08bbf..4c71d823 100644 --- a/man/getGlobal.Rd +++ b/man/getGlobal.Rd @@ -113,7 +113,8 @@ getSampleAttributes() getJunctionQuantification(category = getCategory()) -getGeneExpression(category = getCategory()) +getGeneExpression(item = NULL, category = getCategory(), + EList = FALSE) setNormalisedGeneExpression(geneExpr, category = getCategory()) @@ -179,6 +180,12 @@ it uses the selected data category} \item{attrs}{Character: name of attributes to retrieve (if NULL, the whole dataset is returned)} +\item{item}{Character: name of specific item to retrieve (if \code{NULL}, the +whole list is returned)} + +\item{EList}{Boolean: return gene expression datasets as \code{EList} if +possible or as data frames?} + \item{geneExpr}{Data frame or matrix: normalised gene expression} \item{incLevels}{Data frame or matrix: inclusion levels} diff --git a/man/normaliseGeneExpression.Rd b/man/normaliseGeneExpression.Rd index 8249d0e1..15ad0210 100644 --- a/man/normaliseGeneExpression.Rd +++ b/man/normaliseGeneExpression.Rd @@ -5,28 +5,38 @@ \title{Filter and normalise gene expression} \usage{ normaliseGeneExpression(geneExpr, geneFilter = NULL, method = "TMM", - p = 0.75, log2transform = TRUE, priorCount = 0.25) + p = 0.75, log2transform = TRUE, priorCount = 0.25, + performVoom = FALSE) } \arguments{ \item{geneExpr}{Matrix or data frame: gene expression} \item{geneFilter}{Boolean: filtered genes} -\item{method}{normalization method to be used} +\item{method}{Character: normalisation method, including \code{TMM}, +\code{RLE}, \code{upperquartile}, \code{none} or \code{quantile} (see +Details)} \item{p}{percentile (between 0 and 1) of the counts that is aligned when \code{method="upperquartile"}} \item{log2transform}{Boolean: perform log2-transformation?} -\item{priorCount}{Average count to add to each observation to avoid zeroes +\item{priorCount}{Average count to add to each observation to avoid zeroes after log-transformation} } \value{ -Gene expression filtered and normalised +Filtered and normalised gene expression } \description{ Filter and normalise gene expression } +\details{ +\code{edgeR::calcNormFactors} will be used to normalise gene +expression if one of the followin methods is set: \code{TMM}, \code{RLE}, +\code{upperquartile} or \code{none}. However, \code{limma::voom} will be +used for normalisation if \code{performVoom = TRUE} and the selected method +is \code{quantile}. +} \examples{ geneExpr <- readFile("ex_gene_expression.RDS") normaliseGeneExpression(geneExpr) diff --git a/man/plotDistribution.Rd b/man/plotDistribution.Rd index 376ac6ca..406d5f5c 100644 --- a/man/plotDistribution.Rd +++ b/man/plotDistribution.Rd @@ -4,15 +4,17 @@ \alias{plotDistribution} \title{Plot distribution through a density plot} \usage{ -plotDistribution(data, groups = "All samples", rug = TRUE, - vLine = TRUE, ..., title = NULL, psi = NULL) +plotDistribution(data, groups = NULL, rug = TRUE, vLine = TRUE, ..., + title = NULL, psi = NULL, rugLabels = FALSE) } \arguments{ \item{data}{Numeric, data frame or matrix: data for one gene or alternative splicing event} \item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} +or character vector (group of each value in \code{data}); if \code{NULL} or a +character vector of length 1, all data points will be considered of the same +group} \item{rug}{Boolean: include rug plot to better visualise data distribution} @@ -26,6 +28,8 @@ density estimates} \item{psi}{Boolean: are data composed of PSI values? Automatically set to \code{TRUE} if all \code{data} values are between 0 and 1} + +\item{rugLabels}{Boolean: plot names or colnames of \code{data} in the rug?} } \value{ Highcharter object with density plot @@ -35,7 +39,8 @@ The tooltip shows the median, variance, max, min and number of non-NA samples of each data series. } \examples{ -data <- sample(20, rep=TRUE)/20 -groups <- c(rep("A", 10), rep("B", 10)) -plotDistribution(data, groups) +data <- sample(20, rep=TRUE)/20 +groups <- paste("Group", c(rep("A", 10), rep("B", 10))) +label <- paste("Sample", 1:20) +plotDistribution(data, groups, label=label) } diff --git a/man/plotGeneExprPerSample.Rd b/man/plotGeneExprPerSample.Rd new file mode 100644 index 00000000..59002e27 --- /dev/null +++ b/man/plotGeneExprPerSample.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_geNormalisationFiltering.R +\name{plotGeneExprPerSample} +\alias{plotGeneExprPerSample} +\title{Plot distribution of gene expression per sample} +\usage{ +plotGeneExprPerSample(geneExpr, ...) +} +\arguments{ +\item{geneExpr}{Data frame or matrix: gene expression} + +\item{...}{Arguments passed on to \code{renderBoxplot} +\describe{ + \item{data}{Data frame or matrix} + \item{outliers}{Boolean: draw outliers?} + \item{sortByMedian}{Boolean: sort box plots based on ascending median?} + \item{showXlabels}{Boolean: show labels in X axis?} +}} +} +\value{ +Gene expression distribution plots +} +\description{ +Plot distribution of gene expression per sample +} +\examples{ +df <- data.frame(geneA=c(2, 4, 5), + geneB=c(20, 3, 5), + geneC=c(5, 10, 21)) +colnames(df) <- paste("Sample", 1:3) +plotGeneExprPerSample(df) +} diff --git a/man/plotMeanVariance.Rd b/man/plotMeanVariance.Rd new file mode 100644 index 00000000..791516b5 --- /dev/null +++ b/man/plotMeanVariance.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_geNormalisationFiltering.R +\name{plotMeanVariance} +\alias{plotMeanVariance} +\title{Render mean-variance plot} +\usage{ +plotMeanVariance(data) +} +\arguments{ +\item{data}{Data frame or matrix: gene expression or junction quantification} +} +\value{ +Mean-variance plot +} +\description{ +Render mean-variance plot +} diff --git a/man/plotPSI.Rd b/man/plotPSI.Rd new file mode 100644 index 00000000..64943572 --- /dev/null +++ b/man/plotPSI.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_inclusionLevels.R +\name{plotPSI} +\alias{plotPSI} +\title{Plot alternative splicing quantification} +\usage{ +plotPSI(psi, x, y, minX = NULL, maxX = NULL, minY = NULL, + maxY = NULL, xlim = NULL, ylim = NULL) +} +\arguments{ +\item{psi}{Data frame or matrix: alternative splicing quantification} + +\item{x}{Character: \code{median}, \code{var} or \code{range} (or +transformations of those variables, such as \code{log10(var)})} + +\item{y}{Character: \code{median}, \code{var} or \code{range} (or +transformations of those variables, such as \code{log10(var)})} + +\item{minX}{Numeric: minimum X to subset data} + +\item{maxX}{Numeric: maximum X to subset data} + +\item{minY}{Numeric: minimum Y to subset data} + +\item{maxY}{Numeric: maximum Y to subset data} + +\item{xlim}{Numeric: minimum and maximum X to display} + +\item{ylim}{Numeric: minimum and maximum Y to display} +} +\value{ +Plot with the variables chosen in \code{x} and \code{y}. Also +includes an attribute \code{threshold}: a boolean vector stating which genes +pass the threshold based on \code{minX}, \code{maxX}, \code{minY} and +\code{maxY}. +} +\description{ +Plot alternative splicing quantification +} diff --git a/man/quantifySplicing.Rd b/man/quantifySplicing.Rd index abe97859..c0a1c7d1 100644 --- a/man/quantifySplicing.Rd +++ b/man/quantifySplicing.Rd @@ -18,8 +18,8 @@ splicing event type} \item{minReads}{Integer: discard alternative splicing quantified using a number of reads below this threshold} -\item{genes}{Character: gene symbols for which the splicing quantification -of associated splicing events is performed (by default, all splicing events +\item{genes}{Character: gene symbols for which the splicing quantification +of associated splicing events is performed (by default, all splicing events undergo splicing quantification)} } \value{ diff --git a/man/renderBoxplot.Rd b/man/renderBoxplot.Rd new file mode 100644 index 00000000..30119187 --- /dev/null +++ b/man/renderBoxplot.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis.R +\name{renderBoxplot} +\alias{renderBoxplot} +\title{Render boxplot} +\usage{ +renderBoxplot(data, outliers = FALSE, sortByMedian = TRUE, + showXlabels = TRUE, title = NULL, seriesName = "Gene expression") +} +\arguments{ +\item{data}{Data frame or matrix} + +\item{outliers}{Boolean: draw outliers?} + +\item{sortByMedian}{Boolean: sort box plots based on ascending median?} + +\item{showXlabels}{Boolean: show labels in X axis?} +} +\value{ +Box plot +} +\description{ +Render boxplot +} +\examples{ +renderBoxplot(data.frame(a=1:10, b=10:19, c=45:54)) +} +\keyword{internal} diff --git a/man/tabDataset.Rd b/man/tabDataset.Rd index dfdf7954..437c8eb2 100644 --- a/man/tabDataset.Rd +++ b/man/tabDataset.Rd @@ -22,6 +22,10 @@ tabDataset(ns, title, tableId, columns, visCols, data, \item{data}{Data frame: dataset of interest} \item{description}{Character: description of the table (optional)} + +\item{icon}{Character: list containing an item named \code{symbol} +(FontAwesome icon name) and another one named \code{colour} (background +colour)} } \value{ HTML elements From f344fc0607fdf20cf78e91ecaf4e40f8ff337493 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 5 Mar 2019 15:50:28 +0000 Subject: [PATCH 20/46] Fix article title formatting --- NEWS | 2 ++ R/analysis_information.R | 72 ++++++++++++++++++++++++++-------------- man/pubmedUI.Rd | 4 ++- 3 files changed, 52 insertions(+), 26 deletions(-) diff --git a/NEWS b/NEWS index 0f36ab1b..eeb37256 100644 --- a/NEWS +++ b/NEWS @@ -68,6 +68,8 @@ - Fix inconsistency when presenting median and variance differences between gene expression and alternative splicing quantification - Fix error when groups contain samples outside the data being analysed +* Gene, transcript and protein information: + - Fix article title formatting (e.g. bold and italics) # 1.6.2 (2 October, 2018) diff --git a/R/analysis_information.R b/R/analysis_information.R index 96b53b82..f7763d90 100644 --- a/R/analysis_information.R +++ b/R/analysis_information.R @@ -690,35 +690,46 @@ articleUI <- function(article) { description <- sprintf("%s.", description) pmid <- article$articleids$value[1] + + decodeHTMLentities <- function(char) { + char <- gsub("<", "<", char, fixed=TRUE) + char <- gsub(">", ">", char, fixed=TRUE) + return(HTML(char)) + } + tags$a(href=paste0("http://pubmed.gov/", pmid), target="_blank", class="list-group-item", h5(class="list-group-item-heading", - article$title, tags$small(description))) + decodeHTMLentities(article$title), + tags$small(description))) } #' Return the interface of relevant PubMed articles for a given gene #' +#' @param ns Namespace function #' @param gene Character: gene #' @inheritDotParams queryPubMed -primary #' #' @return HTML interface of relevant PubMed articles #' @keywords internal -pubmedUI <- function(gene, ...) { - pubmed <- queryPubMed(gene, ...) - articles <- pubmed[-1] - articleList <- lapply(articles, articleUI) - - search <- pubmed$search$querytranslation - search <- gsub("[Abstract]", "[Title/Abstract]", search, fixed = TRUE) - search <- paste0("http://www.ncbi.nlm.nih.gov/pubmed/?term=", search) - - articlesUI <- div(class="panel panel-default", - div(class="panel-heading", - tags$b("Relevant PubMed articles", tags$a( - href=search, target="_blank", - class="pull-right", "Show more articles", - icon("external-link")))), - div(class="list-group", articleList)) - return(articlesUI) +pubmedUI <- function(ns, gene, ...) { + terms <- c(gene, as.list(...)) + + selectTerms <- selectizeInput( + ns("articleTerms"), label=NULL, choices=terms, selected=terms, + multiple=TRUE, width="auto", options=list( + create=TRUE, createOnBlur=TRUE, persist=FALSE, + plugins=list('remove_button', 'drag_drop'), + placeholder="Add keywords...")) + selectTerms[[2]]$style <- paste(selectTerms[[2]]$style, "margin-bottom: 0;") + + articleList <- uiOutput(ns("articleList")) + + div(class="panel panel-default", + div(class="panel-heading", + tags$b("Relevant PubMed articles", + uiOutput(ns("articleSearch"), inline=TRUE))), + div(class="list-group", tags$li(class="list-group-item", selectTerms), + articleList)) } #' Render protein information @@ -828,17 +839,28 @@ infoServer <- function(input, output, session) { # Render relevant articles according to available gene output$articles <- renderUI({ - number <- 3 category <- getCategory() - if (!is.null(category)) { - category <- unlist(strsplit(getCategory(), " ")) - articles <- pubmedUI(gene, "cancer", category, top=number) - } else { - articles <- pubmedUI(gene, "cancer", top=number) - } + if (!is.null(category)) category <- unlist(strsplit(category, " ")) + articles <- pubmedUI(session$ns, gene, "cancer", category) return(articles) }) + observeEvent(input$articleTerms, { + terms <- input$articleTerms + pubmed <- queryPubMed(terms[1], terms[-1]) + articles <- pubmed[-1] + articleList <- lapply(articles, articleUI) + output$articleList <- renderUI(articleList) + + search <- pubmed$search$querytranslation + search <- gsub("[Abstract]", "[Title/Abstract]", search, fixed=TRUE) + search <- paste0("http://www.ncbi.nlm.nih.gov/pubmed/?term=", + search) + link <- tags$a(href=search, target="_blank", class="pull-right", + "Show more articles", icon("external-link")) + output$articleSearch <- renderUI(link) + }) + # Show NULL so it doesn't show previous results when loading output$selectProtein <- renderUI("Loading...") output$proteinError <- renderUI(NULL) diff --git a/man/pubmedUI.Rd b/man/pubmedUI.Rd index 798de0be..25091651 100644 --- a/man/pubmedUI.Rd +++ b/man/pubmedUI.Rd @@ -4,9 +4,11 @@ \alias{pubmedUI} \title{Return the interface of relevant PubMed articles for a given gene} \usage{ -pubmedUI(gene, ...) +pubmedUI(ns, gene, ...) } \arguments{ +\item{ns}{Namespace function} + \item{gene}{Character: gene} \item{...}{Arguments passed on to \code{queryPubMed} From 76ba81ea5f6d3f13761ab733550daa2e703252bc Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 5 Mar 2019 15:54:02 +0000 Subject: [PATCH 21/46] Improve GTEx and other data loading - Automatically download and load GTEx data - Only display at most the first 100 columns for performance reasons - Improve data loading titles - Minor copyediting --- NEWS | 4 + R/data.R | 15 ++- R/data_firebrowse.R | 4 +- R/data_gtex.R | 255 ++++++++++++++++++++------------------------ R/data_local.R | 3 +- R/data_recount.R | 6 +- 6 files changed, 134 insertions(+), 153 deletions(-) diff --git a/NEWS b/NEWS index eeb37256..167d0803 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,10 @@ the `as.table` function) * Data: - Decrease loading time after quantifying alternative splicing +* Data loading: + - GTEx data can now be automatically downloaded and loaded on-demand + - By default, data table now only displays at most the first 100 columns + for performance reasons * Alternative splicing quantification: - By default, quantify skipped exons, mutually exclusive exons, alternative 3' and 5' splice sites, and alternative first and last exons; this default diff --git a/R/data.R b/R/data.R index 4568f29d..4583166e 100644 --- a/R/data.R +++ b/R/data.R @@ -609,17 +609,22 @@ dataServer <- function(input, output, session) { dataTablesUI <- lapply( seq_along(categoryData), function(i) { data <- categoryData[[i]] + + # Display at most 100 columns if no visible columns are set + visCols <- attr(data, "show") + if (is.null(visCols) && ncol(data) > 100) + visCols <- colnames(data)[seq(100)] + tabDataset(ns, names(categoryData)[i], icon=attr(data, "icon"), paste(category, i, sep="-"), names(data), - attr(data, "show"), data, - description=attr(data, "description")) - }) - do.call(tabsetPanel, c(id=ns("datasetTab"), dataTablesUI)) + visCols, data, description=attr(data, "description")) + } + ) }) # Change the active dataset observe( setActiveDataset(input$datasetTab) ) - + # Match clinical data with sample information observe({ patients <- getPatientId() diff --git a/R/data_firebrowse.R b/R/data_firebrowse.R index eae07f75..16ffe907 100644 --- a/R/data_firebrowse.R +++ b/R/data_firebrowse.R @@ -579,9 +579,9 @@ firebrowseUI <- function(id, panel) { ns <- NS(id) panel(style="info", - title=list(icon("plus-circle"), "Automatically load TCGA data"), + title=list(icon("plus-circle"), "TCGA data loading"), value="Load TCGA/Firebrowse data", - helpText("TCGA data is downloaded using the", + helpText("TCGA data are downloaded using the", a(href="http://firebrowse.org", target="_blank", "Firebrowse"), "API."), div(id=ns("firebrowseLoading"), class="progress", diff --git a/R/data_gtex.R b/R/data_gtex.R index 4eab14b4..1af9edd1 100644 --- a/R/data_gtex.R +++ b/R/data_gtex.R @@ -1,3 +1,14 @@ +#' Get GTEx data types +#' +#' @return GTEx data types +#' @keywords internal +getGtexDataTypes <- function() { + c("Sample attributes"="sampleInfo", + "Subject phenotypes"="subjectInfo", + "Gene expression"="geneExpr", + "Junction quantification"="junctionQuant") +} + #' @rdname appUI #' #' @importFrom shinyBS bsCollapse bsCollapsePanel @@ -6,41 +17,33 @@ gtexDataUI <- function(id, panel) { ns <- NS(id) - panel(style="info", title=list(icon("plus-circle"), "Load GTEx files"), - value="Load GTEx files", + panel(style="info", title=list(icon("plus-circle"), "GTEx data loading"), + value="Automatically load GTEx data", uiOutput(ns("modal")), - helpText("Please download files from the", + helpText("GTEx data are downloaded from the", a(href="http://www.gtexportal.org", target="_blank", - "GTEx Data Portal"), "and load them here."), - fileBrowserInput(ns("sampleInfo"), "Sample attributes (TXT file)", - placeholder="No file selected"), - fileBrowserInput(ns("subjectInfo"), "Subject phenotypes (TXT file)", - placeholder="No file selected"), - fileBrowserInput(ns("junctionQuant"), "Junction read counts", - placeholder="No file selected"), - fileBrowserInput(ns("geneExpr"), "Gene expression", - placeholder="No file selected"), + "GTEx Data Portal"), "website."), + selectizeInput(ns("dataTypes"), "Data type", multiple=TRUE, + width="100%", getGtexDataTypes(), + selected=names(getGtexDataTypes()), options=list( + placeholder="Select data types", + plugins=list("remove_button"))), + fileBrowserInput( + ns("dataFolder"), "Folder where data is stored", + value=getDownloadsFolder(), + placeholder="No folder selected", + info=TRUE, infoFUN=bsTooltip, + infoTitle=paste("Data will be downloaded if not available in this", + "folder.")), bsCollapse( id=ns("filterCollapse"), bsCollapsePanel( - title=tagList(icon("filter"), "Filter tissue(s) to load"), + title=tagList(icon("filter"), "Filter tissues to load"), value="Load by tissue", div(id=ns("loadingAvailableTissues"), class="progress", div(class="progress-bar progress-bar-striped active", role="progressbar", style="width:100%", - "Loading tissues from sample attributes")), - hidden(errorDialog( - paste( - "Please select a file containing GTEx sample", - "attributes. This file is required to obtain", - "available tissues in GTEx."), - id=ns("missingData"), style="margin: 10px;")), - hidden(warningDialog( - paste( - "An issue occurred while reading the file", - "containing sample attributes. Please confirm", - "if the input file is the correct one."), - id=ns("fileReadWarning"), style="margin: 10px;")), + "Loading tissues from sample attributes...")), hidden( selectizeInput(ns("tissues"), label=NULL, width="100%", choices=c("Select one or more tissues"=""), @@ -50,14 +53,20 @@ gtexDataUI <- function(id, panel) { #' Get GTEx tissues from given GTEx sample attributes #' -#' @param sampleMetadata Character: path to sample attributes +#' @inheritParams loadGtexData #' #' @return Character: available tissues #' @export -getGtexTissues <- function(sampleMetadata) { - tissueCol <- "Tissue Type (area of retrieval)" - metadata <- loadGtexFile(sampleMetadata, "Sample") - freq <- table(metadata[[tissueCol]]) +getGtexTissues <- function(dataFolder=getDownloadsFolder()) { + sampleFile <- "GTEx_v7_Annotations_SampleAttributesDS.txt" + filepath <- file.path(dataFolder, sampleFile) + names(filepath) <- sampleFile + downloadGtexFiles(filepath, "Samples") + + filepath <- gsub("\\.gz$", "", filepath) + sampleMetadata <- grep("Sample", filepath, value=TRUE) + metadata <- loadGtexFile(sampleMetadata, "Sample") + freq <- table(metadata[["Tissue Type (area of retrieval)"]]) tissues <- names(freq) names(tissues) <- sprintf("%s (%s samples)", names(freq), as.vector(freq)) @@ -125,34 +134,60 @@ loadGtexFile <- function(path, pattern, samples=NULL) { return(parsed) } -#' @rdname loadGtexFile -loadGTExFile <- loadGtexFile +downloadGtexFiles <- function(filepath, dataTypes) { + + link <- paste0("https://storage.googleapis.com/gtex_analysis_v7/", + rep(c("annotations/", "rna_seq_data/"), each=2), + names(filepath)) + toDownload <- !file.exists(gsub("\\.gz$", "", filepath)) + if (sum(toDownload) > 0) { + updateProgress("Downoading data...", divisions=sum(toDownload)) + for (i in which(toDownload)) { + updateProgress("Downloading file", detail=dataTypes[i]) + download.file(link[i], filepath[i]) + } + } + + toDecompress <- grepl("\\.gz$", filepath) & file.exists(filepath) + if (sum(toDecompress) > 0) { + updateProgress("Extracting files...", divisions=sum(toDecompress)) + for (each in which(toDecompress)) { + updateProgress("Extracting file", detail=dataTypes[each]) + gunzip(filepath[each]) + } + } +} #' Load GTEx data #' -#' @param clinical Character: path to subject information (the TXT file) -#' @param sampleMetadata Character: path to sample metadata (the TXT file) -#' @param geneExpr Character: path to gene read counts, RPKMs or TPMs -#' @param junctionQuant Character: path to junction quantification -#' @param tissue Character: tissue(s) of interest when loading data (all tissues -#' are loaded by default); if only some tissue(s) are of interest, this may -#' speed up loading the data +#' @param dataTypes Character: data types to load (see \code{getGtexDataTypes}) +#' @param dataFolder Character: folder containing data +#' @param tissue Character: tissues to load (if \code{NULL}, load all); tissue +#' selection may speed up data loading #' #' @importFrom tools file_path_sans_ext +#' @importFrom R.utils gunzip #' #' @return List with loaded data #' @export -loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, - geneExpr=NULL, tissue=NULL) { - if (is.null(clinical) && is.null(sampleMetadata) && is.null(junctionQuant) - && is.null(geneExpr)) - stop("No input data was given.") +loadGtexData <- function(dataTypes=getGtexDataTypes(), + dataFolder=getDownloadsFolder(), tissue=NULL) { + if (is.null(dataTypes)) stop("Argument 'dataTypes' cannot be NULL.") + if (is.null(dataFolder)) stop("Argument 'dataFolder' cannot be NULL.") - loaded <- list() - validFiles <- !vapply( - list(clinical, sampleMetadata, junctionQuant, geneExpr), - is.null, logical(1)) - updateProgress("Loading files...", divisions=sum(validFiles)) + files <- c( + "GTEx_v7_Annotations_SampleAttributesDS.txt", + "GTEx_v7_Annotations_SubjectPhenotypesDS.txt", + "GTEx_Analysis_2016-01-15_v7_RNASeQCv1.1.8_gene_reads.gct.gz", + "GTEx_Analysis_2016-01-15_v7_STARv2.4.2a_junctions.gct.gz") + names(files) <- getGtexDataTypes() + files <- files[dataTypes] + filepath <- file.path(dataFolder, files) + names(filepath) <- files + + downloadGtexFiles(filepath, dataTypes) + + updateProgress("Loading files...", divisions=length(dataTypes)) loadThisGtexFile <- function(path, pattern, samples=NULL) { name <- ifelse(is.character(path), basename(path), path$name) @@ -161,18 +196,17 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, return(loaded) } - if (!is.null(tissue) && is.null(sampleMetadata)) - stop("Filtering by tissue requires sample metadata as input.") + filepath <- gsub("\\.gz$", "", filepath) + sampleMetadata <- grep("Sample", filepath, value=TRUE) + clinical <- grep("Subject", filepath, value=TRUE) + junctionQuant <- grep("junctions", filepath, value=TRUE) + geneExpr <- grep("gene_reads", filepath, value=TRUE) + loaded <- list() samples <- NULL - if (!is.null(sampleMetadata)) { + if (length(sampleMetadata) > 0) { sampleAttrs <- loadThisGtexFile(sampleMetadata, "Sample") if (!is.null(tissue)) { - if (is.null(sampleAttrs)) { - stop("No GTEx samples were found in the given file. Confirm ", - "if this is the correct file.") - } - # Filter which samples match desired tissues tissue <- tolower(unique(tissue)) tissueCol <- "Tissue Type (area of retrieval)" @@ -196,13 +230,13 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, loaded[[1]] <- sampleAttrs } - if (!is.null(clinical)) + if (length(clinical) > 0) loaded[[2]] <- loadThisGtexFile(clinical, "Subject", samples) - if (!is.null(junctionQuant)) + if (length(junctionQuant) > 0) loaded[[3]] <- loadThisGtexFile(junctionQuant, "junction", samples) - if (!is.null(geneExpr)) + if (length(geneExpr) > 0) loaded[[4]] <- loadThisGtexFile(geneExpr, "gene", samples) names(loaded) <- sapply(loaded, attr, "tablename") @@ -210,6 +244,7 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, data <- setNames(list(loaded), "GTEx") data <- processDatasetNames(data) + closeProgress() return(data) } @@ -222,68 +257,24 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, #' @return NULL (this function is used to modify the Shiny session's state) #' @keywords internal loadGtexDataShiny <- function(session, input, replace=TRUE) { - tissue <- input$tissues + dataTypes <- input$dataTypes + dataFolder <- input$dataFolder + tissue <- input$tissues - subjectInfo <- input$subjectInfo - if (is.null(subjectInfo) || identical(subjectInfo, "")) - subjectInfo <- NULL + time <- startProcess("load") + data <- loadGtexData(dataTypes, dataFolder, tissue) - sampleInfo <- input$sampleInfo - if (is.null(sampleInfo) || identical(sampleInfo, "")) - sampleInfo <- NULL - - junctionQuant <- input$junctionQuant - if (is.null(junctionQuant) || identical(junctionQuant, "")) - junctionQuant <- NULL - - geneExpr <- input$geneExpr - if (is.null(geneExpr) || identical(geneExpr, "")) - geneExpr <- NULL - - files <- c("Sample attributes"=sampleInfo, "Subject phenotypes"=subjectInfo, - "Junction read counts"=junctionQuant, "Gene expression"=geneExpr) - - if (all(is.null(files))) { - errorModal(session, "No file provided", - "Please input at least one GTEx file.", modalId="modal", - caller="Load GTEx data") - } else if (any(!isFile(files))) { - formatFileInfo <- function(item, files) { - filepath <- prepareWordBreak(files[[item]]) - tagList(tags$b(names(files[item])), tags$br(), - tags$kbd(filepath), tags$br(), tags$br()) - } - - nonExisting <- files[!isFile(files)] - filesNotFound <- do.call( - tagList, lapply(names(nonExisting), formatFileInfo, nonExisting)) - - errorModal(session, "Files not found", - "The following files were not found:", tags$br(), tags$br(), - filesNotFound, modalId="modal", caller="Load GTEx data") - } else { - time <- startProcess("load") - data <- loadGtexData(clinical=subjectInfo, sampleMetadata=sampleInfo, - junctionQuant=junctionQuant, geneExpr=geneExpr, - tissue=tissue) - - if (!is.null(data)) { - if (!replace) data <- c(getData(), data) - data <- processDatasetNames(data) - setData(data) - } - endProcess("load", time) + if (!is.null(data)) { + if (!replace) data <- c(getData(), data) + data <- processDatasetNames(data) + setData(data) } + endProcess("load", time) } #' @rdname appServer #' @importFrom shinyjs show hide gtexDataServer <- function(input, output, session) { - prepareFileBrowser(session, input, "sampleInfo") - prepareFileBrowser(session, input, "subjectInfo") - prepareFileBrowser(session, input, "junctionQuant") - prepareFileBrowser(session, input, "geneExpr") - observeEvent(input$load, { if (!is.null(getData())) loadedDataModal(session, "modal", "replace", "append") @@ -293,40 +284,20 @@ gtexDataServer <- function(input, output, session) { # Select available tissues from GTEx showAvailableTissues <- reactive({ - sampleMetadata <- input$sampleInfo + dataFolder <- input$dataFolder progressBar <- "loadingAvailableTissues" tissueSelect <- "tissues" - alert <- "missingData" - warning <- "fileReadWarning" fadeIn <- function(id, ...) show(id, anim=TRUE, ...) fadeOut <- function(id, ...) hide(id, anim=TRUE, ...) fadeOut(progressBar) - if (!is.null(sampleMetadata) && !identical(sampleMetadata, "")) { - fadeOut(tissueSelect) - - tissues <- tryCatch(getGtexTissues(sampleMetadata), error=return, - warning=return) - - if (is.null(tissues) || is(tissues, "error") || - is(tissues, "warning")) { - # Warn the user when having an issue reading the file - fadeOut(tissueSelect, animType="fade") - fadeIn(warning) - tissues <- character(0) - } else { - fadeIn(tissueSelect, animType="fade") - fadeOut(warning) - tissues <- c(tissues, "Select available tissues"="") - } - fadeOut(alert) - } else { - fadeOut(tissueSelect, animType="fade") - fadeIn(alert) - fadeOut(warning) - tissues <- character(0) - } + fadeOut(tissueSelect) + tissues <- tryCatch( + getGtexTissues(dataFolder), error=return, warning=return) + fadeIn(tissueSelect, animType="fade") + tissues <- c(tissues, "Select available tissues"="") + updateSelectizeInput(session, "tissues", choices=tissues) }) diff --git a/R/data_local.R b/R/data_local.R index 9d02bb2b..a6a83e70 100644 --- a/R/data_local.R +++ b/R/data_local.R @@ -111,7 +111,8 @@ localDataUI <- function(id, panel) { placeholder="These files will not be loaded")), processButton(ns("acceptFile"), "Load files")) - panel(style="info", title=list(icon("plus-circle"), "Load user files"), + panel(style="info", title=list(icon("plus-circle"), + "User-provided data loading"), value="Load local files", uiOutput(ns("localDataModal")), tabsetPanel( diff --git a/R/data_recount.R b/R/data_recount.R index e40da5e9..fa346a6d 100644 --- a/R/data_recount.R +++ b/R/data_recount.R @@ -6,7 +6,7 @@ recountDataUI <- function(id, panel) { ns <- NS(id) - title <- "Automatically load SRA data" + title <- "SRA data loading" panel(style="info", title=list(icon("plus-circle"), title), value=title, uiOutput(ns("recountDataModal")), helpText( @@ -15,8 +15,7 @@ recountDataUI <- function(id, panel) { a(href="https://jhubiostatistics.shinyapps.io/recount/", target="_blank", "recount"), "R package."), div(class="alert", class="alert-info", role="alert", - "Data from SRA projects not listed below may be manually loaded", - "after splice-aware alignment.", + "SRA data unlisted below may be manually aligned and loaded.", tags$a( href="http://rpubs.com/nuno-agostinho/psichomics-custom-data", class="alert-link", target="_blank", "Learn more...")), @@ -142,6 +141,7 @@ loadSRAproject <- function(project, outdir=getDownloadsFolder()) { format <- loadFileFormats()$recountSampleFormat data[[sra]][["Sample metadata"]] <- parseValidFile(sampleInfo, format) + attr(data[[sra]], "source") <- "recount" closeProgress() } return(data) From a063ae9c3e8485ec8321719898a43a2e1eced67b Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 5 Mar 2019 15:54:02 +0000 Subject: [PATCH 22/46] Improve GTEx and other data loading - Automatically download and load GTEx data - Only display at most the first 100 columns for performance reasons - Improve data loading titles - Default to load clinical, junction quantification and gene expression data when selecting TCGA data - Minor copyediting --- NEWS | 6 + R/analysis_correlation.R | 3 +- R/analysis_diffExpression_table.R | 4 +- R/data.R | 29 +++- R/data_firebrowse.R | 7 +- R/data_geNormalisationFiltering.R | 60 +++---- R/data_gtex.R | 255 +++++++++++++----------------- R/data_local.R | 3 +- R/data_recount.R | 6 +- man/getGtexDataTypes.Rd | 15 ++ man/getGtexTissues.Rd | 4 +- man/listAllAnnotations.Rd | 4 +- man/loadGtexData.Rd | 17 +- man/loadGtexFile.Rd | 3 - 14 files changed, 209 insertions(+), 207 deletions(-) create mode 100644 man/getGtexDataTypes.Rd diff --git a/NEWS b/NEWS index eeb37256..7b150c64 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,10 @@ the `as.table` function) * Data: - Decrease loading time after quantifying alternative splicing +* Data loading: + - GTEx data can now be automatically downloaded and loaded on-demand + - By default, data table now only displays at most the first 100 columns + for performance reasons * Alternative splicing quantification: - By default, quantify skipped exons, mutually exclusive exons, alternative 3' and 5' splice sites, and alternative first and last exons; this default @@ -51,6 +55,8 @@ - Export functions mentioned in the documentation - Hide documentation of internal functions from the PDF reference manual * Alternative splicing quantification: + - Automatically set the human genome version after loading data from TCGA + (hg19), GTEx (hg19) or recount2 (hg38) - Fix progress bar * Fix crash when loading psichomics with test data that is not locally available (by automatically downloading said data if not found) diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index 9abf7003..c083e986 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -137,7 +137,8 @@ subsetGeneExpressionFromMatchingGenes <- function(geneExpr, gene) { matched[unmatched] <- bestMatch matched <- matched[!is.na(matched)] if (length(matched) == 0) stop("Gene expression not found for input genes.") - return(geneExpr[matched, ]) + if (is(geneExpr, "EList")) geneExpr <- data.frame(geneExpr) + return(geneExpr[matched, , drop=FALSE]) } #' Find splicing events based on given genes diff --git a/R/analysis_diffExpression_table.R b/R/analysis_diffExpression_table.R index b8e1e720..1b080796 100644 --- a/R/analysis_diffExpression_table.R +++ b/R/analysis_diffExpression_table.R @@ -173,7 +173,7 @@ diffExpressionSet <- function(session, input, output) { }) performDiffExpression <- reactive({ - geneExpr <- getGeneExpression(input$geneExpr) + geneExpr <- getGeneExpression(input$geneExpr, EList=TRUE) totalTime <- startProcess("startAnalyses") # Prepare groups of samples to analyse and filter samples not available @@ -181,7 +181,7 @@ diffExpressionSet <- function(session, input, output) { groups <- getSelectedGroups(input, "diffGroups", "Samples", filter=colnames(geneExpr)) groups <- discardOutsideSamplesFromGroups(groups, colnames(geneExpr)) - if (is(geneExpr, "EList")) + if (!is(geneExpr, "EList")) geneExpr <- geneExpr[ , unlist(groups), drop=FALSE] else geneExpr <- geneExpr[ , unlist(groups)] diff --git a/R/data.R b/R/data.R index 4568f29d..91799e3c 100644 --- a/R/data.R +++ b/R/data.R @@ -445,6 +445,7 @@ createDataTab <- function(index, data, name, session, input, output) { table <- data[[index]] # Only show default columns if they are defined (don't cause problems) + if (is(table, "EList")) table <- table$E subsetToShow <- table visCols <- input[[paste(tablename, "columns", sep="-")]] @@ -530,8 +531,12 @@ createDataTab <- function(index, data, name, session, input, output) { highchart=geneExprPerSamplePlot, highchart=librarySizePlot) } else if (isPSI) { - medianVar <- plotPSI(table, x="median", y="var") - rangeVar <- plotPSI(table, x="range", y="log10(var)") + medianVar <- plotPSI(table, x="median", y="var") %>% + hc_xAxis(title=list(text="Median PSI")) %>% + hc_yAxis(title=list(text="PSI Variance")) + rangeVar <- plotPSI(table, x="range", y="log10(var)") %>% + hc_xAxis(title=list(text="PSI Range")) %>% + hc_yAxis(title=list(text="log10(PSI Variance)")) plots <- list(plot=medianVar, plot=rangeVar) } attr(table, "plots") <- plots @@ -609,17 +614,25 @@ dataServer <- function(input, output, session) { dataTablesUI <- lapply( seq_along(categoryData), function(i) { data <- categoryData[[i]] - tabDataset(ns, names(categoryData)[i], icon=attr(data, "icon"), - paste(category, i, sep="-"), names(data), - attr(data, "show"), data, - description=attr(data, "description")) - }) + if (is(data, "EList")) data <- data$E + + # Display at most 100 columns if no visible columns are set + visCols <- attr(data, "show") + if (is.null(visCols) && ncol(data) > 100) + visCols <- colnames(data)[seq(100)] + + tabDataset( + ns, names(categoryData)[i], icon=attr(data, "icon"), + paste(category, i, sep="-"), colnames(data), visCols, data, + description=attr(data, "description")) + } + ) do.call(tabsetPanel, c(id=ns("datasetTab"), dataTablesUI)) }) # Change the active dataset observe( setActiveDataset(input$datasetTab) ) - + # Match clinical data with sample information observe({ patients <- getPatientId() diff --git a/R/data_firebrowse.R b/R/data_firebrowse.R index eae07f75..24a8816f 100644 --- a/R/data_firebrowse.R +++ b/R/data_firebrowse.R @@ -557,7 +557,8 @@ addTCGAdata <- function(ns) { plugins=list("remove_button"))), selectizeInput(ns("firebrowseData"), "Data type", multiple = TRUE, width = "100%", dataTypes, - selected=c("Clinical", "junction_quantification"), + selected=c("Clinical", "junction_quantification", + "RSEM_genes"), options = list( placeholder = "Select data types", plugins=list("remove_button"))), @@ -579,9 +580,9 @@ firebrowseUI <- function(id, panel) { ns <- NS(id) panel(style="info", - title=list(icon("plus-circle"), "Automatically load TCGA data"), + title=list(icon("plus-circle"), "TCGA data loading"), value="Load TCGA/Firebrowse data", - helpText("TCGA data is downloaded using the", + helpText("TCGA data are downloaded using the", a(href="http://firebrowse.org", target="_blank", "Firebrowse"), "API."), div(id=ns("firebrowseLoading"), class="progress", diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 93f0990d..20d026ec 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -12,15 +12,15 @@ geNormalisationFilteringInterface <- function(ns) { filters <- div( id=ns("filteringInterface"), fluidRow( - column(6, numericInput(ns("minMean"), "Min mean >", + column(6, numericInput(ns("minMean"), "Min mean", min=-1, max=100, value=0, width="100%")), - column(6, numericInput(ns("maxMean"), "Max mean <", - min=-1, max=100, value=100, width="100%"))), - fluidRow( - column(6, numericInput(ns("minVar"), "Min variance >", - min=-1, max=100, value=0, width="100%")), - column(6, numericInput(ns("maxVar"), "Max variance <", - min=-1, max=100, value=100, width="100%"))), + column(6, numericInput(ns("minVar"), "Min variance", + min=-1, max=100, value=0, width="100%"))), + # fluidRow( + # column(6, numericInput(ns("maxMean"), "Max mean", + # min=-1, max=100, value=100, width="100%"))), + # column(6, numericInput(ns("maxVar"), "Max variance", + # min=-1, max=100, value=100, width="100%"))), fluidRow( column(6, numericInput(ns("minCounts"), "Min counts", min=0, max=100, value=10, width="100%")), @@ -150,6 +150,7 @@ normaliseGeneExpression <- function(geneExpr, geneFilter=NULL, method="TMM", if (is.null(geneFilter)) geneFilter <- TRUE else if (!any(geneFilter)) return(NULL) + originalGeneExpr <- geneExpr geneExpr <- DGEList(geneExpr) geneExprNorm <- geneExpr[geneFilter, , keep.lib.sizes=TRUE] @@ -169,12 +170,10 @@ normaliseGeneExpression <- function(geneExpr, geneFilter=NULL, method="TMM", updateProgress("Preparing gene expression data") if (!is(geneExprNorm, "EList")) geneExprNorm <- data.frame(geneExprNorm) colnames(geneExprNorm) <- colnames(geneExpr) - - # Pass attributes from original gene expression table (except for names) - notNames <- !names(attributes(geneExpr)) %in% - c(names(attributes(geneExprNorm)), "names", "row.names", "class") - attributes(geneExprNorm) <- c(attributes(geneExprNorm), - attributes(geneExpr)[notNames]) + + geneExprNorm <- inheritAttrs(geneExprNorm, originalGeneExpr) + if (is(geneExprNorm, "EList")) + geneExprNorm$E <- inheritAttrs(geneExprNorm$E, originalGeneExpr) return(geneExprNorm) } @@ -351,8 +350,8 @@ filterGeneExpr <- function(geneExpr, minMean=0, maxMean=Inf, minVar=0, geneExprMean <- rowMeans(geneExpr) geneExprVar <- rowVars(geneExpr) - varMeanFilter <- geneExprMean > minMean & geneExprMean < maxMean & - geneExprVar > minVar & geneExprVar < maxVar + varMeanFilter <- geneExprMean >= minMean & geneExprMean <= maxMean & + geneExprVar >= minVar & geneExprVar <= maxVar lowCountFilter <- filterByExpr(geneExpr[varMeanFilter, ], min.count=minCounts, @@ -450,9 +449,9 @@ geNormalisationFilteringServer <- function(input, output, session) { geneExpr <- isolate(getGeneExpression(geneExpr)) minMean <- input$minMean - maxMean <- input$maxMean + maxMean <- Inf minVar <- input$minVar - maxVar <- input$maxVar + maxVar <- Inf minCounts <- input$minCounts minTotalCounts <- input$minTotalCounts @@ -467,7 +466,8 @@ geNormalisationFilteringServer <- function(input, output, session) { samplesToKeep <- !colnames(geneExpr) %in% sampleFilter geneExpr <- geneExpr[ , samplesToKeep] } - + browser() + filtered <- filterGeneExpr(geneExpr, minMean, maxMean, minVar, maxVar, minCounts, minTotalCounts) return(filtered) @@ -519,15 +519,15 @@ geNormalisationFilteringServer <- function(input, output, session) { # Update mean range geneExprMean <- rowMeans(geneExpr) - maxMean <- ceiling( max(geneExprMean, na.rm=TRUE) ) + maxMean <- max(geneExprMean, na.rm=TRUE) updateNumericInput(session, "minMean", max=maxMean) - updateNumericInput(session, "maxMean", max=maxMean, value=maxMean) + # updateNumericInput(session, "maxMean", max=maxMean, value=maxMean) # Update variance range geneExprVar <- rowVars(geneExpr) - maxVar <- ceiling( max(geneExprVar, na.rm=TRUE) ) + maxVar <- max(geneExprVar, na.rm=TRUE) updateNumericInput(session, "minVar", max=maxVar) - updateNumericInput(session, "maxVar", max=maxVar, value=maxVar) + # updateNumericInput(session, "maxVar", max=maxVar, value=maxVar) # output$filteringAssistant <- renderHighchart({ # type <- input$assistantPlot @@ -595,9 +595,9 @@ geNormalisationFilteringServer <- function(input, output, session) { priorCount <- input$priorCount minMean <- input$minMean - maxMean <- input$maxMean + maxMean <- Inf # input$maxMean minVar <- input$minVar - maxVar <- input$maxVar + maxVar <- Inf # input$maxVar minCounts <- input$minCounts minTotalCounts <- input$minTotalCounts @@ -616,7 +616,7 @@ geNormalisationFilteringServer <- function(input, output, session) { } else { geneFilter <- NULL } - + geneExprNorm <- normaliseGeneExpression( geneExpr, geneFilter, method, percentile, log2transform=TRUE, priorCount, performVoom=voom) @@ -643,8 +643,8 @@ geNormalisationFilteringServer <- function(input, output, session) { if (filter) { geneFilterSettings <- c( "Gene filtering"="Enabled", - "Minimum mean >"=minMean, "Maximum mean <"=maxMean, - "Minimum variance >"=minVar, "Maximum variance <"=maxVar, + "Minimum mean >="=minMean, # "Maximum mean <="=maxMean, + "Minimum variance >="=minVar, # "Maximum variance <="=maxVar, "Minimum counts for at least some samples"=minCounts, "Minimum total counts across samples"=minTotalCounts) } else { @@ -677,7 +677,9 @@ geNormalisationFilteringServer <- function(input, output, session) { attr(geneExprNorm, "icon") <- list(symbol="cogs", colour="green") attr(geneExprNorm, "description") <- "Gene expression (normalised)" attr(geneExprNorm, "dataType") <- "Gene expression" - + + if (is(geneExprNorm, "EList")) + geneExprNorm$E <- inheritAttrs(geneExprNorm$E, geneExprNorm) setNormalisedGeneExpression(geneExprNorm) endProcess("processGeneExpr", time=time) }) diff --git a/R/data_gtex.R b/R/data_gtex.R index 4eab14b4..1af9edd1 100644 --- a/R/data_gtex.R +++ b/R/data_gtex.R @@ -1,3 +1,14 @@ +#' Get GTEx data types +#' +#' @return GTEx data types +#' @keywords internal +getGtexDataTypes <- function() { + c("Sample attributes"="sampleInfo", + "Subject phenotypes"="subjectInfo", + "Gene expression"="geneExpr", + "Junction quantification"="junctionQuant") +} + #' @rdname appUI #' #' @importFrom shinyBS bsCollapse bsCollapsePanel @@ -6,41 +17,33 @@ gtexDataUI <- function(id, panel) { ns <- NS(id) - panel(style="info", title=list(icon("plus-circle"), "Load GTEx files"), - value="Load GTEx files", + panel(style="info", title=list(icon("plus-circle"), "GTEx data loading"), + value="Automatically load GTEx data", uiOutput(ns("modal")), - helpText("Please download files from the", + helpText("GTEx data are downloaded from the", a(href="http://www.gtexportal.org", target="_blank", - "GTEx Data Portal"), "and load them here."), - fileBrowserInput(ns("sampleInfo"), "Sample attributes (TXT file)", - placeholder="No file selected"), - fileBrowserInput(ns("subjectInfo"), "Subject phenotypes (TXT file)", - placeholder="No file selected"), - fileBrowserInput(ns("junctionQuant"), "Junction read counts", - placeholder="No file selected"), - fileBrowserInput(ns("geneExpr"), "Gene expression", - placeholder="No file selected"), + "GTEx Data Portal"), "website."), + selectizeInput(ns("dataTypes"), "Data type", multiple=TRUE, + width="100%", getGtexDataTypes(), + selected=names(getGtexDataTypes()), options=list( + placeholder="Select data types", + plugins=list("remove_button"))), + fileBrowserInput( + ns("dataFolder"), "Folder where data is stored", + value=getDownloadsFolder(), + placeholder="No folder selected", + info=TRUE, infoFUN=bsTooltip, + infoTitle=paste("Data will be downloaded if not available in this", + "folder.")), bsCollapse( id=ns("filterCollapse"), bsCollapsePanel( - title=tagList(icon("filter"), "Filter tissue(s) to load"), + title=tagList(icon("filter"), "Filter tissues to load"), value="Load by tissue", div(id=ns("loadingAvailableTissues"), class="progress", div(class="progress-bar progress-bar-striped active", role="progressbar", style="width:100%", - "Loading tissues from sample attributes")), - hidden(errorDialog( - paste( - "Please select a file containing GTEx sample", - "attributes. This file is required to obtain", - "available tissues in GTEx."), - id=ns("missingData"), style="margin: 10px;")), - hidden(warningDialog( - paste( - "An issue occurred while reading the file", - "containing sample attributes. Please confirm", - "if the input file is the correct one."), - id=ns("fileReadWarning"), style="margin: 10px;")), + "Loading tissues from sample attributes...")), hidden( selectizeInput(ns("tissues"), label=NULL, width="100%", choices=c("Select one or more tissues"=""), @@ -50,14 +53,20 @@ gtexDataUI <- function(id, panel) { #' Get GTEx tissues from given GTEx sample attributes #' -#' @param sampleMetadata Character: path to sample attributes +#' @inheritParams loadGtexData #' #' @return Character: available tissues #' @export -getGtexTissues <- function(sampleMetadata) { - tissueCol <- "Tissue Type (area of retrieval)" - metadata <- loadGtexFile(sampleMetadata, "Sample") - freq <- table(metadata[[tissueCol]]) +getGtexTissues <- function(dataFolder=getDownloadsFolder()) { + sampleFile <- "GTEx_v7_Annotations_SampleAttributesDS.txt" + filepath <- file.path(dataFolder, sampleFile) + names(filepath) <- sampleFile + downloadGtexFiles(filepath, "Samples") + + filepath <- gsub("\\.gz$", "", filepath) + sampleMetadata <- grep("Sample", filepath, value=TRUE) + metadata <- loadGtexFile(sampleMetadata, "Sample") + freq <- table(metadata[["Tissue Type (area of retrieval)"]]) tissues <- names(freq) names(tissues) <- sprintf("%s (%s samples)", names(freq), as.vector(freq)) @@ -125,34 +134,60 @@ loadGtexFile <- function(path, pattern, samples=NULL) { return(parsed) } -#' @rdname loadGtexFile -loadGTExFile <- loadGtexFile +downloadGtexFiles <- function(filepath, dataTypes) { + + link <- paste0("https://storage.googleapis.com/gtex_analysis_v7/", + rep(c("annotations/", "rna_seq_data/"), each=2), + names(filepath)) + toDownload <- !file.exists(gsub("\\.gz$", "", filepath)) + if (sum(toDownload) > 0) { + updateProgress("Downoading data...", divisions=sum(toDownload)) + for (i in which(toDownload)) { + updateProgress("Downloading file", detail=dataTypes[i]) + download.file(link[i], filepath[i]) + } + } + + toDecompress <- grepl("\\.gz$", filepath) & file.exists(filepath) + if (sum(toDecompress) > 0) { + updateProgress("Extracting files...", divisions=sum(toDecompress)) + for (each in which(toDecompress)) { + updateProgress("Extracting file", detail=dataTypes[each]) + gunzip(filepath[each]) + } + } +} #' Load GTEx data #' -#' @param clinical Character: path to subject information (the TXT file) -#' @param sampleMetadata Character: path to sample metadata (the TXT file) -#' @param geneExpr Character: path to gene read counts, RPKMs or TPMs -#' @param junctionQuant Character: path to junction quantification -#' @param tissue Character: tissue(s) of interest when loading data (all tissues -#' are loaded by default); if only some tissue(s) are of interest, this may -#' speed up loading the data +#' @param dataTypes Character: data types to load (see \code{getGtexDataTypes}) +#' @param dataFolder Character: folder containing data +#' @param tissue Character: tissues to load (if \code{NULL}, load all); tissue +#' selection may speed up data loading #' #' @importFrom tools file_path_sans_ext +#' @importFrom R.utils gunzip #' #' @return List with loaded data #' @export -loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, - geneExpr=NULL, tissue=NULL) { - if (is.null(clinical) && is.null(sampleMetadata) && is.null(junctionQuant) - && is.null(geneExpr)) - stop("No input data was given.") +loadGtexData <- function(dataTypes=getGtexDataTypes(), + dataFolder=getDownloadsFolder(), tissue=NULL) { + if (is.null(dataTypes)) stop("Argument 'dataTypes' cannot be NULL.") + if (is.null(dataFolder)) stop("Argument 'dataFolder' cannot be NULL.") - loaded <- list() - validFiles <- !vapply( - list(clinical, sampleMetadata, junctionQuant, geneExpr), - is.null, logical(1)) - updateProgress("Loading files...", divisions=sum(validFiles)) + files <- c( + "GTEx_v7_Annotations_SampleAttributesDS.txt", + "GTEx_v7_Annotations_SubjectPhenotypesDS.txt", + "GTEx_Analysis_2016-01-15_v7_RNASeQCv1.1.8_gene_reads.gct.gz", + "GTEx_Analysis_2016-01-15_v7_STARv2.4.2a_junctions.gct.gz") + names(files) <- getGtexDataTypes() + files <- files[dataTypes] + filepath <- file.path(dataFolder, files) + names(filepath) <- files + + downloadGtexFiles(filepath, dataTypes) + + updateProgress("Loading files...", divisions=length(dataTypes)) loadThisGtexFile <- function(path, pattern, samples=NULL) { name <- ifelse(is.character(path), basename(path), path$name) @@ -161,18 +196,17 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, return(loaded) } - if (!is.null(tissue) && is.null(sampleMetadata)) - stop("Filtering by tissue requires sample metadata as input.") + filepath <- gsub("\\.gz$", "", filepath) + sampleMetadata <- grep("Sample", filepath, value=TRUE) + clinical <- grep("Subject", filepath, value=TRUE) + junctionQuant <- grep("junctions", filepath, value=TRUE) + geneExpr <- grep("gene_reads", filepath, value=TRUE) + loaded <- list() samples <- NULL - if (!is.null(sampleMetadata)) { + if (length(sampleMetadata) > 0) { sampleAttrs <- loadThisGtexFile(sampleMetadata, "Sample") if (!is.null(tissue)) { - if (is.null(sampleAttrs)) { - stop("No GTEx samples were found in the given file. Confirm ", - "if this is the correct file.") - } - # Filter which samples match desired tissues tissue <- tolower(unique(tissue)) tissueCol <- "Tissue Type (area of retrieval)" @@ -196,13 +230,13 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, loaded[[1]] <- sampleAttrs } - if (!is.null(clinical)) + if (length(clinical) > 0) loaded[[2]] <- loadThisGtexFile(clinical, "Subject", samples) - if (!is.null(junctionQuant)) + if (length(junctionQuant) > 0) loaded[[3]] <- loadThisGtexFile(junctionQuant, "junction", samples) - if (!is.null(geneExpr)) + if (length(geneExpr) > 0) loaded[[4]] <- loadThisGtexFile(geneExpr, "gene", samples) names(loaded) <- sapply(loaded, attr, "tablename") @@ -210,6 +244,7 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, data <- setNames(list(loaded), "GTEx") data <- processDatasetNames(data) + closeProgress() return(data) } @@ -222,68 +257,24 @@ loadGtexData <- function(clinical=NULL, sampleMetadata=NULL, junctionQuant=NULL, #' @return NULL (this function is used to modify the Shiny session's state) #' @keywords internal loadGtexDataShiny <- function(session, input, replace=TRUE) { - tissue <- input$tissues + dataTypes <- input$dataTypes + dataFolder <- input$dataFolder + tissue <- input$tissues - subjectInfo <- input$subjectInfo - if (is.null(subjectInfo) || identical(subjectInfo, "")) - subjectInfo <- NULL + time <- startProcess("load") + data <- loadGtexData(dataTypes, dataFolder, tissue) - sampleInfo <- input$sampleInfo - if (is.null(sampleInfo) || identical(sampleInfo, "")) - sampleInfo <- NULL - - junctionQuant <- input$junctionQuant - if (is.null(junctionQuant) || identical(junctionQuant, "")) - junctionQuant <- NULL - - geneExpr <- input$geneExpr - if (is.null(geneExpr) || identical(geneExpr, "")) - geneExpr <- NULL - - files <- c("Sample attributes"=sampleInfo, "Subject phenotypes"=subjectInfo, - "Junction read counts"=junctionQuant, "Gene expression"=geneExpr) - - if (all(is.null(files))) { - errorModal(session, "No file provided", - "Please input at least one GTEx file.", modalId="modal", - caller="Load GTEx data") - } else if (any(!isFile(files))) { - formatFileInfo <- function(item, files) { - filepath <- prepareWordBreak(files[[item]]) - tagList(tags$b(names(files[item])), tags$br(), - tags$kbd(filepath), tags$br(), tags$br()) - } - - nonExisting <- files[!isFile(files)] - filesNotFound <- do.call( - tagList, lapply(names(nonExisting), formatFileInfo, nonExisting)) - - errorModal(session, "Files not found", - "The following files were not found:", tags$br(), tags$br(), - filesNotFound, modalId="modal", caller="Load GTEx data") - } else { - time <- startProcess("load") - data <- loadGtexData(clinical=subjectInfo, sampleMetadata=sampleInfo, - junctionQuant=junctionQuant, geneExpr=geneExpr, - tissue=tissue) - - if (!is.null(data)) { - if (!replace) data <- c(getData(), data) - data <- processDatasetNames(data) - setData(data) - } - endProcess("load", time) + if (!is.null(data)) { + if (!replace) data <- c(getData(), data) + data <- processDatasetNames(data) + setData(data) } + endProcess("load", time) } #' @rdname appServer #' @importFrom shinyjs show hide gtexDataServer <- function(input, output, session) { - prepareFileBrowser(session, input, "sampleInfo") - prepareFileBrowser(session, input, "subjectInfo") - prepareFileBrowser(session, input, "junctionQuant") - prepareFileBrowser(session, input, "geneExpr") - observeEvent(input$load, { if (!is.null(getData())) loadedDataModal(session, "modal", "replace", "append") @@ -293,40 +284,20 @@ gtexDataServer <- function(input, output, session) { # Select available tissues from GTEx showAvailableTissues <- reactive({ - sampleMetadata <- input$sampleInfo + dataFolder <- input$dataFolder progressBar <- "loadingAvailableTissues" tissueSelect <- "tissues" - alert <- "missingData" - warning <- "fileReadWarning" fadeIn <- function(id, ...) show(id, anim=TRUE, ...) fadeOut <- function(id, ...) hide(id, anim=TRUE, ...) fadeOut(progressBar) - if (!is.null(sampleMetadata) && !identical(sampleMetadata, "")) { - fadeOut(tissueSelect) - - tissues <- tryCatch(getGtexTissues(sampleMetadata), error=return, - warning=return) - - if (is.null(tissues) || is(tissues, "error") || - is(tissues, "warning")) { - # Warn the user when having an issue reading the file - fadeOut(tissueSelect, animType="fade") - fadeIn(warning) - tissues <- character(0) - } else { - fadeIn(tissueSelect, animType="fade") - fadeOut(warning) - tissues <- c(tissues, "Select available tissues"="") - } - fadeOut(alert) - } else { - fadeOut(tissueSelect, animType="fade") - fadeIn(alert) - fadeOut(warning) - tissues <- character(0) - } + fadeOut(tissueSelect) + tissues <- tryCatch( + getGtexTissues(dataFolder), error=return, warning=return) + fadeIn(tissueSelect, animType="fade") + tissues <- c(tissues, "Select available tissues"="") + updateSelectizeInput(session, "tissues", choices=tissues) }) diff --git a/R/data_local.R b/R/data_local.R index 9d02bb2b..a6a83e70 100644 --- a/R/data_local.R +++ b/R/data_local.R @@ -111,7 +111,8 @@ localDataUI <- function(id, panel) { placeholder="These files will not be loaded")), processButton(ns("acceptFile"), "Load files")) - panel(style="info", title=list(icon("plus-circle"), "Load user files"), + panel(style="info", title=list(icon("plus-circle"), + "User-provided data loading"), value="Load local files", uiOutput(ns("localDataModal")), tabsetPanel( diff --git a/R/data_recount.R b/R/data_recount.R index e40da5e9..fa346a6d 100644 --- a/R/data_recount.R +++ b/R/data_recount.R @@ -6,7 +6,7 @@ recountDataUI <- function(id, panel) { ns <- NS(id) - title <- "Automatically load SRA data" + title <- "SRA data loading" panel(style="info", title=list(icon("plus-circle"), title), value=title, uiOutput(ns("recountDataModal")), helpText( @@ -15,8 +15,7 @@ recountDataUI <- function(id, panel) { a(href="https://jhubiostatistics.shinyapps.io/recount/", target="_blank", "recount"), "R package."), div(class="alert", class="alert-info", role="alert", - "Data from SRA projects not listed below may be manually loaded", - "after splice-aware alignment.", + "SRA data unlisted below may be manually aligned and loaded.", tags$a( href="http://rpubs.com/nuno-agostinho/psichomics-custom-data", class="alert-link", target="_blank", "Learn more...")), @@ -142,6 +141,7 @@ loadSRAproject <- function(project, outdir=getDownloadsFolder()) { format <- loadFileFormats()$recountSampleFormat data[[sra]][["Sample metadata"]] <- parseValidFile(sampleInfo, format) + attr(data[[sra]], "source") <- "recount" closeProgress() } return(data) diff --git a/man/getGtexDataTypes.Rd b/man/getGtexDataTypes.Rd new file mode 100644 index 00000000..00d3c500 --- /dev/null +++ b/man/getGtexDataTypes.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_gtex.R +\name{getGtexDataTypes} +\alias{getGtexDataTypes} +\title{Get GTEx data types} +\usage{ +getGtexDataTypes() +} +\value{ +GTEx data types +} +\description{ +Get GTEx data types +} +\keyword{internal} diff --git a/man/getGtexTissues.Rd b/man/getGtexTissues.Rd index 49397455..8a0c44b8 100644 --- a/man/getGtexTissues.Rd +++ b/man/getGtexTissues.Rd @@ -4,10 +4,10 @@ \alias{getGtexTissues} \title{Get GTEx tissues from given GTEx sample attributes} \usage{ -getGtexTissues(sampleMetadata) +getGtexTissues(dataFolder = getDownloadsFolder()) } \arguments{ -\item{sampleMetadata}{Character: path to sample attributes} +\item{dataFolder}{Character: folder containing data} } \value{ Character: available tissues diff --git a/man/listAllAnnotations.Rd b/man/listAllAnnotations.Rd index 223a5ed0..77354880 100644 --- a/man/listAllAnnotations.Rd +++ b/man/listAllAnnotations.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/data_inclusionLevels.R \name{listAllAnnotations} \alias{listAllAnnotations} -\title{List alternative splicing annotation files available, as well as custom +\title{List alternative splicing annotation files available, as well as custom annotation} \usage{ listAllAnnotations(...) @@ -14,7 +14,7 @@ listAllAnnotations(...) Named character vector with splicing annotation files available#' } \description{ -List alternative splicing annotation files available, as well as custom +List alternative splicing annotation files available, as well as custom annotation } \examples{ diff --git a/man/loadGtexData.Rd b/man/loadGtexData.Rd index 574095f8..a2fbe4dc 100644 --- a/man/loadGtexData.Rd +++ b/man/loadGtexData.Rd @@ -4,21 +4,16 @@ \alias{loadGtexData} \title{Load GTEx data} \usage{ -loadGtexData(clinical = NULL, sampleMetadata = NULL, - junctionQuant = NULL, geneExpr = NULL, tissue = NULL) +loadGtexData(dataTypes = getGtexDataTypes(), + dataFolder = getDownloadsFolder(), tissue = NULL) } \arguments{ -\item{clinical}{Character: path to subject information (the TXT file)} +\item{dataTypes}{Character: data types to load (see \code{getGtexDataTypes})} -\item{sampleMetadata}{Character: path to sample metadata (the TXT file)} +\item{dataFolder}{Character: folder containing data} -\item{junctionQuant}{Character: path to junction quantification} - -\item{geneExpr}{Character: path to gene read counts, RPKMs or TPMs} - -\item{tissue}{Character: tissue(s) of interest when loading data (all tissues -are loaded by default); if only some tissue(s) are of interest, this may -speed up loading the data} +\item{tissue}{Character: tissues to load (if \code{NULL}, load all); tissue +selection may speed up data loading} } \value{ List with loaded data diff --git a/man/loadGtexFile.Rd b/man/loadGtexFile.Rd index 2f9dc775..1508ca5d 100644 --- a/man/loadGtexFile.Rd +++ b/man/loadGtexFile.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/data_gtex.R \name{loadGtexFile} \alias{loadGtexFile} -\alias{loadGTExFile} \title{Load GTEx file} \usage{ loadGtexFile(path, pattern, samples = NULL) - -loadGTExFile(path, pattern, samples = NULL) } \arguments{ \item{path}{Character: path to file} From a949e3a91ad0a650c39a57e0351e9bae1f702b73 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 6 Mar 2019 00:34:12 +0000 Subject: [PATCH 23/46] Fix error when creating groups containing only samples and no matching subjects --- NEWS | 2 ++ R/groups.R | 16 ++++++++-------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index 7b150c64..35f69def 100644 --- a/NEWS +++ b/NEWS @@ -54,6 +54,8 @@ * Documentation: - Export functions mentioned in the documentation - Hide documentation of internal functions from the PDF reference manual + - Fix error when creating groups containing only samples and no matching + subjects * Alternative splicing quantification: - Automatically set the human genome version after loading data from TCGA (hg19), GTEx (hg19) or recount2 (hg38) diff --git a/R/groups.R b/R/groups.R index c1cea6ab..779645a2 100644 --- a/R/groups.R +++ b/R/groups.R @@ -1595,16 +1595,16 @@ groupManipulation <- function(input, output, session, type) { # Match first and second elements available in the group matchingElems <- match[names(match) %in% secondGroup] matchingElems[!matchingElems %in% firstGroup] <- NA + data <- rbind(data, cbind(name, names(matchingElems), + matchingElems)) + + # Get remaining first elements + firstGroup <- firstGroup[!firstGroup %in% matchingElems] + if (length(firstGroup) > 0) + data <- rbind(data, cbind(name, NA, firstGroup)) } else { - matchingElems <- NA + data <- rbind(data, cbind(name, secondGroup, NA)) } - data <- rbind(data, - cbind(name, names(matchingElems), matchingElems)) - - # Get remaining first elements - firstGroup <- firstGroup[!firstGroup %in% matchingElems] - if (length(firstGroup) > 0) - data <- rbind(data, cbind(name, NA, firstGroup)) } else { data <- rbind(data, cbind(name, NA, firstGroup)) } From 25ece479739d264f1f86898a98b703b6355ffbe6 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 6 Mar 2019 00:36:02 +0000 Subject: [PATCH 24/46] Fix missing attributes of gene expression normalised via voom --- NAMESPACE | 3 +++ R/data_geNormalisationFiltering.R | 1 - R/globalAccess.R | 2 +- R/utils.R | 10 ++++++++++ 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7b327b73..c67066d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -95,8 +95,11 @@ importFrom(DT,dataTableProxy) importFrom(DT,renderDataTable) importFrom(DT,replaceData) importFrom(DT,selectRows) +importFrom(GenomicRanges,makeGRangesFromDataFrame) importFrom(R.utils,capitalize) +importFrom(R.utils,decompressFile) importFrom(R.utils,evalWithTimeout) +importFrom(R.utils,gunzip) importFrom(Rcpp,sourceCpp) importFrom(SummarizedExperiment,assay) importFrom(SummarizedExperiment,end) diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 20d026ec..c44a70cb 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -466,7 +466,6 @@ geNormalisationFilteringServer <- function(input, output, session) { samplesToKeep <- !colnames(geneExpr) %in% sampleFilter geneExpr <- geneExpr[ , samplesToKeep] } - browser() filtered <- filterGeneExpr(geneExpr, minMean, maxMean, minVar, maxVar, minCounts, minTotalCounts) diff --git a/R/globalAccess.R b/R/globalAccess.R index 81fa400a..6d0ffc70 100644 --- a/R/globalAccess.R +++ b/R/globalAccess.R @@ -329,7 +329,7 @@ getGeneExpression <- function(item=NULL, category=getCategory(), EList=FALSE) { res <- df[[item]] if (!EList && is(res, "EList")) { # Convert EList object to data frame - res <- data.frame(res) + res <- inheritAttrs(data.frame(res), res) } } else if (!EList) { # Convert EList objects to data frames diff --git a/R/utils.R b/R/utils.R index e8c39aa5..9525076c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1993,4 +1993,14 @@ ggplotAuxServer <- function(input, output, id) { setZoom(id, NULL) setSelectedPoints(id, NULL) }) +} + +inheritAttrs <- function(original, objectToCopyFrom, + avoid=c("names", "row.names", "class")) { + notNames <- !names(attributes(objectToCopyFrom)) %in% c( + names(attributes(original)), avoid) + attributes(original) <- c(attributes(original), + attributes(objectToCopyFrom)[notNames]) + colnames(original) <- colnames(objectToCopyFrom) + return(original) } \ No newline at end of file From 972e5582a5cc7664a89542dc37edf926e7b27e65 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 6 Mar 2019 02:59:35 +0000 Subject: [PATCH 25/46] Improve correlation plots --- R/analysis_correlation.R | 66 +++++++++++-------- ...relation.Rd => plot.GEandAScorrelation.Rd} | 18 ++--- 2 files changed, 47 insertions(+), 37 deletions(-) rename man/{plotCorrelation.Rd => plot.GEandAScorrelation.Rd} (99%) diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index c083e986..8a9cb893 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -213,11 +213,11 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { corrPerGene <- function(gene, ASevent, geneExpr, psi, ...) { updateProgress("Performing correlation analysis", console=FALSE) - expr <- geneExpr[gene, ] + expr <- geneExpr[gene, , drop=FALSE] exprNum <- as.numeric(expr) names(exprNum) <- colnames(expr) - eventPSI <- psi[ASevent, ] + eventPSI <- psi[ASevent, , drop=FALSE] eventPSInum <- as.numeric(eventPSI) names(eventPSInum) <- colnames(eventPSI) @@ -286,6 +286,7 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' aes theme_light scale_colour_manual geom_density_2d #' @importFrom stats loess.smooth #' +#' @method plot GEandAScorrelation #' @export #' @return Plots, summary tables or results of correlation analyses #' @@ -308,13 +309,13 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' Tumour=paste("Cancer", 1:3)) #' attr(colourGroups, "Colour") <- c(Normal="#00C65A", Tumour="#EEE273") #' plot(corr, colourGroups=colourGroups, alpha=1) -plotCorrelation <- function(x, autoZoom=FALSE, loessSmooth=TRUE, - loessFamily=c("gaussian", "symmetric"), - colour="black", alpha=0.2, size=1.5, - loessColour="red", loessAlpha=1, loessWidth=0.5, - fontSize=12, ..., colourGroups=NULL, legend=FALSE, - showAllData=TRUE, density=FALSE, - densityColour="blue", densityWidth=0.5) { +plot.GEandAScorrelation <- function(x, autoZoom=FALSE, loessSmooth=TRUE, + loessFamily=c("gaussian", "symmetric"), + colour="black", alpha=0.2, size=1.5, + loessColour="red", loessAlpha=1, loessWidth=0.5, + fontSize=12, ..., colourGroups=NULL, legend=FALSE, + showAllData=TRUE, density=FALSE, + densityColour="blue", densityWidth=0.5) { loessFamily <- match.arg(loessFamily) plotCorrPerASevent <- function(single) { @@ -338,24 +339,31 @@ plotCorrelation <- function(x, autoZoom=FALSE, loessSmooth=TRUE, groupNames <- sampleColour[match(names(expr), unlist(colourGroups))] lookupColour <- attr(colourGroups, "Colour") - sampleColour <- lookupColour[groupNames] - if (showAllData) { - names(sampleColour)[is.na(names(sampleColour))] <- "NA" - legendColours <- c(lookupColour, "NA"=colour) + if (!is.null(lookupColour)) { + sampleColour <- lookupColour[groupNames] + + if (showAllData) { + names(sampleColour)[is.na(names(sampleColour))] <- "NA" + legendColours <- c(lookupColour, "NA"=colour) + } else { + nonNAs <- !is.na(sampleColour) + event <- event[nonNAs] + expr <- expr[nonNAs] + sampleColour <- sampleColour[nonNAs] + legendColours <- lookupColour + } + + plot <- plot + + geom_point(aes(colour=names(sampleColour)), na.rm=TRUE, + alpha=alpha, size=size) + + scale_colour_manual(name="", values=legendColours, + guide=if(legend) "legend" else FALSE) } else { - nonNAs <- !is.na(sampleColour) - event <- event[nonNAs] - expr <- expr[nonNAs] - sampleColour <- sampleColour[nonNAs] - legendColours <- lookupColour + plot <- plot + + geom_point(aes(colour=sampleColour), na.rm=TRUE, + alpha=alpha, size=size) } - - plot <- plot + - geom_point(aes(colour=names(sampleColour)), na.rm=TRUE, - alpha=alpha, size=size) + - scale_colour_manual(name="", values=legendColours, - guide=if(legend) "legend" else FALSE) } else { plot <- plot + geom_point(na.rm=TRUE, colour=colour, alpha=alpha, size=size) @@ -392,11 +400,12 @@ plotCorrelation <- function(x, autoZoom=FALSE, loessSmooth=TRUE, lapply(x, lapply, plotCorrPerASevent) } -#' @rdname plotCorrelation +#' @rdname plot.GEandAScorrelation #' @export -plot.GEandAScorrelation <- plotCorrelation +plotCorrelation <- plot.GEandAScorrelation -#' @rdname plotCorrelation +#' @rdname plot.GEandAScorrelation +#' @method print GEandAScorrelation #' @export print.GEandAScorrelation <- function(x, ...) { for (item in x) { @@ -413,7 +422,7 @@ print.GEandAScorrelation <- function(x, ...) { } } -#' @rdname plotCorrelation +#' @rdname plot.GEandAScorrelation #' @param pvalueAdjust Character: method used to adjust p-values (see Details) #' #' @details @@ -428,6 +437,7 @@ print.GEandAScorrelation <- function(x, ...) { #' \item{\code{hochberg}: Hochberg's method (family-wise error rate)} #' \item{\code{hommel}: Hommel's method (family-wise error rate)} #' } +#' @method as.table GEandAScorrelation #' @export as.table.GEandAScorrelation <- function (x, pvalueAdjust="BH", ...) { prepareCol <- function(object, FUN) unlist(lapply(object, lapply, FUN)) diff --git a/man/plotCorrelation.Rd b/man/plot.GEandAScorrelation.Rd similarity index 99% rename from man/plotCorrelation.Rd rename to man/plot.GEandAScorrelation.Rd index 3ea5e900..b0fca73b 100644 --- a/man/plotCorrelation.Rd +++ b/man/plot.GEandAScorrelation.Rd @@ -1,19 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/analysis_correlation.R -\name{plotCorrelation} -\alias{plotCorrelation} +\name{plot.GEandAScorrelation} \alias{plot.GEandAScorrelation} +\alias{plotCorrelation} \alias{print.GEandAScorrelation} \alias{as.table.GEandAScorrelation} \title{Display results of correlation analyses} \usage{ -plotCorrelation(x, autoZoom = FALSE, loessSmooth = TRUE, - loessFamily = c("gaussian", "symmetric"), colour = "black", - alpha = 0.2, size = 1.5, loessColour = "red", loessAlpha = 1, - loessWidth = 0.5, fontSize = 12, ..., colourGroups = NULL, - legend = FALSE, showAllData = TRUE, density = FALSE, - densityColour = "blue", densityWidth = 0.5) - \method{plot}{GEandAScorrelation}(x, autoZoom = FALSE, loessSmooth = TRUE, loessFamily = c("gaussian", "symmetric"), colour = "black", alpha = 0.2, size = 1.5, loessColour = "red", @@ -21,6 +14,13 @@ plotCorrelation(x, autoZoom = FALSE, loessSmooth = TRUE, colourGroups = NULL, legend = FALSE, showAllData = TRUE, density = FALSE, densityColour = "blue", densityWidth = 0.5) +plotCorrelation(x, autoZoom = FALSE, loessSmooth = TRUE, + loessFamily = c("gaussian", "symmetric"), colour = "black", + alpha = 0.2, size = 1.5, loessColour = "red", loessAlpha = 1, + loessWidth = 0.5, fontSize = 12, ..., colourGroups = NULL, + legend = FALSE, showAllData = TRUE, density = FALSE, + densityColour = "blue", densityWidth = 0.5) + \method{print}{GEandAScorrelation}(x, ...) \method{as.table}{GEandAScorrelation}(x, pvalueAdjust = "BH", ...) From 47bee24752a09aae6052235133a41d5c30e71f14 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 6 Mar 2019 03:01:52 +0000 Subject: [PATCH 26/46] Minor copy-editing --- NEWS | 47 +++++++++++++++---------------- R/analysis_diffExpression_table.R | 4 +-- R/analysis_dimReduction_pca.R | 6 ++-- R/data_inclusionLevels.R | 12 ++++---- R/utils.R | 12 ++++---- man/wilcox.Rd | 4 ++- 6 files changed, 44 insertions(+), 41 deletions(-) diff --git a/NEWS b/NEWS index 35f69def..1e1e121e 100644 --- a/NEWS +++ b/NEWS @@ -1,20 +1,10 @@ # 1.8.1 (4 March, 2019) -* Correlation analyses: - - Allow to use groups of genes and alternative splicing events - - Display progress - - Display correlation results in a table (in the command-line interface, use - the `as.table` function) -* Data: - - Decrease loading time after quantifying alternative splicing * Data loading: - GTEx data can now be automatically downloaded and loaded on-demand - By default, data table now only displays at most the first 100 columns for performance reasons * Alternative splicing quantification: - - By default, quantify skipped exons, mutually exclusive exons, alternative - 3' and 5' splice sites, and alternative first and last exons; this default - option is now consistent across the visual and command-line interfaces) - Allow to discard samples before alternative splicing quantification - In alternative splicing quantification dataset summary, plot quantification based on median, variance and range per splicing event across @@ -37,31 +27,40 @@ - By default, load pre-made lists of genes when loading gene expression or loading/performing alternative splicing quantification - Added pre-made list of genes that encode for RNA-binding proteins - (Sebestyen et al. 2016), useful to postulate about splicing regulators based - on gene expression and PSI correlation analyses -* Tutorials: - - Copy-edit tutorial on custom alternative splicing annotation preparation - + (Sebestyen et al. 2016), useful to postulate about the regulatory role of + those proteins based on gene expression and PSI correlation analyses +* Correlation analyses: + - Allow to use groups of genes and alternative splicing events in + correlation analyses + - Display progress when performing correlation analyses + - Display correlation results in a table (`as.table()`) +* Gene, transcript and protein information: + - Modify keywords used to search for PubMed articles + ## Bug fixes and minor changes +* Improve console logging of error and warning alerts +* Fix crash when loading psichomics with test data that is not locally available +(by automatically downloading said data if not found) +* Documentation: + - Export functions mentioned in the documentation + - Hide documentation of internal functions from the PDF reference manual * Loading SRA data: - Accept a vector of files as the first argument (easier to use with `list.files()`) - Ask to overwrite file if one exists with the same name as the output file * Groups: - Minor improvements to the group creation interface -* Improve console logging of error and warning alerts -* Documentation: - - Export functions mentioned in the documentation - - Hide documentation of internal functions from the PDF reference manual - Fix error when creating groups containing only samples and no matching subjects * Alternative splicing quantification: - Automatically set the human genome version after loading data from TCGA (hg19), GTEx (hg19) or recount2 (hg38) - Fix progress bar -* Fix crash when loading psichomics with test data that is not locally available -(by automatically downloading said data if not found) + - Decrease loading time after quantifying alternative splicing + - By default, quantify skipped exons, mutually exclusive exons, alternative + 3' and 5' splice sites, and alternative first and last exons; the default + option is now consistent across both the visual and command-line interfaces) * Differential analyses: - Allow distribution plots to show the name of the samples when hovering or when a rug plot is rendered if `rugLabels = TRUE` (function @@ -248,8 +247,8 @@ hg19 and hg38 annotation that is now available for use with psichomics) - Fix splicing events not being quantified based on GTEx v7 junction reads * Gene expression normalisation: - Fix misleading gene expression (non-)normalisation by converting reads to - counts per million (CPM) using `edgeR::cpm` after normalisation using - `edgeR::calcNormFactor` + counts per million (CPM) using `edgeR::cpm()` after normalisation using + `edgeR::calcNormFactor()` * Alternative splicing quantification: - Updated support to properly parse new notation of alternative splicing annotation from Bioconductor (backwards compatible with older notation) @@ -281,7 +280,7 @@ hg19 and hg38 annotation that is now available for use with psichomics) tissues are loaded by default) - Quantify splicing based on a list of genes (splicing events within all genes are quantified by default) - - Parse sample information from TCGA samples using `parseTcgaSampleInfo` + - Parse sample information from TCGA samples using `parseTcgaSampleInfo()` - Generate TCGA sample metadata when loading TCGA junction quantification - Present data summary after loading the data * Data grouping: diff --git a/R/analysis_diffExpression_table.R b/R/analysis_diffExpression_table.R index 1b080796..47401f31 100644 --- a/R/analysis_diffExpression_table.R +++ b/R/analysis_diffExpression_table.R @@ -182,9 +182,9 @@ diffExpressionSet <- function(session, input, output) { filter=colnames(geneExpr)) groups <- discardOutsideSamplesFromGroups(groups, colnames(geneExpr)) if (!is(geneExpr, "EList")) - geneExpr <- geneExpr[ , unlist(groups), drop=FALSE] + geneExpr <- geneExpr[ , unlist(groups), drop=FALSE] else - geneExpr <- geneExpr[ , unlist(groups)] + geneExpr <- geneExpr[ , unlist(groups)] isFromGroup1 <- colnames(geneExpr) %in% groups[[1]] design <- cbind(1, ifelse(isFromGroup1, 1, 0)) diff --git a/R/analysis_dimReduction_pca.R b/R/analysis_dimReduction_pca.R index 0bd0a91c..dec44633 100644 --- a/R/analysis_dimReduction_pca.R +++ b/R/analysis_dimReduction_pca.R @@ -192,7 +192,7 @@ plotVariance <- function(pca) { hc <- highchart() %>% hc_chart(zoomType="xy", backgroundColor=NULL) %>% - hc_title(text=paste("Explained variance by each", + hc_title(text=paste("Variance explained by each", "Principal Component (PC)")) %>% hc_add_series(data=data, type="waterfall", cumvar=cumvar) %>% hc_plotOptions(series=list(dataLabels=list( @@ -201,7 +201,7 @@ plotVariance <- function(pca) { align="center", verticalAlign="top", enabled=TRUE))) %>% hc_xAxis(title=list(text="Principal Components"), categories=seq(length(data)), crosshair=TRUE) %>% - hc_yAxis(title=list(text="Percentage of variances"), min=0, max=100) %>% + hc_yAxis(title=list(text="Percentage of variance"), min=0, max=100) %>% hc_legend(enabled=FALSE) %>% hc_tooltip( headerFormat=paste(tags$b("Principal component {point.x}"), @@ -363,7 +363,7 @@ plotPCA <- function(pca, pcX=1, pcY=2, groups=NULL, individuals=TRUE, name="Loadings", sample=names, contr=contrTotal, contrPCx=contrPCx, contrPCy=contrPCy) %>% hc_subtitle(text=sprintf( - "Bubble size: contribution of a variable to PC%s and PC%s", + "Bubble size ~ relative contribution to PC%s and PC%s", pcX, pcY)) %>% hc_tooltip(useHTML=TRUE, headerFormat="", pointFormat=paste0( tags$b(style="text-align: center; white-space:pre-wrap;", diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index b7899dcc..eb54243c 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -111,24 +111,24 @@ inclusionLevelsInterface <- function(ns) { fluidRow( column(6, numericInput( ns("minMedian"), "Min median >=", - min=0, max=1, value=0, width="100%")), + min=0, max=1, value=0, step=0.1, width="100%")), column(6, numericInput( ns("maxMedian"), "Max median <=", - min=0, max=1, value=1, width="100%"))), + min=0, max=1, value=1, step=0.1, width="100%"))), fluidRow( column(6, numericInput( ns("minLogVar"), "Min log10(variance) >=", - min=-10, max=0, value=-10, width="100%")), + min=-10, max=0, value=-10, step=0.5, width="100%")), column(6, numericInput( ns("maxLogVar"), "Max log10(variance) <=", - min=-10, max=0, value=0, width="100%"))), + min=-10, max=0, value=0, step=0.5, width="100%"))), fluidRow( column(6, numericInput( ns("minRange"), "Min range >=", - min=0, max=1, value=0, width="100%")), + min=0, max=1, value=0, step=0.1, width="100%")), column(6, numericInput( ns("maxRange"), "Max range <=", - min=0, max=1, value=1, width="100%"))) + min=0, max=1, value=1, step=0.1, width="100%"))) )), bsTooltip(ns("minReads"), placement = "right", options = list(container = "body"), diff --git a/R/utils.R b/R/utils.R index 9525076c..d5f32e70 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1787,17 +1787,19 @@ prepareFileBrowser <- function(session, input, id, modalId="modal", ...) { if (input[[buttonId]] > 0) { # Prevent execution on initial launch errorTitle <- NULL if (is.null(Sys.info())) - errorTitle <- "File browser unsupported for this system" + errorTitle <- c( + "The file browser is not supported for this system") else if (isRStudioServer()) - errorTitle <- "File browser unsupported in RStudio Server" + errorTitle <- c( + "The file browser is not supported in RStudio Server") else updateFileBrowserInput(session, id, ...) if (!is.null(errorTitle)) { errorModal(session, errorTitle, - "Please use the text input to type the full path to", - "the file or folder of interest.", modalId=modalId, - caller="File browser") + "Please use instead the text input field to type", + "the full path to the file or folder of interest.", + modalId=modalId, caller="File browser") } } }) diff --git a/man/wilcox.Rd b/man/wilcox.Rd index 22a7e7db..3115cde6 100644 --- a/man/wilcox.Rd +++ b/man/wilcox.Rd @@ -29,7 +29,9 @@ spearman(data, groups) splicing event} \item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} +or character vector (group of each value in \code{data}); if \code{NULL} or a +character vector of length 1, all data points will be considered of the same +group} \item{stat}{Data frame or matrix: values of the analyses to be performed (if NULL, the analyses will be performed)} From 1fb75cbb1f6de14bbcff49a1fa2ed1f942a0e3ce Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Wed, 6 Mar 2019 18:58:47 +0000 Subject: [PATCH 27/46] Fix error when subsetting edgeR::DGEList --- NAMESPACE | 1 + R/data_geNormalisationFiltering.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index c67066d6..41992be2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -124,6 +124,7 @@ importFrom(data.table,setkeyv) importFrom(data.table,setnames) importFrom(data.table,setorderv) importFrom(digest,digest) +importFrom(edgeR,"[.DGEList") importFrom(edgeR,DGEList) importFrom(edgeR,calcNormFactors) importFrom(edgeR,cpm) diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index c44a70cb..a34ac7e3 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -132,7 +132,7 @@ geNormalisationFilteringUI <- function(id, panel) { #' used for normalisation if \code{performVoom = TRUE} and the selected method #' is \code{quantile}. #' -#' @importFrom edgeR DGEList calcNormFactors cpm +#' @importFrom edgeR DGEList [.DGEList calcNormFactors cpm #' @importFrom limma voom #' #' @return Filtered and normalised gene expression From b6d0909be72ed3d54fabd3378aae050e14ec4082 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 7 Mar 2019 15:27:54 +0000 Subject: [PATCH 28/46] Allow to use selected splicing event in correlation analysis --- R/analysis_correlation.R | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index 8a9cb893..5c11fe3e 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -12,9 +12,14 @@ correlationUI <- function(id) { selectizeInput(ns("geneExpr"), "Gene expression", choices=NULL, width="100%"), selectGroupsUI(ns("genes"), label="Genes from selected groups"), - selectGroupsUI( - ns("ASevents"), - label="Alternative splicing events from selected groups"), + radioButtons( + ns("ASeventsSelection"), "Alternative splicing event(s)", + c("Selected event"="selectedEvent", + "From selected groups"="byGroup")), + conditionalPanel( + sprintf("input[id='%s'] == '%s'", + ns("ASeventsSelection"), "byGroup"), + selectGroupsUI(ns("ASevents"), label=NULL)), hr(), selectizeInput( ns("method"), "Correlation method", width="100%", c("Pearson's product-moment correlation"="pearson", @@ -529,10 +534,14 @@ correlationServer <- function(input, output, session) { performCorrelationAnalyses <- reactive({ isolate({ psi <- getInclusionLevels() - ASevents <- getSelectedGroups(input, "ASevents", "ASevents", - filter=rownames(psi)) - ASevents <- unlist(ASevents) + if (input$ASeventsSelection == "selectedEvent") { + ASevents <- getASevent() + } else if (input$ASeventsSelection == "byGroup") { + ASevents <- getSelectedGroups(input, "ASevents", "ASevents", + filter=rownames(psi)) + ASevents <- unlist(ASevents) + } geneExpr <- getGeneExpression(input$geneExpr) gene <- getSelectedGroups(input, "genes", "Genes", filter=rownames(geneExpr)) @@ -564,9 +573,14 @@ correlationServer <- function(input, output, session) { ns <- session$ns isolate({ psi <- getInclusionLevels() - ASevents <- getSelectedGroups(input, "ASevents", "ASevents", - filter=rownames(psi)) - ASevents <- unlist(ASevents) + + if (input$ASeventsSelection == "selectedEvent") { + ASevents <- getASevent() + } else if (input$ASeventsSelection == "byGroup") { + ASevents <- getSelectedGroups(input, "ASevents", "ASevents", + filter=rownames(psi)) + ASevents <- unlist(ASevents) + } geneExpr <- getGeneExpression(input$geneExpr) gene <- getSelectedGroups(input, "genes", "Genes", From 0a094a868e124e5ec115d1f5f3c169ae057fdafe Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Fri, 8 Mar 2019 13:45:24 +0000 Subject: [PATCH 29/46] Update citation details --- LICENSE | 2 +- NEWS | 1 + R/app.R | 8 ++++++-- README.md | 4 ++-- inst/CITATION | 8 ++++++-- vignettes/CLI_tutorial.Rmd | 2 +- vignettes/GUI_tutorial.Rmd | 2 +- 7 files changed, 18 insertions(+), 9 deletions(-) diff --git a/LICENSE b/LICENSE index 91e8f995..586364c1 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2015-2018 +YEAR: 2015-2019 COPYRIGHT HOLDER: Nuno Agostinho \ No newline at end of file diff --git a/NEWS b/NEWS index 1e1e121e..b12abf10 100644 --- a/NEWS +++ b/NEWS @@ -77,6 +77,7 @@ - Fix error when groups contain samples outside the data being analysed * Gene, transcript and protein information: - Fix article title formatting (e.g. bold and italics) +* Update citation with journal publication date # 1.6.2 (2 October, 2018) diff --git a/R/app.R b/R/app.R index f194dd05..786af266 100644 --- a/R/app.R +++ b/R/app.R @@ -21,8 +21,11 @@ linkToArticle <- function() { authors <- c("Nuno Saraiva-Agostinho", "Nuno L Barbosa-Morais") title <- paste("psichomics: graphical application for alternative", "splicing quantification and analysis.") - year <- 2018 + year <- 2019 journal <- "Nucleic Acids Research" + volume <- 47 + number <- 2 + pages <- "e7" tags$a( target="_blank", href="https://doi.org/10.1093/nar/gky888", @@ -30,7 +33,8 @@ linkToArticle <- function() { class="alert alert-info", role="alert", icon("paper-plane-o"), sprintf("%s (%s).", paste(authors, collapse=" and "), year), - tags$b(title), tags$i(paste0(journal, ".")))) + tags$b(title), tags$i(paste0(journal, ".")), + sprintf("%s(%s), %s", volume, number, pages))) } #' Check if a given function should be loaded by the calling module diff --git a/README.md b/README.md index 197806b2..920cff10 100644 --- a/README.md +++ b/README.md @@ -2,9 +2,9 @@ > **Original article:** > -> Nuno Saraiva-Agostinho and Nuno L. Barbosa-Morais (2018). +> Nuno Saraiva-Agostinho and Nuno L. Barbosa-Morais (2019). [psichomics: graphical application for alternative splicing quantification and analysis][article]. -*Nucleic Acids Research*. +*Nucleic Acids Research*. 47(2), e7. Interactive R package with an intuitive Shiny-based graphical interface for alternative splicing quantification and integrative analyses of diff --git a/inst/CITATION b/inst/CITATION index 7f2a3861..2aca5f7d 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -2,7 +2,11 @@ bibentry(bibtype = "Article", title = "psichomics: graphical application for alternative splicing quantification and analysis", author = c(person("Nuno", "Saraiva-Agostinho"), person(c("Nuno", "L"), "Barbosa-Morais")), - year = 2018, - month = "oct", + year = 2019, + month = "jan", + day = 25, journal = "Nucleic Acids Research", + volume = 47, + number = 2, + pages = "e7", url = "https://doi.org/10.1093/nar/gky888") diff --git a/vignettes/CLI_tutorial.Rmd b/vignettes/CLI_tutorial.Rmd index 19f2793a..9e59ce7a 100644 --- a/vignettes/CLI_tutorial.Rmd +++ b/vignettes/CLI_tutorial.Rmd @@ -170,7 +170,7 @@ identifier > The following case study was adapted from *psichomics*' original article: > -> Nuno Saraiva-Agostinho and Nuno L. Barbosa-Morais (2018). +> Nuno Saraiva-Agostinho and Nuno L. Barbosa-Morais (2019). **[psichomics: graphical application for alternative splicing quantification and analysis][article]**. *Nucleic Acids Research*. Breast cancer is the cancer type with the highest incidence and mortality in diff --git a/vignettes/GUI_tutorial.Rmd b/vignettes/GUI_tutorial.Rmd index e378ab0c..9f74409e 100644 --- a/vignettes/GUI_tutorial.Rmd +++ b/vignettes/GUI_tutorial.Rmd @@ -46,7 +46,7 @@ psichomics() > The following case study was adapted from *psichomics*' original article: > -> Nuno Saraiva-Agostinho and Nuno L. Barbosa-Morais (2018). +> Nuno Saraiva-Agostinho and Nuno L. Barbosa-Morais (2019). **[psichomics: graphical application for alternative splicing quantification and analysis][article]**. *Nucleic Acids Research*. Breast cancer is the cancer type with the highest incidence and mortality in From 387d63051f11ccee7856271f8369b38570b3d556 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Fri, 8 Mar 2019 14:24:35 +0000 Subject: [PATCH 30/46] Improve AS and GE filtering - Present PSI filtering settings in the visual interface - Minor interface tweaks - Fix plot PSI error --- NAMESPACE | 1 + R/data_geNormalisationFiltering.R | 17 +- R/data_inclusionLevels.R | 265 +++++++++++++++++------------- man/filterPSI.Rd | 34 ++++ 4 files changed, 197 insertions(+), 120 deletions(-) create mode 100644 man/filterPSI.Rd diff --git a/NAMESPACE b/NAMESPACE index 41992be2..c8ef48d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(diffAnalyses) export(ensemblToUniprot) export(filterGeneExpr) export(filterGroups) +export(filterPSI) export(getAttributesTime) export(getColumnsTime) export(getDownloadsFolder) diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index a34ac7e3..a60d1e08 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -12,9 +12,9 @@ geNormalisationFilteringInterface <- function(ns) { filters <- div( id=ns("filteringInterface"), fluidRow( - column(6, numericInput(ns("minMean"), "Min mean", + column(6, numericInput(ns("minMean"), "Mean >=", min=-1, max=100, value=0, width="100%")), - column(6, numericInput(ns("minVar"), "Min variance", + column(6, numericInput(ns("minVar"), "Variance >=", min=-1, max=100, value=0, width="100%"))), # fluidRow( # column(6, numericInput(ns("maxMean"), "Max mean", @@ -22,9 +22,9 @@ geNormalisationFilteringInterface <- function(ns) { # column(6, numericInput(ns("maxVar"), "Max variance", # min=-1, max=100, value=100, width="100%"))), fluidRow( - column(6, numericInput(ns("minCounts"), "Min counts", + column(6, numericInput(ns("minCounts"), "Counts >=", min=0, max=100, value=10, width="100%")), - column(6, numericInput(ns("minTotalCounts"), "Min total counts", + column(6, numericInput(ns("minTotalCounts"), "Total counts >=", min=0, max=100, value=15, width="100%"))), helpText(textOutput(ns("filteredGenes")))) @@ -397,6 +397,7 @@ plotMeanVariance <- function(data) { ylab("Square Root of the Standard Deviation") } +#' Sum columns using an \code{\link{EList-class}} object #' @export setMethod("colSums", signature="EList", function(x, na.rm=FALSE, dims=1) { colSums(x$E, na.rm=na.rm, dims=dims) @@ -642,10 +643,10 @@ geNormalisationFilteringServer <- function(input, output, session) { if (filter) { geneFilterSettings <- c( "Gene filtering"="Enabled", - "Minimum mean >="=minMean, # "Maximum mean <="=maxMean, - "Minimum variance >="=minVar, # "Maximum variance <="=maxVar, - "Minimum counts for at least some samples"=minCounts, - "Minimum total counts across samples"=minTotalCounts) + "Mean >="=minMean, # "Mean <="=maxMean, + "Variance >="=minVar, # "Variance <="=maxVar, + "Counts for at least some samples >="=minCounts, + "Total counts across samples >="=minTotalCounts) } else { geneFilterSettings <- c("Gene filtering"="Disabled") } diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index eb54243c..db130d2d 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -43,13 +43,13 @@ listAllAnnotations <- function(...) { inclusionLevelsInterface <- function(ns) { eventTypes <- getSplicingEventTypes() names(eventTypes) <- sprintf("%s (%s)", names(eventTypes), eventTypes) - + filterGenesSelectize <- selectizeInput( ns("filterGenes"), label=NULL, selected=NULL, multiple=TRUE, width="100%", choices=c("Type to search for genes..."=""), options=list( # Allow to add new items create=TRUE, createOnBlur=TRUE, plugins=list("remove_button"))) - + options <- div( id=ns("options"), selectizeInput(ns("junctionQuant"), choices=NULL, width = "100%", @@ -70,6 +70,32 @@ inclusionLevelsInterface <- function(ns) { selectizeInput(ns("sampleFilter"), "Samples to discard", multiple=TRUE, width="100%", choices=character(0))), + bsCollapsePanel( + tagList(icon("filter"), "PSI filtering"), value="PSI filtering", + checkboxInput( + ns("enablePSIfiltering"), value=FALSE, width="100%", + "Filter splicing events based on their PSI values"), + fluidRow( + column(6, numericInput( + ns("minMedian"), "Median >=", + min=0, max=1, value=0, step=0.1, width="100%")), + column(6, numericInput( + ns("maxMedian"), "Median <=", + min=0, max=1, value=1, step=0.1, width="100%"))), + fluidRow( + column(6, numericInput( + ns("minLogVar"), "log10(variance) >=", + min=-10, max=0, value=-10, step=0.5, width="100%")), + column(6, numericInput( + ns("maxLogVar"), "log10(variance) <=", + min=-10, max=0, value=0, step=0.5, width="100%"))), + fluidRow( + column(6, numericInput( + ns("minRange"), "Range >=", + min=0, max=1, value=0, step=0.1, width="100%")), + column(6, numericInput( + ns("maxRange"), "Range <=", + min=0, max=1, value=1, step=0.1, width="100%")))), bsCollapsePanel( title=tagList(icon("filter"), "Filter splicing events by genes"), @@ -85,56 +111,29 @@ inclusionLevelsInterface <- function(ns) { div(class="progress-bar progress-bar-striped active", role="progressbar", style="width:100%", "Loading genes from annotation")), - hidden(div(id=ns("geneOptions"), - filterGenesSelectize, + hidden(div( + id=ns("geneOptions"), filterGenesSelectize, div(id=ns("geneLoadingIcon"), style="position: relative;", # div(class="fa fa-spinner fa-spin", # style="position:absolute;", # style="right:6px;", # style="bottom: 24px;", style="z-index: 2;")), - helpText("Presented genes are based on the selected", - "alternative splicing annotation."))))), + helpText( + "Presented genes are based on the selected", + "alternative splicing annotation."))))), conditionalPanel( sprintf("input[id='%s'] == '%s'", ns("filter"), "file"), fileBrowserInput(ns("filterGenesFile"), NULL, placeholder="No file selected"), helpText("Provide a file with gene symbols separated by a", "space, comma, tab or new line. For instance: ", - tags$code("BRCA1, BRAF, ABL")))), - bsCollapsePanel( - tagList(icon("filter"), "PSI filtering"), value="PSI filtering", - checkboxInput( - ns("enablePSIfiltering"), - "Filter splicing events based on their PSI values", - value=FALSE), - fluidRow( - column(6, numericInput( - ns("minMedian"), "Min median >=", - min=0, max=1, value=0, step=0.1, width="100%")), - column(6, numericInput( - ns("maxMedian"), "Max median <=", - min=0, max=1, value=1, step=0.1, width="100%"))), - fluidRow( - column(6, numericInput( - ns("minLogVar"), "Min log10(variance) >=", - min=-10, max=0, value=-10, step=0.5, width="100%")), - column(6, numericInput( - ns("maxLogVar"), "Max log10(variance) <=", - min=-10, max=0, value=0, step=0.5, width="100%"))), - fluidRow( - column(6, numericInput( - ns("minRange"), "Min range >=", - min=0, max=1, value=0, step=0.1, width="100%")), - column(6, numericInput( - ns("maxRange"), "Max range <=", - min=0, max=1, value=1, step=0.1, width="100%"))) - )), + tags$code("BRCA1, BRAF, ABL"))))), bsTooltip(ns("minReads"), placement = "right", options = list(container = "body"), paste("Discard alternative splicing quantified using a", "number of reads below this threshold."))) - + tagList( uiOutput(ns("modal")), helpText("Exon inclusion levels are measured from exon-exon junction", @@ -193,16 +192,16 @@ quantifySplicing <- function(annotation, junctionQuant, eventIndex <- rep(seq(allGenes), eventGenes) return(df[unique(eventIndex[valid]), ]) } - + genes <- unique(genes) annotation <- lapply(annotation, filterByGenes, genes) } - + # Convert data frame to matrix if needed (faster) mJunctionQuant <- junctionQuant if (!is(mJunctionQuant, "matrix")) mJunctionQuant <- as.matrix(junctionQuant) - + psi <- NULL for (acronym in eventType) { eventTypes <- getSplicingEventTypes() @@ -210,18 +209,18 @@ quantifySplicing <- function(annotation, junctionQuant, thisAnnot <- annotation[[type]] updateProgress("Calculating inclusion levels", type, value=acronym, max=length(eventType)) - + if (!is.null(thisAnnot) && nrow(thisAnnot) > 0) { psi <- rbind(psi, calculateInclusionLevels( acronym, mJunctionQuant, thisAnnot, minReads)) } } - + # Convert matrix to data frame colns <- colnames(psi) psi <- data.frame(psi) colnames(psi) <- colns - + if (is.null(psi)) psi <- data.frame(NULL) psi <- addObjectAttrs( psi, rowNames=TRUE, @@ -265,7 +264,7 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { ns <- session$ns if (input$annotation == "loadAnnotation") { url <- "http://rpubs.com/nuno-agostinho/preparing-AS-annotation" - + updateSelectizeInput(session, "annotation", selected=listSplicingAnnotations()) infoModal(session, "Load alternative splicing annotation", @@ -286,7 +285,7 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { class="btn-primary")) } }) - + # Load custom splicing annotation observeEvent(input$loadCustom, { customAnnot <- input$customAnnot @@ -311,7 +310,7 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { } }) } - + #' Set of functions to load splicing quantification #' #' @inherit inclusionLevelsServer @@ -322,7 +321,7 @@ loadCustomSplicingAnnotationSet <- function(session, input, output) { #' @keywords internal loadSplicingQuantificationSet <- function(session, input, output) { ns <- session$ns - + # Show modal for loading alternative splicing quantification observeEvent(input$loadIncLevels, { infoModal( @@ -332,22 +331,22 @@ loadSplicingQuantificationSet <- function(session, input, output) { uiOutput(ns("alertIncLevels")), footer=processButton(ns("loadASquant"), "Load quantification")) }) - + observeEvent(input$loadIncLevels, { prepareFileBrowser(session, input, "customASquant") }, once=TRUE) - + # Load alternative splicing quantification loadSplicing <- reactive({ time <- startProcess("loadIncLevels") - + startProgress("Wait a moment", divisions=2) updateProgress("Loading alternative splicing quantification") - + allFormats <- loadFileFormats() formats <- allFormats[sapply(allFormats, "[[", "dataType") == "Inclusion levels"] - + psi <- tryCatch(parseValidFile(input$customASquant, formats), warning=return, error=return) if (is(psi, "error")) { @@ -366,17 +365,17 @@ loadSplicingQuantificationSet <- function(session, input, output) { caller="Alternative splicing quantification") } else { removeAlert(output, "alertIncLevels") - + if ( is.null(getData()) ) { name <- file_path_sans_ext( basename(input$customASquant) ) name <- gsub(" Inclusion levels.*$", "", name) if (name == "") name <- "Unnamed" - + data <- setNames(list(list("Inclusion levels"=psi)), name) data <- processDatasetNames(data) setData(data) setCategory(name) - + samples <- colnames(psi) parsed <- parseTcgaSampleInfo(samples) if ( !is.null(parsed) ) setSampleInfo(parsed) @@ -389,7 +388,7 @@ loadSplicingQuantificationSet <- function(session, input, output) { } endProcess("loadIncLevels", time) }) - + # Show warnings if needed before loading splicing quantification observeEvent(input$loadASquant, { if (!is.null(getInclusionLevels())) { @@ -415,14 +414,14 @@ loadSplicingQuantificationSet <- function(session, input, output) { loadSplicing() } }) - + # Replace previous splicing quantification observeEvent(input$replace2, { setGroups("Samples", NULL) setGroups("AS events", NULL) loadSplicing() }) - + # Discard differential analyses and replace previous splicing quantification observeEvent(input$discard2, { setDifferentialSplicing(NULL) @@ -450,7 +449,7 @@ readAnnot <- function(session, annotation, showProgress=FALSE) { if (showProgress) updateProgress("Downloading alternative splicing annotation") annot <- loadAnnotation(annotation) - + # Set species and assembly version allAnnot <- listSplicingAnnotations() annotID <- names(allAnnot)[match(annotation, allAnnot)] @@ -467,8 +466,8 @@ readAnnot <- function(session, annotation, showProgress=FALSE) { #' @keywords internal quantifySplicingSet <- function(session, input) { ns <- session$ns - - + + # Calculate inclusion levels calcSplicing <- reactive({ eventType <- input$eventType @@ -489,7 +488,7 @@ quantifySplicingSet <- function(session, input) { if (is.na(minRange)) minRange <- -Inf maxRange <- input$maxRange if (is.na(maxRange)) maxRange <- Inf - + if (is.null(eventType) || is.null(minReads) || is.null(annotation)) { return(NULL) } else if (input$junctionQuant == "") { @@ -505,7 +504,7 @@ quantifySplicingSet <- function(session, input) { # Read annotation annot <- readAnnot(session, annotation, showProgress=TRUE) junctionQuant <- getJunctionQuantification()[[input$junctionQuant]] - + # Filter alternative splicing events based on their genes filter <- NULL if (input$filter == "select") { @@ -523,19 +522,23 @@ quantifySplicingSet <- function(session, input) { filter <- NULL } } - + # Discard samples sampleFilter <- input$sampleFilter if (!is.null(sampleFilter) && sampleFilter != "") { samplesToKeep <- !colnames(junctionQuant) %in% sampleFilter junctionQuant <- junctionQuant[ , samplesToKeep] + sampleFilterText <- paste(sampleFilter, collapse=", ") + } else { + sampleFilterText <- "None" } - + sampleFilterSettings <- c("Discarded samples"=sampleFilterText) + # Quantify splicing with splicing annotation and junction quantification updateProgress("Calculating inclusion levels") psi <- quantifySplicing(annot, junctionQuant, eventType, minReads, genes=filter) - + if (nrow(psi) == 0) { errorModal(session, "No splicing events returned", "The total reads of the alternative splicing events are", @@ -544,43 +547,47 @@ quantifySplicingSet <- function(session, input) { endProcess("calcIncLevels") return(NULL) } - + + # Filter PSI values + if (enablePSIfiltering) { + filtered <- filterPSI( + psi, minMedian=minMedian, maxMedian=maxMedian, + minLogVar=minLogVar, maxLogVar=maxLogVar, + minRange=minRange, maxRange=maxRange) + filteredPSI <- psi[filtered, ] + filterSettings <- c("Filter enabled"="Yes", + "Median >="=minMedian, + "Median <="=maxMedian, + "log10(variance) >="=minLogVar, + "log10(variance) <="=maxLogVar, + "Range >="=minRange, + "Range <="=maxRange) + } else { + filteredPSI <- psi + filterSettings <- c("Filter enabled"="No") + } + # Include settings used for alternative splicing quantification allEventTypes <- getSplicingEventTypes() eventTypeName <- names(allEventTypes[allEventTypes %in% eventType]) - settings <- list( - "Alternative splicing annotation"=annotation, - "Exon-exon junction quantification (label)"=input$junctionQuant, - "Exon-exon junction quantification (file)"=attr( - junctionQuant, "filename"), - "Splicing event types"=eventTypeName, - "Minimum read counts' threshold"=minReads, - "Selected genes for splicing event quantification"=if (is.null( - filter)) "All available genes" else filter) + settings <- c( + list( + "Alternative splicing annotation"=annotation, + "Exon-exon junction quantification (label)"=input$junctionQuant, + "Exon-exon junction quantification (file)"=attr( + junctionQuant, "filename"), + "Splicing event types"=eventTypeName, + "Minimum read counts' threshold"=minReads, + "Selected genes for splicing event quantification"=if (is.null( + filter)) "All available genes" else filter), + sampleFilterSettings, filterSettings) attr(psi, "settings") <- settings attr(psi, "icon") <- list(symbol="calculator", colour="green") - - # Filter PSI - if (enablePSIfiltering) { - medians <- rowMedians(psi, na.rm=TRUE) - medianThres <- medians >= minMedian & medians <= maxMedian - - vars <- log10(rowVars(psi, na.rm=TRUE)) - varThres <- vars >= minLogVar & vars <= maxLogVar - - ranges <- apply(psi, 1, max, na.rm=TRUE) - apply(psi, 1, min, - na.rm=TRUE) - rangeThres <- ranges >= minRange & ranges <= maxRange - - thres <- which(medianThres & varThres & rangeThres) - filteredPSI <- psi[thres, ] - } else { - filteredPSI <- psi - } + setInclusionLevels(filteredPSI) endProcess("calcIncLevels", time) }) - + # Show warnings if needed before quantifying alternative splicing observeEvent(input$calcIncLevels, { if (is.null(getData()) || is.null(getJunctionQuantification())) { @@ -608,7 +615,7 @@ quantifySplicingSet <- function(session, input) { calcSplicing() } }) - + observeEvent(input$replace, calcSplicing()) observeEvent(input$discard, { setDifferentialSplicing(NULL) @@ -617,6 +624,40 @@ quantifySplicingSet <- function(session, input) { }) } +#' Filter alternative splicing quantification +#' +#' @param psi Data frame or matrix: alternative splicing quantification +#' @param minMedian Numeric: minimum of read count median per splicing event +#' @param maxMedian Numeric: maximum of read count median per splicing event +#' @param minLogVar Numeric: minimum log10(read count variance) per splicing +#' event +#' @param maxLogVar Numeric: maximum log10(read count variance) per splicing +#' event +#' @param minRange Numeric: minimum range of read counts across samples per +#' splicing event +#' @param maxRange Numeric: maximum range of read counts across samples per +#' splicing event +#' +#' @importFrom miscTools rowMedians +#' +#' @return Boolean vector indicating which splicing events pass the thresholds +#' @export +filterPSI <- function(psi, minMedian=-Inf, maxMedian=Inf, + minLogVar=-Inf, maxLogVar=Inf, + minRange=-Inf, maxRange=Inf) { + medians <- rowMedians(psi, na.rm=TRUE) + medianThres <- medians >= minMedian & medians <= maxMedian + + vars <- log10(rowVars(psi, na.rm=TRUE)) + varThres <- vars >= minLogVar & vars <= maxLogVar + + ranges <- apply(psi, 1, max, na.rm=TRUE) - apply(psi, 1, min, na.rm=TRUE) + rangeThres <- ranges >= minRange & ranges <= maxRange + + thres <- which(medianThres & varThres & rangeThres) + return(thres) +} + #' Plot alternative splicing quantification #' #' @param psi Data frame or matrix: alternative splicing quantification @@ -645,31 +686,31 @@ plotPSI <- function(psi, x, y, minX=NULL, maxX=NULL, minY=NULL, stop("x and y require to contain one of the strings:", "median, var, range") } - + if (any(grepl("var", c(x, y)))) { message("Calculating variance per splicing event...") var <- rowVars(psi, na.rm=TRUE) } - + if (any(grepl("median", c(x, y)))) { message("Calculating median per splicing event...") median <- rowMedians(psi, na.rm=TRUE) } - + if (any(grepl("range", c(x, y)))) { message("Calculating range per splicing event...") range <- apply(psi, 1, max, na.rm=TRUE) - apply(psi, 1, min, na.rm=TRUE) } - + message("Plotting...") plot <- ggplot(mapping=aes_string(x=x, y=y)) + # geom_hex(na.rm=TRUE) + geom_point(size=1, na.rm=TRUE, alpha=0.5) + geom_density_2d(colour="orange", na.rm=TRUE) - + if (!is.null(xlim)) plot <- plot + ylim(xlim) if (!is.null(ylim)) plot <- plot + ylim(ylim) - + xThreshold1 <- xThreshold2 <- yThreshold1 <- yThreshold2 <- TRUE if (!is.null(minX)) { plot <- plot + geom_vline(xintercept=minX, colour="red") @@ -702,9 +743,9 @@ plotPSI <- function(psi, x, y, minX=NULL, maxX=NULL, minY=NULL, inclusionLevelsServer <- function(input, output, session) { ns <- session$ns observeEvent(input$missing, missingDataGuide("Junction quantification")) - + prepareFileBrowser(session, input, "filterGenesFile") - + # Update available junction quantification according to loaded files observe({ junctionQuant <- getJunctionQuantification() @@ -718,7 +759,7 @@ inclusionLevelsServer <- function(input, output, session) { choices=c("No junction quantification loaded"="")) } }) - + # Warn user if junction quantification is not loaded observe({ if (is.null(getData()) || is.null(getJunctionQuantification())) { @@ -731,12 +772,12 @@ inclusionLevelsServer <- function(input, output, session) { hide("missingData") } }) - + # Update gene symbols for filtering based on selected annotation observe({ annotation <- input$annotation filter <- input$filter - + # Avoid loading if already loaded if (filter == "select" && !is.null(annotation) && !annotation %in% c("", "loadAnnotation") && @@ -744,7 +785,7 @@ inclusionLevelsServer <- function(input, output, session) { # Show loading bar show("geneOptionsLoading") hide("geneOptions") - + annotation <- input$annotation startProgress("Loading alternative splicing annotation", divisions=2) @@ -754,14 +795,14 @@ inclusionLevelsServer <- function(input, output, session) { updateSelectizeInput(session, "filterGenes", choices=genes, selected=character(0), server=TRUE) closeProgress("Gene list prepared") - + setAnnotationName(annotation) # Show gene options set hide("geneOptionsLoading") show("geneOptions") } }) - + # Toggle visibility of loading icon observe({ toggle("geneLoadingIcon", @@ -769,7 +810,7 @@ inclusionLevelsServer <- function(input, output, session) { '$("#data-inclusionLevels-filterGenes").parent()', '.children("div.selectize-control").hasClass("loading")')) }) - + # Update default AS event annotation based on selected dataset observe({ data <- getCategoryData() @@ -782,7 +823,7 @@ inclusionLevelsServer <- function(input, output, session) { } updateSelectizeInput(session, "annotation", selected=selected) }) - + # Update sample filtering options observeEvent(input$junctionQuant, { junctionQuant <- getJunctionQuantification()[[input$junctionQuant]] @@ -820,4 +861,4 @@ inclusionLevelsServer <- function(input, output, session) { } attr(inclusionLevelsUI, "loader") <- "data" -attr(inclusionLevelsServer, "loader") <- "data" \ No newline at end of file +attr(inclusionLevelsServer, "loader") <- "data" diff --git a/man/filterPSI.Rd b/man/filterPSI.Rd new file mode 100644 index 00000000..8512fc1e --- /dev/null +++ b/man/filterPSI.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_inclusionLevels.R +\name{filterPSI} +\alias{filterPSI} +\title{Filter alternative splicing quantification} +\usage{ +filterPSI(psi, minMedian = -Inf, maxMedian = Inf, minLogVar = -Inf, + maxLogVar = Inf, minRange = -Inf, maxRange = Inf) +} +\arguments{ +\item{psi}{Data frame or matrix: alternative splicing quantification} + +\item{minMedian}{Numeric: minimum of read count median per splicing event} + +\item{maxMedian}{Numeric: maximum of read count median per splicing event} + +\item{minLogVar}{Numeric: minimum log10(read count variance) per splicing +event} + +\item{maxLogVar}{Numeric: maximum log10(read count variance) per splicing +event} + +\item{minRange}{Numeric: minimum range of read counts across samples per +splicing event} + +\item{maxRange}{Numeric: maximum range of read counts across samples per +splicing event} +} +\value{ +Boolean vector indicating which splicing events pass the thresholds +} +\description{ +Filter alternative splicing quantification +} From 1caf8bada79c40a23afb39422050550f2c9aae6d Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Fri, 15 Mar 2019 16:22:27 +0100 Subject: [PATCH 31/46] Plot specific combinations of gene and alternative splicing events after performing correlation analyses --- NAMESPACE | 1 + NEWS | 2 + R/analysis_correlation.R | 118 ++++++++++++++++++++++++++++++--- man/sub-.GEandAScorrelation.Rd | 23 +++++++ 4 files changed, 134 insertions(+), 10 deletions(-) create mode 100644 man/sub-.GEandAScorrelation.Rd diff --git a/NAMESPACE b/NAMESPACE index c8ef48d7..a5e71045 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method("[",GEandAScorrelation) S3method(as.table,GEandAScorrelation) S3method(plot,GEandAScorrelation) S3method(print,GEandAScorrelation) diff --git a/NEWS b/NEWS index b12abf10..813616d8 100644 --- a/NEWS +++ b/NEWS @@ -32,6 +32,8 @@ * Correlation analyses: - Allow to use groups of genes and alternative splicing events in correlation analyses + - Plot specific combinations of gene and alternative splicing events + (`[.GEandAScorrelation`()) - Display progress when performing correlation analyses - Display correlation results in a table (`as.table()`) * Gene, transcript and protein information: diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index 5c11fe3e..a8a51224 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -78,6 +78,24 @@ correlationUI <- function(id) { scatterParams <- bsCollapsePanel( tagList(icon("sliders"), "Scatterplot options"), value="scatterplotOptions", style="info", + radioButtons( + ns("genesToPlot"), "Genes to plot", width="100%", + c("All genes"="all", "Selected genes"="selected")), + conditionalPanel( + sprintf("input[id='%s'] == '%s'", ns("genesToPlot"), "selected"), + selectizeInput(ns("selectedGenesToPlot"), label="Genes to plot", + choices=NULL, width="100%", multiple=TRUE, + options=list(placeholder="Select genes to plot"))), + radioButtons( + ns("ASeventsToPlot"), "Alternative splicing events to plot", + c("All events"="all", "Selected events"="selected")), + conditionalPanel( + sprintf("input[id='%s'] == '%s'", ns("ASeventsToPlot"), "selected"), + selectizeInput( + ns("selectedASeventsToPlot"), + label="Splicing events to plot", + choices=NULL, width="100%", multiple=TRUE, + options=list(placeholder="Select splicing events to plot"))), selectGroupsUI( ns("groupColour"), label="Sample colouring", noGroupsLabel="Same colour for all samples", @@ -260,6 +278,62 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { return(res) } +#' Subset correlation results between gene expression and splicing +#' quantification +#' +#' @param x \code{GEandAScorrelation} object to subset +#' @param genes Character: genes +#' @param ASevents Character: ASevents +#' +#' @method [ GEandAScorrelation +#' +#' @return \code{GEandAScorrelation} object subset +#' @export +`[.GEandAScorrelation` <- function(x, genes=NULL, ASevents=NULL) { + x <- unclass(x) + + if (!is.null(ASevents)) { + if (is.numeric(ASevents)) { + x <- x[ASevents] + } else if (any(ASevents %in% names(x))) { + ASevents <- ASevents[ASevents %in% names(x)] + x <- x[ASevents] + } else { + x <- NULL + } + } + # TODO: What if AS events do not match anything here? + if (is.null(x)) return(NULL) + + if (!is.null(genes)) { + for (eachASevent in seq(x)) { + if (is.numeric(genes)) { + x[[eachASevent]] <- x[[eachASevent]][genes] + } else { + ns <- names(x[[eachASevent]]) + matched <- c(match(genes, ns), + match(genes, gsub("\\|.*", "", ns))) + matched <- na.omit(matched) + geneNames <- ns[matched] + if (any(geneNames %in% ns)) { + x[[eachASevent]] <- x[[eachASevent]][geneNames] + } else { + x[[eachASevent]] <- NULL + } + } + } + } + + x <- lapply(x, function(item) Filter(Negate(is.null), item)) + x <- Filter(length, x) + if (length(x) > 0 && !is.null(x)) { + class(x) <- c("GEandAScorrelation", class(x)) + } else { + x <- NULL + } + return(x) +} + #' Display results of correlation analyses #' #' @param x \code{GEandAScorrelation} object (obtained after running @@ -314,13 +388,11 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' Tumour=paste("Cancer", 1:3)) #' attr(colourGroups, "Colour") <- c(Normal="#00C65A", Tumour="#EEE273") #' plot(corr, colourGroups=colourGroups, alpha=1) -plot.GEandAScorrelation <- function(x, autoZoom=FALSE, loessSmooth=TRUE, - loessFamily=c("gaussian", "symmetric"), - colour="black", alpha=0.2, size=1.5, - loessColour="red", loessAlpha=1, loessWidth=0.5, - fontSize=12, ..., colourGroups=NULL, legend=FALSE, - showAllData=TRUE, density=FALSE, - densityColour="blue", densityWidth=0.5) { +plot.GEandAScorrelation <- function( + x, autoZoom=FALSE, loessSmooth=TRUE, loessFamily=c("gaussian", "symmetric"), + colour="black", alpha=0.2, size=1.5, loessColour="red", loessAlpha=1, + loessWidth=0.5, fontSize=12, ..., colourGroups=NULL, legend=FALSE, + showAllData=TRUE, density=FALSE, densityColour="blue", densityWidth=0.5) { loessFamily <- match.arg(loessFamily) plotCorrPerASevent <- function(single) { @@ -598,11 +670,11 @@ correlationServer <- function(input, output, session) { "Please selected gene expression data", caller="Correlation analysis") } else if (is.null(gene) || identical(gene, "")) { - errorModal(session, "No gene selected", "Please select a gene", + errorModal(session, "No gene selected", "Please select genes", caller="Correlation analysis") } else if (is.null(ASevents) || identical(ASevents, "")) { errorModal(session, "No alternative splicing event selected", - "Please select one or more alternative splicing events", + "Please select alternative splicing events", caller="Correlation analysis") } else if (!is.null(cor)) { warningModal(session, "Correlation analyses already performed", @@ -623,6 +695,15 @@ correlationServer <- function(input, output, session) { plotShinyCorr <- reactive({ ns <- session$ns corr <- getCorrelation() + if (is.null(corr) || !is(corr, "GEandAScorrelation")) return(NULL) + + genes <- input$selectedGenesToPlot + if (input$genesToPlot == "selected" && !is.null(genes)) + corr <- corr[genes=genes] + + ASevents <- input$selectedASeventsToPlot + if (input$ASeventsToPlot == "selected" && !is.null(ASevents)) + corr <- corr[ASevents=ASevents] if (is.null(corr)) return(NULL) autoZoom <- input$zoom @@ -647,7 +728,7 @@ correlationServer <- function(input, output, session) { groupColour <- getSelectedGroups( input, "groupColour", "Samples", filter=names(corr[[1]][[1]]$psi)) - plots <- plotCorrelation( + plots <- plot( corr, colour=colour, alpha=alpha, size=size, fontSize=fontSize, autoZoom=autoZoom, loessFamily=loessFamily, loessSmooth=loessSmooth, loessColour=loessColour, loessWidth=loessWidth, @@ -697,6 +778,23 @@ correlationServer <- function(input, output, session) { endProcess("applyPlotStyle") }) + # Update choices to select genes and alternative splicing events to plot + observe({ + corr <- getCorrelation() + if (!is.null(corr)) { + geneChoices <- unique(unlist(sapply(corr, names))) + ASeventChoices <- names(corr) + names(ASeventChoices) <- parseSplicingEvent(names(corr), char=TRUE) + } else { + geneChoices <- character(0) + ASeventChoices <- character(0) + } + updateSelectizeInput(session, "selectedGenesToPlot", + choices=geneChoices) + updateSelectizeInput(session, "selectedASeventsToPlot", + choices=ASeventChoices) + }) + observeEvent(input$missingInclusionLevels, missingDataGuide("Inclusion levels")) observeEvent(input$loadData, missingDataGuide("Inclusion levels")) diff --git a/man/sub-.GEandAScorrelation.Rd b/man/sub-.GEandAScorrelation.Rd new file mode 100644 index 00000000..b9c6c7ac --- /dev/null +++ b/man/sub-.GEandAScorrelation.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis_correlation.R +\name{[.GEandAScorrelation} +\alias{[.GEandAScorrelation} +\title{Subset correlation results between gene expression and splicing +quantification} +\usage{ +\method{[}{GEandAScorrelation}(x, genes = NULL, ASevents = NULL) +} +\arguments{ +\item{x}{\code{GEandAScorrelation} object to subset} + +\item{genes}{Character: genes} + +\item{ASevents}{Character: ASevents} +} +\value{ +\code{GEandAScorrelation} object subset +} +\description{ +Subset correlation results between gene expression and splicing +quantification +} From 3cb42cf98e05b35bd2006ab9ae5f85833e707032 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 18 Mar 2019 15:43:04 +0000 Subject: [PATCH 32/46] Improve and fix plotting of gene expression and alternative splicing quantification data --- NAMESPACE | 5 +- NEWS | 4 +- R/analysis.R | 2 +- R/data.R | 119 +++++++++++++++++++++++++++--- R/data_geNormalisationFiltering.R | 14 ---- R/data_inclusionLevels.R | 76 ------------------- man/colSums-EList-method.Rd | 12 +++ man/plotMeanVariance.Rd | 17 ----- man/plotPSI.Rd | 39 ---------- man/plotRowStats.Rd | 44 +++++++++++ 10 files changed, 170 insertions(+), 162 deletions(-) create mode 100644 man/colSums-EList-method.Rd delete mode 100644 man/plotMeanVariance.Rd delete mode 100644 man/plotPSI.Rd create mode 100644 man/plotRowStats.Rd diff --git a/NAMESPACE b/NAMESPACE index a5e71045..80f16ff0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -64,10 +64,10 @@ export(plotDistribution) export(plotGeneExprPerSample) export(plotGroupIndependence) export(plotICA) -export(plotMeanVariance) export(plotPCA) -export(plotPSI) export(plotProtein) +export(plotPvaluesByCutoff) +export(plotRowStats) export(plotSurvivalCurves) export(plotTranscripts) export(plotVariance) @@ -154,6 +154,7 @@ importFrom(ggplot2,scale_fill_gradient2) importFrom(ggplot2,theme) importFrom(ggplot2,theme_light) importFrom(ggplot2,unit) +importFrom(ggplot2,xlim) importFrom(ggplot2,ylab) importFrom(ggplot2,ylim) importFrom(ggrepel,geom_label_repel) diff --git a/NEWS b/NEWS index 813616d8..3b360d2e 100644 --- a/NEWS +++ b/NEWS @@ -8,7 +8,7 @@ - Allow to discard samples before alternative splicing quantification - In alternative splicing quantification dataset summary, plot quantification based on median, variance and range per splicing event across - samples to provide tools to filter quantification (`plotPSI()`) + samples to provide tools to filter quantification (`plotRowStats()`) * Gene expression filtering and normalisation: - Allow to discard samples before filtering and normalisation - Filter low read counts using `edgeR::filterByExpr()` @@ -18,7 +18,7 @@ per sample, distribution of library sizes and gene-wise mean and variance of gene expression across samples to provide the user tools to assess gene expression normalisation (`plotGeneExprPerSample()`, `plotDistribution` and - `plotMeanVariance()`, respectively) + `plotRowStats()`, respectively) - Convert between different gene identifiers (the original identifier is kept in some conditions, read `convertGeneIdentifiers`); in the visual interface, when filtering and normalising gene expression, ENSEMBL diff --git a/R/analysis.R b/R/analysis.R index ac561b41..f88f2073 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -1798,7 +1798,7 @@ renderBoxplot <- function(data, outliers=FALSE, sortByMedian=TRUE, hc <- hcboxplot(melted$value, melted$variable, outliers=outliers) %>% hc_chart(zoomType="x", type="column") %>% hc_plotOptions(boxplot=list(color="black", fillColor="orange")) %>% - hc_xAxis(labels=list(enabled=showXlabels)) %>% + hc_xAxis(labels=list(enabled=showXlabels), visible=showXlabels) %>% hc_title(text=title) if (min(melted$value) >= 0) hc <- hc %>% hc_yAxis(min=0) diff --git a/R/data.R b/R/data.R index 91799e3c..ae668876 100644 --- a/R/data.R +++ b/R/data.R @@ -122,6 +122,92 @@ loadTCGAsampleMetadata <- function(data) { return(data) } +#' Plot sample statistics per row +#' +#' @param data Data frame or matrix +#' @param x,y Character: statistic to calculate and display in the plot per row; +#' choose between \code{mean}, \code{median}, \code{var} or \code{range} +#' (or transformations of those variables, e.g. \code{log10(var)}) +#' @param minX,maxX,minY,maxY Numeric: minimum and maximum X and Y values to +#' draw in the plot +#' @param xLim,yLim Numeric: X and Y axis range +#' +#' @importFrom ggplot2 geom_vline geom_hline xlim ylim +#' +#' @return Plot of \code{data} +#' @export +#' +#' @examples +#' # Plotting gene expression data +#' geneExpr <- readFile("ex_gene_expression.RDS") +#' plotRowStats(geneExpr, "mean", "var^(1/4)") + +#' ggtitle("Mean-variance plot") + +#' ylab("Square Root of the Standard Deviation") +#' +#' # Plotting alternative splicing quantification +#' annot <- readFile("ex_splicing_annotation.RDS") +#' junctionQuant <- readFile("ex_junctionQuant.RDS") +#' psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) +#' +#' medianVar <- plotRowStats(table, x="median", y="var", xLim=c(0, 1)) + +#' labs(x="Median PSI", y="PSI variance") +#' rangeVar <- plotRowStats(table, x="range", y="log10(var)", xLim=c(0, 1)) + +#' labs(x="PSI range", y="log10(PSI variance)") +plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, + maxY=NULL, xLim=NULL, yLim=NULL) { + stats <- c("range", "var", "median", "mean") + if (!any(sapply(stats, grepl, x)) || !any(sapply(stats, grepl, y))) { + stop("x and y require to contain one of the strings:", + "median, var, range") + } + + calculateXandYvalues <- function(psi, stats) { + names(stats) <- stats + input <- lapply(stats, grepl, c(x, y)) + + rowRanges <- function(mat, ...) { + apply(mat, 1, max, ...) - apply(mat, 1, min, ...) + # apply(mat, 1, function(k) max(k, ...) - min(k, ...)) + } + + x <- y <- NULL + vars <- list() + for (stat in stats) { + message(sprintf("Calculating %s per splicing event...", stat)) + + if (any(input[[stat]])) { + FUN <- switch(stat, + "var"=rowVars, + "mean"=rowMeans, + "median"=rowMedians, + "range"=rowRanges) + res <- FUN(psi, na.rm=TRUE) + vars[[stat]] <- res + } + } + vars <- data.frame(vars, stringsAsFactors=FALSE) + return(vars) + } + vars <- calculateXandYvalues(data, stats) + + message("Plotting...") + plot <- ggplot(vars, aes_string(x, y)) + + # geom_hex(na.rm=TRUE) + + geom_point(size=1, na.rm=TRUE, alpha=0.5) + + geom_density_2d(colour="orange", na.rm=TRUE) + + labs(x=x, y=y) + + if (!is.null(xLim)) plot <- plot + xlim(xLim) + if (!is.null(yLim)) plot <- plot + ylim(yLim) + + # Intercept lines + if (!is.null(minX)) plot <- plot + geom_vline(xintercept=minX, colour="red") + if (!is.null(maxX)) plot <- plot + geom_vline(xintercept=maxX, colour="red") + if (!is.null(minY)) plot <- plot + geom_hline(yintercept=minY, colour="red") + if (!is.null(maxY)) plot <- plot + geom_hline(yintercept=maxY, colour="red") + return(plot) +} + #' Warn user about loaded data #' #' @param modalId Character: identifier of the modal @@ -516,27 +602,38 @@ createDataTab <- function(index, data, name, session, input, output) { if (isGeneExpr) { if (is(table, "EList")) table <- table$E geneExprPerSamplePlot <- plotGeneExprPerSample( - table, sortByMedian=TRUE) + table, sortByMedian=TRUE, + title="Gene expression distribution per sample") librarySizePlot <- suppressWarnings( plotDistribution(log10(colSums(table)), rugLabels=TRUE, vLine=FALSE) %>% hc_xAxis(title=list(text="log10(Library sizes)")) %>% hc_yAxis(title=list(text="Density")) %>% - hc_legend(enabled=FALSE)) + hc_legend(enabled=FALSE) %>% + hc_title( + text="Library size distribution across samples") %>% + hc_subtitle(text=paste("Library size: number total", + "mapped reads"))) librarySizePlot$x$hc_opts$series[[1]]$color <- NULL librarySizePlot$x$hc_opts$series[[2]]$marker$fillColor <- NULL - plots <- list(plot=plotMeanVariance(table), - highchart=geneExprPerSamplePlot, - highchart=librarySizePlot) + plots <- list( + highchart=geneExprPerSamplePlot, + highchart=librarySizePlot) } else if (isPSI) { - medianVar <- plotPSI(table, x="median", y="var") %>% - hc_xAxis(title=list(text="Median PSI")) %>% - hc_yAxis(title=list(text="PSI Variance")) - rangeVar <- plotPSI(table, x="range", y="log10(var)") %>% - hc_xAxis(title=list(text="PSI Range")) %>% - hc_yAxis(title=list(text="log10(PSI Variance)")) + medianVar <- plotRowStats(table, x="median", y="var", + xLim=c(0,1 )) + + labs(x="PSI median", y="PSI variance") + + ggtitle(paste("Scatterplot of alternative splicing", + "quantification per event")) + + theme_light(14) + rangeVar <- plotRowStats(table, x="range", y="log10(var)", + xLim=c(0, 1)) + + labs(x="PSI range", y="log10(PSI variance)") + + ggtitle(paste("Scatterplot of alternative splicing", + "quantification per event")) + + theme_light(14) plots <- list(plot=medianVar, plot=rangeVar) } attr(table, "plots") <- plots diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index a60d1e08..5cca2cab 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -383,20 +383,6 @@ plotGeneExprPerSample <- function(geneExpr, ...) { hc_yAxis(title=list(text="Gene expression")) } -#' Render mean-variance plot -#' -#' @param data Data frame or matrix: gene expression or junction quantification -#' -#' @return Mean-variance plot -#' @export -plotMeanVariance <- function(data) { - df <- data.frame(Mean=rowMeans(data), Variance=rowVars(data)) - ggplot(df, aes_string("Mean", "Variance^(1/4)")) + - geom_point() + - ggtitle("Mean-variance plot") + - ylab("Square Root of the Standard Deviation") -} - #' Sum columns using an \code{\link{EList-class}} object #' @export setMethod("colSums", signature="EList", function(x, na.rm=FALSE, dims=1) { diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index db130d2d..c8673d85 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -658,82 +658,6 @@ filterPSI <- function(psi, minMedian=-Inf, maxMedian=Inf, return(thres) } -#' Plot alternative splicing quantification -#' -#' @param psi Data frame or matrix: alternative splicing quantification -#' @param x Character: \code{median}, \code{var} or \code{range} (or -#' transformations of those variables, such as \code{log10(var)}) -#' @param y Character: \code{median}, \code{var} or \code{range} (or -#' transformations of those variables, such as \code{log10(var)}) -#' @param minX Numeric: minimum X to subset data -#' @param maxX Numeric: maximum X to subset data -#' @param minY Numeric: minimum Y to subset data -#' @param maxY Numeric: maximum Y to subset data -#' @param xlim Numeric: minimum and maximum X to display -#' @param ylim Numeric: minimum and maximum Y to display -#' -#' @importFrom ggplot2 geom_vline geom_hline ylim -#' -#' @return Plot with the variables chosen in \code{x} and \code{y}. Also -#' includes an attribute \code{threshold}: a boolean vector stating which genes -#' pass the threshold based on \code{minX}, \code{maxX}, \code{minY} and -#' \code{maxY}. -#' @export -plotPSI <- function(psi, x, y, minX=NULL, maxX=NULL, minY=NULL, - maxY=NULL, xlim=NULL, ylim=NULL) { - stats <- c("range", "var", "median") - if (!any(sapply(stats, grepl, x)) || !any(sapply(stats, grepl, y))) { - stop("x and y require to contain one of the strings:", - "median, var, range") - } - - if (any(grepl("var", c(x, y)))) { - message("Calculating variance per splicing event...") - var <- rowVars(psi, na.rm=TRUE) - } - - if (any(grepl("median", c(x, y)))) { - message("Calculating median per splicing event...") - median <- rowMedians(psi, na.rm=TRUE) - } - - if (any(grepl("range", c(x, y)))) { - message("Calculating range per splicing event...") - range <- apply(psi, 1, max, na.rm=TRUE) - apply(psi, 1, min, na.rm=TRUE) - } - - message("Plotting...") - plot <- ggplot(mapping=aes_string(x=x, y=y)) + - # geom_hex(na.rm=TRUE) + - geom_point(size=1, na.rm=TRUE, alpha=0.5) + - geom_density_2d(colour="orange", na.rm=TRUE) - - if (!is.null(xlim)) plot <- plot + ylim(xlim) - if (!is.null(ylim)) plot <- plot + ylim(ylim) - - xThreshold1 <- xThreshold2 <- yThreshold1 <- yThreshold2 <- TRUE - if (!is.null(minX)) { - plot <- plot + geom_vline(xintercept=minX, colour="red") - xThreshold1 <- eval(parse(text=x)) > minX - } - if (!is.null(maxX)) { - plot <- plot + geom_vline(xintercept=maxX, colour="red") - xThreshold2 <- eval(parse(text=x)) < maxX - } - if (!is.null(minY)) { - plot <- plot + geom_hline(yintercept=minY, colour="red") - yThreshold1 <- eval(parse(text=y)) > minY - } - if (!is.null(maxY)) { - plot <- plot + geom_hline(yintercept=maxY, colour="red") - yThreshold2 <- eval(parse(text=y)) > maxY - } - subset <- xThreshold1 & xThreshold2 & yThreshold1 & yThreshold2 - message(sprintf("%s splicing events subset to %s", nrow(psi), sum(subset))) - attr(plot, "threshold") <- subset - return(plot) -} - #' @rdname appServer #' #' @importFrom shiny reactive observeEvent helpText removeModal diff --git a/man/colSums-EList-method.Rd b/man/colSums-EList-method.Rd new file mode 100644 index 00000000..d92e8564 --- /dev/null +++ b/man/colSums-EList-method.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_geNormalisationFiltering.R +\docType{methods} +\name{colSums,EList-method} +\alias{colSums,EList-method} +\title{Sum columns using an \code{\link{EList-class}} object} +\usage{ +\S4method{colSums}{EList}(x, na.rm = FALSE, dims = 1) +} +\description{ +Sum columns using an \code{\link{EList-class}} object +} diff --git a/man/plotMeanVariance.Rd b/man/plotMeanVariance.Rd deleted file mode 100644 index 791516b5..00000000 --- a/man/plotMeanVariance.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_geNormalisationFiltering.R -\name{plotMeanVariance} -\alias{plotMeanVariance} -\title{Render mean-variance plot} -\usage{ -plotMeanVariance(data) -} -\arguments{ -\item{data}{Data frame or matrix: gene expression or junction quantification} -} -\value{ -Mean-variance plot -} -\description{ -Render mean-variance plot -} diff --git a/man/plotPSI.Rd b/man/plotPSI.Rd deleted file mode 100644 index 64943572..00000000 --- a/man/plotPSI.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_inclusionLevels.R -\name{plotPSI} -\alias{plotPSI} -\title{Plot alternative splicing quantification} -\usage{ -plotPSI(psi, x, y, minX = NULL, maxX = NULL, minY = NULL, - maxY = NULL, xlim = NULL, ylim = NULL) -} -\arguments{ -\item{psi}{Data frame or matrix: alternative splicing quantification} - -\item{x}{Character: \code{median}, \code{var} or \code{range} (or -transformations of those variables, such as \code{log10(var)})} - -\item{y}{Character: \code{median}, \code{var} or \code{range} (or -transformations of those variables, such as \code{log10(var)})} - -\item{minX}{Numeric: minimum X to subset data} - -\item{maxX}{Numeric: maximum X to subset data} - -\item{minY}{Numeric: minimum Y to subset data} - -\item{maxY}{Numeric: maximum Y to subset data} - -\item{xlim}{Numeric: minimum and maximum X to display} - -\item{ylim}{Numeric: minimum and maximum Y to display} -} -\value{ -Plot with the variables chosen in \code{x} and \code{y}. Also -includes an attribute \code{threshold}: a boolean vector stating which genes -pass the threshold based on \code{minX}, \code{maxX}, \code{minY} and -\code{maxY}. -} -\description{ -Plot alternative splicing quantification -} diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd new file mode 100644 index 00000000..a8422379 --- /dev/null +++ b/man/plotRowStats.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\name{plotRowStats} +\alias{plotRowStats} +\title{Plot sample statistics per row} +\usage{ +plotRowStats(data, x, y, minX = NULL, maxX = NULL, minY = NULL, + maxY = NULL, xLim = NULL, yLim = NULL) +} +\arguments{ +\item{data}{Data frame or matrix} + +\item{x, y}{Character: statistic to calculate and display in the plot per row; +choose between \code{mean}, \code{median}, \code{var} or \code{range} +(or transformations of those variables, e.g. \code{log10(var)})} + +\item{minX, maxX, minY, maxY}{Numeric: minimum and maximum X and Y values to +draw in the plot} + +\item{xLim, yLim}{Numeric: X and Y axis range} +} +\value{ +Plot of \code{data} +} +\description{ +Plot sample statistics per row +} +\examples{ +# Plotting gene expression data +geneExpr <- readFile("ex_gene_expression.RDS") +plotRowStats(geneExpr, "mean", "var^(1/4)") + + ggtitle("Mean-variance plot") + + ylab("Square Root of the Standard Deviation") + +# Plotting alternative splicing quantification +annot <- readFile("ex_splicing_annotation.RDS") +junctionQuant <- readFile("ex_junctionQuant.RDS") +psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) + +medianVar <- plotRowStats(table, x="median", y="var", xLim=0:1) + + labs(x="Median PSI", y="PSI variance") +rangeVar <- plotRowStats(table, x="range", y="log10(var)") + + labs(x="PSI range", y="log10(PSI variance)") +} From 87a2d3d83d46f2660576f905222a3c1df1638da7 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 21 Mar 2019 11:21:05 +0000 Subject: [PATCH 33/46] Fix table filtering based on plotted points --- R/analysis.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/analysis.R b/R/analysis.R index f88f2073..17946ac8 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -2349,7 +2349,7 @@ analysesTableSet <- function(session, input, output, analysesType, analysesID, # Render table with sparklines output$statsTable <- renderDataTableSparklines({ - stats <- getAnalysesData() + stats <- getAnalysesFiltered() if (!is.null(stats)) { # Discard columns of no interest cols <- colnames(stats) From d1246e4b8322f3cce87fcacb76894dc2e34ccb56 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 21 Mar 2019 14:55:48 +0000 Subject: [PATCH 34/46] Require human gene annotation --- DESCRIPTION | 7 ++++--- NAMESPACE | 1 + 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d41c4a42..05761359 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,6 +33,7 @@ License: MIT + file LICENSE LazyData: true RoxygenNote: 6.1.1 Imports: + AnnotationDbi, AnnotationHub, cluster, colourpicker, @@ -66,7 +67,8 @@ Imports: utils, XML, xtable, - methods + methods, + org.Hs.eg.db Suggests: testthat, knitr, @@ -76,8 +78,7 @@ Suggests: gplots, covr, car, - rstudioapi, - org.Hs.eg.db + rstudioapi LinkingTo: Rcpp VignetteBuilder: knitr Collate: diff --git a/NAMESPACE b/NAMESPACE index 80f16ff0..c1ef2384 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -200,6 +200,7 @@ importFrom(limma,voom) importFrom(methods,is) importFrom(miscTools,colMedians) importFrom(miscTools,rowMedians) +importFrom(org.Hs.eg.db,org.Hs.eg.db) importFrom(pairsD3,pairsD3) importFrom(pairsD3,pairsD3Output) importFrom(pairsD3,renderPairsD3) From 37a0afa77baec0645d9378d24cd0acb57d1af1de Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Thu, 21 Mar 2019 15:11:35 +0000 Subject: [PATCH 35/46] Fix issues with R CMD check --- NAMESPACE | 4 +++- R/analysis_correlation.R | 3 +++ R/data.R | 6 +++--- R/data_geNormalisationFiltering.R | 13 +++++-------- R/data_local.R | 2 ++ R/groups.R | 2 ++ man/colSums-EList-method.Rd | 14 ++++++++++++++ man/convertCoordinates.Rd | 18 ------------------ man/convertGeneIdentifiers.Rd | 10 +++++----- man/normaliseGeneExpression.Rd | 2 ++ man/plotRowStats.Rd | 6 +++--- 11 files changed, 42 insertions(+), 38 deletions(-) delete mode 100644 man/convertCoordinates.Rd diff --git a/NAMESPACE b/NAMESPACE index c1ef2384..c71e0132 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -155,10 +155,10 @@ importFrom(ggplot2,theme) importFrom(ggplot2,theme_light) importFrom(ggplot2,unit) importFrom(ggplot2,xlim) -importFrom(ggplot2,ylab) importFrom(ggplot2,ylim) importFrom(ggrepel,geom_label_repel) importFrom(grDevices,chull) +importFrom(graphics,plot) importFrom(highcharter,"%>%") importFrom(highcharter,JS) importFrom(highcharter,fa_icon_mark) @@ -326,6 +326,7 @@ importFrom(stats,kruskal.test) importFrom(stats,lm) importFrom(stats,loess.smooth) importFrom(stats,median) +importFrom(stats,na.omit) importFrom(stats,optim) importFrom(stats,p.adjust) importFrom(stats,pchisq) @@ -342,6 +343,7 @@ importFrom(survival,survdiff) importFrom(survival,survfit) importFrom(tools,file_ext) importFrom(tools,file_path_sans_ext) +importFrom(utils,askYesNo) importFrom(utils,download.file) importFrom(utils,head) importFrom(utils,read.delim) diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index a8a51224..50b09b16 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -287,6 +287,8 @@ correlateGEandAS <- function(geneExpr, psi, gene, ASevents=NULL, ...) { #' #' @method [ GEandAScorrelation #' +#' @importFrom stats na.omit +#' #' @return \code{GEandAScorrelation} object subset #' @export `[.GEandAScorrelation` <- function(x, genes=NULL, ASevents=NULL) { @@ -548,6 +550,7 @@ as.table.GEandAScorrelation <- function (x, pvalueAdjust="BH", ...) { #' @importFrom shiny renderUI observeEvent isolate tagList tags #' @importFrom highcharter renderHighchart #' @importFrom shinyjs show hide toggle +#' @importFrom graphics plot correlationServer <- function(input, output, session) { selectGroupsServer(session, "ASevents", "ASevents") selectGroupsServer(session, "genes", "Genes") diff --git a/R/data.R b/R/data.R index ae668876..36618a10 100644 --- a/R/data.R +++ b/R/data.R @@ -132,7 +132,7 @@ loadTCGAsampleMetadata <- function(data) { #' draw in the plot #' @param xLim,yLim Numeric: X and Y axis range #' -#' @importFrom ggplot2 geom_vline geom_hline xlim ylim +#' @importFrom ggplot2 geom_vline geom_hline xlim ylim ggtitle #' #' @return Plot of \code{data} #' @export @@ -142,7 +142,7 @@ loadTCGAsampleMetadata <- function(data) { #' geneExpr <- readFile("ex_gene_expression.RDS") #' plotRowStats(geneExpr, "mean", "var^(1/4)") + #' ggtitle("Mean-variance plot") + -#' ylab("Square Root of the Standard Deviation") +#' labs(y="Square Root of the Standard Deviation") #' #' # Plotting alternative splicing quantification #' annot <- readFile("ex_splicing_annotation.RDS") @@ -521,7 +521,7 @@ tabDataset <- function(ns, title, tableId, columns, visCols, data, #' @importFrom shiny downloadHandler br #' @importFrom utils write.table #' @importFrom shinyjs show hide -#' @importFrom ggplot2 ylab +#' @importFrom ggplot2 labs ggtitle theme_light #' #' @return NULL (this function is used to modify the Shiny session's state) #' @keywords internal diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 5cca2cab..69273777 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -125,6 +125,7 @@ geNormalisationFilteringUI <- function(id, panel) { #' @param log2transform Boolean: perform log2-transformation? #' @param priorCount Average count to add to each observation to avoid zeroes #' after log-transformation +#' @param performVoom Boolean: perform mean-variance modelling (voom)? #' #' @details \code{edgeR::calcNormFactors} will be used to normalise gene #' expression if one of the followin methods is set: \code{TMM}, \code{RLE}, @@ -271,6 +272,7 @@ loadGeneExpressionSet <- function(session, input, output) { #' #' @importFrom AnnotationDbi select #' @importFrom data.table data.table +#' @importFrom org.Hs.eg.db org.Hs.eg.db #' #' @return Character vector of the respective targets of gene identifiers. The #' previous identifiers remain other identifiers have the same target (in case @@ -384,6 +386,7 @@ plotGeneExprPerSample <- function(geneExpr, ...) { } #' Sum columns using an \code{\link{EList-class}} object +#' @inheritParams base::colSums #' @export setMethod("colSums", signature="EList", function(x, na.rm=FALSE, dims=1) { colSums(x$E, na.rm=na.rm, dims=dims) @@ -608,14 +611,8 @@ geNormalisationFilteringServer <- function(input, output, session) { priorCount, performVoom=voom) if (convertToGeneSymbol) { - if (require(org.Hs.eg.db)) { - rownames(geneExprNorm) <- convertGeneIdentifiers( - org.Hs.eg.db, rownames(geneExprNorm)) - } else { - warning(paste( - "Gene identifiers not converted:", - "Install 'org.Hs.eg.db' to convert human genes")) - } + rownames(geneExprNorm) <- convertGeneIdentifiers( + org.Hs.eg.db, rownames(geneExprNorm)) } attr(geneExprNorm, "filename") <- NULL diff --git a/R/data_local.R b/R/data_local.R index a6a83e70..f0fc7dea 100644 --- a/R/data_local.R +++ b/R/data_local.R @@ -144,6 +144,8 @@ prepareSRAmetadata <- function(file, output="psichomics_metadata.txt") { #' @param output Character: output filename (if \code{NULL}, no file is saved) #' @param IDcolname Character: name of the column containing the identifiers #' +#' @importFrom utils askYesNo +#' #' @return Process file and save its output #' @keywords internal processAndSaveSRAdata <- function(files, data, output, IDcolname) { diff --git a/R/groups.R b/R/groups.R index 779645a2..5f93710b 100644 --- a/R/groups.R +++ b/R/groups.R @@ -2233,6 +2233,8 @@ testGroupIndependence <- function(ref, groups, elements, pvalueAdjust="BH") { #' @param samples Character: vector with all available samples #' @param clean Boolean: clean results? #' +#' @importFrom stats na.omit +#' #' @return Groups without samples not found in \code{samples} #' @keywords internal discardOutsideSamplesFromGroups <- function(groups, samples, clean=FALSE) { diff --git a/man/colSums-EList-method.Rd b/man/colSums-EList-method.Rd index d92e8564..3bb4e498 100644 --- a/man/colSums-EList-method.Rd +++ b/man/colSums-EList-method.Rd @@ -7,6 +7,20 @@ \usage{ \S4method{colSums}{EList}(x, na.rm = FALSE, dims = 1) } +\arguments{ +\item{x}{an array of two or more dimensions, containing numeric, + complex, integer or logical values, or a numeric data frame. For + \code{.colSums()} etc, a numeric, integer or logical matrix (or + vector of length \code{m * n}).} + +\item{na.rm}{logical. Should missing values (including \code{NaN}) + be omitted from the calculations?} + +\item{dims}{integer: Which dimensions are regarded as \sQuote{rows} or + \sQuote{columns} to sum over. For \code{row*}, the sum or mean is + over dimensions \code{dims+1, \dots}; for \code{col*} it is over + dimensions \code{1:dims}.} +} \description{ Sum columns using an \code{\link{EList-class}} object } diff --git a/man/convertCoordinates.Rd b/man/convertCoordinates.Rd deleted file mode 100644 index de85b7df..00000000 --- a/man/convertCoordinates.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis_information.R -\name{convertCoordinates} -\alias{convertCoordinates} -\title{Convert genome coordinates between assemblies} -\usage{ -convertCoordinates(ASevents, from = "hg38", to = "hg19") -} -\value{ -Character vector with converted coordinates -} -\description{ -Convert genome coordinates between assemblies -} -\examples{ -convertCoordinates("SE_1_+_207785682_207790253_207790345_207793519_CD46", - from="hg38", to="hg19") -} diff --git a/man/convertGeneIdentifiers.Rd b/man/convertGeneIdentifiers.Rd index dbf371d8..be98f51c 100644 --- a/man/convertGeneIdentifiers.Rd +++ b/man/convertGeneIdentifiers.Rd @@ -8,7 +8,7 @@ convertGeneIdentifiers(annotation, genes, key = "ENSEMBL", target = "SYMBOL", ignoreDuplicatedTargets = TRUE) } \arguments{ -\item{annotation}{OrgDb: genome wide annotation for an organism, e.g. +\item{annotation}{OrgDb: genome wide annotation for an organism, e.g. \code{org.Hs.eg.db}} \item{genes}{Character: genes to be converted} @@ -19,7 +19,7 @@ convertGeneIdentifiers(annotation, genes, key = "ENSEMBL", \item{target}{Character: type of identifier to convert to; read \code{?AnnotationDbi::columns}} -\item{ignoreDuplicatedTargets}{Boolean: if \code{TRUE}, identifiers that +\item{ignoreDuplicatedTargets}{Boolean: if \code{TRUE}, identifiers that share targets with other identifiers will not be converted} } \value{ @@ -33,10 +33,10 @@ Convert gene identifiers \examples{ if ( require("org.Hs.eg.db") ) { columns(org.Hs.eg.db) - - genes <- c("ENSG00000012048", "ENSG00000083093", "ENSG00000141510", + + genes <- c("ENSG00000012048", "ENSG00000083093", "ENSG00000141510", "ENSG00000051180") - convertGeneIdentifiers(org.Hs.eg.db, genes, + convertGeneIdentifiers(org.Hs.eg.db, genes, key="ENSEMBL", target="SYMBOL") } } diff --git a/man/normaliseGeneExpression.Rd b/man/normaliseGeneExpression.Rd index 15ad0210..502da64e 100644 --- a/man/normaliseGeneExpression.Rd +++ b/man/normaliseGeneExpression.Rd @@ -23,6 +23,8 @@ Details)} \item{priorCount}{Average count to add to each observation to avoid zeroes after log-transformation} + +\item{performVoom}{Boolean: perform mean-variance modelling (voom)?} } \value{ Filtered and normalised gene expression diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd index a8422379..57cb659b 100644 --- a/man/plotRowStats.Rd +++ b/man/plotRowStats.Rd @@ -30,15 +30,15 @@ Plot sample statistics per row geneExpr <- readFile("ex_gene_expression.RDS") plotRowStats(geneExpr, "mean", "var^(1/4)") + ggtitle("Mean-variance plot") + - ylab("Square Root of the Standard Deviation") + labs(y="Square Root of the Standard Deviation") # Plotting alternative splicing quantification annot <- readFile("ex_splicing_annotation.RDS") junctionQuant <- readFile("ex_junctionQuant.RDS") psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) -medianVar <- plotRowStats(table, x="median", y="var", xLim=0:1) + +medianVar <- plotRowStats(table, x="median", y="var", xLim=c(0, 1)) + labs(x="Median PSI", y="PSI variance") -rangeVar <- plotRowStats(table, x="range", y="log10(var)") + +rangeVar <- plotRowStats(table, x="range", y="log10(var)", xLim=c(0, 1)) + labs(x="PSI range", y="log10(PSI variance)") } From 388aef18906d504e4edfef4294d8152935b63322 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Fri, 22 Mar 2019 09:14:01 +0000 Subject: [PATCH 36/46] Minor bug fixes and improvements - Allow to edit path in file/directory browser elements - Automatically set dropdown width for group attribute selection - Fix warning when displaying group preview only based on subjects or samples - Prepare for code escaping in newer JavaScript versions --- NEWS | 4 ++++ R/groups.R | 6 +++--- R/utils.R | 2 +- inst/shiny/www/functions.js | 3 +++ inst/shiny/www/styles.css | 5 +++++ 5 files changed, 16 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 3b360d2e..c3d41fed 100644 --- a/NEWS +++ b/NEWS @@ -44,6 +44,7 @@ * Improve console logging of error and warning alerts * Fix crash when loading psichomics with test data that is not locally available (by automatically downloading said data if not found) +* Allow to edit file path in file/directory browser elemnts * Documentation: - Export functions mentioned in the documentation - Hide documentation of internal functions from the PDF reference manual @@ -52,9 +53,12 @@ `list.files()`) - Ask to overwrite file if one exists with the same name as the output file * Groups: + - Automatically set dropdown width for group attribute selection - Minor improvements to the group creation interface - Fix error when creating groups containing only samples and no matching subjects + - Fix warning when displaying group preview only based on subjects or + samples * Alternative splicing quantification: - Automatically set the human genome version after loading data from TCGA (hg19), GTEx (hg19) or recount2 (hg38) diff --git a/R/groups.R b/R/groups.R index 5f93710b..13be6eeb 100644 --- a/R/groups.R +++ b/R/groups.R @@ -206,7 +206,7 @@ groupManipulationInput <- function(id, type) { } if (type == "Samples") { - title <- "By patients" + title <- "By subjects" first <- groupOptions("Patients", title) # firstAlert <- tabPanel(title, value="NoPatients", missingData( # "Clinical data", "No clinical data loaded to group by patients.", @@ -251,7 +251,7 @@ groupsUI <- function(id, tab) { tab(icon="object-group", title="Groups", tabsetPanel( id="groupsTypeTab", tabPanel( - "Patient and sample groups", + "Subject and sample groups", groupManipulationInput(ns("sampleGroupModule"), "Samples")), tabPanel( "Splicing event and gene groups", @@ -1383,7 +1383,7 @@ groupManipulation <- function(input, output, session, type) { extra <- NULL totalGroups <- length(group) if (totalGroups > groupsToPreview) { - table <- rbind(table, rep("(...)", 3)) + table <- rbind(table, rep("(...)", ncol(table))) extra <- helpText(style="text-align: right;", sprintf("Previewing %s out of %s groups", groupsToPreview, totalGroups)) diff --git a/R/utils.R b/R/utils.R index d5f32e70..cc45732a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1733,7 +1733,7 @@ fileBrowserInput <- function(id, label, value=NULL, placeholder=NULL, fileBrowserButton <- div(class="input-group-btn", fileBrowserButton) filepathInput <- tags$input( id=id, value=value, type='text', placeholder=placeholder, - readonly = if (!isRStudioServer()) 'readonly' else NULL, + # readonly = if (!isRStudioServer()) 'readonly' else NULL, class='form-control fileBrowser-input-chosen-dir') tagList( diff --git a/inst/shiny/www/functions.js b/inst/shiny/www/functions.js index 58a7fda3..5f0c5ce0 100644 --- a/inst/shiny/www/functions.js +++ b/inst/shiny/www/functions.js @@ -1,3 +1,6 @@ +/* Ensure code escaping */ +window.escape = window.escape || window.encodeURI; + /** * Update location according to browser navigation * diff --git a/inst/shiny/www/styles.css b/inst/shiny/www/styles.css index 8e478a49..ba512aa8 100644 --- a/inst/shiny/www/styles.css +++ b/inst/shiny/www/styles.css @@ -62,6 +62,11 @@ a { cursor: pointer; } /* Align element with selectize input */ .inline_selectize { margin-top: 25px; } +/* Increase dropdown width of a specific selectize input */ +#groups-sampleGroupModule-groupAttributePatients + div > .selectize-dropdown { + width: auto !important; +} + /* Add error style to modal headers Adapted from: http://bootsnipp.com/snippets/featured/colored-modal-headings */ .modal-content .error { From 885ed2cc3315d2efaa7795679597f7b2e29f4810 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Fri, 22 Mar 2019 09:22:18 +0000 Subject: [PATCH 37/46] Plot p-values by cutoff --- NEWS | 3 + R/analysis_survival.R | 139 +++++++++++++++++++++---------------- man/plotPvaluesByCutoff.Rd | 55 +++++++++++++++ 3 files changed, 138 insertions(+), 59 deletions(-) create mode 100644 man/plotPvaluesByCutoff.Rd diff --git a/NEWS b/NEWS index c3d41fed..7296bc49 100644 --- a/NEWS +++ b/NEWS @@ -36,6 +36,9 @@ (`[.GEandAScorrelation`()) - Display progress when performing correlation analyses - Display correlation results in a table (`as.table()`) +* Survival: + - Render p-value plot by cutoff in command-line interface + (`plotPvaluesByCutoff()`) * Gene, transcript and protein information: - Modify keywords used to search for PubMed articles diff --git a/R/analysis_survival.R b/R/analysis_survival.R index 30b20fbf..723a305e 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -460,6 +460,78 @@ geneExprSurvSet <- function(session, input, output) { }) } +#' Plot p-values by multiple cutoffs +#' +#' @inheritParams processSurvTerms +#' @inheritParams testSurvivalCutoff +#' @param significance Numeric: significance threshold +#' @param cutoffs Numeric: cutoffs to test +#' +#' @return p-value plot +#' @export +plotPvaluesByCutoff <- function(clinical, data, censoring, event, timeStart, + timeStop=NULL, followup="days_to_last_followup", + significance=0.05, + cutoffs=seq(0, 0.99, 0.01)) { + survTime <- getAttributesTime(clinical, event, timeStart, timeStop) + + pvalues <- lapply( + cutoffs, testSurvivalCutoff, data=data, + clinical=clinical, censoring=censoring, timeStart=timeStart, + timeStop=timeStop, event=event, survTime=survTime, survivalInfo=TRUE) + + patients <- lapply(pvalues, function(n) attr(n, "info")$n) + noSeparation <- vapply(patients, length, numeric(1)) == 1 + patients[noSeparation] <- NA + patients1 <- vapply(patients, "[[", 1, FUN.VALUE = numeric(1)) + patients2 <- NA + patients2[!noSeparation] <- vapply(patients[!noSeparation], + "[[", 2, FUN.VALUE = numeric(1)) + + pvalues <- -log10(unlist(pvalues)) + significance <- -log10(significance) + + data <- data.frame(x=cutoffs, y=pvalues, + patients1=patients1, patients2=patients2) + data <- list_parse(data) + + firstSeriesColour <- JS("Highcharts.getOptions().colors[0]") + + # Put the label of p-value plot to the right when there are many + # significant points to the left + signif <- pvalues >= significance + labelAlign <- "left" + if (sum(signif[1:50]) > sum(signif[51:100])) labelAlign <- "right" + + pvaluePlot <- highchart(height="100px") %>% + hc_add_series(data=data, + zones=list(list(value=significance, + color="lightgray"))) %>% + hc_chart(zoomType="x") %>% + hc_xAxis(tickInterval=0.1, showLastLabel=TRUE, endOnTick=TRUE, + min=0, max=1, minorGridLineWidth=0, + gridLineWidth=0) %>% + hc_yAxis(crosshair=list(color="gray", width=1, + dashStyle="shortdash"), + labels=list(enabled=FALSE), gridLineWidth=0, + plotLines=list(list( + value=significance, color=firstSeriesColour, + dashStyle="shortdash", width=1, + label=list( + align=labelAlign, text="p < 0.05", + style=list(color=firstSeriesColour))))) %>% + hc_legend(NULL) %>% + hc_tooltip(formatter=JS( + "function() { return getPvaluePlotTooltip(this); }")) %>% + hc_plotOptions(series=list( + cursor="pointer", + point=list(events=list(click=JS( + "function () { setPSIcutoffSlider(this.x) }"))), + marker=list(radius=2))) + attr(pvaluePlot, "pvalues") <- pvalues + return(pvaluePlot) +} + #' @rdname appServer #' #' @importFrom R.utils capitalize @@ -713,73 +785,22 @@ survivalServer <- function(input, output, session) { show("psiCutoff") slider <- uiOutput(ns("cutoffPvalue")) - categories <- seq(0, 0.99, 0.01) + label <- tags$label(class="control-label", + "-log\u2081\u2080(p-value) plot by cutoff") - survTime <- getAttributesTime(clinical, event, timeStart, timeStop) - pvalues <- lapply( - categories, testSurvivalCutoff, data=eventPSI, - clinical=clinical, censoring=censoring, timeStart=timeStart, - timeStop=timeStop, event=event, survTime=survTime, - session=session, survivalInfo=TRUE) + cutoffs <- seq(0, 0.99, 0.01) + pvaluePlot <- plotPvaluesByCutoff( + clinical=clinical, data=eventPSI, censoring=censoring, + event=event, timeStart=timeStart, timeStop=timeStop, + followup=followup, cutoffs=cutoffs) # Automatically set minimal p-value - value <- categories[which.min(unlist(pvalues))] + value <- cutoffs[which.min(unlist(attr(pvaluePlot, "pvalues")))] observe({ if (is.na(value)) value <- 0.5 updateSliderInput(session, "psiCutoff", value=value) }) - patients <- lapply(pvalues, function(n) attr(n, "info")$n) - noSeparation <- vapply(patients, length, numeric(1)) == 1 - patients[noSeparation] <- NA - patients1 <- vapply(patients, "[[", 1, FUN.VALUE = numeric(1)) - patients2 <- NA - patients2[!noSeparation] <- vapply(patients[!noSeparation], - "[[", 2, FUN.VALUE = numeric(1)) - - pvalues <- -log10(unlist(pvalues)) - significance <- -log10(0.05) - - data <- data.frame(x=categories, y=pvalues, - patients1=patients1, patients2=patients2) - data <- list_parse(data) - - firstSeriesColour <- JS("Highcharts.getOptions().colors[0]") - label <- tags$label(class="control-label", - "-log\u2081\u2080(p-value) plot by cutoff") - - # Put the label of p-value plot to the right when there are many - # significant points to the left - signif <- pvalues >= -log10(0.05) - labelAlign <- "left" - if (sum(signif[1:50]) > sum(signif[51:100])) labelAlign <- "right" - - pvaluePlot <- highchart(height="100px") %>% - hc_add_series(data=data, - zones=list(list(value=significance, - color="lightgray"))) %>% - hc_chart(zoomType="x") %>% - hc_xAxis(tickInterval=0.1, showLastLabel=TRUE, endOnTick=TRUE, - min=0, max=1, minorGridLineWidth=0, - gridLineWidth=0) %>% - hc_yAxis(crosshair=list(color="gray", width=1, - dashStyle="shortdash"), - labels=list(enabled=FALSE), gridLineWidth=0, - plotLines=list(list( - value=-log10(0.05), color=firstSeriesColour, - dashStyle="shortdash", width=1, - label=list( - align=labelAlign, text="p < 0.05", - style=list(color=firstSeriesColour))))) %>% - hc_legend(NULL) %>% - hc_tooltip(formatter=JS( - "function() { return getPvaluePlotTooltip(this); }")) %>% - hc_plotOptions(series=list( - cursor="pointer", - point=list(events=list(click=JS( - "function () { setPSIcutoffSlider(this.x) }"))), - marker=list(radius=2))) - if (!is.na(value) && value < 1) { return(tagList(slider, label, pvaluePlot)) } else { diff --git a/man/plotPvaluesByCutoff.Rd b/man/plotPvaluesByCutoff.Rd new file mode 100644 index 00000000..88d89fe1 --- /dev/null +++ b/man/plotPvaluesByCutoff.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis_survival.R +\name{plotPvaluesByCutoff} +\alias{plotPvaluesByCutoff} +\title{Plot p-values by multiple cutoffs} +\usage{ +plotPvaluesByCutoff(clinical, data, censoring, event, timeStart, + timeStop = NULL, followup = "days_to_last_followup", + significance = 0.05, cutoffs = seq(0, 0.99, 0.01)) +} +\arguments{ +\item{clinical}{Data frame: clinical data} + +\item{data}{Numeric: elements of interest to test against the cutoff} + +\item{censoring}{Character: censor using "left", "right", "interval" or +"interval2"} + +\item{event}{Character: name of column containing time of the event of +interest} + +\item{timeStart}{Character: name of column containing starting time of the +interval or follow up time} + +\item{timeStop}{Character: name of column containing ending time of the +interval (only relevant for interval censoring)} + +\item{followup}{Character: name of column containing follow up time} + +\item{significance}{Numeric: significance threshold} + +\item{cutoffs}{Numeric: cutoffs to test} +} +\value{ +p-value plot +} +\description{ +Plot p-values by multiple cutoffs +} +\examples{ +clinical <- read.table(text = "2549 NA ii female + 840 NA i female + NA 1204 iv male + NA 383 iv female + 1293 NA iii male + NA 1355 ii male") +names(clinical) <- c("patient.days_to_last_followup", + "patient.days_to_death", + "patient.stage_event.pathologic_stage", + "patient.gender") +timeStart <- "days_to_death" +event <- "days_to_death" +psi <- c(0.1, 1, 0.9, 1, 0.2, 0.6) +plotPvaluesByCutoff(clinical, psi, censoring="right", event, timeStart) +} From 0fefbe1d1cc79a2c554321ef62af02ce37647cb8 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 25 Mar 2019 15:58:12 +0000 Subject: [PATCH 38/46] Make it clearer that TCGA data is loaded from Downloads folder by default --- R/data_firebrowse.R | 3 +-- man/loadFirebrowseData.Rd | 5 +++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/data_firebrowse.R b/R/data_firebrowse.R index 24a8816f..6d76005f 100644 --- a/R/data_firebrowse.R +++ b/R/data_firebrowse.R @@ -407,7 +407,7 @@ loadFirebrowseFolders <- function(folder, exclude="") { #' \dontrun{ #' loadFirebrowseData(cohort = "ACC", data_type = "Clinical") #' } -loadFirebrowseData <- function(folder=NULL, data=NULL, +loadFirebrowseData <- function(folder=getDownloadsFolder(), data=NULL, exclude=c(".aux.", ".mage-tab.", "MANIFEST.txt"), ..., download=TRUE) { args <- list(...) @@ -436,7 +436,6 @@ loadFirebrowseData <- function(folder=NULL, data=NULL, base[!md5] <- file_path_sans_ext(base[!md5], compression = TRUE) # Check which files are missing from the given directory - if (is.null(folder)) folder <- getDownloadsFolder() downloadedFiles <- list.files(folder, recursive=TRUE, full.names=TRUE, include.dirs=TRUE) downloadedMD5 <- file_ext(downloadedFiles) == "md5" diff --git a/man/loadFirebrowseData.Rd b/man/loadFirebrowseData.Rd index 7f253cfc..b47b3515 100644 --- a/man/loadFirebrowseData.Rd +++ b/man/loadFirebrowseData.Rd @@ -4,8 +4,9 @@ \alias{loadFirebrowseData} \title{Downloads and processes data from the Firebrowse web API and loads it into R} \usage{ -loadFirebrowseData(folder = NULL, data = NULL, exclude = c(".aux.", - ".mage-tab.", "MANIFEST.txt"), ..., download = TRUE) +loadFirebrowseData(folder = getDownloadsFolder(), data = NULL, + exclude = c(".aux.", ".mage-tab.", "MANIFEST.txt"), ..., + download = TRUE) } \arguments{ \item{folder}{Character: directory to store the downloaded archives (by From d6ecc35918e88ce390a51026234c38824cd18581 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Mon, 25 Mar 2019 16:00:29 +0000 Subject: [PATCH 39/46] Code copy-editing --- R/analysis.R | 2 +- R/data.R | 18 +++++++++--------- man/plotPvaluesByCutoff.Rd | 16 ---------------- man/plotRowStats.Rd | 8 ++++---- 4 files changed, 14 insertions(+), 30 deletions(-) diff --git a/R/analysis.R b/R/analysis.R index 17946ac8..4ff4be29 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -169,7 +169,7 @@ getValuePerPatient <- function(data, match, clinical=NULL, patients=NULL, hasOneRow <- !is.null(nrow(data)) && nrow(data) == 1 isNamedVector <- is.vector(data) && !is.null(names(data)) if (!hasOneRow && !isNamedVector) - stop("Data needs to either have only one row or be a vector with", + stop("Data needs to either have only one row or be a vector with ", "sample identifiers as names.") if (is.null(clinical) && is.null(patients)) diff --git a/R/data.R b/R/data.R index 36618a10..7540ec56 100644 --- a/R/data.R +++ b/R/data.R @@ -130,7 +130,7 @@ loadTCGAsampleMetadata <- function(data) { #' (or transformations of those variables, e.g. \code{log10(var)}) #' @param minX,maxX,minY,maxY Numeric: minimum and maximum X and Y values to #' draw in the plot -#' @param xLim,yLim Numeric: X and Y axis range +#' @param xlim,ylim Numeric: X and Y axis range #' #' @importFrom ggplot2 geom_vline geom_hline xlim ylim ggtitle #' @@ -149,12 +149,12 @@ loadTCGAsampleMetadata <- function(data) { #' junctionQuant <- readFile("ex_junctionQuant.RDS") #' psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) #' -#' medianVar <- plotRowStats(table, x="median", y="var", xLim=c(0, 1)) + +#' medianVar <- plotRowStats(table, x="median", y="var", xlim=c(0, 1)) + #' labs(x="Median PSI", y="PSI variance") -#' rangeVar <- plotRowStats(table, x="range", y="log10(var)", xLim=c(0, 1)) + +#' rangeVar <- plotRowStats(table, x="range", y="log10(var)", xlim=c(0, 1)) + #' labs(x="PSI range", y="log10(PSI variance)") plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, - maxY=NULL, xLim=NULL, yLim=NULL) { + maxY=NULL, xlim=NULL, ylim=NULL) { stats <- c("range", "var", "median", "mean") if (!any(sapply(stats, grepl, x)) || !any(sapply(stats, grepl, y))) { stop("x and y require to contain one of the strings:", @@ -190,15 +190,15 @@ plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, } vars <- calculateXandYvalues(data, stats) - message("Plotting...") + message("Preparing plot...") plot <- ggplot(vars, aes_string(x, y)) + # geom_hex(na.rm=TRUE) + geom_point(size=1, na.rm=TRUE, alpha=0.5) + geom_density_2d(colour="orange", na.rm=TRUE) + labs(x=x, y=y) - if (!is.null(xLim)) plot <- plot + xlim(xLim) - if (!is.null(yLim)) plot <- plot + ylim(yLim) + if (!is.null(xlim)) plot <- plot + xlim(xlim) + if (!is.null(ylim)) plot <- plot + ylim(ylim) # Intercept lines if (!is.null(minX)) plot <- plot + geom_vline(xintercept=minX, colour="red") @@ -623,13 +623,13 @@ createDataTab <- function(index, data, name, session, input, output) { highchart=librarySizePlot) } else if (isPSI) { medianVar <- plotRowStats(table, x="median", y="var", - xLim=c(0,1 )) + + xlim=c(0,1 )) + labs(x="PSI median", y="PSI variance") + ggtitle(paste("Scatterplot of alternative splicing", "quantification per event")) + theme_light(14) rangeVar <- plotRowStats(table, x="range", y="log10(var)", - xLim=c(0, 1)) + + xlim=c(0, 1)) + labs(x="PSI range", y="log10(PSI variance)") + ggtitle(paste("Scatterplot of alternative splicing", "quantification per event")) + diff --git a/man/plotPvaluesByCutoff.Rd b/man/plotPvaluesByCutoff.Rd index 88d89fe1..e966288c 100644 --- a/man/plotPvaluesByCutoff.Rd +++ b/man/plotPvaluesByCutoff.Rd @@ -37,19 +37,3 @@ p-value plot \description{ Plot p-values by multiple cutoffs } -\examples{ -clinical <- read.table(text = "2549 NA ii female - 840 NA i female - NA 1204 iv male - NA 383 iv female - 1293 NA iii male - NA 1355 ii male") -names(clinical) <- c("patient.days_to_last_followup", - "patient.days_to_death", - "patient.stage_event.pathologic_stage", - "patient.gender") -timeStart <- "days_to_death" -event <- "days_to_death" -psi <- c(0.1, 1, 0.9, 1, 0.2, 0.6) -plotPvaluesByCutoff(clinical, psi, censoring="right", event, timeStart) -} diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd index 57cb659b..735da4e4 100644 --- a/man/plotRowStats.Rd +++ b/man/plotRowStats.Rd @@ -5,7 +5,7 @@ \title{Plot sample statistics per row} \usage{ plotRowStats(data, x, y, minX = NULL, maxX = NULL, minY = NULL, - maxY = NULL, xLim = NULL, yLim = NULL) + maxY = NULL, xlim = NULL, ylim = NULL) } \arguments{ \item{data}{Data frame or matrix} @@ -17,7 +17,7 @@ choose between \code{mean}, \code{median}, \code{var} or \code{range} \item{minX, maxX, minY, maxY}{Numeric: minimum and maximum X and Y values to draw in the plot} -\item{xLim, yLim}{Numeric: X and Y axis range} +\item{xlim, ylim}{Numeric: X and Y axis range} } \value{ Plot of \code{data} @@ -37,8 +37,8 @@ annot <- readFile("ex_splicing_annotation.RDS") junctionQuant <- readFile("ex_junctionQuant.RDS") psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) -medianVar <- plotRowStats(table, x="median", y="var", xLim=c(0, 1)) + +medianVar <- plotRowStats(table, x="median", y="var", xlim=c(0, 1)) + labs(x="Median PSI", y="PSI variance") -rangeVar <- plotRowStats(table, x="range", y="log10(var)", xLim=c(0, 1)) + +rangeVar <- plotRowStats(table, x="range", y="log10(var)", xlim=c(0, 1)) + labs(x="PSI range", y="log10(PSI variance)") } From 1190319ef6dab35921c8fb3c9870a29c5befe51a Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 10:04:36 +0000 Subject: [PATCH 40/46] Fix issues using EList's gene expression for correlation analyses --- R/analysis_correlation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/analysis_correlation.R b/R/analysis_correlation.R index 50b09b16..2e942467 100644 --- a/R/analysis_correlation.R +++ b/R/analysis_correlation.R @@ -160,7 +160,7 @@ subsetGeneExpressionFromMatchingGenes <- function(geneExpr, gene) { matched[unmatched] <- bestMatch matched <- matched[!is.na(matched)] if (length(matched) == 0) stop("Gene expression not found for input genes.") - if (is(geneExpr, "EList")) geneExpr <- data.frame(geneExpr) + if (is(geneExpr, "EList")) geneExpr <- geneExpr$E return(geneExpr[matched, , drop=FALSE]) } From 1deea8a5ceb0c77ff269cffe6e4762d205433468 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 11:25:15 +0000 Subject: [PATCH 41/46] Copy-editing --- NAMESPACE | 2 +- NEWS | 10 ++--- R/analysis_survival.R | 34 ++++++++++++++--- R/data.R | 17 ++++----- man/plotPvaluesByCutoff.Rd | 39 ------------------- man/plotRowStats.Rd | 6 +-- man/plotSurvivalPvaluesByCutoff.Rd | 60 ++++++++++++++++++++++++++++++ vignettes/CLI_tutorial.Rmd | 11 +++++- 8 files changed, 114 insertions(+), 65 deletions(-) delete mode 100644 man/plotPvaluesByCutoff.Rd create mode 100644 man/plotSurvivalPvaluesByCutoff.Rd diff --git a/NAMESPACE b/NAMESPACE index c71e0132..95f99ba2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,9 +66,9 @@ export(plotGroupIndependence) export(plotICA) export(plotPCA) export(plotProtein) -export(plotPvaluesByCutoff) export(plotRowStats) export(plotSurvivalCurves) +export(plotSurvivalPvaluesByCutoff) export(plotTranscripts) export(plotVariance) export(prepareAnnotationFromEvents) diff --git a/NEWS b/NEWS index 7296bc49..91d69ff8 100644 --- a/NEWS +++ b/NEWS @@ -17,10 +17,10 @@ - In gene expression dataset summary, plot distribution of gene expression per sample, distribution of library sizes and gene-wise mean and variance of gene expression across samples to provide the user tools to assess gene - expression normalisation (`plotGeneExprPerSample()`, `plotDistribution` and - `plotRowStats()`, respectively) + expression normalisation (`plotGeneExprPerSample()`, `plotDistribution()` + and `plotRowStats()`, respectively) - Convert between different gene identifiers (the original identifier is - kept in some conditions, read `convertGeneIdentifiers`); in the visual + kept in some conditions, read `convertGeneIdentifiers()`); in the visual interface, when filtering and normalising gene expression, ENSEMBL identifiers are converted to gene symbols, by default * Groups: @@ -38,7 +38,7 @@ - Display correlation results in a table (`as.table()`) * Survival: - Render p-value plot by cutoff in command-line interface - (`plotPvaluesByCutoff()`) + (`plotSurvivalPvaluesByCutoff()`) * Gene, transcript and protein information: - Modify keywords used to search for PubMed articles @@ -86,7 +86,7 @@ - Fix error when groups contain samples outside the data being analysed * Gene, transcript and protein information: - Fix article title formatting (e.g. bold and italics) -* Update citation with journal publication date +* Update psichomics citation with journal publication date # 1.6.2 (2 October, 2018) diff --git a/R/analysis_survival.R b/R/analysis_survival.R index 723a305e..af749c81 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -460,7 +460,7 @@ geneExprSurvSet <- function(session, input, output) { }) } -#' Plot p-values by multiple cutoffs +#' Plot p-values of survival difference between groups based on multiple cutoffs #' #' @inheritParams processSurvTerms #' @inheritParams testSurvivalCutoff @@ -469,10 +469,32 @@ geneExprSurvSet <- function(session, input, output) { #' #' @return p-value plot #' @export -plotPvaluesByCutoff <- function(clinical, data, censoring, event, timeStart, - timeStop=NULL, followup="days_to_last_followup", - significance=0.05, - cutoffs=seq(0, 0.99, 0.01)) { +#' +#' @examples +#' clinical <- read.table(text = "2549 NA ii female +#' 840 NA i female +#' NA 1204 iv male +#' NA 383 iv female +#' 1293 NA iii male +#' NA 1355 ii male") +#' names(clinical) <- c("patient.days_to_last_followup", +#' "patient.days_to_death", +#' "patient.stage_event.pathologic_stage", +#' "patient.gender") +#' timeStart <- "days_to_death" +#' event <- "days_to_death" +#' eventPSI <- c(0.1, 1, 0.9, 1, 0.2, 0.6) +#' +#' match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) +#' eventPSI <- assignValuePerPatient(eventPSI, match, clinical) +#' +#' plotSurvivalPvaluesByCutoff(clinical, psi, censoring="right", event, +#' timeStart) +plotSurvivalPvaluesByCutoff <- function( + clinical, data, censoring, event, timeStart, timeStop=NULL, + followup="days_to_last_followup", significance=0.05, + cutoffs=seq(0, 0.99, 0.01)) { + survTime <- getAttributesTime(clinical, event, timeStart, timeStop) pvalues <- lapply( @@ -789,7 +811,7 @@ survivalServer <- function(input, output, session) { "-log\u2081\u2080(p-value) plot by cutoff") cutoffs <- seq(0, 0.99, 0.01) - pvaluePlot <- plotPvaluesByCutoff( + pvaluePlot <- plotSurvivalPvaluesByCutoff( clinical=clinical, data=eventPSI, censoring=censoring, event=event, timeStart=timeStart, timeStop=timeStop, followup=followup, cutoffs=cutoffs) diff --git a/R/data.R b/R/data.R index 7540ec56..90b8ac8c 100644 --- a/R/data.R +++ b/R/data.R @@ -128,7 +128,7 @@ loadTCGAsampleMetadata <- function(data) { #' @param x,y Character: statistic to calculate and display in the plot per row; #' choose between \code{mean}, \code{median}, \code{var} or \code{range} #' (or transformations of those variables, e.g. \code{log10(var)}) -#' @param minX,maxX,minY,maxY Numeric: minimum and maximum X and Y values to +#' @param xmin,xmax,ymin,ymax Numeric: minimum and maximum X and Y values to #' draw in the plot #' @param xlim,ylim Numeric: X and Y axis range #' @@ -153,8 +153,8 @@ loadTCGAsampleMetadata <- function(data) { #' labs(x="Median PSI", y="PSI variance") #' rangeVar <- plotRowStats(table, x="range", y="log10(var)", xlim=c(0, 1)) + #' labs(x="PSI range", y="log10(PSI variance)") -plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, - maxY=NULL, xlim=NULL, ylim=NULL) { +plotRowStats <- function(data, x, y, xmin=NULL, xmax=NULL, ymin=NULL, ymax=NULL, + xlim=NULL, ylim=NULL) { stats <- c("range", "var", "median", "mean") if (!any(sapply(stats, grepl, x)) || !any(sapply(stats, grepl, y))) { stop("x and y require to contain one of the strings:", @@ -173,9 +173,8 @@ plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, x <- y <- NULL vars <- list() for (stat in stats) { - message(sprintf("Calculating %s per splicing event...", stat)) - if (any(input[[stat]])) { + message(sprintf("Calculating %s per splicing event...", stat)) FUN <- switch(stat, "var"=rowVars, "mean"=rowMeans, @@ -201,10 +200,10 @@ plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, if (!is.null(ylim)) plot <- plot + ylim(ylim) # Intercept lines - if (!is.null(minX)) plot <- plot + geom_vline(xintercept=minX, colour="red") - if (!is.null(maxX)) plot <- plot + geom_vline(xintercept=maxX, colour="red") - if (!is.null(minY)) plot <- plot + geom_hline(yintercept=minY, colour="red") - if (!is.null(maxY)) plot <- plot + geom_hline(yintercept=maxY, colour="red") + if (!is.null(xmin)) plot <- plot + geom_vline(xintercept=xmin, colour="red") + if (!is.null(xmax)) plot <- plot + geom_vline(xintercept=xmax, colour="red") + if (!is.null(ymin)) plot <- plot + geom_hline(yintercept=ymin, colour="red") + if (!is.null(ymax)) plot <- plot + geom_hline(yintercept=ymax, colour="red") return(plot) } diff --git a/man/plotPvaluesByCutoff.Rd b/man/plotPvaluesByCutoff.Rd deleted file mode 100644 index e966288c..00000000 --- a/man/plotPvaluesByCutoff.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis_survival.R -\name{plotPvaluesByCutoff} -\alias{plotPvaluesByCutoff} -\title{Plot p-values by multiple cutoffs} -\usage{ -plotPvaluesByCutoff(clinical, data, censoring, event, timeStart, - timeStop = NULL, followup = "days_to_last_followup", - significance = 0.05, cutoffs = seq(0, 0.99, 0.01)) -} -\arguments{ -\item{clinical}{Data frame: clinical data} - -\item{data}{Numeric: elements of interest to test against the cutoff} - -\item{censoring}{Character: censor using "left", "right", "interval" or -"interval2"} - -\item{event}{Character: name of column containing time of the event of -interest} - -\item{timeStart}{Character: name of column containing starting time of the -interval or follow up time} - -\item{timeStop}{Character: name of column containing ending time of the -interval (only relevant for interval censoring)} - -\item{followup}{Character: name of column containing follow up time} - -\item{significance}{Numeric: significance threshold} - -\item{cutoffs}{Numeric: cutoffs to test} -} -\value{ -p-value plot -} -\description{ -Plot p-values by multiple cutoffs -} diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd index 735da4e4..6da8a1a3 100644 --- a/man/plotRowStats.Rd +++ b/man/plotRowStats.Rd @@ -4,8 +4,8 @@ \alias{plotRowStats} \title{Plot sample statistics per row} \usage{ -plotRowStats(data, x, y, minX = NULL, maxX = NULL, minY = NULL, - maxY = NULL, xlim = NULL, ylim = NULL) +plotRowStats(data, x, y, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, xlim = NULL, ylim = NULL) } \arguments{ \item{data}{Data frame or matrix} @@ -14,7 +14,7 @@ plotRowStats(data, x, y, minX = NULL, maxX = NULL, minY = NULL, choose between \code{mean}, \code{median}, \code{var} or \code{range} (or transformations of those variables, e.g. \code{log10(var)})} -\item{minX, maxX, minY, maxY}{Numeric: minimum and maximum X and Y values to +\item{xmin, xmax, ymin, ymax}{Numeric: minimum and maximum X and Y values to draw in the plot} \item{xlim, ylim}{Numeric: X and Y axis range} diff --git a/man/plotSurvivalPvaluesByCutoff.Rd b/man/plotSurvivalPvaluesByCutoff.Rd new file mode 100644 index 00000000..c05f1fa0 --- /dev/null +++ b/man/plotSurvivalPvaluesByCutoff.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis_survival.R +\name{plotSurvivalPvaluesByCutoff} +\alias{plotSurvivalPvaluesByCutoff} +\title{Plot p-values of survival difference between groups based on multiple cutoffs} +\usage{ +plotSurvivalPvaluesByCutoff(clinical, data, censoring, event, timeStart, + timeStop = NULL, followup = "days_to_last_followup", + significance = 0.05, cutoffs = seq(0, 0.99, 0.01)) +} +\arguments{ +\item{clinical}{Data frame: clinical data} + +\item{data}{Numeric: elements of interest to test against the cutoff} + +\item{censoring}{Character: censor using "left", "right", "interval" or +"interval2"} + +\item{event}{Character: name of column containing time of the event of +interest} + +\item{timeStart}{Character: name of column containing starting time of the +interval or follow up time} + +\item{timeStop}{Character: name of column containing ending time of the +interval (only relevant for interval censoring)} + +\item{followup}{Character: name of column containing follow up time} + +\item{significance}{Numeric: significance threshold} + +\item{cutoffs}{Numeric: cutoffs to test} +} +\value{ +p-value plot +} +\description{ +Plot p-values of survival difference between groups based on multiple cutoffs +} +\examples{ +clinical <- read.table(text = "2549 NA ii female + 840 NA i female + NA 1204 iv male + NA 383 iv female + 1293 NA iii male + NA 1355 ii male") +names(clinical) <- c("patient.days_to_last_followup", + "patient.days_to_death", + "patient.stage_event.pathologic_stage", + "patient.gender") +timeStart <- "days_to_death" +event <- "days_to_death" +eventPSI <- c(0.1, 1, 0.9, 1, 0.2, 0.6) + +match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) +eventPSI <- assignValuePerPatient(eventPSI, match, clinical) + +plotSurvivalPvaluesByCutoff(clinical, psi, censoring="right", event, + timeStart) +} diff --git a/vignettes/CLI_tutorial.Rmd b/vignettes/CLI_tutorial.Rmd index 9e59ce7a..14306aab 100644 --- a/vignettes/CLI_tutorial.Rmd +++ b/vignettes/CLI_tutorial.Rmd @@ -86,9 +86,11 @@ aligners (currently, psichomics supports the output of the splice-aware aligner [STAR][STAR]) ### Gene expression pre-processing -* `rowMeans`: Calculate mean per row (useful to filter gene expression) -* `rowVars`: Calculate variance per row (useful to filter gene expression) +* `plotRowStats`: Plot statistics (median, variance, etc.) per gene +* `plotGeneExprPerSample`: Plot distribution of gene expression per sample +* `filterGeneExpr`: Filter genes based on their expression * `normaliseGeneExpression`: Normalise gene expression data +* `convertGeneIdentifiers`: Convert between different gene identifiers ### PSI quantification * `getSplicingEventTypes`: Get quantifiable splicing event types @@ -96,6 +98,9 @@ aligners (currently, psichomics supports the output of the splice-aware aligner files * `loadAnnotation`: Load an alternative splicing annotation file * `quantifySplicing`: Quantify alternative splicing +* `plotRowStats`: Plot statistics (median, variance, etc.) per alternative +splicing event +* `filterPSI`: Filter alternative splicing quantification **Custom alternative splicing annotation preparation** @@ -146,6 +151,8 @@ survival curves * `survfit`: Compute estimates of survival curves * `survdiff`: Test differences between survival curves * `plotSurvivalCurves`: Plot survival curves +* `plotSurvivalPvaluesByCutoff`: Plot p-values of survival difference between +groups based on multiple cutoffs ### Differential analyses * `diffAnalyses`: Perform statistical analyses (including differential splicing From 17e2fbd3026f133b864b60a08bbb742a373b2f53 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 11:25:15 +0000 Subject: [PATCH 42/46] Fix issues in R CMD build/check --- DESCRIPTION | 1 + NAMESPACE | 4 +- NEWS | 10 ++--- R/analysis_survival.R | 34 ++++++++++++++--- R/data.R | 17 ++++----- man/basicStats.Rd | 4 +- man/plotPvaluesByCutoff.Rd | 39 ------------------- man/plotRowStats.Rd | 6 +-- man/plotSurvivalPvaluesByCutoff.Rd | 60 ++++++++++++++++++++++++++++++ vignettes/CLI_tutorial.Rmd | 11 +++++- 10 files changed, 118 insertions(+), 68 deletions(-) delete mode 100644 man/plotPvaluesByCutoff.Rd create mode 100644 man/plotSurvivalPvaluesByCutoff.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 05761359..3fcd0a59 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -58,6 +58,7 @@ Imports: Rcpp (>= 0.12.14), recount, R.utils, + reshape2, shinyjs, stringr, stats, diff --git a/NAMESPACE b/NAMESPACE index c71e0132..cadc81ac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,9 +66,9 @@ export(plotGroupIndependence) export(plotICA) export(plotPCA) export(plotProtein) -export(plotPvaluesByCutoff) export(plotRowStats) export(plotSurvivalCurves) +export(plotSurvivalPvaluesByCutoff) export(plotTranscripts) export(plotVariance) export(prepareAnnotationFromEvents) @@ -97,9 +97,7 @@ importFrom(DT,dataTableProxy) importFrom(DT,renderDataTable) importFrom(DT,replaceData) importFrom(DT,selectRows) -importFrom(GenomicRanges,makeGRangesFromDataFrame) importFrom(R.utils,capitalize) -importFrom(R.utils,decompressFile) importFrom(R.utils,evalWithTimeout) importFrom(R.utils,gunzip) importFrom(Rcpp,sourceCpp) diff --git a/NEWS b/NEWS index 7296bc49..91d69ff8 100644 --- a/NEWS +++ b/NEWS @@ -17,10 +17,10 @@ - In gene expression dataset summary, plot distribution of gene expression per sample, distribution of library sizes and gene-wise mean and variance of gene expression across samples to provide the user tools to assess gene - expression normalisation (`plotGeneExprPerSample()`, `plotDistribution` and - `plotRowStats()`, respectively) + expression normalisation (`plotGeneExprPerSample()`, `plotDistribution()` + and `plotRowStats()`, respectively) - Convert between different gene identifiers (the original identifier is - kept in some conditions, read `convertGeneIdentifiers`); in the visual + kept in some conditions, read `convertGeneIdentifiers()`); in the visual interface, when filtering and normalising gene expression, ENSEMBL identifiers are converted to gene symbols, by default * Groups: @@ -38,7 +38,7 @@ - Display correlation results in a table (`as.table()`) * Survival: - Render p-value plot by cutoff in command-line interface - (`plotPvaluesByCutoff()`) + (`plotSurvivalPvaluesByCutoff()`) * Gene, transcript and protein information: - Modify keywords used to search for PubMed articles @@ -86,7 +86,7 @@ - Fix error when groups contain samples outside the data being analysed * Gene, transcript and protein information: - Fix article title formatting (e.g. bold and italics) -* Update citation with journal publication date +* Update psichomics citation with journal publication date # 1.6.2 (2 October, 2018) diff --git a/R/analysis_survival.R b/R/analysis_survival.R index 723a305e..af749c81 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -460,7 +460,7 @@ geneExprSurvSet <- function(session, input, output) { }) } -#' Plot p-values by multiple cutoffs +#' Plot p-values of survival difference between groups based on multiple cutoffs #' #' @inheritParams processSurvTerms #' @inheritParams testSurvivalCutoff @@ -469,10 +469,32 @@ geneExprSurvSet <- function(session, input, output) { #' #' @return p-value plot #' @export -plotPvaluesByCutoff <- function(clinical, data, censoring, event, timeStart, - timeStop=NULL, followup="days_to_last_followup", - significance=0.05, - cutoffs=seq(0, 0.99, 0.01)) { +#' +#' @examples +#' clinical <- read.table(text = "2549 NA ii female +#' 840 NA i female +#' NA 1204 iv male +#' NA 383 iv female +#' 1293 NA iii male +#' NA 1355 ii male") +#' names(clinical) <- c("patient.days_to_last_followup", +#' "patient.days_to_death", +#' "patient.stage_event.pathologic_stage", +#' "patient.gender") +#' timeStart <- "days_to_death" +#' event <- "days_to_death" +#' eventPSI <- c(0.1, 1, 0.9, 1, 0.2, 0.6) +#' +#' match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) +#' eventPSI <- assignValuePerPatient(eventPSI, match, clinical) +#' +#' plotSurvivalPvaluesByCutoff(clinical, psi, censoring="right", event, +#' timeStart) +plotSurvivalPvaluesByCutoff <- function( + clinical, data, censoring, event, timeStart, timeStop=NULL, + followup="days_to_last_followup", significance=0.05, + cutoffs=seq(0, 0.99, 0.01)) { + survTime <- getAttributesTime(clinical, event, timeStart, timeStop) pvalues <- lapply( @@ -789,7 +811,7 @@ survivalServer <- function(input, output, session) { "-log\u2081\u2080(p-value) plot by cutoff") cutoffs <- seq(0, 0.99, 0.01) - pvaluePlot <- plotPvaluesByCutoff( + pvaluePlot <- plotSurvivalPvaluesByCutoff( clinical=clinical, data=eventPSI, censoring=censoring, event=event, timeStart=timeStart, timeStop=timeStop, followup=followup, cutoffs=cutoffs) diff --git a/R/data.R b/R/data.R index 7540ec56..90b8ac8c 100644 --- a/R/data.R +++ b/R/data.R @@ -128,7 +128,7 @@ loadTCGAsampleMetadata <- function(data) { #' @param x,y Character: statistic to calculate and display in the plot per row; #' choose between \code{mean}, \code{median}, \code{var} or \code{range} #' (or transformations of those variables, e.g. \code{log10(var)}) -#' @param minX,maxX,minY,maxY Numeric: minimum and maximum X and Y values to +#' @param xmin,xmax,ymin,ymax Numeric: minimum and maximum X and Y values to #' draw in the plot #' @param xlim,ylim Numeric: X and Y axis range #' @@ -153,8 +153,8 @@ loadTCGAsampleMetadata <- function(data) { #' labs(x="Median PSI", y="PSI variance") #' rangeVar <- plotRowStats(table, x="range", y="log10(var)", xlim=c(0, 1)) + #' labs(x="PSI range", y="log10(PSI variance)") -plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, - maxY=NULL, xlim=NULL, ylim=NULL) { +plotRowStats <- function(data, x, y, xmin=NULL, xmax=NULL, ymin=NULL, ymax=NULL, + xlim=NULL, ylim=NULL) { stats <- c("range", "var", "median", "mean") if (!any(sapply(stats, grepl, x)) || !any(sapply(stats, grepl, y))) { stop("x and y require to contain one of the strings:", @@ -173,9 +173,8 @@ plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, x <- y <- NULL vars <- list() for (stat in stats) { - message(sprintf("Calculating %s per splicing event...", stat)) - if (any(input[[stat]])) { + message(sprintf("Calculating %s per splicing event...", stat)) FUN <- switch(stat, "var"=rowVars, "mean"=rowMeans, @@ -201,10 +200,10 @@ plotRowStats <- function(data, x, y, minX=NULL, maxX=NULL, minY=NULL, if (!is.null(ylim)) plot <- plot + ylim(ylim) # Intercept lines - if (!is.null(minX)) plot <- plot + geom_vline(xintercept=minX, colour="red") - if (!is.null(maxX)) plot <- plot + geom_vline(xintercept=maxX, colour="red") - if (!is.null(minY)) plot <- plot + geom_hline(yintercept=minY, colour="red") - if (!is.null(maxY)) plot <- plot + geom_hline(yintercept=maxY, colour="red") + if (!is.null(xmin)) plot <- plot + geom_vline(xintercept=xmin, colour="red") + if (!is.null(xmax)) plot <- plot + geom_vline(xintercept=xmax, colour="red") + if (!is.null(ymin)) plot <- plot + geom_hline(yintercept=ymin, colour="red") + if (!is.null(ymax)) plot <- plot + geom_hline(yintercept=ymax, colour="red") return(plot) } diff --git a/man/basicStats.Rd b/man/basicStats.Rd index 5b318bfc..eb8f4443 100644 --- a/man/basicStats.Rd +++ b/man/basicStats.Rd @@ -11,7 +11,9 @@ basicStats(data, groups) splicing event} \item{groups}{List of characters (list of groups containing data identifiers) -or character vector (group of each value in \code{data})} +or character vector (group of each value in \code{data}); if \code{NULL} or a +character vector of length 1, all data points will be considered of the same +group} } \value{ HTML elements diff --git a/man/plotPvaluesByCutoff.Rd b/man/plotPvaluesByCutoff.Rd deleted file mode 100644 index e966288c..00000000 --- a/man/plotPvaluesByCutoff.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/analysis_survival.R -\name{plotPvaluesByCutoff} -\alias{plotPvaluesByCutoff} -\title{Plot p-values by multiple cutoffs} -\usage{ -plotPvaluesByCutoff(clinical, data, censoring, event, timeStart, - timeStop = NULL, followup = "days_to_last_followup", - significance = 0.05, cutoffs = seq(0, 0.99, 0.01)) -} -\arguments{ -\item{clinical}{Data frame: clinical data} - -\item{data}{Numeric: elements of interest to test against the cutoff} - -\item{censoring}{Character: censor using "left", "right", "interval" or -"interval2"} - -\item{event}{Character: name of column containing time of the event of -interest} - -\item{timeStart}{Character: name of column containing starting time of the -interval or follow up time} - -\item{timeStop}{Character: name of column containing ending time of the -interval (only relevant for interval censoring)} - -\item{followup}{Character: name of column containing follow up time} - -\item{significance}{Numeric: significance threshold} - -\item{cutoffs}{Numeric: cutoffs to test} -} -\value{ -p-value plot -} -\description{ -Plot p-values by multiple cutoffs -} diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd index 735da4e4..6da8a1a3 100644 --- a/man/plotRowStats.Rd +++ b/man/plotRowStats.Rd @@ -4,8 +4,8 @@ \alias{plotRowStats} \title{Plot sample statistics per row} \usage{ -plotRowStats(data, x, y, minX = NULL, maxX = NULL, minY = NULL, - maxY = NULL, xlim = NULL, ylim = NULL) +plotRowStats(data, x, y, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, xlim = NULL, ylim = NULL) } \arguments{ \item{data}{Data frame or matrix} @@ -14,7 +14,7 @@ plotRowStats(data, x, y, minX = NULL, maxX = NULL, minY = NULL, choose between \code{mean}, \code{median}, \code{var} or \code{range} (or transformations of those variables, e.g. \code{log10(var)})} -\item{minX, maxX, minY, maxY}{Numeric: minimum and maximum X and Y values to +\item{xmin, xmax, ymin, ymax}{Numeric: minimum and maximum X and Y values to draw in the plot} \item{xlim, ylim}{Numeric: X and Y axis range} diff --git a/man/plotSurvivalPvaluesByCutoff.Rd b/man/plotSurvivalPvaluesByCutoff.Rd new file mode 100644 index 00000000..c05f1fa0 --- /dev/null +++ b/man/plotSurvivalPvaluesByCutoff.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis_survival.R +\name{plotSurvivalPvaluesByCutoff} +\alias{plotSurvivalPvaluesByCutoff} +\title{Plot p-values of survival difference between groups based on multiple cutoffs} +\usage{ +plotSurvivalPvaluesByCutoff(clinical, data, censoring, event, timeStart, + timeStop = NULL, followup = "days_to_last_followup", + significance = 0.05, cutoffs = seq(0, 0.99, 0.01)) +} +\arguments{ +\item{clinical}{Data frame: clinical data} + +\item{data}{Numeric: elements of interest to test against the cutoff} + +\item{censoring}{Character: censor using "left", "right", "interval" or +"interval2"} + +\item{event}{Character: name of column containing time of the event of +interest} + +\item{timeStart}{Character: name of column containing starting time of the +interval or follow up time} + +\item{timeStop}{Character: name of column containing ending time of the +interval (only relevant for interval censoring)} + +\item{followup}{Character: name of column containing follow up time} + +\item{significance}{Numeric: significance threshold} + +\item{cutoffs}{Numeric: cutoffs to test} +} +\value{ +p-value plot +} +\description{ +Plot p-values of survival difference between groups based on multiple cutoffs +} +\examples{ +clinical <- read.table(text = "2549 NA ii female + 840 NA i female + NA 1204 iv male + NA 383 iv female + 1293 NA iii male + NA 1355 ii male") +names(clinical) <- c("patient.days_to_last_followup", + "patient.days_to_death", + "patient.stage_event.pathologic_stage", + "patient.gender") +timeStart <- "days_to_death" +event <- "days_to_death" +eventPSI <- c(0.1, 1, 0.9, 1, 0.2, 0.6) + +match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) +eventPSI <- assignValuePerPatient(eventPSI, match, clinical) + +plotSurvivalPvaluesByCutoff(clinical, psi, censoring="right", event, + timeStart) +} diff --git a/vignettes/CLI_tutorial.Rmd b/vignettes/CLI_tutorial.Rmd index 9e59ce7a..14306aab 100644 --- a/vignettes/CLI_tutorial.Rmd +++ b/vignettes/CLI_tutorial.Rmd @@ -86,9 +86,11 @@ aligners (currently, psichomics supports the output of the splice-aware aligner [STAR][STAR]) ### Gene expression pre-processing -* `rowMeans`: Calculate mean per row (useful to filter gene expression) -* `rowVars`: Calculate variance per row (useful to filter gene expression) +* `plotRowStats`: Plot statistics (median, variance, etc.) per gene +* `plotGeneExprPerSample`: Plot distribution of gene expression per sample +* `filterGeneExpr`: Filter genes based on their expression * `normaliseGeneExpression`: Normalise gene expression data +* `convertGeneIdentifiers`: Convert between different gene identifiers ### PSI quantification * `getSplicingEventTypes`: Get quantifiable splicing event types @@ -96,6 +98,9 @@ aligners (currently, psichomics supports the output of the splice-aware aligner files * `loadAnnotation`: Load an alternative splicing annotation file * `quantifySplicing`: Quantify alternative splicing +* `plotRowStats`: Plot statistics (median, variance, etc.) per alternative +splicing event +* `filterPSI`: Filter alternative splicing quantification **Custom alternative splicing annotation preparation** @@ -146,6 +151,8 @@ survival curves * `survfit`: Compute estimates of survival curves * `survdiff`: Test differences between survival curves * `plotSurvivalCurves`: Plot survival curves +* `plotSurvivalPvaluesByCutoff`: Plot p-values of survival difference between +groups based on multiple cutoffs ### Differential analyses * `diffAnalyses`: Perform statistical analyses (including differential splicing From e29243d6e5d2783019182604c4ada9b96dba7582 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 13:47:16 +0000 Subject: [PATCH 43/46] Fix issues in R CMD build/check --- R/data.R | 2 ++ man/plotRowStats.Rd | 2 ++ 2 files changed, 4 insertions(+) diff --git a/R/data.R b/R/data.R index 90b8ac8c..0adc4757 100644 --- a/R/data.R +++ b/R/data.R @@ -138,6 +138,8 @@ loadTCGAsampleMetadata <- function(data) { #' @export #' #' @examples +#' library(ggplot2) +#' #' # Plotting gene expression data #' geneExpr <- readFile("ex_gene_expression.RDS") #' plotRowStats(geneExpr, "mean", "var^(1/4)") + diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd index 6da8a1a3..6b2bea7a 100644 --- a/man/plotRowStats.Rd +++ b/man/plotRowStats.Rd @@ -26,6 +26,8 @@ Plot of \code{data} Plot sample statistics per row } \examples{ +library(ggplot2) + # Plotting gene expression data geneExpr <- readFile("ex_gene_expression.RDS") plotRowStats(geneExpr, "mean", "var^(1/4)") + From 71e896c1c008fce02fbad5de282327816ef39a33 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 17:28:24 +0000 Subject: [PATCH 44/46] Improve and fix function examples --- R/analysis.R | 38 ++++++++++++++++++---------- R/analysis_dimReduction_pca.R | 4 +++ R/analysis_information.R | 2 -- R/analysis_survival.R | 21 --------------- R/data.R | 7 +++-- R/data_firebrowse.R | 4 +-- R/data_geNormalisationFiltering.R | 13 ++++++++++ R/data_inclusionLevels.R | 8 ++++++ man/calculateLoadingsContribution.Rd | 4 +++ man/createOptimalSurvData.Rd | 2 +- man/downloadFiles.Rd | 4 +-- man/filterGeneExpr.Rd | 13 ++++++++++ man/filterPSI.Rd | 8 ++++++ man/getValuePerPatient.Rd | 15 ++++++++++- man/missingDataModal.Rd | 14 +++++----- man/plotProtein.Rd | 2 -- man/plotRowStats.Rd | 7 +++-- man/plotSurvivalPvaluesByCutoff.Rd | 21 --------------- man/renderBoxplot.Rd | 2 +- 19 files changed, 113 insertions(+), 76 deletions(-) diff --git a/R/analysis.R b/R/analysis.R index 4ff4be29..3c756aae 100644 --- a/R/analysis.R +++ b/R/analysis.R @@ -13,12 +13,14 @@ NULL #' #' @examples #' \dontrun{ -#' session <- session$ns -#' buttonInput <- "takeMeThere" -#' buttonId <- ns(buttonInput) -#' dataType <- "Inclusion levels" -#' missingDataModal(session, buttonId, dataType) -#' observeEvent(input[[buttonInput]], missingDataGuide(dataType)) +#' if (shiny::isRunning()) { +#' session <- session$ns +#' buttonInput <- "takeMeThere" +#' buttonId <- ns(buttonInput) +#' dataType <- "Inclusion levels" +#' missingDataModal(session, buttonId, dataType) +#' observeEvent(input[[buttonInput]], missingDataGuide(dataType)) +#' } #' } missingDataModal <- function(session, dataType, buttonId) { template <- function(buttonLabel) { @@ -160,10 +162,23 @@ getClinicalDataForSurvival <- function(..., formulaStr=NULL) { #' @param patients Character: patient identifiers (only required if the #' \code{clinical} argument is not handed) #' @param samples Character: samples to use when assigning values per patient -#' (if NULL, all samples will be used) +#' (if \code{NULL}, all samples will be used) #' #' @return Values per patient #' @export +#' +#' @examples +#' # Calculate PSI for skipped exon (SE) and mutually exclusive (MXE) events +#' annot <- readFile("ex_splicing_annotation.RDS") +#' junctionQuant <- readFile("ex_junctionQuant.RDS") +#' +#' psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) +#' +#' # Match between subjects and samples +#' match <- rep(paste("Patient", 1:3), 2) +#' names(match) <- colnames(psi) +#' +#' assignValuePerSubject(psi[3, ], match) getValuePerPatient <- function(data, match, clinical=NULL, patients=NULL, samples=NULL) { hasOneRow <- !is.null(nrow(data)) && nrow(data) == 1 @@ -172,11 +187,8 @@ getValuePerPatient <- function(data, match, clinical=NULL, patients=NULL, stop("Data needs to either have only one row or be a vector with ", "sample identifiers as names.") - if (is.null(clinical) && is.null(patients)) - stop("You cannot leave both 'clinical' and 'patients' arguments ", - "as NULL.") - else if (is.null(patients)) - patients <- rownames(clinical) + # TO DO: filter by subjects (allow to input no subjects, i.e. no filtering) + if (is.null(patients)) patients <- rownames(clinical) if (!is.numeric(data)) { ns <- names(data) @@ -1779,7 +1791,7 @@ plotDistribution <- function(data, groups=NULL, rug=TRUE, vLine=TRUE, #' @keywords internal #' #' @examples -#' renderBoxplot(data.frame(a=1:10, b=10:19, c=45:54)) +#' psichomics:::renderBoxplot(data.frame(a=1:10, b=10:19, c=45:54)) renderBoxplot <- function(data, outliers=FALSE, sortByMedian=TRUE, showXlabels=TRUE, title=NULL, seriesName="Gene expression") { diff --git a/R/analysis_dimReduction_pca.R b/R/analysis_dimReduction_pca.R index dec44633..08d166a7 100644 --- a/R/analysis_dimReduction_pca.R +++ b/R/analysis_dimReduction_pca.R @@ -230,6 +230,10 @@ plotVariance <- function(pca) { #' @return Data frame containing the correlation between variables and selected #' principal components and the contribution of variables to the selected #' principal components (both individual and total contribution) +#' +#' @examples +#' pca <- performPCA(USArrests) +#' calculateLoadingsContribution(pca) calculateLoadingsContribution <- function(pca, pcX=1, pcY=2) { loadings <- data.frame(pca$rotation)[, c(pcX, pcY)] sdev <- pca$sdev[c(pcX, pcY)] diff --git a/R/analysis_information.R b/R/analysis_information.R index f7763d90..7f4a3848 100644 --- a/R/analysis_information.R +++ b/R/analysis_information.R @@ -285,13 +285,11 @@ parseUniprotXML <- function(xml) { #' @return \code{highcharter} object #' @export #' @examples -#' \dontrun{ #' protein <- "P38398" #' plotProtein(protein) #' #' transcript <- "ENST00000488540" #' plotProtein(transcript) -#' } plotProtein <- function(molecule) { display("Retrieving protein annotation from UniProt...") xml <- queryUniprot(molecule, "xml") diff --git a/R/analysis_survival.R b/R/analysis_survival.R index af749c81..1a43a54d 100644 --- a/R/analysis_survival.R +++ b/R/analysis_survival.R @@ -469,27 +469,6 @@ geneExprSurvSet <- function(session, input, output) { #' #' @return p-value plot #' @export -#' -#' @examples -#' clinical <- read.table(text = "2549 NA ii female -#' 840 NA i female -#' NA 1204 iv male -#' NA 383 iv female -#' 1293 NA iii male -#' NA 1355 ii male") -#' names(clinical) <- c("patient.days_to_last_followup", -#' "patient.days_to_death", -#' "patient.stage_event.pathologic_stage", -#' "patient.gender") -#' timeStart <- "days_to_death" -#' event <- "days_to_death" -#' eventPSI <- c(0.1, 1, 0.9, 1, 0.2, 0.6) -#' -#' match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) -#' eventPSI <- assignValuePerPatient(eventPSI, match, clinical) -#' -#' plotSurvivalPvaluesByCutoff(clinical, psi, censoring="right", event, -#' timeStart) plotSurvivalPvaluesByCutoff <- function( clinical, data, censoring, event, timeStart, timeStop=NULL, followup="days_to_last_followup", significance=0.05, diff --git a/R/data.R b/R/data.R index 0adc4757..8d332864 100644 --- a/R/data.R +++ b/R/data.R @@ -151,10 +151,13 @@ loadTCGAsampleMetadata <- function(data) { #' junctionQuant <- readFile("ex_junctionQuant.RDS") #' psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) #' -#' medianVar <- plotRowStats(table, x="median", y="var", xlim=c(0, 1)) + +#' medianVar <- plotRowStats(psi, x="median", y="var", xlim=c(0, 1)) + #' labs(x="Median PSI", y="PSI variance") -#' rangeVar <- plotRowStats(table, x="range", y="log10(var)", xlim=c(0, 1)) + +#' medianVar +#' +#' rangeVar <- plotRowStats(psi, x="range", y="log10(var)", xlim=c(0, 1)) + #' labs(x="PSI range", y="log10(PSI variance)") +#' rangeVar plotRowStats <- function(data, x, y, xmin=NULL, xmax=NULL, ymin=NULL, ymax=NULL, xlim=NULL, ylim=NULL) { stats <- c("range", "var", "median", "mean") diff --git a/R/data_firebrowse.R b/R/data_firebrowse.R index 6d76005f..2a6634fb 100644 --- a/R/data_firebrowse.R +++ b/R/data_firebrowse.R @@ -199,10 +199,10 @@ getFirebrowseCohorts <- function(cohort = NULL) { #' @examples #' \dontrun{ #' url <- paste0("https://unsplash.it/400/300/?image=", 570:572) -#' downloadFiles(url, "~/Pictures") +#' psichomics:::downloadFiles(url, "~/Pictures") #' #' # Download without printing to console -#' downloadFiles(url, "~/Pictures", quiet = TRUE) +#' psichomics:::downloadFiles(url, "~/Pictures", quiet = TRUE) #' } downloadFiles <- function(url, folder, download = download.file, ...) { destination <- file.path(folder, basename(url)) diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 69273777..6fc7743c 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -347,6 +347,19 @@ convertGeneIdentifiers <- function(annotation, genes, key="ENSEMBL", #' #' @return Boolean vector indicating which genes have sufficiently large counts #' @export +#' +#' @examples +#' geneExpr <- readFile("ex_gene_expression.RDS") +#' +#' # Add some genes with low expression +#' geneExpr <- rbind(geneExpr, +#' lowReadGene1=c(rep(4:5, 10)), +#' lowReadGene2=c(rep(5:1, 10)), +#' lowReadGene3=c(rep(10:1, 10)), +#' lowReadGene4=c(rep(7:8, 10))) +#' +#' # Filter out genes with low reads across samples +#' geneExpr[filterGeneExpr(geneExpr), ] filterGeneExpr <- function(geneExpr, minMean=0, maxMean=Inf, minVar=0, maxVar=Inf, minCounts=10, minTotalCounts=15) { geneExprMean <- rowMeans(geneExpr) diff --git a/R/data_inclusionLevels.R b/R/data_inclusionLevels.R index c8673d85..8031ed92 100644 --- a/R/data_inclusionLevels.R +++ b/R/data_inclusionLevels.R @@ -642,6 +642,14 @@ quantifySplicingSet <- function(session, input) { #' #' @return Boolean vector indicating which splicing events pass the thresholds #' @export +#' +#' @examples +#' # Calculate PSI for skipped exon (SE) and mutually exclusive (MXE) events +#' annot <- readFile("ex_splicing_annotation.RDS") +#' junctionQuant <- readFile("ex_junctionQuant.RDS") +#' +#' psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) +#' psi[filterPSI(psi, minMedian=0.05, maxMedian=0.95, minRange=0.15), ] filterPSI <- function(psi, minMedian=-Inf, maxMedian=Inf, minLogVar=-Inf, maxLogVar=Inf, minRange=-Inf, maxRange=Inf) { diff --git a/man/calculateLoadingsContribution.Rd b/man/calculateLoadingsContribution.Rd index b28762d0..7851ae22 100644 --- a/man/calculateLoadingsContribution.Rd +++ b/man/calculateLoadingsContribution.Rd @@ -28,3 +28,7 @@ Total contribution of a variable is calculated as per: contributions of a variable to principal components (x and y) and Ex and Ey are the eigenvalues of principal components (x and y) } +\examples{ +pca <- performPCA(USArrests) +calculateLoadingsContribution(pca) +} diff --git a/man/createOptimalSurvData.Rd b/man/createOptimalSurvData.Rd index a20e8b8c..911ac17f 100644 --- a/man/createOptimalSurvData.Rd +++ b/man/createOptimalSurvData.Rd @@ -31,7 +31,7 @@ interval (only relevant for interval censoring)} \code{clinical} argument is not handed)} \item{samples}{Character: samples to use when assigning values per patient -(if NULL, all samples will be used)} +(if \code{NULL}, all samples will be used)} } \value{ Survival data including optimal PSI cutoff, minimal survival p-value diff --git a/man/downloadFiles.Rd b/man/downloadFiles.Rd index 391f345e..a5ae13f2 100644 --- a/man/downloadFiles.Rd +++ b/man/downloadFiles.Rd @@ -24,10 +24,10 @@ Download files to a given directory \examples{ \dontrun{ url <- paste0("https://unsplash.it/400/300/?image=", 570:572) -downloadFiles(url, "~/Pictures") +psichomics:::downloadFiles(url, "~/Pictures") # Download without printing to console -downloadFiles(url, "~/Pictures", quiet = TRUE) +psichomics:::downloadFiles(url, "~/Pictures", quiet = TRUE) } } \keyword{internal} diff --git a/man/filterGeneExpr.Rd b/man/filterGeneExpr.Rd index 8f466a04..9c7a7eb6 100644 --- a/man/filterGeneExpr.Rd +++ b/man/filterGeneExpr.Rd @@ -29,3 +29,16 @@ Boolean vector indicating which genes have sufficiently large counts \description{ Filter genes based on their expression } +\examples{ +geneExpr <- readFile("ex_gene_expression.RDS") + +# Add some genes with low expression +geneExpr <- rbind(geneExpr, + lowReadGene1=c(rep(4:5, 10)), + lowReadGene2=c(rep(5:1, 10)), + lowReadGene3=c(rep(10:1, 10)), + lowReadGene4=c(rep(7:8, 10))) + +# Filter out genes with low reads across samples +geneExpr[filterGeneExpr(geneExpr), ] +} diff --git a/man/filterPSI.Rd b/man/filterPSI.Rd index 8512fc1e..56e6ee4d 100644 --- a/man/filterPSI.Rd +++ b/man/filterPSI.Rd @@ -32,3 +32,11 @@ Boolean vector indicating which splicing events pass the thresholds \description{ Filter alternative splicing quantification } +\examples{ +# Calculate PSI for skipped exon (SE) and mutually exclusive (MXE) events +annot <- readFile("ex_splicing_annotation.RDS") +junctionQuant <- readFile("ex_junctionQuant.RDS") + +psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) +psi[filterPSI(psi, minMedian=0.05, maxMedian=0.95, minRange=0.15), ] +} diff --git a/man/getValuePerPatient.Rd b/man/getValuePerPatient.Rd index 5cc4ccf5..5ad8ac01 100644 --- a/man/getValuePerPatient.Rd +++ b/man/getValuePerPatient.Rd @@ -35,7 +35,7 @@ single gene} \code{clinical} argument is not handed)} \item{samples}{Character: samples to use when assigning values per patient -(if NULL, all samples will be used)} +(if \code{NULL}, all samples will be used)} \item{psi}{Data frame or matrix: values per sample} @@ -47,3 +47,16 @@ Values per patient \description{ Assign average sample values to their corresponding patients } +\examples{ +# Calculate PSI for skipped exon (SE) and mutually exclusive (MXE) events +annot <- readFile("ex_splicing_annotation.RDS") +junctionQuant <- readFile("ex_junctionQuant.RDS") + +psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) + +# Match between subjects and samples +match <- rep(paste("Patient", 1:3), 2) +names(match) <- colnames(psi) + +assignValuePerSubject(psi[3, ], match) +} diff --git a/man/missingDataModal.Rd b/man/missingDataModal.Rd index 6ecac5d9..c95bb534 100644 --- a/man/missingDataModal.Rd +++ b/man/missingDataModal.Rd @@ -30,12 +30,14 @@ Missing information modal template } \examples{ \dontrun{ - session <- session$ns - buttonInput <- "takeMeThere" - buttonId <- ns(buttonInput) - dataType <- "Inclusion levels" - missingDataModal(session, buttonId, dataType) - observeEvent(input[[buttonInput]], missingDataGuide(dataType)) +if (shiny::isRunning()) { + session <- session$ns + buttonInput <- "takeMeThere" + buttonId <- ns(buttonInput) + dataType <- "Inclusion levels" + missingDataModal(session, buttonId, dataType) + observeEvent(input[[buttonInput]], missingDataGuide(dataType)) +} } } \keyword{internal} diff --git a/man/plotProtein.Rd b/man/plotProtein.Rd index 7add8c55..481b8661 100644 --- a/man/plotProtein.Rd +++ b/man/plotProtein.Rd @@ -16,11 +16,9 @@ plotProtein(molecule) Plot protein features } \examples{ -\dontrun{ protein <- "P38398" plotProtein(protein) transcript <- "ENST00000488540" plotProtein(transcript) } -} diff --git a/man/plotRowStats.Rd b/man/plotRowStats.Rd index 6b2bea7a..00794b3b 100644 --- a/man/plotRowStats.Rd +++ b/man/plotRowStats.Rd @@ -39,8 +39,11 @@ annot <- readFile("ex_splicing_annotation.RDS") junctionQuant <- readFile("ex_junctionQuant.RDS") psi <- quantifySplicing(annot, junctionQuant, eventType=c("SE", "MXE")) -medianVar <- plotRowStats(table, x="median", y="var", xlim=c(0, 1)) + +medianVar <- plotRowStats(psi, x="median", y="var", xlim=c(0, 1)) + labs(x="Median PSI", y="PSI variance") -rangeVar <- plotRowStats(table, x="range", y="log10(var)", xlim=c(0, 1)) + +medianVar + +rangeVar <- plotRowStats(psi, x="range", y="log10(var)", xlim=c(0, 1)) + labs(x="PSI range", y="log10(PSI variance)") +rangeVar } diff --git a/man/plotSurvivalPvaluesByCutoff.Rd b/man/plotSurvivalPvaluesByCutoff.Rd index c05f1fa0..cc308dc0 100644 --- a/man/plotSurvivalPvaluesByCutoff.Rd +++ b/man/plotSurvivalPvaluesByCutoff.Rd @@ -37,24 +37,3 @@ p-value plot \description{ Plot p-values of survival difference between groups based on multiple cutoffs } -\examples{ -clinical <- read.table(text = "2549 NA ii female - 840 NA i female - NA 1204 iv male - NA 383 iv female - 1293 NA iii male - NA 1355 ii male") -names(clinical) <- c("patient.days_to_last_followup", - "patient.days_to_death", - "patient.stage_event.pathologic_stage", - "patient.gender") -timeStart <- "days_to_death" -event <- "days_to_death" -eventPSI <- c(0.1, 1, 0.9, 1, 0.2, 0.6) - -match <- getSubjectFromSample(samples, clinical, sampleInfo=sampleInfo) -eventPSI <- assignValuePerPatient(eventPSI, match, clinical) - -plotSurvivalPvaluesByCutoff(clinical, psi, censoring="right", event, - timeStart) -} diff --git a/man/renderBoxplot.Rd b/man/renderBoxplot.Rd index 30119187..6115044f 100644 --- a/man/renderBoxplot.Rd +++ b/man/renderBoxplot.Rd @@ -23,6 +23,6 @@ Box plot Render boxplot } \examples{ -renderBoxplot(data.frame(a=1:10, b=10:19, c=45:54)) +psichomics:::renderBoxplot(data.frame(a=1:10, b=10:19, c=45:54)) } \keyword{internal} From db6c24f4af2b371c061b96577479a59aca9097ce Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 17:45:11 +0000 Subject: [PATCH 45/46] Fix R CMD check and BiocCheck issues --- DESCRIPTION | 1 + R/data_geNormalisationFiltering.R | 2 ++ tests/testthat/testFilterGroups.R | 1 + tests/testthat/testFirebrowse.R | 1 + tests/testthat/testGeneInfo.R | 1 + tests/testthat/testSurvival.R | 1 + tests/testthat/testUtils.R | 1 + 7 files changed, 8 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 3fcd0a59..6d2773eb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,6 +46,7 @@ Imports: fastmatch, ggplot2, ggrepel, + graphics, grDevices, highcharter (>= 0.5.0), htmltools, diff --git a/R/data_geNormalisationFiltering.R b/R/data_geNormalisationFiltering.R index 6fc7743c..9d92eadd 100644 --- a/R/data_geNormalisationFiltering.R +++ b/R/data_geNormalisationFiltering.R @@ -400,6 +400,8 @@ plotGeneExprPerSample <- function(geneExpr, ...) { #' Sum columns using an \code{\link{EList-class}} object #' @inheritParams base::colSums +#' +#' @return Numeric vector with the sum of the columns #' @export setMethod("colSums", signature="EList", function(x, na.rm=FALSE, dims=1) { colSums(x$E, na.rm=na.rm, dims=dims) diff --git a/tests/testthat/testFilterGroups.R b/tests/testthat/testFilterGroups.R index a8f46b3b..8cf188a8 100644 --- a/tests/testthat/testFilterGroups.R +++ b/tests/testthat/testFilterGroups.R @@ -38,3 +38,4 @@ test_that("Groups are ignored with less non-missing values than the threshold", ordered <- vector[3:12][order(names(vector[3:12]), decreasing = TRUE)] expect_identical(filtered, ordered) }) + diff --git a/tests/testthat/testFirebrowse.R b/tests/testthat/testFirebrowse.R index 071f103b..d68e35ff 100644 --- a/tests/testthat/testFirebrowse.R +++ b/tests/testthat/testFirebrowse.R @@ -129,3 +129,4 @@ test_that("Parse the URLs from a Firebrowse response", { # # Remove folder after testing # unlink(file, recursive = TRUE) # }) + diff --git a/tests/testthat/testGeneInfo.R b/tests/testthat/testGeneInfo.R index b3559fff..c748e904 100644 --- a/tests/testthat/testGeneInfo.R +++ b/tests/testthat/testGeneInfo.R @@ -79,3 +79,4 @@ test_that("Plot UniProt protein", { expect_equal(plot$x$hc_opts$chart$zoomType, "x") expect_length(plot$x$hc_opts$series, 9) }) + diff --git a/tests/testthat/testSurvival.R b/tests/testthat/testSurvival.R index f1724e4c..5b89f6a5 100644 --- a/tests/testthat/testSurvival.R +++ b/tests/testthat/testSurvival.R @@ -151,3 +151,4 @@ test_that("Plot survival curves with no separation", { expect_equal(plot$x$hc_opts$chart$zoomType, "xy") expect_length(plot$x$hc_opts$series, 1) }) + diff --git a/tests/testthat/testUtils.R b/tests/testthat/testUtils.R index 2a8c990b..86b9378c 100644 --- a/tests/testthat/testUtils.R +++ b/tests/testthat/testUtils.R @@ -145,3 +145,4 @@ test_that("Parse alternative splicing event from identifiers", { c("constitutive1", "alternative1", "alternative2", "constitutive2")) }) + From b91903c6b07bf50e1cbe67bf46b06343a39d9320 Mon Sep 17 00:00:00 2001 From: Nuno Agostinho Date: Tue, 26 Mar 2019 17:51:23 +0000 Subject: [PATCH 46/46] Fix R CMD check and BiocCheck issues --- man/colSums-EList-method.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/colSums-EList-method.Rd b/man/colSums-EList-method.Rd index 3bb4e498..d5c6f3ff 100644 --- a/man/colSums-EList-method.Rd +++ b/man/colSums-EList-method.Rd @@ -21,6 +21,9 @@ over dimensions \code{dims+1, \dots}; for \code{col*} it is over dimensions \code{1:dims}.} } +\value{ +Numeric vector with the sum of the columns +} \description{ Sum columns using an \code{\link{EList-class}} object }