image_data_explorer.R 32.3 KB
Newer Older
1 2 3 4 5 6 7 8 9
## Install required packages if missing
## CRAN packages
pkg <- c("DT", "shiny", "shinyFiles", "shinycssloaders", "shinydashboard", "ggplot2", "plotly", "RANN", "BiocManager")
new.pkg <- pkg[!(pkg %in% installed.packages())]
if (length(new.pkg)) {
  install.packages(new.pkg)
}
## Bioconductor packages
if(!"RBioFormats" %in% installed.packages()) {
10
  BiocManager::install("aoles/RBioFormats")
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
}
# BiocManager::install("EBImage")
## For now, we need a patched version of EBImage
## May install over pre-existing EBImage
library(devtools)
install_github("jkh1/EBImage")

library(DT) # R interface to the js DataTables library
library(EBImage) # patched version with improved Shiny integration
library(RBioFormats)
library(shiny)
library(shinyFiles) # File and directory selectors
library(shinycssloaders) # Loading/busy animations
library(shinydashboard)
library(ggplot2)
library(plotly)
library(RANN)

## Increase amount of RAM allocated to the JVM to allow BioFormats to read large files.
# options(java.parameters = "-Xmx8g" ) 

## Making data table filtering persistent
## from https://dev.to/awwsmm/reactive-datatables-in-r-with-persistent-filters-l26
## Default global search value
if (!exists("defaultSearch")) defaultSearch <- ""
## Default column search values
if (!exists("defaultSearchColumns")) defaultSearchColumns <- NULL
  
ui <- dashboardPage(
  
  dashboardHeader(title = "Image Data Explorer"),
                       
  ## Sidebar with input and output definitions
  dashboardSidebar(
    
    ## Sidebar panel for inputs
    sidebarMenu(
      id = "menu",
      menuItem("Input data", tabName = "datafile", icon = icon("file-import")),
50 51
      menuItem("Explore", tabName = "explore", icon = icon("microscope")),
      menuItem("Annotate", tabName = "edit", icon = icon("edit"))
52 53 54 55 56 57 58 59 60
    )
  ),
  
  ## Main panel for displaying outputs
  dashboardBody(
    
    ## Hide disabled elements
    tags$head(tags$style(HTML("input[type='search']:disabled {visibility:hidden}"))),
    
61
    ## Custom CSS to:
62 63
    ## - Reduce white space around boxes
    ## - Chenge font size
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
64
    ## - Change postion and size of notification box
65 66 67 68 69 70 71 72 73
    tags$head(tags$style(HTML(
'[class*="col-lg-"],[class*="col-md-"],
[class*="col-sm-"],[class*="col-xs-"]{
  padding-right:5px !important;
  padding-left:5px !important;
}
.main-sidebar { font-size: 20px; }
.shiny-notification {
             position:fixed;
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
74 75 76
             top: calc(50%);
             left: calc(50%);
             width: 22em;
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
             }'
))), 
    
    tabItems(
      tabItem(tabName = "datafile",
              fluidRow(
                box( width = 3,
                     title = "Input data file", solidHeader = TRUE, status = "primary",
                     ## Input: Select a file
                     fileInput("datafile", "Select data file",
                               multiple = FALSE,
                               accept = c("text/csv",
                                          "text/comma-separated-values,text/plain",
                                          ".csv")),
                     
                     ## Input: Checkbox if file has header
                     checkboxInput("header", "File has header", TRUE),
                     
                     ## Input: Select separator
                     radioButtons("sep", "Separator",
                                  choices = c(Comma = ",",
                                              Semicolon = ";",
                                              Tab = "\t"),
                                  selected = "\t"),
                     
                     ## Input: Select quotes
                     radioButtons("quote", "Quote",
                                  choices = c(None = "",
                                              "Double Quote" = '"',
                                              "Single Quote" = "'"),
                                  selected = '')
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
108 109 110 111 112 113 114 115 116 117 118
                ), 
                column(width = 3, 
                       box( width = NULL,
                            title = "Plot variables", solidHeader = TRUE, status = "primary",
                            ## Select variables to display
                            uiOutput("variables")
                       ),
                       box( width = NULL,
                            title = "Columns to hide", solidHeader = TRUE, status = "primary",
                            ## Select columns to hide
                            uiOutput("columnsToHide")
119 120 121 122 123
                       ),
                       box( width = NULL,
                            title = "Columns to edit", solidHeader = TRUE, status = "primary",
                            ## Select columns to edit
                            uiOutput("columnsToEdit")
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
124 125 126 127 128
                       ),
                       box( width = NULL,
                            title = "Groups", solidHeader = TRUE, status = "primary",
                            ## Select variables to display
                            uiOutput("groupsColumn")
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
129 130
                       )
                ),
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
                box( width = 3,
                     title = "Images", solidHeader = TRUE, status = "primary",
                     ## Select image root directory
                     tags$div(style = "line-height: 2",
                              tags$b("Select image root dir"),
                              shinyDirButton('dir',
                                             label = 'Browse...',
                                             title = 'Select image root directory'),
                              tags$br(),
                              "Selected image directory:",
                              tags$br(),
                              verbatimTextOutput('imageDir')
                     ),
                     ## Select column containing image file names
                     uiOutput("fileColumn1"),
                     uiOutput("fileColumn2")
                ),
                box( width = 3,
                     title = "ROIs", solidHeader = TRUE, status = "primary",
                     ## Select columns containing ROI coordinates
                     uiOutput("roiX"),
                     uiOutput("roiY"),
                     uiOutput("roiFrame")
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
154
                )
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
155 156 157 158
              ), # End first row
              fluidRow(
    
              ) # End second row
159
      ),
160
      tabItem(tabName = "explore",
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
              fluidRow( 
                column(12,
                       fluidRow(
                         box( width = 6,
                              title = "Plot", solidHeader = TRUE, status = "primary",
                              withSpinner(
                                plotlyOutput('plot', height = '500px')
                              )
                         ),
                         box( width = 6,
                              title = "Image 1", solidHeader = TRUE, status = "primary",
                              withSpinner(
                                displayOutput("imageViewer1")
                              )
                         )
                       ),
                       fluidRow(
                         box( width = 12,
                              verbatimTextOutput("hover"),
                              verbatimTextOutput("info")
                         )
                       )
                )
              ),
              fluidRow( 
                column(12,
                       tabsetPanel(
                         id = "tabs",
                         tabPanel(
                           ## Output : Data file
191
                           h4('Data'),
192 193 194
                           DTOutput("dataTable")
                         ),
                         tabPanel(
195
                           h4('Image 2'),
196 197 198 199 200 201 202 203 204 205
                           box(
                             title = "Image 2", solidHeader = TRUE, status = "primary",
                             withSpinner(
                               displayOutput("imageViewer2")
                             )
                           )
                         )
                       )
                )
              )
206 207 208 209 210 211 212 213 214
      ),
      tabItem(tabName = "edit",
              fluidRow(
                column(12)
              ),
              fluidRow( 
                column(12,
                       box( width = 12,
                            title = "Editable data", solidHeader = TRUE, status = "primary",
215
                            downloadButton("download1","Download as csv"),
216 217 218 219 220 221
                            withSpinner(
                              DTOutput("dataTableEdit")
                            )
                       )
                )
              )
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
      )
    ) # tabItems
  ) # dashboardBody
) # dashboardPage       



server <- function(input, output, session) {
  
  ## Increase max upload size to 100 MB
  options(shiny.maxRequestSize=100*1024^2)
  
  observeEvent(input$refresh, { session$reload() })
  
  observeEvent(input$header,{
    if(!input$header) {
      showNotification("Data file must have a header.", type ="error")
    }
  })
  
  updateFilters <- function() {
    isolate({
      # Update global search and column search strings
      defaultSearch <- input$dataTable_search
      defaultSearchColumns <- c("", input$dataTable_search_columns)
      # Update the search terms on the proxy table
      updateSearch(proxy, keywords = list(global = defaultSearch, columns = defaultSearchColumns))
    })
  }
  
  ## Dynamically generate UI input to select variables once data is uploaded and read
  
  ## Select variables for plotting
  output$variables <- renderUI({
    selectizeInput(inputId = "selectedVar", 
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
257
                   label = "Select 2 variables to plot",
258 259 260 261 262
                   multiple = TRUE,
                   choices = names(rv$data),
                   options = list(maxItems = 2))
  })
  
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
263 264 265
  ## Select columns to hide
  output$columnsToHide <- renderUI({
    selectizeInput(inputId = "colsToHide", 
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
266
                   label = "These columns will not be displayed",
267 268 269 270 271 272 273
                   multiple = TRUE,
                   choices = names(rv$data))
  })
  
  ## Select columns to edit
  output$columnsToEdit <- renderUI({
    selectizeInput(inputId = "colsToEdit", 
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
274
                   label = "Cells in these columns can be modified",
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
275 276 277 278
                   multiple = TRUE,
                   choices = names(rv$data))
  })
  
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
279 280 281 282 283 284 285 286 287
  ## Select column containing group labels
  output$groupsColumn <- renderUI({
    selectizeInput(inputId = "groupLabels", 
                   label = "Select column containing group labels",
                   multiple = FALSE,
                   choices = c("",names(rv$data)),
                   options = list(maxItems = 1))
  })
  
288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345
  ## Select columns containing ROI coordinates
  output$roiX <- renderUI({
    colNames <- names(rv$data)
    ## Try to infer from name and set as default
    found <- grepl("coordinate_x", colNames, ignore.case = TRUE)
    selection <- NULL
    if(any(found)) {
      selection <- colNames[found]
    }
    selectizeInput(inputId = "roiX", 
                   label = "Column for X coordinates",
                   multiple = FALSE,
                   selected = selection,
                   choices = c("",colNames),
                   options = list(maxItems = 1))
  })
  output$roiY <- renderUI({
    colNames <- names(rv$data)
    ## Try to infer from name and set as default
    found <- grepl("coordinate_y", colNames, ignore.case = TRUE)
    selection <- NULL
    if(any(found)) {
      selection <- colNames[found]
    }
    selectizeInput(inputId = "roiY", 
                   label = "Column for Y coordinates",
                   multiple = FALSE,
                   selected = selection,
                   choices = c("",colNames),
                   options = list(maxItems = 1))
  })
  output$roiFrame <- renderUI({
    colNames <- names(rv$data)
    ## Try to infer from name and set as default
    found <- grepl("coordinate_z|coordinate_time", colNames, ignore.case = TRUE)
    selection <- NULL
    if(any(found)) {
      selection <- colNames[found]
    }
    selectizeInput(inputId = "roiFrame", 
                   label = "Column for frame (Z or time) coordinates",
                   multiple = FALSE,
                   selected = selection,
                   choices = c("",colNames),
                   options = list(maxItems = 1))
  })
  
  ## Select image root directory
  roots = c(home = "~", wd = '.', tier2 = '/g/tier2')
  shinyDirChoose(input, 'dir', roots = roots)
  
  output$imageDir <- renderText({
    dirInfo <- parseDirPath(roots, input$dir)
  })
  ## Select column containing image file names as paths relative to image dir
  output$fileColumn1 <- renderUI({
    colNames <- names(rv$data)
    ## Try to infer from name and set as default
346
    found <- grepl("path|file", colNames, ignore.case = TRUE) & grepl("image|intensit", colNames, ignore.case = TRUE)
347 348 349 350 351 352 353 354 355 356 357 358 359 360
    selection <- NULL
    if(any(found)) {
      selection <- colNames[found]
    }
    selectizeInput(inputId = "fileCol1", 
                   label = "Column with file names for image 1",
                   multiple = TRUE,
                   selected = selection,
                   choices = c("", colNames),
                   options = list(maxItems = 1))
  })
  ## Second image selection
  output$fileColumn2 <- renderUI({
    colNames <- names(rv$data)
361 362 363 364 365 366
    ## Try to infer from name and set as default
    found <- grepl("path|file", colNames, ignore.case = TRUE) & grepl("label|mask", colNames, ignore.case = TRUE)
    selection <- NULL 
    if(any(found)) {
      selection <- colNames[found]
    }
367 368 369
    selectizeInput(inputId = "fileCol2", 
                   label = "Column with file names for image 2",
                   multiple = TRUE,
370
                   selected = selection,
371 372 373 374 375
                   choices = c("",colNames),
                   options = list(maxItems = 1))
  })
  
 
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
376
  rv <- reactiveValues(data = NULL, currentRows = NULL, selectedRows = NULL, clusters = NULL, imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL, 
377
                       selectedFrame = NULL,  metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL, colsToEdit = NULL)
378 379 380 381 382 383 384 385 386 387 388 389
  
  ## Read uploaded data file
  observeEvent(input$datafile, {

    if (is.null(input$datafile)) return(NULL)

    ## After the user selects and uploads a data file,
    ## the content of the data file will be shown.

    req(input$datafile) ## Proceed only if file selected
    
    ## When reading semicolon separated files,
390
    ## having a comma separator causes read.csv to error
391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407
    tryCatch(
      {
        rv$data <- read.csv(input$datafile$datapath,
                            header = input$header,
                            sep = input$sep,
                            quote = input$quote,
                            stringsAsFactors = FALSE)
        rv$currentRows <- c(1:nrow(rv$data))
      },
      error = function(e) {
        ## Return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )
    rv
  })
  
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
408 409 410 411 412 413
  # Columns to hide
  observeEvent(input$colsToHide, {
    req(rv$data) ## Proceed only if file read
    # Get index of each column
    # Note: indexing starts at 0 but if row names are present they are in column 0
    # so we don't use -1 to get the actual column indices.
414
    rv$colsToHide <- match(input$colsToHide, colnames(rv$data))
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
415 416
  })
  
417 418 419 420 421 422 423 424 425
  # Columns to edit
  observeEvent(input$colsToEdit, {
    req(rv$data) ## Proceed only if file read
    # Get index of each column
    # Note: indexing starts at 0 but if row names are present they are in column 0
    # so we don't use -1 to get the actual column indices.
    rv$colsToEdit <- match(input$colsToEdit, colnames(rv$data))
  })
  
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443
  # Group labels
  observeEvent(input$groupLabels, {
    req(rv$data) ## Proceed only if file read
    # Get index of column
    # Note: indexing starts at 0 but if row names are present they are in column 0
    # so we don't use -1 to get the actual column indices.
    idx <- match(input$groupLabels, colnames(rv$data))
    if(!is.null(idx) && !is.na(idx) && length(idx)>0) {
      rv$clusters <- rv$data[,idx]
      if(length(levels(factor(rv$clusters)))>9) {
        showNotification("Not enough colours for more than 9 groups", type = "warning")
        rv$clusters <- NULL
      }
    } else {
      rv$clusters <- NULL
    }
  })
  
444
  ## Show the data table in the explorer (this one is not editable)
445
  output$dataTable <- renderDT({
446
      req(rv$data)
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
447
      datatable(rv$data[rv$currentRows,],
448
                class = 'row-border hover',
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
449
                selection = list(mode = 'multiple', selected = rv$selectedRows),
450
                extensions = c('Buttons', 'Scroller'), 
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
451
                filter = "top",
452
                escape = FALSE, # Don't escape HTML code in the table to allow e.g. checkboxes
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
453 454
                options = list(displayModeBar = TRUE,
                               scrollX = TRUE,
455 456
                               scrollY = 1000,
                               scroller = TRUE,
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
457 458 459 460 461 462
                               stateSave = TRUE,
                               columnDefs = list(list(visible = FALSE, targets = rv$colsToHide)),
                               searchCols = defaultSearchColumns,
                               search = list(regex = FALSE, caseInsensitive = FALSE, search = defaultSearch),
                               autoWidth = TRUE,
                               dom = 'Bfrtip',
463
                               buttons = list(
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
464 465 466 467
                                              list(
                                                extend = 'collection',
                                                text = 'Show filtered rows in plot',
                                                action = DT::JS("function ( e, dt, node, config ) {
468 469
                                                              Shiny.setInputValue('selectFiltered', true, {priority: 'event'});
                                                          }")
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
470 471 472 473 474
                                              ),
                                              list(
                                                extend = 'collection',
                                                text = 'Clear selection',
                                                action = DT::JS("function ( e, dt, node, config ) {
475 476
                                                              Shiny.setInputValue('clearSelected', true, {priority: 'event'});
                                                          }")
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
477 478
                                              )
                               )
479 480
                )) %>%
      formatStyle( 0, target= 'row', lineHeight='60%')
481 482 483 484 485 486 487 488
  }, server = TRUE)  # Server side processing required for large data tables
  
  ## Make a proxy to manipulate the table after it's been rendered
  ## All data point selection irrespective of origin 
  ## should select rows in the proxy table which then 
  ## updates the plot and/or the image(s)
  proxy <- dataTableProxy('dataTable')
  
489 490
  ## Show the plot
  output$plot <- renderPlotly({
491
    req(rv$data)
492 493
    selectedCols <- input$selectedVar
    D <- rv$data[rv$currentRows,]
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
494
    clusters <- rv$clusters[rv$currentRows]
495 496 497 498 499 500 501 502
    IDs <- rownames(D) # Used to uniquely identify data points
    D <- cbind(D, IDs)
    ## Limit selection to two columns otherwise we get a scatterplot matrix
    if (length(selectedCols) == 2) {
      p <- ggplot(data = D, aes_string(x = selectedCols[1], y = selectedCols[2], key = "IDs")) +
        labs(x = eval(selectedCols[1]), y = eval(selectedCols[2])) +
        geom_point(colour = "grey") +
        coord_cartesian(expand = TRUE)
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
503 504
      if(!is.null(rv$clusters)) {
        p <- p + geom_point(aes(colour = factor(clusters)), alpha = 0.3) +
505 506
          scale_colour_brewer(palette = 'Set1') + 
          theme(plot.title = element_blank(), legend.title = element_blank())
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
507 508 509 510 511
      }
      p <- p + geom_point(data = D[rv$selectedRows,],
                     aes_string(x = selectedCols[1], y = selectedCols[2], key = "IDs"),
                     colour = "black")
      ggplotly(p, tooltip = "none") %>% layout(legend = list(orientation = "v", x = 1, y = 0.8)) %>%
512 513
        config(p = ., staticPlot = FALSE, doubleClick = "reset+autosize",  autosizable = TRUE, displayModeBar = TRUE,
               sendData = FALSE, displaylogo = FALSE,
514 515 516 517 518 519 520
               modeBarButtonsToRemove = c("sendDataToCloud", "lasso2d", "select2d", "hoverCompareCartesian")) # Control Plotly's tool bar
    }
  })
  
  ## Interactions with the plot
  observe({
    
521
    req(rv$data)
522 523 524
    df <- rv$data
    
    ## Get indices of data points in selected area (Box and Lasso Select tool)
525
    if(input$menu == "explore") { # Ensure we already have a plot
526 527 528 529
      brush <- event_data("plotly_selected")
      
      if(!is.null(brush)) {
        rv$currentRows <- brush$pointNumber + 1
530
      }
531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553
      
      ## Get indices of data points in zoomed-in/out area
      zoom <- event_data("plotly_relayout")
      
      if(!is.null(zoom) ) {
        ## Take care of cases where range is on one axis only
        if (!is.null(zoom[['xaxis.range[0]']])) {
          if(!is.null(zoom[['yaxis.range[0]']])) {
            rv$currentRows <- which(df[, input$selectedVar[1]] >= zoom[['xaxis.range[0]']] &
                                      df[, input$selectedVar[1]] <= zoom[['xaxis.range[1]']] &
                                      df[, input$selectedVar[2]] >= zoom[['yaxis.range[0]']] &
                                      df[, input$selectedVar[2]] <= zoom[['yaxis.range[1]']], arr.ind = TRUE)
          } else {
            rv$currentRows <- which(df[, input$selectedVar[1]] >= zoom[['xaxis.range[0]']] &
                                      df[, input$selectedVar[1]] <= zoom[['xaxis.range[1]']] , arr.ind = TRUE)
          }
        } else if(!is.null(zoom[['yaxis.range[0]']])) {
          rv$currentRows <- which(df[, input$selectedVar[2]] >= zoom[['yaxis.range[0]']] &
                                    df[, input$selectedVar[2]] <= zoom[['yaxis.range[1]']] , arr.ind = TRUE)
        }
        else {
          rv$currentRows <- c(1:nrow(rv$data))
        }
554 555
      }
    }
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
556
    updateFilters()  # Don't lose search terms
557 558 559 560 561
    rv$currentRows
  })
  ## Show values for data point close to cursor
  ## We don't want to use Plotly's tooltip because it obscures data points
  output$hover <- renderPrint({
562
    req(rv$data)
563 564 565 566 567
    hover <- event_data("plotly_hover")
    if(is.null(hover)) NULL else cat(unlist(hover$key), " : ", paste(rv$data[unlist(hover$key),input$selectedVar]))
  })
  ## Get image(s) associated with selected data point
  observe({
568 569
    req(rv$data)
    req(input$selectedVar)
570
    if(input$menu == "explore") { # Ensure we already have a plot
571 572 573 574 575 576 577 578 579 580 581
      click <- event_data("plotly_click")
      if(!is.null(click)) {
        rv$imgPath1 <- as.character(rv$data[unlist(click$key), input$fileCol1])
        rv$imgPath2 <- as.character(rv$data[unlist(click$key), input$fileCol2])
        if(input$roiFrame != "") {
          rv$selectedFrame <- rv$data[unlist(click$key), input$roiFrame]
        }
        selectRows(proxy, as.numeric(unlist(click$key))) # Set selected point in table
        if(!is.null(input$roiX) && input$roiX != "" && !is.null(input$roiY) && input$roiY != ""){
          rv$pixelPosition <- unlist(rv$data[unlist(click$key), c(input$roiX, input$roiY)])
        }
582 583 584 585 586 587 588
      }
    }
  })
  
  ## Interactions with the table
  observe({
    rv$selectedRows <- input$dataTable_rows_selected
589 590 591 592 593 594 595 596
    if(length(rv$selectedRows) == 1) {
      rv$imgPath1 <- as.character(rv$data[rv$selectedRows, input$fileCol1])
      rv$imgPath2 <- as.character(rv$data[rv$selectedRows, input$fileCol2])
      if(!is.null(input$roiX) && input$roiX != "" && !is.null(input$roiY) && input$roiY != ""){
        rv$pixelPosition <- unlist(rv$data[rv$selectedRows, c(input$roiX, input$roiY)])
        rv$selectedFrame <- rv$data[rv$selectedRows, input$roiFrame]
      }
    }
597 598 599 600 601 602 603 604 605 606 607 608
    updateFilters()
  })
  observeEvent(input$selectFiltered, { 
    selectRows(proxy, input$dataTable_rows_all)
    rv$imgPath1 <- NULL
    rv$ImgPath2 <- NULL
    rv$pixelPosition <- NULL
    rv$selectedFrame <- NULL
    updateFilters()
  })
  observeEvent(input$clearSelected, {
    selectRows(proxy, list())
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
609
    selectRows(proxy2, list())
610 611 612 613 614 615 616 617
    rv$imgPath1 <- NULL
    rv$ImgPath2 <- NULL
    rv$pixelPosition <- NULL
    rv$selectedFrame <- NULL
    updateFilters()
  })
  
  ## Detect switching tabs
618
  observeEvent(input$tabs,{
619 620 621
    updateFilters()
  })
  
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
622 623 624 625 626
  ## Detect switching areas
  observeEvent(input$menu,{
    updateFilters()
  })
  
627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769
  ## Read image(s) corresponding to selected data point
  img1 <- reactive({
    ## Deal with eventual Windows-style paths
    if(!is.null(input$dir)) {
      rootDir <- file.path(strsplit(parseDirPath(roots, input$dir),'\\\\'))
    }
    if(!is.null(rv$imgPath1) && !is.null(input$fileCol1) && input$fileCol1 != ""){
      rv$imgPath1 <- gsub("[[:space:]]", "", rv$imgPath1)
      filePath1 <- file.path(rootDir, strsplit(rv$imgPath1, '\\\\'))
      validate(need(filePath1 != "" && file.exists(filePath1), "File not found. Check that you selected the correct image root directory."))
      slice.def <- list()
      rv$metadataImg1 <- read.metadata(filePath1)
      if(!is.null(input$roiFrame) && input$roiFrame != "") {
        ## Figure out what the 3rd dimension is
        if(rv$metadataImg1$coreMetadata$sizeZ == 1 && rv$metadataImg1$coreMetadata$sizeT > 1) {
          slice.def = list(T = rv$selectedFrame)
        }
        else if(rv$metadataImg1$coreMetadata$sizeZ > 1 && rv$metadataImg1$coreMetadata$sizeT == 1) {
          slice.def = list(Z = rv$selectedFrame)
        }
      }
      ## Use Bio-Formats to read one image
      I <- read.image(filePath1, subset = slice.def)
      if(colorMode(I) == 0) { # Convert grayscale to color
        I <- rgbImage(I, I, I)
      }
      I
    }
  })
  img2 <- reactive({
    ## Deal with eventual Windows-style paths
    if(!is.null(input$dir)) {
      rootDir <- file.path(strsplit(parseDirPath(roots, input$dir),'\\\\'))
    }
    if(!is.null(rv$imgPath2) && !is.null(input$fileCol2) && input$fileCol2 != ""){
      rv$imgPath2 <- gsub("[[:space:]]", "", rv$imgPath2)
      filePath2 <- file.path(rootDir, strsplit(rv$imgPath2, '\\\\'))
      validate(need(filePath2 != "" && file.exists(filePath2), "File not found. Check that you selected the correct image root directory."))
      slice.def <- list()
      rv$metadataImg2 <- read.metadata(filePath2)
      if(!is.null(input$roiFrame) && input$roiFrame != "") {
        ## Figure out what the 3rd dimension is
        if(rv$metadataImg2$coreMetadata$sizeZ == 1 && rv$metadataImg2$coreMetadata$sizeT > 1) {
          slice.def = list(T = rv$selectedFrame)
        }
        else if(rv$metadataImg2$coreMetadata$sizeZ > 1 && rv$metadataImg2$coreMetadata$sizeT == 1) {
          slice.def = list(Z = rv$selectedFrame)
        }
      }        
      ## Use Bio-Formats to read one image
      I <- read.image(filePath2, subset = slice.def)
      if(colorMode(I) == 0) { # Convert grayscale to color
        I <- rgbImage(I, I, I)
      }
      I
    }
  })
  
  ## Interactive image display with EBImage for first image
  output$imageViewer1 <- renderDisplay({
    image1 <- img1()
    if(!is.null(image1)) {
      if(!is.null(rv$pixelPosition) && input$roiX!="") { # input$roiX!="" => ROI selection enabled
        r <- ceiling(rv$metadataImg1$coreMetadata$sizeX/100)
        colorMode(image1) = Color
        image1 <- drawCircle(image1, rv$pixelPosition[1], rv$pixelPosition[2], r, "red", fill=TRUE, z=1)
      }
      display(image1, method = 'browser')
    }
  })
  ## Interactive image display with EBImage for second image
  ## We assume that the two images are the same size and the same field of view.
  output$imageViewer2 <- renderDisplay({
    image2 <- img2()
    if(!is.null(image2)) {
      if(!is.null(rv$pixelPosition) && input$roiX!="") { # input$roiX!="" => ROI selection enabled
        r <- ceiling(rv$metadataImg2$coreMetadata$sizeX/100)
        colorMode(image2) = Color
        image2 <- drawCircle(image2, rv$pixelPosition[1], rv$pixelPosition[2], r, "red", fill=TRUE, z=1)
      }
      display(image2, method = 'browser')
    }
  })
  
  ## Interactions with images
  
  ## Pixel coordinates of where the cursor is
  ## This requires modification of EBImage/htmlwidgets/lib/viewer/viewer.js 
  ## with addition of Shiny.setInputValue("pixelPosition", pixelPos);
  ## to the function this.updatePixelPosition() (for hover event) or 
  ## this.grabImage() (for click event).
  ## Similarly, position in stack is available as input$currentFrame and
  ## image size as input$imgWidth and input$imgHeight.
  ## Here we get the coordinates on click.
  ## We assume that all simultaneously displayed images are the same size and the same field of view.
  
  observe({
    rv$pixelPosition <- input$pixelPosition
  })
  
  output$info <- renderPrint({
    if(input$roiX != "") {
    cat("ROI selected on",input$roiX, input$roiY, input$roiFrame,"\n")
    } else {
      cat("No ROI selection\n")
    }
    cat("X:", rv$pixelPosition[1],  " ", "Y:", rv$pixelPosition[2], " ", "Z/T:", rv$selectedFrame, "\n")
    cat("Current image 1:", rv$imgPath1, "\n")
  })
  
  ## Get table row(s) associated with clicked pixel
  ## Use nearest neighbour
  observe({
    k <- 1 # number of data points to retrieve
    clickPosition <- NULL
    roiData <- NULL
    if(!is.null(input$pixelPosition) && input$roiX != "" && input$roiY != "") {
      ## Depends only on input$pixelPosition (input$roiX and input$roiY are not expected to change here).
      ## This prevents being run upon clearing row selection.
      isolate({
        if(input$roiFrame != "") {
          clickPosition <- data.frame(t(c(input$pixelPosition, rv$selectedFrame)))
          ## Make sure we're looking only for ROIs present in the frame currently displayed
          ## This assumes that we interact with imageViewer1
          roiData <- rv$data[rv$data[,input$fileCol1] == rv$imgPath1 & rv$data[,input$roiFrame] == rv$selectedFrame, 
                             c(input$roiX, input$roiY, input$roiFrame)]
        } else {
          clickPosition <- data.frame(t(c(input$pixelPosition)))
          roiData <- rv$data[,c(input$roiX, input$roiY)]
        }
        nn <- nn2(roiData,
                  clickPosition,
                  k = k,
                  searchtype = "radius",
                  radius = 50) # search within 50 pixels of the click
        ## nn$nn.idx indexes into roiData.
        ## When subsetting, the index into the full data is stored as rowname
        ## so rownames(roiData) contains the index into the original data.
        selectRows(proxy, as.numeric(rownames(roiData[nn$nn.idx,]))[1]) # Set selected point in table
      })
    }
  })
  
770 771 772 773 774 775 776 777
  ## Show table in annotator (this is the editable one)
  output$dataTableEdit <- renderDT({
    req(rv$data)
    nonEditableColumns <- c(1:ncol(rv$data))
    nonEditableColumns <- c(0, nonEditableColumns[-rv$colsToEdit])
    datatable(rv$data[rv$currentRows,],
              class = 'row-border hover',
              selection = list(mode = 'multiple', selected = rv$selectedRows),
778
              extensions = c('Scroller'), 
779 780 781 782 783
              editable = list(target = "cell", disable = list(columns = nonEditableColumns)),
              filter = "top",
              escape = FALSE, # Don't escape HTML code in the table to allow e.g. checkboxes
              options = list(displayModeBar = TRUE,
                             scrollX = TRUE,
784 785
                             scrollY = 1000,
                             scroller = TRUE,
786 787 788 789 790
                             stateSave = TRUE,
                             columnDefs = list(list(visible = FALSE, targets = rv$colsToHide)),
                             searchCols = defaultSearchColumns,
                             search = list(regex = FALSE, caseInsensitive = FALSE, search = defaultSearch),
                             autoWidth = TRUE,
791
                             dom = '<"dwnld">frtip'
792 793
              )) %>%
      formatStyle( 0, target= 'row', lineHeight='60%')
794 795
  }, callback = DT::JS("$('div.dwnld').append($('#download1'));"), # works but generates warnings
  server = TRUE)  # Server side processing required for large data tables
796
  
Jean-Karim Heriche's avatar
Jean-Karim Heriche committed
797 798
  proxy2 <- dataTableProxy('dataTableEdit')
  
799 800 801 802
  observeEvent(input$dataTableEdit_cell_edit, {
    rv$data <<- editData(rv$data, input$dataTableEdit_cell_edit, 'dataTableEdit')
  })
  
803 804 805 806 807 808 809 810
  output$download1 <- downloadHandler(
    filename = function() {
      basename(input$datafile$name)
    },
    content = function(file) {
      write.csv(rv$data, file)
    }
  )
811
  
812 813 814 815 816 817 818 819 820 821 822
  ## Stop the app when browser tab is closed
  session$onSessionEnded(stopApp)
  
}

## Run the application
## Supply desired port to runApp() because it ignores options in shinyApp()
IDE <- shinyApp(ui = ui, 
                server = server, 
                enableBookmarking = "url")
runApp(IDE, port = 5476)