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

 
+
 # 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)
   })
   
 })
-

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'),