Commit 3bd0e251 authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

- Ajout du texte indiquant le recalcul, et supression de l'actualisation...

- Ajout du texte indiquant le recalcul, et supression de l'actualisation intempestive dans l'onglet Grid
- Ajout du choix du nombre de colonnes dans Grid
parent 53b2f1b4
......@@ -157,8 +157,10 @@ sidebar <- dashboardSidebar(
conditionalPanel(condition= "output.fileUploaded",align="center",
radioButtons(inputId="graph_grid", label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"), selected = "umap"),
sliderInput(inputId="ptsize_grid", label="Point size :", min=0.1, max=2, step=0.1, value = 0.6, ticks = FALSE),
hr(),
uiOutput("grid_ncol"), br(),
selectizeInput(inputId="listminigenes", label="Choose a gene :", choices ="", multiple = TRUE), br(),
textOutput("gridstatut"), actionButton("gridgraphs", icon = icon("far fa-arrow-alt-circle-right"), label="Compute Graphs"),
br(),
uiOutput("dlgrid")
)
)
......@@ -269,7 +271,7 @@ body <- dashboardBody(
column(width=4, img(src = "chu.png", height = 150, align="center")),
column(width=4, img(src = "siric.jpg", height = 100, align="center"))),
br(), hr(), br(), p(em("Development Team : Mathias BAGUENEAU, Jean-Baptiste ALBERGE, Jonathan CRUARD,"), br(), em("Beta-test : Benjamin DELAUNE")),
br(), p(strong("Git repository :"),a(href="https://gitlab.univ-nantes.fr/MathBgn/myelome", "Shiny SChnurR"), br(), em("A complete tutorial is available at this adress."))
br(), p(strong("GitLab repository :"),a(href="https://gitlab.univ-nantes.fr/MathBgn/myelome", "Shiny SChnurR"), br(), em("A complete tutorial is available at this adress."))
)
)
)
......@@ -346,7 +348,15 @@ server <- function(input, output, session) {
return(coldf)
})
## Graphs & one table Generations --------
## Visualization Page --------
output$information <- renderUI({ # Information Visualize text
req(wrfile())
az <- paste(strong("Filename :"), filedata$name)
er <- paste(strong("Genes number :"), length(wrfile()@assays$SCT@data@Dimnames[[1]]), " | ",strong("Cells number :"), length(wrfile()@assays$SCT@data@Dimnames[[2]]), " | ",strong("Median genes/cell :"), median(wrfile()@meta.data$nFeature_SCT))
ty <- paste(strong("Assay used :"), wrfile()@active.assay)
HTML(paste(az,er,ty, sep='</br>'))
})
markersData <- reactive ({ # Markers table Visu page
mD <- wrfile()@misc$markers[[input$fsel]]
return(mD)
......@@ -365,22 +375,6 @@ server <- function(input, output, session) {
}
})
miniplot_compareData <- reactive ({ # Mini Graph 1 Compare page
withProgress(DimPlot(object = wrfile(), label=TRUE, pt.size = input$ptsize_compare, legend="none", reduction=input$graph_compare, group.by = input$fsel2, cols = as.character(eval(parse(text=paste0("alldf()$",input$fsel2,"$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 Graph 2 Compare page
if (input$choice_compare == "features_compare") {
if (input$featuresel2 =="d2") {
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") {
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)
}
}
})
## Graphs & Tables Outputs --------
output$plot_factors <-renderPlotly ({
req(wrfile())
ggplotly(factorsplotData(),tooltip = c("colour","text")) %>% config(displaylogo = F, modeBarButtonsToRemove = c('resetScale2d', 'toggleSpikelines', 'toImage', 'hoverCompareCartesian','hoverClosestCartesian'))
......@@ -397,32 +391,100 @@ server <- function(input, output, session) {
datatable(markersData()[c(7,6,3,4,2,1,5)], rownames = FALSE, filter="top", caption = paste("Table : All significant markers for the class :", input$fsel ,"| Test used : MAST" )) %>% formatRound(columns=c(3,4,5), digits=3) %>% formatSignif(columns=c(7,6), digits=3)
})
output$miniplot_compare <- renderPlot({
req(wrfile())
plot(miniplot_compareData())
# Downloads
output$dlmarkbutton_visu <- renderUI ({
req(markersData() != "")
downloadButton("dlmarkers", label="Export Table")
})
output$dlmarkers <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_allmarkers_",input$fchoice,".csv")
},
content = function(file) {
write.csv(markersData(), file)
}
)
output$miniplot_compare2 <- renderPlot({
output$dlleftplot <- downloadHandler(
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(
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()
}
)
## Visualization Page - Clusters + selection information text --------
output$clusters_infos <- renderTable({
req(input$fsel != "")
req(input$show_clusters == "TRUE")
clDATA <- data.table("Cluster" = levels(as.factor(wrfile()@meta.data[[input$fsel]])), "Cells_nb" = as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel]]))), "Percentage" =formatC(((as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel]])))/length(as.factor(wrfile()@meta.data[[input$fsel]])))*100),digits=2, format ="f" ))
t(head( clDATA, n=999 ))}, align="c", striped = TRUE, hover = TRUE, spacing = 'xs', width = '100%', colnames = FALSE, rownames=TRUE
)
output$select_infos <- renderText({
req(wrfile())
plot(miniplot_compare2Data())
d <- paste0("Your selection : Cells nb : ", nrow(event_data("plotly_selected")), " | % : ", formatC(((nrow(event_data("plotly_selected"))/length(wrfile()@meta.data[[input$fsel]]))*100),digits=2, format ="f" ) )
if (is.null(nrow(event_data("plotly_selected")))) "Please select some cells" else d
})
## Grid Genes Miniplots Generation & Outputs --------
## Grid Page --------
observeEvent({list(input$ptsize_grid,input$graph_grid,input$listminigenes,input$ncol)},
{req(input$gridgraphs)
output$gridstatut <- renderText({"Needs recalculation"})})
output$grid_ncol <- renderUI ({
sliderInput("ncol", label="Choose the number of columns :", min=1, max=10, step=1, value=3)
})
observeEvent(input$gridgraphs, {
output$gridstatut <- renderText({""})
# Grid graphs
gridData <- withProgress(FeaturePlot(object = wrfile(), ncol=input$ncol, 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()) + theme(aspect.ratio = 1)
output$minigenes <- renderPlot({
req(wrfile())
plot(gridData())
plot(gridData)
})
# Download
output$dlgrid <- renderUI ({
req(gridData != "")
downloadButton("dlminiplots_grid", label="Export Graphs")
})
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())
output$dlminiplots_grid <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_gridplot_",input$graph_grid,".png")
},
content = function(file) {
png(file)
print(gridData)
dev.off()
}
)
})
## Heatmap Generation, Output & Download --------
## Heatmap Page --------
output$heat_numb <- renderUI ({
sliderInput("top_number", label="Choose the number of top genes :", min=1, max=10, step=1, value=3)
})
......@@ -537,315 +599,47 @@ server <- function(input, output, session) {
})
output$dl_gene <- downloadHandler(
filename = function() {
if (input$gographtype == "dplot") {
paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_dotplot_",input$fsel4,".png")
} else if (input$gographtype == "bplot") {
paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_barplot_",input$fsel4,".png")
} else {
paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_emapplot_",input$fsel4,".png")
}
},
content = function(file) {
png(file, width = 800, height = 600)
print(goplotData)
dev.off()
}
)
output$dlgenedt <- renderUI ({ # Download
downloadButton("dl_godt", label="Export Table")
})
output$dl_godt <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_genes_datatable_",input$fsel4,".csv")
},
content = function(file) {
write.csv(dtgoData, file)
}
)
output$dlontodt <- renderUI ({ # Download
downloadButton("dl_ontodt", label="Export Table")
})
output$dl_ontodt <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology,"_datatable_",input$fsel4,".csv")
},
content = function(file) {
write.csv(dtontoData, file)
}
)
}
})
## Other Downloads functions --------
output$dlmarkbutton_visu <- renderUI ({ # visualization Page
req(markersData() != "")
downloadButton("dlmarkers", label="Export Table")
})
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$dlgrid <- renderUI ({ # Grid Page
req(gridData() != "")
downloadButton("dlminiplots_grid", label="Export Graphs")
})
output$dlminiplots_grid <- downloadHandler( # Grid Page
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_gridplot_",input$graph_grid,".svg")
},
content = function(file) {
svg(file)
print(gridData())
dev.off()
}
)
## Information Visualize text --------
output$information <- renderUI({
req(wrfile())
az <- paste(strong("Filename :"), filedata$name)
er <- paste(strong("Genes number :"), length(wrfile()@assays$SCT@data@Dimnames[[1]]), " | ",strong("Cells number :"), length(wrfile()@assays$SCT@data@Dimnames[[2]]), " | ",strong("Median genes/cell :"), median(wrfile()@meta.data$nFeature_SCT))
ty <- paste(strong("Assay used :"), wrfile()@active.assay)
HTML(paste(az,er,ty, sep='</br>'))
})
## No file texts --------
output$no_file2 <- renderText({
req(input$file =="")
req(is.null(input$file1))
print("Please upload or \n choose a file")
})
output$no_file3 <- renderText({
req(input$file =="")
req(is.null(input$file1))
print("Please upload or \n choose a file")
})
output$no_file4 <- renderText({
req(input$file =="")
req(is.null(input$file1))
print("Please upload or \n choose a file")
})
output$no_file5 <- renderText({
req(input$file =="")
req(is.null(input$file1))
print("Please upload or \n choose a file")
})
## Clusters + selection information text in visualization page --------
output$clusters_infos <- renderTable({
req(input$fsel != "")
req(input$show_clusters == "TRUE")
clDATA <- data.table("Cluster" = levels(as.factor(wrfile()@meta.data[[input$fsel]])), "Cells_nb" = as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel]]))), "Percentage" =formatC(((as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel]])))/length(as.factor(wrfile()@meta.data[[input$fsel]])))*100),digits=2, format ="f" ))
t(head( clDATA, n=999 ))}, align="c", striped = TRUE, hover = TRUE, spacing = 'xs', width = '100%', colnames = FALSE, rownames=TRUE
)
output$select_infos <- renderText({
req(wrfile())
d <- paste0("Your selection : Cells nb : ", nrow(event_data("plotly_selected")), " | % : ", formatC(((nrow(event_data("plotly_selected"))/length(wrfile()@meta.data[[input$fsel]]))*100),digits=2, format ="f" ) )
if (is.null(nrow(event_data("plotly_selected")))) "Please select some cells" else d
})
## Clusters + selection information text in compare page --------
output$clusters_infos_compare <- renderTable ({
req(input$fsel2 != "")
req(input$show_clusters_compare == "TRUE")
clDATA2 <- data.table("Cluster" = levels(as.factor(wrfile()@meta.data[[input$fsel2]])), "Cells_nb" = as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel2]]))), "Percentage" =formatC(((as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel2]])))/length(as.factor(wrfile()@meta.data[[input$fsel2]])))*100),digits=2, format ="f" ))
t(head( clDATA2, n=999 ))}, align="c", striped = TRUE, hover = TRUE, spacing = 'xs', width = '100%', colnames = FALSE, rownames=TRUE
)
output$select_infos_compare <- renderText({
req(wrfile())
d <- paste0("Your selection : Cells nb : ", nrow(event_data("plotly_selected")), " | % : ", formatC(((nrow(event_data("plotly_selected"))/length(wrfile()@meta.data[[input$fsel2]]))*100),digits=2, format ="f" ) )
if (is.null(nrow(event_data("plotly_selected")))) "Please select some cells" else d
})
## Factors choices --------
output$fchoice <-renderUI({ # Visualize page
selectizeInput("fsel", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
})
output$fchoice2 <-renderUI({ # Compare Page
selectizeInput("fsel2", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
})
output$fchoice3 <-renderUI({ # Heatmap Page
selectizeInput("fsel3", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
})
output$fchoice4 <-renderUI({ # Genes Page
selectizeInput("fsel4", "Choose a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4")
})
output$addf <-renderUI({ # Add factor Compare Page
req(input$add %% 2 != 0)
selectizeInput("add_factor", "Add a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "orig.ident")
})
## Link the choices --
observeEvent ({
input$fsel
}, { updateSelectizeInput(session,"fsel2",selected = input$fsel)
updateSelectizeInput(session,"fsel3",selected = input$fsel)
updateSelectizeInput(session,"fsel4",selected = input$fsel) },ignoreNULL = FALSE)
observeEvent ({
input$fsel2
}, { updateSelectizeInput(session,"fsel",selected = input$fsel2)
updateSelectizeInput(session,"fsel3",selected = input$fsel2)
updateSelectizeInput(session,"fsel4",selected = input$fsel2) },ignoreNULL = FALSE)
observeEvent ({
input$fsel3
}, { updateSelectizeInput(session,"fsel",selected = input$fsel3)
updateSelectizeInput(session,"fsel2",selected = input$fsel3)
updateSelectizeInput(session,"fsel4",selected = input$fsel3) },ignoreNULL = FALSE)
observeEvent ({
input$fsel4
}, { updateSelectizeInput(session,"fsel",selected = input$fsel4)
updateSelectizeInput(session,"fsel2",selected = input$fsel4)
updateSelectizeInput(session,"fsel3",selected = input$fsel4) },ignoreNULL = FALSE)
## Features and numerics choices ---------
output$featurechoice <- renderUI ({ # Visualize page
selectInput("featuresel", "Choose a Feature :", choices = c("Genes" ="g","Quantitave Variable" ="d"), selected = "Genes")
})
output$nchoice <-renderUI({ # Visualize page
req(input$featuresel=="d")
selectInput("nsel", "Choose a Quantitave variable :", choices = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class)), selected = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class)))
})
output$featurechoice2 <- renderUI ({ # Compare page
selectInput("featuresel2", "Choose a Feature :", choices = c("Genes" ="g2","Quantitave Variable" ="d2"), selected = "Genes")
})
output$nchoice2 <-renderUI({ # Compare page
req(input$featuresel2=="d2")
selectInput("nsel2", "Choose a Quantitave variable :", choices = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class)), selected = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class)))
})
## Filter by Groups --------
output$plot1_library <- renderUI ({
req(wrfile())
choice <- unique(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))))
req(!is.na(choice))
selectInput("library1_compare", "Choose a group :", multiple = TRUE, choices = choice[order(choice)])
})
output$plot2_library <- renderUI ({
req(wrfile())
choice <- unique(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel2))))
req(!is.na(choice))
selectInput("library2_compare", "Choose a group :",multiple = TRUE, choices = choice[order(choice)])
})
output$addg1 <- renderUI ({
req(wrfile())
req(input$add %% 2 != 0)
choice <- unique(eval(parse(text=paste0("wrfile()@meta.data$",input$add_factor))))
req(!is.na(choice))
selectInput("add_group1", "Choose a group :", multiple = TRUE, choices = choice[order(choice)])
})
output$addg2 <- renderUI ({
req(wrfile())
req(input$add %% 2 != 0)
choice <- unique(eval(parse(text=paste0("wrfile()@meta.data$",input$add_factor))))
req(!is.na(choice))
selectInput("add_group2", "Choose a group :", multiple = TRUE, choices = choice[order(choice)])
})
output$group <- renderUI ({ # Genes Page
req(wrfile())
choice <- unique(eval(parse(text=paste0("wrfile()@meta.data$",input$fsel4))))
req(!is.na(choice))
selectInput("group_genepage", "Choose a group :", multiple = TRUE, choices = choice[order(choice)])
})
## Help messages --------
observeEvent (input$help1, {
showModal(modalDialog("You first need to upload a .rds file, or choose one already provided as example.
Then, many information are provided :
Some files information, with genes and cells number, and the assay used.
Two graphs for the visualization.
A data table with some pre-calculated markers.
The first graph allows you to visualise by all the factors (resolution, idents, ...) of your file.
The second one is for the features or data (all the genes repartitions, scores, ...).
The two graphs could be controlled with the panel made for. You have two graph modes : t-SNE or UMAP, and clusters informations for every factors.
On the graphs, you could also select some cells, and have the percentage of your selection by the total cell number.
The data table under the graphs is pre-calculated depending the selected class.
It shows all significant markers, calculated with the test MAST. You could affine your marker research with the filters.
All of the outputs are exportable : in .svg for the graphs and in .csv for the table.", title=strong("Vizualisation page Help"), easyClose=TRUE, footer = NULL )
)
})
observeEvent (input$help2, {
showModal(modalDialog("The Genes page allows you to do a Gene Ontology and have information about genes.
You have to choose a class, group(s) of it, and ontology. Three type of ontology are available : Biological Process, Molecular Function and Cellular Component.
Then you will have a graph (you can also change the graph mode), and two tables.
The first table gives you the list of the genes present in your selection.
The second one gives you the ontology.
The Gene Ontology also use the pre-calculated markers for each factors (like the data table from the visualization page and the Heatmap).
All of the outputs are exportable : in .png for the graph and in .csv for the tables.", title=strong("Genes page Help"), easyClose=TRUE, footer = NULL )
)
})
observeEvent (input$help3, {
showModal(modalDialog("In this page, you could compare groups from factors with each other.
You could choose multiple groups, and also add a second class to filter with.
Then you could Find the significant markers of your selection.
Be carefull to not select redondant cells.
After this, another option and two text areas appears. The text areas are filled with the top 30 genes upregulated from one condition against the other. These areas are writable (you can add or remove some genes).
Then you could do a gene ontology with these two lists.
The results are into two tables.
Like the Visualization page, you have a Control panel to change some parameters to the graphs (like graph mode, point size, ...) and choose what you want to see (factors, features, ...).
You could also choose an ontology.
All of the outputs are exportable : in .svg for the graphs and in .csv for the tables.
You could also export the barcodes of the selected cells, in .csv.", title=strong("Compare page Help"), easyClose=TRUE, footer = NULL )
)
if (input$gographtype == "dplot") {
paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_dotplot_",input$fsel4,".png")
} else if (input$gographtype == "bplot") {
paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_barplot_",input$fsel4,".png")
} else {
paste0(file_path_sans_ext(filedata$name),"_",input$ontology,"_emapplot_",input$fsel4,".png")
}
},
content = function(file) {
png(file, width = 800, height = 600)
print(goplotData)
dev.off()
}
)
output$dlgenedt <- renderUI ({ # Download
downloadButton("dl_godt", label="Export Table")
})
observeEvent (input$help4, {
showModal(modalDialog("The Heatmap page allows you to do a Heatmap with many parameters.
You could choose a class and the number of top genes you want to be shown.
The Heatmap also use the pre-calculated markers for each factors (like the data table from the visualization page).
The Heatmap is exportable in .png.", title=strong("Heatmap page Help"), easyClose=TRUE, footer = NULL )
)
output$dl_godt <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_genes_datatable_",input$fsel4,".csv")
},
content = function(file) {
write.csv(dtgoData, file)
}
)
output$dlontodt <- renderUI ({ # Download
downloadButton("dl_ontodt", label="Export Table")
})
observeEvent (input$help5, {
showModal(modalDialog("The Grid !", title=strong("Grid page Help"), easyClose=TRUE, footer = NULL )
)
output$dl_ontodt <- downloadHandler(
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_onto_",input$ontology,"_datatable_",input$fsel4,".csv")
},
content = function(file) {
write.csv(dtontoData, file)
}
)
}
})
## Compare Page - Graphs generations, outputs and downloads --------
observeEvent({list(input$library1_compare,input$library2_compare,input$add_group1,input$add_group2,input$fsel2,input$add_factor,input$graph_compare,input$ptsize_compare,input$choice_compare,input$featuresel2,input$nsel2,input$genes2)},
{req(input$gographs)
......@@ -979,6 +773,7 @@ server <- function(input, output, session) {
}
)
output$export_compare2 <- downloadHandler( # Export into Seurat 2
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_subsetdata.rds")
......@@ -1023,6 +818,42 @@ server <- function(input, output, session) {
})
miniplot_compareData <- reactive ({ # Mini Graph 1 Compare page
withProgress(DimPlot(object = wrfile(), label=TRUE, pt.size = input$ptsize_compare, legend="none", reduction=input$graph_compare, group.by = input$fsel2, cols = as.character(eval(parse(text=paste0("alldf()$",input$fsel2,"$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 Graph 2 Compare page
if (input$choice_compare == "features_compare") {
if (input$featuresel2 =="d2") {
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") {
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)
}
}
})
output$miniplot_compare <- renderPlot({
req(wrfile())
plot(miniplot_compareData())
})
output$miniplot_compare2 <- renderPlot({
req(wrfile())
plot(miniplot_compare2Data())
})
## Compare Page - Clusters + selection information text --------
output$clusters_infos_compare <- renderTable ({
req(input$fsel2 != "")
req(input$show_clusters_compare == "TRUE")
clDATA2 <- data.table("Cluster" = levels(as.factor(wrfile()@meta.data[[input$fsel2]])), "Cells_nb" = as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel2]]))), "Percentage" =formatC(((as.vector(summary(as.factor(wrfile()@meta.data[[input$fsel2]])))/length(as.factor(wrfile()@meta.data[[input$fsel2]])))*100),digits