Skip to content

GitLab

Commit 04fcb9a7 authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

- Color palettes and color picker for Feature Plots !

parent 63c73f90
Hide whitespace changes
Inline Side-by-side
app.R
View file @ 04fcb9a7
......@@ -36,17 +36,17 @@ source("config.R")
useShinyjs()
header <- dashboardHeader(tags$li(class="dropdown", # Text for every tabs
conditionalPanel(condition="input.tabs == 'visu_item'",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Visualization -")),
tags$p(style="color:white;font-size:25px;margin-right:20px","Visualization")),
conditionalPanel(condition="input.tabs == 'heatmap_item'",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Heatmap -")),
tags$p(style="color:white;font-size:25px;margin-right:20px","Heatmap")),
conditionalPanel(condition="input.tabs == 'genes_item'",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Genes -")),
tags$p(style="color:white;font-size:25px;margin-right:20px","Genes")),
conditionalPanel(condition="input.tabs == 'compare_item'",
tags$p(style="color:white;font-size:25px;margin-right:20px","- Compare -")),
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 -")),
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$p(style="color:white;font-size:25px;margin-right:20px","Grid")),
tags$head(HTML("<link rel='icon' href='min.png'>")
)
))
......@@ -154,7 +154,17 @@ source("config.R")
label="Choose a gene :",
choices ="")),
conditionalPanel(condition ="input.feature_selector_compare == 'd2'",
uiOutput("qvariable_choice_compare"))),
uiOutput("qvariable_choice_compare")),
FeatureColorPalettes("feature_color_palettes_compare"), # Go into config.R to custom the available color palette !
conditionalPanel(condition ="input.feature_color_palettes_compare == 'Color Picker'",
colourInput("color_picker_compare", # Color picker
label = "Choose a color :",
value = "blue",
showColour = "background",
allowTransparent = TRUE,
returnName = FALSE))),
conditionalPanel(condition = "input.choice_compare == 'class_compare'",
ClassColorPalettes("color_palettes_compare")), # Go into config.R to custom the available color palette !
radioButtons(inputId="graph_compare",
label= "Choose the graph mode :", c("t-SNE" = "tsne", "UMAP" = "umap"),
selected = "umap"),
......@@ -163,8 +173,6 @@ source("config.R")
min=0.1, max=2,
step=0.1, value = 0.6,
ticks = FALSE),
conditionalPanel(condition = "input.choice_compare == 'class_compare'",
ColorPalettes("color_palettes_compare")), # Go into config.R to custom the available color palette !
radioButtons("ontology_compare",
label="Choose an ontology :",
choices=c("Biological Process"="BP", "Molecular Function"="MF", "Cellular Component" = "CC")))))
......@@ -231,7 +239,7 @@ source("config.R")
jqui_resizable(plotlyOutput("classplot_visu", # Remove jqui_resizable for better perfs
width='500px',
height='500px')),
ColorPalettes("color_palettes_visu"), # Go into config.R to custom the available color palette !
ClassColorPalettes("color_palettes_visu"), # Go into config.R to custom the available color palette !
uiOutput("class_choice_visu"),
downloadButton("dlclassplot_visu",
label="Export Plot")),
......@@ -240,12 +248,14 @@ source("config.R")
jqui_resizable(plotlyOutput("featureplot_visu",
width='500px',
height='500px')),
# colourInput("featureplot_color_visu", # Color picker
# label = "Choose a color :",
# value = "blue",
# showColour = "background",
# allowTransparent = TRUE,
# returnName = FALSE),
FeatureColorPalettes("feature_color_palettes_visu"), # Go into config.R to custom the available color palette !
conditionalPanel(condition ="input.feature_color_palettes_visu == 'Color Picker'",
colourInput("color_picker_visu", # Color picker
label = "Choose a color :",
value = "blue",
showColour = "background",
allowTransparent = TRUE,
returnName = FALSE)),
uiOutput("feature_choice_visu"),
uiOutput("qvariable_choice_visu"),
conditionalPanel(condition ="input.feature_selector_visu == 'g'",
......@@ -548,7 +558,7 @@ server <- function(input, output, session) {
withProgress(DimPlot(object = filedata$data,
label=FALSE,
pt.size = input$ptsize_visu,
reduction=input$graph_visu,
reduction = input$graph_visu,
group.by = input$class_selector_visu,
cols = as.character(eval(parse(text=paste0("all_class_colors_visu()$",input$class_selector_visu,"$color"))))), message = "Plot Generation", value=1) +
NoLegend() +
......@@ -571,7 +581,7 @@ server <- function(input, output, session) {
featurevar <- input$genes_list_visu
}
withProgress(FeaturePlot(object = filedata$data,
cols=c("lightgrey",plasma(200)),
cols=c("lightgrey", AssignFeatureColors(input$feature_color_palettes_visu, input$color_picker_visu)),
pt.size = input$ptsize_visu,
features = featurevar,
reduction = input$graph_visu), message = "Plot Generation", value=1) +
......@@ -859,7 +869,7 @@ server <- function(input, output, session) {
featurevar <- input$genes_list_compare
}
withProgress(FeaturePlot(object = filedata$data,
cols=c("lightgrey",plasma(200)),
cols=c("lightgrey", AssignFeatureColors(input$feature_color_palettes_compare, input$color_picker_compare)),
pt.size = input$ptsize_compare,
features = featurevar,
reduction = input$graph_compare), message = "Plot Generation", value=1) +
......@@ -918,9 +928,10 @@ server <- function(input, output, session) {
} else if (input$feature_selector_compare =="g2") {
featurevar <- input$genes_list_compare
}
feature_palette <- AssignFeatureColors(input$feature_color_palettes_compare, input$color_picker_compare)
plot1_compareData <- withProgress(FeaturePlot(object = filedata$data,
cells = rownames(cells_to_plot1_compare@meta.data),
cols = ScaleColors(filedata$data, featurevar, cells_to_plot1_compare),
cols = ScaleColors(filedata$data, featurevar, cells_to_plot1_compare, feature_palette),
pt.size = input$ptsize_compare,
features = featurevar,
reduction = input$graph_compare), message = "Plot Generation", value=1) +
......@@ -956,9 +967,10 @@ server <- function(input, output, session) {
} else if (input$feature_selector_compare =="g2") {
featurevar <- input$genes_list_compare
}
feature_palette <- AssignFeatureColors(input$feature_color_palettes_compare, input$color_picker_compare)
plot2_compareData <- withProgress(FeaturePlot(object = filedata$data,
cells = rownames(cells_to_plot2_compare@meta.data),
cols = ScaleColors(filedata$data, featurevar, cells_to_plot2_compare),
cols = ScaleColors(filedata$data, featurevar, cells_to_plot2_compare, feature_palette),
pt.size = input$ptsize_compare,
features = featurevar,
reduction = input$graph_compare), message = "Plot Generation", value=1) +
......
config.R
View file @ 04fcb9a7
......@@ -81,10 +81,10 @@ selectInput(inputId = "presets_grid",
}
# Then : add and/or edit the genes lists here :
# -> shiny_session : shiny_session : the session of your Shiny app (named "session" most of the time), input.presets : the preset choice
# -> shiny_session : the session of your Shiny app (named "session" most of the time), input.presets : the preset choice
PresetsListgenesGrid <- function(shiny_session, input.presets) {
if (input.presets == "plasmacells") {
updateSelectizeInput(shiny_session, "genes_list_grid", selected=c("IRF4","XBP1","PRDM1","IGKC","IGLC2","IGLC3","IGHM","IGHG1","IGHG2","IGHG3","IGHG4", "IGHA1","IGHE","IGHD","SDC1","CD38","CD19","MS4A1","SLAMF7","TNFRSF17"))
updateSelectizeInput(shiny_session, "genes_list_grid", selected=c("IRF4","XBP1","PRDM1","IGKC","IGLC2","IGLC3","IGHM","IGHG1","IGHG2","IGHG3","IGHG4", "IGHA1","IGHE","IGHD","SDC1","CD38","CD19","MS4A1","SLAMF7","TNFRSF17","NCAM1"))
} else if (input.presets == "apoptosis") {
updateSelectizeInput(shiny_session, "genes_list_grid", selected=c("MCL1","BCL2","BCL2L1","BAK","BAX","BCL2L11","BBC3"))
} else if (input.presets == "immuno") {
......@@ -92,9 +92,9 @@ PresetsListgenesGrid <- function(shiny_session, input.presets) {
}
}
## Color palettes ----
## Color palettes for Class Plots ----
# -> inputname : the name of the Shiny input object
ColorPalettes <- function(inputname) {
ClassColorPalettes <- function(inputname) {
selectInput(inputId = as.character(inputname),
label="Choose a color palette :",
choices = list(`ggplot` = c("Dark2", "Set1", "Set2", "Set3", "Pastel1", "Pastel2", "Paired", "Accent", "Spectral"),
......@@ -102,3 +102,28 @@ ColorPalettes <- function(inputname) {
`Misc` = c("simpsons","startrek", "rickandmorty")),
selected = "npg")
}
## Color palettes for Feature Plots ----
# -> inputname : the name of the Shiny input object
FeatureColorPalettes <- function(inputname) {
selectInput(inputId = as.character(inputname),
label="Choose a color palette or the color picker :",
choices = list(`Color Picker` = "Color Picker",
`viridis` = c("viridis", "plasma", "inferno", "magma"),
`ggplot` = c("YlOrRd", "YlGn", "Reds","RdPu","Purples","PuRd","PuBuGn","OrRd","Oranges","Greys","Greens","GnBu","BuPu","BuGn","Blues","RdYlGn","RdYlBu","RdGy","RdBu","PuOr","PRGn","PiYG","BrBG")),
selected = "plasma")
}
## AssignFeatureColors function ----
# -> palette : the color palette you want, color_picker : color from the color_picker input
# If you add other categories in the choices list in FeatureColorPalettes(), don't forget to add them here !
AssignFeatureColors <- function(palette, color_picker){
if (palette == "Color Picker") {
color <- color_picker
} else if (palette == "viridis" || palette == "plasma" || palette == "inferno" || palette == "magma" ){
color <- paste0(eval(parse(text=paste0(palette,"(200)"))))
} else {
color <- get_palette(palette,200)
}
return(color)
}
\ No newline at end of file
utils.R
View file @ 04fcb9a7
......@@ -10,7 +10,7 @@
AssignColors <- function(obj, ident, palette){
ident <- as.factor(ident)
nr.groups <- length(levels(ident))
colors <- colorRampPalette(get_palette(palette, 8))(nr.groups)
colors <- colorRampPalette(get_palette(palette, 9))(nr.groups)
colors.df <- data.frame(group=levels(ident), color=colors)
return(colors.df)
}
......@@ -76,7 +76,7 @@ GroupChoices <- function(obj, input_class_selector, inputname) {
GenesOrQv <- function(inputname, g, d) {
selectInput(as.character(inputname),
"Choose a Feature :",
choices = c("Genes" = as.character(g),"Quantitave Variable" = as.character(d)),
choices = c("Genes" = as.character(g),"Quantitative Variable" = as.character(d)),
selected = "Genes")
}
......@@ -124,9 +124,9 @@ MetaData <- function(cells, obj) {
}
## Compare page : Scale color for feature plots ----
# -> obj : the file you uploaded, var : the selected variable (genes or qv), cells : the subset of the selected cells,
ScaleColors <- function(obj, var, cells) {
palette.full <- c("lightgrey", plasma(200))
# -> obj : the file you uploaded, var : the selected variable (genes or qv), cells : the subset of the selected cells, palette : feature color palette
ScaleColors <- function(obj, var, cells, palette) {
palette.full <- c("lightgrey", palette)
data.max.global <- max(FetchData(obj, var))
data.max.local <- max(FetchData(cells, var))
palette.local <- palette.full[1:ceiling(length(palette.full) * data.max.local / data.max.global)]
......
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