Improved recognition of input data column names

modules/auxfunc.R

@@ -45,6 +45,7 @@ s.cl.spar.linkage = c("average",
 s.cl.diss = c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", "DTW")
 s.cl.spar.diss = c("squared.distance","absolute.value")
 
+# list of palettes for the heatmap
 l.col.pal = list(
   "White-Orange-Red" = 'OrRd',
   "Yellow-Orange-Red" = 'YlOrRd',
@@ -55,6 +56,16 @@ l.col.pal = list(
   "Spectral" = 'Spectral'
 )
 
+# list of palettes for the dendrogram
+l.col.pal.dend = list(
+  "Rainbow" = 'rainbow_hcl',
+  "Sequential" = 'sequential_hcl',
+  "Heat" = 'heat_hcl',
+  "Terrain" = 'terrain_hcl',
+  "Diverge HCL" = 'diverge_hcl',
+  "Diverge HSV" = 'diverge_hsv'
+)
+
 # Creates a popup with help text
 # From: https://gist.github.com/jcheng5/5913297
 helpPopup <- function(title, content,
@@ -341,6 +352,13 @@ userDataGen <- function() {
 }
 
 
+# Fast DTW computation
+fastDTW <-function (x)
+{
+  return(dtw(x, window.type = 'sakoechiba', distance.only = T)$normalizedDistance)
+}
+
+
 # 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.

modules/tabClHier.R

@@ -59,15 +59,22 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
                  column(3,
                         checkboxInput(ns('selectPlotHierDend'), 'Plot dendrogram and re-order samples', TRUE),
                         selectInput(
-                          ns("selectPlotHierPalette"),
-                          label = "Select colour palette:",
-                          choices = l.col.pal,
-                          selected = 'Spectral'
+                          ns("selectPlotHierPaletteDend"),
+                          label = "Dendrogram\'s colour palette:",
+                          choices = l.col.pal.dend,
+                          selected = 'Rainbow'
                         ),
-                        checkboxInput(ns('inPlotHierRevPalette'), 'Reverse colour palette', TRUE),
+
                         checkboxInput(ns('selectPlotHierKey'), 'Plot colour key', TRUE)
                  ),
                  column(3,
+                        selectInput(
+                          ns("selectPlotHierPalette"),
+                          label = "Heatmap\'s colour palette:",
+                          choices = l.col.pal,
+                          selected = 'Spectral'
+                        ),
+                        checkboxInput(ns('inPlotHierRevPalette'), 'Reverse heatmap\'s colour palette', TRUE),
                         sliderInput(
                           ns('inPlotHierNAcolor'),
                           'Shade of grey for NA values (0 - black, 1 - white)',
@@ -76,15 +83,17 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
                           value = 0.8,
                           step = .1,
                           ticks = TRUE
-                        ),
+                        )
+                 ),
+                 column(6,
+                        h4('Classic hierarchical clustering'),
+                        br(),
                         numericInput(ns('inPlotHierHeatMapHeight'), 
                                      'Display plot height [px]', 
                                      value = 600, 
                                      min = 100,
                                      step = 100)
-                 ),
-                 column(6,
-                        h4('Classic hierarchical clustering')
+                        
                  )
                ),
                
@@ -174,6 +183,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
       return(NULL)
     }
     
+    #pr_DB$set_entry(FUN = fastDTW, names = c("fastDTW"))
     cl.dist = dist(dm.t, method = s.cl.diss[as.numeric(input$selectPlotHierDiss)])
     
     return(cl.dist)
@@ -191,11 +201,10 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) {
     }
     
     cl.hc = hclust(dm.dist, method = s.cl.linkage[as.numeric(input$selectPlotHierLinkage)])
-    #cl.lev = rev(row.names(dm.t))
-    
+
     dend <- as.dendrogram(cl.hc)
     dend <- color_branches(dend, 
-                           col = rainbow_hcl, # make sure that n here equals max in the input$inPlotHierNclust slider
+                           col = get(input$selectPlotHierPaletteDend), # make sure that n here equals max in the input$inPlotHierNclust slider
                            k = input$inPlotHierNclust)
     
     return(dend)

server.R

@@ -15,7 +15,7 @@ library(gplots) # for heatmap.2
 library(plotly)
 library(d3heatmap) # for interactive heatmap
 library(dendextend) # for color_branches
-library(colorspace) # for palettes (ised to colour dendrogram)
+library(colorspace) # for palettes (used to colour dendrogram)
 library(RColorBrewer)
 library(sparcl) # sparse hierarchical and k-means
 library(scales) # for percentages on y scale
@@ -115,7 +115,7 @@ shinyServer(function(input, output, session) {
   output$varSelTrackLabel = renderUI({
     cat(file = stderr(), 'UI varSelTrackLabel\n')
     locCols = getDataNucCols()
-    locColSel = locCols[locCols %like% 'rack.*abel'][1] # index 1 at the end in case more matches; select 1st
+    locColSel = locCols[grep('(T|t)rack|ID|id', locCols)[1]] # index 1 at the end in case more matches; select 1st; matches TrackLabel, tracklabel, Track Label etc
     
     selectInput(
       'inSelTrackLabel',
@@ -129,7 +129,7 @@ shinyServer(function(input, output, session) {
   output$varSelTime = renderUI({
     cat(file = stderr(), 'UI varSelTime\n')
     locCols = getDataNucCols()
-    locColSel = locCols[locCols %like% 'RealTime'][1] # index 1 at the end in case more matches; select 1st
+    locColSel = locCols[grep('(T|t)ime|Metadata_T', locCols)[1]] # index 1 at the end in case more matches; select 1st; matches RealTime, realtime, real time, etc.
     
     cat(locColSel, '\n')
     selectInput(
@@ -153,13 +153,9 @@ shinyServer(function(input, output, session) {
       locCols = getDataNucCols()
       
       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')
+        locColSel = locCols[grep('(G|g)roup|(S|s)tim_All|(S|s)timulation|(S|s)ite', locCols)[1]]
+
+        #cat('UI varSelGroup::locColSel ', locColSel, '\n')
         selectInput(
           'inSelGroup',
           'Select one or more facet groupings (e.g. Site, Well, Channel):',
@@ -177,7 +173,7 @@ shinyServer(function(input, output, session) {
     
     if (!input$chBtrackUni) {
       locCols = getDataNucCols()
-      locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
+      locColSel = locCols[grep('(S|s)ite|(S|s)eries', locCols)[1]] # index 1 at the end in case more matches; select 1st
       
       selectInput(
         'inSelSite',
@@ -197,8 +193,7 @@ 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[grep('objCyto_Intensity_MeanIntensity_imErkCor|(R|r)atio|(I|i)ntensity', locCols)[1]] # index 1 at the end in case more matches; select 1st
 
       selectInput(
         'inSelMeas1',
@@ -217,7 +212,7 @@ shinyServer(function(input, output, session) {
     
     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
+      locColSel = locCols[grep('objNuc_Intensity_MeanIntensity_imErkCor', locCols)[1]] # index 1 at the end in case more matches; select 1st
 
       selectInput(
         'inSelMeas2',
@@ -536,8 +531,8 @@ shinyServer(function(input, output, session) {
     
     
     # Find column names with position
-    loc.s.pos.x = names(loc.dt)[names(loc.dt) %like% c('.*ocation.*X') | names(loc.dt) %like% c('.*os.x')]
-    loc.s.pos.y = names(loc.dt)[names(loc.dt) %like% c('.*ocation.*Y') | names(loc.dt) %like% c('.*os.y')]
+    loc.s.pos.x = names(loc.dt)[grep('(L|l)ocation.*X|(P|p)os.x|(P|p)osx', names(loc.dt))[1]]
+    loc.s.pos.y = names(loc.dt)[grep('(L|l)ocation.*X|(P|p)os.x|(P|p)osx', names(loc.dt))[1]]
     
     if (length(loc.s.pos.x) == 1 & length(loc.s.pos.y) == 1)
       locPos = TRUE
@@ -548,13 +543,15 @@ shinyServer(function(input, output, session) {
     # Find column names with ObjectNumber
     # This is different from TrackObject_Label and is handy to keep
     # because labels on segmented images are typically ObjectNumber
-    loc.s.objnum = names(loc.dt)[names(loc.dt) %like% c('ObjectNumber')]
-    if (length(loc.s.objnum) > 0) {
+    loc.s.objnum = names(loc.dt)[grep('(O|o)bject(N|n)umber', names(loc.dt))[1]]
+    #cat('data4trajPlot::loc.s.objnum ', loc.s.objnum, '\n')
+    if (is.na(loc.s.objnum)) {
+      locObjNum = FALSE
+    }
+    else {
       loc.s.objnum = loc.s.objnum[1]
       locObjNum = TRUE
     }
-    else
-      locObjNum = FALSE
     
     
     # if dataset contains column mid.in with trajectory filtering status,

ui.R

@@ -42,7 +42,7 @@ shinyUI(fluidPage(
       uiOutput('uiButLoadTrajRem'),
       
       tags$hr(),
-      checkboxInput('chBtrackUni', 'Track Label unique across entire dataset', FALSE),
+      checkboxInput('chBtrackUni', 'Track Label unique across entire dataset', TRUE),
       helpPopup(
         title = 'Create unique cell ID',
         content = help.text[2],
@@ -53,7 +53,7 @@ shinyUI(fluidPage(
       uiOutput('varSelTrackLabel'),
 
       tags$hr(),
-      checkboxInput('chBgroup', 'Dataset contains grouping column (e.g. treatment, condition)', TRUE),                
+      checkboxInput('chBgroup', 'Dataset contains grouping column (e.g. treatment, condition)', FALSE),                
       uiOutput('varSelGroup'),
       uiOutput('varSelTime'),
       uiOutput('varSelMeas1'),