fix package errors, etc

shinyApp/global.R

@@ -1,3 +1,18 @@
+#if(!requireNamespace("BiocManager")){
+#  install.packages("BiocManager")
+#}
+#BiocManager::install("phyloseq")
+#BiocManager::install("Rhdf5lib")
+#BiocManager::install("permute")
+
+# https://stackoverflow.com/questions/4090169/elegant-way-to-check-for-missing-packages-and-install-them
+list.of.packages <- c(#"phyloseq", 
+                      "ade4", "dplyr", "stringr", "shiny", 
+                      "shinydashboard",
+                      "shinyjs", "DT", "futile.logger")
+new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
+if(length(new.packages)) install.packages(new.packages)
+
 library(phyloseq)
 library(ade4)
 library(dplyr)
@@ -6,25 +21,21 @@ library(shiny)
 library(shinydashboard)
 library(shinyjs)
 library(DT)
-library(shinywdstar)
 library(futile.logger)
 
-flog.appender(appender.file("shinywdstar.log"))
+ts <- substr(as.character(Sys.time()), 1, 10)
+log_filename <- paste0("shinywdstar_",ts,".log")
+flog.appender(appender.file(log_filename))
 
 source("newutil.R")
 source("module-loadPanel.R")
 source("module-factorPanel.R")
-source("module-testsPanel.R")
+
+#source("module-testsPanel.R")
 source("module-analysisPanel.R")
+source("module-statusPanel.R")
 
 distance_choices <- phyloseq::distanceMethodList
-data(physeq)
-
-#other data set
-data(phy)
-data(phenotypes)
-
-#physeq <- readRDS("physeq.rds")
-#physeq <- readRDS("physeq.rds")
-#load("data/physeq.rda")
+data(soilrep)
+physeq <- soilrep
 

shinyApp/module-analysisPanel.R

@@ -3,89 +3,97 @@ library(shiny)
 library(glue)
 library(DT)
 library(futile.logger)
