diff --git a/server.R b/server.R
index b60be192a2760f932269f90ad42fa80e243f3be9..a53d65fb4c942f5019d44fda1799acb2d772e958 100644
--- a/server.R
+++ b/server.R
@@ -1,876 +1,879 @@
-library(shinydashboard)
-
-shinyServer
-(function(input, output, session)
-{
- checkNull <- function(x) {
- if (!exists(as.character(substitute(x)))) {
- return(NULL)
- } else if (is.null(x)) {
- return(NULL)
- } else if (length(x) > 1) {
- return(x)
- }
- else if (x %in% c(0, "", NA, "NULL")) {
- return(NULL)
- } else {
- return(x)
- }
- }
-
- beautifulTable <- function(data) {
- DT::datatable(
- data = data,
- rownames = FALSE,
- filter = "top",
- extensions = c("Buttons", "ColReorder", "FixedColumns"),
- options = list(
- dom = "lBtip",
- pageLength = 10,
- lengthMenu = list(c(10, 25, 50, 100, -1), list('10', '25', '50', '100', 'All')),
- buttons = list(
- 'colvis',
- list(
- extend = 'collection',
- buttons = c('copy', 'csv', 'excel', 'pdf'),
- text = 'Download'
- )
- ),
- colReorder = TRUE,
- scrollX = TRUE,
- fixedColumns = list(leftColumns = 1, rightColumns = 0)
- ),
- width = "auto",
- height = "auto"
- )
- }
-
- source({
- "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
- })
-
- data16S <- reactive({
- if (input$dataset == "input")
- {
- if (is.null(input$fileBiom))
- {
- return()
- }
- if (input$biomFormat == "std")
- {
- d <- import_biom(
- BIOMfilename = input$fileBiom$datapath,
- treefilename = input$fileTree$datapath# ,
- # refseqfilename = input$fileSeq$datapath
- )
- } else if (input$biomFormat == "frogs") {
- d <- import_frogs(
- biom = input$fileBiom$datapath,
- treefilename = input$fileTree$datapath# ,
- # refseqfilename = input$fileSeq$datapath
- )
- }
-
- colnames(tax_table(d)) <-
- c("Kingdom",
- "Phylum",
- "Class",
- "Order",
- "Family",
- "Genus",
- "Species",
- "Strain")[1:length(rank_names(d))]
- tax_table(d)[grep("unknown ", tax_table(d))] <- NA
- #tax_table(d)[grep("Unclassified", tax_table(d))] <- NA
- if (!is.null(input$fileMeta)) {
- if (input$CSVsep == "excel") {
- sample_data(d) <-
- RcmdrMisc::readXL(input$fileMeta$datapath,
- rownames = TRUE,
- header = TRUE)
- } else {
- sample_data(d) <- read.csv(
- input$fileMeta$datapath,
- header = TRUE,
- sep = input$CSVsep,
- row.names = 1,
- na.strings = NA
- )
- sample_data(d)$SampleID <- rownames(sample_data(d))
- }
- } else {
- n <- data.frame(sample_names(d) , row.names = sample_names(d))
- names(n) <- "SampleID"
- sample_data(d) <- n
- }
- if (input$rareData) {
- d <- rarefy_even_depth(
- d,
- replace = FALSE,
- rngseed = as.integer(Sys.time()),
- verbose = FALSE
- )
- }
- return(d)
- } else if (input$dataset == "rdata")
- {
- if (is.null(input$fileRData))
- {
- return()
- }
- load(input$fileRData$datapath)
- if (exists("data"))
- {
- return(data)
- } else {
- return()
- }
- } else {
- load("demo/demo.RData")
- return(get(input$dataset))
- }
- })
-
- data <- reactiveValues()
- {
- observe({
- if (!is.null(data16S()))
- isolate(data <<- data16S())
- })
- }
-
- output$downloadData <- {
- downloadHandler(
- filename = function() {
- paste("Easy16S-data", Sys.Date(), "RData", sep = ".")
- },
- content = function(file) {
- save(data, file = file)
- }
- )
- }
-
- output$downloadUI <- renderUI({
- validate(need(data16S(), ""))
- tags$div(
- style = "text-align:center",
- title = "Download as RData",
- 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(
- data16S(),
- "Firstly, you should select a demo dataset or upload an abundance BIOM file.\nFor example, with Galaxy, a BIOM file can be obtained at the end of FROGS workflow with the 'FROGS BIOM to std BIOM' tool"
- )
- )
- data16S()
- })
-
- output$summaryTable <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Tables",
- width = NULL,
- status = "primary",
- tabsetPanel(
- tabPanel("otu_table",
- beautifulTable(
- data.frame(OTU = taxa_names(data16S()), otu_table(data16S()))
- )),
- tabPanel("tax_table",
- beautifulTable(
- data.frame(OTU = taxa_names(data16S()), tax_table(data16S()))
- )),
- tabPanel("sample_data",
- #as.data.frame(sapply(sample_data(data16S()), class)),
- beautifulTable(
- data.frame(SAMPLE = sample_names(data16S()), sample_data(data16S()))
- ))
- )
- )
- })
-
- output$histUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : ",
- width = NULL,
- status = "primary",
- radioButtons(
- "barFill",
- label = "Taxonomic rank : ",
- choices = rank_names(data16S()),
- inline = TRUE
- ),
- textInput("barTitle",
- label = "Title : ",
- value = "OTU abundance barplot"),
- selectInput(
- "barGrid",
- label = "Subplot : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- ,
- selectInput(
- "barX",
- label = "X : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- )
- })
-
- output$histo <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p <- plot_bar(
- physeq = data16S(),
- fill = input$barFill,
- x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX),
- title = checkNull(input$barTitle)
- )
- if (!is.null(checkNull(input$barGrid))) {
- p <-
- p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
- }
- return(p)
- })
-
- output$histFocusUIfocusRank <- renderUI({
- validate(need(data16S(), ""))
- radioButtons(
- "focusRank",
- label = "Taxonomic rank : ",
- choices = rank_names(data16S())[-length(rank_names(data16S()))],
- 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(
- "focusNbTaxa",
- label = "Number of sub-taxa : ",
- min = 0,
- #max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
- max = 30,
- value = 10
- )
- })
-
- output$histFocusUIfocusGrid <- renderUI({
- validate(need(data16S(), ""))
- selectInput("focusGrid",
- label = "Subplot : ",
- choices = c("..." = 0, sample_variables(data16S())))
- })
-
- output$histFocusUIfocusX <- renderUI({
- validate(need(data16S(), ""))
- selectInput("focusX",
- label = "X : ",
- choices = c("..." = 0, sample_variables(data16S())))
- })
-
- output$histoFocus <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p <- plot_composition(
- physeq = data16S(),
- taxaRank1 = input$focusRank,
- taxaSet1 = input$focusTaxa,
- taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
- numberOfTaxa = input$focusNbTaxa,
- fill = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
- x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
- )
- if (!is.null(checkNull(input$focusGrid))) {
- p <-
- p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
- }
- return(p)
- })
-
- output$clustUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- selectInput(
- "clustDist",
- label = "Distance : ",
- choices = list(
- "bray",
- "jaccard",
- "unifrac",
- "wunifrac",
- "dpcoa",
- "jsd",
- "euclidean"
- )
- ),
- selectInput(
- "clustMethod",
- label = "Method : ",
- choices = list(
- "ward.D2",
- "ward.D",
- "single",
- "complete",
- "average",
- "mcquitty",
- "median",
- "centroid"
- )
- ),
- selectInput(
- "clustCol",
- label = "Color : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- )
- })
-
- output$clust <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- plot_clust(
- physeq = data16S(),
- dist = input$clustDist,
- method = input$clustMethod,
- color = checkNull(input$clustCol)
- )
- })
-
- output$richnessAUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- checkboxGroupInput(
- "richnessMeasures",
- label = "Measures : ",
- choices = c(
- "Observed",
- "Chao1",
- "ACE",
- "Shannon",
- "Simpson",
- "InvSimpson",
- "Fisher"
- ),
- selected = c(
- "Observed",
- "Chao1",
- "ACE",
- "Shannon",
- "Simpson",
- "InvSimpson",
- "Fisher"
- ),
- inline = TRUE
- ),
- radioButtons(
- "richnessBoxplot",
- label = "Representation : ",
- choices = list(
- "Dots only" = 1,
- "Dots and boxplot" = 2,
- "Boxplot only" = 3
- ),
- selected = 2,
- inline = TRUE
- ),
- textInput("richnessTitle",
- label = "Title : ",
- value = "Alpha diversity graphics"),
- selectInput(
- "richnessX",
- label = "X : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "richnessColor",
- label = "Color : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "richnessShape",
- label = "Shape : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- )
- })
-
- output$richnessA <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p <- plot_richness(
- physeq = data16S(),
- x = ifelse(is.null(checkNull(
- input$richnessX
- )), "samples", input$richnessX),
- color = checkNull(input$richnessColor),
- shape = checkNull(input$richnessShape),
- title = checkNull(input$richnessTitle),
- measures = checkNull(input$richnessMeasures)
- )
- if (input$richnessBoxplot >= 2) {
- p <- p + geom_boxplot()
- }
- if (input$richnessBoxplot <= 2) {
- p <- p + geom_point()
- }
- return(p)
- })
-
- output$richnessATable <- renderUI({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p(beautifulTable(data.frame(
- SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
- )))
- })
-
- output$richnessBUI <- renderUI({
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- selectInput(
- "richnessBOrder",
- label = "Sorting sample : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- textInput("richnessBTitle",
- label = "Title : ",
- value = "Beta diversity heatmap")
- )
- })
-
- output$richnessB <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- beta <-
- melt(as(distance(data16S(), method = input$richnessBDist), "matrix"))
- colnames(beta) <- c("x", "y", "distance")
- if (!is.null(checkNull(input$richnessBOrder)))
- {
- new_factor = as.factor(get_variable(data16S(), input$richnessBOrder))
- variable_sort <-
- as.factor(get_variable(data16S(), input$richnessBOrder)[order(new_factor)])
- L = levels(reorder(sample_names(data16S()), as.numeric(new_factor)))
- beta$x <- factor(beta$x, levels = L)
- beta$y <- factor(beta$y, levels = L)
- palette <- hue_pal()(length(levels(new_factor)))
- tipColor <-
- col_factor(palette, levels = levels(new_factor))(variable_sort)
- }
- p <-
- ggplot(beta, aes(x = x, y = y, fill = distance)) + geom_tile()
- p <- p + ggtitle(input$richnessBTitle) + theme(
- axis.text.x = element_text(
- angle = 90,
- hjust = 1,
- color = checkNull(tipColor)
- ),
- axis.text.y = element_text(color = checkNull(tipColor)),
- axis.title.x = element_blank(),
- axis.title.y = element_blank()
- )
- return(p + scale_fill_gradient2())
- })
-
- output$networkBUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- sliderInput(
- "netwMax",
- label = "Threshold : ",
- min = 0,
- max = 1,
- value = 0.7
- ),
- checkboxInput("netwOrphan",
- label = "Keep orphans",
- value = TRUE),
- textInput("netwTitle",
- label = "Title : ",
- value = "Beta diversity network"),
- selectInput(
- "netwCol",
- label = "Color : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "netwShape",
- label = "Shape : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "netwLabel",
- label = "Label : ",
- choices = c(
- "..." = 0,
- "Sample name" = "value",
- sample_variables(data16S())
- )
- )
- )
- })
-
- output$networkB <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- g <- make_network(
- data16S(),
- distance = input$richnessBDist,
- max.dist = input$netwMax,
- keep.isolates = input$netwOrphan
- )
- p <- plot_network(
- g,
- physeq = data16S(),
- color = checkNull(input$netwCol),
- shape = checkNull(input$netwShape),
- label = checkNull(input$netwLabel),
- hjust = 2,
- title = checkNull(input$netwTitle)
- )
- return(p)
- })
-
- output$richnessBTable <- renderUI({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p(beautifulTable(data.frame(
- SAMPLE = sample_names(data16S()), round(as.matrix(
- distance(data16S(), method = input$richnessBDist)
- ), digits = 2)
- )))
- })
-
- output$rarefactionCurve <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p <- ggrare(
- physeq = data16S(),
- step = 100,
- #step = input$rarefactionStep,
- color = checkNull(input$rarefactionColor),
- label = checkNull(input$rarefactionLabel),
- se = FALSE
- )
- 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(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- # sliderInput(
- # "rarefactionStep",
- # label = "Etapes de calcul : ",
- # min = 1,
- # max = 1000,
- # value = 100
- # ),
- checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE),
- textInput("rarefactionTitle",
- label = "Title : ",
- value = "Rarefaction curves"),
- selectInput(
- "rarefactionColor",
- label = "Color : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "rarefactionLabel",
- label = "Label : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "rarefactionGrid",
- label = "Subplot : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- )
- })
-
- output$HeatmapUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- textInput("heatmapTitle",
- label = "Title : ",
- value = "Taxa heatmap by samples"),
- selectInput(
- "heatmapGrid",
- label = "Subplot : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "heatmapX",
- label = "X : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- sliderInput(
- "heatmapTopOtu",
- label = "Show the n most abundant OTU : ",
- min = 1,
- max = ntaxa(data16S()),
- value = 250
- ),
- selectInput(
- "heatmapDist",
- label = "Distance : ",
- selected = "bray",
- choices = list(
- "bray",
- "jaccard",
- "unifrac",
- "wunifrac",
- "dpcoa",
- "jsd",
- "euclidean"
- )
- ),
- selectInput(
- "heatmapMethod",
- label = "Method : ",
- selected = "NMDS",
- choices = list(
- "NMDS",
- "ward.D2",
- "ward.D",
- "single",
- "complete",
- "average",
- "mcquitty",
- "median",
- "centroid"
- )
- )
- )
- })
-
- output$Heatmap <- renderPlot({
- validate(need(data16S(),
- "Requires an abundance dataset"))
- p <- plot_heatmap(
- physeq = prune_taxa(names(sort(
- taxa_sums(data16S()), decreasing = TRUE
- )[1:input$heatmapTopOtu]), data16S()),
- distance = input$heatmapDist,
- method = input$heatmapMethod,
- title = checkNull(input$heatmapTitle),
- sample.order = checkNull(input$heatmapX),
- low = "yellow",
- high = "red",
- na.value = "white"
- )
- if (!is.null(checkNull(input$heatmapGrid))) {
- p <-
- p + facet_grid(paste(".", "~", input$heatmapGrid), scales = "free_x")
- }
- return(p)
- })
-
- output$treeUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- radioButtons(
- "treeRank",
- label = "Taxonomic rank captioned : ",
- choices = c(aucun = "",
- rank_names(data16S()),
- OTU = "taxa_names"),
- inline = TRUE
- ),
- sliderInput(
- "treeTopOtu",
- label = "Show the n most abundant OTU : ",
- min = 1,
- max = ntaxa(data16S()),
- value = 20
- ),
- checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
- checkboxInput("treeSample", label = "Show samples", value = TRUE),
- textInput("treeTitle",
- label = "Title : ",
- value = "Phylogenetic tree"),
- selectInput(
- "treeCol",
- label = "Color : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "treeShape",
- label = "Shape : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- )
- })
-
- output$tree <- renderPlot({
- validate(
- need(data16S(), "Requires an abundance dataset"),
- need(
- phy_tree(data16S(), errorIfNULL = FALSE),
- "Requires a phylogenetic tree"
- )
- )
- p <- plot_tree(
- physeq = prune_taxa(names(sort(
- taxa_sums(data16S()), decreasing = TRUE
- )[1:input$treeTopOtu]), data16S()),
- method = ifelse(input$treeSample, "sampledodge", "treeonly"),
- color = checkNull(input$treeCol),
- shape = checkNull(input$treeShape),
- size = "abundance",
- label.tips = checkNull(input$treeRank),
- sizebase = 5,
- ladderize = "left",
- plot.margin = 0,
- title = checkNull(input$treeTitle)
- )
- if (checkNull(input$treeRadial)) {
- return(p + coord_polar(theta = "y"))
- } else {
- return(p)
- }
- })
-
- output$acpUI <- renderUI({
- validate(need(data16S(), ""))
- box(
- title = "Setting : " ,
- width = NULL,
- status = "primary",
- checkboxGroupInput(
- "acpAxes",
- label = "Axes : ",
- choices = seq(10),
- selected = c(1, 2),
- inline = TRUE
- ),
- selectInput(
- "acpDist",
- label = "Distance : ",
- selected = "bray",
- choices = list(
- "bray",
- "jaccard",
- "unifrac",
- "wunifrac",
- "dpcoa",
- "jsd",
- "euclidean"
- )
- ),
- selectInput(
- "acpMethod",
- label = "Method : ",
- selected = "MDS",
- choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
- ),
- textInput("acpTitle",
- label = "Title : ",
- value = "Samples ordination graphic"),
- selectInput(
- "acpLabel",
- label = "Label : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "acpCol",
- label = "Color : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "acpShape",
- label = "Shape : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "acpEllipse",
- label = "Ellipses : ",
- choices = c("..." = 0, sample_variables(data16S()))
- ),
- selectInput(
- "acpRep",
- label = "Barycenters : ",
- choices = c("..." = 0, sample_variables(data16S()))
- )
- )
- })
-
- output$acp <- renderPlot({
- validate(
- need(data16S(), "Requires an abundance dataset"),
- need(length(input$acpAxes) == 2, "Requires two projections axes")
- )
- p <- plot_samples(
- data16S(),
- ordination = ordinate(
- data16S(),
- method = input$acpMethod,
- distance = input$acpDist
- ),
- axes = as.numeric(input$acpAxes),
- title = checkNull(input$acpTitle),
- color = checkNull(input$acpCol),
- replicate = checkNull(input$acpRep),
- shape = checkNull(input$acpShape),
- label = checkNull(input$acpLabel)
- )
- if (!is.null(checkNull(input$acpEllipse))) {
- p <- p + stat_ellipse(aes_string(group = input$acpEllipse))
- }
- return(p + theme_bw())
- })
+library(shinydashboard)
+
+shinyServer
+(function(input, output, session)
+{
+ checkNull <- function(x) {
+ if (!exists(as.character(substitute(x)))) {
+ return(NULL)
+ } else if (is.null(x)) {
+ return(NULL)
+ } else if (length(x) > 1) {
+ return(x)
+ }
+ else if (x %in% c(0, "", NA, "NULL")) {
+ return(NULL)
+ } else {
+ return(x)
+ }
+ }
+
+ beautifulTable <- function(data) {
+ DT::datatable(
+ data = data,
+ rownames = FALSE,
+ filter = "top",
+ extensions = c("Buttons", "ColReorder", "FixedColumns"),
+ options = list(
+ dom = "lBtip",
+ pageLength = 10,
+ lengthMenu = list(c(10, 25, 50, 100, -1), list('10', '25', '50', '100', 'All')),
+ buttons = list(
+ 'colvis',
+ list(
+ extend = 'collection',
+ buttons = c('copy', 'csv', 'excel', 'pdf'),
+ text = 'Download'
+ )
+ ),
+ colReorder = TRUE,
+ scrollX = TRUE,
+ fixedColumns = list(leftColumns = 1, rightColumns = 0)
+ ),
+ width = "auto",
+ height = "auto"
+ )
+ }
+
+ source({
+ "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
+ })
+
+ data16S <- reactive({
+ if (input$dataset == "input")
+ {
+ if (is.null(input$fileBiom))
+ {
+ return()
+ }
+ if (input$biomFormat == "std")
+ {
+ d <- import_biom(
+ BIOMfilename = input$fileBiom$datapath,
+ treefilename = input$fileTree$datapath# ,
+ # refseqfilename = input$fileSeq$datapath
+ )
+ } else if (input$biomFormat == "frogs") {
+ d <- import_frogs(
+ biom = input$fileBiom$datapath,
+ treefilename = input$fileTree$datapath# ,
+ # refseqfilename = input$fileSeq$datapath
+ )
+ }
+
+ colnames(tax_table(d)) <-
+ c("Kingdom",
+ "Phylum",
+ "Class",
+ "Order",
+ "Family",
+ "Genus",
+ "Species",
+ "Strain")[1:length(rank_names(d))]
+ tax_table(d)[grep("unknown ", tax_table(d))] <- NA
+ #tax_table(d)[grep("Unclassified", tax_table(d))] <- NA
+ if (!is.null(input$fileMeta)) {
+ if (input$CSVsep == "excel") {
+ sample_data(d) <-
+ RcmdrMisc::readXL(input$fileMeta$datapath,
+ rownames = TRUE,
+ header = TRUE)
+ } else {
+ sample_data(d) <- read.csv(
+ input$fileMeta$datapath,
+ header = TRUE,
+ sep = input$CSVsep,
+ row.names = 1,
+ na.strings = NA
+ )
+ sample_data(d)$SampleID <- rownames(sample_data(d))
+ }
+ } else {
+ n <- data.frame(sample_names(d) , row.names = sample_names(d))
+ names(n) <- "SampleID"
+ sample_data(d) <- n
+ }
+ if (input$rareData) {
+ d <- rarefy_even_depth(
+ d,
+ replace = FALSE,
+ rngseed = as.integer(Sys.time()),
+ verbose = FALSE
+ )
+ }
+ return(d)
+ }
+
+ if (input$dataset == "rdata")
+ {
+ if (is.null(input$fileRData))
+ {
+ return()
+ }
+ load(input$fileRData$datapath)
+ if (exists("data"))
+ {
+ return(data)
+ } else {
+ return()
+ }
+ }
+
+ load("demo/demo.RData")
+ return(get(input$dataset))
+
+ })
+
+ data <- reactiveValues()
+ {
+ observe({
+ if (!is.null(data16S()))
+ isolate(data <<- data16S())
+ })
+ }
+
+ output$downloadData <- {
+ downloadHandler(
+ filename = function() {
+ paste("Easy16S-data", Sys.Date(), "RData", sep = ".")
+ },
+ content = function(file) {
+ save(data, file = file)
+ }
+ )
+ }
+
+ output$downloadUI <- renderUI({
+ validate(need(data16S(), ""))
+ tags$div(
+ style = "text-align:center",
+ title = "Download as RData",
+ 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(
+ data16S(),
+ "Firstly, you should select a demo dataset or upload an abundance BIOM file.\nFor example, with Galaxy, a BIOM file can be obtained at the end of FROGS workflow with the 'FROGS BIOM to std BIOM' tool"
+ )
+ )
+ data16S()
+ })
+
+ output$summaryTable <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Tables",
+ width = NULL,
+ status = "primary",
+ tabsetPanel(
+ tabPanel("otu_table",
+ beautifulTable(
+ data.frame(OTU = taxa_names(data16S()), otu_table(data16S()))
+ )),
+ tabPanel("tax_table",
+ beautifulTable(
+ data.frame(OTU = taxa_names(data16S()), tax_table(data16S()))
+ )),
+ tabPanel("sample_data",
+ #as.data.frame(sapply(sample_data(data16S()), class)),
+ beautifulTable(
+ data.frame(SAMPLE = sample_names(data16S()), sample_data(data16S()))
+ ))
+ )
+ )
+ })
+
+ output$histUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : ",
+ width = NULL,
+ status = "primary",
+ radioButtons(
+ "barFill",
+ label = "Taxonomic rank : ",
+ choices = rank_names(data16S()),
+ inline = TRUE
+ ),
+ textInput("barTitle",
+ label = "Title : ",
+ value = "OTU abundance barplot"),
+ selectInput(
+ "barGrid",
+ label = "Subplot : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ ,
+ selectInput(
+ "barX",
+ label = "X : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ )
+ })
+
+ output$histo <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p <- plot_bar(
+ physeq = data16S(),
+ fill = input$barFill,
+ x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX),
+ title = checkNull(input$barTitle)
+ )
+ if (!is.null(checkNull(input$barGrid))) {
+ p <-
+ p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
+ }
+ return(p)
+ })
+
+ output$histFocusUIfocusRank <- renderUI({
+ validate(need(data16S(), ""))
+ radioButtons(
+ "focusRank",
+ label = "Taxonomic rank : ",
+ choices = rank_names(data16S())[-length(rank_names(data16S()))],
+ 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(
+ "focusNbTaxa",
+ label = "Number of sub-taxa : ",
+ min = 0,
+ #max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
+ max = 30,
+ value = 10
+ )
+ })
+
+ output$histFocusUIfocusGrid <- renderUI({
+ validate(need(data16S(), ""))
+ selectInput("focusGrid",
+ label = "Subplot : ",
+ choices = c("..." = 0, sample_variables(data16S())))
+ })
+
+ output$histFocusUIfocusX <- renderUI({
+ validate(need(data16S(), ""))
+ selectInput("focusX",
+ label = "X : ",
+ choices = c("..." = 0, sample_variables(data16S())))
+ })
+
+ output$histoFocus <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p <- plot_composition(
+ physeq = data16S(),
+ taxaRank1 = input$focusRank,
+ taxaSet1 = input$focusTaxa,
+ taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
+ numberOfTaxa = input$focusNbTaxa,
+ fill = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
+ x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
+ )
+ if (!is.null(checkNull(input$focusGrid))) {
+ p <-
+ p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
+ }
+ return(p)
+ })
+
+ output$clustUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ selectInput(
+ "clustDist",
+ label = "Distance : ",
+ choices = list(
+ "bray",
+ "jaccard",
+ "unifrac",
+ "wunifrac",
+ "dpcoa",
+ "jsd",
+ "euclidean"
+ )
+ ),
+ selectInput(
+ "clustMethod",
+ label = "Method : ",
+ choices = list(
+ "ward.D2",
+ "ward.D",
+ "single",
+ "complete",
+ "average",
+ "mcquitty",
+ "median",
+ "centroid"
+ )
+ ),
+ selectInput(
+ "clustCol",
+ label = "Color : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ )
+ })
+
+ output$clust <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ plot_clust(
+ physeq = data16S(),
+ dist = input$clustDist,
+ method = input$clustMethod,
+ color = checkNull(input$clustCol)
+ )
+ })
+
+ output$richnessAUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ checkboxGroupInput(
+ "richnessMeasures",
+ label = "Measures : ",
+ choices = c(
+ "Observed",
+ "Chao1",
+ "ACE",
+ "Shannon",
+ "Simpson",
+ "InvSimpson",
+ "Fisher"
+ ),
+ selected = c(
+ "Observed",
+ "Chao1",
+ "ACE",
+ "Shannon",
+ "Simpson",
+ "InvSimpson",
+ "Fisher"
+ ),
+ inline = TRUE
+ ),
+ radioButtons(
+ "richnessBoxplot",
+ label = "Representation : ",
+ choices = list(
+ "Dots only" = 1,
+ "Dots and boxplot" = 2,
+ "Boxplot only" = 3
+ ),
+ selected = 2,
+ inline = TRUE
+ ),
+ textInput("richnessTitle",
+ label = "Title : ",
+ value = "Alpha diversity graphics"),
+ selectInput(
+ "richnessX",
+ label = "X : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "richnessColor",
+ label = "Color : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "richnessShape",
+ label = "Shape : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ )
+ })
+
+ output$richnessA <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p <- plot_richness(
+ physeq = data16S(),
+ x = ifelse(is.null(checkNull(
+ input$richnessX
+ )), "samples", input$richnessX),
+ color = checkNull(input$richnessColor),
+ shape = checkNull(input$richnessShape),
+ title = checkNull(input$richnessTitle),
+ measures = checkNull(input$richnessMeasures)
+ )
+ if (input$richnessBoxplot >= 2) {
+ p <- p + geom_boxplot()
+ }
+ if (input$richnessBoxplot <= 2) {
+ p <- p + geom_point()
+ }
+ return(p)
+ })
+
+ output$richnessATable <- renderUI({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p(beautifulTable(data.frame(
+ SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
+ )))
+ })
+
+ output$richnessBUI <- renderUI({
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ selectInput(
+ "richnessBOrder",
+ label = "Sorting sample : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ textInput("richnessBTitle",
+ label = "Title : ",
+ value = "Beta diversity heatmap")
+ )
+ })
+
+ output$richnessB <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ beta <-
+ melt(as(distance(data16S(), method = input$richnessBDist), "matrix"))
+ colnames(beta) <- c("x", "y", "distance")
+ if (!is.null(checkNull(input$richnessBOrder)))
+ {
+ new_factor = as.factor(get_variable(data16S(), input$richnessBOrder))
+ variable_sort <-
+ as.factor(get_variable(data16S(), input$richnessBOrder)[order(new_factor)])
+ L = levels(reorder(sample_names(data16S()), as.numeric(new_factor)))
+ beta$x <- factor(beta$x, levels = L)
+ beta$y <- factor(beta$y, levels = L)
+ palette <- hue_pal()(length(levels(new_factor)))
+ tipColor <-
+ col_factor(palette, levels = levels(new_factor))(variable_sort)
+ }
+ p <-
+ ggplot(beta, aes(x = x, y = y, fill = distance)) + geom_tile()
+ p <- p + ggtitle(input$richnessBTitle) + theme(
+ axis.text.x = element_text(
+ angle = 90,
+ hjust = 1,
+ color = checkNull(tipColor)
+ ),
+ axis.text.y = element_text(color = checkNull(tipColor)),
+ axis.title.x = element_blank(),
+ axis.title.y = element_blank()
+ )
+ return(p + scale_fill_gradient2())
+ })
+
+ output$networkBUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ sliderInput(
+ "netwMax",
+ label = "Threshold : ",
+ min = 0,
+ max = 1,
+ value = 0.7
+ ),
+ checkboxInput("netwOrphan",
+ label = "Keep orphans",
+ value = TRUE),
+ textInput("netwTitle",
+ label = "Title : ",
+ value = "Beta diversity network"),
+ selectInput(
+ "netwCol",
+ label = "Color : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "netwShape",
+ label = "Shape : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "netwLabel",
+ label = "Label : ",
+ choices = c(
+ "..." = 0,
+ "Sample name" = "value",
+ sample_variables(data16S())
+ )
+ )
+ )
+ })
+
+ output$networkB <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ g <- make_network(
+ data16S(),
+ distance = input$richnessBDist,
+ max.dist = input$netwMax,
+ keep.isolates = input$netwOrphan
+ )
+ p <- plot_network(
+ g,
+ physeq = data16S(),
+ color = checkNull(input$netwCol),
+ shape = checkNull(input$netwShape),
+ label = checkNull(input$netwLabel),
+ hjust = 2,
+ title = checkNull(input$netwTitle)
+ )
+ return(p)
+ })
+
+ output$richnessBTable <- renderUI({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p(beautifulTable(data.frame(
+ SAMPLE = sample_names(data16S()), round(as.matrix(
+ distance(data16S(), method = input$richnessBDist)
+ ), digits = 2)
+ )))
+ })
+
+ output$rarefactionCurve <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p <- ggrare(
+ physeq = data16S(),
+ step = 100,
+ #step = input$rarefactionStep,
+ color = checkNull(input$rarefactionColor),
+ label = checkNull(input$rarefactionLabel),
+ se = FALSE
+ )
+ 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(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ # sliderInput(
+ # "rarefactionStep",
+ # label = "Etapes de calcul : ",
+ # min = 1,
+ # max = 1000,
+ # value = 100
+ # ),
+ checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE),
+ textInput("rarefactionTitle",
+ label = "Title : ",
+ value = "Rarefaction curves"),
+ selectInput(
+ "rarefactionColor",
+ label = "Color : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "rarefactionLabel",
+ label = "Label : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "rarefactionGrid",
+ label = "Subplot : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ )
+ })
+
+ output$HeatmapUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ textInput("heatmapTitle",
+ label = "Title : ",
+ value = "Taxa heatmap by samples"),
+ selectInput(
+ "heatmapGrid",
+ label = "Subplot : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "heatmapX",
+ label = "X : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ sliderInput(
+ "heatmapTopOtu",
+ label = "Show the n most abundant OTU : ",
+ min = 1,
+ max = ntaxa(data16S()),
+ value = 250
+ ),
+ selectInput(
+ "heatmapDist",
+ label = "Distance : ",
+ selected = "bray",
+ choices = list(
+ "bray",
+ "jaccard",
+ "unifrac",
+ "wunifrac",
+ "dpcoa",
+ "jsd",
+ "euclidean"
+ )
+ ),
+ selectInput(
+ "heatmapMethod",
+ label = "Method : ",
+ selected = "NMDS",
+ choices = list(
+ "NMDS",
+ "ward.D2",
+ "ward.D",
+ "single",
+ "complete",
+ "average",
+ "mcquitty",
+ "median",
+ "centroid"
+ )
+ )
+ )
+ })
+
+ output$Heatmap <- renderPlot({
+ validate(need(data16S(),
+ "Requires an abundance dataset"))
+ p <- plot_heatmap(
+ physeq = prune_taxa(names(sort(
+ taxa_sums(data16S()), decreasing = TRUE
+ )[1:input$heatmapTopOtu]), data16S()),
+ distance = input$heatmapDist,
+ method = input$heatmapMethod,
+ title = checkNull(input$heatmapTitle),
+ sample.order = checkNull(input$heatmapX),
+ low = "yellow",
+ high = "red",
+ na.value = "white"
+ )
+ if (!is.null(checkNull(input$heatmapGrid))) {
+ p <-
+ p + facet_grid(paste(".", "~", input$heatmapGrid), scales = "free_x")
+ }
+ return(p)
+ })
+
+ output$treeUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ radioButtons(
+ "treeRank",
+ label = "Taxonomic rank captioned : ",
+ choices = c(aucun = "",
+ rank_names(data16S()),
+ OTU = "taxa_names"),
+ inline = TRUE
+ ),
+ sliderInput(
+ "treeTopOtu",
+ label = "Show the n most abundant OTU : ",
+ min = 1,
+ max = ntaxa(data16S()),
+ value = 20
+ ),
+ checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
+ checkboxInput("treeSample", label = "Show samples", value = TRUE),
+ textInput("treeTitle",
+ label = "Title : ",
+ value = "Phylogenetic tree"),
+ selectInput(
+ "treeCol",
+ label = "Color : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "treeShape",
+ label = "Shape : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ )
+ })
+
+ output$tree <- renderPlot({
+ validate(
+ need(data16S(), "Requires an abundance dataset"),
+ need(
+ phy_tree(data16S(), errorIfNULL = FALSE),
+ "Requires a phylogenetic tree"
+ )
+ )
+ p <- plot_tree(
+ physeq = prune_taxa(names(sort(
+ taxa_sums(data16S()), decreasing = TRUE
+ )[1:input$treeTopOtu]), data16S()),
+ method = ifelse(input$treeSample, "sampledodge", "treeonly"),
+ color = checkNull(input$treeCol),
+ shape = checkNull(input$treeShape),
+ size = "abundance",
+ label.tips = checkNull(input$treeRank),
+ sizebase = 5,
+ ladderize = "left",
+ plot.margin = 0,
+ title = checkNull(input$treeTitle)
+ )
+ if (checkNull(input$treeRadial)) {
+ return(p + coord_polar(theta = "y"))
+ } else {
+ return(p)
+ }
+ })
+
+ output$acpUI <- renderUI({
+ validate(need(data16S(), ""))
+ box(
+ title = "Setting : " ,
+ width = NULL,
+ status = "primary",
+ checkboxGroupInput(
+ "acpAxes",
+ label = "Axes : ",
+ choices = seq(10),
+ selected = c(1, 2),
+ inline = TRUE
+ ),
+ selectInput(
+ "acpDist",
+ label = "Distance : ",
+ selected = "bray",
+ choices = list(
+ "bray",
+ "jaccard",
+ "unifrac",
+ "wunifrac",
+ "dpcoa",
+ "jsd",
+ "euclidean"
+ )
+ ),
+ selectInput(
+ "acpMethod",
+ label = "Method : ",
+ selected = "MDS",
+ choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
+ ),
+ textInput("acpTitle",
+ label = "Title : ",
+ value = "Samples ordination graphic"),
+ selectInput(
+ "acpLabel",
+ label = "Label : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "acpCol",
+ label = "Color : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "acpShape",
+ label = "Shape : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "acpEllipse",
+ label = "Ellipses : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ selectInput(
+ "acpRep",
+ label = "Barycenters : ",
+ choices = c("..." = 0, sample_variables(data16S()))
+ )
+ )
+ })
+
+ output$acp <- renderPlot({
+ validate(
+ need(data16S(), "Requires an abundance dataset"),
+ need(length(input$acpAxes) == 2, "Requires two projections axes")
+ )
+ p <- plot_samples(
+ data16S(),
+ ordination = ordinate(
+ data16S(),
+ method = input$acpMethod,
+ distance = input$acpDist
+ ),
+ axes = as.numeric(input$acpAxes),
+ title = checkNull(input$acpTitle),
+ color = checkNull(input$acpCol),
+ replicate = checkNull(input$acpRep),
+ shape = checkNull(input$acpShape),
+ label = checkNull(input$acpLabel)
+ )
+ if (!is.null(checkNull(input$acpEllipse))) {
+ p <- p + stat_ellipse(aes_string(group = input$acpEllipse))
+ }
+ return(p + theme_bw())
+ })
})
\ No newline at end of file
diff --git a/ui.R b/ui.R
index 05da260adf702061ee53d42167b8454b159ce5ea..6d405dec8f10939f4cce4efb43d3ae65a97831b0 100644
--- a/ui.R
+++ b/ui.R
@@ -1,208 +1,208 @@
-library(shinydashboard)
-library(shinycustomloader)
-shinyUI(dashboardPage(
- dashboardHeader(title = "Easy16S"),
- dashboardSidebar(
- tags$div(
- title = "Select dataset for demonstration",
- selectInput(
- "dataset",
- label = "Select dataset : ",
- choices = list(
- "Input data" = "input",
- "Rdata" = "rdata",
- "Demo : Chaillou et al., 2015" = "food"
- ),
- # "Mach et al., 2015" = "kinetic", "Morton et al., 2017" = "soil", "Ravel et al., 2011" = "ravel", "biorare" = "biorare", "GlobalPatterns" = "GlobalPatterns"
- selected = 1
- )
- ),
- hr(),
- tags$div(
- title = "RData where 'data' is a phyloseq object.",
- fileInput("fileRData",
- label = "RData : ",
- placeholder = "data.RData")
- ),
- hr(),
- tags$div(
- title = "Abundance BIOM file come from FROGS with 'FROGS BIOM to std BIOM', Qiime or another metagenomic tool.",
- fileInput("fileBiom",
- label = "Abundance BIOM file : ",
- placeholder = "data.biom"),
- radioButtons(
- "biomFormat",
- label = NULL,
- inline = TRUE,
- choices = list(`STD BIOM` = "std",
- `FROGS BIOM` = "frogs"),
- selected = "std"
- )
- ),
- tags$div(
- style = "text-align:center",
- title = "Resample dataset such that all samples have the same library size. \nIt's using an random sampling without replacement.",
- checkboxInput("rareData", label = "Rarefy dataset", value = TRUE),
- textOutput("rarefactionMin")
- ),
- tags$div(
- title = "Metadata table with variables (in columns) and samples (in rows). \nMake sure you follow the exact spelling of the sample names (1st column). \nThe import of an excel table is possible but not recommended.",
- fileInput("fileMeta",
- label = "Metadata table : ",
- placeholder = "data.csv")
- ),
- radioButtons(
- "CSVsep",
- label = "CSV separator : ",
- inline = TRUE,
- choices = list(
- `<tab>` = "\t",
- `,` = ",",
- `;` = ";",
- excel = "excel"
- )
- ),
- tags$div(
- title = "Phylogenetic tree",
- fileInput("fileTree",
- label = "Phylogenetic tree : ",
- placeholder = "data.nwk")
- ),
- # tags$div(
- # title = "Representative FASTA sequences of OTU",
- # fileInput(
- # "fileSeq",
- # label = "FASTA sequences : "),
- # placeholder = "data.fasta"
- # )
- # ),
- uiOutput("downloadUI")
- ),
- dashboardBody(
- tabsetPanel(
- tabPanel(
- "Summary",
- verbatimTextOutput("phyloseqPrint"),
- withLoader(uiOutput("summaryTable")),
- tags$footer(
- "Questions, problems or comments regarding this application should be sent to ",
- a(href = "mailto:cedric.midoux@irstea.fr?subject=[Easy16S]", "cedric.midoux@irstea.fr"),
- align = "center",
- style = "position:absolute;
- bottom: 0;
- width: 100%;
- color: grey;
- padding: 10px;
- # background-color: white;
- z-index: 1000;
- "
- )
- ),
- tabPanel("Global barplot",
- withLoader(plotOutput("histo", height = 700)),
- uiOutput("histUI")),
- tabPanel(
- "Filtered barplot",
- withLoader(plotOutput("histoFocus", height = 700)),
- box(
- title = "Paramètres",
- width = NULL,
- status = "primary",
- uiOutput("histFocusUIfocusRank"),
- uiOutput("histFocusUIfocusTaxa"),
- uiOutput("histFocusUIfocusNbTaxa"),
- uiOutput("histFocusUIfocusGrid"),
- uiOutput("histFocusUIfocusX")
- )
- ),
- tabPanel("Heatmap",
- withLoader(plotOutput("Heatmap", height = 700)),
- uiOutput("HeatmapUI")),
- tabPanel(
- "Rarefaction curves",
- withLoader(plotOutput("rarefactionCurve", height = 700)),
- uiOutput("rarefactionCurveUI")
- ),
- tabPanel(HTML("α-diversity"),
- box(
- width = NULL, tabsetPanel(
- tabPanel("Plots",
- withLoader(plotOutput(
- "richnessA", height = 700
- )),
- uiOutput("richnessAUI")),
- tabPanel("Tables", withLoader(uiOutput("richnessATable")))
- )
- )),
- tabPanel(
- HTML("β-diversity"),
- selectInput(
- "richnessBDist",
- label = "Distance : ",
- choices = list(
- "bray",
- "jaccard",
- "unifrac",
- "wunifrac",
- "dpcoa",
- "jsd",
- "euclidean"
- )
- ),
- box(width = NULL, tabsetPanel(
- tabPanel("Heatmap",
- withLoader(plotOutput(
- "richnessB", height = 700
- )),
- uiOutput("richnessBUI")),
- tabPanel("Networks",
- withLoader(plotOutput("networkB", height = 700)),
- uiOutput("networkBUI")),
- tabPanel("Tables", withLoader(uiOutput("richnessBTable")))
- ))
- ),
- tabPanel(
- "MultiDimensional Scaling",
- withLoader(plotOutput("acp", height = 700)),
- uiOutput("acpUI")
- ),
- tabPanel(
- "Phylogenetic tree",
- withLoader(plotOutput("tree", height = 700)),
- uiOutput("treeUI")
- ),
- tabPanel("Clustering",
- withLoader(plotOutput("clust", height = 700)),
- uiOutput("clustUI")),
- tabPanel("Help",
- div(
- HTML(
- "<p>
- Questions, problems or comments regarding this application should be sent to
- <a href = \"mailto:cedric.midoux@irstea.fr?subject=[Easy16S]\">cedric.midoux@irstea.fr</a>
- </p>
-
- <p>
- For more information about this tool, you can refer to
- <a href = \"http://migale.jouy.inra.fr/sites/migale.jouy.inra.fr.drupal7.migale.jouy.inra.fr/files/JOBIM2018_poster.pdf\">this poster</a>.
- </p>
-
- <p>
- <u>The demo dataset :</u> Chaillou, S., et al. \"
- <a href = \"https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4409155/\">
- Origin and ecological selection of core and food-specific bacterial communities associated with meat and seafood spoilage.</a>\"
- <i>The ISME journal</i> 9.5 (2015): 1105.
- <br>
- 16S survey of bacterial communities from 8 different food products, distributed as 4 meat products and 4 seafoods. Used to find core microbiota of food products.
- </p>
- <br>
- <p align=\"center\" position=\"absolute\" bottom\"80px\">
- <img src=\"migale.png\" width=\"100\"/>
- <img src=\"Irstea.png\" width=\"100\"/>
- </p>
- "
- )
- ))
- )
- )
- ))
+library(shinydashboard)
+library(shinycustomloader)
+shinyUI(dashboardPage(
+ dashboardHeader(title = "Easy16S"),
+ dashboardSidebar(
+ tags$div(
+ title = "Select a dataset for demonstration purpose",
+ selectInput(
+ "dataset",
+ label = "Select dataset : ",
+ choices = list(
+ "Input data" = "input",
+ "Rdata" = "rdata",
+ "Demo : Chaillou et al., 2015" = "food"
+ ),
+ # "Mach et al., 2015" = "kinetic", "Morton et al., 2017" = "soil", "Ravel et al., 2011" = "ravel", "biorare" = "biorare", "GlobalPatterns" = "GlobalPatterns"
+ selected = 1
+ )
+ ),
+ hr(),
+ tags$div(
+ title = "RData where 'data' is a phyloseq object.",
+ fileInput("fileRData",
+ label = "RData : ",
+ placeholder = "data.RData")
+ ),
+ hr(),
+ tags$div(
+ title = "Abundance BIOM file come from FROGS with 'FROGS BIOM to std BIOM', Qiime or another metagenomic tool.",
+ fileInput("fileBiom",
+ label = "Abundance BIOM file : ",
+ placeholder = "data.biom"),
+ radioButtons(
+ "biomFormat",
+ label = NULL,
+ inline = TRUE,
+ choices = list(`STD BIOM` = "std",
+ `FROGS BIOM` = "frogs"),
+ selected = "std"
+ )
+ ),
+ tags$div(
+ style = "text-align:center",
+ title = "Resample dataset such that all samples have the same library size. \nIt's using an random sampling without replacement.",
+ checkboxInput("rareData", label = "Rarefy dataset", value = TRUE),
+ textOutput("rarefactionMin")
+ ),
+ tags$div(
+ title = "Metadata table with variables (in columns) and samples (in rows). \nMake sure you follow the exact spelling of the sample names (1st column). \nThe import of an excel table is possible but not recommended.",
+ fileInput("fileMeta",
+ label = "Metadata table : ",
+ placeholder = "data.csv")
+ ),
+ radioButtons(
+ "CSVsep",
+ label = "CSV separator : ",
+ inline = TRUE,
+ choices = list(
+ `<tab>` = "\t",
+ `,` = ",",
+ `;` = ";",
+ excel = "excel"
+ )
+ ),
+ tags$div(
+ title = "Phylogenetic tree",
+ fileInput("fileTree",
+ label = "Phylogenetic tree : ",
+ placeholder = "data.nwk")
+ ),
+ # tags$div(
+ # title = "Representative FASTA sequences of OTU",
+ # fileInput(
+ # "fileSeq",
+ # label = "FASTA sequences : "),
+ # placeholder = "data.fasta"
+ # )
+ # ),
+ uiOutput("downloadUI")
+ ),
+ dashboardBody(
+ tabsetPanel(
+ tabPanel(
+ "Summary",
+ verbatimTextOutput("phyloseqPrint"),
+ withLoader(uiOutput("summaryTable")),
+ tags$footer(
+ "Questions, problems or comments regarding this application should be sent to ",
+ a(href = "mailto:cedric.midoux@irstea.fr?subject=[Easy16S]", "cedric.midoux@irstea.fr"),
+ align = "center",
+ style = "position:absolute;
+ bottom: 0;
+ width: 100%;
+ color: grey;
+ padding: 10px;
+ # background-color: white;
+ z-index: 1000;
+ "
+ )
+ ),
+ tabPanel("Global barplot",
+ withLoader(plotOutput("histo", height = 700)),
+ uiOutput("histUI")),
+ tabPanel(
+ "Filtered barplot",
+ withLoader(plotOutput("histoFocus", height = 700)),
+ box(
+ title = "Paramètres",
+ width = NULL,
+ status = "primary",
+ uiOutput("histFocusUIfocusRank"),
+ uiOutput("histFocusUIfocusTaxa"),
+ uiOutput("histFocusUIfocusNbTaxa"),
+ uiOutput("histFocusUIfocusGrid"),
+ uiOutput("histFocusUIfocusX")
+ )
+ ),
+ tabPanel("Heatmap",
+ withLoader(plotOutput("Heatmap", height = 700)),
+ uiOutput("HeatmapUI")),
+ tabPanel(
+ "Rarefaction curves",
+ withLoader(plotOutput("rarefactionCurve", height = 700)),
+ uiOutput("rarefactionCurveUI")
+ ),
+ tabPanel(HTML("α-diversity"),
+ box(
+ width = NULL, tabsetPanel(
+ tabPanel("Plots",
+ withLoader(plotOutput(
+ "richnessA", height = 700
+ )),
+ uiOutput("richnessAUI")),
+ tabPanel("Tables", withLoader(uiOutput("richnessATable")))
+ )
+ )),
+ tabPanel(
+ HTML("β-diversity"),
+ selectInput(
+ "richnessBDist",
+ label = "Distance : ",
+ choices = list(
+ "bray",
+ "jaccard",
+ "unifrac",
+ "wunifrac",
+ "dpcoa",
+ "jsd",
+ "euclidean"
+ )
+ ),
+ box(width = NULL, tabsetPanel(
+ tabPanel("Heatmap",
+ withLoader(plotOutput(
+ "richnessB", height = 700
+ )),
+ uiOutput("richnessBUI")),
+ tabPanel("Networks",
+ withLoader(plotOutput("networkB", height = 700)),
+ uiOutput("networkBUI")),
+ tabPanel("Tables", withLoader(uiOutput("richnessBTable")))
+ ))
+ ),
+ tabPanel(
+ "MultiDimensional Scaling",
+ withLoader(plotOutput("acp", height = 700)),
+ uiOutput("acpUI")
+ ),
+ tabPanel(
+ "Phylogenetic tree",
+ withLoader(plotOutput("tree", height = 700)),
+ uiOutput("treeUI")
+ ),
+ tabPanel("Clustering",
+ withLoader(plotOutput("clust", height = 700)),
+ uiOutput("clustUI")),
+ tabPanel("Help",
+ div(
+ HTML(
+ "<p>
+ Questions, problems or comments regarding this application should be sent to
+ <a href = \"mailto:cedric.midoux@irstea.fr?subject=[Easy16S]\">cedric.midoux@irstea.fr</a>
+ </p>
+
+ <p>
+ For more information about this tool, you can refer to
+ <a href = \"http://migale.jouy.inra.fr/sites/migale.jouy.inra.fr.drupal7.migale.jouy.inra.fr/files/JOBIM2018_poster.pdf\">this poster</a>.
+ </p>
+
+ <p>
+ <u>The demo dataset :</u> Chaillou, S., et al. \"
+ <a href = \"https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4409155/\">
+ Origin and ecological selection of core and food-specific bacterial communities associated with meat and seafood spoilage.</a>\"
+ <i>The ISME journal</i> 9.5 (2015): 1105.
+ <br>
+ 16S survey of bacterial communities from 8 different food products, distributed as 4 meat products and 4 seafoods. Used to find core microbiota of food products.
+ </p>
+ <br>
+ <p align=\"center\" position=\"absolute\" bottom\"80px\">
+ <img src=\"migale.png\" width=\"100\"/>
+ <img src=\"Irstea.png\" width=\"100\"/>
+ </p>
+ "
+ )
+ ))
+ )
+ )
+ ))