Added: scatter plot

global.R

 source('modules/auxfunc.R')
 source('modules/downPlot.R')
-source('modules/downCellIDsCls.R')
\ No newline at end of file
+source('modules/downCellIDsCls.R')
+source('modules/tabScatter.R')
\ No newline at end of file

modules/auxfunc.R

@@ -220,6 +220,105 @@ myNorm = function(in.dt,
   return(loc.dt)
 }
 
+# Plots a scatter plot with marginal histograms
+# Points are connected by a line (grouping by cellID)
+#
+# Assumes an input of data.table with
+# x, y - columns with x and y coordinates
+# id - a unique point identifier (here corresponds to cellID)
+# mid - a (0,1) column by which points are coloured (here corresponds to whether cells are within bounds)
+
+myGgplotScat = function(dt.arg,
+                        band.arg = NULL,
+                        facet.arg = NULL,
+                        facet.ncol.arg = 2,
+                        xlab.arg = NULL,
+                        ylab.arg = NULL,
+                        plotlab.arg = NULL,
+                        alpha.arg = 1,
+                        group.col.arg = NULL) {
+  p.tmp = ggplot(dt.arg, aes(x = x, y = y))
+  
+  if (is.null(group.col.arg)) {
+    p.tmp = p.tmp +
+      geom_point(alpha = alpha.arg, aes(group = id))
+  } else {
+    p.tmp = p.tmp +
+      geom_point(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
+      geom_path(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
+      scale_color_manual(name = group.col.arg, values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green'))
+  }
+  
+  if (is.null(band.arg))
+    p.tmp = p.tmp +
+      stat_smooth(
+        method = function(formula, data, weights = weight)
+          rlm(formula, data, weights = weight, method = 'MM'),
+        fullrange = FALSE,
+        level = 0.95,
+        colour = 'blue'
+      )
+  else {
+    p.tmp = p.tmp +
+      geom_abline(slope = band.arg$a, intercept = band.arg$b) +
+      geom_abline(
+        slope = band.arg$a,
+        intercept =  band.arg$b + abs(band.arg$b)*band.arg$width,
+        linetype = 'dashed'
+      ) +
+      geom_abline(
+        slope = band.arg$a,
+        intercept = band.arg$b - abs(band.arg$b)*band.arg$width,
+        linetype = 'dashed'
+      )
+  }
+  
+  if (!is.null(facet.arg)) {
+    p.tmp = p.tmp +
+      facet_wrap(as.formula(paste("~", facet.arg)),
+                 ncol = facet.ncol.arg)
+    
+  }
+  
+  
+  if (!is.null(xlab.arg))
+    p.tmp = p.tmp +
+      xlab(paste0(xlab.arg, "\n"))
+  
+  if (!is.null(ylab.arg))
+    p.tmp = p.tmp +
+      ylab(paste0("\n", ylab.arg))
+  
+  if (!is.null(plotlab.arg))
+    p.tmp = p.tmp +
+      ggtitle(paste0(plotlab.arg, "\n"))
+  
+  
+  
+  p.tmp = p.tmp +
+    theme_bw(base_size = 18, base_family = "Helvetica") +
+    theme(
+      panel.grid.minor = element_blank(),
+      panel.grid.major = 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 = "none"
+    )
+  
+  # Marginal distributions don;t work with plotly...
+  # if (is.null(facet.arg))
+  #   ggExtra::ggMarginal(p.scat, type = "histogram",  bins = 100)
+  # else
+  return(p.tmp)
+}
 
 myGgplotTheme = theme_bw(base_size = 18, base_family = "Helvetica") +
   theme(

modules/tabScatter.R

+# RShiny module for performing hierarchical clustering
+# Use:
+# in ui.R
+# tabPanel(
+#  'Hierarchical',
+#  clustHierUI('TabClustHier'))
+#
+# in server.R
+# callModule(clustHier, 'TabClustHier', dataMod)
+# where dataMod is the output from a reactive function that returns dataset ready for clustering
+
+
+require(plotly) # interactive plot
+require(robust)
+
+# UI
+tabScatterPlotUI <- function(id, label = "Comparing t-points") {
+  ns <- NS(id)
+  
+  tagList(
+    h4(
+      "Scatter plot between two time points"
+    ),
+    br(),
+    
+    fluidRow(
+      column(
+        6,
+        uiOutput(ns('varSelTptX')),
+        uiOutput(ns('varSelTptY'))
+      ),
+      column(
+        6,
+        numericInput(
+          ns('inPlotHeight'),
+          'Display plot height',
+          value = 1000,
+          min = 100,
+          step = 100
+        ),
+        numericInput(
+          ns('inPlotNcolFacet'),
+          '#columns',
+          value = 2,
+          min = 1,
+          step = 1
+        )
+      )
+    ),
+    
+    br(),
+    actionButton(ns('butGoScatter'), 'Plot!'),
+    checkboxInput(ns('plotInt'), 
+                  'Interactive Plot?',
+                  value = FALSE),
+    uiOutput(ns("plotInt_ui")),
+    downPlotUI(ns('downPlotScatter'), "Download PDF")
+  )
+}
+
+# SERVER
+tabScatterPlot <- function(input, output, session, in.data) {
+  
+# return all unique time points (real time)
+# This will be used to display in UI for box-plot
+# These timepoints are from the original dt and aren't affected by trimming of x-axis
+getDataTpts <- reactive({
+  cat(file = stderr(), 'getDataTpts\n')
+  loc.dt = in.data()
+  
+  if (is.null(loc.dt))
+    return(NULL)
+  else
+    return(unique(loc.dt$realtime))
+})
+
+output$varSelTptX = renderUI({
+  cat(file = stderr(), 'UI varSelTptX\n')
+  
+  ns <- session$ns
+  
+  loc.v = getDataTpts()
+  if (!is.null(loc.v)) {
+    selectInput(
+      ns('inSelTptX'),
+      'Select timepoint for X-axis:',
+      loc.v,
+      width = '100%',
+      selected = 0,
+      multiple = FALSE
+    )
+  }
+})
+
+output$varSelTptY = renderUI({
+  cat(file = stderr(), 'UI varSelTptY\n')
+  
+  ns <- session$ns
+  
+  loc.v = getDataTpts()
+  if (!is.null(loc.v)) {
+    selectInput(
+      ns('inSelTptY'),
+      'Select timepoint for Y-axis:',
+      loc.v,
+      width = '100%',
+      selected = 0,
+      multiple = FALSE
+    )
+  }
+})
+
+data4scatterPlot <- reactive({
+  cat(file = stderr(), 'data4scatterPlot\n')
+  
+  loc.dt.in = in.data()
+  if(is.null(loc.dt.in))
+    return(NULL)
+  
+  loc.dt = data.table(x = loc.dt.in[realtime == input$inSelTptX, y],  
+                      y = loc.dt.in[realtime == input$inSelTptY, y],
+                      group = loc.dt.in[realtime == input$inSelTptX, group])
+  
+  
+  loc.dt.x = loc.dt.in[realtime == input$inSelTptX]
+  loc.dt.y = loc.dt.in[realtime == input$inSelTptY]
+  loc.dt = merge(loc.dt.x, loc.dt.y, by = 'id')
+  
+  setnames(loc.dt, c('group.x', 'y.x', 'y.y'), c('group', 'x', 'y'))
+
+  return(loc.dt)
+  
+})
+
+  # 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
+  
+plotScatter <- function() {
+  cat(file=stderr(), "plotScatter\n")
+  
+  # isolate because calculations & plotting take a while
+  # re-plotting done upon button press
+  loc.dt = isolate(data4scatterPlot())
+  #loc.fit = isolate(dataFit())
+  
+  cat("plotScatter on to plot\n\n")
+  if (is.null(loc.dt)) {
+    cat(file=stderr(), 'plotScatter: dt is NULL\n')
+    return(NULL)
+  }
+  
+  cat(file=stderr(), 'plotScatter:dt not NULL\n')
+  
+  
+  ## FIX: r.squared is unavailable for lm  
+  
+  #     loc.fit.rsq = ifelse(input$inRobustFit, loc.fit$r.squared, )
+
+  p.out = myGgplotScat(
+    dt.arg = loc.dt,
+    band.arg = NULL, #list(a = loc.fit$coeff.a, b = loc.fit$coeff.b, width = input$inBandWidth),
+    group.col.arg = NULL,
+    plotlab.arg = NULL,
+    # plotlab.arg = sprintf(
+    #   "%s%.2f\n%s%.2f x %.2f",
+    #   ifelse(input$inRobustFit, "lmRob, entire dataset R2=", "lm, entire dataset R2="),
+    #   loc.fit$r.squared,
+    #   'bandwidth=',
+    #   input$inBandWidth,
+    #   loc.fit$coeff.b
+    # ),
+    facet.arg = 'group',
+    facet.ncol.arg = input$inPlotNcolFacet,
+    alpha.arg = 0.5
+  )
+  return(p.out)
+}
+
+# display plot
+output$outPlotScatter <- renderPlot({
+  locBut = input$butGoScatter
+  
+  if (locBut == 0) {
+    cat(file=stderr(), 'plotScatter: Go button not pressed\n')
+    
+    return(NULL)
+  }
+  
+  plotScatter()
+})
+
+
+
+output$outPlotScatterInt <- renderPlotly({
+  # 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()
+  pdf(NULL)
+
+  return( plotly_build(plotScatter()))
+  
+})
+
+  # download pdf
+  callModule(downPlot, "downPlotScatter", "scatter.pdf", plotScatter, TRUE)
+  
+  # Hierarchical - choose to display regular heatmap.2 or d3heatmap (interactive)
+  output$plotInt_ui <- renderUI({
+    ns <- session$ns
+    if (input$plotInt)
+      tagList(plotlyOutput(ns("outPlotScatterInt"), height = paste0(input$inPlotHeight, "px")))
+    else
+      tagList(plotOutput(ns('outPlotScatter'), height = paste0(input$inPlotHeight, "px")))
+  })
+  
+}
\ No newline at end of file

server.R

@@ -803,6 +803,9 @@ shinyServer(function(input, output, session) {
   }
   
   
+  ###### Scatter plot
+  callModule(tabScatterPlot, 'tabScatter', data4trajPlot)
+  
   ##### Hierarchical clustering
   
   output$uiPlotHierClSel = renderUI({
@@ -972,12 +975,12 @@ shinyServer(function(input, output, session) {
     #                                               s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv'),
     #            getDataCl(userFitDendHier, input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim))
     # 
-    # output$downloadDataClean <- downloadHandler(
-    #   filename = 'tCoursesSelected_clean.csv',
-    #   content = function(file) {
-    #     write.csv(data4trajPlot(), file, row.names = FALSE)
-    #   }
-    # )
+    output$downloadDataClean <- downloadHandler(
+      filename = 'tCoursesSelected_clean.csv',
+      content = function(file) {
+        write.csv(data4trajPlot(), file, row.names = FALSE)
+      }
+    )
     
     
     

ui.R

@@ -142,12 +142,17 @@ shinyUI(fluidPage(
       ),
       
 
+      # scatter plot
+      tabPanel(
+        'Scatter',
+        tabScatterPlotUI('tabScatter')
+      ),
+      
       tabPanel(
         'Hierarchical',
         br(),
         fluidRow(
-          column(
-            6,
+          column(4,
             selectInput(
               "selectPlotHierLinkage",
               label = ("Select linkage method:"),
@@ -174,7 +179,7 @@ shinyUI(fluidPage(
               selected = 1
             )
           ),
-          column(6,
+          column(4,
                  sliderInput(
                    'inPlotHierNclust',
                    '#dendrogram branches to colour',
@@ -191,8 +196,6 @@ shinyUI(fluidPage(
                  downloadButton('downCellCl', 'Download CSV with cell IDs and cluster no.')
           )
         ),
-        
-        
         br(),
         #checkboxInput('inPlotHierSparInteractive', 'Interactive Plot?',  value = FALSE),