Commit 17cc9acd authored by Jean-Karim Heriche's avatar Jean-Karim Heriche
Browse files

Fixed bug in which adding a new label to an existing annotation column would...

Fixed bug in which adding a new label to an existing annotation column would automatically assign it to current selection.
parent 5abd1aab
......@@ -86,14 +86,14 @@ annotate_server <- function(input, output,session, rv, session_parent) {
rv$annotationCol <- input$newCol
} else if(!is.null(input$annotationCol) && input$annotationCol != "") {
labels <- unique(rv$data[,input$annotationCol])
rv$annotationLabels <- labels[!is.na(labels)]
rv$annotationLabels <- unique(c(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)
rv$annotationLabels <- unique(c(rv$annotationLabels, new.labels))
}
}
if(is.null(rv$annotationLabels) || length(rv$annotationLabels) == 0) {
......
......@@ -73,16 +73,6 @@ explore_image_server <-function(input, output, session, rv){
}
})
observe({
if(!is.null(input$pixelPosition)) {
rv$pixelPosition <- matrix(input$pixelPosition, ncol = 2, byrow = TRUE)
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('explore_module-image-pixelPosition', null);")
} else {
rv$pixelPosition <- NULL
}
})
## Get table row(s) associated with clicked pixel(s)
## Use nearest neighbour
observe({
......@@ -93,6 +83,7 @@ explore_image_server <-function(input, output, session, rv){
## 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({
rv$pixelPosition <- matrix(input$pixelPosition, ncol = 2, byrow = TRUE)
if(!is.null(rv$selectedFrame)) {
for(i in 1:nrow(rv$pixelPosition)) {
if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
......@@ -119,6 +110,8 @@ explore_image_server <-function(input, output, session, rv){
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
rv$selectedRows <- nn.rows.idx
runjs("Shiny.setInputValue('explore_module-image-pixelPosition', null);")
}
}) # End isolate
} # End if
......
......@@ -103,6 +103,7 @@ plot_server <- function(input, output, session, rv) {
brush <- event_data("plotly_selected", priority = "event", source = "A")
if(!is.null(brush)) {
selectRows(rv$proxy, as.numeric(unique(unlist(brush$key))))
rv$selectedRows <- as.numeric(unique(unlist(brush$key)))
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('plotly_selected-A', null);")
}
......
......@@ -118,19 +118,23 @@ explore_table_server <- function(input, output, session, rv, react) {
#####################################
## Section to deal with annotation ##
#####################################
# Use a flag to monitor opening/closing of modal window
modalWindowOpened <- reactiveVal(0)
actionFunctionselect <- function(){
shinyjs::disable("annotateSelected")
if(is.null(rv$annotationCol)) {
showNotification("Annotation column not defined. Use the Annotate tab first.", type = "error")
} else {
} else if(modalWindowOpened()==0){
modalWindowOpened(1)
# Show modal window with annotation options
showModal(modalDialog(
title = "Assign label to selected points",
selectizeInput(inputId = ns("selectedLabel"),
label = "Select label",
multiple = FALSE,
selected = ,
selected = NULL,
choices = c("", rv$annotationLabels),
options = list(maxItems = 1)),
easyClose = FALSE, # Only dismissed by clicking on a button
......@@ -147,14 +151,17 @@ explore_table_server <- function(input, output, session, rv, react) {
onclick("annotateSelected", actionFunctionselect())
observeEvent(input$annotationDone, {
## Add chosen label to selected rows
if(!is.null(rv$annotationCol)) {
rv$data[rv$selectedRows, rv$annotationCol] <- rep(input$selectedLabel, length(rv$selectedRows))
} else {
showNotification("Annotation column not defined.", type = "error")
}
reset("annotationDone")
removeModal()
removeModal() # causes input$annotationDone to be reset when showModal() is called again
isolate({
if(modalWindowOpened() == 1) { # modal window has been opened
if(!is.null(rv$annotationCol)) { # Add chosen label to selected rows
rv$data[rv$selectedRows, rv$annotationCol] <- rep(input$selectedLabel, length(rv$selectedRows))
} else {
showNotification("Annotation column not defined.", type = "error")
}
}
})
modalWindowOpened(0)
})
actionFunction <- function(){
......
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