Commit bda07c44 authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

improvment

parent 1fab6a6f
......@@ -177,8 +177,8 @@ body <- dashboardBody(
uiOutput(outputId = "clusters_infos"),
verbatimTextOutput(outputId = "select_infos"),
br(),
fluidRow(column(align="center", width = 6, plotlyOutput("plot_factors", width="500", height="500"), uiOutput("fchoice"),downloadButton("dlleftplot", label="")),
column(align="center", width = 6, plotlyOutput("plot_numerics", width="500", height="500"),uiOutput("featurechoice"), uiOutput("nchoice"),
fluidRow(column(align="center", width = 6, plotlyOutput("plot_factors", width='500px', height='500px'), uiOutput("fchoice"),downloadButton("dlleftplot", label="")),
column(align="center", width = 6, plotlyOutput("plot_numerics", width='500px', height='500px'),uiOutput("featurechoice"), uiOutput("nchoice"),
conditionalPanel(condition ="input.featuresel == 'g'", selectizeInput(inputId="genes", label="Choose a gene :", choices ="")),downloadButton("dlrightplot", label=""))# br(), verbatimTextOutput(outputId="genes_analyse"))
),
hr(),
......@@ -220,9 +220,9 @@ body <- dashboardBody(
uiOutput(outputId = "clusters_infos_compare"),
br(),
conditionalPanel(condition="output.fileUploaded",
fluidRow(column(align="center", width = 2, plotOutput(outputId="miniplot_compare", width="225px", height="225px"), br(), plotOutput(outputId="miniplot_compare2", width="225px", height="225px"), uiOutput("fchoice2"), div(actionLink("add", "", icon = icon("far fa-plus-square")), align="center"), uiOutput("addf")),
column(align="center", width = 5, plotlyOutput("plot1_compare", width="450px", height="450px"), br(), uiOutput("plot1_library"), br(), uiOutput("addg1"), br(), downloadButton("dl_compare1", label=""), downloadButton("dl_comparebarcodes1", label="Export barcodes")),
column(align="center", width = 5, plotlyOutput("plot2_compare", width="450px", height="450px"), br(), uiOutput("plot2_library"), br(), uiOutput("addg2"), br(), downloadButton("dl_compare2", label=""), downloadButton("dl_comparebarcodes2", label="Export barcodes"))
fluidRow(column(align="center", width = 2, plotOutput(outputId="miniplot_compare", width="225px", height="225px"), br(), plotOutput(outputId="miniplot_compare2", width="225px", height="225px"), br(), br(), uiOutput("fchoice2"), div(actionLink("add", "", icon = icon("far fa-plus-square")), align="center"), uiOutput("addf"), br(), actionButton("gographs", icon = icon("far fa-arrow-alt-circle-right"), label="Do Graphs")),
column(align="center", width = 5, plotlyOutput("plot1_compare", width="490px", height="490px"), br(), uiOutput("plot1_library"), br(), uiOutput("addg1"), br(), downloadButton("dl_compare1", label=""), downloadButton("dl_comparebarcodes1", label="Export barcodes")),
column(align="center", width = 5, plotlyOutput("plot2_compare", width="490px", height="490px"), br(), uiOutput("plot2_library"), br(), uiOutput("addg2"), br(), downloadButton("dl_compare2", label=""), downloadButton("dl_comparebarcodes2", label="Export barcodes"))
),
hr(),
br(),
......@@ -351,14 +351,14 @@ server <- function(input, output, session) {
})
factorsplotData <- reactive ({ # Left Graph Visu page
withProgress(DimPlot(object = wrfile(), label=FALSE, pt.size = input$ptsize, reduction=input$graph, group.by = input$fsel, cols = as.character(eval(parse(text=paste0("alldf()$",input$fsel,"$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$fsel)) + theme(aspect.ratio = 1)
})
withProgress(DimPlot(object = wrfile(), label=FALSE, pt.size = input$ptsize, reduction=input$graph, group.by = input$fsel, cols = as.character(eval(parse(text=paste0("alldf()$",input$fsel,"$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$fsel)) + theme(aspect.ratio = 1)
})
numericsplotData <- reactive ({ # Right Graph Visu page
if (input$featuresel =="d") {
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(20)), pt.size = input$ptsize, features = input$nsel, reduction = input$graph), 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),"-", input$nsel)) + theme(aspect.ratio = 1)
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize, features = input$nsel, reduction = input$graph), 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),"-", input$nsel)) + theme(aspect.ratio = 1)
} else if (input$featuresel =="g") {
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(20)), pt.size = input$ptsize, features = input$genes, reduction = input$graph), 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),"-", input$genes)) + theme(aspect.ratio = 1)
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize, features = input$genes, reduction = input$graph), 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),"-", input$genes))+ theme(aspect.ratio = 1)
}
})
......@@ -370,76 +370,14 @@ server <- function(input, output, session) {
miniplot_compare2Data <- reactive ({ # Mini Graph 2 Compare page
if (input$choice_compare == "features_compare") {
if (input$featuresel2 =="d2") {
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(20)), pt.size = input$ptsize_compare, features = input$nsel2, 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)
} else if (input$featuresel2 =="g2") {
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(20)), pt.size = input$ptsize_compare, features = input$genes2, 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)
}
}
})
cells_to_plot1 <- reactive({ # Data for Compare Left Graph
if (input$add %% 2 != 0) {
subset1 <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library1_compare)] )
selectedCells <- SubsetData(object = subset1, cells=rownames(subset1@meta.data)[which(eval(parse(text=paste0("subset1@meta.data$",input$add_factor))) %in% input$add_group1)])
} else {
selectedCells <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library1_compare)] )
}
return(selectedCells)
})
plot1_compareData <- reactive ({ # Left Graph Compare page
scalex <- scale_x_continuous(limits = c(min(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,1]), max(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,1])))
scaley <- scale_y_continuous(limits = c(min(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,2]), max(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,2])))
if (input$choice_compare == "f_compare") {
withProgress(DimPlot(object = wrfile(), cells=rownames(cells_to_plot1()@meta.data), label=FALSE, pt.size = input$ptsize_compare, reduction=input$graph_compare, group.by = input$fsel2, cols= c(as.character(eval(parse(text=paste0("alldf()$",input$fsel2,"$color")))[which(eval(parse(text=paste0("alldf()$",input$fsel2,"$group"))) %in% input$library1_compare)]), "#000000")), message = "Plot Generation", value=1) + NoLegend() + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$fsel2)) + scalex + scaley + 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 {
palette.full <- c("lightgrey", plasma(20))
if (input$featuresel2 =="d2") {
data.max.global <- max(FetchData(wrfile(), input$nsel2))
data.max.local <- max(FetchData(cells_to_plot1(), input$nsel2))
palette.local <- palette.full[1:ceiling(length(palette.full) * data.max.local / data.max.global)]
withProgress(FeaturePlot(object = wrfile(), cells=rownames(cells_to_plot1()@meta.data), cols=palette.local, pt.size = input$ptsize_compare, features = input$nsel2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw()+ NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$nsel2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + scalex + scaley + theme(aspect.ratio = 1)
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_compare, features = input$nsel2, 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)
} else if (input$featuresel2 =="g2") {
gene.max.global <- max(FetchData(wrfile(), input$genes2))
gene.max.local <- max(FetchData(cells_to_plot1(), input$genes2))
palette.local <- palette.full[1:ceiling(length(palette.full) * gene.max.local / gene.max.global)]
withProgress(FeaturePlot(object = wrfile(), cols=palette.local, cells=rownames(cells_to_plot1()@meta.data), pt.size = input$ptsize_compare, features = input$genes2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$genes2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +scalex + scaley+ theme(aspect.ratio = 1)
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_compare, features = input$genes2, 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)
}
}
})
cells_to_plot2 <- reactive({ # Data for Compare Right Graph
if (input$add %% 2 != 0) {
subset2 <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library2_compare)] )
selectedCells2 <- SubsetData(object = subset2, cells=rownames(subset2@meta.data)[which(eval(parse(text=paste0("subset2@meta.data$",input$add_factor))) %in% input$add_group2)])
} else {
selectedCells2 <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library2_compare)] )
}
return(selectedCells2)
})
plot2_compareData <- reactive ({ # Right Graph Compare page
scalex <- scale_x_continuous(limits = c(min(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,1]), max(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,1])))
scaley <- scale_y_continuous(limits = c(min(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,2]), max(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,2])))
if (input$choice_compare == "f_compare") {
withProgress(DimPlot(object = wrfile(), cells=rownames(cells_to_plot2()@meta.data), pt.size = input$ptsize_compare, reduction=input$graph_compare, group.by = input$fsel2, cols= c(as.character(eval(parse(text=paste0("alldf()$",input$fsel2,"$color")))[which(eval(parse(text=paste0("alldf()$",input$fsel2,"$group"))) %in% input$library2_compare)]), "#000000")), message = "Plot Generation", value=1) + NoLegend() + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$fsel2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + scalex + scaley + theme(aspect.ratio = 1)
} else {
palette.full <- c("lightgrey", plasma(20))
if (input$featuresel2 =="d2") {
data.max.global <- max(FetchData(wrfile(), input$nsel2))
data.max.local <- max(FetchData(cells_to_plot2(), input$nsel2))
palette.local <- palette.full[1:ceiling(length(palette.full) * data.max.local / data.max.global)]
withProgress(FeaturePlot(object = wrfile(), cells=rownames(cells_to_plot2()@meta.data), cols=palette.local, pt.size = input$ptsize_compare, features = input$nsel2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$nsel2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + scalex + scaley + theme(aspect.ratio = 1)
} else if (input$featuresel2 =="g2") {
gene.max.global <- max(FetchData(wrfile(), input$genes2))
gene.max.local <- max(FetchData(cells_to_plot2(), input$genes2))
palette.local <- palette.full[1:ceiling(length(palette.full) * gene.max.local / gene.max.global)]
withProgress(FeaturePlot(object = wrfile(), cols=palette.local, cells=rownames(cells_to_plot2()@meta.data), pt.size = input$ptsize_compare, features = input$genes2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$genes2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + scalex + scaley + theme(aspect.ratio = 1)
}
}
})
## Graphs & Tables Outputs --------
output$plot_factors <-renderPlotly ({
req(wrfile())
......@@ -467,24 +405,9 @@ server <- function(input, output, session) {
plot(miniplot_compare2Data())
})
output$plot1_compare <- renderPlotly ({
req(wrfile())
if (input$choice_compare == "features_compare") {
ggplotly(plot1_compareData(),tooltip ="none") %>% config(displaylogo = F, modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
} else {
ggplotly(plot1_compareData(),tooltip = c("colour","x","y")) %>% config(displaylogo = F, modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
}
})
output$plot2_compare <- renderPlotly ({
req(wrfile())
if (input$choice_compare == "features_compare") {
ggplotly(plot2_compareData(),tooltip ="none") %>% config(displaylogo = F, modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
} else {
ggplotly(plot2_compareData(),tooltip = c("colour","x","y")) %>% config(displaylogo = F, modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
}
})
## Grid Genes Miniplots Generation & Outputs --------
output$minigenes <- renderPlot({
......@@ -493,16 +416,17 @@ server <- function(input, output, session) {
})
gridData <- reactive ({ # Grid MiniGraph
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_grid, features = c(input$listminigenes), reduction = input$graph_grid), 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())
withProgress(FeaturePlot(object = wrfile(), cols=c("lightgrey",plasma(200)), pt.size = input$ptsize_grid, features = c(input$listminigenes), reduction = input$graph_grid), 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())
})
## Heatmap Generation & Output --------
## Heatmap Generation, Output & Download --------
output$heat_numb <- renderUI ({
sliderInput("top_number", label="Choose the number of top genes :", min=1, max=10, step=1, value=3)
})
heatmapData <- reactive ({
req(input$goheatmap)
observeEvent(input$goheatmap, {
if (is.null(wrfile()@misc$markers[[input$fsel3]])) {
showModal(modalDialog("The markers may have not been calculated for this factor yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
tempfile <- wrfile()
......@@ -514,21 +438,37 @@ server <- function(input, output, session) {
} else {
topgenes <- wrfile()@misc$markers[[input$fsel3]] %>% group_by(cluster) %>% top_n(n = input$top_number, wt = avg_logFC)
datascale <- withProgress(ScaleData(object = wrfile(), features = topgenes$gene), message = "Scaling data...", value=1)
withProgress(DoHeatmap(object = datascale, features = topgenes$gene, group.by=input$fsel3), message = "Heatmap Generation", value=1) + NoLegend() + ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$fsel3,"- top",input$top_number,"genes")) + theme(plot.title = element_text(size=20))
heatmap <- withProgress(DoHeatmap(object = datascale, features = topgenes$gene, group.by=input$fsel3), message = "Heatmap Generation", value=1) + NoLegend() + ggtitle(paste(file_path_sans_ext(filedata$name),"- Heatmap -", input$fsel3,"- top",input$top_number,"genes")) + theme(plot.title = element_text(size=20))
}
})
output$heatmap <-renderPlot ({
req(wrfile())
heatmapData()
heatmap
})
output$dlheat <- renderUI ({ # Download
downloadButton("dl_heatmap", label="")
})
output$dl_heatmap <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_heatmap_",input$fsel3,"_top",input$top_number,"genes",".png")
},
content = function(file) {
png(file, width = 800, height = 600)
print(heatmap)
dev.off()
}
)
})
## Genes Page --------
observeEvent(input$gogo, {
if (is.null(input$group_genepage)) {
showModal(modalDialog("You must choose at least one group to do the Gene Ontology.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
}
})
egot <- reactive({
} else {
if (is.null(wrfile()@misc$markers[[input$fsel4]])) {
showModal(modalDialog("The markers may have not been calculated for this factor yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
tempfile <- wrfile()
......@@ -542,99 +482,48 @@ server <- function(input, output, session) {
}
genes <- bitr(genes, fromType = "SYMBOL",toType = "ENTREZID",OrgDb = org.Hs.eg.db,drop = TRUE)
ego <- withProgress(enrichGO(gene = genes$ENTREZID, OrgDb = "org.Hs.eg.db", keyType= "ENTREZID", ont = input$ontology, readable = TRUE), value = 1, message = "Ontology in progress...")
return(ego)
})
goplotData <- reactive ({ # Ontology Graph
req(input$gogo)
req(!is.null(input$group_genepage))
isolate ({
req(!is.null(input$group_genepage)) # Graph data
req(input$gogo)
if (input$gographtype == "dplot") {
dotplot(egot()) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
goplotData <- dotplot(ego) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
} else if (input$gographtype == "bplot") {
barplot(egot(), drop=TRUE) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
goplotData <- barplot(ego, drop=TRUE) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
} else {
emapplot(egot()) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
goplotData <- emapplot(ego) + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$ontology,"-",input$fsel4)) + theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank())
}
})
})
output$goplot <-renderPlot ({
req(wrfile())
goplotData()
goplotData
})
dtgoData <- reactive ({ # Genes Table
filegene <- wrfile()
req(input$gogo)
req(!is.null(input$group_genepage)) # Genes Table
filegene <- wrfile()
Idents(filegene) <- as.factor(paste0(eval(parse(text=paste0("filegene@meta.data$",input$fsel4)))))
dtgenes <- data.table(filegene@misc$markers[[input$fsel4]]$gene[which(eval(parse(text=paste0("filegene@misc$markers$",input$fsel4,"$cluster"))) %in% input$group_genepage)])
setDT(dtgenes)[]
names(dtgenes)[1] <- "Gene"
return(dtgenes)
})
dtgoData <- data.table(filegene@misc$markers[[input$fsel4]]$gene[which(eval(parse(text=paste0("filegene@misc$markers$",input$fsel4,"$cluster"))) %in% input$group_genepage)])
setDT(dtgoData)[]
names(dtgoData)[1] <- "Gene"
output$dtgenes <-renderDataTable ({
req(wrfile())
req(!is.null(input$group_genepage))
datatable(dtgoData(), filter="top", caption = paste("Table : Markers for the following group(s) : ",paste(sapply(input$group_genepage, paste, collapse=""), collapse=" + "), "and this factor : ", input$fsel4))
})
datatable(dtgoData, filter="top", caption = paste("Table : Markers for the selected group(s) and factor"))
})
dtontoData <- reactive ({ # Ontology Table
filegene <- wrfile()
req(input$gogo)
Idents(filegene) <- as.factor(paste0(eval(parse(text=paste0("filegene@meta.data$",input$fsel4)))))
dtonto <- data.table(egot()$Description, egot()$GeneRatio, egot()$pvalue, egot()$p.adjust, egot()$geneID)[which(egot()$Count > 3)]
colnames(dtonto) <- c("Description","Gene Ratio","P-value","FDR","GeneID")
return(dtonto)
})
req(!is.null(input$group_genepage)) # Ontology Table
dtontoData <- data.table(ego$Description, ego$GeneRatio, ego$pvalue, ego$p.adjust, ego$geneID)[which(ego$Count > 3)]
colnames(dtontoData) <- c("Description","Gene Ratio","P-value","FDR","GeneID")
output$dtonto <-renderDataTable ({
req(wrfile())
req(!is.null(input$group_genepage))
datatable(dtontoData(), filter="top", caption = paste("Table : Gene Ontology (",input$ontology,") for the following group(s) : ",paste(sapply(input$group_genepage, paste, collapse=""), collapse=" + "), "and this factor : ", input$fsel4,"| Only takes groups with a ratio > 3/Total, p-value cutoff : 0.05")) %>% formatSignif(columns=c(3,4), digits=3)
})
## Downloads functions --------
output$dlmarkbutton_visu <- renderUI ({ # visualization Page
req(markersData() != "")
downloadButton("dlmarkers", label="")
datatable(dtontoData, filter="top", caption = paste("Table : Gene Ontology for the selected group(s) and factor | Only takes groups with a ratio > 3/Total, p-value cutoff : 0.05")) %>% formatSignif(columns=c(3,4), digits=3)
})
output$dlmarkers <- downloadHandler( # visualization Page
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_allmarkers_",input$fchoice,".csv")
},
content = function(file) {
write.csv(markersData(), file)
}
)
output$dlleftplot <- downloadHandler( # visualization Page
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_plot_",input$fsel,"_",input$graph,".svg")
},
content = function(file) {
svg(file)
print(factorsplotData())
dev.off()
}
)
output$dlrightplot <- downloadHandler( # visualization Page
filename = function() {
if (input$featuresel =="g") {
paste0(file_path_sans_ext(filedata$name),"_",input$genes,"_plot_",input$graph,".svg")
} else {
paste0(file_path_sans_ext(filedata$name),"_",input$nsel,"_plot_",input$graph,".svg")
}
},
content = function(file) {
svg(file)
print(numericsplotData())
dev.off()
}
)
output$dlgenegraph <- renderUI ({ # Genes Page
req(goplotData() !="")
output$dlgenegraph <- renderUI ({ # Download
downloadButton("dl_gene", label="")
})
output$dl_gene <- downloadHandler(
......@@ -649,13 +538,12 @@ server <- function(input, output, session) {
},
content = function(file) {
png(file, width = 800, height = 600)
print(goplotData())
print(goplotData)
dev.off()
}
)
output$dlgenedt <- renderUI ({ # Genes Page
req(dtgoData() !="")
output$dlgenedt <- renderUI ({ # Download
downloadButton("dl_godt", label="")
})
output$dl_godt <- downloadHandler(
......@@ -663,13 +551,11 @@ server <- function(input, output, session) {
paste0(file_path_sans_ext(filedata$name),"_genes_datatable_",input$fsel4,".csv")
},
content = function(file) {
write.csv(dtgoData(), file)
write.csv(dtgoData, file)
}
)
output$dlontodt <- renderUI ({ # Genes Page
req(dtgoData() !="")
output$dlontodt <- renderUI ({ # Download
downloadButton("dl_ontodt", label="")
})
output$dl_ontodt <- downloadHandler(
......@@ -677,84 +563,52 @@ server <- function(input, output, session) {
paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology,"_datatable_",input$fsel4,".csv")
},
content = function(file) {
write.csv(dtontoData(), file)
write.csv(dtontoData, file)
}
)
}
})
output$dlheat <- renderUI ({ # Heatmap Page
req(heatmapData() !="")
downloadButton("dl_heatmap", label="")
## Other Downloads functions --------
output$dlmarkbutton_visu <- renderUI ({ # visualization Page
req(markersData() != "")
downloadButton("dlmarkers", label="")
})
output$dl_heatmap <- downloadHandler(
output$dlmarkers <- downloadHandler( # visualization Page
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_heatmap_",input$fsel3,"_top",input$top_number,"genes",".png")
paste0(file_path_sans_ext(filedata$name),"_allmarkers_",input$fchoice,".csv")
},
content = function(file) {
png(file, width = 800, height = 600)
print(heatmapData())
dev.off()
write.csv(markersData(), file)
}
)
output$dl_compare1 <- downloadHandler( # Compare Page
output$dlleftplot <- downloadHandler( # visualization Page
filename = function() {
if (input$choice_compare == "f_compare") {
paste0(file_path_sans_ext(filedata$name),"_plot_",input$fsel2,"_",input$graph_compare,".svg")
} else {
if (input$featuresel2 =="g2") {
paste0(file_path_sans_ext(filedata$name),"_",input$genes2,"_plot_",input$graph_compare,".svg")
} else {
paste0(file_path_sans_ext(filedata$name),"_",input$nsel2,"_plot_",input$graph_compare,".svg")
}
}
paste0(file_path_sans_ext(filedata$name),"_plot_",input$fsel,"_",input$graph,".svg")
},
content = function(file) {
svg(file)
print(plot1_compareData())
dev.off()
}
print(factorsplotData())
dev.off()
}
)
output$dl_compare2 <- downloadHandler( # Compare Page
output$dlrightplot <- downloadHandler( # visualization Page
filename = function() {
if (input$choice_compare == "f_compare") {
paste0(file_path_sans_ext(filedata$name),"_plot_",input$fsel2,"_",input$graph_compare,".svg")
if (input$featuresel =="g") {
paste0(file_path_sans_ext(filedata$name),"_",input$genes,"_plot_",input$graph,".svg")
} else {
if (input$featuresel2 =="g2") {
paste0(file_path_sans_ext(filedata$name),"_",input$genes2,"_plot_",input$graph_compare,".svg")
} else {
paste0(file_path_sans_ext(filedata$name),"_",input$nsel2,"_plot_",input$graph_compare,".svg")
}
paste0(file_path_sans_ext(filedata$name),"_",input$nsel,"_plot_",input$graph,".svg")
}
},
content = function(file) {
svg(file)
print(plot2_compareData())
print(numericsplotData())
dev.off()
}
)
output$dl_comparebarcodes1 <- downloadHandler( # Compare Page
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_selectedbarcodes.csv")
},
content = function(file) {
write.csv(cbar1Data(), file)
}
)
output$dl_comparebarcodes2 <- downloadHandler( # Compare Page
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_selectedbarcodes.csv")
},
content = function(file) {
write.csv(cbar2Data(), file)
}
)
output$dlgrid <- renderUI ({ # Grid Page
req(gridData() != "")
......@@ -983,6 +837,167 @@ server <- function(input, output, session) {
showModal(modalDialog("The Grid !", title=strong("Grid page Help"), easyClose=TRUE, footer = NULL )
)
})
## Compare Page - Graphs generations, outputs and downloads --------
observeEvent (input$gographs, {
cells_to_plot1 <- reactive({ # Data for Compare Left Graph
if (input$add %% 2 != 0) {
subset1 <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library1_compare)] )
selectedCells <- SubsetData(object = subset1, cells=rownames(subset1@meta.data)[which(eval(parse(text=paste0("subset1@meta.data$",input$add_factor))) %in% input$add_group1)])
} else {
selectedCells <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library1_compare)] )
}
return(selectedCells)
})
plot1_compareData <- reactive ({ # Left Graph Compare page
scalex <- scale_x_continuous(limits = c(min(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,1]), max(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,1])))
scaley <- scale_y_continuous(limits = c(min(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,2]), max(wrfile()@reductions[[input$graph_compare]]@cell.embeddings[,2])))
if (input$choice_compare == "f_compare") {
withProgress(DimPlot(object = wrfile(), cells=rownames(cells_to_plot1()@meta.data), label=FALSE, pt.size = input$ptsize_compare, reduction=input$graph_compare, group.by = input$fsel2, cols= c(as.character(eval(parse(text=paste0("alldf()$",input$fsel2,"$color")))[which(eval(parse(text=paste0("alldf()$",input$fsel2,"$group"))) %in% input$library1_compare)]), "#000000")), message = "Plot Generation", value=1) + NoLegend() + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-",input$fsel2)) + scalex + scaley + 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 {
palette.full <- c("lightgrey", plasma(200))
if (input$featuresel2 =="d2") {
data.max.global <- max(FetchData(wrfile(), input$nsel2))
data.max.local <- max(FetchData(cells_to_plot1(), input$nsel2))
palette.local <- palette.full[1:ceiling(length(palette.full) * data.max.local / data.max.global)]
withProgress(FeaturePlot(object = wrfile(), cells=rownames(cells_to_plot1()@meta.data), cols=palette.local, pt.size = input$ptsize_compare, features = input$nsel2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw()+ NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$nsel2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) + scalex + scaley + theme(aspect.ratio = 1)
} else if (input$featuresel2 =="g2") {
gene.max.global <- max(FetchData(wrfile(), input$genes2))
gene.max.local <- max(FetchData(cells_to_plot1(), input$genes2))
palette.local <- palette.full[1:ceiling(length(palette.full) * gene.max.local / gene.max.global)]
withProgress(FeaturePlot(object = wrfile(), cols=palette.local, cells=rownames(cells_to_plot1()@meta.data), pt.size = input$ptsize_compare, features = input$genes2, reduction = input$graph_compare), message = "Plot Generation", value=1) + theme_bw() + NoAxes() + ggtitle(paste(file_path_sans_ext(filedata$name),"-", input$genes2))+ theme(panel.grid.major=element_blank(),plot.title = element_text(size=18),panel.grid.minor=element_blank(),plot.background=element_blank()) +scalex + scaley+ theme(aspect.ratio = 1)
}
}
})
cells_to_plot2 <- reactive({ # Data for Compare Right Graph
if (input$add %% 2 != 0) {
subset2 <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library2_compare)] )
selectedCells2 <- SubsetData(object = subset2, cells=rownames(subset2@meta.data)[which(eval(parse(text=paste0("subset2@meta.data$",input$add_factor))) %in% input$add_group2)])
} else {
selectedCells2 <- SubsetData(object = wrfile(), cells=rownames(wrfile()@meta.data)[which(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))) %in% input$library2_compare)] ) <