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

Strain for tax_rank

parent 4cc07004
library(shinydashboard)
shinyServer
(function(input, output, session)
{
checkNull <- function(x) {
if (!exists(as.character(substitute(x)))) {
return(NULL)
} else if (is.null(x)) {
return(NULL)
} else if (length(x) > 1) {
return(x)
}
else if (x %in% c(0, "", NA, "NULL")) {
return(NULL)
} else {
return(x)
}
}
beautifulTable <- function(data) {
DT::datatable(
data = data,
rownames = FALSE,
filter = "top",
extensions = c("Buttons", "ColReorder", "FixedColumns"),
options = list(
dom = "lBtip",
pageLength = 10,
lengthMenu = list(c(10, 25, 50, 100,-1), list('10', '25', '50', '100', 'All')),
buttons = list(
'colvis',
list(
extend = 'collection',
buttons = c('copy', 'csv', 'excel', 'pdf'),
text = 'Download'
)
),
colReorder = TRUE,
scrollX = TRUE,
fixedColumns = list(leftColumns = 1, rightColumns = 0)
),
width = "auto",
height = "auto"
)
}
source(
"https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
)
data16S <- reactive({
if (input$biomFormat == "std")
{
d <- import_biom(
BIOMfilename = input$fileBiom$datapath,
treefilename = input$fileTree$datapath,
refseqfilename = input$fileSeq$datapath
)
} else if (input$biomFormat == "frogs") {
d <- import_frogs(
biom = input$fileBiom$datapath,
treefilename = input$fileTree$datapath,
refseqfilename = input$fileSeq$datapath
)
}
colnames(tax_table(d)) <-
c("Kingdom",
"Phylum",
"Class",
"Order",
"Family",
"Genus",
"Species")
tax_table(d)[grep("unknown ", tax_table(d))] <- NA
#tax_table(d)[grep("Unclassified", tax_table(d))] <- NA
if (!is.null(input$fileMeta)) {
if (input$CSVsep == "excel") {
sample_data(d) <-
RcmdrMisc::readXL(input$fileMeta$datapath,
rownames = TRUE,
header = TRUE)
} else {
sample_data(d) <- read.csv(
input$fileMeta$datapath,
header = TRUE,
sep = input$CSVsep,
row.names = 1,
na.strings = NA
)
}
} else {
n <- data.frame(sample_names(d) , row.names = sample_names(d))
names(n) <- "sample_names"
sample_data(d) <- n
}
if (input$rareData) {
d <- rarefy_even_depth(
d,
replace = FALSE,
rngseed = as.integer(Sys.time()),
verbose = FALSE
)
}
return(d)
})
output$rarefactionMin <- renderText({
if (!is.null(input$fileBiom)) {
paste("(min sample =", format(min(sample_sums(data16S(
))), big.mark = " "), "reads)")
} else {
paste("(min sample =", 0, "reads)")
}
})
output$rarefaction <- renderText({
if (input$rareData) {
"<font color=\"#FF0000\"><b> Vous travaillez acctuellement avec des données raréfiés </b></font>"
}
})
output$phyloseqPrint <- renderPrint({
validate(
need(
!is.null(input$fileBiom),
"Merci de commencer par importer un fichier d'abondance au format BIOM. Celui-ci peut etre obtenu a l'issue du workflow FROGS avec l'operation 'FROGS BIOM to std BIOM'"
)
)
data16S()
})
output$summaryTable <- renderUI({
if (is.null(input$fileBiom))
return()
box(
title = "Tables",
width = NULL,
status = "primary",
tabsetPanel(
tabPanel("otu_table",
beautifulTable(
data.frame(OTU = taxa_names(data16S()), otu_table(data16S()))
)),
tabPanel("tax_table",
beautifulTable(
data.frame(OTU = taxa_names(data16S()), tax_table(data16S()))
)),
if (!is.null(input$fileMeta)) {
tabPanel("sample_data",
beautifulTable(data.frame(
SAMPLE = sample_names(data16S()), sample_data(data16S())
)))
}
)
)
})
output$histUI <- renderUI({
if (is.null(input$fileBiom))
return()
box(
title = "Paramètres",
width = NULL,
status = "primary",
selectInput(
"barFill",
label = "Niveau taxo :",
choices = rank_names(data16S())
),
if (!is.null(input$fileMeta))
{
selectInput(
"barGrid",
label = "Regroupement :",
choices = c("..." = 0, sample_variables(data16S()))
)
},
if (!is.null(input$fileMeta))
{
selectInput("barX",
label = "X :",
choices = c("..." = 0, sample_variables(data16S())))
}
)
})
output$histo <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
p <- plot_bar(
physeq = data16S(),
fill = input$barFill,
x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX)
)
if (!is.null(checkNull(input$barGrid))) {
p <-
p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
}
return(p)
})
output$histFocusUIfocusRank <- renderUI({
if (is.null(input$fileBiom))
return()
radioButtons(
"focusRank",
label = "Niveau taxo :",
choices = list(
"Kingdom" = 1,
"Phylum" = 2,
"Class" = 3,
"Order" = 4,
"Family" = 5,
"Genus" = 6
),
inline = TRUE,
selected = 1
)
})
output$histFocusUIfocusTaxa <- renderUI({
if (is.null(input$fileBiom))
return()
selectInput(
"focusTaxa",
label = "Taxa :",
choices = unique(as.matrix(as.data.frame(
tax_table(data16S())
)[, as.integer(input$focusRank)])),
selected = TRUE
)
})
output$histFocusUIfocusNbTaxa <- renderUI({
if (is.null(input$fileBiom))
return()
sliderInput(
"focusNbTaxa",
label = "Nombre de sous-taxons :",
min = 0,
#max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
max = 30
,
value = 10
)
})
output$histFocusUIfocusGrid <- renderUI({
if (is.null(input$fileBiom) && is.null(input$fileMeta))
return()
selectInput(
"focusGrid",
label = "Regroupement :",
choices = c("..." = 0, sample_variables(data16S()))
)
})
output$histFocusUIfocusX <- renderUI({
if (is.null(input$fileBiom) && is.null(input$fileMeta))
return()
selectInput("focusX",
label = "X :",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histoFocus <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
p <- plot_composition(
physeq = data16S(),
taxaRank1 = rank_names(data16S())[as.integer(input$focusRank)],
taxaSet1 = input$focusTaxa,
taxaRank2 = rank_names(data16S())[as.integer(input$focusRank) + 1],
numberOfTaxa = input$focusNbTaxa,
fill = rank_names(data16S())[as.integer(input$focusRank) + 1],
x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
)
if (!is.null(checkNull(input$focusGrid))) {
p <-
p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
}
return(p)
})
output$clustUI <- renderUI({
if (is.null(input$fileBiom))
return()
box(
title = "Paramètres",
width = NULL,
status = "primary",
selectInput(
"clustDist",
label = "Distance :",
choices = list(
"bray",
"jaccard",
"unifrac",
"wunifrac",
"dpcoa",
"jsd",
"euclidean"
)
),
selectInput(
"clustMethod",
label = "Methode :",
choices = list(
"ward.D2",
"ward.D",
"single",
"complete",
"average",
"mcquitty",
"median",
"centroid"
)
),
if (!is.null(input$fileMeta)) {
selectInput(
"clustCol",
label = "Couleur :",
choices = c("..." = 0, sample_variables(data16S()))
)
}
)
})
output$clust <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
plot_clust(
physeq = data16S(),
dist = input$clustDist,
method = input$clustMethod,
color = checkNull(input$clustCol)
)
})
output$richnessAUI <- renderUI({
if (is.null(input$fileBiom)) {
return()
}
box(
title = "Paramètres",
width = NULL,
status = "primary",
checkboxGroupInput(
"richnessMeasures",
label = "Mesures :",
choices = c(
"Observed",
"Chao1",
"ACE",
"Shannon",
"Simpson",
"InvSimpson",
"Fisher"
),
selected = c(
"Observed",
"Chao1",
"ACE",
"Shannon",
"Simpson",
"InvSimpson",
"Fisher"
),
inline = TRUE
),
if (!is.null(input$fileMeta)) {
selectInput(
"richnessX",
label = "X :",
choices = c("..." = 0, sample_variables(data16S()))
)
},
if (!is.null(input$fileMeta)) {
selectInput(
"richnessColor",
label = "Couleur :",
choices = c("..." = 0, sample_variables(data16S()))
)
},
if (!is.null(input$fileMeta)) {
selectInput(
"richnessShape",
label = "Forme :",
choices = c("..." = 0, sample_variables(data16S()))
)
},
radioButtons(
"richnessBoxplot",
label = "Representation :",
choices = list(
"Points seuls" = 1,
"Boxplot et points" = 2,
"Boxplot seul" = 3
),
selected = 2,
inline = TRUE
)
)
})
output$richnessA <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
p <- plot_richness(
physeq = data16S(),
x = ifelse(is.null(checkNull(
input$richnessX
)), "samples", input$richnessX),
color = checkNull(input$richnessColor),
shape = checkNull(input$richnessShape),
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(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
p(beautifulTable(data.frame(
SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
)))
})
output$richnessBUI <- renderUI({
if (is.null(input$fileMeta)) {
return()
}
box(
title = "Paramètres",
width = NULL,
status = "primary",
selectInput(
"richnessOrder",
label = "Ordre de tri des echantillons :",
choices = c("..." = 0, sample_variables(data16S()))
)
)
})
output$richnessB <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
beta <-
melt(as(distance(data16S(), method = input$richnessBDist), "matrix"))
colnames(beta) <- c("x", "y", "distance")
if (!is.null(checkNull(input$richnessOrder)))
{
new_factor = as.factor(get_variable(data16S(), input$richnessOrder))
variable_sort <-
as.factor(get_variable(data16S(), input$richnessOrder)[order(new_factor)])
L = levels(reorder(sample_names(data16S()), as.numeric(new_factor)))
beta$x <- factor(beta$x, levels = L)
beta$y <- factor(beta$y, levels = L)
palette <- hue_pal()(length(levels(new_factor)))
tipColor <-
col_factor(palette, levels = levels(new_factor))(variable_sort)
}
p <-
ggplot(beta, aes(x = x, y = y, fill = distance)) + geom_tile()
p <- p + theme(
axis.text.x = element_text(
angle = 90,
hjust = 1,
color = checkNull(tipColor)
),
axis.text.y = element_text(color = checkNull(tipColor)),
axis.title.x = element_blank(),
axis.title.y = element_blank()
)
return(p + scale_fill_gradient2())
})
output$networkBUI <- renderUI({
if (is.null(input$fileBiom)) {
return()
}
box(
title = "Paramètres",
width = NULL,
status = "primary",
sliderInput(
"netwMax",
label = "Cutoff :",
min = 0,
max = 1,
value = 0.7
),
checkboxInput("netwOrphan",
label = "Garder les points orphelins",
value = TRUE),
if (!is.null(input$fileMeta)) {
selectInput(
"netwCol",
label = "Couleur :",
choices = c("..." = 0, sample_variables(data16S()))
)
},
if (!is.null(input$fileMeta)) {
selectInput(
"netwShape",
label = "Forme :",
choices = c("..." = 0, sample_variables(data16S()))
)
},
if (!is.null(input$fileMeta)) {
selectInput(
"netwLabel",
label = "Label :",
choices = c(
select = "",
"Sample name" = "value",
sample_variables(data16S())
)
)
}
)
})
output$networkB <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
g <- make_network(
data16S(),
distance = input$richnessBDist,
max.dist = input$netwMax,
keep.isolates = input$netwOrphan
)
p <- plot_network(
g,
physeq = data16S(),
color = checkNull(input$netwCol),
shape = checkNull(input$netwShape),
label = checkNull(input$netwLabel),
hjust = 2,
title = NULL
)
return(p)
})
output$richnessBTable <- renderUI({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
p(beautifulTable(data.frame(
SAMPLE = sample_names(data16S()), round(as.matrix(
distance(data16S(), method = input$richnessBDist)
), digits = 2)
)))
})
output$rarefactionCurve <- renderPlot({
validate(need(
!is.null(input$fileBiom),
"Merci d'importer un fichier d'abondance"
))
p <- ggrare(
physeq = data16S(),
step = input$rarefactionStep,
color = checkNull(input$rarefactionColor),
se = FALSE
)
if (!is.null(checkNull(input$rarefactionGrid))) {
p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
}
if (!input$rareData)
{
if (input$rarefactionMin) {
p <-
p + geom_vline(xintercept = min(sample_sums(data16S())),
color = "gray60")
}
}
return(p)
})
output$rarefactionCurveUI <- renderUI({
if (is.null(input$fileBiom))