Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Bagueneau Mathias
Shiny SChnurR
Commits
04fcb9a7
Commit
04fcb9a7
authored
Jun 12, 2019
by
Bagueneau Mathias
Browse files
- Color palettes and color picker for Feature Plots !
parent
63c73f90
Changes
3
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 !
Class
ColorPalettes
(
"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
)
{
Class
ColorPalettes
<-
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
),
"Quantita
ti
ve 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"
,
p
lasma
(
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"
,
p
alette
)
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
)]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment