Commit 41ab68de authored by Midoux Cedric's avatar Midoux Cedric
Browse files

DeseqResults

parent d62ef33f
......@@ -38,16 +38,6 @@ output$deseqTitleUI <- renderUI({
value = "Volcano Plot")
})
output$deseqPadjUI <- renderUI({
validate(need(physeq(), ""))
sliderInput("deseqPadj",
label = "Adjusted p-value threshold (recommended 0.05 ):",
min = 0,
max = 1,
value = 0.05,
step = 0.01)
})
output$deseqUI <- renderUI({
validate(need(physeq(), ""))
box(
......@@ -56,27 +46,42 @@ output$deseqUI <- renderUI({
status = "primary",
uiOutput("deseqContrastVarUI"),
uiOutput("deseqContrastModUI"),
uiOutput("deseqTitleUI"),
uiOutput("deseqPadjUI")
# actionButton("deseqButton", label = "Execute", icon = icon("check"), class = "btn-primary"),
uiOutput("deseqTitleUI")
)
})
output$deseq <- metaRender2(renderPlot, {
validate(
need(physeq(), "Requires an abundance dataset"),
need(class(get_variable(physeq(), input$deseqContrastVar)) != "numeric" ||
length(input$deseqContrastMod) == 2, "Requires a continuous design or a selection of two modalities for a discrete design.")
)
design <- metaReactive2({
req(input$deseqContrastVar)
metaExpr({as.formula(..(paste("~", input$deseqContrastVar)))})
})
cds <- metaReactive2({
req(design())
req(physeq())
data <- physeq()
metaExpr({phyloseq_to_deseq2(data, design = ..(design()))})
})
dds <- metaReactive2({
req(cds())
metaExpr({DESeq2::DESeq(..(cds()), sfType = "poscounts")})
})
design <- metaExpr({as.formula(..(paste("~", input$deseqContrastVar)))})
cds <- metaExpr({phyloseq_to_deseq2(data, design = design)})
dds <- metaExpr({DESeq2::DESeq(cds, sfType = "poscounts")})
results <- metaReactive2({
req(input$deseqContrastVar)
req(dds())
req(physeq())
req({class(get_variable(physeq(), input$deseqContrastVar)) == "numeric" || length(input$deseqContrastMod) == 2})
results <- if (class(get_variable(data, input$deseqContrastVar)) == "numeric") {
data <- physeq()
if (class(get_variable(data, input$deseqContrastVar)) == "numeric") {
# First case: regression against a continuous variable
metaExpr({
DESeq2::results(object = dds,
DESeq2::results(object = ..(dds()),
name = ..(input$deseqContrastVar),
tidy = TRUE) %>%
as_tibble() %>%
......@@ -84,28 +89,34 @@ output$deseq <- metaRender2(renderPlot, {
inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU")
})
} else {
validate(need(length(input$deseqContrastMod) == 2, "Invalid input."))
if (length(levels(get_variable(data, input$deseqContrastVar))) == 2) {
# Second case: regression against a binary variable
metaExpr({
DESeq2::results(object = dds,
name = ..(DESeq2::resultsNames(dds)[-1]),
DESeq2::results(object = ..(dds()),
name = ..(DESeq2::resultsNames(..(dds()))[-1]),
tidy = TRUE) %>%
as_tibble() %>% rename(OTU = row) %>%
inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU")
})
} else {
# Third case: regression against a qualiative variable with three or more levels
metaExpr({
DESeq2::results(object = dds,
contrast = ..(c(input$deseqContrastVar, input$deseqContrastMod[1], input$deseqContrastMod[2])),
tidy = TRUE) %>%
as_tibble() %>% rename(OTU = row) %>%
inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU")
})
}
} else {
# Third case: regression against a qualiative variable with three or more levels
metaExpr({
DESeq2::results(object = ..(dds()),
contrast = ..(c(input$deseqContrastVar, input$deseqContrastMod[1], input$deseqContrastMod[2])),
tidy = TRUE) %>%
as_tibble() %>% rename(OTU = row) %>%
inner_join(tax_table(data) %>% as("matrix") %>% as_tibble(rownames = "OTU"), by = "OTU")
})
}
}
})
detail <-metaReactive2({
data <- physeq()
detail <- if (class(get_variable(data, input$deseqContrastVar)) == "numeric") {
if (class(get_variable(data, input$deseqContrastVar)) == "numeric") {
# First case
metaExpr({
..(paste0("You compare low and high values of the continuous variable ", input$deseqContrastVar, ".\nA positive log2FoldChange means more abundant for high values of ", input$deseqContrastVar, "."))
......@@ -123,16 +134,22 @@ output$deseq <- metaRender2(renderPlot, {
})
}
}
deseqTable <- metaExpr({
})
})
output$deseq <- metaRender2(renderPlot, {
validate(
need(physeq(), "Requires an abundance dataset"),
need(class(get_variable(physeq(), input$deseqContrastVar)) == "numeric" ||
length(input$deseqContrastMod) == 2, "Requires a continuous design or a selection of two modalities for a discrete design.")#,
#need(class(results()) == "DESeqResults", "Invalid input.")
)
data <- physeq()
deseqPlot <- metaExpr({
ggplot(results %>% mutate(evidence = -log10(padj),
ggplot(..(results()) %>% mutate(evidence = -log10(padj),
evolution = case_when(
padj <= ..(input$deseqPadj) & log2FoldChange < 0 ~ "Down",
padj <= ..(input$deseqPadj) & log2FoldChange > 0 ~ "Up",
padj <= 0.05 & log2FoldChange < 0 ~ "Down",
padj <= 0.05 & log2FoldChange > 0 ~ "Up",
TRUE ~ "Not DA"
)),
aes(x = log2FoldChange, y = evidence)) +
......@@ -140,20 +157,15 @@ output$deseq <- metaRender2(renderPlot, {
theme_bw(base_size = 16) + # clean up theme
theme(legend.position = "none", # remove legend
plot.subtitle = element_text(size = 12)) + # add subtitle
ggtitle(label = ..(input$deseqTitle), subtitle = detail) + # add informative title
ggtitle(label = ..(input$deseqTitle), subtitle = ..(detail())) + # add informative title
xlab(expression(log[2]("FoldChange"))) + # x-axis label
ylab(expression(-log[10]("adjusted p-value"))) + # y-axis label
geom_vline(xintercept = 0, colour = "grey80", linetype = 2) + # add line at 0
geom_hline(yintercept = -log10(..(input$deseqPadj)), colour = "grey80", linetype = 2) +
geom_hline(yintercept = -log10(0.05), colour = "grey80", linetype = 2) +
scale_color_manual(values = c("Down" = "red", "Not DA" = "grey20", "Up" = "green")) # change colors
})
metaExpr({
design <- ..(design)
cds <- ..(cds)
dds <- ..(dds)
results <- ..(results)
detail <- ..(detail)
p <- ..(deseqPlot)
p
})
......@@ -176,3 +188,7 @@ observeEvent(input$deseq_output_code,
)
}
)
# output$deseqTable <- metaRender2(renderTable, {
# }
# )
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