Commit 1f1e6aee authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

- Optimisations

parent a039cda0
......@@ -52,13 +52,11 @@ source("config.R")
header$children[[2]]$children <- tags$div(tags$head(tags$style(HTML(".name { background-color: transparent } .content-wrapper, .right-side {background-color: white}"))),anchor)
header[["children"]][[2]][["children"]][["name"]] <- "Shiny SChnurR"
## SIDEBAR --------
sidebar <- dashboardSidebar(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
".shiny-output-error:before { visibility: hidden; }"),
br(),
# Menu -------
sidebarMenu(id="tabs",
......@@ -455,7 +453,6 @@ source("config.R")
sidebar,
body)
### ----------------------------- Server logic -----------------------------------------------------
......@@ -482,7 +479,7 @@ server <- function(input, output, session) {
} else {
DefaultAssay(filedata$data) <- "RNA"
}
genesList <- rownames(filedata$data)
genesList <- rownames(filedata$data) # Genes lists updates
UpdateGeneslist(filedata$data, session, genesList, "genes_list_visu")
UpdateGeneslist(filedata$data, session, genesList, "genes_list_compare")
UpdateGeneslist(filedata$data, session, genesList, "genes_list_grid", selected_choice = "")
......@@ -551,7 +548,13 @@ server <- function(input, output, session) {
pt.size = input$ptsize_visu,
reduction=input$graph_visu,
group.by = input$class_selector_visu,
cols = as.character(eval(parse(text=paste0("all_class_colors_visu()$",input$class_selector_visu,"$color"))))), message = "Plot Generation", value=1) + NoLegend() + theme_bw() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$class_selector_visu)) + theme(aspect.ratio = 1)
cols = as.character(eval(parse(text=paste0("all_class_colors_visu()$",input$class_selector_visu,"$color"))))), message = "Plot Generation", value=1) +
NoLegend() +
theme_bw() +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +
NoAxes() +
ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$class_selector_visu)) +
theme(aspect.ratio = 1)
})
output$classplot_visu <-renderPlotly ({
req(filedata$data)
......@@ -569,7 +572,13 @@ server <- function(input, output, session) {
cols=c("lightgrey",plasma(200)),
pt.size = input$ptsize_visu,
features = featurevar,
reduction = input$graph_visu), message = "Plot Generation", value=1) + theme_bw() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) + theme(aspect.ratio = 1) + theme(legend.text = element_blank())
reduction = input$graph_visu), message = "Plot Generation", value=1) +
theme_bw() +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +
NoAxes() +
ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) +
theme(aspect.ratio = 1) +
theme(legend.text = element_blank())
})
output$featureplot_visu <-renderPlotly ({
......@@ -632,16 +641,19 @@ server <- function(input, output, session) {
output$status_heatmap <- renderText({""})
if (is.null(filedata$data@misc$markers[[input$class_selector_heatmap]])) { # Case where the markers are not pre-calculated for the selected class
showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
Idents(filedata$data) <<- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_heatmap)))))
tempmarkers <- withProgress(FindAllMarkers(filedata$data,
tempdata <- filedata$data # Tempfile for FindMarkers : allows to change Idents() with no bug ( using Idents(filedata$data) <<- ... was tested but is buggy)
Idents(tempdata) <- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_heatmap)))))
tempmarkers <- withProgress(FindAllMarkers(tempdata,
assay = 'SCT',
test.use = "MAST",
only.pos = TRUE,
min.pct = 0.25,
logfc.threshold = 0.25), message = "Calculating all markers. This may take a while...", value=1)
topgenes <- tempmarkers %>% group_by(cluster) %>% top_n(n = input$top_genes_number_heatmap, wt = avg_logFC)
datascale <- withProgress(ScaleData(object = filedata$data,
datascale <- withProgress(ScaleData(object = tempdata,
features = topgenes$gene), message = "Scaling data...", value=1)
tempmarkers <- NULL
tempdata <- NULL
} else { # Normal case
topgenes <- filedata$data@misc$markers[[input$class_selector_heatmap]] %>% group_by(cluster) %>% top_n(n = input$top_genes_number_heatmap, wt = avg_logFC)
datascale <- withProgress(ScaleData(object = filedata$data,
......@@ -649,7 +661,10 @@ server <- function(input, output, session) {
}
heatmap_Data <- withProgress(DoHeatmap(object = datascale,
features = topgenes$gene,
group.by=input$class_selector_heatmap), message = "Heatmap Generation", value=1) + NoLegend() + ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$class_selector_heatmap,"- top",input$top_genes_number_heatmap,"genes")) + theme(plot.title = element_text(size=20))
group.by=input$class_selector_heatmap), message = "Heatmap Generation", value=1) +
NoLegend() +
ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$class_selector_heatmap,"- top",input$top_genes_number_heatmap,"genes")) +
theme(plot.title = element_text(size=20))
output$heatmap <-renderPlot ({
req(filedata$data)
......@@ -684,8 +699,9 @@ server <- function(input, output, session) {
output$status_genes <- renderText({""})
if (is.null(filedata$data@misc$markers[[input$class_selector_genes]])) { # Case where the markers are not pre-calculated for the selected class
showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
Idents(filedata$data) <<- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_genes)))))
tempmarkers <- withProgress(FindAllMarkers(filedata$data,
tempdata <- filedata$data # Tempfile for FindMarkers : allows to change Idents() with no bug ( using Idents(filedata$data) <<- ... was tested but is buggy)
Idents(tempdata) <- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_genes)))))
tempmarkers <- withProgress(FindAllMarkers(tempdata,
assay = 'SCT',
test.use = "MAST",
only.pos = TRUE,
......@@ -693,6 +709,8 @@ server <- function(input, output, session) {
logfc.threshold = 0.25), message = "Calculating all markers. This may take a while...", value=1)
genes <- tempmarkers$cluster == input$group_selector_genes
genes <- tempmarkers$gene[genes]
tempmarkers <- NULL
tempdata <- NULL
} else { # Normal case
genes <- filedata$data@misc$markers[[input$class_selector_genes]]$cluster == input$group_selector_genes
genes <- filedata$data@misc$markers[[input$class_selector_genes]]$gene[genes]
......@@ -712,7 +730,9 @@ server <- function(input, output, session) {
} else {
goplot_Data <- emapplot(go_Data)
}
goplot_Data <- goplot_Data + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology_genes,"-",input$class_selector_genes)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
goplot_Data <- goplot_Data +
ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology_genes,"-",input$class_selector_genes)) +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
})
output$goplot_genes <-renderPlot ({
req(filedata$data)
......@@ -821,7 +841,12 @@ server <- function(input, output, session) {
legend="none",
reduction=input$graph_compare,
group.by = input$class_selector_compare,
cols = as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color"))) )), message = "Plot Generation", value=1) + theme_bw() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) + NoAxes() + NoLegend() + theme(aspect.ratio = 1)
cols = as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color"))) )), message = "Plot Generation", value=1) +
theme_bw() +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) +
NoAxes() +
NoLegend() +
theme(aspect.ratio = 1)
})
miniplot_compare2Data <- reactive ({ # Mini Plot 2 Compare page
......@@ -835,7 +860,13 @@ server <- function(input, output, session) {
cols=c("lightgrey",plasma(200)),
pt.size = input$ptsize_compare,
features = featurevar,
reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw()+ NoLegend() + NoAxes() + theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) + theme(aspect.ratio = 1) + theme(legend.text = element_blank())
reduction = input$graph_compare), message = "Plot Generation", value=1) +
theme_bw() +
NoLegend() +
NoAxes() +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=12),panel.grid.minor=element_blank(),plot.background=element_blank()) +
theme(aspect.ratio = 1) +
theme(legend.text = element_blank())
}
})
......@@ -870,7 +901,15 @@ server <- function(input, output, session) {
pt.size = input$ptsize_compare,
reduction=input$graph_compare,
group.by = input$class_selector_compare,
cols= c(as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color")))[which(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$group"))) %in% input$group_selector1_compare)]), "#000000")), message = "Plot Generation", value=1) + NoLegend() + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$class_selector_compare)) + Scalex(filedata$data, input$graph_compare) + Scaley(filedata$data, input$graph_compare) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + theme(aspect.ratio = 1)
cols= c(as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color")))[which(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$group"))) %in% input$group_selector1_compare)]), "#000000")), message = "Plot Generation", value=1) +
NoLegend() +
theme_bw() +
NoAxes() +
ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$class_selector_compare)) +
Scalex(filedata$data, input$graph_compare) +
Scaley(filedata$data, input$graph_compare) +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +
theme(aspect.ratio = 1)
} else {
if (input$feature_selector_compare =="d2") {
featurevar <- input$qv_selector_compare
......@@ -882,7 +921,15 @@ server <- function(input, output, session) {
cols = ScaleColors(filedata$data, featurevar, cells_to_plot1_compare),
pt.size = input$ptsize_compare,
features = featurevar,
reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw()+ NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + Scalex(filedata$data, input$graph_compare) + Scaley(filedata$data, input$graph_compare) + theme(aspect.ratio = 1) + theme(legend.text = element_blank())
reduction = input$graph_compare), message = "Plot Generation", value=1) +
theme_bw() +
NoAxes() +
ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +
Scalex(filedata$data, input$graph_compare) +
Scaley(filedata$data, input$graph_compare) +
theme(aspect.ratio = 1) +
theme(legend.text = element_blank())
}
# Right Plot Compare page
......@@ -892,7 +939,15 @@ server <- function(input, output, session) {
pt.size = input$ptsize_compare,
reduction = input$graph_compare,
group.by = input$class_selector_compare,
cols= c(as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color")))[which(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$group"))) %in% input$group_selector2_compare)]), "#000000")), message = "Plot Generation", value=1) + NoLegend() + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$class_selector_compare))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + Scalex(filedata$data, input$graph_compare) + Scaley(filedata$data, input$graph_compare) + theme(aspect.ratio = 1)
cols= c(as.character(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$color")))[which(eval(parse(text=paste0("all_class_colors_compare()$",input$class_selector_compare,"$group"))) %in% input$group_selector2_compare)]), "#000000")), message = "Plot Generation", value=1) +
NoLegend() +
theme_bw() +
NoAxes() +
ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$class_selector_compare)) +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +
Scalex(filedata$data, input$graph_compare) +
Scaley(filedata$data, input$graph_compare) +
theme(aspect.ratio = 1)
} else {
if (input$feature_selector_compare =="d2") {
featurevar <- input$qv_selector_compare
......@@ -904,7 +959,15 @@ server <- function(input, output, session) {
cols = ScaleColors(filedata$data, featurevar, cells_to_plot2_compare),
pt.size = input$ptsize_compare,
features = featurevar,
reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + Scalex(filedata$data, input$graph_compare) + Scaley(filedata$data, input$graph_compare) + theme(aspect.ratio = 1) + theme(legend.text = element_blank())
reduction = input$graph_compare), message = "Plot Generation", value=1) +
theme_bw() +
NoAxes() +
ggtitle(paste(file_path_sans_ext(filedata$name),"-", featurevar)) +
theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +
Scalex(filedata$data, input$graph_compare) +
Scaley(filedata$data, input$graph_compare) +
theme(aspect.ratio = 1) +
theme(legend.text = element_blank())
}
output$plot1_compare <- renderPlotly ({ # Output Plot 1
......@@ -1050,7 +1113,8 @@ server <- function(input, output, session) {
if (is.null(input$group_selector1_compare) || is.null(input$group_selector2_compare)) {
showModal(modalDialog("At least one of the select is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
} else if (input$add %% 2 != 0) { # Compare with 2 factors
# Compare with 2 factors
} else if (input$add %% 2 != 0) {
if ((input$add %% 2 !=0 && is.null(input$addgroup_selector1_compare)) || (input$add %% 2 !=0 && is.null(input$addgroup_selector2_compare))) {
showModal(modalDialog("At least one of the select is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
......@@ -1058,50 +1122,30 @@ server <- function(input, output, session) {
if ((length(intersect(input$addgroup_selector1_compare, input$addgroup_selector2_compare)) != 0) && (length(intersect(input$group_selector1_compare,input$group_selector2_compare)) != 0)){
showModal(modalDialog("Some cells are in common with your query. Please change some groups.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
} else {
if (!exists("ffm")) {
ffm <- filedata$data
}
Idents(object=ffm) <- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_compare))), eval(parse(text=paste0("filedata$data@meta.data$",input$add_class_selector_compare)))))
df <- withProgress(data.frame(FindMarkers(ffm, paste0(input$group_selector1_compare, input$addgroup_selector1_compare), paste0(input$group_selector2_compare, input$addgroup_selector2_compare), test.use = "MAST")), message = "Preparing data", value=1)
setDT(df, keep.rownames = TRUE)[]
df <- data.frame(c(df,(input$class_selector_compare)))
names(df)[[4]] <- paste("pct.",sapply(input$group_selector1_compare, paste, collapse=""), collapse=" + ","in",sapply(input$addgroup_selector1_compare, paste, collapse=""))
names(df)[[5]] <- paste("pct.",sapply(input$group_selector2_compare, paste, collapse=""), collapse=" + ","in",sapply(input$addgroup_selector2_compare, paste, collapse=""))
names(df)[[1]] <- "Gene"
names(df)[[7]] <- paste("",input$class_selector_compare)
leftgenes <- df %>% top_n(30, df$avg_logFC)
rightgenes <- df %>% top_n(-30, df$avg_logFC)
tempdata <- filedata$data # Tempfile for FindMarkers : allows to change Idents() with no bug ( using Idents(filedata$data) <<- ... was tested but is buggy)
Idents(object=tempdata) <- as.factor(paste0(eval(parse(text=paste0("filedata$data@meta.data$",input$class_selector_compare))), eval(parse(text=paste0("filedata$data@meta.data$",input$add_class_selector_compare)))))
findmarkers_compare_results <- FindMakersCompare(tempdata, input$group_selector1_compare, input$group_selector2_compare, input$addgroup_selector1_compare, input$addgroup_selector2_compare, input$class_selector_compare, "in")
tempdata <- NULL
}
}
} else { # Compare with 1 factor
# Compare with 1 factor
} else {
if (length(intersect(input$group_selector1_compare,input$group_selector2_compare)) != 0) {
showModal(modalDialog("You must only choose different groups when comparing with one class", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
} else {
if (!exists("ffm")) {
ffm <- filedata$data
}
Idents(object=ffm) <- input$class_selector_compare
df <- withProgress(data.frame(FindMarkers(ffm,
input$group_selector1_compare,
input$group_selector2_compare,
test.use = "MAST")), message = "Preparing data", value=1)
setDT(df, keep.rownames = TRUE)[]
df <- data.frame(c(df,(input$class_selector_compare)))
names(df)[[4]] <- paste("pct.",sapply(input$group_selector1_compare, paste, collapse=""), collapse=" + ")
names(df)[[5]] <- paste("pct.",sapply(input$group_selector2_compare, paste, collapse=""), collapse=" + ")
names(df)[[1]] <- "Gene"
names(df)[[7]] <- paste("",input$class_selector_compare)
leftgenes <- df %>% top_n(30, df$avg_logFC)
rightgenes <- df %>% top_n(-30, df$avg_logFC)
tempdata <- filedata$data # Tempfile for FindMarkers : allows to change Idents() with no bug ( using Idents(filedata$data) <<- ... was tested but is buggy)
Idents(object=tempdata) <- input$class_selector_compare
findmarkers_compare_results <- FindMakersCompare(tempdata, input$group_selector1_compare, input$group_selector2_compare, "", "", input$class_selector_compare, "")
tempdata <- NULL
}
}
# Then, in the 2 cases :
output$markers_table_compare <- renderDataTable ({
req(filedata$data)
withProgress(datatable(df[c(1,4,5,3,2,6)],
withProgress(datatable(findmarkers_compare_results$findmarkers_compareData[c(1,4,5,3,2,6)],
rownames=FALSE,
filter="top",
caption = "Table : Significant markers of your query | Test used : MAST" ), message = "Render DataTable", value=1) %>% formatRound(columns=c(1,2,3,4), digits=3) %>% formatSignif(columns=c(6,5), digits=3)
......@@ -1111,29 +1155,29 @@ server <- function(input, output, session) {
"Top 30 upregulated left genes",
"Data Summary",
width = "100px", height = "620px",
value = paste(sapply(leftgenes$Gene, paste, collapse=""), collapse="\n"))
value = paste(sapply(findmarkers_compare_results$leftgenes_compare$Gene, paste, collapse=""), collapse="\n"))
})
output$topgenes2_compare <- renderUI ({
textAreaInput("toplist2_compare",
"Top 30 upregulated right genes",
"Data Summary",
width = "100px", height = "620px",
value = paste(sapply(rightgenes$Gene, paste, collapse=""), collapse="\n"))
value = paste(sapply(findmarkers_compare_results$rightgenes_compare$Gene, paste, collapse=""), collapse="\n"))
})
output$dlmarkbutton_compare <- renderUI ({
downloadButton("dlmarkers_compare", label="Export Table")
})
output$dlmarkers_compare <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_markers_",names(df)[[7]],".csv")
paste0(file_path_sans_ext(filedata$name),"_markers_",names(findmarkers_compare_results$findmarkers_compareData)[[7]],".csv")
},
content = function(file) {
write.csv(df, file, row.names=FALSE)
write.csv(findmarkers_compare_results$findmarkers_compareData, file, row.names=FALSE)
}
)
})
## Compare Page 3 - FindOntology Left --------
## Compare Page 3 - FindOntology --------
observeEvent({list(input$findmarkers, input$group_selector1_compare,input$group_selector2_compare,input$addgroup_selector1_compare,input$addgroup_selector2_compare,
input$class_selector_compare,input$add_class_selector_compare,input$ontology_compare,input$toplist1_compare,input$toplist2_compare)},
{req(input$go_ontology_compare)
......@@ -1151,76 +1195,49 @@ server <- function(input, output, session) {
showModal(modalDialog("At least one of the text area is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
} else {
leftchain <- strsplit(input$toplist1_compare, "\n")
genesc <- bitr(leftchain[[1]],
fromType = "SYMBOL",
toType = "ENTREZID",
OrgDb = org.Hs.eg.db,drop = TRUE)
egoc <- withProgress(enrichGO(gene = genesc$ENTREZID,
OrgDb = "org.Hs.eg.db",
keyType= "ENTREZID",
ont = input$ontology_compare,
readable = TRUE), value = 1, message = "Ontology n°1 in progress...")
dfo <- data.table(egoc@result$Description, egoc@result$GeneRatio, egoc@result$pvalue, egoc@result$p.adjust)[which(egoc@result$Count > 2)]
colnames(dfo) <- c("Description","Gene Ratio","P-value","FDR")
GOleft_compareData <- FindOntologyCompare(input$toplist1_compare, input$ontology_compare)
GOright_compareData <- FindOntologyCompare(input$toplist2_compare, input$ontology_compare)
output$onto_compare1 <- renderDataTable ({
req(filedata$data)
withProgress(datatable(dfo,
withProgress(datatable(GOleft_compareData,
filter="top",
caption = paste("Table : Gene Ontology (",input$ontology_compare,") for the left selected group(s) and this class : ", input$class_selector_compare,"| Only takes groups with a ratio > 2/Total, p-value cutoff : 0.05")), value=1, message = "Rendering Datatable...") %>% formatSignif(columns=c(3,4), digits=3)
})
output$dlontobutton1_compare <- renderUI ({
downloadButton("dlonto1_compare", label="Export Table")
})
output$dlonto1_compare <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology_compare,"_datatable_",input$class_selector_compare,".csv")
},
content = function(file) {
write.csv(dfo, file, row.names=FALSE)
write.csv(GOleft_compareData, file, row.names=FALSE)
}
)
}
})
## Compare Page 3 bis- FindOntology Right --------
observeEvent(input$go_ontology_compare, {
if (is.null(input$toplist1_compare) || is.null(input$toplist2_compare)) {
showModal(modalDialog("At least one of the text area is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
} else {
rightchain <- strsplit(input$toplist2_compare, "\n")
genesc <- bitr(rightchain[[1]],
fromType = "SYMBOL",
toType = "ENTREZID",
OrgDb = org.Hs.eg.db,drop = TRUE)
egoc <- withProgress(enrichGO(gene = genesc$ENTREZID,
OrgDb = "org.Hs.eg.db",
keyType= "ENTREZID",
ont = input$ontology_compare,
readable = TRUE), value = 1, message = "Ontology n°2 in progress...")
dfo <- data.table(egoc@result$Description, egoc@result$GeneRatio, egoc@result$pvalue, egoc@result$p.adjust)[which(egoc@result$Count > 2)]
colnames(dfo) <- c("Description","Gene Ratio","P-value","FDR")
output$onto_compare2 <- renderDataTable ({
req(filedata$data)
withProgress(datatable(dfo, filter="top", caption = paste("Table : Gene Ontology (",input$ontology_compare,") for the right selected group(s) and this class : ", input$class_selector_compare,"| Only takes groups with a ratio > 2/Total, p-value cutoff : 0.05")), value=1, message = "Rendering Datatable...") %>% formatSignif(columns=c(3,4), digits=3)
withProgress(datatable(GOright_compareData, filter="top", caption = paste("Table : Gene Ontology (",input$ontology_compare,") for the right selected group(s) and this class : ", input$class_selector_compare,"| Only takes groups with a ratio > 2/Total, p-value cutoff : 0.05")), value=1, message = "Rendering Datatable...") %>% formatSignif(columns=c(3,4), digits=3)
})
output$dlontobutton2_compare <- renderUI ({
downloadButton("dlonto2_compare", label="Export Table")
})
output$dlonto2_compare <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology_compare,"_datatable_",input$class_selector_compare,".csv")
},
content = function(file) {
write.csv(dfo, file, row.names=FALSE)
write.csv(GOright_compareData, file, row.names=FALSE)
}
)
}
})
## Grid Page --------
observeEvent({list(input$ptsize_grid, input$graph_grid, input$genes_list_grid, input$ncolumns_grid)},
{req(input$gridgraphs)
......@@ -1250,7 +1267,13 @@ server <- function(input, output, session) {
pt.size = input$ptsize_grid,
features = c(input$genes_list_grid),
reduction = input$graph_grid, combine=FALSE), message = "Plot(s) Generation", value=1)
gridData <- lapply(X = gridData, FUN = function(x) x + theme(plot.title = element_text(size = 25)) + NoLegend() + NoAxes() + theme(panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank()) + theme(aspect.ratio = 1) + theme(legend.text = element_blank()) )
gridData <- lapply(X = gridData, FUN = function(x) x +
theme(plot.title = element_text(size = 25)) +
NoLegend() +
NoAxes() +
theme(panel.grid.major=element_blank(),panel.grid.minor=element_blank(),plot.background=element_blank()) +
theme(aspect.ratio = 1) +
theme(legend.text = element_blank()) )
gridData <- CombinePlots(gridData,
ncol=input$ncolumns_grid)
......@@ -1306,8 +1329,7 @@ server <- function(input, output, session) {
{ LinkClassChoices(session, "class_selector_visu", "class_selector_compare", "class_selector_heatmap", input$class_selector_genes)},ignoreNULL = FALSE)
observeEvent ({input$class_selector_compare}, # Compare page
{ LinkClassChoices(session, "class_selector_visu", "class_selector_heatmap", "class_selector_genes", input$class_selector_compare)},ignoreNULL = FALSE)
## Filter by Groups --------
output$group_genes <- renderUI ({ # Group choice in Genes page
GroupChoices(filedata$data, input$class_selector_genes, "group_selector_genes")})
......@@ -1323,7 +1345,6 @@ server <- function(input, output, session) {
req(input$add %% 2 != 0)
GroupChoices(filedata$data, input$add_class_selector_compare, "addgroup_selector2_compare")})
## Help messages --------
observeEvent (input$help_visu, {showModal(modalDialog(HelptextVisu(), title=strong("Vizualisation page Help"), easyClose=TRUE, footer = NULL))})
observeEvent (input$help_heatmap, {showModal(modalDialog(HelptextHeatmap(), title=strong("Heatmap page Help"), easyClose=TRUE, footer = NULL))})
......
......@@ -69,7 +69,7 @@ print("The Grid page allows a great visualization for genes plots.
In this page, you could choose many genes to visualize. Some presets are available to show genes plots depending a cell type, a pathway, ...
You could also change some parameters, like the graph mode or the number of columns you want.
The grid plot is exportable in .png.")}
## Functions to customize the Grid Presets ----
## Grid page : Functions to customize the Grid Presets ----
# First : if you want to add a preset, add it into "choices" here :
PresetsGrid <- function() {
selectInput(inputId = "presets_grid",
......
......@@ -94,7 +94,7 @@ SelectionInformation <- function(obj, input_class_selector) {
}
## Compare : Data for the plots function ----
## Compare page : Data for the plots function ----
CellsToPlot <- function(obj, class, group, add, addclass, addgroup) {
data <- SubsetData(object = obj,
cells=rownames(obj@meta.data)[which(eval(parse(text=paste0("obj@meta.data$",class))) %in% group)] )
......@@ -104,16 +104,50 @@ CellsToPlot <- function(obj, class, group, add, addclass, addgroup) {
}
return(data)
}
## Compare : Meta.data for csv export function ----
## Compare page : Meta.data for csv export function ----
MetaData <- function(cells, obj) {
data <- data.frame(FetchData(cells,
names(rapply(obj@meta.data, class=c("factor","character","numeric","integer"), f=class))))
}
## Compare : Scale color for feature plots ----
## Compare page : Scale color for feature plots ----
ScaleColors <- function(obj, var, cells) {
palette.full <- c("lightgrey", plasma(200))
data.max.global <- max(FetchData(obj, var))
data.max.local <- max(FetchData(cells, var))
palette.local <- palette.full[1:ceiling(length(palette.full) * data.max.local / data.max.global)]
return(palette.local)
}
## Compare page : Custom FindMarkers function ----
FindMakersCompare <- function(tempdata, group1, group2, addgroup1, addgroup2, class, word) {
df <- withProgress(data.frame(FindMarkers(tempdata,
paste0(group1, addgroup1),
paste0(group2, addgroup2),
test.use = "MAST")), message = "Preparing data", value=1)
setDT(df, keep.rownames = TRUE)[]
df <- data.frame(c(df,(class)))
names(df)[[4]] <- paste("pct.",sapply(group1, paste, collapse=""), collapse=" + ",as.character(word),sapply(addgroup1, paste, collapse=""))
names(df)[[5]] <- paste("pct.",sapply(group2, paste, collapse=""), collapse=" + ",as.character(word),sapply(addgroup2, paste, collapse=""))
names(df)[[1]] <- "Gene"
names(df)[[7]] <- paste("",class)
leftgenes <- df %>% top_n(30, df$avg_logFC)
rightgenes <- df %>% top_n(-30, df$avg_logFC)
findmarkers_compare_results <- list("findmarkers_compareData" = df, "leftgenes_compare" = leftgenes, "rightgenes_compare" = rightgenes)
return(findmarkers_compare_results)
}
## Compare page : Gene Ontology function ----
FindOntologyCompare <- function(gene_list, ontology_mode) {
gene_chain <- strsplit(gene_list, "\n")
genes <- bitr(gene_chain[[1]],
fromType = "SYMBOL",
toType = "ENTREZID",
OrgDb = org.Hs.eg.db,drop = TRUE)
gene_ontology <- withProgress(enrichGO(gene = genes$ENTREZID,
OrgDb = "org.Hs.eg.db",
keyType= "ENTREZID",
ont = ontology_mode,
readable = TRUE), value = 1, message = "Ontology in progress...")
GOdata <- data.table(gene_ontology@result$Description, gene_ontology@result$GeneRatio, gene_ontology@result$pvalue, gene_ontology@result$p.adjust)[which(gene_ontology@result$Count > 2)]
colnames(GOdata) <- c("Description","Gene Ratio","P-value","FDR")
return(GOdata)
}
\ No newline at end of file
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