Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
🚀
This server has been upgraded to GitLab release
15.7
.
🚀
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
47483105
Commit
47483105
authored
Mar 04, 2017
by
dmattek
Browse files
Initial commit
parents
Changes
3
Hide whitespace changes
Inline
Side-by-side
auxfunc.R
0 → 100644
View file @
47483105
## Custom plotting
rhg_cols
<-
c
(
"#771C19"
,
"#AA3929"
,
"#E25033"
,
"#F27314"
,
"#F8A31B"
,
"#E2C59F"
,
"#B6C5CC"
,
"#8E9CA3"
,
"#556670"
,
"#000000"
)
md_cols
<-
c
(
"#FFFFFF"
,
"#F8A31B"
,
"#F27314"
,
"#E25033"
,
"#AA3929"
,
"#FFFFCC"
,
"#C2E699"
,
"#78C679"
,
"#238443"
)
myGgplotTraj
=
function
(
dt.arg
,
x.arg
,
y.arg
,
group.arg
,
facet.arg
,
facet.ncol.arg
=
2
,
line.col.arg
=
NULL
,
xlab.arg
=
NULL
,
ylab.arg
=
NULL
,
plotlab.arg
=
NULL
,
dt.stim.arg
=
NULL
,
tfreq.arg
=
1
,
maxrt.arg
=
60
,
xaxisbreaks.arg
=
10
,
ylim.arg
=
c
(
0
,
1
),
stim.bar.height.arg
=
0.1
,
stim.bar.width.arg
=
0.5
)
{
p.tmp
=
ggplot
(
dt.arg
,
aes_string
(
x
=
x.arg
,
y
=
y.arg
))
if
(
is.null
(
line.col.arg
))
p.tmp
=
p.tmp
+
geom_line
(
aes_string
(
group
=
group.arg
),
alpha
=
0.25
,
size
=
0.25
)
else
p.tmp
=
p.tmp
+
geom_line
(
aes_string
(
group
=
group.arg
,
colour
=
line.col.arg
),
alpha
=
0.5
,
size
=
0.5
)
p.tmp
=
p.tmp
+
stat_summary
(
aes_string
(
y
=
y.arg
,
group
=
1
),
fun.y
=
mean
,
colour
=
'blue'
,
linetype
=
'solid'
,
size
=
1
,
geom
=
"line"
,
group
=
1
)
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
facet.arg
)),
ncol
=
facet.ncol.arg
,
scales
=
"free_x"
)
if
(
!
is.null
(
dt.stim.arg
))
{
p.tmp
=
p.tmp
+
geom_segment
(
data
=
dt.stim.arg
,
aes
(
x
=
Stimulation_time
-
tfreq.arg
,
xend
=
Stimulation_time
-
tfreq.arg
,
y
=
ylim.arg
[
1
],
yend
=
ylim.arg
[
1
]
+
abs
(
ylim.arg
[
2
]
-
ylim.arg
[
1
])
*
stim.bar.height.arg
),
colour
=
rhg_cols
[[
3
]],
size
=
stim.bar.width.arg
,
group
=
1
)
}
p.tmp
=
p.tmp
+
scale_x_continuous
(
breaks
=
seq
(
0
,
maxrt.arg
,
xaxisbreaks.arg
))
+
coord_cartesian
(
ylim
=
ylim.arg
)
+
xlab
(
paste0
(
xlab.arg
,
"\n"
))
+
ylab
(
paste0
(
"\n"
,
ylab.arg
))
+
ggtitle
(
plotlab.arg
)
+
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
=
"top"
)
p.tmp
}
userDataGen
<-
function
()
{
cat
(
file
=
stderr
(),
'userDataGen: in\n'
)
locNtp
=
13
locNtracks
=
5
locNsites
=
4
locNwells
=
2
dt.nuc
=
data.table
(
Metadata_Site
=
rep
(
1
:
locNsites
,
each
=
locNtp
*
locNtracks
),
Metadata_Well
=
rep
(
1
:
locNwells
,
each
=
locNtp
*
locNsites
*
locNtracks
/
locNwells
),
Metadata_Time
=
rep
(
1
:
locNtp
,
locNsites
*
locNtracks
),
meas_MeanIntensity_cyto
=
rnorm
(
locNtp
*
locNtracks
*
locNsites
,
.5
,
0.1
),
meas_MeanIntensity_nuc
=
rnorm
(
locNtp
*
locNtracks
*
locNsites
,
.5
,
0.1
),
TrackLabel
=
rep
(
1
:
(
locNtracks
*
locNsites
),
each
=
locNtp
))
cat
(
colnames
(
dt.nuc
))
return
(
dt.nuc
)
}
server.R
0 → 100644
View file @
47483105
# 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
#
library
(
shiny
)
library
(
shinyjs
)
#http://deanattali.com/shinyjs/
library
(
data.table
)
library
(
ggplot2
)
library
(
plotly
)
options
(
shiny.maxRequestSize
=
30
*
1024
^
2
)
source
(
'auxfunc.R'
)
shinyServer
(
function
(
input
,
output
)
{
butCounter
<-
reactiveValues
(
dataLoadNuc
=
isolate
(
ifelse
(
is.null
(
input
$
inFileNucLoad
),
0
,
1
)),
dataLoadStim
=
isolate
(
ifelse
(
is.null
(
input
$
inFileStimLoad
),
0
,
1
)),
dataGen
=
isolate
(
input
$
butDataGen
)
)
getDataNucCols
<-
reactive
({
cat
(
file
=
stderr
(),
'getDataNucCols: in\n'
)
return
(
colnames
(
dataInBoth
()))
})
output
$
varSelSite
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelSite\n'
)
locCols
=
getDataNucCols
()
locColSel
=
locCols
[
locCols
%like%
'ite'
][
1
]
# index 1 at the end in case more matches; select 1st
cat
(
locColSel
,
'\n'
)
selectInput
(
'inSelSite'
,
'Select Grouping (e.g. Metadata_Site or Well):'
,
locCols
,
width
=
'100%'
,
selected
=
locColSel
)
})
output
$
varSelTrackLabel
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTrackLabel\n'
)
locCols
=
getDataNucCols
()
locColSel
=
locCols
[
locCols
%like%
'rack'
][
1
]
# index 1 at the end in case more matches; select 1st
cat
(
locColSel
,
'\n'
)
selectInput
(
'inSelTrackLabel'
,
'Select Track Label (e.g. objNuc_Track_ObjectsLabel):'
,
locCols
,
width
=
'100%'
,
selected
=
locColSel
)
})
output
$
varSelTime
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelTime\n'
)
locCols
=
getDataNucCols
()
locColSel
=
locCols
[
locCols
%like%
'ime'
][
1
]
# index 1 at the end in case more matches; select 1st
cat
(
locColSel
,
'\n'
)
selectInput
(
'inSelTime'
,
'Select Time (e.g. RealTime):'
,
locCols
,
width
=
'100%'
,
selected
=
locColSel
)
})
output
$
varSelMeas1
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelMeas1\n'
)
locCols
=
getDataNucCols
()
locColSel
=
locCols
[
locCols
%like%
'MeanIntensity'
][
1
]
# index 1 at the end in case more matches; select 1st
cat
(
locColSel
,
'\n'
)
selectInput
(
'inSelMeas1'
,
'Select 1st Measurement:'
,
locCols
,
width
=
'100%'
,
selected
=
locColSel
)
})
output
$
varSelRatio
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelRatio\n'
)
checkboxInput
(
'inSelRatio'
,
'Divide by:'
,
0
)
})
output
$
varSelMeas2
=
renderUI
({
cat
(
file
=
stderr
(),
'UI varSelMeas2\n'
)
locCols
=
getDataNucCols
()
locColSel
=
locCols
[
locCols
%like%
'Intensity'
][
1
]
# index 1 at the end in case more matches; select 1st
cat
(
locColSel
,
'\n'
)
selectInput
(
'inSelMeas2'
,
'Select 2nd Measurement:'
,
locCols
,
width
=
'100%'
,
selected
=
locColSel
)
})
output
$
outPlot
=
renderUI
({
plotlyOutput
(
"trajPlot"
,
width
=
paste0
(
input
$
inPlotWidth
,
'%'
),
height
=
paste0
(
input
$
inPlotHeight
,
'px'
))
})
userDataNuc
<-
eventReactive
(
input
$
inFileNucLoad
,
{
cat
(
file
=
stderr
(),
'userDataNuc: in\n'
)
infile
=
input
$
inFileNucLoad
dt
=
fread
(
infile
$
datapath
)
cat
(
file
=
stderr
(),
'userDataNuc: out\n'
)
return
(
dt
)
})
userDataNucMod
=
reactive
({
# make unique cell identifier based on metadata.site
cat
(
file
=
stderr
(),
'userDataNucMod: in\n'
)
# dt = userDataNuc()
dt
=
dataInBoth
()
colNameSite
=
input
$
inSelSite
colNameTrackLabel
=
input
$
inSelTrackLabel
if
(
colNameSite
==
''
&&
colNameTrackLabel
==
''
)
{
cat
(
file
=
stderr
(),
'userDataNucMod: no colName\n'
)
return
(
NULL
)
}
dt
[,
trackObjectsLabelUni
:=
paste
(
sprintf
(
"%04d"
,
get
(
colNameSite
)),
sprintf
(
"%04d"
,
get
(
colNameTrackLabel
)),
sep
=
"_"
)]
loc.colnames
=
colnames
(
dt
)
if
(
sum
(
loc.colnames
%like%
'Stimulation'
)
==
0
)
{
dt
[,
metadata.site.stim
:=
get
(
colNameSite
)]
}
else
{
dt
[,
metadata.site.stim
:=
paste
(
sprintf
(
'%02d'
,
get
(
colNameSite
)),
': '
,
Stimulation_duration
,
' '
,
Stimulation_intensity
,
' '
,
Stimulation_treatment
,
sep
=
''
)]
}
cat
(
file
=
stderr
(),
'userDataNucMod: out\n'
)
return
(
dt
)
})
userDataStim
<-
eventReactive
(
input
$
inFileStimLoad
,
{
cat
(
file
=
stderr
(),
'userDataStim: in\n'
)
infile
=
input
$
inFileStimLoad
dt
=
fread
(
infile
$
datapath
)
cat
(
file
=
stderr
(),
'userDataStim: out\n'
)
return
(
dt
)
})
# This button will reset the inFileLoad
observeEvent
(
input
$
butReset
,
{
reset
(
"inFileNucLoad"
)
# reset is a shinyjs function
reset
(
"inFileStimLoad"
)
# reset is a shinyjs function
})
dataInBoth
<-
reactive
({
cat
(
file
=
stderr
(),
'dataInBoth: in\n'
)
locInGen
=
input
$
butDataGen
locInLoadNuc
=
ifelse
(
is.null
(
input
$
inFileNucLoad
),
0
,
isolate
(
butCounter
$
dataLoadNuc
)
+
1
)
locInLoadStim
=
ifelse
(
is.null
(
input
$
inFileStimLoad
),
0
,
isolate
(
butCounter
$
dataLoadStim
)
+
1
)
cat
(
file
=
stderr
(),
"dataInBoth\n1: "
,
locInGen
,
"\n2: "
,
locInLoadNuc
,
"\n3: "
,
locInLoadStim
,
"\n"
)
# isolate the checks of counter reactiveValues
# as we set the values in this same reactive
if
(
locInLoadNuc
!=
isolate
(
butCounter
$
dataLoadNuc
))
{
cat
(
file
=
stderr
(),
"dataInBoth if inFileNucLoad\n"
)
dm
=
userDataNuc
()
# no need to isolate updating the counter reactive values!
butCounter
$
dataLoad
<-
locInLoadNuc
}
else
if
(
locInGen
!=
isolate
(
butCounter
$
dataGen
))
{
cat
(
file
=
stderr
(),
"dataInBoth if inDataGen\n"
)
dm
=
userDataGen
()
cat
(
colnames
(
dm
))
# no need to isolate updating the counter reactive values!
butCounter
$
dataGen
<-
locInGen
}
else
dm
=
NULL
cat
(
file
=
stderr
(),
'dataInBoth: out\n'
)
return
(
dm
)
})
output
$
trajPlot
<-
renderPlotly
({
cat
(
file
=
stderr
(),
'trajPlot: in\n'
)
locBut
=
input
$
butGo
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'trajPlot: Go button not pressed\n'
)
return
(
NULL
)
}
dt.nuc
=
(
userDataNucMod
())
locInLoadStim
=
isolate
(
input
$
inFileStimLoad
)
if
(
is.null
(
dt.nuc
)
&&
is.null
(
locInLoadStim
))
{
cat
(
file
=
stderr
(),
'trajPlot: Data not yet loaded\n'
)
return
(
NULL
)
}
else
if
(
is.null
(
locInLoadStim
))
{
cat
(
file
=
stderr
(),
'trajPlot: only timecourses loaded\n'
)
dt.stim
=
NULL
}
else
{
cat
(
file
=
stderr
(),
'trajPlot: timecourses and stimulation pattern loaded\n'
)
dt.stim
=
userDataStim
()
}
loc.facet.ncol.arg
=
isolate
(
input
$
inFacetNcol
)
loc.time
=
isolate
(
input
$
inSelTime
)
loc.meas.1
=
isolate
(
input
$
inSelMeas1
)
if
(
isolate
(
input
$
inSelRatio
))
{
loc.meas.2
=
isolate
(
input
$
inSelMeas2
)
loc.y.arg
=
paste0
(
loc.meas.1
,
' / '
,
loc.meas.2
)
}
else
loc.y.arg
=
loc.meas.1
cat
(
loc.y.arg
)
p.out
=
myGgplotTraj
(
dt.arg
=
dt.nuc
,
x.arg
=
loc.time
,
y.arg
=
loc.y.arg
,
group.arg
=
"trackObjectsLabelUni"
,
facet.arg
=
'metadata.site.stim'
,
# xlab.arg = "Time (min)",
# ylab.arg = loc.y.arg,
# plotlab.arg = "Raw data from illumination-corrected images",
dt.stim.arg
=
dt.stim
,
tfreq.arg
=
1
,
maxrt.arg
=
120
,
xaxisbreaks.arg
=
10
,
facet.ncol.arg
=
loc.facet.ncol.arg
,
ylim.arg
=
c
(
0
,
1.2
),
stim.bar.height.arg
=
0.05
,
stim.bar.width.arg
=
1
)
#ggplotly(p.out)
cat
(
file
=
stderr
(),
'trajPlot: out\n'
)
return
(
ggplotly
(
p.out
))
})
})
ui.R
0 → 100644
View file @
47483105
# 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
#
library
(
shiny
)
library
(
plotly
)
shinyUI
(
fluidPage
(
useShinyjs
(),
# Include shinyjs
# Application title
title
=
"Timecourse Inspector"
,
fluidRow
(
column
(
3
,
h4
(
"Load data files"
),
#Selector for file upload
fileInput
(
'inFileNucLoad'
,
'Choose CSV file with measurement data, e.g. tCoursesSelected.csv'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)
),
fileInput
(
'inFileStimLoad'
,
'Choose CSV file with stimulation times, e.g. stimT.csv'
,
accept
=
c
(
'text/csv'
,
'text/comma-separated-values,text/plain'
)
),
actionButton
(
"butReset"
,
"Reset file input"
),
actionButton
(
'butDataGen'
,
'Generate artificial dataset'
),
actionButton
(
'butGo'
,
'Go!'
)),
column
(
4
,
offset
=
1
,
uiOutput
(
'varSelSite'
),
uiOutput
(
'varSelTrackLabel'
),
uiOutput
(
'varSelTime'
),
uiOutput
(
'varSelMeas1'
),
uiOutput
(
'varSelRatio'
),
uiOutput
(
'varSelMeas2'
)),
column
(
2
,
offset
=
1
,
numericInput
(
'inFacetNcol'
,
'No. of plot columns:'
,
value
=
4
,
min
=
1
,
width
=
'150px'
,
step
=
1
),
numericInput
(
'inPlotHeight'
,
'Plot Height [px]:'
,
value
=
400
,
min
=
100
,
width
=
'150px'
,
step
=
50
),
numericInput
(
'inPlotWidth'
,
'Plot Width [%]:'
,
value
=
100
,
min
=
10
,
max
=
100
,
width
=
'150px'
,
step
=
10
))
),
br
(),
uiOutput
(
'outPlot'
)
))
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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