Commit a0165c62 authored by Midoux Cedric's avatar Midoux Cedric

panel/richnessA

parent 9cbef098
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()))
),
collapsedBox(verbatimTextOutput("richnessAScript"), title = "RCode")
)
})
output$richnessAScript <- renderText({
if (!is.null(checkNull(input$richnessMeasures))) {
measures <-
glue("measures = c(\"{glue_collapse(input$richnessMeasures, sep='\", \"')}\")")
} else {
measures <- NULL
}
scriptArgs <- c("physeq = data", measures)
if (!is.null(checkNull(input$richnessX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$richnessX}\""))
}
if (!is.null(checkNull(input$richnessColor))) {
scriptArgs <-
c(scriptArgs, glue("color = \"{input$richnessColor}\""))
}
if (!is.null(checkNull(input$richnessShape))) {
scriptArgs <-
c(scriptArgs, glue("shape = \"{input$richnessShape}\""))
}
if (!is.null(checkNull(input$richnessTitle))) {
scriptArgs <-
c(scriptArgs, glue("title = \"{input$richnessTitle}\""))
}
script <- c(
scriptHead,
"# Plot boxplot of alpha diversity",
glue(
"p <- plot_richness({glue_collapse(scriptArgs, sep=', ')})"
)
)
if (input$richnessBoxplot >= 2) {
script <- c(script,
"p <- p + geom_boxplot()")
}
if (input$richnessBoxplot <= 2) {
script <- c(script,
"p <- p + geom_point()")
}
script <- c(script, "", "plot(p)")
script <- c(script, "", "# Tables")
script <- c(
script,
glue(
"t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"
),
"write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)"
)
return(glue_collapse(script, sep = "\n"))
})
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)
)))
})
richnessA <- fluidPage(box(width = NULL, tabsetPanel(
tabPanel("Plots",
withLoader(plotOutput(
"richnessA", height = 700
)),
uiOutput("richnessAUI")),
tabPanel("Tables", withLoader(uiOutput("richnessATable")))
)))
......@@ -12,6 +12,7 @@ shinyServer
source("panels/histoFocus-server.R", local = TRUE)
source("panels/heatmap-server.R", local = TRUE)
source("panels/rarefactionCurve-server.R", local = TRUE)
source("panels/richnessA-server.R", local = TRUE)
source("panels/tree-server.R", local = TRUE)
checkNull <- function(x) {
......@@ -317,150 +318,6 @@ shinyServer
)
})
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()))
),
collapsedBox(verbatimTextOutput("richnessAScript"), title = "RCode")
)
})
output$richnessAScript <- renderText({
if (!is.null(checkNull(input$richnessMeasures))) {
measures <-
glue("measures = c(\"{glue_collapse(input$richnessMeasures, sep='\", \"')}\")")
} else {
measures <- NULL
}
scriptArgs <- c("physeq = data", measures)
if (!is.null(checkNull(input$richnessX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$richnessX}\""))
}
if (!is.null(checkNull(input$richnessColor))) {
scriptArgs <-
c(scriptArgs, glue("color = \"{input$richnessColor}\""))
}
if (!is.null(checkNull(input$richnessShape))) {
scriptArgs <-
c(scriptArgs, glue("shape = \"{input$richnessShape}\""))
}
if (!is.null(checkNull(input$richnessTitle))) {
scriptArgs <-
c(scriptArgs, glue("title = \"{input$richnessTitle}\""))
}
script <- c(
scriptHead,
"# Plot boxplot of alpha diversity",
glue(
"p <- plot_richness({glue_collapse(scriptArgs, sep=', ')})"
)
)
if (input$richnessBoxplot >= 2) {
script <- c(script,
"p <- p + geom_boxplot()")
}
if (input$richnessBoxplot <= 2) {
script <- c(script,
"p <- p + geom_point()")
}
script <- c(script, "", "plot(p)")
script <- c(script, "", "# Tables")
script <- c(
script,
glue(
"t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"
),
"write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)"
)
return(glue_collapse(script, sep = "\n"))
})
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({
validate(need(data16S(), ""))
box(
......
......@@ -4,6 +4,7 @@ source("panels/histo-ui.R", local = TRUE)
source("panels/histoFocus-ui.R", local = TRUE)
source("panels/heatmap-ui.R", local = TRUE)
source("panels/rarefactionCurve-ui.R", local = TRUE)
source("panels/richnessA-ui.R", local = TRUE)
source("panels/tree-ui.R", local = TRUE)
shinyUI(dashboardPage(
......@@ -114,16 +115,7 @@ shinyUI(dashboardPage(
tabPanel("Rarefaction curves",
rarefactionCurve),
tabPanel(HTML("&alpha;-diversity"),
box(
width = NULL, tabsetPanel(
tabPanel("Plots",
withLoader(plotOutput(
"richnessA", height = 700
)),
uiOutput("richnessAUI")),
tabPanel("Tables", withLoader(uiOutput("richnessATable")))
)
)),
richnessA),
tabPanel(
HTML("&beta;-diversity"),
selectInput(
......
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