Skip to content

GitLab

Commit a949d8e1 authored by Midoux Cedric's avatar Midoux Cedric
Browse files
Options

Table with agglomerate taxe but not DataTable formatting

parent 2f2009bb
Hide whitespace changes
Inline Side-by-side
Showing with 77 additions and 50 deletions
server.R
View file @ a949d8e1
......@@ -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"),
......
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