R/shinyApp.R

In CMWbio/weavR: weavR: Windowed Evolutionary Analysis and Visualisation in R.

#' Shiny GUI
#'
#' @description Shiny GUI
#'
#' @details Run the GUI to explore the data generated by this package.
#'
#' @param fileName A \code{character} vector of length one containing the full path name for a Tabix indexed VCF
#' @param contigs \code{character}. Default is \code{"all"} Contigs to extract windows from.
#'
#'
#' @return Shiny GUI to visulaise and explore results
#'
#'
#' @import shiny
#' @import shinydashboard
#' @import shinyFiles
#'
#'
#'
#'
#'
#' @examples
#'
#' @export
#' @rdname popShiny

# library(shiny)
# library(shinydashboard)
# library(leaflet)
# library(shinyFiles)
#
#


popShiny <- function(){



  ui <- dashboardPage(
    dashboardHeader(title = "weavR"),
    dashboardSidebar(
      sidebarMenu(
        menuItem(text = "", icon = icon("upload", "fa-2x"), tabName = "readVCF"),
        menuItem(text = "", icon = icon("tree", "fa-2x"), tabName = "trees")
      ), width = "59px"
    ),
    dashboardBody(
      tabItems(tabItem(tabName = "readVCF",
                       box(h5("Select VCF File"),
                           shinyFilesButton(id = "VCF", title = "Select VCF File", label = "Browse...", multiple = FALSE),
                           textInput(inputId = "winSize", value = "10000", label = "Select Window Size"),
                           selectizeInput("scaffoldNames", choices = NULL, label = "Select Contigs to Read in from VCF", multiple = TRUE),
                           textInput("minSites", value = "1000", label = "Minimum sites in window to calculate from"),
                           textInput("ploidy", value = "2", label = "Ploidy of samples"),
                           actionButton("import", "Import Windows"),
                           textOutput("nrows"), collapsible = TRUE, title = "Read in VCF Data", width = 4)
      ), tabItem(tabName = "trees")
      )
    )
  )

  server <- function(input, output, session){

    values <- reactiveValues()

     volumes <- getVolumes()
     observe({
       shinyFileChoose(input, "VCF", roots = volumes, session = session)
     })


     observeEvent(input$VCF, {
       fileSelected <- shinyFiles::parseFilePaths(volumes, input$VCF)
       values$fileName <- as.character(fileSelected$datapath)
     })

     observeEvent(input$VCF, {
       header <- scanVcfHeader(TabixFile(values$fileName))
       values$contigMD <- as.data.frame(header@header$contig)
       values$contigs <- rownames(values$contigMD)
       updateSelectizeInput(session, "scaffoldNames", choices = c("all", values$contigs))
     })


    observeEvent(input$import, {
      winSize <- as.numeric(input$winSize)
      percentage <- 0
      ploidy <- as.numeric(input$ploidy)
      minSites <- as.numeric(input$minSites)
      fileName <- values$fileName
      contigMD <- values$contigMD
      nCores <- 5

      if(all(input$scaffoldNames == "all")){
        scaf <- values$contigs
      } else {
        scaf <- input$scaffoldNames
      }
      withProgress(
        values$dna <- lapply(scaf,  function(con){
          percentage <<- percentage + 1/length(scaf)*100
          incProgress(1/length(scaf), detail = paste0("Progress: ", round(percentage,2)))
          length <- as.integer(filter(contigMD, rownames(contigMD) == con)$length)
          if(length >= winSize){
            nWindows <- floor(length / winSize)

            scafDNA <- mclapply(seq(1, nWindows), mc.cores = nCores, function(winN){

              pos <- winN * winSize + 1
              start <- pos - winSize
              end <- pos

              p <- ScanVcfParam(which = GRanges(seqnames = con, ranges = IRanges(start = start, end = end)))

              nSites <- tryCatch(length(scanVcf(TabixFile(fileName), param = p)[[1]]$rowRanges),  error=function(e) 0)

              if(nSites >= minSites){
                #read in vcf
                dna <- vcfWindow(fileName = fileName, contig = con, param = p, ploidy = ploidy)
              } else dna <- c(NA)
              names(dna) <- paste0(con, ":", start, "-", end)
              dna
            })
            scafDNA
          } else scafDNA <- NA
        }) %>% unlist(recursive = FALSE),
        message = "Reading in Windows"

      )
    })



    output$nrows <- renderText({
      if(!is.null(values$dna)) length(values$dna)
    })


  }


  shinyApp(ui = ui, server = server)

}