exec/app.R

In nickilott/MIGTranscriptomeExplorer: MIGTranscriptomeExplorer: An R/shiny interface for exploring transcriptomic data

# load packages
library(shiny)
library(MIGTranscriptomeExplorer)
library(gridExtra)
library(RSQLite)
library(dplyr)
library(shinythemes)
library(shinyjs)
library(ggplot2)
library(VennDiagram)

# Define UI for MIGTranscriptomeExplorer app

db <- system.file("data/csvdb", package="MIGTranscriptomeExplorer")
conn <- connect(db=db)

ui <- fluidPage(theme=shinytheme("flatly"),
  
    # App title
    titlePanel("MIGTranscriptomeExplorer"),
  
    # Sidebar panel for inputs
    sidebarLayout(
        sidebarPanel(
	    h2("1. Explore gene expression across datasets"),

	    h4("Search for gene in database"),
	    textInput("gene", label="Gene:", value = ""),
            actionButton("gene.search", "get expression"),

	    h4("Significant contrasts in database"),
	    h5("Specify thresholds"),
	    numericInput("lfc", label="lfc:", value = 0),
	    numericInput("padj", label="padj", value = 0.05),
	    actionButton("significant", "get significant"),

	    h2("2. Explore specific dataset"),
	    h4("Choose dataset"),
	    selectInput("choose.dataset", "Dataset:", choices=showDatasets(conn)$dataset),

	    h4("Principle Components Analysis"),

	    selectInput("PCs", "PC:", choices=c("PC1 vs. PC2" = "PC1_PC2",
	                                        "PC1 vs. PC3" = "PC1_PC3",
						"PC2 vs. PC3" = "PC2_PC3")),
	    h5("Colour by"),
	    uiOutput("variable"),
	    h5("Shape by"),
	    uiOutput("variable.shape"),
            actionButton("PCA", "PCA"),
	    downloadButton("download.pca", "Download"),

	    h4("Differential expression results"),
	    uiOutput("ma.contrast"),
	    h5("Thresholds"),
	    numericInput("ma.lfc", label="lfc", value = 1),
	    actionButton("MA", "MA plot"),
	    downloadButton("download.ma", "Download"),

            h5("Dispay results table"),
	    actionButton("show.results", "Tabulate"),

	    h5("Export results to current directory"),
            downloadButton("download.table", "Download"),

	    h2("3. Compare results across datasets/contrasts"),
	    selectInput("dataset1", "dataset 1", choices=getDatasetToContrastNames(conn)),
	    selectInput("dataset2", "dataset 2", choices=getDatasetToContrastNames(conn)),
	    actionButton("scatter.lfc", "Scatterplot lfc"),
            downloadButton("download.scatter", "Download"),

            h5("Venn diagram"),
	    numericInput("venn.lfc", "lfc", value=1),
	    actionButton("venn", "venn diagram")
        ),

    # Main panel for displaying outputs
    mainPanel(
              tabsetPanel(
	          tabPanel("Datasets", DT::dataTableOutput("dataset.table")),
                  tabPanel("1. Expression across datasets", plotOutput("gene.expression", height=800),
	                                                 DT::dataTableOutput("significant.results")),
	          tabPanel("2. Explore dataset", plotOutput("PCA"),
	                                      plotOutput("MA", brush = "plot_brush_ma"),
                                              verbatimTextOutput("gene.info.ma"),
                                              DT::dataTableOutput("tabulate.results")),
                  tabPanel("3. Compare datasets", plotOutput("scatter.lfc", brush = "plot_brush"),
                                               verbatimTextOutput("gene.info"),
	                                       plotOutput("venn"))
                 )
   )
   )
)



db <- system.file("data/csvdb", package="MIGTranscriptomeExplorer")
conn <- connect(db=db)

# Define server logic
server <- function(input, output) {

    ######################
    # displaying datasets
    ######################

    output$dataset.table <- DT::renderDataTable({
        showDatasets(conn)
    })

    #####################
    # gene expression
    #####################
    expression <- eventReactive(input$gene.search, {

        statement <- 'SELECT dataset FROM reference'
        datasets <- dbGetQuery(conn, statement)$dataset

        grobs.list <- list()
        for (i in 1:length(datasets)){
            dataset <- datasets[i]
            expression <- getExpression(conn, dataset, input$gene) 
            expression <- na.omit(expression)
	    metadata <- getMetadata(conn, dataset)
            p <- plotGeneOfInterest(dataset, expression, metadata, variable="group") + theme(legend.position="none")
            grobs.list[[i]] <- p
        }
	# hardcoded
        grid.arrange(grobs=grobs.list, nrow=3, ncol=3)
    })

    output$gene.expression <- renderPlot({
	expression()
    })

    #####################
    # significant sets
    #####################
    significant <- eventReactive(input$significant, {

        statement <- 'SELECT dataset FROM reference'
        datasets <- dbGetQuery(conn, statement)$dataset

        dfs.list <- list()
        idx <- 1
        for (i in 1:length(datasets)){
            dataset <- datasets[i]

	    # get the contrasts for the dataset
	    contrasts <- getContrasts(conn, dataset)

	    # iterate over contrasts
	    for (j in 1:length(contrasts)){
                contrast <- contrasts[j]
                significant <- getSignificant(conn, dataset, contrast, input$lfc, input$padj, input$gene)
	        if (!(is.na(significant)) > 0){
	            significant$contrast <- contrast
	            dfs.list[[idx]] <- significant
		    idx <- idx + 1
		}
            }
        }
        df.out <- bind_rows(dfs.list)
    })

    output$significant.results <- DT::renderDataTable({
        significant()
    })

    #####################
    # plots
    #####################
    output$variable <- renderUI({
        variables <- append("none", getMetadataList(conn, input$choose.dataset))
        names(variables) <- variables
        selectInput("variable", "variable", variables)
    })

    output$variable.shape <- renderUI({
        variables <- append("none", getMetadataList(conn, input$choose.dataset))
        names(variables) <- variables
        selectInput("variable.shape", "variable", variables)
    })

    PCA <- eventReactive(input$PCA, {
        mat <- getMatrix(conn, input$choose.dataset)
        metadata <- getMetadata(conn, input$choose.dataset)
        metadata <- sortMetadata(mat, metadata)
        metadata$none <- "none"
	pcs <- unlist(strsplit(input$PCs, "_"))
        pc <- runPCA(mat, scale=FALSE)
        plotPrincipleComponents(pc, metadata, colourby=input$variable, shapeby=input$variable.shape, pcs=pcs)
    })

    output$PCA <- renderPlot({
        PCA()
    })

    output$ma.contrast <- renderUI({
        contrasts <- getContrasts(conn, input$choose.dataset)
        names(contrasts) <- contrasts
        selectInput("ma.contrast", "contrast", contrasts)
    })

    ma.df <- eventReactive(input$MA, {
        getResultSet(conn, input$choose.dataset, input$ma.contrast)
    })

    MA <- eventReactive(input$MA, {
        plotMA(ma.df(), lfc=input$ma.lfc, title=paste(input$choose.dataset, input$ma.contrast, sep=": "))
    })

    output$MA <- renderPlot({
        MA()
    })

    output$gene.info.ma <- renderPrint({
	brushedPoints(na.omit(ma.df()), input$plot_brush_ma)          
    })

    tabulate <- eventReactive(input$show.results, {
        tabulateResults(conn, input$choose.dataset, input$ma.contrast)
    })

    output$tabulate.results <- DT::renderDataTable({
        tabulate()
    })

    df <- eventReactive(input$scatter.lfc, {
        buildComparisonSet(conn, input$dataset1, input$dataset2)
    })

    scatterlfc <- eventReactive(input$scatter.lfc, {
      scatterComparisons(na.omit(df()))
    })

    output$scatter.lfc <- renderPlot({
        scatterlfc()
    })

    output$gene.info <- renderPrint({
	brushedPoints(na.omit(df()), input$plot_brush)          
    })

    df.venn <- eventReactive(input$venn, {
        buildComparisonSet(conn, input$dataset1, input$dataset2)
    })

    venndiagram <- eventReactive(input$venn, {
        vennComparisons(df.venn(), input$venn.lfc)
    })

    output$venn <- renderPlot({
        venndiagram()
    })

    ##############
    # downloads
    ##############

    output$download.pca <- downloadHandler(
	filename = function() {
	    paste0(input$choose.dataset, "_", "pca", ".pdf")
	},
        content = function(file){
	    ggsave(file, plot=PCA())
    })

    output$download.ma <- downloadHandler(
	filename = function() {
	    paste0(input$choose.dataset, "__", input$ma.contrast, "_", "ma", ".pdf")
	},
        content = function(file){
	    ggsave(file, plot=MA())
    })

    output$download.table <- downloadHandler(
	filename = function() {
	    paste0(input$choose.dataset, "__", input$ma.contrast, "_", "result", ".tsv")
	},
        content = function(file){
	    write.table(tabulate(), file, sep="\t", quote=F, row.names=F)
    })
    
    output$download.scatter <- downloadHandler(
	filename = function() {
	    paste0(input$choose.dataset, "_", input$dataset1, "_vs_", input$dataset2, ".pdf")
	},
        content = function(file){
	    ggsave(file, plot=output$scatter.lfc)
   })
}

shinyApp(ui, server)