Feat(28)-date_upload_tab_page Fixes #28

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
-))

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)
+      })
+    }
+  })
+})

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")
+        )
+      )
   )
-)
+))