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
5a2e859f
Commit
5a2e859f
authored
May 31, 2017
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added: scatter plot based on 2 time-points with surrounding points
parent
03947223
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
55 additions
and
14 deletions
+55
-14
modules/tabScatter.R
modules/tabScatter.R
+55
-14
No files found.
modules/tabScatter.R
View file @
5a2e859f
...
...
@@ -25,12 +25,15 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
fluidRow
(
column
(
6
,
uiOutput
(
ns
(
'varSelTptX'
)),
uiOutput
(
ns
(
'varSelTptY'
))
4
,
uiOutput
(
ns
(
'uiSelTptX'
)),
uiOutput
(
ns
(
'uiSelTptY'
)),
checkboxInput
(
ns
(
'chBfoldChange'
),
'Y-axis displays fold change between the two t-points'
),
numericInput
(
ns
(
'inNeighTpts'
),
'#t-pts left & right'
,
value
=
0
,
step
=
1
,
min
=
0
),
radioButtons
(
ns
(
'rBstats'
),
'Operation:'
,
list
(
'Mean'
=
1
,
'Min'
=
2
,
'Max'
=
3
))
),
column
(
6
,
4
,
numericInput
(
ns
(
'inPlotHeight'
),
'Display plot height'
,
...
...
@@ -74,8 +77,8 @@ getDataTpts <- reactive({
return
(
unique
(
loc.dt
$
realtime
))
})
output
$
var
SelTptX
=
renderUI
({
cat
(
file
=
stderr
(),
'UI
var
SelTptX\n'
)
output
$
ui
SelTptX
=
renderUI
({
cat
(
file
=
stderr
(),
'UI
ui
SelTptX\n'
)
ns
<-
session
$
ns
...
...
@@ -92,8 +95,8 @@ output$varSelTptX = renderUI({
}
})
output
$
var
SelTptY
=
renderUI
({
cat
(
file
=
stderr
(),
'UI
var
SelTptY\n'
)
output
$
ui
SelTptY
=
renderUI
({
cat
(
file
=
stderr
(),
'UI
ui
SelTptY\n'
)
ns
<-
session
$
ns
...
...
@@ -117,17 +120,49 @@ data4scatterPlot <- reactive({
if
(
is.null
(
loc.dt.in
))
return
(
NULL
)
loc.dt
=
data.table
(
x
=
loc.dt.in
[
realtime
==
input
$
inSelTptX
,
y
],
y
=
loc.dt.in
[
realtime
==
input
$
inSelTptY
,
y
],
group
=
loc.dt.in
[
realtime
==
input
$
inSelTptX
,
group
])
loc.tpts.x
=
input
$
inSelTptX
loc.tpts.y
=
input
$
inSelTptY
# if neigbbouring points selected
if
(
input
$
inNeighTpts
>
0
)
{
loc.dt.in.tpts
=
unique
(
loc.dt.in
$
realtime
)
loc.tpts.x.id
=
seq
(
which
(
loc.dt.in.tpts
==
loc.tpts.x
)
-
input
$
inNeighTpts
,
which
(
loc.dt.in.tpts
==
loc.tpts.x
)
+
input
$
inNeighTpts
,
1
)
loc.tpts.y.id
=
seq
(
which
(
loc.dt.in.tpts
==
loc.tpts.y
)
-
input
$
inNeighTpts
,
which
(
loc.dt.in.tpts
==
loc.tpts.y
)
+
input
$
inNeighTpts
,
1
)
loc.tpts.x.id
=
loc.tpts.x.id
[
loc.tpts.x.id
>
0
]
loc.tpts.y.id
=
loc.tpts.y.id
[
loc.tpts.y.id
>
0
]
loc.tpts.x
=
loc.dt.in.tpts
[
loc.tpts.x.id
]
loc.tpts.y
=
loc.dt.in.tpts
[
loc.tpts.y.id
]
#cat(loc.tpts.x.id, '\n')
#cat(loc.tpts.y.id, '\n')
}
#cat(loc.tpts.x, '\n')
#cat(loc.tpts.y, '\n')
loc.dt.x
=
loc.dt.in
[
realtime
==
input
$
inSelTptX
]
loc.dt.y
=
loc.dt.in
[
realtime
==
input
$
inSelTptY
]
if
(
input
$
rBstats
==
1
)
{
loc.dt.x
=
loc.dt.in
[
realtime
%in%
loc.tpts.x
,
.
(
y.aggr
=
mean
(
y
)),
by
=
.
(
group
,
id
)]
loc.dt.y
=
loc.dt.in
[
realtime
%in%
loc.tpts.y
,
.
(
y.aggr
=
mean
(
y
)),
by
=
.
(
group
,
id
)]
}
else
if
(
input
$
rBstats
==
2
)
{
loc.dt.x
=
loc.dt.in
[
realtime
%in%
loc.tpts.x
,
.
(
y.aggr
=
min
(
y
)),
by
=
.
(
group
,
id
)]
loc.dt.y
=
loc.dt.in
[
realtime
%in%
loc.tpts.y
,
.
(
y.aggr
=
min
(
y
)),
by
=
.
(
group
,
id
)]
}
else
{
loc.dt.x
=
loc.dt.in
[
realtime
%in%
loc.tpts.x
,
.
(
y.aggr
=
max
(
y
)),
by
=
.
(
group
,
id
)]
loc.dt.y
=
loc.dt.in
[
realtime
%in%
loc.tpts.y
,
.
(
y.aggr
=
max
(
y
)),
by
=
.
(
group
,
id
)]
}
loc.dt
=
merge
(
loc.dt.x
,
loc.dt.y
,
by
=
'id'
)
setnames
(
loc.dt
,
c
(
'group.x'
,
'y.x'
,
'y.y'
),
c
(
'group'
,
'x'
,
'y'
))
loc.dt
[,
group.y
:=
NULL
]
setnames
(
loc.dt
,
c
(
'group.x'
,
'y.aggr.x'
,
'y.aggr.y'
),
c
(
'group'
,
'x'
,
'y'
))
if
(
input
$
chBfoldChange
)
{
loc.dt
[
,
y
:=
y
/
x
]
}
return
(
loc.dt
)
})
...
...
@@ -197,6 +232,12 @@ output$outPlotScatterInt <- renderPlotly({
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
# https://github.com/ropensci/plotly/issues/494
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'plotScatterInt Go button not pressed\n'
)
return
(
NULL
)
}
if
(
names
(
dev.cur
())
!=
"null device"
)
dev.off
()
pdf
(
NULL
)
...
...
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