Skip to content

GitLab

Commit fa2a8fd8 authored by Jean-Karim Heriche's avatar Jean-Karim Heriche
Browse files
Options

Allow selection of multiple wells. More code clean up.

parent 27359d47
Hide whitespace changes
Inline Side-by-side
Showing with 66 additions and 88 deletions
R/explore.R
View file @ fa2a8fd8
......@@ -51,7 +51,7 @@ ui_explore <- function(id) {
),
box( width = 6,
tags$style(css),
h4(HTML("&nbsp; Selected ROIs")),
h4(HTML("&nbsp; Selected data points")),
tableOutput(ns("info"))
)
)
......@@ -71,16 +71,16 @@ ui_explore <- function(id) {
####################### Server ###############################
explore_server <- function(input, output, session, rv, react) {
explore_server <- function(input, output, session, rv) {
ns <- session$ns # Allow to use ns()
# Plot creation
callModule(plot_server, "plot", rv)
callModule(plate_view_server, "plate_view", rv)
# Data_table creation
callModule(explore_table_server, "table", rv, react)
callModule(explore_table_server, "table", rv)
# Image viewers
callModule(explore_image_server, "image", rv)
......@@ -88,11 +88,11 @@ explore_server <- function(input, output, session, rv, react) {
# Info on hover
output$hover <- renderTable({
if(length(rv$selectedVar) > 0 && length(rv$selectedVar) <= 2) {
if(input$plot_tabs == "scatterPlot") {
hover <- event_data("plotly_hover", source = "scatterPlot")
} else if(input$plot_tabs == "plateViewer") {
req(rv$wellInfo, length(unique(rv$wellInfo[, "Plate"])) == 1) # Ensure the plate viewer exists
hover <- event_data("plotly_hover", source = "plateView")
}
df <- head(rv$data[,c(rv$selectedVar, rv$colsOnHover), drop = FALSE], n = 1)
......@@ -108,19 +108,20 @@ explore_server <- function(input, output, session, rv, react) {
output$info <- renderTable({
if(input$plot_tabs == "scatterPlot") {
if(!is.null(rv$imgPath1) && !is.null(rv$pixelPosition) && !is.null(rv$roiX) && rv$roiX != "") {
data.frame("X" = rv$pixelPosition[,1], "Y" = rv$pixelPosition[,2], "Z/T" = rv$selectedFrame, "File" = rv$imgPath1)
df <- data.frame("X" = rv$pixelPosition[,1], "Y" = rv$pixelPosition[,2], "Z/T" = rv$selectedFrame, "File" = rv$imgPath1)
} else {
data.frame("X" = NA, "Y" = NA, "Z/T" = NA, "File" = NA)
df <- data.frame("X" = NA, "Y" = NA, "Z/T" = NA, "File" = NA)
}
} else if(input$plot_tabs == "plateViewer") {
if(!is.null(rv$wellInfo)) {
data.frame("Plate" = rv$wellInfo[,1], "Well" = rv$wellInfo[,2], "Field" = rv$wellInfo[,3], "Treatment" = rv$wellInfo[,4])
df <- data.frame("Plate" = rv$wellInfo[,1], "Well" = rv$wellInfo[,2], "Field" = rv$wellInfo[,3], "Treatment" = rv$wellInfo[,4])
} else {
data.frame("Plate" = NA, "Well" = NA, "Field" = NA, "Treatment" = NA)
df <- data.frame("Plate" = NA, "Well" = NA, "Field" = NA, "Treatment" = NA)
}
} else {
""
}
df <- NULL
}
return(df)
})
}
......
R/explore_plate_view.R
View file @ fa2a8fd8
......@@ -21,60 +21,57 @@ ui_explore_plate_view<- function(id) {
plate_view_server <- function(input, output, session, rv) {
ns <- session$ns # Allow to use ns()
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(rv$proxy, keywords = list(global = defaultSearch, columns = defaultSearchColumns))
})
}
output$plate_view <- renderPlotly({
req(rv$data)
selectedPlate <- unique(rv$data[rv$selectedRows, rv$plateCol])
if(length(selectedPlate) != 1) { # No plate or more than one => don't draw
} else { # only one plate
# Extract plate data
plateData <- rv$data[rv$data[,rv$plateCol] == selectedPlate,]
# Try to figure out plate format/size
# Conventions:
# - Rows are along the shortest dimension, e.g. an 8x12 plate has 8 rows.
# - Rows are labelled with letters starting from A.
# - Columns are numbered starting from 1.
# - Well A1 represents the top left corner of the plate.
plate.sizes <- c(4, 6, 8, 12, 24, 48, 96, 384, 1536)
plate.formats <- list(
"4" = c(nb.rows = 2, nb.cols = 2),
"6" = c(nb.rows = 2, nb.cols = 3),
"8" = c(nb.rows = 2, nb.cols = 4),
"12" = c(nb.rows = 3, nb.cols = 4),
"24" = c(nb.rows = 4, nb.cols = 6),
"48" = c(nb.rows = 6, nb.cols = 8),
"96" = c(nb.rows = 8, nb.cols = 12),
"384" = c(nb.rows = 16, nb.cols = 24),
"1536" = c(nb.rows = 32, nb.cols = 48)
)
nb.wells <- length(unique(plateData[,rv$wellCol]))
plateSize <- min(plate.sizes[nb.wells/plate.sizes<=1])
validate(need(plateSize>=4 && plateSize<=1536, "Unrecognized plate size/format."))
nb.rows <- plate.formats[[as.character(plateSize)]]["nb.rows"]
row.labels <- c(LETTERS, "AA", "AB", "AC", "AD", "AE", "AF")[1:nb.rows] # Expand alphabet for 1536-well plates
nb.cols <- plate.formats[[as.character(plateSize)]]["nb.cols"]
col.labels <- 1:nb.cols
plateData <- cbind(plateData[, c("ide.id", rv$wellCol,rv$fieldCol, rv$treatCol, rv$selectedVar[1]), drop = FALSE], rows = NA, cols = NA)
# Match well index to row/col coordinates
for(i in 1:nrow(plateData)) {
idx <- plateData[i, rv$wellCol]
plateData[i, "rows"] <- row.labels[((idx-1) %/% nb.cols)+1]
plateData[i, "cols"] <- ((idx-1) %% nb.cols)+1
}
plateData$rows <- factor(plateData$rows)
plateData$rows <- factor(plateData$rows, rev(levels(plateData$rows)))
plateData$cols <- factor(plateData$cols)
selectedPlates <- unique(rv$data[rv$selectedRows, rv$plateCol])
req(length(selectedPlates)>0)
# Extract selected plate data
plateData <- rv$data[rv$data[,rv$plateCol] %in% selectedPlates,]
# Try to figure out plate format/size
# Conventions:
# - Rows are along the shortest dimension, e.g. an 8x12 plate has 8 rows.
# - Rows are labelled with letters starting from A.
# - Columns are numbered starting from 1.
# - Well A1 represents the top left corner of the plate.
plate.sizes <- c(4, 6, 8, 12, 24, 48, 96, 384, 1536)
plate.formats <- list(
"4" = c(nb.rows = 2, nb.cols = 2),
"6" = c(nb.rows = 2, nb.cols = 3),
"8" = c(nb.rows = 2, nb.cols = 4),
"12" = c(nb.rows = 3, nb.cols = 4),
"24" = c(nb.rows = 4, nb.cols = 6),
"48" = c(nb.rows = 6, nb.cols = 8),
"96" = c(nb.rows = 8, nb.cols = 12),
"384" = c(nb.rows = 16, nb.cols = 24),
"1536" = c(nb.rows = 32, nb.cols = 48)
)
# Use the first selected plate since this is the one we'll eventuually draw
nb.wells <- length(unique(plateData[plateData[, rv$plateCol] == selectedPlates[1],rv$wellCol]))
plateSize <- min(plate.sizes[nb.wells/plate.sizes<=1])
validate(need(plateSize>=4 && plateSize<=1536, "Unrecognized plate size/format."))
nb.rows <- plate.formats[[as.character(plateSize)]]["nb.rows"]
row.labels <- c(LETTERS, "AA", "AB", "AC", "AD", "AE", "AF")[1:nb.rows] # Expand alphabet for 1536-well plates
nb.cols <- plate.formats[[as.character(plateSize)]]["nb.cols"]
col.labels <- 1:nb.cols
plateData <- cbind(plateData[, c("ide.id", rv$plateCol, rv$wellCol,rv$fieldCol, rv$treatCol, rv$selectedVar[1]), drop = FALSE], rows = NA, cols = NA)
# Match well index to row/col coordinates
for(i in 1:nrow(plateData)) {
idx <- plateData[i, rv$wellCol]
plateData[i, "rows"] <- row.labels[((idx-1) %/% nb.cols)+1]
plateData[i, "cols"] <- ((idx-1) %% nb.cols)+1
}
plateData$rows <- factor(plateData$rows)
plateData$rows <- factor(plateData$rows, rev(levels(plateData$rows)))
plateData$cols <- factor(plateData$cols)
wellData <- plateData[plateData$ide.id %in% rv$selectedRows,]
rv$wellInfo <- data.frame("Plate" = wellData[, rv$plateCol],
"Well" = paste0(wellData$rows,wellData$cols),
"Field" = NA,
"Treatment" = NA)
if(!is.null(rv$fieldCol) && !is.null(wellData[,rv$fieldCol])) {rv$wellInfo[,"Field"] <- wellData[,rv$fieldCol]}
if(!is.null(rv$treatCol) && !is.null(wellData[,rv$treatCol])) {rv$wellInfo[,"Treatment"] <- wellData[,rv$treatCol]}
if(length(selectedPlates) == 1) { # Don't draw if no plate or more than one
# Draw plate
# Make sure that well size is small enough to fit plate in the available space
well.size <- 1536/(2*plateSize)
......@@ -82,18 +79,11 @@ plate_view_server <- function(input, output, session, rv) {
geom_point(aes_string(colour = rv$selectedVar[1]), size = well.size) +
theme(legend.title = element_blank()) +
labs(x = NULL, y = NULL, title = NULL)
# Highlight selected well
wellData <- plateData[plateData$ide.id == rv$selectedRows[1],]
rv$wellInfo <- data.frame("Plate" = selectedPlate,
"Well" = paste0(wellData$rows,wellData$cols),
"Field" = NA,
"Treatment" = NA)
if(!is.null(rv$fieldCol) && !is.null(wellData[,rv$fieldCol])) {rv$wellInfo[,"Field"] <- wellData[,rv$fieldCol]}
if(!is.null(rv$treatCol) && !is.null(wellData[,rv$treatCol])) {rv$wellInfo[,"Treatment"] <- wellData[,rv$treatCol]}
# Highlight selected well(s)
plateView <- plateView + geom_point(data = wellData,
shape = 21, stroke = well.size/8, size = well.size,
colour = "red")
ggplotly(plateView, tooltip = "none", source = "plateView") %>% event_register("plotly_hover") %>%
config(p = ., staticPlot = FALSE, doubleClick = "reset+autosize", autosizable = TRUE, displayModeBar = TRUE,
sendData = FALSE, displaylogo = FALSE,
......@@ -108,6 +98,7 @@ plate_view_server <- function(input, output, session, rv) {
## This selects the corresponding row in the data table
observe({
req(rv$data)
req(rv$wellInfo, length(unique(rv$wellInfo[, "Plate"])) == 1) # Ensure the plate viewer exists
click <- event_data("plotly_click", priority = "event", source = "plateView")
if(!is.null(click)) {
selectRows(rv$proxy, as.numeric(unlist(click$key))) # Set selected point in table
......@@ -117,11 +108,6 @@ plate_view_server <- function(input, output, session, rv) {
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('plotly_click-plateView', null);")
}
updateFilters() # Don't lose search terms in the data table
rv$currentRows
}) # End Observe
}
R/explore_plot.R
View file @ fa2a8fd8
......@@ -24,16 +24,6 @@ plot_server <- function(input, output, session, rv) {
ns <- session$ns # Allow to use ns()
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(rv$proxy, keywords = list(global = defaultSearch, columns = defaultSearchColumns))
})
}
output$plot <- renderPlotly({
req(rv$data)
D <- rv$data[rv$currentRows,]
......
R/explore_table.R
View file @ fa2a8fd8
......@@ -31,7 +31,7 @@ ui_explore_table <- function(id) {
######################## Server ####################
explore_table_server <- function(input, output, session, rv, react) {
explore_table_server <- function(input, output, session, rv) {
ns <- session$ns # Allow to use ns()
updateFilters <- function() {
......@@ -97,6 +97,7 @@ explore_table_server <- function(input, output, session, rv, react) {
rv$selectedFrame <- rv$data[rv$selectedRows, rv$roiFrame]
}
}
print("Table clicked")
updateFilters()
})
......
image_data_explorer.R
View file @ fa2a8fd8
......@@ -132,7 +132,7 @@ server <- function(input,output,session){
# explore
observeEvent(input$tabs_menu,{
if(input$tabs_menu=="explore"){
explore_data <- callModule(explore_server, "explore_module", global_data, react)
explore_data <- callModule(explore_server, "explore_module", global_data)
}
}, ignoreNULL = TRUE, ignoreInit = TRUE)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment