From f1f961dcb6fe7a854ced52c1dcdbf75e595266b5 Mon Sep 17 00:00:00 2001 From: dmattek Date: Tue, 14 Mar 2017 12:08:07 +0100 Subject: [PATCH] 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 --- server.R | 483 ++++++++++++++++++++++++++++++------------------------- ui.R | 35 ++-- 2 files changed, 277 insertions(+), 241 deletions(-) diff --git a/server.R b/server.R index c6fa58b..8f9115c 100644 --- a/server.R +++ b/server.R @@ -1,4 +1,5 @@ + # 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 : 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
y: %.2f
id: %s
s: %s", - # dt.nuc[[loc.time]], - # dt.nuc[[loc.y.arg]], dt.nuc[['trackObjectsLabelUni']], - # dt.nuc[[loc.facet.group]]) - return(p.out.ly) }) }) - diff --git a/ui.R b/ui.R index 1d30f93..8ac4950 100644 --- a/ui.R +++ b/ui.R @@ -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') )) -- GitLab