From 20f35a8ce07479fe5f52d3428ee5710fa339a836 Mon Sep 17 00:00:00 2001 From: Ben Raymond Date: Thu, 11 Aug 2022 17:53:55 +1000 Subject: [PATCH] silent icon warnings --- NAMESPACE | 1 - R/dvw_utils.R | 2 +- R/internal_utils.R | 5 ++ R/ovscout2-package.R | 2 +- R/video_scouter_playslist_module.R | 119 ----------------------------- 5 files changed, 7 insertions(+), 122 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6409583..a659731 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -93,7 +93,6 @@ importFrom(shiny,downloadHandler) importFrom(shiny,fixedRow) importFrom(shiny,fluidPage) importFrom(shiny,fluidRow) -importFrom(shiny,icon) importFrom(shiny,isTruthy) importFrom(shiny,isolate) importFrom(shiny,modalDialog) diff --git a/R/dvw_utils.R b/R/dvw_utils.R index 1dbbb54..a529b43 100644 --- a/R/dvw_utils.R +++ b/R/dvw_utils.R @@ -9,7 +9,7 @@ preprocess_dvw <- function(x) { msgs <- dplyr::summarize(group_by_at(msgs, "file_line_number"), error_message = paste0(.data$message, collapse = "
")) if ("error_message" %in% names(x$plays)) x$plays <- dplyr::select(x$plays, -"error_message") x$plays <- left_join(x$plays, msgs, by = "file_line_number") - x$plays$error_icon <- ifelse(is.na(x$plays$error_message), "", HTML(as.character(shiny::icon("exclamation-triangle")))) + x$plays$error_icon <- ifelse(is.na(x$plays$error_message), "", HTML(as.character(icon("exclamation-triangle")))) x } diff --git a/R/internal_utils.R b/R/internal_utils.R index 7abb5ec..12d4a21 100644 --- a/R/internal_utils.R +++ b/R/internal_utils.R @@ -155,3 +155,8 @@ dv_add_freeball_over <- function(x) { lag(.data$point_id) %eq% .data$point_id, ##lead(.data$point_id) %eq% .data$point_id, ((!is.na(lead(.data$team)) & lead(.data$team) != .data$team) | lag(.data$team) %eq% .data$team)) } + +## convenience wrapper around shiny::icon that inserts verify_fa = FALSE to quiet the warnings +icon <- function(...) { + shiny::icon(..., verify_fa = FALSE) +} diff --git a/R/ovscout2-package.R b/R/ovscout2-package.R index 45fd8b2..8f91826 100644 --- a/R/ovscout2-package.R +++ b/R/ovscout2-package.R @@ -10,7 +10,7 @@ #' @importFrom ggplot2 aes aes_string arrow coord_flip element_blank element_rect geom_label geom_path geom_point geom_polygon geom_segment geom_text ggplot scale_size_continuous scale_x_continuous scale_x_reverse scale_y_continuous scale_y_reverse theme unit xlim ylim #' @importFrom graphics par points segments #' @importFrom htmltools HTML tagList tags -#' @importFrom shiny actionButton callModule checkboxInput column downloadButton downloadHandler fixedRow fluidPage fluidRow icon isolate isTruthy modalDialog NS numericInput observeEvent observe onStop plotOutput reactive reactiveVal reactiveValues reactiveValuesToList removeModal renderPlot renderText renderUI req selectInput showModal sliderInput tabPanel tabsetPanel textInput uiOutput updateSelectInput updateTextInput verbatimTextOutput wellPanel withTags +#' @importFrom shiny actionButton callModule checkboxInput column downloadButton downloadHandler fixedRow fluidPage fluidRow isolate isTruthy modalDialog NS numericInput observeEvent observe onStop plotOutput reactive reactiveVal reactiveValues reactiveValuesToList removeModal renderPlot renderText renderUI req selectInput showModal sliderInput tabPanel tabsetPanel textInput uiOutput updateSelectInput updateTextInput verbatimTextOutput wellPanel withTags #' @importFrom stats aggregate na.omit setNames #' @importFrom stringr str_c str_count str_detect str_match str_pad str_remove str_split str_sub str_to_upper str_trim #' @importFrom uuid UUIDgenerate diff --git a/R/video_scouter_playslist_module.R b/R/video_scouter_playslist_module.R index 7cb26a0..51ea796 100644 --- a/R/video_scouter_playslist_module.R +++ b/R/video_scouter_playslist_module.R @@ -1,122 +1,3 @@ -mod_playslist_ui_old <- function(id) { - ns <- NS(id) - DT::dataTableOutput(ns("playslist"), width = "98%") -} -mod_playslist_old <- function(input, output, session, rdata, plays_cols_to_show, plays_cols_renames, height = "40vh") { - ns <- session$ns - - reactive_scrolling <- FALSE ## testing, not sure it helps. In principle if multiple scroll requests get lined up before the first has actually been initiated, then it'll skip to just the last - plays_do_rename <- function(z) names_first_to_capital(dplyr::rename(z, plays_cols_renames)) - ## the plays display in the RHS table - output$playslist <- DT::renderDataTable({ - isolate(mydat <- rdata$dvw$plays) ## render once, then isolate from further renders - will be done by replaceData below - ##if (!is.null(window_height) && !is.na(window_height)) { - ## plh <- window_height*0.4 - ##} else { - ## plh <- 200 - ##} - if (!is.null(mydat)) { - ## make sure all cols are present, otherwise the DT proxy won't update properly when those columns are added later - for (cl in setdiff(c("skill", "set_number", "home_team_score", "visiting_team_score", plays_cols_to_show), c("Score", "is_skill"))) { - if (!cl %in% names(mydat)) mydat[[cl]] <- rep(NA, nrow(mydat)) - } - isolate({ - sel <- list(mode = "single") - ##last_skill_row <- which(is_skill(mydat$skill)) - ##if (length(last_skill_row)) last_skill_row <- max(last_skill_row) - ##if (length(last_skill_row) > 0) { - ## sel$target <- "row" - ## sel$selected <- last_skill_row - ##} - ## select last row on startup, no matter what it is - if (nrow(mydat) > 0) { - sel$target <- "row" - sel$selected <- nrow(mydat) - } - }) - mydat$is_skill <- is_skill(mydat$skill) - mydat$set_number <- as.factor(mydat$set_number) - mydat$Score <- paste(mydat$home_team_score, mydat$visiting_team_score, sep = "-") - cols_to_hide <- which(plays_cols_to_show %in% c("is_skill")) - 1L ## 0-based because no row names - cnames <- names(plays_do_rename(mydat[1, plays_cols_to_show, drop = FALSE])) - cnames[plays_cols_to_show == "error_icon"] <- "" - out <- DT::datatable(mydat[, plays_cols_to_show, drop = FALSE], rownames = FALSE, colnames = cnames, - extensions = "Scroller", - escape = FALSE, ##filter = "top", - selection = sel, options = list(scroller = TRUE, - lengthChange = FALSE, sDom = '<"top">t<"bottom">rlp', paging = TRUE, "scrollY" = height,##paste0(plh, "px"), - ordering = FALSE, ##autoWidth = TRUE, - columnDefs = list(list(targets = cols_to_hide, visible = FALSE)), - drawCallback = DT::JS(paste0("function(settings) { Shiny.setInputValue('", ns("playslist_redrawn"), "', new Date().getTime()); }")) - ##list(targets = 0, width = "20px")) ## does nothing - )) - out <- DT::formatStyle(out, "is_skill", target = "row", backgroundColor = DT::styleEqual(c(FALSE, TRUE), c("#f0f0e0", "lightgreen"))) ## colour skill rows green - out <- DT::formatStyle(out, "error_icon", color = "red") - out - } else { - NULL - } - }, server = TRUE) - - playslist_proxy <- DT::dataTableProxy("playslist") - playslist_needs_scroll <- reactiveVal(FALSE) - playslist_scroll_target <- reactiveVal(-99L) - observeEvent(input$playslist_redrawn, { - ## when the table has finished being drawn, scroll it if necessary - if (playslist_needs_scroll()) { - playslist_needs_scroll(FALSE) - if (reactive_scrolling) playslist_scroll_target(playslist_current_row()) else scroll_playslist(playslist_current_row()) - } - ## and mark current row as selected in the table, but don't re-scroll to it - playslist_select_row(playslist_current_row(), scroll = FALSE) - }) - ## keep track of selected playslist row as a reactiveVal - ## when updating e.g. video time, set this reactiveVal, then wait for DT to redraw THEN scroll - playslist_current_row <- reactiveVal(NULL) - ## the playslist_select_row function just changes the visible selection in the table, and optionally scrolls to it, but does not change playslist_current_row() value - playslist_select_row <- function(rw, scroll = TRUE) { - DT::selectRows(playslist_proxy, rw) - if (isTRUE(scroll)) { - if (reactive_scrolling) playslist_scroll_target(rw) else scroll_playslist(rw) - } - } - ## when the user changes the selected row, update playslist_current_row - observeEvent(input$playslist_rows_selected, playslist_current_row(input$playslist_rows_selected)) - - observe({ - if (reactive_scrolling && !is.null(playslist_scroll_target()) && !is.na(playslist_scroll_target()) && playslist_scroll_target() > 0) { - scroll_playslist(playslist_scroll_target()) - } - }) - - scroll_playslist <- function(rw) { - if (!is.null(rw)) { - ## scrolling works on the VISIBLE row index, so it depends on any column filters that might have been applied - visible_rowidx <- which(input$playslist_rows_all == rw) - scrollto <- max(visible_rowidx-1-5, 0) ## -1 for zero indexing, -5 to keep the selected row 5 from the top - dojs(paste0("$('#", ns("playslist"), "').find('.dataTable').DataTable().scroller.toPosition(", scrollto, ", false);")) ## no anim, faster - } - } - - observe({ - ## replace playslist data when dvw$plays changes - if (!is.null(rdata$dvw$plays) && nrow(rdata$dvw$plays) > 0) replace_playslist_data() - }) - replace_playslist_data <- function() { - mydat <- rdata$dvw$plays - mydat$is_skill <- is_skill(mydat$skill) - mydat$set_number <- as.factor(mydat$set_number) - mydat$Score <- paste(mydat$home_team_score, mydat$visiting_team_score, sep = "-") - DT::replaceData(playslist_proxy, data = mydat[, plays_cols_to_show, drop = FALSE], rownames = FALSE, clearSelection = "none") - playslist_current_row(nrow(mydat)) - } - - list(scroll_playslist = scroll_playslist, current_row = playslist_current_row) -} - - - - mod_playslist_ui <- function(id, height = "40vh", styling) { ns <- NS(id) tagList(