Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
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
3704a71c
Commit
3704a71c
authored
Apr 24, 2019
by
Bagueneau Mathias
Browse files
- Compare : Ajout d'une miniature + sélections multiples possibles
parent
407a3449
Changes
1
Hide whitespace changes
Inline
Side-by-side
app.R
View file @
3704a71c
...
...
@@ -17,7 +17,7 @@ library(RColorBrewer)
library
(
MAST
)
library
(
data.table
)
library
(
clusterProfiler
)
library
(
org.Hs.eg.db
)
# A installer sur bird
library
(
org.Hs.eg.db
)
# library(topGO)
# library(BiocGenerics)
...
...
@@ -194,7 +194,7 @@ body <- dashboardBody(
uiOutput
(
outputId
=
"clusters_infos_compare"
),
br
(),
conditionalPanel
(
condition
=
"output.fileUploaded"
,
fluidRow
(
column
(
align
=
"center"
,
width
=
2
,
ui
Output
(
outputId
=
"
plotlist"
,
align
=
"left
"
)),
fluidRow
(
column
(
align
=
"center"
,
width
=
2
,
plot
Output
(
outputId
=
"
miniplot_compare"
,
width
=
"250px"
,
height
=
"250px
"
)),
column
(
align
=
"center"
,
width
=
5
,
plotlyOutput
(
"plot1_compare"
,
width
=
"450px"
,
height
=
"450px"
),
br
(),
uiOutput
(
"plot1_library"
),
downloadButton
(
"dl_compare1"
,
label
=
""
)),
column
(
align
=
"center"
,
width
=
5
,
plotlyOutput
(
"plot2_compare"
,
width
=
"450px"
,
height
=
"450px"
),
br
(),
uiOutput
(
"plot2_library"
),
downloadButton
(
"dl_compare2"
,
label
=
""
))
),
...
...
@@ -288,32 +288,48 @@ server <- function(input, output, session) {
}
})
miniplot_compareData
<-
reactive
({
if
(
input
$
choice_compare
==
"f_compare"
)
{
withProgress
(
DimPlot
(
object
=
filedata
$
data
,
label
=
TRUE
,
pt.size
=
input
$
ptsize_compare
,
legend
=
"none"
,
reduction
=
input
$
graph_compare
,
group.by
=
input
$
fsel2
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
NoLegend
()
}
else
{
if
(
input
$
featuresel2
==
"d2"
)
{
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
legend
=
"none"
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
nsel2
))))))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
nsel2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
}
else
if
(
input
$
featuresel2
==
"g2"
)
{
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
legend
=
"none"
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
filedata
$
data
@
assays
$
SCT
@
data
[
input
$
genes2
,])))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
genes2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
}
}
})
plot1_compareData
<-
reactive
({
df.colors
<-
data.frame
(
class
=
unique
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))),
color
=
"viridis"
(
length
(
unique
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))))))
#
df.colors <- data.frame(class=unique(eval(parse(text=paste0("filedata$data@meta.data$",input$fsel2)))), color="viridis"(length(unique(eval(parse(text=paste0("filedata$data@meta.data$",input$fsel2)))))))
scalex
<-
scale_x_continuous
(
limits
=
c
(
min
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
]),
max
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
])))
scaley
<-
scale_y_continuous
(
limits
=
c
(
min
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
]),
max
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
])))
cells_to_plot
<-
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
%in%
input
$
library1_compare
)]
if
(
input
$
choice_compare
==
"f_compare"
)
{
withProgress
(
DimPlot
(
object
=
filedata
$
data
,
cols
=
df.colors
[
df.colors
$
class
==
input
$
library1_compare
,
"color"
],
cells
=
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
==
input
$
library1_compare
)]
,
label
=
FALSE
,
pt.size
=
input
$
ptsize_compare
,
reduction
=
input
$
graph_compare
,
group.by
=
input
$
fsel2
),
message
=
"Plot Generation"
,
value
=
1
)
+
NoLegend
()
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"-
Group"
,
input
$
library1_compare
,
"-
"
,
input
$
fsel2
))
+
scalex
+
scaley
withProgress
(
DimPlot
(
object
=
filedata
$
data
,
cells
=
cells_to_plot
,
label
=
FALSE
,
pt.size
=
input
$
ptsize_compare
,
reduction
=
input
$
graph_compare
,
group.by
=
input
$
fsel2
),
message
=
"Plot Generation"
,
value
=
1
)
+
NoLegend
()
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"-"
,
input
$
fsel2
))
+
scalex
+
scaley
}
else
{
if
(
input
$
featuresel2
==
"d2"
)
{
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
==
input
$
library1_compare
)]
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
nsel2
))))))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
nsel2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Feature Plot -"
,
input
$
nsel2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
cells_to_plot
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
nsel2
))))))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
nsel2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Feature Plot -"
,
input
$
nsel2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
}
else
if
(
input
$
featuresel2
==
"g2"
)
{
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
==
input
$
library1_compare
)]
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
filedata
$
data
@
assays
$
SCT
@
data
[
input
$
genes2
,])))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
genes2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Gene Plot -"
,
input
$
genes2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
cells_to_plot
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
filedata
$
data
@
assays
$
SCT
@
data
[
input
$
genes2
,])))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
genes2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Gene Plot -"
,
input
$
genes2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
}
}
})
plot2_compareData
<-
reactive
({
df.colors
<-
data.frame
(
class
=
unique
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))),
color
=
"viridis"
(
length
(
unique
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))))))
#
df.colors <- data.frame(class=unique(eval(parse(text=paste0("filedata$data@meta.data$",input$fsel2)))), color="viridis"(length(unique(eval(parse(text=paste0("filedata$data@meta.data$",input$fsel2)))))))
scalex
<-
scale_x_continuous
(
limits
=
c
(
min
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
]),
max
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
])))
scaley
<-
scale_y_continuous
(
limits
=
c
(
min
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
]),
max
(
filedata
$
data
@
reductions
[[
input
$
graph_compare
]]
@
cell.embeddings
[,
1
])))
cells_to_plot
<-
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
%in%
input
$
library2_compare
)]
if
(
input
$
choice_compare
==
"f_compare"
)
{
withProgress
(
DimPlot
(
object
=
filedata
$
data
,
cells
=
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
==
input
$
library2_compare
)],
cols
=
df.colors
[
df.colors
$
class
==
input
$
library2_compare
,
"color"
],
pt.size
=
input
$
ptsize_compare
,
reduction
=
input
$
graph_compare
,
group.by
=
input
$
fsel2
),
message
=
"Plot Generation"
,
value
=
1
)
+
NoLegend
()
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Group"
,
input
$
library2_compare
,
"-"
,
input
$
fsel2
))
+
scalex
+
scaley
}
else
{
withProgress
(
DimPlot
(
object
=
filedata
$
data
,
cells
=
cells_to_plot
,
pt.size
=
input
$
ptsize_compare
,
reduction
=
input
$
graph_compare
,
group.by
=
input
$
fsel2
),
message
=
"Plot Generation"
,
value
=
1
)
+
NoLegend
()
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"-"
,
input
$
fsel2
))
+
scalex
+
scaley
# cols = df.colors[df.colors$class==input$library2_compare, "color"],
}
else
{
if
(
input
$
featuresel2
==
"d2"
)
{
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
==
input
$
library2_compare
)],
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
nsel2
))))))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
nsel2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Feature Plot -"
,
input
$
nsel2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
cells_to_plot
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
nsel2
))))))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
nsel2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Feature Plot -"
,
input
$
nsel2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
}
else
if
(
input
$
featuresel2
==
"g2"
)
{
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
rownames
(
filedata
$
data
@
meta.data
)[
which
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
)))
==
input
$
library2_compare
)],
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
filedata
$
data
@
assays
$
SCT
@
data
[
input
$
genes2
,])))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
genes2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Gene Plot -"
,
input
$
genes2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
withProgress
(
FeaturePlot
(
object
=
filedata
$
data
,
cells
=
cells_to_plot
,
cols
=
c
(
"lightgrey"
,
plasma
(
ceiling
(
max
(
filedata
$
data
@
assays
$
SCT
@
data
[
input
$
genes2
,])))),
pt.size
=
input
$
ptsize_compare
,
features
=
input
$
genes2
,
reduction
=
input
$
graph_compare
),
message
=
"Plot Generation"
,
value
=
1
)
+
theme_bw
()
+
NoAxes
()
+
ggtitle
(
paste
(
filedata
$
name
,
"- Gene Plot -"
,
input
$
genes2
))
+
scalex
+
scaley
#+ aes(text=Cells(filedata$data))
}
}
})
...
...
@@ -332,9 +348,13 @@ server <- function(input, output, session) {
output
$
markers_table
<-
renderDataTable
({
req
(
filedata
$
data
)
req
(
markersData
()
!=
""
)
datatable
(
markersData
()[
c
(
6
,
3
,
4
,
2
,
1
,
5
)])
%>%
formatRound
(
columns
=
c
(
3
,
4
,
2
,
1
,
5
),
digits
=
5
)
datatable
(
markersData
()[
c
(
6
,
3
,
4
,
2
,
1
,
5
)])
%>%
formatRound
(
columns
=
c
(
2
,
3
,
4
),
digits
=
5
)
%>%
formatSignif
(
columns
=
c
(
6
,
5
),
digits
=
5
)
})
output
$
miniplot_compare
<-
renderPlot
({
req
(
filedata
$
data
)
plot
(
miniplot_compareData
())
})
output
$
plot1_compare
<-
renderPlotly
({
req
(
filedata
$
data
)
...
...
@@ -446,9 +466,9 @@ server <- function(input, output, session) {
output
$
dl_compare1
<-
downloadHandler
(
filename
=
function
()
{
if
(
input
$
choice_compare
==
"f_compare"
)
{
paste0
(
filedata
$
name
,
"_
library"
,
input
$
library1_compare
,
"_
plot_"
,
input
$
fsel2
,
"_"
,
input
$
graph_compare
,
".svg"
)
paste0
(
filedata
$
name
,
"_plot_"
,
input
$
fsel2
,
"_"
,
input
$
graph_compare
,
".svg"
)
}
else
{
paste0
(
filedata
$
name
,
"_
library"
,
input
$
library1_compare
,
"_
plot_"
,
input
$
graph_compare
,
".svg"
)
paste0
(
filedata
$
name
,
"_plot_"
,
input
$
graph_compare
,
".svg"
)
}
},
content
=
function
(
file
)
{
...
...
@@ -461,9 +481,9 @@ server <- function(input, output, session) {
output
$
dl_compare2
<-
downloadHandler
(
filename
=
function
()
{
if
(
input
$
choice_compare
==
"f_compare"
)
{
paste0
(
filedata
$
name
,
"_
patient"
,
input
$
library2_compare
,
"_
plot_"
,
input
$
fsel2
,
"_"
,
input
$
graph_compare
,
".svg"
)
paste0
(
filedata
$
name
,
"_plot_"
,
input
$
fsel2
,
"_"
,
input
$
graph_compare
,
".svg"
)
}
else
{
paste0
(
filedata
$
name
,
"_
patient"
,
input
$
library2_compare
,
"_
plot_"
,
input
$
graph_compare
,
".svg"
)
paste0
(
filedata
$
name
,
"_plot_"
,
input
$
graph_compare
,
".svg"
)
}
},
content
=
function
(
file
)
{
...
...
@@ -584,14 +604,14 @@ server <- function(input, output, session) {
req
(
filedata
$
data
)
choice
<-
unique
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
))))
req
(
!
is.na
(
choice
))
selectInput
(
"library1_compare"
,
"Choose a group :"
,
multiple
=
FALS
E
,
choices
=
choice
[
order
(
choice
)])
selectInput
(
"library1_compare"
,
"Choose a group :"
,
multiple
=
TRU
E
,
choices
=
choice
[
order
(
choice
)])
})
output
$
plot2_library
<-
renderUI
({
req
(
filedata
$
data
)
choice
<-
unique
(
eval
(
parse
(
text
=
paste0
(
"filedata$data@meta.data$"
,
input
$
fsel2
))))
req
(
!
is.na
(
choice
))
selectInput
(
"library2_compare"
,
"Choose a group :"
,
multiple
=
FALS
E
,
choices
=
choice
[
order
(
choice
)])
selectInput
(
"library2_compare"
,
"Choose a group :"
,
multiple
=
TRU
E
,
choices
=
choice
[
order
(
choice
)])
})
output
$
group
<-
renderUI
({
# Genes Page
...
...
@@ -626,9 +646,10 @@ server <- function(input, output, session) {
})
observeEvent
(
input
$
findmarkers
,
{
if
(
input
$
library1_compare
==
input
$
library2_compare
)
{
showModal
(
modalDialog
(
"You must choose two different groups"
,
title
=
strong
(
"Warning"
),
easyClose
=
TRUE
,
footer
=
NULL
)
)
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
))
}
else
if
(
length
(
intersect
(
input
$
library1_compare
,
input
$
library2_compare
))
!=
0
)
{
showModal
(
modalDialog
(
"You must choose only different groups."
,
title
=
strong
(
"Warning !"
),
easyClose
=
TRUE
,
footer
=
NULL
))
}
else
{
if
(
!
exists
(
"ffm"
))
{
ffm
<-
filedata
$
data
...
...
@@ -638,12 +659,12 @@ server <- function(input, output, session) {
setDT
(
df
,
keep.rownames
=
TRUE
)[]
df
<-
data.frame
(
c
(
df
,(
input
$
fsel2
)))
names
(
df
)[[
1
]]
<-
"Gene"
names
(
df
)[[
4
]]
<-
paste
(
"pct."
,
input
$
library1_compare
)
names
(
df
)[[
5
]]
<-
paste
(
"pct."
,
input
$
library2_compare
)
names
(
df
)[[
4
]]
<-
paste
(
"pct."
,
sapply
(
input
$
library1_compare
,
paste
,
collapse
=
""
),
collapse
=
" + "
)
names
(
df
)[[
5
]]
<-
paste
(
"pct."
,
sapply
(
input
$
library2_compare
,
paste
,
collapse
=
""
),
collapse
=
" + "
)
names
(
df
)[[
7
]]
<-
paste
(
""
,
input
$
fsel2
)
output
$
markers_compare
<-
renderDataTable
({
req
(
filedata
$
data
)
withProgress
(
datatable
(
df
[
c
(
1
,
4
,
5
,
3
,
2
,
6
)],
rownames
=
FALSE
),
message
=
"Render DataTable"
,
value
=
1
)
%>%
formatRound
(
columns
=
c
(
1
,
4
,
5
,
3
,
2
,
6
),
digits
=
5
)
withProgress
(
datatable
(
df
[
c
(
1
,
4
,
5
,
3
,
2
,
6
)],
rownames
=
FALSE
),
message
=
"Render DataTable"
,
value
=
1
)
%>%
formatRound
(
columns
=
c
(
1
,
2
,
3
,
4
),
digits
=
5
)
%>%
formatSignif
(
columns
=
c
(
6
,
5
),
digits
=
5
)
})
output
$
dlmarkbutton_compare
<-
renderUI
({
downloadButton
(
"dlmarkers_compare"
,
label
=
""
)
...
...
Write
Preview
Supports
Markdown
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