Commit 53b2f1b4 authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

- Ajout de l'exportation des cellules subset de compare en objets Seurat rds

- Clarification de termes
parent 0187367c
...@@ -75,7 +75,7 @@ sidebar <- dashboardSidebar( ...@@ -75,7 +75,7 @@ sidebar <- dashboardSidebar(
radioButtons("gographtype", label="Choose a graph type :", choices=c("Dotplot"="dplot", "Barplot"="bplot", "Emapplot" = "eplot")), br(), radioButtons("gographtype", label="Choose a graph type :", choices=c("Dotplot"="dplot", "Barplot"="bplot", "Emapplot" = "eplot")), br(),
radioButtons("ontology", label="Choose an ontology :", choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")), br(), radioButtons("ontology", label="Choose an ontology :", choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")), br(),
textOutput("genesstatut"), textOutput("genesstatut"),
actionButton("gogo", icon = icon("far fa-arrow-alt-circle-right"), label="Do Gene Ontology") actionButton("gogo", icon = icon("far fa-arrow-alt-circle-right"), label="Ontology")
) )
) )
) )
...@@ -108,8 +108,7 @@ sidebar <- dashboardSidebar( ...@@ -108,8 +108,7 @@ sidebar <- dashboardSidebar(
conditionalPanel(condition = "input.choice_compare == 'f_compare'", conditionalPanel(condition = "input.choice_compare == 'f_compare'",
checkboxInput(inputId="show_clusters_compare", label="Clusters information", value=FALSE) checkboxInput(inputId="show_clusters_compare", label="Clusters information", value=FALSE)
), ),
radioButtons("ontology2", label="Choose an ontology :", choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")), radioButtons("ontology2", label="Choose an ontology :", choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC"))
textOutput("comparestatut")
) )
) )
) )
...@@ -125,7 +124,7 @@ sidebar <- dashboardSidebar( ...@@ -125,7 +124,7 @@ sidebar <- dashboardSidebar(
uiOutput("fchoice3"), br(), uiOutput("fchoice3"), br(),
uiOutput("heat_numb"), br(), uiOutput("heat_numb"), br(),
textOutput("heatmapstatut"), textOutput("heatmapstatut"),
actionButton("goheatmap", icon = icon("far fa-arrow-alt-circle-right"), label="Do Heatmap") actionButton("goheatmap", icon = icon("far fa-arrow-alt-circle-right"), label="Compute Heatmap")
) )
) )
) )
...@@ -180,9 +179,9 @@ body <- dashboardBody( ...@@ -180,9 +179,9 @@ body <- dashboardBody(
uiOutput(outputId = "clusters_infos"), uiOutput(outputId = "clusters_infos"),
verbatimTextOutput(outputId = "select_infos"), verbatimTextOutput(outputId = "select_infos"),
br(), br(),
fluidRow(column(align="center", width = 6, plotlyOutput("plot_factors", width='500px', height='500px'), uiOutput("fchoice"),downloadButton("dlleftplot", label="")), fluidRow(column(align="center", width = 6, plotlyOutput("plot_factors", width='500px', height='500px'), uiOutput("fchoice"),downloadButton("dlleftplot", label="Export Graph")),
column(align="center", width = 6, plotlyOutput("plot_numerics", width='500px', height='500px'),uiOutput("featurechoice"), uiOutput("nchoice"), 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")) conditionalPanel(condition ="input.featuresel == 'g'", selectizeInput(inputId="genes", label="Choose a gene :", choices ="")),downloadButton("dlrightplot", label="Export Graph"))# br(), verbatimTextOutput(outputId="genes_analyse"))
), ),
hr(), hr(),
br(), br(),
...@@ -223,17 +222,17 @@ body <- dashboardBody( ...@@ -223,17 +222,17 @@ body <- dashboardBody(
uiOutput(outputId = "clusters_infos_compare"), uiOutput(outputId = "clusters_infos_compare"),
br(), br(),
conditionalPanel(condition="output.fileUploaded", 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"), 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")), 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="Compute Graphs"), align="left", textOutput("comparestatutgraphs")),
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("plot1_compare", width="490px", height="490px"), br(), uiOutput("plot1_library"), br(), uiOutput("addg1"), br(), downloadButton("dl_compare1", label="Export Graph"), downloadButton("dl_comparebarcodes1", label="Export barcodes"), br(), downloadButton("export_compare1", label="Export into Seurat object")),
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")) column(align="center", width = 5, plotlyOutput("plot2_compare", width="490px", height="490px"), br(), uiOutput("plot2_library"), br(), uiOutput("addg2"), br(), downloadButton("dl_compare2", label="Export Graph"), downloadButton("dl_comparebarcodes2", label="Export barcodes"), br(), downloadButton("export_compare2", label="Export into Seurat object"))
), ),
hr(), hr(),
br(), br(),
uiOutput(align="left","markbutton"), uiOutput(align="left","dlmarkbutton_compare"), br(), uiOutput(align="left","markbutton"), align="left", textOutput("comparestatutmarkers"), br(), uiOutput(align="left","dlmarkbutton_compare"), br(),
dataTableOutput("markers_compare"), dataTableOutput("markers_compare"),
hr(), hr(),
br(), br(),
uiOutput(align="left","ontobutton"), uiOutput(align="left","ontobutton"), textOutput("comparestatutonto"), br(),
fluidRow(column(align="center",width=6, column(align="center", width=2, uiOutput("topgenes1"),br(), uiOutput(align="center","dlontobutton_compare1") ) , column(align="center", width=10, br(), dataTableOutput("onto_compare1"))), fluidRow(column(align="center",width=6, column(align="center", width=2, uiOutput("topgenes1"),br(), uiOutput(align="center","dlontobutton_compare1") ) , column(align="center", width=10, br(), dataTableOutput("onto_compare1"))),
column(align="center",width=6, column(align="center", width=10, br(), dataTableOutput("onto_compare2")), column(align="align", width=2, uiOutput("topgenes2"),br(), uiOutput(align="align","dlontobutton_compare2") ))) column(align="center",width=6, column(align="center", width=10, br(), dataTableOutput("onto_compare2")), column(align="align", width=2, uiOutput("topgenes2"),br(), uiOutput(align="align","dlontobutton_compare2") )))
) )
...@@ -341,7 +340,7 @@ server <- function(input, output, session) { ...@@ -341,7 +340,7 @@ server <- function(input, output, session) {
return(colors.df) return(colors.df)
} }
# List group <-> color for every factor # List group <-> color for every class
alldf <- reactive ({ alldf <- reactive ({
coldf <- lapply(wrfile()@meta.data[,sapply(wrfile()@meta.data, class) %in% c("factor","character")], assign.colors, obj=wrfile(), palette="Dark2") coldf <- lapply(wrfile()@meta.data[,sapply(wrfile()@meta.data, class) %in% c("factor","character")], assign.colors, obj=wrfile(), palette="Dark2")
return(coldf) return(coldf)
...@@ -395,7 +394,7 @@ server <- function(input, output, session) { ...@@ -395,7 +394,7 @@ server <- function(input, output, session) {
output$markers_table <- renderDataTable ({ output$markers_table <- renderDataTable ({
req(wrfile()) req(wrfile())
req(markersData() != "") req(markersData() != "")
datatable(markersData()[c(7,6,3,4,2,1,5)], rownames = FALSE, filter="top", caption = paste("Table : All significant markers for the factor :", input$fsel ,"| Test used : MAST" )) %>% formatRound(columns=c(3,4,5), digits=3) %>% formatSignif(columns=c(7,6), digits=3) 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({ output$miniplot_compare <- renderPlot({
...@@ -428,12 +427,13 @@ server <- function(input, output, session) { ...@@ -428,12 +427,13 @@ server <- function(input, output, session) {
sliderInput("top_number", label="Choose the number of top genes :", min=1, max=10, step=1, value=3) sliderInput("top_number", label="Choose the number of top genes :", min=1, max=10, step=1, value=3)
}) })
observeEvent({list(input$fsel3,input$top_number)}, observeEvent({list(input$fsel3,input$top_number)},
{output$heatmapstatut <- renderText({"Needs recalculation"})}) {req(input$goheatmap)
output$heatmapstatut <- renderText({"Needs recalculation"})})
observeEvent(input$goheatmap, { observeEvent(input$goheatmap, {
output$heatmapstatut <- renderText({""}) output$heatmapstatut <- renderText({""})
if (is.null(wrfile()@misc$markers[[input$fsel3]])) { 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 )) showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
tempfile <- wrfile() tempfile <- wrfile()
Idents(tempfile) <- as.factor(paste0(eval(parse(text=paste0("tempfile@meta.data$",input$fsel3))))) Idents(tempfile) <- as.factor(paste0(eval(parse(text=paste0("tempfile@meta.data$",input$fsel3)))))
tempmarkers <- withProgress(FindAllMarkers(tempfile, 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) tempmarkers <- withProgress(FindAllMarkers(tempfile, 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)
...@@ -452,7 +452,7 @@ server <- function(input, output, session) { ...@@ -452,7 +452,7 @@ server <- function(input, output, session) {
}) })
output$dlheat <- renderUI ({ # Download output$dlheat <- renderUI ({ # Download
downloadButton("dl_heatmap", label="") downloadButton("dl_heatmap", label="Export Heatmap")
}) })
output$dl_heatmap <- downloadHandler( output$dl_heatmap <- downloadHandler(
filename = function() { filename = function() {
...@@ -469,7 +469,8 @@ server <- function(input, output, session) { ...@@ -469,7 +469,8 @@ server <- function(input, output, session) {
## Genes Page -------- ## Genes Page --------
observeEvent({list(input$fsel4,input$group_genepage,input$gographtype,input$ontology)}, observeEvent({list(input$fsel4,input$group_genepage,input$gographtype,input$ontology)},
{output$genesstatut <- renderText({"Needs recalculation"})}) {req(input$gogo)
output$genesstatut <- renderText({"Needs recalculation"})})
observeEvent(input$gogo, { observeEvent(input$gogo, {
if (is.null(input$group_genepage)) { if (is.null(input$group_genepage)) {
...@@ -478,7 +479,7 @@ server <- function(input, output, session) { ...@@ -478,7 +479,7 @@ server <- function(input, output, session) {
output$genesstatut <- renderText({""}) output$genesstatut <- renderText({""})
if (is.null(wrfile()@misc$markers[[input$fsel4]])) { 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 )) showModal(modalDialog("The markers may have not been calculated for this class yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
tempfile <- wrfile() tempfile <- wrfile()
Idents(tempfile) <- as.factor(paste0(eval(parse(text=paste0("tempfile@meta.data$",input$fsel4))))) Idents(tempfile) <- as.factor(paste0(eval(parse(text=paste0("tempfile@meta.data$",input$fsel4)))))
tempmarkers <- withProgress(FindAllMarkers(tempfile, 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) tempmarkers <- withProgress(FindAllMarkers(tempfile, 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)
...@@ -517,7 +518,7 @@ server <- function(input, output, session) { ...@@ -517,7 +518,7 @@ server <- function(input, output, session) {
output$dtgenes <-renderDataTable ({ output$dtgenes <-renderDataTable ({
req(wrfile()) req(wrfile())
datatable(dtgoData, filter="top", caption = paste("Table : Markers for the selected group(s) and factor")) datatable(dtgoData, filter="top", caption = paste("Table : Markers for the selected group(s) and class"))
}) })
...@@ -527,12 +528,12 @@ server <- function(input, output, session) { ...@@ -527,12 +528,12 @@ server <- function(input, output, session) {
output$dtonto <-renderDataTable ({ output$dtonto <-renderDataTable ({
req(wrfile()) req(wrfile())
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) datatable(dtontoData, filter="top", caption = paste("Table : Gene Ontology for the selected group(s) and class | Only takes groups with a ratio > 3/Total, p-value cutoff : 0.05")) %>% formatSignif(columns=c(3,4), digits=3)
}) })
output$dlgenegraph <- renderUI ({ # Download output$dlgenegraph <- renderUI ({ # Download
downloadButton("dl_gene", label="") downloadButton("dl_gene", label="Export Graph")
}) })
output$dl_gene <- downloadHandler( output$dl_gene <- downloadHandler(
filename = function() { filename = function() {
...@@ -552,7 +553,7 @@ server <- function(input, output, session) { ...@@ -552,7 +553,7 @@ server <- function(input, output, session) {
) )
output$dlgenedt <- renderUI ({ # Download output$dlgenedt <- renderUI ({ # Download
downloadButton("dl_godt", label="") downloadButton("dl_godt", label="Export Table")
}) })
output$dl_godt <- downloadHandler( output$dl_godt <- downloadHandler(
filename = function() { filename = function() {
...@@ -564,7 +565,7 @@ server <- function(input, output, session) { ...@@ -564,7 +565,7 @@ server <- function(input, output, session) {
) )
output$dlontodt <- renderUI ({ # Download output$dlontodt <- renderUI ({ # Download
downloadButton("dl_ontodt", label="") downloadButton("dl_ontodt", label="Export Table")
}) })
output$dl_ontodt <- downloadHandler( output$dl_ontodt <- downloadHandler(
filename = function() { filename = function() {
...@@ -580,7 +581,7 @@ server <- function(input, output, session) { ...@@ -580,7 +581,7 @@ server <- function(input, output, session) {
## Other Downloads functions -------- ## Other Downloads functions --------
output$dlmarkbutton_visu <- renderUI ({ # visualization Page output$dlmarkbutton_visu <- renderUI ({ # visualization Page
req(markersData() != "") req(markersData() != "")
downloadButton("dlmarkers", label="") downloadButton("dlmarkers", label="Export Table")
}) })
output$dlmarkers <- downloadHandler( # visualization Page output$dlmarkers <- downloadHandler( # visualization Page
filename = function() { filename = function() {
...@@ -620,7 +621,7 @@ server <- function(input, output, session) { ...@@ -620,7 +621,7 @@ server <- function(input, output, session) {
output$dlgrid <- renderUI ({ # Grid Page output$dlgrid <- renderUI ({ # Grid Page
req(gridData() != "") req(gridData() != "")
downloadButton("dlminiplots_grid", label="") downloadButton("dlminiplots_grid", label="Export Graphs")
}) })
output$dlminiplots_grid <- downloadHandler( # Grid Page output$dlminiplots_grid <- downloadHandler( # Grid Page
...@@ -697,21 +698,21 @@ server <- function(input, output, session) { ...@@ -697,21 +698,21 @@ server <- function(input, output, session) {
## Factors choices -------- ## Factors choices --------
output$fchoice <-renderUI({ # Visualize page output$fchoice <-renderUI({ # Visualize page
selectizeInput("fsel", "Choose a Factor :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4") 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 output$fchoice2 <-renderUI({ # Compare Page
selectizeInput("fsel2", "Choose a Factor :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4") 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 output$fchoice3 <-renderUI({ # Heatmap Page
selectizeInput("fsel3", "Choose a Factor :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4") 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 output$fchoice4 <-renderUI({ # Genes Page
selectizeInput("fsel4", "Choose a Factor :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "integrated_snn_res.0.4") 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 output$addf <-renderUI({ # Add factor Compare Page
req(input$add %% 2 != 0) req(input$add %% 2 != 0)
selectizeInput("add_factor", "Add a Factor :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "orig.ident") selectizeInput("add_factor", "Add a Class :", choices = names(rapply(wrfile()@meta.data, class=c("factor","character"), f=class)), selected = "orig.ident")
}) })
...@@ -742,18 +743,18 @@ server <- function(input, output, session) { ...@@ -742,18 +743,18 @@ server <- function(input, output, session) {
## Features and numerics choices --------- ## Features and numerics choices ---------
output$featurechoice <- renderUI ({ # Visualize page output$featurechoice <- renderUI ({ # Visualize page
selectInput("featuresel", "Choose a Feature :", choices = c("Genes" ="g","Data" ="d"), selected = "Genes") selectInput("featuresel", "Choose a Feature :", choices = c("Genes" ="g","Quantitave Variable" ="d"), selected = "Genes")
}) })
output$nchoice <-renderUI({ # Visualize page output$nchoice <-renderUI({ # Visualize page
req(input$featuresel=="d") req(input$featuresel=="d")
selectInput("nsel", "Choose a Data :", choices = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class)), selected = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class))) 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 output$featurechoice2 <- renderUI ({ # Compare page
selectInput("featuresel2", "Choose a Feature :", choices = c("Genes" ="g2","Data" ="d2"), selected = "Genes") selectInput("featuresel2", "Choose a Feature :", choices = c("Genes" ="g2","Quantitave Variable" ="d2"), selected = "Genes")
}) })
output$nchoice2 <-renderUI({ # Compare page output$nchoice2 <-renderUI({ # Compare page
req(input$featuresel2=="d2") req(input$featuresel2=="d2")
selectInput("nsel2", "Choose a Data :", choices = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class)), selected = names(rapply(wrfile()@meta.data, class=c("numeric","integer"), f=class))) 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 -------- ## Filter by Groups --------
...@@ -805,14 +806,14 @@ server <- function(input, output, session) { ...@@ -805,14 +806,14 @@ server <- function(input, output, session) {
The second one is for the features or data (all the genes repartitions, scores, ...). 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. 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. 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 factor. 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. 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 ) 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, { observeEvent (input$help2, {
showModal(modalDialog("The Genes page allows you to do a Gene Ontology and have information about genes. showModal(modalDialog("The Genes page allows you to do a Gene Ontology and have information about genes.
You have to choose a factor, group(s) of it, and ontology. Three type of ontology are available : Biological Process, Molecular Function and Cellular Component. 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. 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 first table gives you the list of the genes present in your selection.
The second one gives you the ontology. The second one gives you the ontology.
...@@ -822,7 +823,7 @@ server <- function(input, output, session) { ...@@ -822,7 +823,7 @@ server <- function(input, output, session) {
}) })
observeEvent (input$help3, { observeEvent (input$help3, {
showModal(modalDialog("In this page, you could compare groups from factors with each other. showModal(modalDialog("In this page, you could compare groups from factors with each other.
You could choose multiple groups, and also add a second factor to filter with. You could choose multiple groups, and also add a second class to filter with.
Then you could Find the significant markers of your selection. Then you could Find the significant markers of your selection.
Be carefull to not select redondant cells. 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). 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).
...@@ -836,7 +837,7 @@ server <- function(input, output, session) { ...@@ -836,7 +837,7 @@ server <- function(input, output, session) {
}) })
observeEvent (input$help4, { observeEvent (input$help4, {
showModal(modalDialog("The Heatmap page allows you to do a Heatmap with many parameters. showModal(modalDialog("The Heatmap page allows you to do a Heatmap with many parameters.
You could choose a factor and the number of top genes you want to be shown. 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 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 ) The Heatmap is exportable in .png.", title=strong("Heatmap page Help"), easyClose=TRUE, footer = NULL )
) )
...@@ -846,11 +847,12 @@ server <- function(input, output, session) { ...@@ -846,11 +847,12 @@ server <- function(input, output, session) {
) )
}) })
## Compare Page - Graphs generations, outputs and downloads -------- ## 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,input$ontology2,input$top1,input$top2)}, 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)},
{output$comparestatut <- renderText({"Needs recalculation"})}) {req(input$gographs)
output$comparestatutgraphs <- renderText({"Needs recalculation"})})
observeEvent (input$gographs, { observeEvent (input$gographs, {
output$comparestatut <- renderText({""}) output$comparestatutgraphs <- renderText({""})
# Data for Compare Left Graph # Data for Compare Left Graph
if (input$add %% 2 != 0) { if (input$add %% 2 != 0) {
...@@ -968,6 +970,25 @@ server <- function(input, output, session) { ...@@ -968,6 +970,25 @@ server <- function(input, output, session) {
} }
) )
output$export_compare1 <- downloadHandler( # Export into Seurat 1
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_subsetdata.rds")
},
content = function(file) {
saveRDS(cells_to_plot1, file)
}
)
output$export_compare2 <- downloadHandler( # Export into Seurat 2
filename = function() {
paste0(file_path_sans_ext(filedata$name),"_subsetdata.rds")
},
content = function(file) {
saveRDS(cells_to_plot2, file)
}
)
# Barcodes data # Barcodes data
cbar1Data <- reactive ({ cbar1Data <- reactive ({
...@@ -1006,11 +1027,16 @@ server <- function(input, output, session) { ...@@ -1006,11 +1027,16 @@ server <- function(input, output, session) {
## Compare Page - FindMarkers -------- ## Compare Page - FindMarkers --------
output$markbutton <- renderUI ({ output$markbutton <- renderUI ({
req(wrfile()) req(wrfile())
actionButton(inputId="findmarkers", label=strong("Find Markers"), icon = icon("fas fa-bookmark")) req(input$gographs)
actionButton(inputId="findmarkers", label=strong("Find Markers"), icon = icon("far fa-arrow-alt-circle-right"))
}) })
observeEvent({list(input$library1_compare,input$library2_compare,input$add_group1,input$add_group2,input$fsel2,input$add_factor)},
{ req(input$findmarkers)
output$comparestatutmarkers <- renderText({"Needs recalculation"})})
observeEvent(input$findmarkers, { observeEvent(input$findmarkers, {
output$comparestatutmarkers <- renderText({""})
if (is.null(input$library1_compare) || is.null(input$library2_compare)) { if (is.null(input$library1_compare) || is.null(input$library2_compare)) {
showModal(modalDialog("At least one of the select is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL )) showModal(modalDialog("At least one of the select is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
...@@ -1039,7 +1065,7 @@ server <- function(input, output, session) { ...@@ -1039,7 +1065,7 @@ server <- function(input, output, session) {
} else { # Compare with 1 factor } else { # Compare with 1 factor
if (length(intersect(input$library1_compare,input$library2_compare)) != 0) { if (length(intersect(input$library1_compare,input$library2_compare)) != 0) {
showModal(modalDialog("You must only choose different groups when comparing with one factor.", title=strong("Warning !"), easyClose=TRUE, footer = NULL )) showModal(modalDialog("You must only choose different groups when comparing with one class", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
} else { } else {
if (!exists("ffm")) { if (!exists("ffm")) {
ffm <- wrfile() ffm <- wrfile()
...@@ -1069,7 +1095,7 @@ server <- function(input, output, session) { ...@@ -1069,7 +1095,7 @@ server <- function(input, output, session) {
textAreaInput("top2", "Top 30 upregulated right genes", "Data Summary", width = "100px", height = "620px", value = paste(sapply(rightgenes$Gene, paste, collapse=""), collapse="\n")) textAreaInput("top2", "Top 30 upregulated right genes", "Data Summary", width = "100px", height = "620px", value = paste(sapply(rightgenes$Gene, paste, collapse=""), collapse="\n"))
}) })
output$dlmarkbutton_compare <- renderUI ({ output$dlmarkbutton_compare <- renderUI ({
downloadButton("dlmarkers_compare", label="") downloadButton("dlmarkers_compare", label="Export Table")
}) })
output$dlmarkers_compare <- downloadHandler( output$dlmarkers_compare <- downloadHandler(
filename = function() { filename = function() {
...@@ -1082,14 +1108,18 @@ server <- function(input, output, session) { ...@@ -1082,14 +1108,18 @@ server <- function(input, output, session) {
}) })
## Compare Page - FindOntology Left -------- ## Compare Page - FindOntology Left --------
observeEvent({list(input$findmarkers, input$library1_compare,input$library2_compare,input$add_group1,input$add_group2,input$fsel2,input$add_factor,input$ontology2,input$top1,input$top2)},
{req(input$findonto)
output$comparestatutonto <- renderText({"Needs recalculation (maybe after computing another 'Find Markers')"})})
output$ontobutton <- renderUI ({ output$ontobutton <- renderUI ({
req(wrfile()) req(wrfile())
req(input$findmarkers) req(input$findmarkers)
actionButton(inputId="findonto", label=strong("Ontology"), icon = icon("fas fa-bookmark")) actionButton(inputId="findonto", label=strong("Ontology"), icon = icon("far fa-arrow-alt-circle-right"))
}) })
observeEvent(input$findonto, { observeEvent(input$findonto, {
output$comparestatutonto <- renderText({""})
if (is.null(input$top1) || is.null(input$top2)) { if (is.null(input$top1) || is.null(input$top2)) {
showModal(modalDialog("At least one of the text area is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL )) showModal(modalDialog("At least one of the text area is empty !", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
...@@ -1101,10 +1131,10 @@ server <- function(input, output, session) { ...@@ -1101,10 +1131,10 @@ server <- function(input, output, session) {
colnames(dfo) <- c("Description","Gene Ratio","P-value","FDR") colnames(dfo) <- c("Description","Gene Ratio","P-value","FDR")
output$onto_compare1 <- renderDataTable ({ output$onto_compare1 <- renderDataTable ({
req(wrfile()) req(wrfile())
withProgress(datatable(dfo, filter="top", caption = paste("Table : Gene Ontology (",input$ontology2,") for the left selected group(s) and this factor : ", input$fsel2,"| 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(dfo, filter="top", caption = paste("Table : Gene Ontology (",input$ontology2,") for the left selected group(s) and this class : ", input$fsel2,"| 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$dlontobutton_compare1 <- renderUI ({ output$dlontobutton_compare1 <- renderUI ({
downloadButton("dlonto_compare1", label="") downloadButton("dlonto_compare1", label="Export Table")
}) })
output$dlonto_compare1 <- downloadHandler( output$dlonto_compare1 <- downloadHandler(
filename = function() { filename = function() {
...@@ -1126,15 +1156,15 @@ server <- function(input, output, session) { ...@@ -1126,15 +1156,15 @@ server <- function(input, output, session) {
} else { } else {
rightchain <- strsplit(input$top2, "\n") rightchain <- strsplit(input$top2, "\n")
genesc <- bitr(rightchain[[1]], fromType = "SYMBOL",toType = "ENTREZID",OrgDb = org.Hs.eg.db,drop = TRUE) 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$ontology2, readable = TRUE), value = 1, message = "Ontology n°1 in progress...") egoc <- withProgress(enrichGO(gene = genesc$ENTREZID, OrgDb = "org.Hs.eg.db", keyType= "ENTREZID", ont = input$ontology2, 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)] 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") colnames(dfo) <- c("Description","Gene Ratio","P-value","FDR")
output$onto_compare2 <- renderDataTable ({