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
7b7d8294
Commit
7b7d8294
authored
Apr 12, 2018
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fixed: file names for downloaded plots
parent
a50e814e
Changes
11
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
126 additions
and
63 deletions
+126
-63
modules/auxfunc.R
modules/auxfunc.R
+5
-6
modules/boxPlot.R
modules/boxPlot.R
+1
-1
modules/downPlot.R
modules/downPlot.R
+4
-3
modules/tabAUC.R
modules/tabAUC.R
+1
-1
modules/tabBoxPlot.R
modules/tabBoxPlot.R
+1
-1
modules/tabClHier.R
modules/tabClHier.R
+48
-18
modules/tabClHierSpar.R
modules/tabClHierSpar.R
+44
-19
modules/tabScatter.R
modules/tabScatter.R
+2
-2
modules/trajPlot.R
modules/trajPlot.R
+7
-3
modules/trajRibbonPlot.R
modules/trajRibbonPlot.R
+4
-2
server.R
server.R
+9
-7
No files found.
modules/auxfunc.R
View file @
7b7d8294
...
...
@@ -198,9 +198,11 @@ myGgplotTraj = function(dt.arg, # data table
aes_string
(
x
=
x.arg
,
y
=
y.arg
,
group
=
group.arg
,
label
=
aux.label1
,
label2
=
aux.label2
,
label3
=
aux.label3
))
label
=
group.arg
))
#,
# label = aux.label1,
# label2 = aux.label2,
# label3 = aux.label3))
if
(
is.null
(
line.col.arg
))
{
p.tmp
=
p.tmp
+
...
...
@@ -310,9 +312,6 @@ myGgplotTraj = function(dt.arg, # data table
legend.position
=
"top"
)
return
(
p.tmp
)
}
...
...
modules/boxPlot.R
View file @
7b7d8294
...
...
@@ -72,7 +72,7 @@ modBoxPlot = function(input, output, session,
meas.y
=
'y'
,
group
=
'group'
,
id
=
'id'
),
in.fname
=
'boxplot.pdf'
)
{
in.fname
)
{
ns
<-
session
$
ns
...
...
modules/downPlot.R
View file @
7b7d8294
...
...
@@ -46,7 +46,7 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
output
$
uiDownButton
=
renderUI
({
ns
<-
session
$
ns
if
(
in.fname
%like%
'pdf'
)
{
if
(
in.fname
()
%like%
'pdf'
)
{
downloadButton
(
ns
(
'downPlot'
),
'PDF'
)
}
else
{
downloadButton
(
ns
(
'downPlot'
),
'PNG'
)
...
...
@@ -56,7 +56,8 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
output
$
downPlot
<-
downloadHandler
(
filename
=
function
()
{
in.fname
cat
(
in.fname
(),
"\n"
)
in.fname
()
},
content
=
function
(
file
)
{
...
...
@@ -69,7 +70,7 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
height
=
input
$
inPlotHeight
)
}
else
{
if
(
in.fname
%like%
'pdf'
)
{
if
(
in.fname
()
%like%
'pdf'
)
{
pdf
(
file
,
width
=
input
$
inPlotWidth
,
height
=
input
$
inPlotHeight
)
...
...
modules/tabAUC.R
View file @
7b7d8294
...
...
@@ -19,7 +19,7 @@ modAUCplotUI = function(id, label = "Plot Area Under Curves") {
)
}
modAUCplot
=
function
(
input
,
output
,
session
,
in.data
,
in.fname
=
'boxplotAUC.pdf'
)
{
modAUCplot
=
function
(
input
,
output
,
session
,
in.data
,
in.fname
)
{
ns
<-
session
$
ns
...
...
modules/tabBoxPlot.R
View file @
7b7d8294
...
...
@@ -21,7 +21,7 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
####
## server box-plot
tabBoxPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.fname
=
'boxplotTP.pdf'
)
{
tabBoxPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.fname
)
{
callModule
(
modStats
,
'dispStats'
,
in.data
=
data4boxPlot
,
...
...
modules/tabClHier.R
View file @
7b7d8294
...
...
@@ -344,7 +344,14 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
})
createMethodStr
=
reactive
({
paste0
(
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)])
})
# 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
...
...
@@ -369,7 +376,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
nacol.arg
=
input
$
inPlotHierNAcolor
,
font.row.arg
=
input
$
inPlotHierFontX
,
font.col.arg
=
input
$
inPlotHierFontY
,
title.arg
=
paste
(
title.arg
=
paste
0
(
"Distance measure: "
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
"\nLinkage method: "
,
...
...
@@ -398,38 +405,61 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
plotHier
()
},
height
=
getPlotHierHeatMapHeight
)
createFnameHeatMap
=
reactive
({
paste0
(
'clust_hierch_heatMap_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.png'
)
})
createFnameTrajPlot
=
reactive
({
paste0
(
'clust_hierch_tCourses_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
)
})
createFnameRibbonPlot
=
reactive
({
paste0
(
'clust_hierch_tCoursesMeans_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
)
})
createFnameDistPlot
=
reactive
({
paste0
(
'clust_hierch_clDist_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
)
})
# Hierarchical - Heat Map - download pdf
callModule
(
downPlot
,
"downPlotHier"
,
paste0
(
'clust_hierch_heatMap_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.png'
),
plotHier
)
callModule
(
downPlot
,
"downPlotHier"
,
createFnameHeatMap
,
plotHier
)
callModule
(
modTrajPlot
,
'modPlotHierTraj'
,
in.data
=
data4trajPlotCl
,
in.facet
=
'cl'
,
in.facet.color
=
getClColHier
,
in.fname
=
paste0
(
'clust_hierch_tCourses_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
))
in.fname
=
createFnameTrajPlot
)
callModule
(
modTrajRibbonPlot
,
'modPlotHierTrajRibbon'
,
in.data
=
data4trajPlotCl
,
in.facet
=
'cl'
,
in.facet.color
=
getClColHier
,
in.fname
=
paste0
(
'clust_hierch_tCoursesMeans_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
))
in.fname
=
createFnameRibbonPlot
)
callModule
(
modClDistPlot
,
'hierClDistPlot'
,
in.data
=
data4clDistPlot
,
in.cols
=
getClColHier
,
in.fname
=
paste0
(
'clust_hierch_clDist_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierLinkage
)],
'.pdf'
))
in.fname
=
createFnameDistPlot
)
}
\ No newline at end of file
modules/tabClHierSpar.R
View file @
7b7d8294
...
...
@@ -449,33 +449,65 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
return
(
input
$
inPlotHierSparHeatMapHeight
)
}
createFnameHeatMap
=
reactive
({
paste0
(
'clust_hierchSparse_heatMap_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.png'
)
})
createFnameTrajPlot
=
reactive
({
paste0
(
'clust_hierchSparse_tCourses_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
)
})
createFnameRibbonPlot
=
reactive
({
paste0
(
'clust_hierchSparse_tCoursesMeans_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
)
})
createFnameDistPlot
=
reactive
({
paste0
(
'clust_hierchSparse_clDist_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
)
})
# Sparse Hierarchical - Heat Map - download pdf
callModule
(
downPlot
,
"downPlotHierSparHM"
,
createFnameHeatMap
,
plotHierSpar
)
callModule
(
modTrajPlot
,
'modPlotHierSparTraj'
,
in.data
=
data4trajPlotClSpar
,
in.facet
=
'cl'
,
in.facet.color
=
getClColHierSpar
,
paste0
(
'clust_hierchSparse_tCourses_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
))
in.fname
=
createFnameTrajPlot
)
callModule
(
modTrajRibbonPlot
,
'modPlotHierSparTrajRibbon'
,
in.data
=
data4trajPlotClSpar
,
in.facet
=
'cl'
,
in.facet.color
=
getClColHierSpar
,
in.fname
=
paste0
(
'clust_hierchSparse_tCoursesMeans_'
,
s.cl.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
))
in.fname
=
createFnameRibbonPlot
)
callModule
(
modClDistPlot
,
'hierClSparDistPlot'
,
in.data
=
data4clSparDistPlot
,
in.cols
=
getClColHierSpar
,
in.fname
=
paste0
(
'clust_hierchSparse_clDist_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.pdf'
))
in.fname
=
createFnameDistPlot
)
...
...
@@ -492,11 +524,4 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
plotHierSpar
()
},
height
=
getPlotHierSparHeatMapHeight
)
# Sparse Hierarchical - Heat Map - download pdf
callModule
(
downPlot
,
"downPlotHierSparHM"
,
paste0
(
'clust_hierchSparse_heatMap_'
,
s.cl.spar.diss
[
as.numeric
(
input
$
selectPlotHierSparDiss
)],
'_'
,
s.cl.spar.linkage
[
as.numeric
(
input
$
selectPlotHierSparLinkage
)],
'.png'
),
plotHierSpar
)
}
\ No newline at end of file
modules/tabScatter.R
View file @
7b7d8294
...
...
@@ -66,7 +66,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
}
# SERVER
tabScatterPlot
<-
function
(
input
,
output
,
session
,
in.data
)
{
tabScatterPlot
<-
function
(
input
,
output
,
session
,
in.data
,
in.fname
)
{
# return all unique time points (real time)
# This will be used to display in UI for box-plot
...
...
@@ -251,7 +251,7 @@ output$outPlotScatterInt <- renderPlotly({
})
# download pdf
callModule
(
downPlot
,
"downPlotScatter"
,
"scatter.pdf"
,
plotScatter
,
TRUE
)
callModule
(
downPlot
,
"downPlotScatter"
,
in.fname
,
plotScatter
,
TRUE
)
# Hierarchical - choose to display regular heatmap.2 or d3heatmap (interactive)
output
$
plotInt_ui
<-
renderUI
({
...
...
modules/trajPlot.R
View file @
7b7d8294
...
...
@@ -56,7 +56,11 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
}
modTrajPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.facet
=
'group'
,
in.facet.color
=
NULL
,
in.fname
=
'tCourses.pdf'
)
{
modTrajPlot
=
function
(
input
,
output
,
session
,
in.data
,
in.fname
,
in.facet
=
'group'
,
in.facet.color
=
NULL
)
{
ns
<-
session
$
ns
...
...
@@ -102,7 +106,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
if
(
is.null
(
loc.p
))
return
(
NULL
)
return
(
plotly_build
(
loc.p
))
return
(
ggplotly
(
loc.p
))
})
...
...
@@ -176,7 +180,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
loc.facet.col
=
in.facet.color
()
$
cl.col
loc.facet.col
=
loc.facet.col
[
loc.groups
]
}
p.out
=
myGgplotTraj
(
dt.arg
=
loc.dt
,
...
...
modules/trajRibbonPlot.R
View file @
7b7d8294
...
...
@@ -49,7 +49,7 @@ modTrajRibbonPlot = function(input, output, session,
in.data
,
in.facet
=
'group'
,
in.facet.color
=
NULL
,
in.fname
=
'tCoursesMeans.pdf'
)
{
in.fname
)
{
ns
<-
session
$
ns
...
...
@@ -101,7 +101,9 @@ modTrajRibbonPlot = function(input, output, session,
# Trajectory plot - download pdf
callModule
(
downPlot
,
"downPlotTraj"
,
in.fname
,
plotTraj
,
TRUE
)
callModule
(
downPlot
,
"downPlotTraj"
,
in.fname
=
in.fname
,
plotTraj
,
TRUE
)
plotTraj
<-
function
()
{
cat
(
file
=
stderr
(),
'plotTraj: in\n'
)
...
...
server.R
View file @
7b7d8294
...
...
@@ -449,7 +449,7 @@ shinyServer(function(input, output, session) {
cat
(
file
=
stderr
(),
'dataMod: trajRem not NULL\n'
)
loc.dt.rem
=
dataLoadTrajRem
()
print
(
loc.dt.rem
)
loc.dt
=
loc.dt
[
!
(
trackObjectsLabelUni
%in%
loc.dt.rem
[[
1
]])]
}
...
...
@@ -742,12 +742,14 @@ shinyServer(function(input, output, session) {
)
###### Trajectory plotting
callModule
(
modTrajRibbonPlot
,
'modTrajRibbon'
,
data4trajPlot
)
callModule
(
modTrajRibbonPlot
,
'modTrajRibbon'
,
in.data
=
data4trajPlot
)
in.data
=
data4trajPlot
,
in.fname
=
function
()
return
(
"tCoursesMeans.pdf"
))
###### Trajectory plotting
callModule
(
modTrajPlot
,
'modTrajPlot'
,
data4trajPlot
)
callModule
(
modTrajPlot
,
'modTrajPlot'
,
in.data
=
data4trajPlot
,
in.fname
=
function
()
{
return
(
"tCourses.pdf"
)})
## UI for selecting trajectories
# The output data table of data4trajPlot is modified based on inSelHighlight field
...
...
@@ -771,13 +773,13 @@ shinyServer(function(input, output, session) {
})
###### AUC calculation and plotting
callModule
(
modAUCplot
,
'tabAUC'
,
data4trajPlot
)
callModule
(
modAUCplot
,
'tabAUC'
,
data4trajPlot
,
in.fname
=
function
()
return
(
'boxplotAUC.pdf'
)
)
###### Box-plot
callModule
(
tabBoxPlot
,
'tabBoxPlot'
,
data4trajPlot
)
callModule
(
tabBoxPlot
,
'tabBoxPlot'
,
data4trajPlot
,
in.fname
=
function
()
return
(
'boxplotTP.pdf'
)
)
###### Scatter plot
callModule
(
tabScatterPlot
,
'tabScatter'
,
data4trajPlot
)
callModule
(
tabScatterPlot
,
'tabScatter'
,
data4trajPlot
,
in.fname
=
function
()
return
(
'scatter.pdf'
)
)
##### Hierarchical clustering
callModule
(
clustHier
,
'tabClHier'
,
data4clust
,
data4trajPlot
)
...
...
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