+library(ggplot2)
+
+data_controls_box_height <- 210
 
 # UI
 analysisPanelUI <- function(id) {
   ns = NS(id)
 
-  tagList(uiOutput(ns("analysis")))
-}
-
-# Server
-analysisPanel <- function(input, output, session, computed_details, sampleData, 
-                       allDataAvailable, availableFactors, numTests,
-                       testsData, testsDT) {
-
-  numTests <- numTests
-  allDataAvailable <- allDataAvailable
-  computed_details <- computed_details
-  testsData <- testsData
-  sampleMainFactor <- reactiveVal(NULL)
-
-  selectedFactorChoices <- reactiveVal(NULL)
-
-  data_controls_box_height <- 210
-
-  data_controls_panel <- reactive({
-    ns <- session$ns
-     fluidRow(div(id="xdata_controls_panel",
+  tagList(
+    fluidRow(h1("Please wait for plots to appear, notification is at bottom of screen")),
+    fluidRow(div(id="xdata_controls_panel",
        box(width = 4,
            background = "olive",
            height = data_controls_box_height,
            selectInput(ns("distanceMethod"), "Distance",
-                              distance_choices, selected = "jsd")),
+                 distance_choices, selected = "jsd")),
        box(width = 4, background="olive",
            height = data_controls_box_height,
            uiOutput(ns("strataFactor")),
-           uiOutput(ns("mainFactor"))),
-       box(id = ns("add_test_box"), width = 4, background= "teal",
-           height = data_controls_box_height,
-           actionButton(ns("addTestBtn"), "Add Test"),
-           numericInput(ns("numPermutations"), "Number of Permutations",
-                            value = 999, min = 1, max = 100000),
-           if(numTests() > 0) actionButton(ns("runTestsBtn1"), "Run Tests"),
-           if(numTests() > 0) actionButton(ns("clearTestsBtn"), "Clear Tests"),
-           if(numTests() > 0) textOutput(ns("testTable2"))
-           )))})
-
-
-  observeEvent(input$runTestsBtn1, {
-    show(id = "running-tests", anim = TRUE, animType = "fade")
-    runTestsAction()
-    hide(id = "running-tests", anim = TRUE, animType = "fade")
-    updateTabsetPanel(session, inputId="sidebar", selected="tests")
+           uiOutput(ns("mainFactorDropdown"))))),
+        fluidRow(
+          box(title = "Ordination Plot", width = 6, plotOutput(ns("plot"))),
+          box(title = "Plot", width = 6, plotOutput(ns("newplot")))))
+}
+
+
+#' Analysis Panel module server-side processing
+#'
+#' @param input,output,session standard \code{shiny} boilerplate
+#'
+#' @return list with following components
+#' \describe{
+#'   \item{globalData}{reactive character indicating x variable selection}
+#' }
+analysisPanel <- function(input, output, session, 
+                          globalData) {
+
+  ns <- session$ns
+  globalData <- globalData
+  sampleMainFactor <- reactiveVal(NULL)
+  selectedFactorChoices <- reactiveVal(NULL)
+
+  observeEvent(input$mainFactor, {
+  })
+
+
+  availableFactors <- reactive({
+    av <- globalData()[["factor_metadata"]]
+    af <- av %>% 
+            dplyr::filter(ready == TRUE) %>% 
+            pull(name)
+    af
   })
 
   # output$mainFactor ----
-  output$mainFactor = renderUI({
+  output$mainFactorDropdown = renderUI({
     af <- availableFactors()
     if(length(af) > 0) {
-      selectInput('mainFactor', 'Main factor', af )
+      selectInput(ns("mainFactor"), 'Main factor', af )
+    } else {
+      selectInput(ns("mainFactor"), 'Main factor', 
+                  c("Missing") )
     }
   })
 
   # output$strataFactor ----
   output$strataFactor = renderUI({
     af <- append("None", availableFactors())
     if(length(af) > 0) {
-      selectInput('strataFactor', 'Strata factor', af )
+      selectInput(ns('strataFactor'), 'Strata factor', af )
+    } else {
+      selectInput(ns('strataFactor'), 'Strata factor', 
+                  c("Missing"))
     }
   })
 
 
   # physeqDataFactor ----
   physeqDataFactor <- reactive({
-     flog.info(glue("78: physeqDataFactor {input$mainFactor}"))
      req(input$mainFactor)
 
-     flog.info(glue("81: physeqDataFactor {input$mainFactor}"))
-     physeq <- physeqData()
+     #physeq <- physeqData()
 
-     flog.info(glue("84: physeqDataFactor {input$mainFactor}"))
+     sd <- globalData()[["sample"]]
+     q <- sd[ , input$mainFactor]
+
      # save main factor
-     sampleMainFactor(sample_data(physeq)[[input$mainFactor]])
-     flog.info(glue("87: physeqDataFactor {input$mainFactor}"))
+     sampleMainFactor(q)
+     #sampleMainFactor(sample_data(physeq)[[input$mainFactor]])
 
+     #soilrep
      physeq
   })
 
@@ -96,82 +104,42 @@ analysisPanel <- function(input, output, session, computed_details, sampleData,
     physeq <- physeqDataFactor()
     dist_matrices = distance(physeq, method=c(input$distanceMethod))
   })
-  observeEvent(input$clearTestsBtn, {
-     testsDT(NULL)
-  })
-
-  # ADD TEST BUTTON ----
-  observeEvent(input$addTestBtn, {
-     req(input$mainFactor)
-
-     flog.info("ADD TEST BUTTON")
-     aRow <- data_frame(test_id = numTests() + 1,
-                        strata_factor = input$strataFactor,
-                        main_factor = input$mainFactor,
-                        distance = input$distanceMethod,
-                        status = "not run")
-
-     newTable <- bind_rows(testsDT(), aRow)
-     testsDT(newTable)
-  })
-
-
-  # analysis tab ----
-  output$analysis <- renderUI({
-    flog.info("117: analysis render ui")
-    if(allDataAvailable()) {
-      ns <- session$ns
-      flog.info("120: analysis render ui: all data available")
-      div(data_controls_panel(), 
-        fluidRow(
-          box(title = "Ordination Plot", width = 6, plotOutput(ns("plot"))),
-          box(title = "Plot", width = 6, plotOutput(ns("newplot")))))
-    } else {
-      flog.info("analysis render ui: no data available")
-      div(h1("No data loaded."))
-    }
-  })
 
   # output$plot ----
   output$plot <- renderPlot({
-    flog.info(glue("analysis : plot {input$mainFactor}"))
-    flog.info(glue("analysis : plot {is.null(physeqDataFactor())}"))
     req(physeqDataFactor(), input$mainFactor)
-    flog.info("analysis : plot B")
+    withProgress(message = 'Creating ordination plot', value = 0, {
 
      physeq <- physeqDataFactor()
      dist_matrices = distance(physeq, method=c(input$distanceMethod))
 
-     #print(glue::glue("plot_ordination: {input$mainFactor} {input$distanceMethod}"))
 
-    flog.info("analysis : plot C")
      ordination_list = ordinate(physeq, method="MDS",
             distance = distanceMatrices())
 
      p <- plot_ordination(physeq = physeq,
          ordination = ordination_list,
          type = "samples",
          color = input$mainFactor ) +
-         theme_minimal()
+         ggplot2::theme_minimal()
 
     flog.info("analysis : plot D")
-     p <- p + scale_color_discrete(labels = paste(levels(sampleMainFactor()),
+     p <- p + ggplot2::scale_color_discrete(labels = paste(levels(sampleMainFactor()),
                                           table(sampleMainFactor())))
+                  })
 
      return(p)
   })
 
 
   # display new plot ----
   output$newplot <- renderPlot({
-     flog.info("analysis render ui new plot A checking requirements")
      req(physeqDataFactor(), input$mainFactor)
 
-     flog.info("analysis render ui new plot B requiements met")
+     withProgress(message = 'Creating plot', value = 0, {
      physeq <- physeqDataFactor()
      dist_matrices = distance(physeq, method=c(input$distanceMethod))
 
-     #print(glue::glue("newplot: {input$mainFactor} {input$strataFactor} {input$distanceMethod}"))
 
      phy <- physeq
      jsd.dist = dist_matrices
@@ -189,6 +157,8 @@ analysisPanel <- function(input, output, session, computed_details, sampleData,
      } else {
        ade4::s.class(jsd.pco$li, sample_data(phy)[[input$mainFactor]])
      }
+   })
+
   })
 
   outin <- reactiveValues(inputs = NULL)