Initial commit

auxfunc.R

+## Custom plotting
+rhg_cols <- c(
+  "#771C19",
+  "#AA3929",
+  "#E25033",
+  "#F27314",
+  "#F8A31B",
+  "#E2C59F",
+  "#B6C5CC",
+  "#8E9CA3",
+  "#556670",
+  "#000000"
+)
+
+md_cols <- c(
+  "#FFFFFF",
+  "#F8A31B",
+  "#F27314",
+  "#E25033",
+  "#AA3929",
+  "#FFFFCC",
+  "#C2E699",
+  "#78C679",
+  "#238443"
+)
+
+myGgplotTraj = function(dt.arg,
+                        x.arg,
+                        y.arg,
+                        group.arg,
+                        facet.arg,
+                        facet.ncol.arg = 2,
+                        line.col.arg = NULL,
+                        xlab.arg = NULL,
+                        ylab.arg = NULL,
+                        plotlab.arg = NULL,
+                        dt.stim.arg = NULL,
+                        tfreq.arg = 1,
+                        maxrt.arg = 60,
+                        xaxisbreaks.arg = 10,
+                        ylim.arg = c(0,1),
+                        stim.bar.height.arg = 0.1,
+                        stim.bar.width.arg = 0.5) {
+  p.tmp = ggplot(dt.arg,
+                 aes_string(x = x.arg,
+                            y = y.arg))
+  
+  if (is.null(line.col.arg))
+    p.tmp = p.tmp + geom_line(aes_string(group = group.arg), alpha = 0.25, size = 0.25)
+  else
+    p.tmp = p.tmp + geom_line(aes_string(group = group.arg, colour = line.col.arg), alpha = 0.5, size = 0.5)
+  
+  p.tmp = p.tmp + 
+    stat_summary(
+      aes_string(y = y.arg, group = 1),
+      fun.y = mean,
+      colour = 'blue',
+      linetype = 'solid',
+      size = 1,
+      geom = "line",
+      group = 1
+    ) +
+    facet_wrap(as.formula(paste("~", facet.arg)),
+               ncol = facet.ncol.arg,
+               scales = "free_x")
+  
+  if(!is.null(dt.stim.arg)) {
+    p.tmp = p.tmp + geom_segment(data = dt.stim.arg,
+                                 aes(x = Stimulation_time - tfreq.arg,
+                                     xend = Stimulation_time - tfreq.arg,
+                                     y = ylim.arg[1],
+                                     yend = ylim.arg[1] + abs(ylim.arg[2] - ylim.arg[1]) * stim.bar.height.arg),
+                                 colour = rhg_cols[[3]],
+                                 size = stim.bar.width.arg,
+                                 group = 1) 
+  }
+  
+  p.tmp = p.tmp + 
+    scale_x_continuous(breaks = seq(0, maxrt.arg, xaxisbreaks.arg)) +
+    coord_cartesian(ylim = ylim.arg) +
+    xlab(paste0(xlab.arg, "\n")) +
+    ylab(paste0("\n", ylab.arg)) +
+    ggtitle(plotlab.arg) +
+    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 = "top"
+    )
+  
+  p.tmp
+}
+
+
+userDataGen <- function() {  
+  cat(file=stderr(), 'userDataGen: in\n')
+  
+  locNtp = 13
+  locNtracks = 5
+  locNsites = 4
+  locNwells = 2
+  
+  dt.nuc = data.table(Metadata_Site = rep(1:locNsites, each = locNtp * locNtracks),
+                      Metadata_Well = rep(1:locNwells, each = locNtp * locNsites * locNtracks / locNwells),
+                      Metadata_Time = rep(1:locNtp, locNsites* locNtracks),
+                      meas_MeanIntensity_cyto = rnorm(locNtp * locNtracks * locNsites, .5, 0.1),
+                      meas_MeanIntensity_nuc  = rnorm(locNtp * locNtracks * locNsites, .5, 0.1),
+                      TrackLabel = rep(1:(locNtracks*locNsites), each = locNtp))
+  
+  cat(colnames(dt.nuc))
+  return(dt.nuc)
+}

server.R

+
+# This is the server logic for a Shiny web application.
+# You can find out more about building applications with Shiny here:
+#
+# http://shiny.rstudio.com
+#
+
+library(shiny)
+library(shinyjs) #http://deanattali.com/shinyjs/
+library(data.table)
+library(ggplot2)
+library(plotly)
+
+options(shiny.maxRequestSize=30*1024^2)
+source('auxfunc.R')
+
+shinyServer(function(input, output) {
+  
+  butCounter <- reactiveValues(
+    dataLoadNuc  = isolate(ifelse(is.null(input$inFileNucLoad), 0, 1)), 
+    dataLoadStim = isolate(ifelse(is.null(input$inFileStimLoad), 0, 1)), 
+    dataGen  = isolate(input$butDataGen)
+  )
+  
+  getDataNucCols <- reactive({
+    cat(file=stderr(), 'getDataNucCols: in\n')
+    
+    return(colnames(dataInBoth()))
+  })
+  
+  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 Grouping (e.g. Metadata_Site or Well):', 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% 'ime'][1] # index 1 at the end in case more matches; select 1st
+    
+    cat(locColSel, '\n')
+    selectInput('inSelTime', 'Select Time (e.g. RealTime):', locCols, width = '100%', selected = locColSel)
+  })
+
+    output$varSelMeas1 = renderUI({
+    cat(file=stderr(), 'UI varSelMeas1\n')
+    locCols = getDataNucCols()
+    locColSel = locCols[locCols %like% 'MeanIntensity'][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$varSelRatio = renderUI({
+    cat(file=stderr(), 'UI varSelRatio\n')
+    checkboxInput('inSelRatio', 'Divide by:', 0)
+  })
+
+  output$varSelMeas2 = renderUI({
+    cat(file=stderr(), 'UI varSelMeas2\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 Measurement:', locCols, width = '100%', selected = locColSel)
+  })
+  
+  output$outPlot = renderUI({
+    
+    plotlyOutput("trajPlot", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px'))
+  })
+  
+  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 = userDataNuc()
+    dt = dataInBoth()
+    colNameSite  = input$inSelSite
+    colNameTrackLabel = input$inSelTrackLabel
+    
+    if (colNameSite == '' && colNameTrackLabel == '') {
+      cat(file=stderr(), 'userDataNucMod: no colName\n')
+      return(NULL)
+    }
+    
+    dt[, trackObjectsLabelUni := paste(sprintf("%04d", get(colNameSite)),
+                                       sprintf("%04d", get(colNameTrackLabel)),
+                                       sep = "_")]
+
+    loc.colnames = colnames(dt)
+    if (sum(loc.colnames %like% 'Stimulation') == 0) {
+      dt[, metadata.site.stim := get(colNameSite)]
+    } else {
+      dt[, metadata.site.stim := paste(
+        sprintf('%02d', get(colNameSite)),
+        ': ',
+        Stimulation_duration,
+        ' ',
+        Stimulation_intensity,
+        ' ',
+        Stimulation_treatment,
+        sep = ''
+      )]
+    }
+    
+    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
+  })
+  
+  dataInBoth <- reactive({
+    cat(file=stderr(), 'dataInBoth: in\n')
+    
+    locInGen = input$butDataGen
+    locInLoadNuc  = ifelse(is.null(input$inFileNucLoad),  0, isolate(butCounter$dataLoadNuc) + 1)
+    locInLoadStim = ifelse(is.null(input$inFileStimLoad), 0, isolate(butCounter$dataLoadStim) + 1)
+    
+    cat(file=stderr(), "dataInBoth\n1: ", locInGen, "\n2: ", locInLoadNuc, "\n3: ", locInLoadStim, "\n")
+    
+    # isolate the checks of counter reactiveValues
+    # as we set the values in this same reactive
+    if (locInLoadNuc != isolate(butCounter$dataLoadNuc)) {
+      cat(file=stderr(), "dataInBoth if inFileNucLoad\n")
+      dm = userDataNuc()
+
+      # no need to isolate updating the counter reactive values!
+      butCounter$dataLoad <- locInLoadNuc
+    } else if (locInGen != isolate(butCounter$dataGen)) {
+      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
+    
+    cat(file=stderr(), 'dataInBoth: out\n')
+    return(dm)
+  })
+  
+  output$trajPlot <- renderPlotly({
+    
+    cat(file=stderr(), 'trajPlot: in\n')
+    locBut = input$butGo
+    
+    if (locBut == 0) {
+      cat(file=stderr(), 'trajPlot: Go button not pressed\n')
+      
+      return(NULL)
+    }
+    
+    
+    dt.nuc = (userDataNucMod())
+    locInLoadStim = isolate(input$inFileStimLoad)
+    
+    if (is.null(dt.nuc) && is.null(locInLoadStim)) {
+      cat(file=stderr(), 'trajPlot: Data not yet loaded\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)
+    
+    if (isolate(input$inSelRatio)) {
+      loc.meas.2 = isolate(input$inSelMeas2)
+      loc.y.arg = paste0(loc.meas.1, ' / ', loc.meas.2)
+    }  else
+      loc.y.arg = loc.meas.1
+    
+    cat(loc.y.arg)
+    
+    p.out = myGgplotTraj(
+      dt.arg = dt.nuc,
+      x.arg = loc.time,
+      y.arg = loc.y.arg,
+      group.arg = "trackObjectsLabelUni",
+      facet.arg = 'metadata.site.stim',
+#      xlab.arg = "Time (min)",
+#      ylab.arg = loc.y.arg,
+#      plotlab.arg = "Raw data from illumination-corrected images",
+      dt.stim.arg = dt.stim,
+      tfreq.arg = 1,
+      maxrt.arg = 120,
+      xaxisbreaks.arg = 10,
+      facet.ncol.arg = loc.facet.ncol.arg,
+      ylim.arg = c(0, 1.2),
+      stim.bar.height.arg = 0.05,
+      stim.bar.width.arg = 1
+    )
+    
+    #ggplotly(p.out)
+    cat(file=stderr(), 'trajPlot: out\n')
+    return(ggplotly(p.out))
+  })
+  
+})
+

ui.R

+
+# This is the user-interface definition of a Shiny web application.
+# You can find out more about building applications with Shiny here:
+#
+# http://shiny.rstudio.com
+#
+
+library(shiny)
+library(plotly)
+
+shinyUI(fluidPage(
+  useShinyjs(), # Include shinyjs
+  
+  # Application title
+  title = "Timecourse Inspector",
+  
+  fluidRow(
+    column(3,
+           h4("Load data files"),
+           #Selector for file upload
+           fileInput(
+             'inFileNucLoad',
+             'Choose CSV file with measurement data, e.g. tCoursesSelected.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')
+           ),
+           
+           actionButton("butReset", "Reset file input"),
+           actionButton('butDataGen', 'Generate artificial dataset'),
+           actionButton('butGo', 'Go!')),
+    
+    column(4, offset = 1,
+           uiOutput('varSelSite'),
+           uiOutput('varSelTrackLabel'),
+           uiOutput('varSelTime'),
+           uiOutput('varSelMeas1'),
+           uiOutput('varSelRatio'),
+           uiOutput('varSelMeas2')),
+  
+    column(2, offset = 1,
+           numericInput('inFacetNcol', 'No. of plot columns:', value = 4, min = 1, width = '150px', step = 1),
+           numericInput('inPlotHeight', 'Plot Height [px]:', value = 400, min = 100, width = '150px', step = 50),
+           numericInput('inPlotWidth', 'Plot Width [%]:', value = 100, min = 10, max = 100, width = '150px', step = 10))
+  ),
+  br(),
+  uiOutput('outPlot')
+))
+