Nothing
#' widget_setups.R arguments
#'
#' @param displayed.moves The valid movements table for a specific tag.
#' @param all.moves The complete movements table for a specific tag.
#' @param detections The detections data.frame for a specific tag.
#' @param trigger The message/warning that triggered the interaction
#' @param first.time Logical: Is this the first time this widget is running for this tag?
#' @param type The type of events (Array or Section)
#' @param tag The tag being analysed.
#' @param event The event selected for expansion.
#' @param to.print The subset of detections to be displayed.
#'
#' @name widget_args
#' @keywords internal
#'
NULL
#' Event Widget (Tabbed version)
#'
#' @inheritParams widget_args
#'
#' @return The movements list, a vector of event validities, and a note on whether or not the widget should be restarted.
#'
#' @keywords internal
#'
eventsTabbedWidget <- function(tag, displayed.moves, all.moves, detections, trigger, first.time, type) { # nocov start
appendTo("debug", "Running eventsTabbedWidget.")
# initiate button variables
cp <- NULL
complain <- NULL
confirm <- NULL
restart <- FALSE
graphical_valid <- NULL
graphical_valid_indexes <- which(all.moves$Valid)
placeholder <- gWidgets2::gwindow("Please wait", width = 300, height = 20)
on.exit({if(gWidgets2::isExtant(placeholder)) gWidgets2::dispose(placeholder)}, add = TRUE)
placeholder_layout <- gWidgets2::ggroup(horizontal = FALSE, container = placeholder)
gWidgets2::glabel("The GUI window is loading...", container = placeholder_layout)
message("M: Please wait while the GUI loads."); flush.console()
moves.window <- gWidgets2::gwindow(paste0("Valid events for tag ", tag, " (", sum(!all.moves$Valid), " invalid event(s) omitted)"),
width = 900, height = 500, visible = FALSE)
on.exit({if(gWidgets2::isExtant(moves.window)) gWidgets2::dispose(moves.window)}, add = TRUE)
g <- gWidgets2::ggroup(horizontal = FALSE, container = moves.window)
hdr <- gWidgets2::glayout(container = g)
hdr[1, 1] <- gWidgets2::glabel("Warning message:", container = hdr)
hdr[1, 2, expand = TRUE] <- ""
hdr[2, 1:2, expand = TRUE] <- gWidgets2::gtext(trigger, handler = NULL, container = hdr)
hdr[3, 1:2, expand = TRUE] <- gWidgets2::glabel("Usage notes:\n - Edit event validity by selecting rows and choosing the desired action below.\n - Loading large tables can take some time. Please wait until the interaction buttons show up at the bottom of this window.", container = hdr)
hdr[2, 1, expand = TRUE] <- gWidgets2::glabel("This table is very long!\n - Please allow some time for the action buttons to complete their tasks (particularly those that span multiple pages).\n - <b>Please wait</b> until the buttons appear at the bottom of the page before performing any action!", container = hdr)
tbl <- list()
nb <- gWidgets2::gnotebook(tab.pos = 3, expand = TRUE, container = g)
# add handler that keeps track of current tab
gWidgets2::addHandlerChanged(nb, handler = function(h, ...) {
cp <<- h$page.no
})
tabbed.moves <- splitN(displayed.moves, 1000)
for (i in 1:length(tabbed.moves)) {
tbl[[i]] <- gWidgets2::gtable(tabbed.moves[[i]], multiple = TRUE, expand = TRUE, container = nb, label = names(tabbed.moves)[i])
}
btns <- gWidgets2::glayout(container = g)
invalid_selected_function <- function(h, ...) {
tbl[[cp]][match(tbl[[cp]]$get_value(), tbl[[cp]][, "Event"]), "Valid"] <- rep(FALSE, length(tbl[[cp]]$get_value()))
}
btns[1, 1] <- gWidgets2::gbutton(text = "Invalidate selected", handler = invalid_selected_function, action = NULL, container = btns)
reset_selected_function <- function(h, ...) {
tbl[[cp]][match(tbl[[cp]]$get_value(), tbl[[cp]][, "Event"]), "Valid"] <- rep(TRUE, length(tbl[[cp]]$get_value()))
}
btns[2, 1] <- gWidgets2::gbutton(text = "Revalidate selected", handler = reset_selected_function, action = NULL, container = btns)
invalid_page_function <- function(h, ...) {
tbl[[cp]][, "Valid"] <- rep(FALSE, nrow(tbl[[cp]]))
}
btns[1, 2] <- gWidgets2::gbutton(text = "Invalidate page", handler = invalid_page_function, action = NULL, container = btns)
reset_page_function <- function(h, ...) {
tbl2[[cp]][, "Valid"] <- rep(TRUE, nrow(tbl[[cp]]))
}
btns[2, 2] <- gWidgets2::gbutton(text = "Revalidate page", handler = reset_page_function, action = NULL, container = btns)
invalid_all_function <- function(h, ...) {
processing <- gWidgets2::gwindow("Processing...", width = 300, height = 30)
for (i in 1:length(tbl)) {
capture <- gWidgets2::glabel(paste("Processing page", i, "of", length(tbl)), container = processing)
tbl[[i]][, "Valid"] <- rep(FALSE, nrow(tbl[[i]]))
}
gWidgets2::dispose(processing)
}
btns[1, 3] <- gWidgets2::gbutton(text = "Invalidate all", handler = invalid_all_function, action = NULL, container = btns)
reset_all_function <- function(h, ...) {
processing <- gWidgets2::gwindow("Processing...", width = 300, height = 30)
for (i in 1:length(tbl)) {
capture <- gWidgets2::glabel(paste("Processing page", i, "of", length(tbl)), container = processing)
tbl[[i]][, "Valid"] <- rep(TRUE, nrow(tbl[[i]]))
}
gWidgets2::dispose(processing)
}
btns[2, 3] <- gWidgets2::gbutton(text = "Revalidate all", handler = reset_all_function, action = NULL, container = btns)
invert_page_function <- function(h, ...) {
tbl[[cp]][, "Valid"] <- !tbl[[cp]][, "Valid"]
}
btns[1, 4] <- gWidgets2::gbutton(text = "Invert page validities", handler = invert_page_function, action = NULL, container = btns)
invert_all_function <- function(h, ...) {
processing <- gWidgets2::gwindow("Processing...", width = 300, height = 30)
for (i in 1:length(tbl)) {
capture <- gWidgets2::glabel(paste("Processing page", i, "of", length(tbl)), container = processing)
tbl[[i]][, "Valid"] <- !tbl[[i]][, "Valid"]
}
gWidgets2::dispose(processing)
}
btns[2, 4] <- gWidgets2::gbutton(text = "Invert all validities", handler = invert_all_function, action = NULL, container = btns)
btns[1, 5, expand = TRUE] <- ""
btns[2, 5, expand = TRUE] <- ""
if (type == "Array") {
expand_event_function <- function(h, ...) {
event <- match(tbl[[cp]]$get_value(), displayed.moves$Event)
if (length(event) < 1) {
if (exists("complain") && gWidgets2::isExtant(complain))
gWidgets2::dispose(complain)
complain <<- gWidgets2::gwindow("Warning", width = 300, height = 20)
complain_layout <- gWidgets2::ggroup(horizontal = FALSE, container = complain)
gWidgets2::glabel("No event was selected to expand.", container = complain_layout)
complain_function <- function(h, ...) {
gWidgets2::dispose(complain)
}
complain_btn <- gWidgets2::gbutton(text = "Close", handler = complain_function, action = NULL,
expand = TRUE, container = complain_layout)
}
if (length(event) > 1) {
if (exists("complain") && gWidgets2::isExtant(complain))
gWidgets2::dispose(complain)
complain <<- gWidgets2::gwindow("Warning", width = 300, height = 20)
complain_layout <- gWidgets2::ggroup(horizontal = FALSE, container = complain)
gWidgets2::glabel("Select only one event to expand.", container = complain_layout)
complain_function <- function(h, ...) {
gWidgets2::dispose(complain)
}
complain_btn <- gWidgets2::gbutton(text = "Close", handler = complain_function, action = NULL,
expand = TRUE, container = complain_layout)
}
if (length(event) == 1) {
link <- detections$Timestamp >= displayed.moves$First.time[event] &
detections$Timestamp <= displayed.moves$Last.time[event]
from <- match(displayed.moves$First.time[event], as.character(detections$Timestamp))
to <- match(displayed.moves$Last.time[event], as.character(detections$Timestamp))
sub.det <- detections[from:to, ]
gWidgets2::visible(moves.window) <- FALSE
all.moves <<- graphicalInvalidateDetections(detections = sub.det,
displayed.moves = displayed.moves,
all.moves = all.moves,
event = event,
tag = tag,
silent = TRUE)
graphical_valid <<- all.moves$Valid
restart <<- TRUE
gWidgets2::dispose(moves.window)
}
}
btns[1, 6] <- gWidgets2::gbutton(text = "Expand event", handler = expand_event_function, action = NULL, container = btns)
} else {
btns[1, 6] <- ""
}
close_function <- function(h, ...) {
aux <- lapply(tbl, function(x) as.data.frame(x[, c("Event", "Valid")]))
x <- data.table::rbindlist(aux)
graphical_valid <<- rep(FALSE, nrow(all.moves))
graphical_valid[graphical_valid_indexes] <<- x$Valid[order(x$Event)]
aux <- rle(graphical_valid)
aux <- data.frame(Value = aux[[2]], n = aux[[1]])
aux$stop <- cumsum(aux$n)
aux$start <- c(1, aux$stop[-1] - (aux$n[-1] - 1))
aux$combine <- aux$start != aux$stop
aux$final <- aux$start
aux$final[aux$combine] <- paste(aux$start[aux$combine], aux$stop[aux$combine], sep = ":")
valid.summary <- aux[, c("final", "Value")]
colnames(valid.summary) <- c("Detections", "Validity")
if (exists("confirm") && gWidgets2::isExtant(confirm))
gWidgets2::dispose(confirm)
confirm <<- gWidgets2::gwindow("Confirm", width = 300, height = 300)
confirm_layout <- gWidgets2::ggroup(horizontal = FALSE, container = confirm)
gWidgets2::glabel("Confirm the following validity ranges.", container = confirm_layout)
gWidgets2::gtable(valid.summary, multiple = TRUE, expand = TRUE, container = confirm_layout)
confirm_btns <- gWidgets2::glayout(container = confirm_layout)
confirm_function <- function(h, ...) {
gWidgets2::dispose(confirm)
gWidgets2::dispose(moves.window)
}
confirm_btns[1, 1, expand = TRUE] <- gWidgets2::gbutton(text = "Confirm", handler = confirm_function, action = NULL, container = confirm_btns)
abort_function <- function(h, ...) {
gWidgets2::dispose(confirm)
}
confirm_btns[1, 2, expand = TRUE] <- gWidgets2::gbutton(text = "Return", handler = abort_function, action = NULL, container = confirm_btns)
}
btns[2, 6] <- gWidgets2::gbutton(text = "Submit and close", handler = close_function, action = NULL, container = btns)
gWidgets2::dispose(placeholder)
gWidgets2::visible(moves.window) <- TRUE
if (first.time)
message("M: Make any necessary edits in the external visualization window and submit the result to continue the analysis.\nNote: You can use Ctrl and Shift to select multiple events, and Ctrl+A to select all events at once."); flush.console()
while (gWidgets2::isExtant(moves.window)) {}
if (is.null(graphical_valid)) {
appendTo(c("Screen", "Warning", "Report"), "External visualization window was closed before result submission. Assuming no changes are to be made.")
graphical_valid <- all.moves$Valid
}
return(list(all.moves = all.moves, graphical_valid = graphical_valid, restart = restart))
} # nocov end
#' Event Widget (Single table version)
#'
#' @inheritParams widget_args
#'
#' @return The movements list, a vector of event validities, and a note on whether or not the widget should be restarted.
#'
#' @keywords internal
#'
eventsSingleWidget <- function(tag, displayed.moves, all.moves, detections, trigger, first.time, type) { # nocov start
appendTo("debug", "Running eventsSingleWidget.")
# initiate button variables
complain <- NULL
confirm <- NULL
restart <- FALSE
graphical_valid <- NULL
graphical_valid_indexes <- which(all.moves$Valid)
placeholder <- gWidgets2::gwindow("Please wait", width = 300, height = 20)
on.exit({if(gWidgets2::isExtant(placeholder)) gWidgets2::dispose(placeholder)}, add = TRUE)
placeholder_layout <- gWidgets2::ggroup(horizontal = FALSE, container = placeholder)
gWidgets2::glabel("The GUI window is loading...", container = placeholder_layout)
message("M: Please wait while the GUI loads."); flush.console()
moves.window <- gWidgets2::gwindow(paste0("Valid events for tag ", tag, " (", sum(!all.moves$Valid), " invalid event(s) omitted)"),
width = 900, height = 500, visible = TRUE)
on.exit({if(gWidgets2::isExtant(moves.window)) gWidgets2::dispose(moves.window)}, add = TRUE)
g <- gWidgets2::ggroup(horizontal = FALSE, container = moves.window)
hdr <- gWidgets2::glayout(container = g)
hdr[1, 1] <- gWidgets2::glabel("Warning message:", container = hdr)
hdr[1, 2, expand = TRUE] <- ""
hdr[2, 1:2, expand = TRUE] <- gWidgets2::glabel(trigger, handler = NULL, container = hdr)
hdr[3, 1:2, expand = TRUE] <- gWidgets2::glabel("Usage notes:\n - Edit event validity by selecting rows and choosing the desired action below.\n - Loading large tables can take some time. Please wait until the interaction buttons show up at the bottom of this window.", container = hdr)
tbl <- gWidgets2::gtable(displayed.moves, multiple = TRUE, expand = TRUE, container = g)
btns <- gWidgets2::glayout(container = g)
invalid_selected_function <- function(h, ...) {
tbl[match(tbl$get_value(), tbl[, "Event"]), "Valid"] <- rep(FALSE, length(tbl$get_value()))
}
btns[1, 1] <- gWidgets2::gbutton(text = "Invalidate selected", handler = invalid_selected_function, action = NULL, container = btns)
reset_selected_function <- function(h, ...) {
tbl[match(tbl$get_value(), tbl[, "Event"]), "Valid"] <- rep(TRUE, length(tbl$get_value()))
}
btns[2, 1] <- gWidgets2::gbutton(text = "Revalidate selected", handler = reset_selected_function, action = NULL, container = btns)
invalid_all_function <- function(h, ...) {
tbl[, "Valid"] <- rep(FALSE, nrow(tbl))
}
btns[1, 2] <- gWidgets2::gbutton(text = "Invalidate all", handler = invalid_all_function, action = NULL, container = btns)
reset_all_function <- function(h, ...) {
tbl[, "Valid"] <- rep(TRUE, nrow(tbl))
}
btns[2, 2] <- gWidgets2::gbutton(text = "Revalidate all", handler = reset_all_function, action = NULL, container = btns)
invert_all_function <- function(h, ...) {
tbl[, "Valid"] <- !tbl[, "Valid"]
}
btns[1, 3] <- gWidgets2::gbutton(text = "Invert all validities", handler = invert_all_function, action = NULL, container = btns)
btns[1, 4, expand = TRUE] <- ""
btns[2, 4, expand = TRUE] <- ""
if (type == "Array") {
expand_event_function <- function(h, ...) {
event <- match(tbl$get_value(), displayed.moves$Event)
if (length(event) < 1) {
if (exists("complain") && gWidgets2::isExtant(complain))
gWidgets2::dispose(complain)
complain <<- gWidgets2::gwindow("Warning", width = 300, height = 20)
complain_layout <- gWidgets2::ggroup(horizontal = FALSE, container = complain)
gWidgets2::glabel("No event was selected to expand.", container = complain_layout)
complain_function <- function(h, ...) {
gWidgets2::dispose(complain)
}
complain_btn <- gWidgets2::gbutton(text = "Close", handler = complain_function, action = NULL,
expand = TRUE, container = complain_layout)
}
if (length(event) > 1) {
if (exists("complain") && gWidgets2::isExtant(complain))
gWidgets2::dispose(complain)
complain <<- gWidgets2::gwindow("Warning", width = 300, height = 20)
complain_layout <- gWidgets2::ggroup(horizontal = FALSE, container = complain)
gWidgets2::glabel("Select only one event to expand.", container = complain_layout)
complain_function <- function(h, ...) {
gWidgets2::dispose(complain)
}
complain_btn <- gWidgets2::gbutton(text = "Close", handler = complain_function, action = NULL,
expand = TRUE, container = complain_layout)
}
if (length(event) == 1) {
link <- detections$Timestamp >= displayed.moves$First.time[displayed.moves$Valid][event] &
detections$Timestamp <= displayed.moves$Last.time[displayed.moves$Valid][event]
from <- match(displayed.moves$First.time[event], as.character(detections$Timestamp))
to <- match(displayed.moves$Last.time[event], as.character(detections$Timestamp))
sub.det <- detections[from:to, ]
gWidgets2::visible(moves.window) <- FALSE
all.moves <<- graphicalInvalidateDetections(detections = sub.det,
displayed.moves = displayed.moves,
all.moves = all.moves,
event = event,
tag = tag,
silent = TRUE)
graphical_valid <<- all.moves$Valid
restart <<- TRUE
gWidgets2::dispose(moves.window)
}
}
btns[1, 5] <- gWidgets2::gbutton(text = "Expand event", handler = expand_event_function, container = btns)
} else {
btns[1, 5] <- ""
}
close_function <- function(h, ...) {
x <- as.data.frame(tbl[, c("Event", "Valid")])
graphical_valid <<- rep(FALSE, nrow(all.moves))
graphical_valid[graphical_valid_indexes] <<- x$Valid[order(x$Event)]
aux <- rle(graphical_valid)
aux <- data.frame(Value = aux[[2]], n = aux[[1]])
aux$stop <- cumsum(aux$n)
aux$start <- c(1, aux$stop[-1] - (aux$n[-1] - 1))
aux$combine <- aux$start != aux$stop
aux$final <- aux$start
aux$final[aux$combine] <- paste(aux$start[aux$combine], aux$stop[aux$combine], sep = ":")
valid.summary <- aux[, c("final", "Value")]
colnames(valid.summary) <- c("Events", "Validity")
if (exists("confirm") && gWidgets2::isExtant(confirm))
gWidgets2::dispose(confirm)
confirm <<- gWidgets2::gwindow("Confirm", width = 300, height = 300)
confirm_layout <- gWidgets2::ggroup(horizontal = FALSE, container = confirm)
gWidgets2::glabel("Confirm the following validity ranges.", container = confirm_layout)
gWidgets2::gtable(valid.summary, multiple = TRUE, expand = TRUE, container = confirm_layout)
confirm_btns <- gWidgets2::glayout(container = confirm_layout)
confirm_function <- function(h, ...) {
gWidgets2::dispose(confirm)
gWidgets2::dispose(moves.window)
}
confirm_btns[1, 1, expand = TRUE] <- gWidgets2::gbutton(text = "Confirm", handler = confirm_function, action = NULL, container = confirm_btns)
abort_function <- function(h, ...) {
gWidgets2::dispose(confirm)
}
confirm_btns[1, 2, expand = TRUE] <- gWidgets2::gbutton(text = "Return", handler = abort_function, action = NULL, container = confirm_btns)
}
btns[2, 5] <- gWidgets2::gbutton(text = "Submit and close", handler = close_function, action = NULL, container = btns)
gWidgets2::dispose(placeholder)
gWidgets2::visible(moves.window) <- TRUE
if (first.time)
message("M: Make any necessary edits in the external visualization window and submit the result to continue the analysis.\nNote: You can use Ctrl and Shift to select multiple events, and Ctrl+A to select all events at once."); flush.console()
while (gWidgets2::isExtant(moves.window)) {}
if (is.null(graphical_valid)) {
appendTo(c("Screen", "Warning", "Report"), "External visualization window was closed before result submission. Assuming no changes are to be made.")
graphical_valid <- all.moves$Valid
}
return(list(all.moves = all.moves, graphical_valid = graphical_valid, restart = restart))
} # nocov end
#' Detections Widget (Tabbed version)
#'
#' @inheritParams widget_args
#'
#' @return A vector of detection validities.
#'
#' @keywords internal
#'
detectionsTabbedWidget <- function(event, tag, to.print, silent) { # nocov start
appendTo("debug", "Running detectionsTabbedWidget.")
# initiate button variables
cp <- NULL
confirm <- NULL
graphical_valid <- NULL
placeholder <- gWidgets2::gwindow("Please wait", width = 300, height = 20)
on.exit({if(gWidgets2::isExtant(placeholder)) gWidgets2::dispose(placeholder)}, add = TRUE)
placeholder_layout <- gWidgets2::ggroup(horizontal = FALSE, container = placeholder)
gWidgets2::glabel("The GUI window is loading...", container = placeholder_layout)
message("M: Please wait while the GUI loads."); flush.console()
w2 <- gWidgets2::gwindow(paste0("Detections for valid event ", event, " from tag ", tag ,"."),
width = 900, height = 500, visible = FALSE)
on.exit({if(gWidgets2::isExtant(w2)) gWidgets2::dispose(w2)}, add = TRUE)
g2 <- gWidgets2::ggroup(horizontal = FALSE, container = w2)
hdr2 <- gWidgets2::glayout(container = g2)
hdr2[1, 1, expand = TRUE] <- gWidgets2::glabel("Usage notes:\n - Edit detection validity by selecting rows and choosing the desired action below.\n - Loading large tables can take some time. Please wait until the interaction buttons show up at the bottom of this window.", container = hdr2)
hdr2[2, 1, expand = TRUE] <- gWidgets2::glabel("This table is very long!\n - Please allow some time for the action buttons to complete their tasks (particularly those that span multiple pages).\n - _Please wait_ until the buttons appear at the bottom of the page before performing any action!", container = hdr2)
tbl2 <- list()
nb <- gWidgets2::gnotebook(tab.pos = 3, expand = TRUE, container = g2)
# add handler that keeps track of current tab
gWidgets2::addHandlerChanged(nb, handler = function(h, ...) {
cp <<- h$page.no
})
for (i in 1:length(to.print)) {
tbl2[[i]] <- gWidgets2::gtable(to.print[[i]], multiple = TRUE, expand = TRUE, container = nb, label = names(to.print)[i])
}
btns2 <- gWidgets2::glayout(container = g2)
invalid_selected_function <- function(h, ...) {
tbl2[[cp]][match(tbl2[[cp]]$get_value(), tbl2[[cp]][, "Index"]), "Valid"] <- rep(FALSE, length(tbl2[[cp]]$get_value()))
}
btns2[1, 1] <- gWidgets2::gbutton(text = "Invalidate selected", handler = invalid_selected_function, action = NULL, container = btns2)
reset_selected_function <- function(h, ...) {
tbl2[[cp]][match(tbl2[[cp]]$get_value(), tbl2[[cp]][, "Index"]), "Valid"] <- rep(TRUE, length(tbl2[[cp]]$get_value()))
}
btns2[2, 1] <- gWidgets2::gbutton(text = "Revalidate selected", handler = reset_selected_function, action = NULL, container = btns2)
invalid_page_function <- function(h, ...) {
tbl2[[cp]][, "Valid"] <- rep(FALSE, nrow(tbl2[[cp]]))
}
btns2[1, 2] <- gWidgets2::gbutton(text = "Invalidate page", handler = invalid_page_function, action = NULL, container = btns2)
reset_page_function <- function(h, ...) {
tbl2[[cp]][, "Valid"] <- rep(TRUE, nrow(tbl2[[cp]]))
}
btns2[2, 2] <- gWidgets2::gbutton(text = "Revalidate page", handler = reset_page_function, action = NULL, container = btns2)
invalid_all_function <- function(h, ...) {
processing <- gWidgets2::gwindow("Processing...", width = 300, height = 30)
for (i in 1:length(tbl2)) {
capture <- gWidgets2::glabel(paste("Processing page", i, "of", length(tbl2)), container = processing)
tbl2[[i]][, "Valid"] <- rep(FALSE, nrow(tbl2[[i]]))
}
gWidgets2::dispose(processing)
}
btns2[1, 3] <- gWidgets2::gbutton(text = "Invalidate all", handler = invalid_all_function, action = NULL, container = btns2)
reset_all_function <- function(h, ...) {
processing <- gWidgets2::gwindow("Processing...", width = 300, height = 30)
for (i in 1:length(tbl2)) {
capture <- gWidgets2::glabel(paste("Processing page", i, "of", length(tbl2)), container = processing)
tbl2[[i]][, "Valid"] <- rep(TRUE, nrow(tbl2[[i]]))
}
gWidgets2::dispose(processing)
}
btns2[2, 3] <- gWidgets2::gbutton(text = "Revalidate all", handler = reset_all_function, action = NULL, container = btns2)
invert_page_function <- function(h, ...) {
tbl2[[cp]][, "Valid"] <- !tbl2[[cp]][, "Valid"]
}
btns2[1, 4] <- gWidgets2::gbutton(text = "Invert page validities", handler = invert_page_function, action = NULL, container = btns2)
invert_all_function <- function(h, ...) {
processing <- gWidgets2::gwindow("Processing...", width = 300, height = 30)
for (i in 1:length(tbl2)) {
capture <- gWidgets2::glabel(paste("Processing page", i, "of", length(tbl2)), container = processing)
tbl2[[i]][, "Valid"] <- !tbl2[[i]][, "Valid"]
}
gWidgets2::dispose(processing)
}
btns2[2, 4] <- gWidgets2::gbutton(text = "Invert all validities", handler = invert_all_function, action = NULL, container = btns2)
btns2[2, 5, expand = TRUE] <- ""
close_function <- function(h, ...) {
aux <- lapply(tbl2, function(x) as.data.frame(x[, c("Index", "Valid")]))
x <- data.table::rbindlist(aux)
graphical_valid <<- x$Valid[order(x$Index)]
aux <- rle(graphical_valid)
aux <- data.frame(Value = aux[[2]], n = aux[[1]])
aux$stop <- cumsum(aux$n)
aux$start <- c(1, aux$stop[-1] - (aux$n[-1] - 1))
aux$combine <- aux$start != aux$stop
aux$final <- aux$start
aux$final[aux$combine] <- paste(aux$start[aux$combine], aux$stop[aux$combine], sep = ":")
valid.summary <- aux[, c("final", "Value")]
colnames(valid.summary) <- c("Detections", "Validity")
if (exists("confirm") && gWidgets2::isExtant(confirm))
gWidgets2::dispose(confirm)
confirm <<- gWidgets2::gwindow(paste0("Confirm"), width = 300, height = 300)
confirm_layout <- gWidgets2::ggroup(horizontal = FALSE, container = confirm)
gWidgets2::glabel("Confirm the following validity ranges.", container = confirm_layout)
gWidgets2::gtable(valid.summary, multiple = TRUE, expand = TRUE, container = confirm_layout)
confirm_btns <- gWidgets2::glayout(container = confirm_layout)
confirm_function <- function(h, ...) {
gWidgets2::dispose(confirm)
gWidgets2::dispose(w2)
}
confirm_btns[1, 1, expand = TRUE] <- gWidgets2::gbutton(text = "Confirm", handler = confirm_function, action = NULL, container = confirm_btns)
abort_function <- function(h, ...) {
gWidgets2::dispose(confirm)
}
confirm_btns[1, 2, expand = TRUE] <- gWidgets2::gbutton(text = "Return", handler = abort_function, action = NULL, container = confirm_btns)
}
btns2[2, 6] <- gWidgets2::gbutton(text = "Submit and close", handler = close_function, action = NULL, container = btns2)
gWidgets2::dispose(placeholder)
gWidgets2::visible(w2) <- TRUE
if (!silent)
message("M: Make any necessary edits in the external visualization window and submit the result to continue the analysis.\nNote: You can use Ctrl and Shift to select multiple detections, and Ctrl+A to select all events at once."); flush.console()
while (gWidgets2::isExtant(w2)) {}
if (is.null(graphical_valid)) {
appendTo(c("Screen", "Warning", "Report"), "External visualization window was closed before result submission. Assuming no changes are to be made.")
graphical_valid <- to.print$Valid
}
return(graphical_valid)
} # nocov end
#' Detections Widget (Single table version)
#'
#' @inheritParams widget_args
#'
#' @return A vector of detection validities.
#'
#' @keywords internal
#'
detectionsSingleWidget <- function(event, tag, to.print, silent) { # nocov start
appendTo("debug", "Running detectionsSingleWidget.")
# initiate button variables
confirm <- NULL
graphical_valid <- NULL
placeholder <- gWidgets2::gwindow("Please wait", width = 300, height = 20)
on.exit({if(gWidgets2::isExtant(placeholder)) gWidgets2::dispose(placeholder)}, add = TRUE)
placeholder_layout <- gWidgets2::ggroup(horizontal = FALSE, container = placeholder)
gWidgets2::glabel("The GUI window is loading...", container = placeholder_layout)
message("M: Please wait while the GUI loads."); flush.console()
w2 <- gWidgets2::gwindow(paste0("Detections for valid event ", event, " from tag ", tag ,"."),
width = 900, height = 500, visible = FALSE)
on.exit({if(gWidgets2::isExtant(w2)) gWidgets2::dispose(w2)}, add = TRUE)
g2 <- gWidgets2::ggroup(horizontal = FALSE, container = w2)
hdr2 <- gWidgets2::glayout(container = g2)
hdr2[1, 1, expand = TRUE] <- gWidgets2::glabel("Usage notes:\n - Edit detection validity by selecting rows and choosing the desired action below.\n - Loading large tables can take some time. Please wait until the interaction buttons show up at the bottom of this window.", container = hdr2)
tbl2 <- gWidgets2::gtable(to.print, multiple = TRUE, expand = TRUE, container = g2)
btns2 <- gWidgets2::glayout(container = g2)
invalid_selected_function <- function(h, ...) {
tbl2[match(tbl2$get_value(), tbl2[, "Index"]), "Valid"] <- rep(FALSE, length(tbl2$get_value()))
}
btns2[1, 1] <- gWidgets2::gbutton(text = "Invalidate selected", handler = invalid_selected_function, action = NULL, container = btns2)
reset_selected_function <- function(h, ...) {
tbl2[match(tbl2$get_value(), tbl2[, "Index"]), "Valid"] <- rep(TRUE, length(tbl2$get_value()))
}
btns2[2, 1] <- gWidgets2::gbutton(text = "Revalidate selected", handler = reset_selected_function, action = NULL, container = btns2)
invalid_all_function <- function(h, ...) {
tbl2[, "Valid"] <- rep(FALSE, nrow(tbl2))
}
btns2[1, 2] <- gWidgets2::gbutton(text = "Invalidate all", handler = invalid_all_function, action = NULL, container = btns2)
reset_all_function <- function(h, ...) {
tbl2[, "Valid"] <- rep(TRUE, nrow(tbl2))
}
btns2[2, 2] <- gWidgets2::gbutton(text = "Revalidate all", handler = reset_all_function, action = NULL, container = btns2)
invert_all_function <- function(h, ...) {
tbl2[, "Valid"] <- !tbl2[, "Valid"]
}
btns2[1, 3] <- gWidgets2::gbutton(text = "Invert all validities", handler = invert_all_function, action = NULL, container = btns2)
btns2[2, 4, expand = TRUE] <- ""
close_function <- function(h, ...) {
x <- as.data.frame(tbl2[, c("Index", "Valid")])
graphical_valid <<- x$Valid[order(x$Index)]
aux <- rle(graphical_valid)
aux <- data.frame(Value = aux[[2]], n = aux[[1]])
aux$stop <- cumsum(aux$n)
aux$start <- c(1, aux$stop[-1] - (aux$n[-1] - 1))
aux$combine <- aux$start != aux$stop
aux$final <- aux$start
aux$final[aux$combine] <- paste(aux$start[aux$combine], aux$stop[aux$combine], sep = ":")
valid.summary <- aux[, c("final", "Value")]
colnames(valid.summary) <- c("Detections", "Validity")
if (exists("confirm") && gWidgets2::isExtant(confirm))
gWidgets2::dispose(confirm)
confirm <<- gWidgets2::gwindow(paste0("Confirm"), width = 300, height = 300)
confirm_layout <- gWidgets2::ggroup(horizontal = FALSE, container = confirm)
gWidgets2::glabel("Confirm the following validity ranges.", container = confirm_layout)
gWidgets2::gtable(valid.summary, multiple = TRUE, expand = TRUE, container = confirm_layout)
confirm_btns <- gWidgets2::glayout(container = confirm_layout)
confirm_function <- function(h, ...) {
gWidgets2::dispose(confirm)
gWidgets2::dispose(w2)
}
confirm_btns[1, 1, expand = TRUE] <- gWidgets2::gbutton(text = "Confirm", handler = confirm_function, action = NULL, container = confirm_btns)
abort_function <- function(h, ...) {
gWidgets2::dispose(confirm)
}
confirm_btns[1, 2, expand = TRUE] <- gWidgets2::gbutton(text = "Return", handler = abort_function, action = NULL, container = confirm_btns)
}
btns2[2, 5] <- gWidgets2::gbutton(text = "Submit and close", handler = close_function, action = NULL, container = btns2)
gWidgets2::dispose(placeholder)
gWidgets2::visible(w2) <- TRUE
if (!silent)
message("M: Make any necessary edits in the external visualization window and submit the result to continue the analysis.\nNote: You can use Ctrl and Shift to select multiple detections, and Ctrl+A to select all events at once."); flush.console()
while (gWidgets2::isExtant(w2)) {}
if (is.null(graphical_valid)) {
appendTo(c("Screen", "Warning", "Report"), "External visualization window was closed before result submission. Assuming no changes are to be made.")
graphical_valid <- to.print$Valid
}
return(graphical_valid)
} # nocov end
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.