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
3f2d3136
Commit
3f2d3136
authored
Sep 27, 2019
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Bug fixes
parent
f78cdc1a
Changes
15
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
444 additions
and
426 deletions
+444
-426
example-data/test-datasets/2traj_2missing_middle.csv
example-data/test-datasets/2traj_2missing_middle.csv
+0
-0
example-data/test-datasets/3traj_5tpts_wide.csv
example-data/test-datasets/3traj_5tpts_wide.csv
+0
-0
modules/auxfunc.R
modules/auxfunc.R
+70
-74
modules/boxPlot.R
modules/boxPlot.R
+15
-15
modules/clDistPlot.R
modules/clDistPlot.R
+3
-3
modules/dispStats.R
modules/dispStats.R
+7
-5
modules/dispTrackStats.R
modules/dispTrackStats.R
+3
-3
modules/tabAUC.R
modules/tabAUC.R
+6
-6
modules/tabBoxPlot.R
modules/tabBoxPlot.R
+29
-27
modules/tabClHier.R
modules/tabClHier.R
+109
-119
modules/tabClHierSpar.R
modules/tabClHierSpar.R
+131
-111
modules/tabScatter.R
modules/tabScatter.R
+30
-34
modules/trajPlot.R
modules/trajPlot.R
+13
-14
server.R
server.R
+25
-12
ui.R
ui.R
+3
-3
No files found.
example-data/test-datasets/
simplest_wMissing_w1OutlierM
iddle.csv
→
example-data/test-datasets/
2traj_2missing_m
iddle.csv
View file @
3f2d3136
File moved
example-data/test-datasets/wide.csv
→
example-data/test-datasets/
3traj_5tpts_
wide.csv
View file @
3f2d3136
File moved
modules/auxfunc.R
View file @
3f2d3136
...
...
@@ -45,7 +45,7 @@ PLOTWIDTH = 85 # in percent
PLOTNFACETDEFAULT
=
3
# internal column names
COLRT
=
'
real
time'
COLRT
=
'time'
COLY
=
'y'
COLID
=
'id'
COLIDUNI
=
'trackObjectsLabelUni'
...
...
@@ -96,13 +96,14 @@ md_cols <- c(
# list of palettes for the heatmap
l.col.pal
=
list
(
"White-Orange-Red"
=
'OrRd'
,
"Yellow-Orange-Red"
=
'YlOrRd'
,
"Spectral"
=
'Spectral'
,
"Red-Yellow-Green"
=
'RdYlGn'
,
"Red-Yellow-Blue"
=
'RdYlBu'
,
"Greys"
=
"Greys"
,
"Reds"
=
"Reds"
,
"Oranges"
=
"Oranges"
,
"Greens"
=
"Greens"
,
"Blues"
=
"Blues"
,
"Spectral"
=
'Spectral'
"Blues"
=
"Blues"
)
# list of palettes for the dendrogram
...
...
@@ -115,23 +116,40 @@ l.col.pal.dend = list(
"Diverge HSV"
=
'diverge_hsv'
)
# list of palettes for the dendrogram
l.col.pal.dend.2
=
list
(
"Colorblind 10"
=
'Color Blind'
,
"Tableau 10"
=
'Tableau 10'
,
"Tableau 20"
=
'Tableau 20'
,
"Classic 10"
=
"Classic 10"
,
"Classic 20"
=
"Classic 20"
,
"Traffic 9"
=
'Traffic'
,
"Seattle Grays 5"
=
'Seattle Grays'
)
# Clustering algorithms ----
s.cl.linkage
=
c
(
"ward.D"
,
"ward.D2"
,
"single"
,
s.cl.linkage
=
c
(
"average"
,
"complete"
,
"average"
,
"mcquitty"
,
"centroid"
)
"single"
,
"centroid"
,
"ward.D"
,
"ward.D2"
,
"mcquitty"
)
s.cl.spar.linkage
=
c
(
"average"
,
"complete"
,
"single"
,
"centroid"
)
s.cl.diss
=
c
(
"euclidean"
,
"maximum"
,
"manhattan"
,
"canberra"
,
"binary"
,
"minkowski"
,
"DTW"
)
s.cl.spar.diss
=
c
(
"squared.distance"
,
"absolute.value"
)
s.cl.diss
=
c
(
"euclidean"
,
"maximum"
,
"manhattan"
,
"canberra"
,
"DTW"
)
s.cl.spar.diss
=
c
(
"squared.distance"
,
"absolute.value"
)
# Help text ----
...
...
@@ -159,20 +177,24 @@ helpPopup <- function(title, content,
}
help.text.short
=
c
(
'Load CSV file with a column of track IDs for removal. IDs should correspond to those used for plotting.'
,
'If the track ID is unique only within a group, make it unique globally by combining with the grouping column.'
,
'Interpolate missing time points and pre-existing NAs. The interval of the time column must be provided!'
,
'Load CSV file with 5 columns: grouping, start and end tpts of stimulation, start and end of y-position, dummy column with ID.'
,
'Select columns to group data according to treatment, condition, etc.'
,
'Select math operation to perform on a single or two columns,'
,
'Select range of time for further processing.'
,
'Divide measurments by the mean/median or calculate z-score with respect to selected time span.'
,
'Download time series after modification in this section.'
,
'Long format: a row is a single data point. Wide format: a row is a time series with columns as time points.'
,
'Fold-change or z-score with respect to selected time span.'
,
'Normalise with respect to this time span.'
,
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.'
,
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.'
'Load CSV file with a column of track IDs for removal. IDs should correspond to those used for plotting.'
,
#1
'If the track ID is unique only within a group, make it unique globally by combining with the grouping column.'
,
#2
'Interpolate missing time points and pre-existing NAs. The interval of the time column must be provided!'
,
#3
'Load CSV file with 5 columns: grouping, start and end tpts of stimulation, start and end of y-position, dummy column with ID.'
,
#4
'Select columns to group data according to treatment, condition, etc.'
,
#5
'Select math operation to perform on a single or two columns,'
,
#6
'Select range of time for further processing.'
,
#7
'Divide measurments by the mean/median or calculate z-score with respect to selected time span.'
,
#8
'Download time series after modification in this section.'
,
#9
'Long format: a row is a single data point. Wide format: a row is a time series with columns as time points.'
,
#10
'Fold-change or z-score with respect to selected time span.'
,
#11
'Normalise with respect to this time span.'
,
#12
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.'
,
#13
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.'
,
#14
'Instead of the value at a selected time point, y-axis can display a difference between values at time points on y- and x-axis.'
,
#15
'Add a line with linear regression and regions of 95% confidence interval.'
,
#16
'A number of time points left & right of selected time points; use the mean/min/max of values from these time points for the scatterplot.'
,
#17
'Operations to perform on values at time points selected in the field above.'
#18
)
# Functions for data processing ----
...
...
@@ -765,60 +787,41 @@ LOCplotPSD <- function(dt.arg, # input data table
return
(
p.tmp
)
}
# Plots a scatter plot with marginal histograms
# Points are connected by a line (grouping by cellID)
#
# Assumes an input of data.table with
# x, y - columns with x and y coordinates
# id - a unique point identifier (here corresponds to cellID)
# mid - a (0,1) column by which points are coloured (here corresponds to whether cells are within bounds)
LOCggplotScat
=
function
(
dt.arg
,
band.arg
=
NULL
,
#' Plot a scatter plot with an optional linear regression
#'
#' @param dt.arg input of data.table with 2 columns with x and y coordinates
#' @param facet.arg
#' @param facet.ncol.arg
#' @param xlab.arg
#' @param ylab.arg
#' @param plotlab.arg
#' @param alpha.arg
#' @param trend.arg
#' @param ci.arg
LOCggplotScat
=
function
(
dt.arg
,
facet.arg
=
NULL
,
facet.ncol.arg
=
2
,
xlab.arg
=
NULL
,
ylab.arg
=
NULL
,
plotlab.arg
=
NULL
,
alpha.arg
=
1
,
group.col.arg
=
NULL
)
{
p.tmp
=
ggplot
(
dt.arg
,
aes
(
x
=
x
,
y
=
y
))
trend.arg
=
T
,
ci.arg
=
0.95
)
{
if
(
is.null
(
group.col.arg
))
{
p.tmp
=
p.tmp
+
geom_point
(
alpha
=
alpha.arg
,
aes
(
group
=
id
))
}
else
{
p.tmp
=
p.tmp
+
geom_point
(
aes
(
colour
=
as.factor
(
get
(
group.col.arg
)),
group
=
id
),
alpha
=
alpha.arg
)
+
geom_path
(
aes
(
colour
=
as.factor
(
get
(
group.col.arg
)),
group
=
id
),
alpha
=
alpha.arg
)
+
scale_color_manual
(
name
=
group.col.arg
,
values
=
c
(
"FALSE"
=
rhg_cols
[
7
],
"TRUE"
=
rhg_cols
[
3
],
"SELECTED"
=
'green'
))
}
if
(
is.null
(
band.arg
))
p.tmp
=
ggplot
(
dt.arg
,
aes
(
x
=
x
,
y
=
y
))
+
geom_point
(
alpha
=
alpha.arg
)
if
(
trend.arg
)
{
p.tmp
=
p.tmp
+
stat_smooth
(
# method = function(formula, data, weights = weight)
# rlm(formula, data, weights = weight, method = 'MM'),
method
=
"lm"
,
fullrange
=
FALSE
,
level
=
0.95
,
level
=
ci.arg
,
colour
=
'blue'
)
else
{
p.tmp
=
p.tmp
+
geom_abline
(
slope
=
band.arg
$
a
,
intercept
=
band.arg
$
b
)
+
geom_abline
(
slope
=
band.arg
$
a
,
intercept
=
band.arg
$
b
+
abs
(
band.arg
$
b
)
*
band.arg
$
width
,
linetype
=
'dashed'
)
+
geom_abline
(
slope
=
band.arg
$
a
,
intercept
=
band.arg
$
b
-
abs
(
band.arg
$
b
)
*
band.arg
$
width
,
linetype
=
'dashed'
)
}
if
(
!
is.null
(
facet.arg
))
{
p.tmp
=
p.tmp
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
facet.arg
)),
...
...
@@ -826,7 +829,6 @@ LOCggplotScat = function(dt.arg,
}
if
(
!
is.null
(
xlab.arg
))
p.tmp
=
p.tmp
+
xlab
(
paste0
(
xlab.arg
,
"\n"
))
...
...
@@ -839,8 +841,6 @@ LOCggplotScat = function(dt.arg,
p.tmp
=
p.tmp
+
ggtitle
(
paste0
(
plotlab.arg
,
"\n"
))
p.tmp
=
p.tmp
+
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
in.font.axis.text
=
PLOTFONTAXISTEXT
,
...
...
@@ -849,10 +849,6 @@ LOCggplotScat = function(dt.arg,
in.font.legend
=
PLOTFONTLEGEND
)
+
theme
(
legend.position
=
"none"
)
# Marginal distributions don;t work with plotly...
# if (is.null(facet.arg))
# ggExtra::ggMarginal(p.scat, type = "histogram", bins = 100)
# else
return
(
p.tmp
)
}
...
...
modules/boxPlot.R
View file @
3f2d3136
...
...
@@ -28,7 +28,7 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
4
,
selectInput
(
ns
(
'selPlotBoxLegendPos'
),
label
=
'
Select l
egend position'
,
label
=
'
L
egend position'
,
choices
=
list
(
"Top"
=
'top'
,
"Right"
=
'right'
,
...
...
@@ -76,10 +76,10 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
# SERVER ----
modBoxPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.cols
=
list
(
meas.x
=
'realtime'
,
meas.y
=
'y'
,
group
=
'group'
,
id
=
'id'
),
in.cols
=
list
(
meas.x
=
COLRT
,
meas.y
=
COLY
,
group
=
COLGR
,
id
=
COLID
),
in.fname
)
{
ns
<-
session
$
ns
...
...
@@ -108,7 +108,7 @@ modBoxPlot = function(input, output, session,
ns
<-
session
$
ns
if
(
!
(
'line'
%in%
input
$
inPlotType
))
sliderInput
(
ns
(
'inPlotBoxDodge'
),
'
Dodge serie
s:'
,
min
=
0
,
max
=
1
,
value
=
.4
,
step
=
0.05
)
sliderInput
(
ns
(
'inPlotBoxDodge'
),
'
Space between group
s:'
,
min
=
0
,
max
=
1
,
value
=
.4
,
step
=
0.05
)
})
output
$
uiPlotBoxWidth
=
renderUI
({
...
...
@@ -135,7 +135,7 @@ modBoxPlot = function(input, output, session,
ns
<-
session
$
ns
if
(
'dot'
%in%
input
$
inPlotType
)
sliderInput
(
ns
(
'inPlotDotNbins'
),
'
Dot-plot bin size (10^x):'
,
min
=
-4
,
max
=
4
,
value
=
-1.5
,
step
=
0.
1
)
sliderInput
(
ns
(
'inPlotDotNbins'
),
'
#Bins for dot-plot:'
,
min
=
2
,
max
=
50
,
value
=
30
,
step
=
1
)
})
# Boxplot - display
...
...
@@ -206,30 +206,30 @@ modBoxPlot = function(input, output, session,
cat
(
file
=
stderr
(),
'plotBox:dt not NULL\n'
)
loc.par.dodge
<-
position_dodge
(
width
=
input
$
inPlotBoxDodge
)
p.out
=
ggplot
(
loc.dt
,
aes_string
(
x
=
sprintf
(
"factor(%s)"
,
in.cols
[[
'meas.x'
]]),
y
=
in.cols
[[
'meas.y'
]]
))
p.out
=
ggplot
(
loc.dt
,
aes_string
(
x
=
sprintf
(
"factor(%s)"
,
in.cols
$
meas.x
),
y
=
in.cols
$
meas.y
))
if
(
'dot'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_dotplot
(
aes_string
(
fill
=
in.cols
[[
'group'
]]),
p.out
=
p.out
+
geom_dotplot
(
aes_string
(
fill
=
in.cols
[[
COLGR
]]),
color
=
NA
,
binaxis
=
"y"
,
binaxis
=
in.cols
$
meas.y
,
stackdir
=
"center"
,
position
=
loc.par.dodge
,
binwidth
=
10
^
(
input
$
inPlotDotNbins
),
binwidth
=
abs
(
max
(
loc.dt
[[
in.cols
$
meas.y
]],
na.rm
=
T
)
-
min
(
loc.dt
[[
in.cols
$
meas.y
]],
na.rm
=
T
))
/
(
input
$
inPlotDotNbins
-
1
),
method
=
'histodot'
)
if
(
'viol'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_violin
(
aes_string
(
fill
=
in.cols
[[
'group'
]]),
p.out
=
p.out
+
geom_violin
(
aes_string
(
fill
=
in.cols
[[
COLGR
]]),
position
=
loc.par.dodge
,
width
=
0.2
)
if
(
'line'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_path
(
aes_string
(
color
=
in.cols
[[
'group'
]],
group
=
in.cols
[[
'id'
]]))
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
in.cols
[[
'group'
]])))
geom_path
(
aes_string
(
color
=
in.cols
[[
COLGR
]],
group
=
in.cols
[[
COLID
]]))
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
in.cols
[[
COLGR
]])))
if
(
'box'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_boxplot
(
aes_string
(
fill
=
in.cols
[[
'group'
]]),
aes_string
(
fill
=
in.cols
[[
COLGR
]]),
position
=
loc.par.dodge
,
#width = 0.2, #input$inPlotBoxWidth,
notch
=
input
$
inPlotBoxNotches
,
...
...
modules/clDistPlot.R
View file @
3f2d3136
...
...
@@ -6,14 +6,14 @@
#
# UI ----
modClDistPlotUI
=
function
(
id
,
label
=
"Plot
Fractions Within Clusters
"
)
{
modClDistPlotUI
=
function
(
id
,
label
=
"Plot
distribution of clusters per groupd
"
)
{
ns
<-
NS
(
id
)
tagList
(
radioButtons
(
ns
(
"rBAxisLabelsRotate"
),
"X-axis labels:"
,
c
(
"horizontal"
=
0
,
"45 deg"
=
45
,
"90 deg"
=
90
)),
"90 deg"
=
90
)
,
inline
=
T
),
actionButton
(
ns
(
'butPlotClDist'
),
'Plot!'
),
plotOutput
(
ns
(
'outPlotClDist'
),
height
=
PLOTBOXHEIGHT
,
width
=
'auto'
),
downPlotUI
(
ns
(
'downPlotClDist'
),
"Download PDF"
)
...
...
@@ -66,7 +66,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
p.out
=
p.out
+
scale_y_continuous
(
labels
=
percent
)
+
ylab
(
"Percentage of time-series\n"
)
+
xlab
(
""
)
+
xlab
(
"
Groups
"
)
+
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
in.font.axis.text
=
PLOTFONTAXISTEXT
,
in.font.axis.title
=
PLOTFONTAXISTITLE
,
...
...
modules/dispStats.R
View file @
3f2d3136
...
...
@@ -10,7 +10,7 @@ modStatsUI = function(id, label = "Comparing t-points") {
ns
<-
NS
(
id
)
tagList
(
checkboxInput
(
ns
(
'chbTabStats'
),
'Show stats'
,
FALSE
),
checkboxInput
(
ns
(
'chbTabStats'
),
'Show stat
istic
s'
,
FALSE
),
uiOutput
(
ns
(
'uiTabStats'
)),
uiOutput
(
ns
(
'uiDownSingleCellData'
))
)
...
...
@@ -25,6 +25,8 @@ modStats = function(input, output, session,
ns
<-
session
$
ns
output
$
uiTabStats
=
renderUI
({
cat
(
file
=
stderr
(),
'modStats:uiTabStats\n'
)
ns
<-
session
$
ns
...
...
@@ -34,12 +36,13 @@ modStats = function(input, output, session,
}
})
output
$
uiDownSingleCellData
=
renderUI
({
cat
(
file
=
stderr
(),
'modStats:uiDownSingleCellData\n'
)
ns
<-
session
$
ns
if
(
input
$
chbTabStats
)
{
downloadButton
(
ns
(
'downloadData4BoxPlot'
),
'Download s
ingle-cell data
'
)
downloadButton
(
ns
(
'downloadData4BoxPlot'
),
'Download s
tats for individual time series
'
)
}
})
...
...
@@ -56,10 +59,9 @@ modStats = function(input, output, session,
'Mean'
=
mean
(
x
),
'CV'
=
sd
(
x
)
/
mean
(
x
),
'Median'
=
median
(
x
),
'rCV (IQR)'
=
IQR
(
x
)
/
median
(
x
),
'rCV (MAD)'
=
mad
(
x
)
/
median
(
x
))),
.SDcols
=
in.meascol
,
by
=
in.bycols
]
'rCV'
=
IQR
(
x
)
/
median
(
x
))),
.SDcols
=
in.meascol
,
by
=
in.bycols
]
setnames
(
loc.dt.aggr
,
c
(
in.bycols
,
'
N'
,
'Mean'
,
'CV'
,
'Median'
,
'rCV IQR'
,
'rCV MAD
'
))
setnames
(
loc.dt.aggr
,
c
(
in.bycols
,
'
nPoints'
,
'Mean'
,
'CV'
,
'Median'
,
'rCV
'
))
return
(
loc.dt.aggr
)
})
...
...
modules/dispTrackStats.R
View file @
3f2d3136
...
...
@@ -74,7 +74,7 @@ modTrackStats = function(input, output, session,
'measMean'
=
mean
(
x
,
na.rm
=
T
),
'measSD'
=
sd
(
x
,
na.rm
=
T
),
'measCV'
=
sd
(
x
,
na.rm
=
T
)
/
mean
(
x
,
na.rm
=
T
),
'measMedian'
=
median
(
x
,
na.rm
=
T
),
'measMedian'
=
median
(
as.double
(
x
)
,
na.rm
=
T
),
'measIQR'
=
IQR
(
x
,
na.rm
=
T
),
'meas_rCV_IQR'
=
IQR
(
x
,
na.rm
=
T
)
/
median
(
x
,
na.rm
=
T
))),
.SDcols
=
COLY
,
by
=
c
(
in.bycols
)]
...
...
@@ -96,10 +96,10 @@ modTrackStats = function(input, output, session,
by
=
c
(
in.bycols
,
COLID
)][,
.
(
tracksN
=
.N
,
tracksLenMean
=
mean
(
nTpts
),
tracksLenSD
=
sd
(
nTpts
),
tracksLenMedian
=
median
(
nTpts
),
tracksLenMedian
=
median
(
as.double
(
nTpts
)
),
tracksLenIQR
=
IQR
(
nTpts
)),
by
=
c
(
in.bycols
)]
setnames
(
loc.dt.aggr
,
c
(
in.bycols
,
'
#
Tracks'
,
'Mean'
,
'SD'
,
'Median'
,
'IQR'
))
setnames
(
loc.dt.aggr
,
c
(
in.bycols
,
'
n
Tracks'
,
'Mean'
,
'SD'
,
'Median'
,
'IQR'
))
return
(
loc.dt.aggr
)
})
...
...
modules/tabAUC.R
View file @
3f2d3136
...
...
@@ -39,7 +39,7 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
if
(
is.null
(
loc.dt
))
return
(
NULL
)
else
return
(
unique
(
loc.dt
[[
'realtime'
]]))
return
(
unique
(
loc.dt
[[
COLRT
]]))
})
# UI for trimming x-axis (time)
...
...
@@ -72,7 +72,7 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
if
(
is.null
(
loc.dt
))
return
(
NULL
)
else
{
loc.res
=
loc.dt
[
realtime
>=
input
$
slTimeTrim
[
1
]
&
realtime
<=
input
$
slTimeTrim
[
2
],
.
(
AUC
=
trapz
(
realtime
,
y
)),
by
=
.
(
group
,
id
)]
loc.res
=
loc.dt
[
get
(
COLRT
)
>=
input
$
slTimeTrim
[
1
]
&
get
(
COLRT
)
<=
input
$
slTimeTrim
[
2
],
.
(
AUC
=
trapz
(
get
(
COLRT
),
get
(
COLY
))),
by
=
c
(
COLGR
,
COLID
)]
return
(
loc.res
)
}
})
...
...
@@ -80,15 +80,15 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
callModule
(
modStats
,
'dispStats'
,
in.data
=
AUCcells
,
in.meascol
=
'AUC'
,
in.bycols
=
c
(
'group'
)
,
in.bycols
=
COLGR
,
in.fname
=
'data4boxplotAUC.csv'
)
callModule
(
modBoxPlot
,
'boxPlot'
,
in.data
=
AUCcells
,
in.cols
=
list
(
meas.x
=
'group'
,
in.cols
=
list
(
meas.x
=
COLGR
,
meas.y
=
'AUC'
,
group
=
'group'
,
id
=
'id'
),
group
=
COLGR
,
id
=
COLID
),
in.fname
=
in.fname
)
...
...
modules/tabBoxPlot.R
View file @
3f2d3136
...
...
@@ -6,19 +6,22 @@
#
# UI ----
tabBoxPlotUI
=
function
(
id
,
label
=
"
Comparing t-
points"
)
{
tabBoxPlotUI
=
function
(
id
,
label
=
"
Snapshots at time
points"
)
{
ns
<-
NS
(
id
)
tagList
(
h4
(
"Box-/dot-/violin plot
at selected t-
points"
"Box-/dot-/violin plot
s at selected time
points"
),
br
(),
uiOutput
(
ns
(
'varSelTpts'
)),
checkboxInput
(
ns
(
'chBfoldCh'
),
'Fold change w.r.t. t-point:'
),
uiOutput
(
ns
(
'uiSlFoldChTp'
)),
# This is an experimental feature to re-normalise data points with respect to a selected time point
# Current implementation is limited; in the future slider should be replaced by an input field or a choice list.
# currenlty, if the selected time point is larger than the smallest time point for snapshot plotting, error appears.
#checkboxInput(ns('chBfoldCh'), 'Fold change w.r.t. t-point:'),
#uiOutput(ns('uiSlFoldChTp')),
modStatsUI
(
ns
(
'dispStats'
)),
br
(),
...
...
@@ -33,14 +36,14 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
callModule
(
modStats
,
'dispStats'
,
in.data
=
data4boxPlot
,
in.meascol
=
'y'
,
in.bycols
=
c
(
'realtime'
,
'group'
),
in.bycols
=
c
(
COLRT
,
COLGR
),
in.fname
=
'data4boxplotTP.csv'
)
callModule
(
modBoxPlot
,
'boxPlot'
,
in.data
=
data4boxPlot
,
in.cols
=
list
(
meas.x
=
'realtime'
,
meas.y
=
'y'
,
group
=
'group'
,
in.cols
=
list
(
meas.x
=
COLRT
,
meas.y
=
COLY
,
group
=
COLGR
,
id
=
'id'
),
in.fname
=
in.fname
)
...
...
@@ -54,7 +57,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
if
(
is.null
(
loc.dt
))
return
(
NULL
)
else
return
(
unique
(
loc.dt
[
,
realtime
]))
# column name specified in data4trajPlot
return
(
unique
(
loc.dt
[
[
COLRT
]
]))
# column name specified in data4trajPlot
})
output
$
uiSlFoldChTp
=
renderUI
({
...
...
@@ -75,23 +78,21 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
if
(
is.null
(
loc.dt
))
return
(
NULL
)
if
(
input
$
chBfoldCh
)
{
out.dt
=
loc.dt
[
realtime
%in%
input
$
inSelTpts
]
loc.dt.aux
=
loc.dt
[
realtime
%in%
c
(
as.numeric
(
input
$
inSelTpts
)
-
input
$
slFoldChTp
)]
loc.y.prev
=
loc.dt.aux
[,
y
]
print
(
nrow
(
loc.dt.aux
))
print
(
nrow
(
out.dt
))
out.dt
[,
y.prev
:=
loc.y.prev
]
print
(
out.dt
)
out.dt
[,
y
:=
abs
(
y
/
y.prev
)]
print
(
out.dt
)
out.dt
[,
y.prev
:=
NULL
]
print
(
out.dt
)
}
else
out.dt
=
loc.dt
[
realtime
%in%
input
$
inSelTpts
]
# This is part of re-nromalisation with respect to a time point.
# Test version here; works but needs improvements; see UI section
# if(input$chBfoldCh) {
# out.dt = loc.dt[get(COLRT) %in% input$inSelTpts]
# loc.dt.aux = loc.dt[get(COLRT) %in% c(as.numeric(input$inSelTpts) - input$slFoldChTp)]
# loc.y.prev = loc.dt.aux[, y]
#
# out.dt[, y.prev := loc.y.prev]
#
# out.dt[, y := abs(y / y.prev)]
#
# out.dt[, y.prev := NULL]
#
# } else
out.dt
=
loc.dt
[
get
(
COLRT
)
%in%
input
$
inSelTpts
]
return
(
out.dt
)
...
...
@@ -103,13 +104,14 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
ns
<-
session
$
ns
loc.v
=
getDataTpts
()
if
(
!
is.null
(
loc.v
))
{
selectInput
(
ns
(
'inSelTpts'
),
'Select one or more t-points:'
,
loc.v
,
width
=
'100%'
,
selected
=
0
,
selected
=
loc.v
[[
1
]]
,
multiple
=
TRUE
)
}
...
...
modules/tabClHier.R
View file @
3f2d3136
...
...
@@ -9,23 +9,10 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
ns
<-
NS
(
id
)
tagList
(
h4
(
'Hierarchical clustering'
),
br
(),
fluidRow
(
column
(
4
,
selectInput
(
ns
(
"selectPlotHierLinkage"
),
label
=
(
"Select linkage method:"
),
choices
=
list
(
"Ward"
=
1
,
"Ward D2"
=
2
,
"Single"
=
3
,
"Complete"
=
4
,
"Average"
=
5
,
"McQuitty"
=
6
,
"Centroid"
=
7
),
selected
=
2
),
selectInput
(
ns
(
"selectPlotHierDiss"
),
label
=
(
"Select type of dissimilarity measure:"
),
...
...
@@ -33,10 +20,22 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
"Maximum"
=
2
,
"Manhattan"
=
3
,
"Canberra"
=
4
,
"Binary"
=
5
,
"Minkowski"
=
6
,
"DTW"
=
7
),
"DTW"
=
5
),
selected
=
1
),
selectInput
(
ns
(
"selectPlotHierLinkage"
),
label
=
(
"Select linkage method:"
),
choices
=
list
(
"Average"
=
1
,
"Complete"
=
2
,
"Single"
=
3
,
"Centroid"
=
4
,
"Ward"
=
5
,
"Ward D2"
=
6
,
"McQuitty"
=
7
),
selected
=
5
)
),
column
(
4
,
...
...
@@ -58,24 +57,24 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
checkboxInput
(
ns
(
'chBPlotHierClSel'
),
'Manually select clusters to display'
),
uiOutput
(
ns
(
'uiPlotHierClSel'
)),
downloadButton
(
ns
(
'downCellCl'
),
'Download CSV with c
ell IDs and cluster no.
'
)
downloadButton
(
ns
(
'downCellCl'
),
'Download CSV with c
luster assignments
'
)
)
),
br
(),
tabsetPanel
(
tabPanel
(
'Heat-map'
,
tabPanel
(
'Heatmap'
,
br
(),
fluidRow
(
column
(
3
,
checkboxInput
(
ns
(
'selectPlotHierDend'
),
'Plot dendrogram and re-order samples'
,
TRUE
),
selectInput
(
ns
(
"selectPlotHierPalette
Dend
"
),