Skip to content

GitLab

S
shiny-timecourse-inspector
Commit 256623a3 authored by dmattek's avatar dmattek
Browse files
Options

Added: boxplots 

UI overhaul: side panel added
parent 7ea6e2c0
Hide whitespace changes
Inline Side-by-side
Showing with 443 additions and 182 deletions
auxfunc.R
View file @ 256623a3
...@@ -41,12 +41,22 @@ myGgplotTraj = function(dt.arg, ...@@ -41,12 +41,22 @@ myGgplotTraj = function(dt.arg,
stim.bar.width.arg = 0.5) { stim.bar.width.arg = 0.5) {
p.tmp = ggplot(dt.arg, p.tmp = ggplot(dt.arg,
aes_string(x = x.arg, aes_string(x = x.arg,
y = y.arg)) y = y.arg,
group = group.arg))
if (is.null(line.col.arg)) if (is.null(line.col.arg)) {
p.tmp = p.tmp + geom_line(aes_string(group = group.arg), alpha = 0.25, size = 0.25) p.tmp = p.tmp +
else geom_line(alpha = 0.25,
p.tmp = p.tmp + geom_line(aes_string(group = group.arg, colour = line.col.arg), alpha = 0.5, size = 0.5) size = 0.25)
}
else {
p.tmp = p.tmp +
geom_line(aes_string(colour = line.col.arg),
alpha = 0.5,
size = 0.5) +
scale_color_manual(name = '',
values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green', "NOT SEL" = rhg_cols[7]))
}
p.tmp = p.tmp + p.tmp = p.tmp +
stat_summary( stat_summary(
......
server.R
View file @ 256623a3
...@@ -29,6 +29,9 @@ shinyServer(function(input, output, session) { ...@@ -29,6 +29,9 @@ shinyServer(function(input, output, session) {
#dataLoadStim = isolate(input$inButLoadStim) #dataLoadStim = isolate(input$inButLoadStim)
) )
####
## UI for side panel
# This button will reset the inFileLoad # This button will reset the inFileLoad
observeEvent(input$inButReset, { observeEvent(input$inButReset, {
reset("inFileLoadNuc") # reset is a shinyjs function reset("inFileLoadNuc") # reset is a shinyjs function
...@@ -56,14 +59,136 @@ shinyServer(function(input, output, session) { ...@@ -56,14 +59,136 @@ shinyServer(function(input, output, session) {
} }
}) })
# load stimulation pattern # This button will reset the inFileLoad
# dataLoadStim <- eventReactive(input$inButLoadStim, { observeEvent(input$butReset, {
# cat("dataLoadStim\n") reset("inFileLoadNuc") # reset is a shinyjs function
# locFilePath = input$inFileLoadStim$datapath # reset("inFileStimLoad") # reset is a shinyjs function
# counter$dataLoadStim <- input$inButLoadStim - 1
# })
# return(fread(locFilePath))
# })
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% 'RealTime'][1] # index 1 at the end in case more matches; select 1st
cat(locColSel, '\n')
selectInput(
'inSelTime',
'Select time column (e.g. RealTime):',
locCols,
width = '100%',
selected = locColSel
)
})
# This is main field to select plot facet grouping
# 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.
# In Coralie's case it's a combination of 3 columns called Stimulation_...
output$varSelGroup = renderUI({
cat(file = stderr(), 'UI varSelGroup\n')
locCols = getDataNucCols()
if (!is.null(locCols)) {
locColSel = locCols[locCols %like% 'ite']
if (length(locColSel) == 0)
locColSel = locCols[locCols %like% 'eries'][1] # index 1 at the end in case more matches; select 1st
else if (length(locColSel) > 1) {
locColSel = locColSel[1]
}
# cat('UI varSelGroup::locColSel ', locColSel, '\n')
selectInput(
'inSelGroup',
'Select one or more facet groupings (e.g. Site, Well, Channel):',
locCols,
width = '100%',
selected = locColSel,
multiple = TRUE
)
}
})
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 FOV (e.g. Metadata_Site or Metadata_Series):',
locCols,
width = '100%',
selected = locColSel
)
})
output$varSelMeas1 = renderUI({
cat(file = stderr(), 'UI varSelMeas1\n')
locCols = getDataNucCols()
if (!is.null(locCols)) {
locColSel = locCols[locCols %like% 'objCyto_Intensity_MeanIntensity_imErkCor.*' | locCols %like% 'Ratio'][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$varSelMeas2 = renderUI({
cat(file = stderr(), 'UI varSelMeas2\n')
locCols = getDataNucCols()
if (!is.null(locCols) &&
!(input$inSelMath %in% c('', '1 / '))) {
locColSel = locCols[locCols %like% 'objNuc_Intensity_MeanIntensity_imErkCor.*'][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
)
}
})
####
## data processing
# generate random dataset 1
dataGen1 <- eventReactive(input$inDataGen1, {
cat("dataGen1\n")
return(userDataGen())
})
dataInBoth <- reactive({ dataInBoth <- reactive({
# Without direct references to inDataGen1,2 and inFileLoad, inDataGen2 # Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
...@@ -137,31 +262,41 @@ shinyServer(function(input, output, session) { ...@@ -137,31 +262,41 @@ shinyServer(function(input, output, session) {
return(loc.dt) return(loc.dt)
}) })
# return all unique track object labels (created in dataMod)
# This will be used to display in UI for trajectory highlighting
# This button will reset the inFileLoad getDataTrackObjLabUni <- reactive({
observeEvent(input$butReset, { cat(file = stderr(), 'getDataTrackObjLabUni\n')
reset("inFileLoadNuc") # reset is a shinyjs function loc.dt = dataMod()
# reset("inFileStimLoad") # reset is a shinyjs function
if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt$trackObjectsLabelUni))
}) })
# generate random dataset 1 # return all unique time points (real time)
dataGen1 <- eventReactive(input$inDataGen1, { # This will be used to display in UI for trajectory highlighting
cat("dataGen1\n") getDataTpts <- reactive({
cat(file = stderr(), 'getDataTpts\n')
loc.dt = dataMod()
return(userDataGen()) if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt[[input$inSelTime]]))
}) })
# prepare data for plotting time courses # prepare data for plotting time courses
# returns dt with these columns: # returns dt with these columns:
# realtime - selected from input # realtime - selected from input
# y - measurement selected from input (can be a single column or result of an operation on two cols) # y - measurement selected from input
# id - trackObjectsLabelUni (created in dataMod) # (can be a single column or result of an operation on two cols)
# group - grouping variable from input # id - trackObjectsLabelUni (created in dataMod)
# group - grouping variable for facetting from input
# mid.in - column with trajectory selection status from the input file or
# highlight status from UI
data4trajPlot <- reactive({ data4trajPlot <- reactive({
cat(file=stderr(), 'data4trajPlot\n') cat(file=stderr(), 'data4trajPlot\n')
...@@ -184,6 +319,10 @@ shinyServer(function(input, output, session) { ...@@ -184,6 +319,10 @@ shinyServer(function(input, output, session) {
loc.s.rt = input$inSelTime loc.s.rt = input$inSelTime
# Assign tracks selected for highlighting in UI
loc.tracks.highlight = input$inSelHighlight
locBut = input$chBhighlightTraj
# if dataset contains column mid.in with trajectory filtering status, # if dataset contains column mid.in with trajectory filtering status,
# then, include it in plotting # then, include it in plotting
if (sum(names(loc.dt) %in% 'mid.in') > 0) { if (sum(names(loc.dt) %in% 'mid.in') > 0) {
...@@ -194,6 +333,13 @@ shinyServer(function(input, output, session) { ...@@ -194,6 +333,13 @@ shinyServer(function(input, output, session) {
realtime = eval(parse(text = loc.s.rt)), realtime = eval(parse(text = loc.s.rt)),
mid.in = mid.in mid.in = mid.in
)] )]
# add 3rd level with status of track selection
# to a column with trajectory filtering status
if (locBut) {
loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', mid.in)]
}
} else { } else {
loc.out = loc.dt[, .( loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)), y = eval(parse(text = loc.s.y)),
...@@ -201,133 +347,61 @@ shinyServer(function(input, output, session) { ...@@ -201,133 +347,61 @@ shinyServer(function(input, output, session) {
group = eval(parse(text = loc.s.gr)), group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt)) realtime = eval(parse(text = loc.s.rt))
)] )]
# add a column with status of track selection
if (locBut) {
loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
}
} }
# remove rows with NA # remove rows with NA
return(loc.out[complete.cases(loc.out)]) return(loc.out[complete.cases(loc.out)])
}) })
output$varSelSite = renderUI({ # prepare data for plotting boxplots
cat(file = stderr(), 'UI varSelSite\n') # uses the same dt as for trajectory plotting
locCols = getDataNucCols() # returns dt with these columns:
locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st data4boxPlot <- reactive({
cat(file=stderr(), 'data4trajPlot\n')
cat(locColSel, '\n')
selectInput(
'inSelSite',
'Select FOV (e.g. Metadata_Site or Metadata_Series):',
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% 'RealTime'][1] # index 1 at the end in case more matches; select 1st
cat(locColSel, '\n')
selectInput(
'inSelTime',
'Select X-axis (e.g. RealTime):',
locCols,
width = '100%',
selected = locColSel
)
})
# This is main field to select plot facet grouping
# 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.
# In Coralie's case it's a combination of 3 columns called Stimulation_...
output$varSelGroup = renderUI({
cat(file = stderr(), 'UI varSelGroup\n')
locCols = getDataNucCols()
if (!is.null(locCols)) { loc.dt = data4trajPlot()
locColSel = locCols[locCols %like% 'ite'] if(is.null(loc.dt))
if (length(locColSel) == 0) return(NULL)
locColSel = locCols[locCols %like% 'eries'][1] # index 1 at the end in case more matches; select 1st
else if (length(locColSel) > 1) {
locColSel = locColSel[1]
}
# cat('UI varSelGroup::locColSel ', locColSel, '\n')
selectInput(
'inSelGroup',
'Select one or more facet groupings (e.g. Site, Well, Channel):',
locCols,
width = '100%',
selected = locColSel,
multiple = TRUE
)
}
loc.out = loc.dt[realtime %in% input$inSelTpts]
}) })
####
## UI for trajectory plot
output$varSelMeas1 = renderUI({ output$varSelHighlight = renderUI({
cat(file = stderr(), 'UI varSelMeas1\n') cat(file = stderr(), 'UI varSelHighlight\n')
locCols = getDataNucCols()
if (!is.null(locCols)) { locBut = input$chBhighlightTraj
locColSel = locCols[locCols %like% 'objCyto_Intensity_MeanIntensity_imErkCor.*'][1] # index 1 at the end in case more matches; select 1st if (!locBut)
# cat(locColSel, '\n') return(NULL)
selectInput(
'inSelMeas1',
'Select Y-axis:',
locCols,
width = '100%',
selected = locColSel
)
}
})
output$varSelMeas2 = renderUI({
cat(file = stderr(), 'UI varSelMeas2\n')
locCols = getDataNucCols()
if (!is.null(locCols) && loc.v = getDataTrackObjLabUni()
!(input$inSelMath %in% c('', '1 / '))) { if(!is.null(loc.v)) {
locColSel = locCols[locCols %like% 'objNuc_Intensity_MeanIntensity_imErkCor.*'][1] # index 1 at the end in case more matches; select 1st
# cat(locColSel, '\n')
selectInput( selectInput(
'inSelMeas2', 'inSelHighlight',
'Select 2nd opernad for Y-axis', 'Select one or more rajectories:',
locCols, loc.v,
width = '100%', width = '100%',
selected = locColSel multiple = TRUE
) )
} }
}) })
output$uiPlot = renderUI({ output$uiPlotTraj = renderUI({
plotlyOutput("plotTraj", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px')) plotlyOutput("plotTraj", width = paste0(input$inPlotTrajWidth, '%'), height = paste0(input$inPlotTrajHeight, 'px'))
}) })
output$plotTraj <- renderPlotly({ output$plotTraj <- renderPlotly({
cat(file=stderr(), 'plotTraj: in\n') cat(file=stderr(), 'plotTraj: in\n')
locBut = input$butGo locBut = input$butPlotTraj
if (locBut == 0) { if (locBut == 0) {
cat(file=stderr(), 'plotTraj: Go button not pressed\n') cat(file=stderr(), 'plotTraj: Go button not pressed\n')
...@@ -362,7 +436,7 @@ shinyServer(function(input, output, session) { ...@@ -362,7 +436,7 @@ shinyServer(function(input, output, session) {
xlab.arg = 'Time (min)', xlab.arg = 'Time (min)',
line.col.arg = loc.line.col.arg line.col.arg = loc.line.col.arg
) )
# This is required to avoid # This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'" # "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
...@@ -375,4 +449,95 @@ shinyServer(function(input, output, session) { ...@@ -375,4 +449,95 @@ shinyServer(function(input, output, session) {
return(p.out.ly) return(p.out.ly)
}) })
####
## UI for box-plot
output$varSelTpts = renderUI({
cat(file = stderr(), 'UI varSelTpts\n')
loc.v = getDataTpts()
if(!is.null(loc.v)) {
selectInput(
'inSelTpts',
'Select one or more timepoints:',
loc.v,
width = '100%',
selected = 0,
multiple = TRUE
)
}
})
# Boxplot - display
output$outPlotBox = renderPlot({
locBut = input$butPlotBox
if (locBut == 0) {
cat(file=stderr(), 'plotBox: Go button not pressed\n')
return(NULL)
}
plotBox()
}, height = 800)
# Boxplot - download pdf
output$downPlotBox <- downloadHandler(
filename = 'boxplot.pdf',
content = function(file) {
cat(file = stderr(), input$inPlotBoxWidth, input$inPlotBoxHeight, "\n")
ggsave(file, limitsize = FALSE,
plotBox(),
width = input$inPlotBoxWidth,
height = input$inPlotBoxHeight)
}
)
# 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
plotBox <- function(){
cat(file = stderr(), 'plotBox\n')
loc.dt = data4boxPlot()
cat(file=stderr(), "plotBox: on to plot\n\n")
if (is.null(loc.dt)) {
cat(file=stderr(), 'plotBox: dt is NULL\n')
return(NULL)
}
cat(file=stderr(), 'plotBox:dt not NULL\n')
ggplot(loc.dt, aes(x = as.factor(realtime), y = y)) +
geom_boxplot(aes(fill = group),
#position = position_dodge(width = 1),
notch = input$inPlotBoxNotches,
outlier.colour = ifelse(input$inPlotBoxOutliers, 'red', NA)) +
scale_fill_discrete(name = '') +
xlab('\nTime (min)') +
ylab('') +
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 = input$selPlotBoxLegendPos
)
}
}) })
ui.R
View file @ 256623a3
# This is the user-interface definition of a Shiny web application. # This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here: # You can find out more about building applications with Shiny here:
# #
...@@ -10,59 +11,144 @@ library(shinyjs) #http://deanattali.com/shinyjs/ ...@@ -10,59 +11,144 @@ library(shinyjs) #http://deanattali.com/shinyjs/
library(plotly) library(plotly)
shinyUI(fluidPage( shinyUI(fluidPage(
useShinyjs(), # Include shinyjs useShinyjs(),
# Include shinyjs
# Application title # Application title
title = "Timecourse Inspector", title = "Timecourse Inspector",
fluidRow( sidebarLayout(
column(3, sidebarPanel(
h4("Load data files"), h4("Load data files"),
#Selector for file upload
fileInput( #Selector for file upload
'inFileLoadNuc', fileInput(
'Select file (e.g. tCoursesSelected.csv) and press "Load Data"', 'inFileLoadNuc',
accept = c('text/csv', 'text/comma-separated-values,text/plain') 'Select file (e.g. tCoursesSelected.csv) and press "Load Data"',
), accept = c('text/csv', 'text/comma-separated-values,text/plain')
actionButton("inButLoadNuc", "Load Data"), ),
actionButton("butReset", "Reset file input"), actionButton("inButLoadNuc", "Load Data"),
actionButton('inDataGen1', 'Generate artificial dataset'), actionButton("butReset", "Reset file input"),
actionButton('inDataGen1', 'Generate artificial dataset'),
# fileInput( tags$hr(),
# 'inFileStimLoad', uiOutput('varSelSite'),
# 'Choose CSV file with stimulation times, e.g. stimT.csv', uiOutput('varSelTrackLabel'),
# accept = c('text/csv', 'text/comma-separated-values,text/plain') uiOutput('varSelGroup'),
# ),