Commit 27359d47 authored by Jean-Karim Heriche's avatar Jean-Karim Heriche

Fixed issues displaying hover and selection info with plate viewer. Merged...

Fixed issues displaying hover and selection info with plate viewer. Merged explore_info.R into explore.R.
parent a8cf2366
......@@ -138,7 +138,7 @@ input_data_server <- function(input, output, session) {
imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL, selectedFrame = NULL, metadataImg1 = NULL,
metadataImg2 = NULL, colsToHide = NULL, colsToEdit = NULL, selectedVar = NULL, roiX = NULL,
roiY = NULL, roiFrame = NULL, fileCol1 = NULL, fileCol2 = NULL, plateCol = NULL, wellCol = NULL,
fieldCol = NULL, treatCol = NULL, platePos = NULL, proxy = NULL, key = NULL, colsOnHover = NULL,
fieldCol = NULL, treatCol = NULL, wellInfo = NULL, proxy = NULL, key = NULL, colsOnHover = NULL,
dataTable_rows_all = NULL, annotationCol = NULL, annotationLabels = NULL, imgRoot = NULL,
datapath = NULL, select_variable_DR = NULL, saveparams = NULL)
......
......@@ -13,12 +13,15 @@ source("R/explore_plate_view.R") # HTM plate viewer
source("R/explore_image.R")
source("R/explore_image2.R") # Second image viewer that can be used simultaneously with the first one
source("R/explore_table.R")
source("R/explore_info.R")
####################### UI ###############################
ui_explore <- function(id) {
ns <- NS(id)
css <- paste0("#", ns("info"), " {
display: block;
width: 100%;
height: 10em;
overflow-y: scroll;}\n")
column(12,
fluidRow(
column(12,
......@@ -41,7 +44,16 @@ ui_explore <- function(id) {
fluidRow(
column(12,
ui_explore_info(ns("explore_data"))
box( width = 6,
tags$style(paste0("#", ns("hover"), " { height: 10em;}")),
h4(HTML("&nbsp; Hovered point")),
tableOutput(ns("hover"))
),
box( width = 6,
tags$style(css),
h4(HTML("&nbsp; Selected ROIs")),
tableOutput(ns("info"))
)
)
), # End fluidRow
......@@ -74,8 +86,42 @@ explore_server <- function(input, output, session, rv, react) {
callModule(explore_image_server, "image", rv)
callModule(explore_image_server2, "image2", rv)
# Get info on hovering a data point in the plot
callModule(info_server, "explore_data", rv)
# 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") {
hover <- event_data("plotly_hover", source = "plateView")
}
df <- head(rv$data[,c(rv$selectedVar, rv$colsOnHover), drop = FALSE], n = 1)
df[,] <- NA
if(!is.null(hover)) {
df <- rv$data[unlist(hover$key), c(rv$selectedVar, rv$colsOnHover), drop = FALSE]
}
return(df)
}
})
# Info on selection
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)
} else {
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])
} else {
data.frame("Plate" = NA, "Well" = NA, "Field" = NA, "Treatment" = NA)
}
} else {
""
}
})
}
# Authors: Coralie Muller & Jean-Karim Heriche
##################################
## Module Explore : info tables ##
##################################
############# UI ###########
ui_explore_info <- function(id) {
ns <- NS(id)
css <- paste0("#", ns("info"), " {
display: block;
width: 100%;
height: 10em;
overflow-y: scroll;}\n")
column(12,
box( width = 6,
tags$style(paste0("#", ns("hover"), " { height: 10em;}")),
h4(HTML("&nbsp; Hovered point")),
tableOutput(ns("hover"))
),
box( width = 6,
tags$style(css),
h4(HTML("&nbsp; Selected ROIs")),
tableOutput(ns("info"))
)
)
} # End ui_explore_info()
info_server <- function(input, output, session, rv) {
ns <- session$ns # Allow to use ns()
# Info on hover
output$hover <- renderTable({
# TODO: Figure out which plot we're in
if(length(rv$selectedVar) > 0 && length(rv$selectedVar) <= 2) {
hover <- event_data("plotly_hover", source = "scatterPlot")
if(is.null(hover)) { # we may be on the plate viewer
hover <- event_data("plotly_hover", source = "plateView")
}
df <- head(rv$data[,c(rv$selectedVar, rv$colsOnHover), drop = FALSE], n = 1)
df[,] <- NA
if(!is.null(hover)) {
df <- rv$data[unlist(hover$key), c(rv$selectedVar, rv$colsOnHover), drop = FALSE]
}
return(df)
}
})
}
\ No newline at end of file
......@@ -7,7 +7,7 @@
############### UI ###############
ui_explore_plate_view<- function(id) {
ns <- NS(id)
tabPanel(
tabPanel( value = "plateViewer",
h4('Plate viewer'),
box( width = 12, align = "left",
title = "Plate viewer", solidHeader = TRUE, status = "primary",
......@@ -65,7 +65,7 @@ plate_view_server <- function(input, output, session, rv) {
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$selectedVar[1]), drop = FALSE], rows = NA, cols = NA)
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]
......@@ -83,7 +83,14 @@ plate_view_server <- function(input, output, session, rv) {
theme(legend.title = element_blank()) +
labs(x = NULL, y = NULL, title = NULL)
# Highlight selected well
plateView <- plateView + geom_point(data = plateData[plateData$ide.id == rv$selectedRows[1],],
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]}
plateView <- plateView + geom_point(data = wellData,
shape = 21, stroke = well.size/8, size = well.size,
colour = "red")
......@@ -116,15 +123,5 @@ plate_view_server <- function(input, output, session, rv) {
rv$currentRows
}) # End Observe
# Info on selection
output$info <- renderTable({
if(!is.null(rv$platePos) && !is.na(platePos[1])) {
data.frame("Plate" = platePos[,1], "Well" = platePos[,2], "Field" = platePos[,3], "Treatment" = platePos[,4])
} else {
data.frame("Plate" = NA, "Well" = NA, "Field" = NA, "Treatment" = NA)
}
})
}
......@@ -9,7 +9,7 @@
############### UI ###############
ui_explore_plot <- function(id) {
ns <- NS(id)
tabPanel(
tabPanel( value = "scatterPlot",
h4('Scatter plot'),
box( width = 12, align = "left",
title = "Plot", solidHeader = TRUE, status = "primary",
......@@ -103,13 +103,4 @@ plot_server <- function(input, output, session, rv) {
}
})
# Info on selection
output$info <- renderTable({
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)
} else {
data.frame("X" = NA, "Y" = NA, "Z/T" = NA, "File" = NA)
}
})
}
......@@ -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, react)
}
}, 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