diff --git a/inst/apps/qcExplorer/global.R b/inst/apps/qcExplorer/global.R index 21e26e1..6425f52 100644 --- a/inst/apps/qcExplorer/global.R +++ b/inst/apps/qcExplorer/global.R @@ -1,11 +1,33 @@ +if (!require("shiny")) install.packages("shiny") +if (!require("samplyzer")) install.packages("samplyzer") library(shiny) library(ggplot2) library(prettyGraphs) library(grDevices) library(RColorBrewer) -library(SamplyzeR) +library(samplyzer) library(gdata) +subsetTable <- function(input, sds, id){ + # sort data frame + qc_tag = input[[paste('qcMetrics', id, sep = '')]] + max_sample_id <- max(as.numeric(sub("Sample-", "", sds$df$SampleID)), na.rm = TRUE) + max_qc_metric_value <- max(sds$df[, input$qcMetr1], na.rm = TRUE) + # filter table to brush area + brush = input[[paste('plot_brush', id, sep = '')]] + actual_xmin = brush$xmin * max_sample_id + actual_xmax = brush$xmax * max_sample_id + actual_ymin = brush$ymin * max_qc_metric_value + actual_ymax = brush$ymax * max_qc_metric_value + tab <- sds$df[ + sds$df[, input$qcMetr1] > actual_ymin & + sds$df[, input$qcMetr1] < actual_ymax & + as.numeric(sub("Sample-", "", sds$df$SampleID)) > actual_xmin & + as.numeric(sub("Sample-", "", sds$df$SampleID)) < actual_xmax, + ] + return(tab) +} + getColor<- function(n) { if (n < 7) { col = palette(rainbow(n)) @@ -16,28 +38,6 @@ getColor<- function(n) { return(col) } - -subsetTable <- function(input, sds, id){ - # sort data frame - anno_tag = input[[paste('anno', id, sep='')]] - qc_tag = input[[paste('qcMetrics', id, sep = '')]] - sds$df = sds$df[order(sds$df[anno_tag], na.last = T), ] # sort data frame - sds$df$index = 1:dim(sds$df[qc_tag])[1] # create index - - # filter table to brush area - brush = input[[paste('plot_brush', id, sep = '')]] - tab = sds$df[ - sds$df[, input$qcMetrics1] > brush$ymin & - sds$df[, input$qcMetrics1] < brush$ymax & - sds$df$index > brush$xmin & - sds$df$index < brush$xmax, ] - return(tab) -} - +source("ui.R") +source("server.R") shinyApp(ui, server) - -plot(sampleQcPlot( - sds, annotation = 'SeqProject', - qcMetrics = c('Mean_Coverage', 'Contamination_Estimation'), - geom='scatter', legend=F #, outliers = input$outliers -)) diff --git a/inst/apps/qcExplorer/server.R b/inst/apps/qcExplorer/server.R index 8f1e7bd..4e4ee77 100644 --- a/inst/apps/qcExplorer/server.R +++ b/inst/apps/qcExplorer/server.R @@ -1,39 +1,88 @@ -server <- function(input, output) { - values <- reactiveValues(df_data = NULL, outliers = NULL) - observeEvent(input$plot_brush1, { - values$df_data = subsetTable(input, sds, 1) - values$outliers = values$df_data$sampleId +# Server +server <- shinyServer(function(input, output, session) { + file_data <- reactiveValues( + bamQcMetr = NULL, + annotations = NULL, + vcfQcMetr = NULL, + samplePc = NULL, + refpc = NULL, + sds = NULL + ) + reactive_sds <- reactive({ + file_data$sds() }) - # QC scatterplot - output$plot1 <- renderPlot({ - plot(sampleQcPlot( - sds, annotation = input$anno1, qcMetrics = input$qcMetrics1, - geom='scatter' #, outliers = input$outliers - )) + selectedAnno <- reactive({ + input$anno1 }) - # QC violin plot - output$violin <- renderPlot({ - plot(sampleQcPlot(sds, qcMetrics = input$qcMetrics1, geom = 'violin', - annotation = input$anno1)) # outliers = input$outliers + selectedQcMetrics <- reactive({ + input$qcMetr1 }) - # QC metrics correlation - output$qcCorr <- renderPlot({ - samplyzer::scatter( - data = subsetTable(input, sds, 1), x = input$qcMetr1, y = input$qcMetr2, - strat = input$attr, primaryID = sds$primaryID) - }) + observeEvent(c(input$bamQcMetrFile, input$annotationsFile, input$vcfQcMetrFile), { + # Check if all the required files are provided + if (!is.null(input$bamQcMetrFile) && !is.null(input$annotationsFile) && !is.null(input$vcfQcMetrFile)) { + # Check if optional files are provided + if (!is.null(input$samplePCsFile)) { + file_data$samplePc <- read.csv(input$samplePCsFile$datapath, sep = '\t') + } + if (!is.null(input$refPCsFile)) { + file_data$refPC <- read.csv(input$refPCsFile$datapath, sep = '\t') + } + file_data$bamQcMetr <- read.csv(input$bamQcMetrFile$datapath, sep = '\t', row.names = NULL) + file_data$annotations <- read.csv(input$annotationsFile$datapath, sep = '\t', row.names = NULL) + file_data$vcfQcMetr <- read.csv(input$vcfQcMetrFile$datapath, sep = '\t', row.names = NULL) - # pca correlation - output$pca <- renderPlot({ - samplyzer::scatter( - data = sds$df, x = input$PCx, y = input$PCy, strat = input$attr2, - outliers = input$outliers, primaryID = sds$primaryID) - }) - # render outlier info - output$table1 <- renderTable(values$df_data) -} + file_data$sds <- sampleDataset( + bamQcInput = file_data$bamQcMetr, + vcfQcInput = file_data$vcfQcMetr, + annotInput = file_data$annotations, + primaryID = 'SampleID' + ) + updateSelectInput(session, "qcMetr1", choices = unique(file_data$sds$qcMetrics)) + updateSelectInput(session, "qcMetr2", choices = unique(file_data$sds$qcMetrics)) + updateSelectInput(session, "anno1", choices = unique(file_data$sds$annot)) + + # QC scatterplot + output$plot1 <- renderPlot({ + sampleQcPlot( + file_data$sds, annot= selectedAnno(), qcMetrics = selectedQcMetrics(), + geom= "scatter", outliers = input$outliers, show = T) + }) + + # QC violin plot + output$plot2 <- renderPlot({ + sampleQcPlot( + file_data$sds, annot= selectedAnno(), qcMetrics = selectedQcMetrics(), + geom= "violin", outliers = input$outliers, show = T) + }) + file_data$sds = setAttr(file_data$sds, attributes = 'PC', data = file_data$samplePc, primaryID = 'SampleID') + file_data$sds <- inferAncestry( + file_data$sds, + trainSet = file_data$refPC[, grep("^PC", names(file_data$refPC))], + knownAncestry = file_data$refPC$group, + ) + # pca correlation + output$pca <- renderPlot({ + samplyzer:::scatter( + data = file_data$sds$df, x = input$PCx, y = input$PCy, strat = input$anno1, + outliers = input$outliers, primaryID = file_data$sds$primaryID) + }) + + observeEvent(input$plot_brush1, { + sds_subset = subsetTable(input, file_data$sds, 1) + # QC metrics correlation + output$qcCorr <- renderPlot({ + samplyzer:::scatter( + data = sds_subset, x = input$qcMetr1, y = input$qcMetr2, strat = input$anno1, + outliers = input$outliers, primaryID = file_data$sds$primaryID + )}) + + output$table1 <- renderTable(sds_subset) + }) + } + }) +}) diff --git a/inst/apps/qcExplorer/ui.R b/inst/apps/qcExplorer/ui.R index f5c84d9..d4ec8d3 100644 --- a/inst/apps/qcExplorer/ui.R +++ b/inst/apps/qcExplorer/ui.R @@ -1,32 +1,40 @@ -ui <- fluidPage( - # Some custom CSS for a smaller font for preformatted text - tags$head(tags$style(HTML("pre, table.table {font-size: smaller;}"))), - titlePanel("Sample Explorer"), - fluidRow( - column(width = 2, wellPanel( - fileInput("QC metrics", "Upload sample QC table", - accept = c("text/csv", ".csv")), - fileInput("Subject Annotations", "Upload sample annotatins", - accept =c("text/csv",".csv")), - selectInput('qcMetrics1', 'QC metrics', sds$qcMetrics), - selectInput('anno1', 'Subject Attributes', sds$annotations), - textInput("outliers","sample IDs","outliers") - )), - column(width = 5, plotOutput("plot1", - brush = brushOpts(id = "plot_brush1"))), - column(width = 5, plotOutput("violin")) +# UI +ui <- shinyUI(pageWithSidebar( + headerPanel("Sample Explorer"), + sidebarPanel( + tabsetPanel( + tabPanel("Upload Files", + fileInput("bamQcMetrFile", "Upload sample QC table", accept = c('text/csv', 'text/comma-separated-values,text/plain')), + fileInput("annotationsFile", "Upload sample annotations", accept = c('text/csv', 'text/comma-separated-values,text/plain')), + fileInput("samplePCsFile", "Upload samplePCs", accept = c('text/csv', 'text/comma-separated-values,text/plain')), + fileInput("refPCsFile", "Upload refPCs", accept = c('text/csv', 'text/comma-separated-values,text/plain')), + fileInput("vcfQcMetrFile", "Upload vcfQcMetc", accept = c('text/csv', 'text/comma-separated-values,text/plain')) + ), + tabPanel("Parameters", + selectInput("anno1", 'Subject Attributes', choices = NULL), + textInput("outliers", "sample IDs", "Sample-001"), + selectInput("qcMetr1", 'QC metrics', choices = NULL), + selectInput('qcMetr2', 'QC metrics 2', choices = NULL), + selectInput('PCx', 'first PC', paste('PC', 1:10, sep = '')), + selectInput('PCy', 's-econd PC', paste('PC', 1:10, sep = '')) + ) + ) ), - fluidRow( - column(width = 2, wellPanel( - selectInput('qcMetr1', 'QC metrics 1', sds$qcMetrics), - selectInput('qcMetr2', 'QC metrics 2', sds$qcMetrics), - selectInput('attr', 'attributes', sds$annotations), - selectInput('PCx', 'first PC', paste('PC', 1:10, sep = '')), - selectInput('PCy', 'second PC', paste('PC', 1:10, sep = '')), - selectInput('attr2', 'PC attributes', sds$annotations) - )), - column(width = 5, plotOutput("qcCorr")), - column(width = 5, plotOutput("pca")), - column(width = 3, tableOutput("table1")) + mainPanel( + fluidRow( + column(6, + plotOutput("plot1",brush = brushOpts(id = "plot_brush1")), + plotOutput("pca") + ), + column(6, + plotOutput("plot2"), + plotOutput("qcCorr") + ) + ), + fluidRow( + column(12, + tableOutput("table1") + ) + ) ) -) +))