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
89559932
Commit
89559932
authored
Nov 22, 2018
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Bug fixes
parent
bbcd3d20
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
89 additions
and
90 deletions
+89
-90
modules/auxfunc.R
modules/auxfunc.R
+31
-22
modules/trajPlot.R
modules/trajPlot.R
+13
-2
server.R
server.R
+40
-60
ui.R
ui.R
+5
-6
No files found.
modules/auxfunc.R
View file @
89559932
## Custom plotting
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# These are auxilary functions
#
require
(
ggplot2
)
require
(
ggplot2
)
require
(
RColorBrewer
)
require
(
RColorBrewer
)
require
(
gplots
)
# for heatmap.2
require
(
gplots
)
# for heatmap.2
require
(
grid
)
# for modifying grob
require
(
grid
)
# for modifying grob
# Colour definitions ----
rhg_cols
<-
c
(
rhg_cols
<-
c
(
"#771C19"
,
"#771C19"
,
"#AA3929"
,
"#AA3929"
,
...
@@ -29,22 +37,6 @@ md_cols <- c(
...
@@ -29,22 +37,6 @@ md_cols <- c(
"#238443"
"#238443"
)
)
s.cl.linkage
=
c
(
"ward.D"
,
"ward.D2"
,
"single"
,
"complete"
,
"average"
,
"mcquitty"
,
"centroid"
)
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"
)
# list of palettes for the heatmap
# list of palettes for the heatmap
l.col.pal
=
list
(
l.col.pal
=
list
(
"White-Orange-Red"
=
'OrRd'
,
"White-Orange-Red"
=
'OrRd'
,
...
@@ -66,6 +58,26 @@ l.col.pal.dend = list(
...
@@ -66,6 +58,26 @@ l.col.pal.dend = list(
"Diverge HSV"
=
'diverge_hsv'
"Diverge HSV"
=
'diverge_hsv'
)
)
# Clustering algorithms ----
s.cl.linkage
=
c
(
"ward.D"
,
"ward.D2"
,
"single"
,
"complete"
,
"average"
,
"mcquitty"
,
"centroid"
)
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"
)
# Help text ----
# Creates a popup with help text
# Creates a popup with help text
# From: https://gist.github.com/jcheng5/5913297
# From: https://gist.github.com/jcheng5/5913297
helpPopup
<-
function
(
title
,
content
,
helpPopup
<-
function
(
title
,
content
,
...
@@ -102,9 +114,7 @@ help.text = c(
...
@@ -102,9 +114,7 @@ help.text = c(
)
)
#####
# Functions for clustering ----
## Functions for clustering
# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# This one works wth dist & hclust pair
# This one works wth dist & hclust pair
...
@@ -168,8 +178,7 @@ getClCol <- function(in.dend, in.k) {
...
@@ -168,8 +178,7 @@ getClCol <- function(in.dend, in.k) {
}
}
#####
# Custom plotting functions ----
## Common plotting functions
# Build Function to Return Element Text Object
# Build Function to Return Element Text Object
# From: https://stackoverflow.com/a/36979201/1898713
# From: https://stackoverflow.com/a/36979201/1898713
...
...
modules/trajPlot.R
View file @
89559932
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This is the module for plotting individual time series
#
require
(
DT
)
require
(
DT
)
# UI ----
modTrajPlotUI
=
function
(
id
,
label
=
"Plot Individual Time Series"
)
{
modTrajPlotUI
=
function
(
id
,
label
=
"Plot Individual Time Series"
)
{
ns
<-
NS
(
id
)
ns
<-
NS
(
id
)
...
@@ -66,7 +76,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
...
@@ -66,7 +76,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
)
)
}
}
# Server ----
modTrajPlot
=
function
(
input
,
output
,
session
,
modTrajPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.data
,
in.data.stim
,
in.data.stim
,
...
@@ -270,7 +280,8 @@ modTrajPlot = function(input, output, session,
...
@@ -270,7 +280,8 @@ modTrajPlot = function(input, output, session,
facet.color.arg
=
loc.facet.col
,
facet.color.arg
=
loc.facet.col
,
dt.stim.arg
=
loc.dt.stim
,
dt.stim.arg
=
loc.dt.stim
,
x.stim.arg
=
c
(
'tstart'
,
'tend'
),
x.stim.arg
=
c
(
'tstart'
,
'tend'
),
y.stim.arg
=
c
(
'ystart'
,
'yend'
),
y.stim.arg
=
c
(
'ystart'
,
'yend'
),
stim.bar.width.arg
=
1
,
xlab.arg
=
'Time (min)'
,
xlab.arg
=
'Time (min)'
,
line.col.arg
=
loc.line.col.arg
,
line.col.arg
=
loc.line.col.arg
,
aux.label1
=
if
(
locPos
)
'pos.x'
else
NULL
,
aux.label1
=
if
(
locPos
)
'pos.x'
else
NULL
,
...
...
server.R
View file @
89559932
# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
#
# http://shiny.rstudio.com
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This is the server logic for a Shiny web application.
#
#
library
(
shiny
)
library
(
shiny
)
...
@@ -24,41 +22,34 @@ library(dtw) # for dynamic time warping
...
@@ -24,41 +22,34 @@ library(dtw) # for dynamic time warping
library
(
imputeTS
)
# for interpolating NAs
library
(
imputeTS
)
# for interpolating NAs
library
(
tca
)
# for time series manipulatiom, e.g. normTraj, genTraj, plotTrajRibbon
library
(
tca
)
# for time series manipulatiom, e.g. normTraj, genTraj, plotTrajRibbon
#
increase file upload limit
#
change to increase the limit of the upload file size
options
(
shiny.maxRequestSize
=
200
*
1024
^
2
)
options
(
shiny.maxRequestSize
=
200
*
1024
^
2
)
# Server logic ----
shinyServer
(
function
(
input
,
output
,
session
)
{
shinyServer
(
function
(
input
,
output
,
session
)
{
useShinyjs
()
useShinyjs
()
# This is only set at session start
# This is only set at session start
#
w
e use this as a way to determine which input was
#
W
e use this as a way to determine which input was
# clicked in the dataInBoth reactive
# clicked in the dataInBoth reactive
counter
<-
reactiveValues
(
counter
<-
reactiveValues
(
# The value of
inDataGen1,2 actionButton is the number of times they were
pressed
# The value of
actionButton is the number of times the button is
pressed
dataGen1
=
isolate
(
input
$
inDataGen1
),
dataGen1
=
isolate
(
input
$
inDataGen1
),
dataLoadNuc
=
isolate
(
input
$
inButLoadNuc
),
dataLoadNuc
=
isolate
(
input
$
inButLoadNuc
),
dataLoadTrajRem
=
isolate
(
input
$
inButLoadTrajRem
),
dataLoadTrajRem
=
isolate
(
input
$
inButLoadTrajRem
),
dataLoadStim
=
isolate
(
input
$
inButLoadStim
)
dataLoadStim
=
isolate
(
input
$
inButLoadStim
)
)
)
####
# UI-side-panel-data-load ----
## UI for side panel
# FILE LOAD
# Generate random dataset
# This button will reset the inFileLoad
observeEvent
(
input
$
inButReset
,
{
reset
(
"inFileLoadNuc"
)
# reset is a shinyjs function
#reset("inButLoadStim") # reset is a shinyjs function
})
# generate random dataset 1
dataGen1
<-
eventReactive
(
input
$
inDataGen1
,
{
dataGen1
<-
eventReactive
(
input
$
inDataGen1
,
{
cat
(
"dataGen1\n"
)
cat
(
"dataGen1\n"
)
return
(
tca
::
genTraj
(
in.nwells
=
3
))
return
(
tca
::
genTraj
(
in.nwells
=
3
))
})
})
#
l
oad main data file
#
L
oad main data file
dataLoadNuc
<-
eventReactive
(
input
$
inButLoadNuc
,
{
dataLoadNuc
<-
eventReactive
(
input
$
inButLoadNuc
,
{
cat
(
"dataLoadNuc\n"
)
cat
(
"dataLoadNuc\n"
)
locFilePath
=
input
$
inFileLoadNuc
$
datapath
locFilePath
=
input
$
inFileLoadNuc
$
datapath
...
@@ -75,11 +66,9 @@ shinyServer(function(input, output, session) {
...
@@ -75,11 +66,9 @@ shinyServer(function(input, output, session) {
# This button will reset the inFileLoad
# This button will reset the inFileLoad
observeEvent
(
input
$
butReset
,
{
observeEvent
(
input
$
butReset
,
{
reset
(
"inFileLoadNuc"
)
# reset is a shinyjs function
reset
(
"inFileLoadNuc"
)
# reset is a shinyjs function
# reset("inFileStimLoad") # reset is a shinyjs function
})
})
#
l
oad data with trajectories to remove
#
L
oad data with trajectories to remove
dataLoadTrajRem
<-
eventReactive
(
input
$
inButLoadTrajRem
,
{
dataLoadTrajRem
<-
eventReactive
(
input
$
inButLoadTrajRem
,
{
cat
(
file
=
stderr
(),
"dataLoadTrajRem\n"
)
cat
(
file
=
stderr
(),
"dataLoadTrajRem\n"
)
locFilePath
=
input
$
inFileLoadTrajRem
$
datapath
locFilePath
=
input
$
inFileLoadTrajRem
$
datapath
...
@@ -93,7 +82,7 @@ shinyServer(function(input, output, session) {
...
@@ -93,7 +82,7 @@ shinyServer(function(input, output, session) {
}
}
})
})
#
l
oad data with stimulation pattern
#
L
oad data with stimulation pattern
dataLoadStim
<-
eventReactive
(
input
$
inButLoadStim
,
{
dataLoadStim
<-
eventReactive
(
input
$
inButLoadStim
,
{
cat
(
file
=
stderr
(),
"dataLoadStim\n"
)
cat
(
file
=
stderr
(),
"dataLoadStim\n"
)
locFilePath
=
input
$
inFileLoadStim
$
datapath
locFilePath
=
input
$
inFileLoadStim
$
datapath
...
@@ -148,7 +137,7 @@ shinyServer(function(input, output, session) {
...
@@ -148,7 +137,7 @@ shinyServer(function(input, output, session) {
#
COLUMN SELECTION
#
UI-side-panel-column-selection ----
output
$
varSelTrackLabel
=
renderUI
({
output
$
varSelTrackLabel
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTrackLabel\n'
)
cat
(
file
=
stderr
(),
'UI varSelTrackLabel\n'
)
locCols
=
getDataNucCols
()
locCols
=
getDataNucCols
()
...
@@ -192,10 +181,10 @@ shinyServer(function(input, output, session) {
...
@@ -192,10 +181,10 @@ shinyServer(function(input, output, session) {
}
}
})
})
# This is main field to select plot facet grouping
# This is
the
main field to select plot facet grouping
# It's typically a column with the entire experimental description,
# It's typically a column with the entire experimental description,
# e.g.
in Yannick's case it's
Stim_All_Ch or Stim_All_S.
# e.g.
1
Stim_All_Ch or Stim_All_S.
#
In Coralie's case it's
a combination of 3 columns called Stimulation_...
#
e.g.2
a combination of 3 columns called Stimulation_...
output
$
varSelGroup
=
renderUI
({
output
$
varSelGroup
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelGroup\n'
)
cat
(
file
=
stderr
(),
'UI varSelGroup\n'
)
...
@@ -237,8 +226,6 @@ shinyServer(function(input, output, session) {
...
@@ -237,8 +226,6 @@ shinyServer(function(input, output, session) {
})
})
output
$
varSelMeas1
=
renderUI
({
output
$
varSelMeas1
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelMeas1\n'
)
cat
(
file
=
stderr
(),
'UI varSelMeas1\n'
)
locCols
=
getDataNucCols
()
locCols
=
getDataNucCols
()
...
@@ -275,7 +262,7 @@ shinyServer(function(input, output, session) {
...
@@ -275,7 +262,7 @@ shinyServer(function(input, output, session) {
}
}
})
})
# UI
for trimming x-axis (time)
# UI
-side-panel-trim x-axis (time) ----
output
$
uiSlTimeTrim
=
renderUI
({
output
$
uiSlTimeTrim
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiSlTimeTrim\n'
)
cat
(
file
=
stderr
(),
'UI uiSlTimeTrim\n'
)
...
@@ -300,8 +287,7 @@ shinyServer(function(input, output, session) {
...
@@ -300,8 +287,7 @@ shinyServer(function(input, output, session) {
}
}
})
})
# UI for normalization
# UI-side-panel-normalization ----
output
$
uiChBnorm
=
renderUI
({
output
$
uiChBnorm
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiChBnorm\n'
)
cat
(
file
=
stderr
(),
'UI uiChBnorm\n'
)
...
@@ -358,7 +344,7 @@ shinyServer(function(input, output, session) {
...
@@ -358,7 +344,7 @@ shinyServer(function(input, output, session) {
})
})
# UI
for removing outliers
# UI
-side-panel-remove-outliers ----
output
$
uiSlOutliers
=
renderUI
({
output
$
uiSlOutliers
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiSlOutliers\n'
)
cat
(
file
=
stderr
(),
'UI uiSlOutliers\n'
)
...
@@ -377,18 +363,8 @@ shinyServer(function(input, output, session) {
...
@@ -377,18 +363,8 @@ shinyServer(function(input, output, session) {
}
}
})
})
output
$
uiTxtOutliers
=
renderUI
({
if
(
input
$
chBoutliers
)
{
p
(
"Total tracks"
)
}
})
# Processing-data ----
####
## data processing
dataInBoth
<-
reactive
({
dataInBoth
<-
reactive
({
# Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
# Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
...
@@ -799,19 +775,9 @@ shinyServer(function(input, output, session) {
...
@@ -799,19 +775,9 @@ shinyServer(function(input, output, session) {
}
}
)
)
###### Trajectory plotting
# Plotting-trajectories ----
callModule
(
modTrajRibbonPlot
,
'modTrajRibbon'
,
in.data
=
data4trajPlot
,
# UI for selecting trajectories
in.data.stim
=
data4stimPlot
,
in.fname
=
function
()
return
(
"tCoursesMeans.pdf"
))
###### Trajectory plotting
callModule
(
modTrajPlot
,
'modTrajPlot'
,
in.data
=
data4trajPlot
,
in.data.stim
=
data4stimPlot
,
in.fname
=
function
()
{
return
(
"tCourses.pdf"
)})
## UI for selecting trajectories
# The output data table of data4trajPlot is modified based on inSelHighlight field
# The output data table of data4trajPlot is modified based on inSelHighlight field
output
$
varSelHighlight
=
renderUI
({
output
$
varSelHighlight
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelHighlight\n'
)
cat
(
file
=
stderr
(),
'UI varSelHighlight\n'
)
...
@@ -832,6 +798,20 @@ shinyServer(function(input, output, session) {
...
@@ -832,6 +798,20 @@ shinyServer(function(input, output, session) {
}
}
})
})
# Trajectory plotting - ribbon
callModule
(
modTrajRibbonPlot
,
'modTrajRibbon'
,
in.data
=
data4trajPlot
,
in.data.stim
=
data4stimPlot
,
in.fname
=
function
()
return
(
"tCoursesMeans.pdf"
))
###### Trajectory plotting - individual
callModule
(
modTrajPlot
,
'modTrajPlot'
,
in.data
=
data4trajPlot
,
in.data.stim
=
data4stimPlot
,
in.fname
=
function
()
{
return
(
"tCourses.pdf"
)})
# Tabs ----
###### AUC calculation and plotting
###### AUC calculation and plotting
callModule
(
modAUCplot
,
'tabAUC'
,
data4trajPlot
,
in.fname
=
function
()
return
(
'boxplotAUC.pdf'
))
callModule
(
modAUCplot
,
'tabAUC'
,
data4trajPlot
,
in.fname
=
function
()
return
(
'boxplotAUC.pdf'
))
...
...
ui.R
View file @
89559932
# This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here:
#
#
# http://shiny.rstudio.com
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
#
# This is the user-interface definition for a Shiny web application.
#
library
(
shiny
)
library
(
shiny
)
library
(
shinyjs
)
#http://deanattali.com/shinyjs/
library
(
shinyjs
)
#http://deanattali.com/shinyjs/
library
(
plotly
)
shinyUI
(
fluidPage
(
shinyUI
(
fluidPage
(
useShinyjs
(),
useShinyjs
(),
...
...
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