Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
S
shiny-timecourse-inspector
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
2
Issues
2
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
3874ce02
Commit
3874ce02
authored
Jul 20, 2017
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added:
- box-/dot-/violin plots at discrete time points
parent
e346fce2
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
289 additions
and
129 deletions
+289
-129
global.R
global.R
+1
-0
modules/tabBoxPlot.R
modules/tabBoxPlot.R
+264
-0
modules/tabScatter.R
modules/tabScatter.R
+1
-0
server.R
server.R
+15
-98
ui.R
ui.R
+8
-31
No files found.
global.R
View file @
3874ce02
...
@@ -2,4 +2,5 @@ source('modules/auxfunc.R')
...
@@ -2,4 +2,5 @@ source('modules/auxfunc.R')
source
(
'modules/downPlot.R'
)
source
(
'modules/downPlot.R'
)
source
(
'modules/downCellIDsCls.R'
)
source
(
'modules/downCellIDsCls.R'
)
source
(
'modules/tabScatter.R'
)
source
(
'modules/tabScatter.R'
)
source
(
'modules/tabBoxPlot.R'
)
source
(
'modules/tabClBay.R'
)
source
(
'modules/tabClBay.R'
)
\ No newline at end of file
modules/tabBoxPlot.R
0 → 100644
View file @
3874ce02
require
(
DT
)
tabBoxPlotUI
=
function
(
id
,
label
=
"Comparing t-points"
)
{
ns
<-
NS
(
id
)
tagList
(
uiOutput
(
ns
(
'varSelTpts'
)),
DT
::
dataTableOutput
(
ns
(
'outTabStats'
)),
downloadButton
(
ns
(
'downloadData4BoxPlot'
),
'Download single-cell data'
),
fluidRow
(
column
(
6
,
radioButtons
(
ns
(
'inPlotType'
),
'Plot type:'
,
list
(
'Box-plot'
=
'box'
,
'Dot-plot'
=
'dot'
,
'Violin-plot'
=
'viol'
,
'Line-plot'
=
'line'
)),
uiOutput
(
ns
(
'uiPlotBoxNotches'
)),
uiOutput
(
ns
(
'uiPlotBoxOutliers'
)),
uiOutput
(
ns
(
'uiPlotDotNbins'
))
),
column
(
6
,
selectInput
(
ns
(
'selPlotBoxLegendPos'
),
label
=
'Select legend position'
,
choices
=
list
(
"Top"
=
'top'
,
"Right"
=
'right'
,
"Bottom"
=
'bottom'
),
selected
=
'top'
)
)
),
actionButton
(
ns
(
'butPlotBox'
),
'Plot!'
),
plotOutput
(
ns
(
'outPlotBox'
),
height
=
800
),
downPlotUI
(
ns
(
'downPlotBox'
),
"Download PDF"
)
)
}
####
## server box-plot
tabBoxPlot
=
function
(
input
,
output
,
session
,
in.data
)
{
# return all unique time points (real time)
# This will be used to display in UI for box-plot
# These timepoints are from the original dt and aren't affected by trimming of x-axis
getDataTpts
<-
reactive
({
cat
(
file
=
stderr
(),
'getDataTpts\n'
)
loc.dt
=
in.data
()
if
(
is.null
(
loc.dt
))
return
(
NULL
)
else
return
(
unique
(
loc.dt
[,
realtime
]))
# column name specified in data4trajPlot
})
# prepare data for plotting boxplots
# uses the same dt as for trajectory plotting
# returns dt with these columns:
data4boxPlot
<-
reactive
({
cat
(
file
=
stderr
(),
'data4boxPlot\n'
)
loc.dt
=
in.data
()
if
(
is.null
(
loc.dt
))
return
(
NULL
)
loc.out
=
loc.dt
[
realtime
%in%
input
$
inSelTpts
]
})
output
$
varSelTpts
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTpts\n'
)
ns
<-
session
$
ns
loc.v
=
getDataTpts
()
if
(
!
is.null
(
loc.v
))
{
selectInput
(
ns
(
'inSelTpts'
),
'Select one or more timepoints:'
,
loc.v
,
width
=
'100%'
,
selected
=
0
,
multiple
=
TRUE
)
}
})
output
$
uiPlotBoxNotches
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiPlotBoxNotches\n'
)
ns
<-
session
$
ns
if
(
input
$
inPlotType
==
'box'
)
checkboxInput
(
ns
(
'inPlotBoxNotches'
),
'Box plot notches?'
,
FALSE
)
})
output
$
uiPlotBoxOutliers
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiPlotBoxNotches\n'
)
ns
<-
session
$
ns
if
(
input
$
inPlotType
==
'box'
)
checkboxInput
(
ns
(
'inPlotBoxOutliers'
),
'Box plot outliers?'
,
FALSE
)
})
output
$
uiPlotDotNbins
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiPlotDotNbins\n'
)
ns
<-
session
$
ns
if
(
input
$
inPlotType
==
'dot'
)
sliderInput
(
ns
(
'inPlotDotNbins'
),
'Dot-plot binsize:'
,
min
=
0.01
,
max
=
1
,
value
=
.1
)
})
calcStats
=
reactive
({
cat
(
file
=
stderr
(),
'tabBoxPlot: calsStats\n'
)
loc.dt
=
data4boxPlot
()
if
(
is.null
(
loc.dt
))
return
(
NULL
)
loc.dt.aggr
=
loc.dt
[,
sapply
(
.SD
,
function
(
x
)
list
(
'Mean'
=
mean
(
x
),
'CV'
=
sd
(
x
)
/
mean
(
x
),
'Median'
=
median
(
x
),
'rCV (IQR)'
=
IQR
(
x
)
/
median
(
x
),
'rCV (MAD)'
=
mad
(
x
)
/
median
(
x
))),
.SDcols
=
c
(
'y'
),
by
=
.
(
realtime
,
group
)]
setnames
(
loc.dt.aggr
,
c
(
'Time point'
,
'Group'
,
'Mean'
,
'CV'
,
'Median'
,
'rCV IQR'
,
'rCV MAD'
))
print
(
loc.dt.aggr
)
return
(
loc.dt.aggr
)
})
output
$
downloadData4BoxPlot
<-
downloadHandler
(
filename
=
'data4boxplot.csv'
,
content
=
function
(
file
)
{
write.csv
(
data4boxPlot
(),
file
,
row.names
=
FALSE
)
}
)
# output$outTabStats = DT::renderDataTable(calcStats(),
# server = FALSE,
# rownames = FALSE,
# extensions = 'Buttons',
# options = list(
# dom = 'Bfrtip',
# buttons = list('copy',
# 'print',
# list(extend = 'collection',
# buttons = list(list(extend='csv',
# filename = 'hitStats'),
# list(extend='excel',
# filename = 'hitStats'),
# list(extend='pdf',
# filename= 'hitStats')),
# text = 'Download'))))
#
output
$
outTabStats
=
DT
::
renderDataTable
(
server
=
FALSE
,
{
cat
(
file
=
stderr
(),
'tabBoxPlot: outTabStats\n'
)
loc.dt
=
calcStats
()
if
(
is.null
(
loc.dt
))
return
(
NULL
)
datatable
(
loc.dt
,
rownames
=
FALSE
,
extensions
=
'Buttons'
,
options
=
list
(
dom
=
'Bfrtip'
,
buttons
=
list
(
'copy'
,
'print'
,
list
(
extend
=
'collection'
,
buttons
=
list
(
list
(
extend
=
'csv'
,
filename
=
'hitStats'
),
list
(
extend
=
'excel'
,
filename
=
'hitStats'
),
list
(
extend
=
'pdf'
,
filename
=
'hitStats'
)),
text
=
'Download'
))))
%>%
formatRound
(
3
:
7
,
3
)
})
# Boxplot - display
output
$
outPlotBox
=
renderPlot
({
locBut
=
input
$
butPlotBox
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'plotBox: Go button not pressed\n'
)
return
(
NULL
)
}
plotBox
()
},
height
=
800
)
# Boxplot - download pdf
callModule
(
downPlot
,
"downPlotBox"
,
'boxplot.pdf'
,
plotBox
,
TRUE
)
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
# This function is used to plot and to downoad a pdf
plotBox
<-
function
()
{
cat
(
file
=
stderr
(),
'plotBox\n'
)
loc.dt
=
data4boxPlot
()
cat
(
file
=
stderr
(),
"plotBox: on to plot\n\n"
)
if
(
is.null
(
loc.dt
))
{
cat
(
file
=
stderr
(),
'plotBox: dt is NULL\n'
)
return
(
NULL
)
}
cat
(
file
=
stderr
(),
'plotBox:dt not NULL\n'
)
p.out
=
ggplot
(
loc.dt
,
aes
(
x
=
as.factor
(
realtime
),
y
=
y
))
if
(
input
$
inPlotType
==
'box'
)
p.out
=
p.out
+
geom_boxplot
(
aes
(
fill
=
group
),
#position = position_dodge(width = 1),
notch
=
input
$
inPlotBoxNotches
,
outlier.colour
=
if
(
input
$
inPlotBoxOutliers
)
'red'
else
NA
)
if
(
input
$
inPlotType
==
'dot'
)
p.out
=
p.out
+
geom_dotplot
(
aes
(
fill
=
group
),
binaxis
=
"y"
,
stackdir
=
"center"
,
position
=
"dodge"
,
binwidth
=
input
$
inPlotDotNbins
,
method
=
'histodot'
)
if
(
input
$
inPlotType
==
'viol'
)
p.out
=
p.out
+
geom_violin
(
aes
(
fill
=
group
))
if
(
input
$
inPlotType
==
'line'
)
p.out
=
p.out
+
geom_path
(
aes
(
color
=
group
,
group
=
id
))
p.out
=
p.out
+
scale_fill_discrete
(
name
=
''
)
+
xlab
(
'\nTime (min)'
)
+
ylab
(
''
)
+
theme_bw
(
base_size
=
18
,
base_family
=
"Helvetica"
)
+
theme
(
panel.grid.minor
=
element_blank
(),
panel.grid.major
=
element_blank
(),
panel.border
=
element_blank
(),
axis.line.x
=
element_line
(
color
=
"black"
,
size
=
0.25
),
axis.line.y
=
element_line
(
color
=
"black"
,
size
=
0.25
),
axis.text.x
=
element_text
(
size
=
12
),
axis.text.y
=
element_text
(
size
=
12
),
strip.text.x
=
element_text
(
size
=
14
,
face
=
"bold"
),
strip.text.y
=
element_text
(
size
=
14
,
face
=
"bold"
),
strip.background
=
element_blank
(),
legend.key
=
element_blank
(),
legend.key.height
=
unit
(
1
,
"lines"
),
legend.key.width
=
unit
(
2
,
"lines"
),
legend.position
=
input
$
selPlotBoxLegendPos
)
return
(
p.out
)
}
}
\ No newline at end of file
modules/tabScatter.R
View file @
3874ce02
...
@@ -12,6 +12,7 @@
...
@@ -12,6 +12,7 @@
require
(
plotly
)
# interactive plot
require
(
plotly
)
# interactive plot
require
(
robust
)
require
(
robust
)
require
(
MASS
)
# UI
# UI
tabScatterPlotUI
<-
function
(
id
,
label
=
"Comparing t-points"
)
{
tabScatterPlotUI
<-
function
(
id
,
label
=
"Comparing t-points"
)
{
...
...
server.R
View file @
3874ce02
...
@@ -20,7 +20,7 @@ library(sparcl) # sparse hierarchical and k-means
...
@@ -20,7 +20,7 @@ library(sparcl) # sparse hierarchical and k-means
library
(
scales
)
# for percentages on y scale
library
(
scales
)
# for percentages on y scale
# increase file upload limit
# increase file upload limit
options
(
shiny.maxRequestSize
=
3
0
*
1024
^
2
)
options
(
shiny.maxRequestSize
=
8
0
*
1024
^
2
)
shinyServer
(
function
(
input
,
output
,
session
)
{
shinyServer
(
function
(
input
,
output
,
session
)
{
useShinyjs
()
useShinyjs
()
...
@@ -377,9 +377,18 @@ shinyServer(function(input, output, session) {
...
@@ -377,9 +377,18 @@ shinyServer(function(input, output, session) {
if
(
is.null
(
loc.dt
))
if
(
is.null
(
loc.dt
))
return
(
NULL
)
return
(
NULL
)
loc.dt
[,
trackObjectsLabelUni
:=
paste
(
sprintf
(
"%03d"
,
get
(
input
$
inSelSite
)),
loc.types
=
lapply
(
loc.dt
,
class
)
sprintf
(
"%04d"
,
get
(
input
$
inSelTrackLabel
)),
if
(
loc.types
[[
input
$
inSelTrackLabel
]]
==
'numeric'
)
sep
=
"_"
)]
{
loc.dt
[,
trackObjectsLabelUni
:=
paste
(
sprintf
(
"%03d"
,
get
(
input
$
inSelSite
)),
sprintf
(
"%04d"
,
get
(
input
$
inSelTrackLabel
)),
sep
=
"_"
)]
}
else
{
loc.dt
[,
trackObjectsLabelUni
:=
paste
(
sprintf
(
"%03s"
,
get
(
input
$
inSelSite
)),
sprintf
(
"%s"
,
get
(
input
$
inSelTrackLabel
)),
sep
=
"_"
)]
}
return
(
loc.dt
)
return
(
loc.dt
)
})
})
...
@@ -559,18 +568,6 @@ shinyServer(function(input, output, session) {
...
@@ -559,18 +568,6 @@ shinyServer(function(input, output, session) {
return
(
loc.out
)
return
(
loc.out
)
})
})
# prepare data for plotting boxplots
# uses the same dt as for trajectory plotting
# returns dt with these columns:
data4boxPlot
<-
reactive
({
cat
(
file
=
stderr
(),
'data4boxPlot\n'
)
loc.dt
=
data4trajPlot
()
if
(
is.null
(
loc.dt
))
return
(
NULL
)
loc.out
=
loc.dt
[
realtime
%in%
input
$
inSelTpts
]
})
# prepare data for clustering
# prepare data for clustering
...
@@ -718,89 +715,9 @@ shinyServer(function(input, output, session) {
...
@@ -718,89 +715,9 @@ shinyServer(function(input, output, session) {
}
}
###### Box-plot
callModule
(
tabBoxPlot
,
'tabBoxPlot'
,
data4trajPlot
)
####
## UI for box-plot
output
$
varSelTpts
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTpts\n'
)
loc.v
=
getDataTpts
()
if
(
!
is.null
(
loc.v
))
{
selectInput
(
'inSelTpts'
,
'Select one or more timepoints:'
,
loc.v
,
width
=
'100%'
,
selected
=
0
,
multiple
=
TRUE
)
}
})
# Boxplot - display
output
$
outPlotBox
=
renderPlot
({
locBut
=
input
$
butPlotBox
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'plotBox: Go button not pressed\n'
)
return
(
NULL
)
}
plotBox
()
},
height
=
800
)
# Boxplot - download pdf
callModule
(
downPlot
,
"downPlotBox"
,
'boxplot.pdf'
,
plotBox
,
TRUE
)
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
# This function is used to plot and to downoad a pdf
plotBox
<-
function
()
{
cat
(
file
=
stderr
(),
'plotBox\n'
)
loc.dt
=
data4boxPlot
()
cat
(
file
=
stderr
(),
"plotBox: on to plot\n\n"
)
if
(
is.null
(
loc.dt
))
{
cat
(
file
=
stderr
(),
'plotBox: dt is NULL\n'
)
return
(
NULL
)
}
cat
(
file
=
stderr
(),
'plotBox:dt not NULL\n'
)
ggplot
(
loc.dt
,
aes
(
x
=
as.factor
(
realtime
),
y
=
y
))
+
geom_boxplot
(
aes
(
fill
=
group
),
#position = position_dodge(width = 1),
notch
=
input
$
inPlotBoxNotches
,
outlier.colour
=
if
(
input
$
inPlotBoxOutliers
)
'red'
else
NA
)
+
scale_fill_discrete
(
name
=
''
)
+
xlab
(
'\nTime (min)'
)
+
ylab
(
''
)
+
theme_bw
(
base_size
=
18
,
base_family
=
"Helvetica"
)
+
theme
(
panel.grid.minor
=
element_blank
(),
panel.grid.major
=
element_blank
(),
panel.border
=
element_blank
(),
axis.line.x
=
element_line
(
color
=
"black"
,
size
=
0.25
),
axis.line.y
=
element_line
(
color
=
"black"
,
size
=
0.25
),
axis.text.x
=
element_text
(
size
=
12
),
axis.text.y
=
element_text
(
size
=
12
),
strip.text.x
=
element_text
(
size
=
14
,
face
=
"bold"
),
strip.text.y
=
element_text
(
size
=
14
,
face
=
"bold"
),
strip.background
=
element_blank
(),
legend.key
=
element_blank
(),
legend.key.height
=
unit
(
1
,
"lines"
),
legend.key.width
=
unit
(
2
,
"lines"
),
legend.position
=
input
$
selPlotBoxLegendPos
)
}
###### Scatter plot
###### Scatter plot
...
...
ui.R
View file @
3874ce02
...
@@ -113,32 +113,9 @@ shinyUI(fluidPage(
...
@@ -113,32 +113,9 @@ shinyUI(fluidPage(
downPlotUI
(
'downPlotTraj'
,
"Download PDF"
)
downPlotUI
(
'downPlotTraj'
,
"Download PDF"
)
),
),
tabPanel
(
"Box-plots"
,
tabPanel
(
br
(),
"Box-plots"
,
fluidRow
(
tabBoxPlotUI
(
'tabBoxPlot'
)
column
(
6
,
checkboxInput
(
'inPlotBoxNotches'
,
'Box plot notches?'
,
FALSE
),
checkboxInput
(
'inPlotBoxOutliers'
,
'Box plot outliers?'
,
TRUE
)
),
column
(
6
,
selectInput
(
'selPlotBoxLegendPos'
,
label
=
'Select legend position'
,
choices
=
list
(
"Top"
=
'top'
,
"Right"
=
'right'
,
"Bottom"
=
'bottom'
),
selected
=
'top'
)
)
),
uiOutput
(
'varSelTpts'
),
actionButton
(
'butPlotBox'
,
'Plot!'
),
plotOutput
(
'outPlotBox'
,
height
=
800
),
downPlotUI
(
'downPlotBox'
,
"Download PDF"
)
),
),
...
@@ -475,11 +452,11 @@ shinyUI(fluidPage(
...
@@ -475,11 +452,11 @@ shinyUI(fluidPage(
actionButton
(
'butPlotHierSparClDist'
,
'Plot!'
),
actionButton
(
'butPlotHierSparClDist'
,
'Plot!'
),
plotOutput
(
'outPlotHierSparClDist'
))
plotOutput
(
'outPlotHierSparClDist'
))
)
)
)
,
)
#
tabPanel
(
#
tabPanel(
'Bayesian Cl.'
,
#
'Bayesian Cl.',
clustBayUI
(
'TabClustBay'
))
#
clustBayUI('TabClustBay'))
))
))
)
)
...
...
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