R/shinyVisServer.R

In chapmandu2/CollateralVulnerability2016: Collateral Vulnerability Pipeline

#' Shiny Visualisation Server
#'
#' Creates a shiny server for the interactive view of Collateral Vulnerability pipeline results
#'
#' @param input Shiny input list
#' @param output Shiny output list
#' @param con A \code{SQLiteConnection} object to the database
#' @param table_name The table in the SQLite database containing the expression data.  The table should have fields named
#'   patient_id, gene_id and value where gene_id is an ensembl id.  Default tcga_rnaseq_data
#' @return A shiny server
#' @export
#' @import shiny
shinyVisServer <- function(input, output, con, table_name = "tcga_rnaseq_data") {

    proc_data <- reactive({
        data <- dplyr::src_sqlite(con@dbname) %>%
            dplyr::tbl('combined_results') %>%
            dplyr::filter(pi_value <= input$pi_value_th,
                          bisep_pval <= input$bisep_pval_th) %>%
            dplyr::select(-c(mutations, paralog_ids)) %>%
            dplyr::arrange(bisep_pval) %>%
            dplyr::collect()

        #filter depending on whether bi_value_th greater than 0
        if (input$bi_value_th > 0) {
            data <- data %>% dplyr::filter(BI >= input$bi_value_th)
        }

        #filter depending on paralog checkbox
        if (input$paralog_count_include) {
            data <- data %>% dplyr::filter(count_paralogs >= input$paralog_count_range[1],
                                           count_paralogs <= input$paralog_count_range[2])
        }

        #filter depending on lethality checkboxes
        if (input$lethal_pct_fly_include & input$lethal_pct_worm_include) {
            data <- data %>% dplyr::filter(lethal_pct_fly >= input$lethal_pct_fly | lethal_pct_worm >= input$lethal_pct_worm)
        } else if (input$lethal_pct_fly_include) {
            data <- data %>% dplyr::filter(lethal_pct_fly >= input$lethal_pct_fly)
        } else if (input$lethal_pct_worm_include) {
            data <- data %>% dplyr::filter(lethal_pct_worm >= input$lethal_pct_worm)
        }

        #filter depending on chromosome checkbox
        if (input$chromosome_include) {
            data <- data %>% dplyr::filter(as.character(seqnames) %in% input$chromosome_sel)
        }

        return(as.data.frame(data))
    })

    proc_gene_selected <- reactive({
        if(input$display_type == 'table') {
            proc_data()[input$results_row_last_clicked,'gene_id']
        } else if (input$display_type == 'scatter') {
            vals$gene_selected
        }
    })

    proc_bisep_plot <- reactive({

        if(input$chromosome_include) {
            chromosome_sel <- input$chromosome_sel
        } else {
            chromosome_sel <- 0
        }

        out_plot <- plotBISEPOutput(con, highlighted_gene = proc_gene_selected(),
                                    pi_value_th = input$pi_value_th,
                                    bisep_pval_th = input$bisep_pval_th,
                                    bi_value_th = input$bi_value_th,
                                    xval = input$xaxis,
                                    yval=input$yaxis,
                                    colval = input$colval,
                                    chromosome_sel = chromosome_sel)
        out_data <- as.data.frame(out_plot$data)
        return(list(plot=out_plot, data=out_data))

    })

    # Toggle points that are clicked
    vals <- reactiveValues(
        gene_selected = NULL
    )

    #identify clicked points
    observeEvent(input$bisep_plot_click, {
        res <- nearPoints(proc_bisep_plot()$data, input$bisep_plot_click,  threshold=10, allRows=FALSE, addDist=TRUE)
        if(nrow(res) > 0) {
            vals$gene_selected <- res$gene_id[1]
        } else {
            vals$gene_selected <- NULL
        }
    })

    output$mut_data <- renderTable({
        if(length(proc_gene_selected()) > 0) {
            tableMutationDetails(con, proc_gene_selected())
        }
    })

    output$paralog_data <- renderTable({
        if(length(proc_gene_selected()) > 0) {
            tableParalogDetails(con, proc_gene_selected())
        }
    })

    output$flymine_data <- renderTable({
        if(length(proc_gene_selected()) > 0) {
            tableFlymineDetails(con, proc_gene_selected())
        }
    })

    output$wormmine_data <- renderTable({
        if(length(proc_gene_selected()) > 0) {
            tableWormMineDetails(con, proc_gene_selected())
        }
    })

    output$results <- DT::renderDataTable({
        proc_data()
    }, filter='top', selection = 'single', options=list(pageLength = 10, lengthMenu = c(5,10, 25, 50, 100)))

    output$bisep_plot <- renderPlot({
        proc_bisep_plot()$plot
    })

    output$rnaseq_plot <- renderPlot({
        if(length(proc_gene_selected()) > 0) {
            doRNAseqPlot(con, proc_gene_selected(), table_name)
        }
    })

    output$paralog_plot <- renderPlot({
        if(length(proc_gene_selected()) > 0) {
            plotParalogRNAseq(con, proc_gene_selected())
        }
    })

    #contents of the display panel depending on what is chosen
    output$displayUI <- renderUI({
        if(input$display_type == 'scatter') {
            fluidRow(
                wellPanel(
                    fluidRow(column(4,selectInput(inputId = 'xaxis',
                                        label='X-Axis:',
                                        choices=c('PI Value' = 'pi_value',
                                                   'BISEP P-value' = 'bisep_pval',
                                                  'Bimodal Index Value' = 'BI'),
                                        selected='pi_value')),
                             column(4,selectInput(inputId = 'yaxis',
                                      label='Y-Axis:',
                                      choices=c('PI Value' = 'pi_value',
                                                'BISEP P-value' = 'bisep_pval',
                                                'Bimodal Index Value' = 'BI'),
                                      selected='bisep_pval')),
                             column(4,selectInput(inputId = 'colval',
                                                  label='Colour by:',
                                                  choices=c('Selected' = 'selected',
                                                            'Chromosome' = 'seqnames'),
                                                  selected='selected')))),
                plotOutput('bisep_plot', click = "bisep_plot_click"),
                downloadButton('downloadBISEPData', 'Download BISEP Data')
            )
        } else if (input$display_type == 'table') {
            fluidRow(
                DT::dataTableOutput('results'),
                downloadButton('downloadData', 'Download Combined Data'),
                downloadButton('downloadGenePairsData', 'Download Gene Pairs')
            )
        }
    })

    #contents of the detail panel depending on what is chosen
    output$detailUI <- renderUI({
        if ( input$detail_type == 'rnaseq_plot') {
            plotOutput('rnaseq_plot')
        } else if (input$detail_type == 'mut_data') {
            tableOutput('mut_data')
        } else if (input$detail_type == 'paralog_plot') {
            plotOutput('paralog_plot')
        } else if (input$detail_type == 'paralog_data') {
            tableOutput('paralog_data')
        } else if (input$detail_type == 'flymine_data') {
            tableOutput('flymine_data')
        } else if (input$detail_type == 'wormmine_data') {
            tableOutput('wormmine_data')
        }
    })

    output$test <- renderText({})

    output$downloadData <- downloadHandler(
        filename = "data_download.txt",
        content = function(file) {
            write.table (proc_data(), file = file, sep = '\t', row.names = FALSE, col.names=TRUE, na='')
        }
    )

    output$downloadBISEPData <- downloadHandler(
        filename = 'bisep_data_download.txt',
        content = function(file) {
            write.table(proc_bisep_plot()$data, file=file, sep='\t', row.names = FALSE, col.names = TRUE, na='')
        }
    )

    output$downloadGenePairsData <- downloadHandler(
        filename = 'gene_pairs_download.txt',
        content = function(file) {
            write.table(tableGenePairsDetails(con, proc_data()$gene_id), file=file, sep='\t', row.names = FALSE, col.names = TRUE, na='')
        }
    )

}