Commit f1f961dc authored by dmattek's avatar dmattek

Rewritten to allow for multiple selection of facetting variable.

Added:
Load button
F-n data4trajPlot that prepares data based on column selections in the UI
parent a1a6653f
# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
......@@ -11,292 +12,338 @@ library(data.table)
library(ggplot2)
library(plotly)
options(shiny.maxRequestSize=30*1024^2)
# increase file upload limit
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
source('auxfunc.R')
shinyServer(function(input, output, session) {
useShinyjs()
butCounter <- reactiveValues(
dataLoadNuc = isolate(ifelse(is.null(input$inFileNucLoad), 0, 1)),
dataLoadStim = isolate(ifelse(is.null(input$inFileStimLoad), 0, 1)),
dataGen = isolate(input$butDataGen)
# This is only set at session start
# we use this as a way to determine which input was
# clicked in the dataInBoth reactive
counter <- reactiveValues(
# The value of inDataGen1,2 actionButton is the number of times they were pressed
dataGen1 = isolate(input$inDataGen1),
dataLoadNuc = isolate(input$inButLoadNuc)
#dataLoadStim = isolate(input$inButLoadStim)
)
# 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, {
cat("dataGen1\n")
return(userDataGen())
})
# load main data file
dataLoadNuc <- eventReactive(input$inButLoadNuc, {
cat("dataLoadNuc\n")
locFilePath = input$inFileLoadNuc$datapath
counter$dataLoadNuc <- input$inButLoadNuc - 1
if (is.null(locFilePath) || locFilePath == '')
return(NULL)
else {
return(fread(locFilePath))
}
})
# load stimulation pattern
# dataLoadStim <- eventReactive(input$inButLoadStim, {
# cat("dataLoadStim\n")
# locFilePath = input$inFileLoadStim$datapath
# counter$dataLoadStim <- input$inButLoadStim - 1
#
# return(fread(locFilePath))
# })
dataInBoth <- reactive({
# Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
# does not trigger running this reactive once inDataGen1 is used.
# This is one of the more nuanced areas of reactive programming in shiny
# due to the if else logic, it isn't fetched once inDataGen1 is available
# The morale is use direct retrieval of inputs to guarantee they are available
# for if else logic checks!
locInGen1 = input$inDataGen1
locInLoadNuc = input$inButLoadNuc
#locInLoadStim = input$inButLoadStim
cat(
"dataInBoth\ninGen1: ",
locInGen1,
" prev=",
isolate(counter$dataGen1),
"\ninDataNuc: ",
locInLoadNuc,
" prev=",
isolate(counter$dataLoadNuc),
# "\ninDataStim: ",
# locInLoadStim,
# " prev=",
# isolate(counter$dataLoadStim),
"\n"
)
# isolate the checks of counter reactiveValues
# as we set the values in this same reactive
if (locInGen1 != isolate(counter$dataGen1)) {
cat("dataInBoth if inDataGen1\n")
dm = dataGen1()
# no need to isolate updating the counter reactive values!
counter$dataGen1 <- locInGen1
} else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
cat("dataInBoth if inDataLoadNuc\n")
dm = dataLoadNuc()
# no need to isolate updating the counter reactive values!
counter$dataLoadNuc <- locInLoadNuc
} else {
cat("dataInBoth else\n")
dm = NULL
}
return(dm)
})
# return column names of the main dt
getDataNucCols <- reactive({
cat(file=stderr(), 'getDataNucCols: in\n')
cat(file = stderr(), 'getDataNucCols: in\n')
loc.dt = dataInBoth()
if (is.null(loc.dt))
return(NULL)
else
return(colnames(loc.dt))
})
# return dt with an added column with unique track object label
dataMod <- reactive({
cat(file=stderr(), 'dataMod\n')
loc.dt = dataInBoth()
if(is.null(loc.dt))
return(NULL)
loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
sprintf("%04d", get(input$inSelTrackLabel)),
sep = "_")]
return(colnames(dataInBoth()))
return(loc.dt)
})
# This button will reset the inFileLoad
observeEvent(input$butReset, {
reset("inFileLoadNuc") # reset is a shinyjs function
# reset("inFileStimLoad") # reset is a shinyjs function
})
# generate random dataset 1
dataGen1 <- eventReactive(input$inDataGen1, {
cat("dataGen1\n")
return(userDataGen())
})
# prepare data for plotting time courses
# returns dt with these columns:
# realtime - selected from input
# y - measurement selected from input (can be a single column or result of an operation on two cols)
# id - trackObjectsLabelUni (created in dataMod)
# group - grouping variable from input
data4trajPlot <- reactive({
cat(file=stderr(), 'data4trajPlot\n')
loc.dt = dataMod()
if(is.null(loc.dt))
return(NULL)
if(input$inSelMath == '')
loc.s.y = input$inSelMeas1
else if (input$inSelMath == '1 / ')
loc.s.y = paste0(input$inSelMath, input$inSelMeas1)
else
loc.s.y = paste0(input$inSelMeas1, input$inSelMath, input$inSelMeas2)
# create expression for parsing
# creates a merged column based on other columns from input
# used for grouping of plot facets
loc.s.gr = sprintf("paste(%s, sep=';')", paste(input$inSelGroup, sep = '', collapse = ','))
loc.s.rt = input$inSelTime
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt))
)]
# remove rows with NA
return(loc.out[complete.cases(loc.out)])
})
output$varSelSite = renderUI({
cat(file=stderr(), 'UI varSelSite\n')
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)
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')
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)
selectInput(
'inSelTrackLabel',
'Select Track Label (e.g. objNuc_Track_ObjectsLabel):',
locCols,
width = '100%',
selected = locColSel
)
})
output$varSelTime = renderUI({
cat(file=stderr(), 'UI varSelTime\n')
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 X (e.g. RealTime):', locCols, width = '100%', selected = locColSel)
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')
cat(file = stderr(), 'UI varSelGroup\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'timulation']
if (length(locColSel) == 0)
locColSel = locCols[locCols %like% 'ite'][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 Grouping for Plotting (e.g. Site, Well, Channel):', locCols, width = '100%', selected = locColSel)
})
output$varSelGroup2 = renderUI({
cat(file=stderr(), 'UI varSelGroup2\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'timulation']
if (length(locColSel) == 0)
locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
else if (length(locColSel) > 1) {
# updateCheckboxInput(session, 'inGroupMore1', value = 1)
locColSel = locColSel[2]
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
)
}
# cat('UI varSelGroup2::locColSel ', locColSel, '\n')
if(input$inGroupMore1) {
selectInput('inSelGroup2', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel)
} else {
disabled(selectInput('inSelGroup2', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel))
}
})
output$varSelGroup3 = renderUI({
cat(file=stderr(), 'UI varSelGroup2\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'timulation']
if (length(locColSel) == 0)
locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
else if (length(locColSel) > 1) {
# updateCheckboxInput(session, 'inGroupMore2', value = 1)
locColSel = locColSel[3]
}
# cat('UI varSelGroup3::locColSel ', locColSel, '\n')
if(input$inGroupMore2) {
selectInput('inSelGroup3', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel)
} else {
disabled(selectInput('inSelGroup3', 'Select Additional Grouping:', locCols, width = '100%', selected = locColSel))
}
})
output$varSelMeas1 = renderUI({
cat(file=stderr(), 'UI varSelMeas1\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'Intensity'][1] # index 1 at the end in case more matches; select 1st
# cat(locColSel, '\n')
selectInput('inSelMeas1', 'Select Y:', locCols, width = '100%', selected = locColSel)
})
output$varSelMeas2 = renderUI({
cat(file=stderr(), 'UI varSelMeas2\n')
cat(file = stderr(), 'UI varSelMeas1\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 operand:', locCols, width = '100%', selected = locColSel)
})
output$outPlot = renderUI({
plotlyOutput("trajPlot", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px'))
if (!is.null(locCols)) {
locColSel = locCols[locCols %like% 'objCyto_Intensity_MeanIntensity_imErkCor.*'][1] # index 1 at the end in case more matches; select 1st
# cat(locColSel, '\n')
selectInput(
'inSelMeas1',
'Select Y-axis:',
locCols,
width = '100%',
selected = locColSel
)
}
})
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 = dataInBoth()
colNameSite = input$inSelSite
colNameTrackLabel = input$inSelTrackLabel
output$varSelMeas2 = renderUI({
cat(file = stderr(), 'UI varSelMeas2\n')
locCols = getDataNucCols()
if (colNameSite == '' && colNameTrackLabel == '') {
cat(file=stderr(), 'userDataNucMod: no colName\n')
return(NULL)
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 opernad for Y-axis',
locCols,
width = '100%',
selected = locColSel
)
}
dt[, trackObjectsLabelUni := paste(sprintf("%04d", get(colNameSite)),
sprintf("%04d", get(colNameTrackLabel)),
sep = "_")]
loc.colnames = colnames(dt)
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
reset("inGroupMore1") # reset is a shinyjs function
reset("inGroupMore2") # reset is a shinyjs function
})
dataInBoth <- reactive({
cat(file=stderr(), 'dataInBoth: in\n')
locInGen = input$butDataGen
locButLoadNuc = isolate(butCounter$dataLoadNuc)
locButLoadStim = isolate(butCounter$dataLoadStim)
locButGen = isolate(butCounter$dataGen)
cat("butCounter$dataGen: ", locButGen, "\nbutCounter$dataLoadNuc: ", locButLoadNuc, "\nbutCounter$locButLoadStim: ", locButLoadStim, "\n")
locInLoadNuc = ifelse(is.null(input$inFileNucLoad), 0, locButLoadNuc + 1)
locInLoadStim = ifelse(is.null(input$inFileStimLoad), 0, locButLoadStim + 1)
cat(file=stderr(), "dataInBoth\ninGen: ", locInGen, "\ninLoadNuc: ", locInLoadNuc, "\ninLoadStim: ", locInLoadStim, "\n")
# isolate the checks of counter reactiveValues
# as we set the values in this same reactive
if (locInLoadNuc != locButLoadNuc) {
cat(file=stderr(), "dataInBoth if inFileNucLoad\n")
dm = userDataNuc()
# no need to isolate updating the counter reactive values!
butCounter$dataLoad <- locInLoadNuc
} else if (locInGen != locButGen) {
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
output$uiPlot = renderUI({
cat(file=stderr(), 'dataInBoth: out\n')
return(dm)
plotlyOutput("plotTraj", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px'))
})
output$trajPlot <- renderPlotly({
output$plotTraj <- renderPlotly({
cat(file=stderr(), 'trajPlot: in\n')
cat(file=stderr(), 'plotTraj: in\n')
locBut = input$butGo
if (locBut == 0) {
cat(file=stderr(), 'trajPlot: Go button not pressed\n')
cat(file=stderr(), 'plotTraj: Go button not pressed\n')
return(NULL)
}
loc.dt = isolate(data4trajPlot())
dt.nuc = userDataNucMod()
locInLoadStim = isolate(input$inFileStimLoad)
if (is.null(dt.nuc) && is.null(locInLoadStim)) {
cat(file=stderr(), 'trajPlot: Data not yet loaded\n')
cat("plotScatter on to plot\n\n")
if (is.null(loc.dt)) {
cat(file=stderr(), 'plotTraj: dt is NULL\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)
# create an expression for faceting (max 3 fields)
loc.facet.group = isolate(input$inSelGroup)
if (isolate(input$inGroupMore1)) {
loc.facet.group = paste0(loc.facet.group, ' + ', isolate(input$inSelGroup2))
}
if (isolate(input$inGroupMore2)) {
loc.facet.group = paste0(loc.facet.group, ' + ', isolate(input$inSelGroup3))
}
# cat("loc.facet.group: ", loc.facet.group, "\n")
cat(file=stderr(), 'plotTraj:dt not NULL\n')
# create expression for plotting Y-axis
loc.math = isolate(input$inSelMath)
if (loc.math != '') {
loc.meas.2 = isolate(input$inSelMeas2)
loc.y.arg = paste0(loc.meas.1, loc.math, loc.meas.2)
} else
loc.y.arg = loc.meas.1
# cat("loc.y.arg", loc.y.arg, "\n")
p.out = myGgplotTraj(
dt.arg = dt.nuc,
x.arg = loc.time,
y.arg = loc.y.arg,
group.arg = "trackObjectsLabelUni",
facet.arg = loc.facet.group,
dt.stim.arg = dt.stim,
tfreq.arg = 1,
facet.ncol.arg = loc.facet.ncol.arg,
stim.bar.height.arg = 0.05,
stim.bar.width.arg = 1
dt.arg = loc.dt,
x.arg = 'realtime',
y.arg = 'y',
group.arg = "id",
facet.arg = 'group',
facet.ncol.arg = input$inPlotTrajFacetNcol,
xlab.arg = 'Time (min)'
)
#ggplotly(p.out)
cat(file=stderr(), 'trajPlot: out\n')
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
......@@ -305,15 +352,7 @@ shinyServer(function(input, output, session) {
pdf(NULL)
p.out.ly = plotly_build(p.out)
# Custom tooltip
# p.out.ly$x$data[[1]]$text <- sprintf("t: %d <br>y: %.2f <br>id: %s <br>s: %s",
# dt.nuc[[loc.time]],
# dt.nuc[[loc.y.arg]], dt.nuc[['trackObjectsLabelUni']],
# dt.nuc[[loc.facet.group]])
return(p.out.ly)
})
})
......@@ -20,16 +20,19 @@ shinyUI(fluidPage(
h4("Load data files"),
#Selector for file upload
fileInput(
'inFileNucLoad',
'Choose CSV file with measurement data, e.g. tCoursesSelected.csv',
'inFileLoadNuc',
'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('inDataGen1', 'Generate artificial dataset'),
fileInput(
'inFileStimLoad',
'Choose CSV file with stimulation times, e.g. stimT.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')
# ),
h4("Plot format"),
fluidRow(
......@@ -41,31 +44,25 @@ shinyUI(fluidPage(
numericInput('inPlotWidth', 'Width [%]:', value = 100, min = 10, max = 100, width = '100px', step = 10))
),
actionButton("butReset", "Reset file input"),
actionButton('butDataGen', 'Generate artificial dataset'),
actionButton('butGo', 'Go!')),
actionButton('butGo', 'Plot!')),
column(3, offset = 1,
uiOutput('varSelSite'),
uiOutput('varSelTrackLabel'),
uiOutput('varSelTime'),
uiOutput('varSelMeas1'),
uiOutput('varSelRatio'),
radioButtons('inSelMath', 'Math operation 1st and 2nd meas.:', c('None' = '',
'Divide' = " / ",
'Sum' = " + ",
'Multiply' = " * ",
'Subtract' = ' - ')),
'Subtract' = ' - ',
'1 / X' = '1 / ')),
uiOutput('varSelMeas2')),
column(3, offset = 1,
uiOutput('varSelGroup'),
checkboxInput('inGroupMore1', 'More grouping?'),
uiOutput('varSelGroup2'),
checkboxInput('inGroupMore2', 'More grouping?'),
uiOutput('varSelGroup3'))
),
uiOutput('varSelGroup'))
),
br(),
uiOutput('outPlot')
uiOutput('uiPlot')
))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment