Commit e9cd5af6 authored by Midoux Cedric's avatar Midoux Cedric
Browse files

sampledataTable

No related merge requests found
Showing with 59 additions and 53 deletions
+59 -53
...@@ -17,7 +17,7 @@ shinyServer ...@@ -17,7 +17,7 @@ shinyServer
return(x) return(x)
} }
} }
beautifulTable <- function(data) { beautifulTable <- function(data) {
DT::datatable( DT::datatable(
data = data, data = data,
...@@ -44,32 +44,31 @@ shinyServer ...@@ -44,32 +44,31 @@ shinyServer
height = "auto" height = "auto"
) )
} }
source({ source({
"https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R" "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
}) })
source("internals.R") source("internals.R")
data16S <- reactive({ data16S <- reactive({
## BIOM input ## BIOM input
if (input$dataset == "input") if (input$dataset == "input")
{ {
## Unhappy path ## Unhappy path
if (is.null(input$fileBiom)) if (is.null(input$fileBiom))
return() return()
## Happy path ## Happy path
## Import biom ## Import biom
d <- .import_biom(input) d <- .import_biom(input)
## Format tax table ## Format tax table
tax_table(d) <- .format_tax_table(tax_table(d)) tax_table(d) <- .format_tax_table(tax_table(d))
## import metadata and store it in phyloseq object ## import metadata and store it in phyloseq object
sample_data(d) <- .import_sample_data(input, d) sample_data(d) <- .import_sample_data(input, d)
## Rarefy data ## Rarefy data
if (input$rareData) { if (input$rareData) {
d <- rarefy_even_depth( d <- rarefy_even_depth(
...@@ -81,29 +80,30 @@ shinyServer ...@@ -81,29 +80,30 @@ shinyServer
} }
return(d) return(d)
} }
## Rdata input ## Rdata input
if (input$dataset == "rdata") if (input$dataset == "rdata")
{ {
## .import_from_rdata(input) ## does not work as a function for some reason ## .import_from_rdata(input) ## does not work as a function for some reason
## Happy path ## 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)) if (!is.null(input$fileRData))
load(input$fileRData$datapath, envir = ne) load(input$fileRData$datapath, envir = ne)
if (class(ne$data) == "phyloseq") if (class(ne$data) == "phyloseq")
return(ne$data) return(ne$data)
## Unhappy paths: everything else ## Unhappy paths: everything else
return() return()
} }
## Default case ## Default case
load("demo/demo.RData") load("demo/demo.RData")
return(get(input$dataset)) return(get(input$dataset))
}) })
data <- reactiveValues() data <- reactiveValues()
{ {
observe({ observe({
...@@ -111,7 +111,7 @@ shinyServer ...@@ -111,7 +111,7 @@ shinyServer
isolate(data <<- data16S()) isolate(data <<- data16S())
}) })
} }
output$downloadData <- { output$downloadData <- {
downloadHandler( downloadHandler(
filename = function() { filename = function() {
...@@ -122,7 +122,7 @@ shinyServer ...@@ -122,7 +122,7 @@ shinyServer
} }
) )
} }
output$downloadUI <- renderUI({ output$downloadUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
tags$div( tags$div(
...@@ -131,15 +131,15 @@ shinyServer ...@@ -131,15 +131,15 @@ shinyServer
downloadButton("downloadData", "Download", style = "color: black; background-color: gray90") downloadButton("downloadData", "Download", style = "color: black; background-color: gray90")
) )
}) })
output$rarefactionMin <- renderText({ output$rarefactionMin <- renderText({
validate(need(input$fileBiom, ""), validate(need(input$fileBiom, ""),
need(input$dataset == "input", "")) need(input$dataset == "input", ""))
paste("(min sample =", format(min(sample_sums(data16S( paste("(min sample =", format(min(sample_sums(data16S(
))), big.mark = " "), "reads)") ))), big.mark = " "), "reads)")
}) })
output$phyloseqPrint <- renderPrint({ output$phyloseqPrint <- renderPrint({
validate( validate(
need( need(
...@@ -149,7 +149,12 @@ shinyServer ...@@ -149,7 +149,12 @@ shinyServer
) )
data16S() data16S()
}) })
output$sampledataTable <- renderTable({
validate(need(sample_data(data16S(), errorIfNULL = FALSE), ""))
sapply(sample_data(data16S()), class)
}, rownames = TRUE, colnames = FALSE, caption = "Class of sample_data", caption.placement = "top")
output$summaryTable <- renderUI({ output$summaryTable <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -173,7 +178,7 @@ shinyServer ...@@ -173,7 +178,7 @@ shinyServer
) )
) )
}) })
output$histUI <- renderUI({ output$histUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -202,7 +207,7 @@ shinyServer ...@@ -202,7 +207,7 @@ shinyServer
) )
) )
}) })
output$histo <- renderPlot({ output$histo <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -218,7 +223,7 @@ shinyServer ...@@ -218,7 +223,7 @@ shinyServer
} }
return(p) return(p)
}) })
output$histFocusUIfocusRank <- renderUI({ output$histFocusUIfocusRank <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
radioButtons( radioButtons(
...@@ -228,19 +233,19 @@ shinyServer ...@@ -228,19 +233,19 @@ shinyServer
inline = TRUE inline = TRUE
) )
}) })
output$histFocusUIfocusTaxa <- renderUI({ output$histFocusUIfocusTaxa <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
selectInput( selectInput(
"focusTaxa", "focusTaxa",
label = "Selected taxa : ", label = "Selected taxa : ",
choices = unique(as.vector(tax_table(data16S( choices = unique(as.vector(tax_table(data16S(
))[, input$focusRank])), ))[, input$focusRank])),
selected = TRUE selected = TRUE
) )
}) })
output$histFocusUIfocusNbTaxa <- renderUI({ output$histFocusUIfocusNbTaxa <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
sliderInput( sliderInput(
...@@ -252,21 +257,21 @@ shinyServer ...@@ -252,21 +257,21 @@ shinyServer
value = 10 value = 10
) )
}) })
output$histFocusUIfocusGrid <- renderUI({ output$histFocusUIfocusGrid <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
selectInput("focusGrid", selectInput("focusGrid",
label = "Subplot : ", label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S()))) choices = c("..." = 0, sample_variables(data16S())))
}) })
output$histFocusUIfocusX <- renderUI({ output$histFocusUIfocusX <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
selectInput("focusX", selectInput("focusX",
label = "X : ", label = "X : ",
choices = c("..." = 0, sample_variables(data16S()))) choices = c("..." = 0, sample_variables(data16S())))
}) })
output$histoFocus <- renderPlot({ output$histoFocus <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -285,7 +290,7 @@ shinyServer ...@@ -285,7 +290,7 @@ shinyServer
} }
return(p) return(p)
}) })
output$clustUI <- renderUI({ output$clustUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -326,7 +331,7 @@ shinyServer ...@@ -326,7 +331,7 @@ shinyServer
) )
) )
}) })
output$clust <- renderPlot({ output$clust <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -337,7 +342,7 @@ shinyServer ...@@ -337,7 +342,7 @@ shinyServer
color = checkNull(input$clustCol) color = checkNull(input$clustCol)
) )
}) })
output$richnessAUI <- renderUI({ output$richnessAUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -398,7 +403,7 @@ shinyServer ...@@ -398,7 +403,7 @@ shinyServer
) )
) )
}) })
output$richnessA <- renderPlot({ output$richnessA <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -420,7 +425,7 @@ shinyServer ...@@ -420,7 +425,7 @@ shinyServer
} }
return(p) return(p)
}) })
output$richnessATable <- renderUI({ output$richnessATable <- renderUI({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -428,7 +433,7 @@ shinyServer ...@@ -428,7 +433,7 @@ shinyServer
SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2) SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
))) )))
}) })
output$richnessBUI <- renderUI({ output$richnessBUI <- renderUI({
box( box(
title = "Setting : " , title = "Setting : " ,
...@@ -444,7 +449,7 @@ shinyServer ...@@ -444,7 +449,7 @@ shinyServer
value = "Beta diversity heatmap") value = "Beta diversity heatmap")
) )
}) })
output$richnessB <- renderPlot({ output$richnessB <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -477,7 +482,7 @@ shinyServer ...@@ -477,7 +482,7 @@ shinyServer
) )
return(p + scale_fill_gradient2()) return(p + scale_fill_gradient2())
}) })
output$networkBUI <- renderUI({ output$networkBUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -518,7 +523,7 @@ shinyServer ...@@ -518,7 +523,7 @@ shinyServer
) )
) )
}) })
output$networkB <- renderPlot({ output$networkB <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -539,7 +544,7 @@ shinyServer ...@@ -539,7 +544,7 @@ shinyServer
) )
return(p) return(p)
}) })
output$richnessBTable <- renderUI({ output$richnessBTable <- renderUI({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -549,7 +554,7 @@ shinyServer ...@@ -549,7 +554,7 @@ shinyServer
), digits = 2) ), digits = 2)
))) )))
}) })
output$rarefactionCurve <- renderPlot({ output$rarefactionCurve <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -564,16 +569,16 @@ shinyServer ...@@ -564,16 +569,16 @@ shinyServer
if (!is.null(checkNull(input$rarefactionGrid))) { if (!is.null(checkNull(input$rarefactionGrid))) {
p <- p + facet_grid(paste(".", "~", input$rarefactionGrid)) p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
} }
if (input$rarefactionMin) { if (input$rarefactionMin) {
p <- p <-
p + geom_vline(xintercept = min(sample_sums(data16S())), p + geom_vline(xintercept = min(sample_sums(data16S())),
color = "gray60") color = "gray60")
} }
return(p + ggtitle(input$rarefactionTitle)) return(p + ggtitle(input$rarefactionTitle))
}) })
output$rarefactionCurveUI <- renderUI({ output$rarefactionCurveUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -608,7 +613,7 @@ shinyServer ...@@ -608,7 +613,7 @@ shinyServer
) )
) )
}) })
output$HeatmapUI <- renderUI({ output$HeatmapUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -667,7 +672,7 @@ shinyServer ...@@ -667,7 +672,7 @@ shinyServer
) )
) )
}) })
output$Heatmap <- renderPlot({ output$Heatmap <- renderPlot({
validate(need(data16S(), validate(need(data16S(),
"Requires an abundance dataset")) "Requires an abundance dataset"))
...@@ -689,7 +694,7 @@ shinyServer ...@@ -689,7 +694,7 @@ shinyServer
} }
return(p) return(p)
}) })
output$treeUI <- renderUI({ output$treeUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -728,7 +733,7 @@ shinyServer ...@@ -728,7 +733,7 @@ shinyServer
) )
) )
}) })
output$tree <- renderPlot({ output$tree <- renderPlot({
validate( validate(
need(data16S(), "Requires an abundance dataset"), need(data16S(), "Requires an abundance dataset"),
...@@ -757,7 +762,7 @@ shinyServer ...@@ -757,7 +762,7 @@ shinyServer
return(p) return(p)
} }
}) })
output$acpUI <- renderUI({ output$acpUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
...@@ -821,7 +826,7 @@ shinyServer ...@@ -821,7 +826,7 @@ shinyServer
) )
) )
}) })
output$acp <- renderPlot({ output$acp <- renderPlot({
validate( validate(
need(data16S(), "Requires an abundance dataset"), need(data16S(), "Requires an abundance dataset"),
......
...@@ -83,6 +83,7 @@ shinyUI(dashboardPage( ...@@ -83,6 +83,7 @@ shinyUI(dashboardPage(
tabPanel( tabPanel(
"Summary", "Summary",
verbatimTextOutput("phyloseqPrint"), verbatimTextOutput("phyloseqPrint"),
tableOutput("sampledataTable"),
withLoader(uiOutput("summaryTable")), withLoader(uiOutput("summaryTable")),
tags$footer( tags$footer(
"Questions, problems or comments regarding this application should be sent to ", "Questions, problems or comments regarding this application should be sent to ",
...@@ -181,12 +182,12 @@ shinyUI(dashboardPage( ...@@ -181,12 +182,12 @@ shinyUI(dashboardPage(
Questions, problems or comments regarding this application should be sent to 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> <a href = \"mailto:cedric.midoux@irstea.fr?subject=[Easy16S]\">cedric.midoux@irstea.fr</a>
</p> </p>
<p> <p>
For more information about this tool, you can refer to 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>. <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>
<p> <p>
<u>The demo dataset :</u> Chaillou, S., et al. \" <u>The demo dataset :</u> Chaillou, S., et al. \"
<a href = \"https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4409155/\"> <a href = \"https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4409155/\">
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment