Commit dbc4ebaf authored by Jean-Karim Heriche's avatar Jean-Karim Heriche

Allow selection of multiple ROIs on image and multiple points in plot. Fixed a...

Allow selection of multiple ROIs on image and multiple points in plot. Fixed a bug in annotation where previous annotations could be overwritten with latest label.
parent 29c353d4
......@@ -63,14 +63,12 @@ annotate_server <- function(input, output,session, rv, session_parent) {
Annotate_labs("labelsList", "Enter list of labels", "Type in new labels separated by commas", 5)
observeEvent(input$newCol,{
if(!is.null(input$newCol) && !is.null(input$annotationCol) && input$newCol != "" && input$annotationCol != "") {
showNotification("Only one column can be used.", type ="error")
}})
observeEvent(input$annotationCol,{
if(!is.null(input$annotationCol) && input$annotationCol != "" && !(class(rv$data[,input$annotationCol]) %in% c("character", "logical"))) {
ids <- showNotification("Annotation column must be of character type.
If you go ahead with this choice, the column type will be changed
which can cause problems (e.g. with plotting)", type ="error", duration = NULL)
......@@ -82,16 +80,18 @@ annotate_server <- function(input, output,session, rv, session_parent) {
req(rv$data)
if(!is.null(input$newCol) && input$newCol != "") {
new.column <- rep(NA,nrow(rv$data))
new.column <- rep(NA, nrow(rv$data))
rv$data <- cbind(rv$data, new.column)
colnames(rv$data)[ncol(rv$data)] <- input$newCol
rv$annotationCol <- input$newCol
} else if(!is.null(input$annotationCol) && input$annotationCol != "") {
rv$annotationLabels <- unique(rv$data[,input$annotationCol])
labels <- unique(rv$data[,input$annotationCol])
rv$annotationLabels <- labels[!is.na(labels)]
rv$annotationCol <- input$annotationCol
}
if(length(input$labelsList)>0) {
new.labels <- unlist(strsplit(input$labelsList, "\\s*,\\s*"))
new.labels <- new.labels[!is.na(new.labels)]
if(length(new.labels)>0) {
rv$annotationLabels <- c(rv$annotationLabels, new.labels)
}
......
......@@ -31,9 +31,11 @@ explore_image_server <-function(input, output, session, rv){
## Not sure if this is necessary, R may be able to recognize Windows paths
## Not fully tested
rootDir <- file.path(strsplit(rv$imgRoot,'\\\\'))
if(!is.null(rv$imgPath1) && !is.null(rv$fileCol1) && rv$fileCol1 != ""){
if(!is.null(rv$imgPath1) && length(unique(rv$imgPath1)) == 1 &&
length(unique(rv$selectedFrame)) <= 1 &&
!is.null(rv$fileCol1) && rv$fileCol1 != ""){
rv$imgPath1 <- gsub("[[:space:]]", "", rv$imgPath1)
filePath1 <- file.path(rootDir, strsplit(rv$imgPath1, '\\\\'))
filePath1 <- file.path(rootDir, strsplit(rv$imgPath1[1], '\\\\'))
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)
......@@ -62,7 +64,9 @@ explore_image_server <-function(input, output, session, rv){
if(!is.null(rv$pixelPosition) && !is.null(rv$roiX) && rv$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)
for(i in 1:nrow(rv$pixelPosition)) {
image1 <- drawCircle(image1, rv$pixelPosition[i, 1], rv$pixelPosition[i, 2], r, "red", fill=TRUE, z=1)
}
}
# if(rv$normalize.img1 == TRUE) { image1 <- normalize(image1)}
imageViewerWidget(image1)
......@@ -70,38 +74,50 @@ explore_image_server <-function(input, output, session, rv){
})
observe({
rv$pixelPosition <- input$pixelPosition
if(!is.null(input$pixelPosition)) {
rv$pixelPosition <- matrix(input$pixelPosition, ncol = 2, byrow = TRUE)
} else {
rv$pixelPosition <- NULL
}
})
## Get table row(s) associated with clicked pixel
## Get table row(s) associated with clicked pixel(s)
## Use nearest neighbour
observe({
k <- 1 # number of data points to retrieve
clickPosition <- NULL
roiData <- NULL
nn.rows.idx <- NULL
if(!is.null(input$pixelPosition) && !is.null(rv$roiX ) && !is.null(rv$roiY) && rv$roiX != "" && rv$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(!is.null(rv$roiFrame) && rv$roiFrame != "") {
clickPosition <- data.frame(t(c(rv$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[,rv$fileCol1] == rv$imgPath1 & rv$data[,rv$roiFrame] == rv$selectedFrame,
c(rv$roiX, rv$roiY, rv$roiFrame)]
} else {
clickPosition <- data.frame(t(c(rv$pixelPosition)))
roiData <- rv$data[,c(rv$roiX, rv$roiY)]
if(!is.null(rv$selectedFrame)) {
for(i in 1:nrow(rv$pixelPosition)) {
if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
## rv$selectedFrame should always have a unique value even when length>1
## because the image has already been selected if we click on it
## so it's safe to use the first value
clickPosition <- data.frame(t(c(rv$pixelPosition[i,], rv$selectedFrame[1])))
## 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[,rv$fileCol1] == rv$imgPath1 & rv$data[,rv$roiFrame] == rv$selectedFrame[1],
c(rv$roiX, rv$roiY, rv$roiFrame)]
} else {
clickPosition <- data.frame(t(c(rv$pixelPosition[i,])))
roiData <- rv$data[,c(rv$roiX, rv$roiY)]
}
nn <- nn2(roiData,
clickPosition,
k = 1,
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.
nn.rows.idx <- c(nn.rows.idx, as.numeric(rownames(roiData[nn$nn.idx,]))[1])
}
selectRows(rv$proxy, nn.rows.idx) # Set selected points in table
}
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(rv$proxy, as.numeric(rownames(roiData[nn$nn.idx,]))[1]) # Set selected point in table
}) # End isolate
} # End if
}) # End observe
......
......@@ -58,7 +58,9 @@ explore_image_server2 <-function(input, output, session, rv){
if(!is.null(rv$pixelPosition) && !is.null(rv$roiX) && rv$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)
for(i in 1:nrow(rv$pixelPosition)) {
image2 <- drawCircle(image2, rv$pixelPosition[i,1], rv$pixelPosition[i,2], r, "red", fill=TRUE, z=1)
}
}
# if(rv$normalize.img2 == TRUE) { image2 <- normalize(image2)}
imageViewerWidget(image2)
......
......@@ -8,12 +8,24 @@
ui_explore_info <- function(id) {
ns <- NS(id)
box( width = 12,
h4(HTML("&nbsp; Hovered point")),
tableOutput(ns("hover")),
h4(HTML("&nbsp; Selected ROI")),
tableOutput(ns("info"))
) # End box
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()
# Server is shared with explore_plot.R
......@@ -16,7 +16,7 @@ if (!exists("defaultSearchColumns")) defaultSearchColumns <- NULL
ui_explore_plot <- function(id) {
ns <- NS(id)
column(12,
box( width = 12,align= "left",
box( width = 12, align = "left",
title = "Plot", solidHeader = TRUE, status = "primary",
withSpinner(
plotlyOutput(ns("plot"), height = '500px'))
......@@ -72,23 +72,39 @@ plot_server <- function(input, output, session, rv) {
ggplotly(p, tooltip = "none") %>% layout(legend = list(orientation = "v", x = 1, y = 0.8)) %>%
config(p = ., staticPlot = FALSE, doubleClick = "reset+autosize", autosizable = TRUE, displayModeBar = TRUE,
sendData = FALSE, displaylogo = FALSE,
modeBarButtonsToRemove = c("sendDataToCloud", "lasso2d", "select2d", "hoverCompareCartesian")) %>% # Control Plotly's tool bar
modeBarButtonsToRemove = c("sendDataToCloud", "hoverCompareCartesian")) %>% # Control Plotly's tool bar
toWebGL()
} # End if
}) # End renderPlotly
### Interactions with the plot
## Get clicked point
## This selects it in the data table
observe({
req(rv$data)
req(rv$selectedVar)
if(rv_explore$menu == 1) { # Ensure we already have a plot
click <- event_data("plotly_click")
click <- event_data("plotly_click", priority = "event", source = "A")
if(!is.null(click)) {
selectRows(rv$proxy, as.numeric(unlist(click$key))) # Set selected point in table
if(!is.null(rv$roiX) && rv$roiX != "" && !is.null(rv$roiY) && rv$roiY != ""){
rv$pixelPosition <- unlist(rv$data[unlist(click$key), c(rv$roiX, rv$roiY)])
rv$pixelPosition <- rv$data[unlist(click$key), c(rv$roiX, rv$roiY)]
}
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('plotly_click-A', null);")
}
}
})
observe({
req(rv$data)
if(rv_explore$menu == 1) { # Ensure we already have a plot
brush <- event_data("plotly_selected", priority = "event", source = "A")
if(!is.null(brush)) {
selectRows(rv$proxy, as.numeric(unique(unlist(brush$key))))
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('plotly_selected-A', null);")
}
}
})
......@@ -103,64 +119,14 @@ plot_server <- function(input, output, session, rv) {
}
return(df)
}
}) # End renderTable
})
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)
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)
}
})
### Interactions with the plot
Interaction_Plot <- function(){
observe({
req(rv$data)
isolate({
df <- rv$data
selectedCols <- c(NULL, NULL)
if(length(rv$selectedVar) == 1) {
selectedCols[2] <- rv$selectedVar
selectedCols[1] <- "idx"
} else {
selectedCols <- rv$selectedVar
}
## Get indices of data points in selected area (Box and Lasso Select tool)
if(rv_explore$menu == 1) { # Ensure we already have a plot
brush <- event_data("plotly_selected")
if(!is.null(brush)) {
rv$currentRows <- brush$pointNumber + 1
## 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[, rv$selectedVar[1]] >= zoom[['xaxis.range[0]']] &
df[, rv$selectedVar[1]] <= zoom[['xaxis.range[1]']] &
df[, rv$selectedVar[2]] >= zoom[['yaxis.range[0]']] &
df[, rv$selectedVar[2]] <= zoom[['yaxis.range[1]']], arr.ind = TRUE)
} else {
rv$currentRows <- which(df[, rv$selectedVar[1]] >= zoom[['xaxis.range[0]']] &
df[, rv$selectedVar[1]] <= zoom[['xaxis.range[1]']] , arr.ind = TRUE)
}
} else if(!is.null(zoom[['yaxis.range[0]']])) {
rv$currentRows <- which(df[, rv$selectedVar[2]] >= zoom[['yaxis.range[0]']] &
df[, rv$selectedVar[2]] <= zoom[['yaxis.range[1]']] , arr.ind = TRUE)
}
else {
rv$currentRows <- c(1:nrow(rv$data))
} # End else
} # End if
} # End if
} # End if
updateFilters() # Don't lose search terms in the data table
rv$currentRows
})
}) # End Observe
} # End Interaction_Plot()
Interaction_Plot()
}
......@@ -74,16 +74,26 @@ explore_table_server <- function(input, output, session, rv, react) {
# Interactions with the table
observe({
rv$selectedRows <- input$dataTable_rows_selected
if(length(rv$selectedRows) != 1) {
if(is.null(rv$roiX) || rv$roiX == "") { # No ROIs,we only deal with images
if(length(rv$selectedRows)!=1) {
rv$imgPath1 <- NULL
rv$ImgPath2 <- NULL
} else {
rv$imgPath1 <- as.character(rv$data[rv$selectedRows, rv$fileCol1])[1]
rv$imgPath2 <- as.character(rv$data[rv$selectedRows, rv$fileCol2])[1]
}
} else if(length(unique(rv$data[rv$selectedRows, rv$fileCol1])) == 0 ||
length(unique(rv$data[rv$selectedRows, rv$roiFrame])) == 0) {
# No image
rv$imgPath1 <- NULL
rv$ImgPath2 <- NULL
rv$pixelPosition <- NULL
rv$selectedFrame <- NULL
} else if(length(rv$selectedRows) == 1) {
} else {
rv$imgPath1 <- as.character(rv$data[rv$selectedRows, rv$fileCol1])
rv$imgPath2 <- as.character(rv$data[rv$selectedRows, rv$fileCol2])
if(!is.null(rv$roiX) && rv$roiX != "" && !is.null(rv$roiY) && rv$roiY != ""){
rv$pixelPosition <- unlist(rv$data[rv$selectedRows, c(rv$roiX, rv$roiY)])
rv$pixelPosition <- rv$data[rv$selectedRows, c(rv$roiX, rv$roiY)]
rv$selectedFrame <- rv$data[rv$selectedRows, rv$roiFrame]
}
}
......@@ -93,16 +103,11 @@ explore_table_server <- function(input, output, session, rv, react) {
observeEvent(input$selectFiltered, {
selectRows(rv$proxy, input$dataTable_rows_all)
rv$dataTable_rows_all<-input$dataTable_rows_all
rv$imgPath1 <- NULL
rv$ImgPath2 <- NULL
rv$pixelPosition <- NULL
rv$selectedFrame <- NULL
updateFilters()
})
observeEvent(input$clearSelected, {
selectRows(rv$proxy, list())
# selectRows(proxy2, list())
rv$imgPath1 <- NULL
rv$ImgPath2 <- NULL
rv$pixelPosition <- NULL
......@@ -148,6 +153,7 @@ explore_table_server <- function(input, output, session, rv, react) {
} else {
showNotification("Annotation column not defined.", type = "error")
}
reset("annotationDone")
removeModal()
})
......
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