Table with agglomerate taxe but not DataTable formatting

server.R

@@ -17,7 +17,7 @@ shinyServer
       return(x)
     }
   }
-
+  
   beautifulTable <- function(data)  {
     DT::datatable(
       data = data,
@@ -27,7 +27,7 @@ shinyServer
       options = list(
         dom = "lBtip",
         pageLength = 10,
-        lengthMenu = list(c(10, 25, 50, 100, -1), list('10', '25', '50', '100', 'All')),
+        lengthMenu = list(c(10, 25, 50, 100,-1), list('10', '25', '50', '100', 'All')),
         buttons = list(
           'colvis',
           list(
@@ -44,32 +44,31 @@ shinyServer
       height = "auto"
     )
   }
-
+  
   source({
     "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
   })
-
+  
   source("internals.R")
-
+  
   data16S <- reactive({
-
     ## BIOM input
     if (input$dataset == "input")
     {
       ## Unhappy path
       if (is.null(input$fileBiom))
         return()
-
+      
       ## Happy path
       ## Import biom
       d <- .import_biom(input)
-
+      
       ## Format tax table
       tax_table(d) <- .format_tax_table(tax_table(d))
-
+      
       ## import metadata and store it in phyloseq object
       sample_data(d) <- .import_sample_data(input, d)
-
+      
       ## Rarefy data
       if (input$rareData) {
         d <- rarefy_even_depth(
@@ -81,29 +80,30 @@ shinyServer
       }
       return(d)
     }
-
+    
     ## Rdata input
     if (input$dataset == "rdata")
     {
       ## .import_from_rdata(input) ## does not work as a function for some reason
-
+      
       ## Happy path
-      ne <- new.env() ## new env to store RData content and avoid border effects
+      ne <-
+        new.env() ## new env to store RData content and avoid border effects
       if (!is.null(input$fileRData))
         load(input$fileRData$datapath, envir = ne)
       if (class(ne$data) == "phyloseq")
         return(ne$data)
-
+      
       ## Unhappy paths: everything else
       return()
     }
-
+    
     ## Default case
     load("demo/demo.RData")
     return(get(input$dataset))
-
+    
   })
-
+  
   data <- reactiveValues()
   {
     observe({
@@ -111,7 +111,7 @@ shinyServer
         isolate(data <<- data16S())
     })
   }
-
+  
   output$downloadData <- {
     downloadHandler(
       filename = function() {
@@ -122,7 +122,7 @@ shinyServer
       }
     )
   }
-
+  
   output$downloadUI <- renderUI({
     validate(need(data16S(), ""))
     tags$div(
@@ -131,15 +131,15 @@ shinyServer
       downloadButton("downloadData", "Download", style = "color: black; background-color: gray90")
     )
   })
-
+  
   output$rarefactionMin <- renderText({
     validate(need(input$fileBiom, ""),
              need(input$dataset == "input", ""))
     paste("(min sample =", format(min(sample_sums(data16S(
-
+      
     ))), big.mark = " "), "reads)")
   })
-
+  
   output$phyloseqPrint <- renderPrint({
     validate(
       need(
@@ -149,7 +149,7 @@ shinyServer
     )
     data16S()
   })
-
+  
   output$summaryTable <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -169,11 +169,38 @@ shinyServer
                  #as.data.frame(sapply(sample_data(data16S()), class)),
                  beautifulTable(
                    data.frame(SAMPLE = sample_names(data16S()), sample_data(data16S()))
-                 ))
+                 )),
+        tabPanel(
+          "agglomerate_taxa",
+          radioButtons(
+            "glomRank",
+            label = "Taxonomic rank : ",
+            choices = rank_names(data16S()),
+            inline = TRUE
+          ),
+          dataTableOutput("tableGlom")
+        )
       )
     )
   })
-
+  
+  output$tableGlom <- renderDataTable({
+    Glom <- tax_glom(data16S(), input$glomRank)
+    taxTableGlom <- Glom %>%
+      tax_table() %>%
+      as.data.frame() %>%
+      dplyr::select(1:input$glomRank) %>%
+      tibble::rownames_to_column()
+    otuTableGlom <- Glom %>%
+      otu_table() %>%
+      as.data.frame() %>%
+      tibble::rownames_to_column()
+    joinGlom <-
+      dplyr::left_join(taxTableGlom, otuTableGlom, by = "rowname") %>%
+      dplyr::select(-rowname)
+    return(joinGlom)
+  })
+  
   output$histUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -202,7 +229,7 @@ shinyServer
       )
     )
   })
-
+  
   output$histo <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -218,7 +245,7 @@ shinyServer
     }
     return(p)
   })
-
+  
   output$histFocusUIfocusRank <- renderUI({
     validate(need(data16S(), ""))
     radioButtons(
@@ -228,19 +255,19 @@ shinyServer
       inline = TRUE
     )
   })
-
+  
   output$histFocusUIfocusTaxa <- renderUI({
     validate(need(data16S(), ""))
     selectInput(
       "focusTaxa",
       label = "Selected taxa : ",
       choices = unique(as.vector(tax_table(data16S(
-
+        
       ))[, input$focusRank])),
       selected = TRUE
     )
   })
-
+  
   output$histFocusUIfocusNbTaxa <- renderUI({
     validate(need(data16S(), ""))
     sliderInput(
@@ -285,7 +312,7 @@ shinyServer
     }
     return(p)
   })
-
+  
   output$clustUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -326,7 +353,7 @@ shinyServer
       )
     )
   })
-
+  
   output$clust <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -337,7 +364,7 @@ shinyServer
       color = checkNull(input$clustCol)
     )
   })
-
+  
   output$richnessAUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -398,7 +425,7 @@ shinyServer
       )
     )
   })
-
+  
   output$richnessA <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -420,7 +447,7 @@ shinyServer
     }
     return(p)
   })
-
+  
   output$richnessATable <- renderUI({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -428,7 +455,7 @@ shinyServer
       SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
     )))
   })
-
+  
   output$richnessBUI <- renderUI({
     box(
       title = "Setting : " ,
@@ -444,7 +471,7 @@ shinyServer
                 value = "Beta diversity heatmap")
     )
   })
-
+  
   output$richnessB <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -477,7 +504,7 @@ shinyServer
     )
     return(p + scale_fill_gradient2())
   })
-
+  
   output$networkBUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -518,7 +545,7 @@ shinyServer
       )
     )
   })
-
+  
   output$networkB <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -539,7 +566,7 @@ shinyServer
     )
     return(p)
   })
-
+  
   output$richnessBTable <- renderUI({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -549,7 +576,7 @@ shinyServer
       ), digits = 2)
     )))
   })
-
+  
   output$rarefactionCurve <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -564,16 +591,16 @@ shinyServer
     if (!is.null(checkNull(input$rarefactionGrid))) {
       p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
     }
-
+    
     if (input$rarefactionMin) {
       p <-
         p + geom_vline(xintercept = min(sample_sums(data16S())),
                        color = "gray60")
     }
     return(p + ggtitle(input$rarefactionTitle))
-
+    
   })
-
+  
   output$rarefactionCurveUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -608,7 +635,7 @@ shinyServer
       )
     )
   })
-
+  
   output$HeatmapUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -667,7 +694,7 @@ shinyServer
       )
     )
   })
-
+  
   output$Heatmap <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -689,7 +716,7 @@ shinyServer
     }
     return(p)
   })
-
+  
   output$treeUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -728,7 +755,7 @@ shinyServer
       )
     )
   })
-
+  
   output$tree <- renderPlot({
     validate(
       need(data16S(), "Requires an abundance dataset"),
@@ -757,7 +784,7 @@ shinyServer
       return(p)
     }
   })
-
+  
   output$acpUI <- renderUI({
     validate(need(data16S(), ""))
     box(
@@ -821,7 +848,7 @@ shinyServer
       )
     )
   })
-
+  
   output$acp <- renderPlot({
     validate(
       need(data16S(), "Requires an abundance dataset"),