Commit 9c9428e1 authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

- Possibilité de calculer les marqueurs s'ils n'ont pas déjà été pré-calculés...

- Possibilité de calculer les marqueurs s'ils n'ont pas déjà été pré-calculés (pour Heatmap et Genes)
- Ebauche de l'onglet Grid
parent 6c52e5a6
......@@ -10,7 +10,7 @@ library(plotly)
library(BiocManager)
library(shinydashboard)
library(shinyjs)
library(DT)
library(DT)
library(RColorBrewer)
library(MAST)
library(data.table)
......@@ -36,6 +36,8 @@ header <- dashboardHeader(tags$li(class="dropdown",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Compare -")),
conditionalPanel(condition="input.tabs == 'pipeline_item'",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Pipeline -")),
conditionalPanel(condition="input.tabs == 'grid_item'",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Grid -")),
tags$head(HTML("<link rel='icon' href='min.png'>"))
))
anchor <- tags$a(tags$img(src='logo.png', height='30', width='20'),'Shiny SChnurR', style="color: white")
......@@ -55,6 +57,7 @@ sidebar <- dashboardSidebar(
menuItem("Heatmap", tabName = "heatmap_item", icon=icon("fas fa-align-justify")),
menuItem("Genes", tabName = "genes_item", icon=icon("dna")),
menuItem("Compare", tabName="compare_item", icon = icon("table")),
menuItem("Grid", tabName="grid_item", icon = icon("fas fa-th")),
menuItem("Pipeline", tabName="pipeline_item", icon = icon("fas fa-bezier-curve")),
menuItem("About", tabName = "about_item", icon = icon("far fa-id-card"))
),
......@@ -136,11 +139,27 @@ sidebar <- dashboardSidebar(
conditionalPanel(condition= "output.fileUploaded", align="center",
radioButtons(inputId="graph", label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap")),
checkboxInput(inputId="show_clusters", label="Clusters information", value=FALSE),
# checkboxInput(inputId="show_gene", label="Gene information", value=FALSE),
sliderInput(inputId="ptsize", label="Point size :", min=0.1, max=2, step=0.1, value = 0.6, ticks = FALSE)
)
)
)
),
# Grid Panel --------
conditionalPanel(condition="input.tabs=='grid_item'", align="center",
fluidRow(
column(1),
column(10, h4(align="center", "Control Panel"),
div(actionLink("help5", "", icon = icon("far fa-question-circle")), align="center"),
verbatimTextOutput(outputId = "no_file5"),
conditionalPanel(condition= "output.fileUploaded",align="center",
radioButtons(inputId="graph_grid", label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap")),
sliderInput(inputId="ptsize_grid", label="Point size :", min=0.1, max=2, step=0.1, value = 0.6, ticks = FALSE),
hr(),
selectizeInput(inputId="listminigenes", label="Choose a gene :", choices ="", multiple = TRUE)
)
)
)
)
)
......@@ -215,6 +234,14 @@ body <- dashboardBody(
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") )))
)
),
# Grid Item --------
tabItem(tabName="grid_item", align="left",
conditionalPanel(condition= "output.fileUploaded",
br(), br(),
plotOutput(outputId="minigenes", width="1400px", height="1400px")
)
),
# Pipeline Item --------
tabItem(tabName="pipeline_item", align="center",
br(),
......@@ -274,6 +301,7 @@ server <- function(input, output, session) {
genesList <- filedata$data@assays$SCT@data@Dimnames[1]
updateSelectizeInput(session, "genes", choices = genesList[[1]], selected = "IGKC")
updateSelectizeInput(session, "genes2", choices = genesList[[1]], selected = "IGKC")
updateSelectizeInput(session, "listminigenes", choices = genesList[[1]], selected = "IGKC")
return(filedata$data)
return(filedata$name)
})
......@@ -334,7 +362,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()
})
......@@ -443,6 +470,18 @@ server <- function(input, output, session) {
}
})
## 9 Grid Genes Miniplots Generation & Outputs --------
output$minigenes <- renderPlot({
req(wrfile())
plot(gridData())
})
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())
})
## Heatmap Generation & Output --------
output$heat_numb <- renderUI ({
sliderInput("top_number", label="Choose the number of top genes :", min=1, max=10, step=1, value=3)
......@@ -450,7 +489,13 @@ server <- function(input, output, session) {
heatmapData <- reactive ({
req(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 ))
showModal(modalDialog("The markers may have not been calculated for this factor yet.", title=strong("Warning !"), easyClose=TRUE, footer = NULL ))
tempfile <- wrfile()
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)
topgenesfam <- tempmarkers %>% group_by(cluster) %>% top_n(n = input$top_number, wt = avg_logFC)
datascalefam <- withProgress(ScaleData(object = wrfile(), features = topgenesfam$gene), message = "Scaling data...", value=1)
withProgress(DoHeatmap(object = datascalefam, features = topgenesfam$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))
} 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)
......@@ -469,8 +514,17 @@ server <- function(input, output, session) {
}
})
egot <- reactive({
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()
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)
genes <- tempmarkers$cluster == input$group_genepage
genes <- tempmarkers$gene[genes]
} else {
genes <- wrfile()@misc$markers[[input$fsel4]]$cluster == input$group_genepage
genes <- wrfile()@misc$markers[[input$fsel4]]$gene[genes]
}
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)
......@@ -479,16 +533,12 @@ server <- function(input, output, session) {
goplotData <- reactive ({ # Ontology Graph
req(input$gogo)
req(!is.null(input$group_genepage))
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 ))
} else {
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())
} 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())
} 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())
}
}
})
......@@ -717,6 +767,11 @@ server <- function(input, output, session) {
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 --------
......@@ -892,7 +947,10 @@ server <- function(input, output, session) {
The Heatmap is exportable in .png.", title=strong("Heatmap page Help"), easyClose=TRUE, footer = NULL )
)
})
observeEvent (input$help5, {
showModal(modalDialog("The Grid !", title=strong("Grid page Help"), easyClose=TRUE, footer = NULL )
)
})
## Compare Page - Barcodes data --------
cbar1Data <- reactive ({
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment