Added: normalization

auxfunc.R

@@ -130,3 +130,63 @@ userDataGen <- function() {
   cat(colnames(dt.nuc))
   return(dt.nuc)
 }
+
+
+# Returns original dt with an additional column with normalized quantity.
+# The column to be normalised is given by 'in.meas.col'.
+# The name of additional column is the same as in.meas.col but with ".norm" suffix added.
+# Normalisation is based on part of the trajectory;
+# this is defined by in.rt.min and max, and the column with time in.rt.col.
+# Additional parameters:
+# in.by.cols - character vector with 'by' columns to calculate normalisation per group
+#              if NULL, no grouping is done
+# in.robust - whether robust measures should be used (median instead of mean, mad instead of sd)
+# in.type - type of normalization: z.score or mean (fi.e. old change w.r.t. mean)
+
+myNorm = function(in.dt,
+                  in.meas.col,
+                  in.rt.col = 'RealTime',
+                  in.rt.min = 10,
+                  in.rt.max = 20,
+                  in.by.cols = NULL,
+                  in.robust = TRUE,
+                  in.type = 'z.score') {
+  loc.dt <-
+    copy(in.dt) # copy so as not to alter original dt object w intermediate assignments
+  
+  if (is.null(in.by.cols)) {
+    if (in.robust)
+      loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min &
+                                 get(in.rt.col) < in.rt.max, .(meas.md = median(get(in.meas.col), na.rm = TRUE),
+                                                               meas.mad = mad(get(in.meas.col), na.rm = TRUE))]
+    else
+      loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min &
+                                 get(in.rt.col) < in.rt.max, .(meas.md = mean(get(in.meas.col), na.rm = TRUE),
+                                                               meas.mad = sd(get(in.meas.col), na.rm = TRUE))]
+    
+    loc.dt = cbind(loc.dt, loc.dt.pre.aggr)
+  }  else {
+    if (in.robust)
+      loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min &
+                                 get(in.rt.col) < in.rt.max, .(meas.md = median(get(in.meas.col), na.rm = TRUE),
+                                                               meas.mad = mad(get(in.meas.col), na.rm = TRUE)), by = in.by.cols]
+    else
+      loc.dt.pre.aggr = loc.dt[get(in.rt.col) > in.rt.min &
+                                 get(in.rt.col) < in.rt.max, .(meas.md = mean(get(in.meas.col), na.rm = TRUE),
+                                                               meas.mad = sd(get(in.meas.col), na.rm = TRUE)), by = in.by.cols]
+    
+    loc.dt = merge(loc.dt, loc.dt.pre.aggr, by = in.by.cols)
+  }
+  
+  
+  if (in.type == 'z.score') {
+    loc.dt[, meas.norm := (get(in.meas.col) - meas.md) / meas.mad]
+  } else {
+    loc.dt[, meas.norm := (get(in.meas.col) / meas.md)]
+  }
+  
+  setnames(loc.dt, 'meas.norm', paste0(in.meas.col, '.norm'))
+  
+  loc.dt[, c('meas.md', 'meas.mad') := NULL]
+  return(loc.dt)
+}
\ No newline at end of file

server.R

 
 
+
 # This is the server logic for a Shiny web application.
 # You can find out more about building applications with Shiny here:
 #
@@ -32,6 +33,7 @@ shinyServer(function(input, output, session) {
   ####
   ## UI for side panel
   
+  # FILE LOAD
   # This button will reset the inFileLoad
   observeEvent(input$inButReset, {
     reset("inFileLoadNuc")  # reset is a shinyjs function
@@ -66,7 +68,8 @@ shinyServer(function(input, output, session) {
     
   })
   
-
+  
+  # COLUMN SELECTION
   output$varSelTrackLabel = renderUI({
     cat(file = stderr(), 'UI varSelTrackLabel\n')
     locCols = getDataNucCols()
@@ -148,7 +151,8 @@ shinyServer(function(input, output, session) {
     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
+      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',
@@ -180,6 +184,64 @@ shinyServer(function(input, output, session) {
   })
   
   
+  # UI for normalization
+  
+  output$uiChBnorm = renderUI({
+    cat(file = stderr(), 'UI uiChBnorm\n')
+    
+    if (input$chBnorm) {
+      radioButtons(
+        'rBnormMeth',
+        label = 'Select method',
+        choices = list('fold-change' = 'mean', 'z-score' = 'z.score')
+      )
+    }
+  })
+  
+  output$uiSlNorm = renderUI({
+    cat(file = stderr(), 'UI uiSlNorm\n')
+    
+    if (input$chBnorm) {
+      locTpts  = getDataTpts()
+      
+      if(is.null(locTpts))
+        return(NULL)
+      
+      locRTmin = min(locTpts)
+      locRTmax = max(locTpts)
+      
+      sliderInput(
+        'slNormRtMinMax',
+        label = 'Time range for norm.',
+        min = locRTmin,
+        max = locRTmax,
+        value = c(locRTmin, 0.1 * locRTmax)
+      )
+    }
+  })
+  
+  output$uiChBnormRobust = renderUI({
+    cat(file = stderr(), 'UI uiChBnormRobust\n')
+    
+    if (input$chBnorm) {
+      checkboxInput('chBnormRobust',
+                    label = 'Robust stats',
+                    FALSE)
+    }
+  })
+  
+  output$uiChBnormGroup = renderUI({
+    cat(file = stderr(), 'UI uiChBnormGroup\n')
+    
+    if (input$chBnorm) {
+      radioButtons('chBnormGroup',
+                  label = 'Normalisation grouping',
+                  choices = list('Entire dataset' = 'none', 'Per facet' = 'group', 'Per trajectory (Korean way)' = 'id'))
+    }
+  })
+  
+  
+  
   ####
   ## data processing
   
@@ -250,10 +312,10 @@ shinyServer(function(input, output, session) {
   
   # return dt with an added column with unique track object label
   dataMod <- reactive({
-    cat(file=stderr(), 'dataMod\n')
+    cat(file = stderr(), 'dataMod\n')
     loc.dt = dataInBoth()
     
-    if(is.null(loc.dt))
+    if (is.null(loc.dt))
       return(NULL)
     
     loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
@@ -291,21 +353,21 @@ shinyServer(function(input, output, session) {
   # prepare data for plotting time courses
   # returns dt with these columns:
   #    realtime - selected from input
-  #    y        - measurement 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 for facetting from input
   #    mid.in   - column with trajectory selection status from the input file or
   #               highlight status from UI
   data4trajPlot <- reactive({
-    cat(file=stderr(), 'data4trajPlot\n')
+    cat(file = stderr(), 'data4trajPlot\n')
     
     loc.dt = dataMod()
-    if(is.null(loc.dt))
+    if (is.null(loc.dt))
       return(NULL)
     
     
-    if(input$inSelMath == '')
+    if (input$inSelMath == '')
       loc.s.y = input$inSelMeas1
     else if (input$inSelMath == '1 / ')
       loc.s.y = paste0(input$inSelMath, input$inSelMeas1)
@@ -315,7 +377,10 @@ shinyServer(function(input, output, session) {
     # 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 = ','))
+    if(length(input$inSelGroup) == 0)
+      return(NULL)
+    loc.s.gr = sprintf("paste(%s, sep=';')",
+                       paste(input$inSelGroup, sep = '', collapse = ','))
     
     loc.s.rt = input$inSelTime
     
@@ -354,6 +419,24 @@ shinyServer(function(input, output, session) {
       }
     }
     
+    
+    # Normalization
+    if (input$chBnorm) {
+      loc.out = myNorm(
+        in.dt = loc.out,
+        in.meas.col = 'y',
+        in.rt.col = 'realtime',
+        in.rt.min = input$slNormRtMinMax[1],
+        in.rt.max = input$slNormRtMinMax[2],
+        in.type = input$rBnormMeth,
+        in.robust = input$chBnormRobust,
+        in.by.cols = if(input$chBnormGroup %in% 'none') NULL else input$chBnormGroup
+      )
+      
+      loc.out[, y := NULL]
+      setnames(loc.out, 'y.norm', 'y')
+    }
+    
     # remove rows with NA
     return(loc.out[complete.cases(loc.out)])
   })
@@ -362,10 +445,10 @@ shinyServer(function(input, output, session) {
   # uses the same dt as for trajectory plotting
   # returns dt with these columns:
   data4boxPlot <- reactive({
-    cat(file=stderr(), 'data4trajPlot\n')
+    cat(file = stderr(), 'data4trajPlot\n')
     
     loc.dt = data4trajPlot()
-    if(is.null(loc.dt))
+    if (is.null(loc.dt))
       return(NULL)
     
     loc.out = loc.dt[realtime %in% input$inSelTpts]
@@ -382,7 +465,7 @@ shinyServer(function(input, output, session) {
       return(NULL)
     
     loc.v = getDataTrackObjLabUni()
-    if(!is.null(loc.v)) {
+    if (!is.null(loc.v)) {
       selectInput(
         'inSelHighlight',
         'Select one or more rajectories:',
@@ -393,18 +476,20 @@ shinyServer(function(input, output, session) {
     }
   })
   
-  
   output$uiPlotTraj = renderUI({
-    
-    plotlyOutput("plotTraj", width = paste0(input$inPlotTrajWidth, '%'), height = paste0(input$inPlotTrajHeight, 'px'))
+    plotlyOutput(
+      "plotTraj",
+      width = paste0(input$inPlotTrajWidth, '%'),
+      height = paste0(input$inPlotTrajHeight, 'px')
+    )
   })
   
   output$plotTraj <- renderPlotly({
-    cat(file=stderr(), 'plotTraj: in\n')
+    cat(file = stderr(), 'plotTraj: in\n')
     locBut = input$butPlotTraj
     
     if (locBut == 0) {
-      cat(file=stderr(), 'plotTraj: Go button not pressed\n')
+      cat(file = stderr(), 'plotTraj: Go button not pressed\n')
       
       return(NULL)
     }
@@ -413,15 +498,35 @@ shinyServer(function(input, output, session) {
     
     cat("plotScatter on to plot\n\n")
     if (is.null(loc.dt)) {
-      cat(file=stderr(), 'plotTraj: dt is NULL\n')
+      cat(file = stderr(), 'plotTraj: dt is NULL\n')
       return(NULL)
     }
     
-    cat(file=stderr(), 'plotTraj:dt not NULL\n')
-    
+    cat(file = stderr(), 'plotTraj:dt not NULL\n')
+    
+    # Normalization
+    # if (input$chBnorm) {
+    #   loc.dt = myNorm(
+    #     in.dt = loc.dt,
+    #     in.meas.col = 'y',
+    #     in.rt.col = 'realtime',
+    #     in.rt.min = input$slNormRtMinMax[1],
+    #     in.rt.max = input$slNormRtMinMax[2],
+    #     in.type = input$rBnormMeth,
+    #     in.robust = input$chBnormRobust,
+    #     in.by.cols = if(input$chBnormGroup %in% 'none') NULL else input$chBnormGroup
+    #   )
+    #   #cat(input$slNormRtMinMax, '\n')
+    #   loc.y.arg = 'y.norm'
+    # } else {
+    #   loc.y.arg = 'y'
+    # }
+    
+    
+    # Future: change such that a column with colouring status is chosen by the user
     # colour trajectories, if dataset contains mi.din column
     # with filtering status of trajectory
-    if(sum(names(loc.dt) %in% 'mid.in') > 0)
+    if (sum(names(loc.dt) %in% 'mid.in') > 0)
       loc.line.col.arg = 'mid.in'
     else
       loc.line.col.arg = NULL
@@ -438,18 +543,19 @@ shinyServer(function(input, output, session) {
     )
     
     
-    # This is required to avoid 
+    # This is required to avoid
     # "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
     # When running on a server. Based on:
     # https://github.com/ropensci/plotly/issues/494
-    if (names(dev.cur()) != "null device") dev.off()
+    if (names(dev.cur()) != "null device")
+      dev.off()
     pdf(NULL)
     
     p.out.ly = plotly_build(p.out)
     return(p.out.ly)
   })
   
-
+  
   ####
   ## UI for box-plot
   
@@ -457,12 +563,12 @@ shinyServer(function(input, output, session) {
     cat(file = stderr(), 'UI varSelTpts\n')
     
     loc.v = getDataTpts()
-    if(!is.null(loc.v)) {
+    if (!is.null(loc.v)) {
       selectInput(
         'inSelTpts',
         'Select one or more timepoints:',
         loc.v,
-        width = '100%', 
+        width = '100%',
         selected = 0,
         multiple = TRUE
       )
@@ -471,16 +577,15 @@ shinyServer(function(input, output, session) {
   
   # Boxplot - display
   output$outPlotBox = renderPlot({
-    
     locBut = input$butPlotBox
     
     if (locBut == 0) {
-      cat(file=stderr(), 'plotBox: Go button not pressed\n')
+      cat(file = stderr(), 'plotBox: Go button not pressed\n')
       return(NULL)
     }
     
     plotBox()
-
+    
   }, height = 800)
   
   # Boxplot - download pdf
@@ -488,11 +593,17 @@ shinyServer(function(input, output, session) {
     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)
+      cat(file = stderr(),
+          input$inPlotBoxWidth,
+          input$inPlotBoxHeight,
+          "\n")
+      ggsave(
+        file,
+        limitsize = FALSE,
+        plotBox(),
+        width  = input$inPlotBoxWidth,
+        height = input$inPlotBoxHeight
+      )
     }
   )
   
@@ -500,25 +611,29 @@ shinyServer(function(input, output, session) {
   # 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(){
+  
+  plotBox <- function() {
     cat(file = stderr(), 'plotBox\n')
     
     loc.dt = data4boxPlot()
     
-    cat(file=stderr(), "plotBox: on to plot\n\n")
+    cat(file = stderr(), "plotBox: on to plot\n\n")
     if (is.null(loc.dt)) {
-      cat(file=stderr(), 'plotBox: dt is NULL\n')
+      cat(file = stderr(), 'plotBox: dt is NULL\n')
       return(NULL)
     }
     
-    cat(file=stderr(), 'plotBox:dt not NULL\n')
+    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)) + 
+      geom_boxplot(
+        aes(fill = group),
+        #position = position_dodge(width = 1),
+        notch = input$inPlotBoxNotches,
+        outlier.colour = if(input$inPlotBoxOutliers) 'red' else NA
+      ) +
       scale_fill_discrete(name = '') +
       xlab('\nTime (min)') +
       ylab('') +

ui.R

@@ -19,17 +19,16 @@ shinyUI(fluidPage(
   
   sidebarLayout(
     sidebarPanel(
-      h4("Load data files"),
-      
       #Selector for file upload
       fileInput(
         'inFileLoadNuc',
-        'Select file (e.g. tCoursesSelected.csv) and press "Load Data"',
+        'Select data 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'),
+
       tags$hr(),
       uiOutput('varSelSite'),
       uiOutput('varSelTrackLabel'),
@@ -48,7 +47,14 @@ shinyUI(fluidPage(
           '1 / X' = '1 / '
         )
       ),
-      uiOutput('varSelMeas2')
+      uiOutput('varSelMeas2'),
+      
+      tags$hr(),
+      checkboxInput('chBnorm', 'Normalization', FALSE),
+      uiOutput('uiChBnorm'),
+      uiOutput('uiSlNorm'),
+      uiOutput('uiChBnormRobust'),
+      uiOutput('uiChBnormGroup')
     ),
     
     mainPanel(tabsetPanel(