Skip to content

GitLab

Commit 5511da30 authored by Midoux Cedric's avatar Midoux Cedric
Browse files

Merge branch 'class_sample'

parents 9f80df55 d1e83687
Hide whitespace changes
Inline Side-by-side
server.R
View file @ 5511da30
......@@ -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,13 +44,13 @@ 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")
......@@ -58,17 +58,17 @@ shinyServer
## 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(
......@@ -80,12 +80,12 @@ 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
......@@ -93,17 +93,17 @@ shinyServer
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,12 +149,24 @@ shinyServer
)
data16S()
})
output$sampledataTable <- renderTable({
output$sampledataTable <- renderUI({
validate(need(sample_data(data16S(), errorIfNULL = FALSE), ""))
sapply(sample_data(data16S()), class)
}, rownames = TRUE, colnames = FALSE, caption = "Class of sample_data", caption.placement = "top")
box(
title = "Class of sample_data",
width = NULL,
status = "primary",
collapsible = TRUE,
collapsed = TRUE,
renderTable({
(sapply(sample_data(data16S()), class))
}, rownames = TRUE, colnames = FALSE)
)
#sapply(sample_data(data16S()), class)
#}, rownames = TRUE, colnames = FALSE, caption = "Class of sample_data", caption.placement = "top")
})
output$summaryTable <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -178,7 +190,7 @@ shinyServer
)
)
})
output$histUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -207,7 +219,7 @@ shinyServer
)
)
})
output$histo <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -223,7 +235,7 @@ shinyServer
}
return(p)
})
output$histFocusUIfocusRank <- renderUI({
validate(need(data16S(), ""))
radioButtons(
......@@ -233,19 +245,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(
......@@ -257,21 +269,21 @@ shinyServer
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"))
......@@ -290,7 +302,7 @@ shinyServer
}
return(p)
})
output$clustUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -331,7 +343,7 @@ shinyServer
)
)
})
output$clust <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -342,7 +354,7 @@ shinyServer
color = checkNull(input$clustCol)
)
})
output$richnessAUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -403,7 +415,7 @@ shinyServer
)
)
})
output$richnessA <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -425,7 +437,7 @@ shinyServer
}
return(p)
})
output$richnessATable <- renderUI({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -433,7 +445,7 @@ shinyServer
SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
)))
})
output$richnessBUI <- renderUI({
box(
title = "Setting : " ,
......@@ -449,7 +461,7 @@ shinyServer
value = "Beta diversity heatmap")
)
})
output$richnessB <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -482,7 +494,7 @@ shinyServer
)
return(p + scale_fill_gradient2())
})
output$networkBUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -523,7 +535,7 @@ shinyServer
)
)
})
output$networkB <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -544,7 +556,7 @@ shinyServer
)
return(p)
})
output$richnessBTable <- renderUI({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -554,7 +566,7 @@ shinyServer
), digits = 2)
)))
})
output$rarefactionCurve <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -569,16 +581,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(
......@@ -613,7 +625,7 @@ shinyServer
)
)
})
output$HeatmapUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -672,7 +684,7 @@ shinyServer
)
)
})
output$Heatmap <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
......@@ -694,7 +706,7 @@ shinyServer
}
return(p)
})
output$treeUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -733,7 +745,7 @@ shinyServer
)
)
})
output$tree <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
......@@ -762,7 +774,7 @@ shinyServer
return(p)
}
})
output$acpUI <- renderUI({
validate(need(data16S(), ""))
box(
......@@ -826,7 +838,7 @@ shinyServer
)
)
})
output$acp <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
......@@ -851,4 +863,4 @@ shinyServer
}
return(p + theme_bw())
})
})
\ No newline at end of file
})
ui.R
View file @ 5511da30
......@@ -83,7 +83,7 @@ shinyUI(dashboardPage(
tabPanel(
"Summary",
verbatimTextOutput("phyloseqPrint"),
tableOutput("sampledataTable"),
uiOutput("sampledataTable"),
withLoader(uiOutput("summaryTable")),
tags$footer(
"Questions, problems or comments regarding this application should be sent to ",
......
Markdown is supported
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