diff --git a/server.R b/server.R
index 1ffc68e129b8b05d080d653930016dcda443034a..dd72eab327fd3d34db6308dc3dea109e01c467fd 100644
--- a/server.R
+++ b/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"),