From eb9fba479b26dbab64c8525da434868ae9af2d09 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Mon, 14 Aug 2023 15:12:41 -0300 Subject: [PATCH 1/7] LintR + update_all_packages feature --- R/mod_packageDependencies.R | 433 ++++++++++++++++++++---------------- 1 file changed, 247 insertions(+), 186 deletions(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index a372412ce..993dbc132 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -1,42 +1,41 @@ #' Package Dependencies module's UI. -#' +#' #' @param id a module id name #' @keywords internal -#' +#' packageDependenciesUI <- function(id) { - uiOutput(NS(id, 'package_dependencies_ui')) + uiOutput(NS(id, "package_dependencies_ui")) } #' Package Dependencies module's server logic -#' +#' #' @param id a module id name #' @param selected_pkg placeholder -#' @param user placeholder +#' @param user placeholder #' @param changes a reactive value integer count #' @param parent the parent (calling module) session information -#' +#' #' @import dplyr #' @importFrom DT formatStyle renderDataTable #' @importFrom formattable as.datatable csscolor formattable formatter style #' @importFrom glue glue #' @importFrom purrr map_df #' @importFrom rlang warn -#' @importFrom shiny removeModal showModal tagList +#' @importFrom shiny removeModal showModal tagList #' @importFrom shinyjs click #' @importFrom stringr str_extract str_replace -#' +#' #' @keywords internal -#' +#' packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { moduleServer(id, function(input, output, session) { ns <- session$ns - - cran_pkgs <- as.data.frame(available.packages("https://cran.rstudio.com/src/contrib")[,1:2]) + cran_pkgs <- as.data.frame(available.packages("https://cran.rstudio.com/src/contrib")[, 1:2]) loaded2_db <- eventReactive(list(selected_pkg$name(), changes()), { - dbSelect('SELECT name, version, score FROM package') + dbSelect("SELECT name, version, score FROM package") }) - + # used for adding action buttons to data_table shinyInput <- function(FUN, len, id, ...) { inputs <- character(len) @@ -50,32 +49,34 @@ packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { } inputs } - + tabready <- reactiveVal(value = NULL) - depends <- reactiveVal(value = NULL) - revdeps <- reactiveVal(value = NULL) - rev_pkg <- reactiveVal(value = NULL) - + depends <- reactiveVal(value = NULL) + revdeps <- reactiveVal(value = NULL) + rev_pkg <- reactiveVal(value = NULL) + observeEvent(list(parent$input$tabs, parent$input$metric_type, selected_pkg$name()), { req(selected_pkg$name()) req(selected_pkg$name() != "-") - - if(parent$input$tabs == "Package Metrics" & parent$input$metric_type == "dep") { - tabready(1L) } - else {tabready(0L)} + + if (parent$input$tabs == "Package Metrics" & parent$input$metric_type == "dep") { + tabready(1L) + } else { + tabready(0L) + } }) - + pkgref <- eventReactive(list(selected_pkg$name(), changes(), tabready()), { req(selected_pkg$name()) req(selected_pkg$name() != "-") req(tabready() == 1L) get_assess_blob(selected_pkg$name()) - }) - + }) + observeEvent(pkgref(), { req(pkgref()) - + tryCatch( expr = { depends(pkgref()$dependencies[[1]] %>% dplyr::as_tibble()) @@ -89,219 +90,279 @@ packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { ) revdeps(pkgref()$reverse_dependencies[[1]] %>% as.vector()) }) - + pkg_df <- eventReactive(list(selected_pkg$name(), tabready(), depends()), { - req(selected_pkg$name()) req(selected_pkg$name() != "-") req(tabready() == 1L) - req(depends()) - + req(depends()) + if (nrow(depends()) == 0) { # packages like curl, magrittr will appear here instead of in tryCatch() above msg <- paste("Detailed dependency information is not available for package", selected_pkg$name()) rlang::warn(msg) dplyr::tibble(package = character(0), type = character(0), name = character(0)) - } else { - pkginfo <- depends() %>% - as_tibble() %>% - mutate(package = stringr::str_replace(package, "\n", "")) %>% - mutate(name = stringr::str_extract(package, "\\w+")) + pkginfo <- depends() %>% + as_tibble() %>% + mutate(package = stringr::str_replace(package, "\n", "")) %>% + mutate(name = stringr::str_extract(package, "\\w+")) - purrr::map_df(pkginfo$name, ~get_versnScore(.x, loaded2_db(), cran_pkgs)) %>% - right_join(pkginfo, by = "name") %>% - select(package, type, name, version, score) + purrr::map_df(pkginfo$name, ~ get_versnScore(.x, loaded2_db(), cran_pkgs)) %>% + right_join(pkginfo, by = "name") %>% + select(package, type, name, version, score) } - - }) + }) data_table <- eventReactive(pkg_df(), { - cbind(pkg_df(), - data.frame( - Actions = shinyInput(actionButton, nrow(pkg_df()), - 'button_', - size = "xs", - style='height:24px; padding-top:1px;', - label = icon("arrow-right", class="fa-regular", lib = "font-awesome"), - onclick = paste0('Shiny.setInputValue(\"' , ns("select_button"), '\", this.id, {priority: "event"})') - ) - ) - ) %>% # remove action button if there is nothing to review - mutate(Actions = if_else(identical(package, character(0)) | name %in% c(rownames(installed.packages(priority="base"))), "", Actions)) + cbind( + pkg_df(), + data.frame( + Actions = shinyInput(actionButton, nrow(pkg_df()), + "button_", + size = "xs", + style = "height:24px; padding-top:1px;", + label = icon("arrow-right", class = "fa-regular", lib = "font-awesome"), + onclick = paste0('Shiny.setInputValue(\"', ns("select_button"), '\", this.id, {priority: "event"})') + ) + ) + ) %>% # remove action button if there is nothing to review + mutate(Actions = if_else(identical(package, character(0)) | name %in% c(rownames(installed.packages(priority = "base"))), "", Actions)) }) # Render Output UI for Package Dependencies. output$package_dependencies_ui <- renderUI({ - req(depends()) + req(depends()) # Lets the user know that a package needs to be selected. - if(identical(selected_pkg$name(), character(0))) + if (identical(selected_pkg$name(), character(0))) { showHelperMessage() - - else { + } else { fluidPage( - shiny:: tagList( br(), h4(glue::glue("Package Dependencies: {nrow(depends())}"), style = "text-align: left;"), br(), - tags$strong(glue::glue("First-order dependencies for package: ", {selected_pkg$name()})), + fluidRow( + column(6, + tags$strong( + glue::glue("First-order dependencies for package: ", {selected_pkg$name()}) + ) + ), + column(3, + actionButton( + inputId = ns("update_all_packages"), + label = "Upload all", + icon = icon("fas fa-upload fa-solid", class = "fa-regular", lib = "font-awesome"), + size = "xs", + style = "height:24px; padding-top:1px;" + ) + ) + ), br(), # remove DT "search:" rectangle tags$head( - tags$style(type="text/css", ".dataTables_filter {display: none; }" - )), + tags$style(type = "text/css", ".dataTables_filter {display: none; }") + ), fluidRow( - column(width = 8, - if (nrow(depends()) == 0) { - renderText("No dependency information is available") - } else { - DT::renderDataTable(server = FALSE, { - # Hiding name from DT table. target contains index for "name" - # The - 1 is because js uses 0 index instead of 1 like R - target <- which(names(data_table()) %in% c("name")) - 1 - - formattable::as.datatable( - formattable::formattable( - data_table(), - list( - score = formattable::formatter( - "span", - style = x ~ formattable::style(display = "block", - "border-radius" = "4px", - "padding-right" = "4px", - "font-weight" = "bold", - "color" = "white", - "order" = x, - "background-color" = formattable::csscolor( - setColorPalette(100)[round(as.numeric(x)*100)]))), - decision = formattable::formatter( - "span", - style = x ~ formattable::style(display = "block", - "border-radius" = "4px", - "padding-right" = "4px", - "font-weight" = "bold", - "color" = ifelse(x %in% decision_lst, "white", "inherit"), - "background-color" = - ifelse(x %in% decision_lst, - color_lst[x], - "transparent"))) - )), - selection = 'none', - colnames = c("Package", "Type", "Name", "Version", "Score", "Review Package"), - rownames = FALSE, - options = list( - lengthMenu = list(c(15, -1), c('15', 'All')), - columnDefs = list(list(visible = FALSE, targets = target)), - searchable = FALSE), - style="default" - ) %>% - DT::formatStyle(names(data_table()), textAlign = 'center') - }) + column( + width = 8, + if (nrow(depends()) == 0) { + renderText("No dependency information is available") + } else { + DT::renderDataTable(server = FALSE, { + # Hiding name from DT table. target contains index for "name" + # The - 1 is because js uses 0 index instead of 1 like R + target <- which(names(data_table()) %in% c("name")) - 1 + + formattable::as.datatable( + formattable::formattable( + data_table(), + list( + score = formattable::formatter( + "span", + style = x ~ formattable::style( + display = "block", + "border-radius" = "4px", + "padding-right" = "4px", + "font-weight" = "bold", + "color" = "white", + "order" = x, + "background-color" = formattable::csscolor( + setColorPalette(100)[round(as.numeric(x)*100)] + ) + ) + ), + decision = formattable::formatter( + "span", + style = x ~ formattable::style( + display = "block", + "border-radius" = "4px", + "padding-right" = "4px", + "font-weight" = "bold", + "color" = ifelse(x %in% decision_lst, "white", "inherit"), + "background-color" = + ifelse(x %in% decision_lst, + color_lst[x], + "transparent" + ) + ) + ) + ) + ), + selection = "none", + colnames = c("Package", "Type", "Name", "Version", "Score", "Review Package"), + rownames = FALSE, + options = list( + lengthMenu = list(c(15, -1), c("15", "All")), + columnDefs = list(list(visible = FALSE, targets = target)), + searchable = FALSE + ), + style = "default" + ) %>% + DT::formatStyle(names(data_table()), textAlign = "center") + }) } # if_else ) # column ), # fluidRow - br(), - h4(glue::glue("Reverse Dependencies: {length(revdeps())}"), style = "text-align: left;"), - br(), br(), - fluidRow( - column(width = 8, - wellPanel( - renderText(revdeps() %>% sort() ), - style = "max-height: 500px; overflow: auto" - ) - ) - ) - - ) # taglist - ) #fluidpage + br(), + h4(glue::glue("Reverse Dependencies: {length(revdeps())}"), style = "text-align: left;"), + br(), br(), + fluidRow( + column( + width = 8, + wellPanel( + renderText(revdeps() %>% sort()), + style = "max-height: 500px; overflow: auto" + ) + ) + ) + ) # taglist + ) # fluidpage } }) # renderUI pkgname <- reactiveVal() - observeEvent(input$select_button, { - req(pkg_df()) - rev_pkg(0L) - - selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2]) - - # grab the package name - pkg_name <- pkg_df()[selectedRow, 3] %>% pull() - pkgname("-") - - if(!pkg_name %in% loaded2_db()$name) { - pkgname(pkg_name) - shiny::showModal(modalDialog( - size = "l", - easyClose = TRUE, - h5("Package not Loaded", style = 'text-align: center !important'), - hr(), - br(), - fluidRow( - column( - width = 12, - 'Please confirm to load this package: ', span(class = 'text-info', input$decision), - ) - ), - br(), - footer = tagList( - actionButton(NS(id, 'confirm'), 'Load Package'), - actionButton(NS(id, 'cancel'), 'Cancel') - ))) - - } else { - # update sidebar-select_pkg - updateSelectizeInput( - session = parent, - inputId = "sidebar-select_pkg", - choices = c("-", loaded2_db()$name), - selected = pkg_name - )} - - }, ignoreInit = TRUE) # observeEvent - - + observeEvent(input$select_button, + { + req(pkg_df()) + rev_pkg(0L) + + selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2]) + + # grab the package name + pkg_name <- pkg_df()[selectedRow, 3] %>% pull() + pkgname("-") + + if (!pkg_name %in% loaded2_db()$name) { + pkgname(pkg_name) + shiny::showModal(modalDialog( + size = "l", + easyClose = TRUE, + h5("Package not Loaded", style = "text-align: center !important"), + hr(), + br(), + fluidRow( + column( + width = 12, + "Please confirm to load this package: ", span(class = "text-info", input$decision), + ) + ), + br(), + footer = tagList( + actionButton(NS(id, "confirm"), "Load Package"), + actionButton(NS(id, "cancel"), "Cancel") + ) + )) + } else { + # update sidebar-select_pkg + updateSelectizeInput( + session = parent, + inputId = "sidebar-select_pkg", + choices = c("-", loaded2_db()$name), + selected = pkg_name + ) + } + }, + ignoreInit = TRUE + ) # observeEvent + + observeEvent(input$confirm, { - shiny::removeModal() - updateSelectizeInput(session = parent, "upload_package-pkg_lst", - choices = c(pkgname()), selected = pkgname()) - + updateSelectizeInput( + session = parent, "upload_package-pkg_lst", + choices = c(pkgname()), selected = pkgname() + ) + session$onFlushed(function() { shinyjs::click(id = "upload_package-add_pkgs", asis = TRUE) - - rev_pkg(1L) + + rev_pkg(1L) }) - }) - # Close modal if user cancels decision submission. - observeEvent(input$cancel, { - shiny::removeModal() - }) - + # Close modal if user cancels decision submission. + observeEvent(input$cancel, { + shiny::removeModal() + }) + names_vect <- eventReactive(list(rev_pkg(), changes()), { req(rev_pkg() == 1L) - dbSelect('SELECT name FROM package')$name + dbSelect("SELECT name FROM package")$name }) - observeEvent(names_vect(), { - - pkg_name <- names_vect()[length(names_vect())] + observeEvent(names_vect(), + { + pkg_name <- names_vect()[length(names_vect())] + + updateSelectizeInput( + session = parent, + inputId = "sidebar-select_pkg", + choices = c("-", loaded2_db()$name), + selected = pkg_name + ) + }, + ignoreInit = TRUE + ) + + + observeEvent(input$update_all_packages, { + req(pkg_df(), loaded2_db()) + pkgs_update <- pkg_df() %>% + dplyr::filter(is.na(score) | score == "") - updateSelectizeInput( - session = parent, - inputId = "sidebar-select_pkg", - choices = c("-", loaded2_db()$name), - selected = pkg_name + n_packages <- nrow(pkgs_update) + if (n_packages > 0) { + pkgname(pkgs_update$name) + shiny::showModal( + modalDialog( + size = "l", + easyClose = TRUE, + title = "Upload all packages?", + p(glue::glue("Do you want to upload {n_packages} package(s)?")), + footer = tagList( + actionButton(NS(id, "confirm"), "Load Package(s)"), + actionButton(NS(id, "cancel"), "Cancel") + ) + ) + ) + + } else { + shiny::showModal( + modalDialog( + size = "l", + easyClose = TRUE, + title = "No packages to update", + p("There are no new packages to upload.") + ) ) + + } - }, ignoreInit = TRUE) - + }) }) # moduleServer - } From 297092ed8da6d34423d1379bf6f0af5978b5f300 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Mon, 14 Aug 2023 15:26:16 -0300 Subject: [PATCH 2/7] Update actionbutton height --- R/mod_packageDependencies.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index 993dbc132..e43c49e09 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -156,7 +156,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { label = "Upload all", icon = icon("fas fa-upload fa-solid", class = "fa-regular", lib = "font-awesome"), size = "xs", - style = "height:24px; padding-top:1px;" + style = "height:30px; padding-top:1px;" ) ) ), From 69a50de944a924ff572a268c77a8d0c85fbd5c18 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Mon, 14 Aug 2023 15:26:35 -0300 Subject: [PATCH 3/7] Add contributors --- DESCRIPTION | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 95b1b2de5..98edf1d16 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,10 +12,12 @@ Authors@R: c( person("Marly", "Gotti", role = "aut", email = "marly.cormar@biogen.com"), person("Maya", "Gans", role = "aut", email = "maya.gans@biogen.com"), person("Aravind Reddy", "Kallem", role = "aut"), + person("Eduardo", "Almeida", role = "ctb", email = "eduardoalmeida7393@gmail.com"), person(family = "Fission Labs India Pvt Ltd", role = "aut"), person(family = "PSI special interest group Application and Implementation of Methodologies in Statistics", role = c("cph", "fnd")), person(family = "R Validation Hub", role = c("cph", "fnd")), - person(family = "GSK contributors", role = "ctb", comment = "Author of 'pharmaR/pkg_explorer' repo") + person(family = "GSK contributors", role = "ctb", comment = "Author of 'pharmaR/pkg_explorer' repo"), + person(family = "Appsilon", role = "ctb") ) Description: A shiny application that allows users to define a list of R packages to assess metrics engineered by the `riskmetric` package. From 07319b2a39dda9b8dc9a5d7f771bfa666c6c3869 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Mon, 14 Aug 2023 15:26:48 -0300 Subject: [PATCH 4/7] Increment version number to 2.0.0.9001 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 98edf1d16..290bb7c63 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: riskassessment Title: A web app designed to interface with the `riskmetric` package -Version: 2.0.0.9000 +Version: 2.0.0.9001 Authors@R: c( person("Aaron", "Clark", role = c("aut", "cre"), email = "aaron.clark@biogen.com"), person("Robert", "Krajcik", role = "aut", email = "robert.krajcik@biogen.com"), From b22bd12e56c39dfc63cb44abde75fb969aae4c24 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Mon, 14 Aug 2023 16:52:45 -0300 Subject: [PATCH 5/7] Update lint --- R/mod_packageDependencies.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index e43c49e09..6e4ded93e 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -118,12 +118,13 @@ packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { cbind( pkg_df(), data.frame( - Actions = shinyInput(actionButton, nrow(pkg_df()), - "button_", - size = "xs", - style = "height:24px; padding-top:1px;", - label = icon("arrow-right", class = "fa-regular", lib = "font-awesome"), - onclick = paste0('Shiny.setInputValue(\"', ns("select_button"), '\", this.id, {priority: "event"})') + Actions = shinyInput( + actionButton, nrow(pkg_df()), + "button_", + size = "xs", + style = "height:24px; padding-top:1px;", + label = icon("arrow-right", class = "fa-regular", lib = "font-awesome"), + onclick = paste0('Shiny.setInputValue(\"', ns("select_button"), '\", this.id, {priority: "event"})') ) ) ) %>% # remove action button if there is nothing to review From 9cd521a19a0d91fea4d907c782bb87ad384b9330 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Tue, 15 Aug 2023 11:43:53 -0300 Subject: [PATCH 6/7] Review Update --- R/mod_packageDependencies.R | 6 ++++-- man/riskassessment-package.Rd | 2 ++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index 6e4ded93e..3995a7638 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -333,8 +333,10 @@ packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { observeEvent(input$update_all_packages, { req(pkg_df(), loaded2_db()) - pkgs_update <- pkg_df() %>% - dplyr::filter(is.na(score) | score == "") + + pkgs_update <- pkg_df() %>% + dplyr::filter(is.na(score) | score == "") %>% + dplyr::filter(!name %in% c(rownames(installed.packages(priority = "base")))) n_packages <- nrow(pkgs_update) if (n_packages > 0) { diff --git a/man/riskassessment-package.Rd b/man/riskassessment-package.Rd index 6cd4a01a3..29cdbdb63 100644 --- a/man/riskassessment-package.Rd +++ b/man/riskassessment-package.Rd @@ -40,9 +40,11 @@ Other contributors: \itemize{ \item Munshi Imran Hossain [contributor] \item Scott Schumacker \email{scottschu97@gmail.com} [contributor] + \item Eduardo Almeida \email{eduardoalmeida7393@gmail.com} [contributor] \item PSI special interest group Application and Implementation of Methodologies in Statistics [copyright holder, funder] \item R Validation Hub [copyright holder, funder] \item GSK contributors (Author of 'pharmaR/pkg_explorer' repo) [contributor] + \item Appsilon [contributor] } } From 419e57cae096fef313eac2f2da4b4361fdf61383 Mon Sep 17 00:00:00 2001 From: Eduardodudu Date: Tue, 15 Aug 2023 13:06:27 -0300 Subject: [PATCH 7/7] Review: Fix warning message --- R/mod_packageDependencies.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index 552e19a50..6f746090d 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -156,7 +156,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, changes, parent) { actionButton( inputId = ns("update_all_packages"), label = "Upload all", - icon = icon("fas fa-upload fa-solid", class = "fa-regular", lib = "font-awesome"), + icon = icon("fas fa-upload", class = "fa-regular", lib = "font-awesome"), size = "xs", style = "height:30px; padding-top:1px;" )