diff --git a/DESCRIPTION b/DESCRIPTION index fd83d172..20686c2b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: riskassessment Title: A web app designed to interface with the `riskmetric` package -Version: 3.0.0.9023 +Version: 3.0.0.9024 Authors@R: c( person("Aaron", "Clark", role = c("aut", "cre"), email = "clark.aaronchris@gmail.com"), person("Robert", "Krajcik", role = "aut", email = "robert.krajcik@biogen.com"), diff --git a/NEWS.md b/NEWS.md index bf828f38..a54f0b21 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,7 +26,8 @@ * Updated 'About' page to highlight individual contributors on the project, leveraging `bslib` cards. * Allow users to specify decisions in the CSV upload file (#663) * Fix bug causing application to crash when trying to delete zero packages (#781) -* Add `Decision` column to Package Dependencies tab so that users (#774) +* Add `Decision` column to Package Dependencies tab's table output (#774) +* Add `Decision Summary` card to Package Dependencies tab (#774) diff --git a/R/global.R b/R/global.R index e5820e98..b3a37568 100644 --- a/R/global.R +++ b/R/global.R @@ -34,9 +34,15 @@ utils::globalVariables( 'day_month_year', 'decision', 'decision_by', + 'dec_cat', + 'dec_cat_sum', + 'dec_cat_pct', + 'dec_cat_disp', + 'dec_id', 'decision_cat_disp', 'decision_cat_sum', 'decision_date', + 'decision_id', 'description', 'description', 'downloads', @@ -60,6 +66,8 @@ utils::globalVariables( 'Name', 'new_role', 'new_weight', + 'non_base', + 'non_base_sum', 'old_role', 'package', 'Package', @@ -84,6 +92,9 @@ utils::globalVariables( 'upld_cat_disp', 'upld_cat_pct', 'upld_cat_sum', + 'upld_non_base', + 'upld_non_base_sum', + 'upld_non_base_pct', 'upper_limit', 'user_role', 'Version', diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R index e0d54ceb..cd3060a9 100644 --- a/R/mod_downloadHandler.R +++ b/R/mod_downloadHandler.R @@ -281,21 +281,15 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){ downloads_plot <- build_comm_plotly(comm_data) metric_tbl <- dbSelect("select * from metric", db_name = golem::get_golem_options('assessment_db_name')) - dep_metrics <- get_depends_data(this_pkg, session$userData$suggests(), db_name = golem::get_golem_options("assessment_db_name")) + dep_metrics <- get_depends_data(this_pkg, + session$userData$suggests(), + db_name = golem::get_golem_options("assessment_db_name"), + loaded2_db = session$userData$loaded2_db(), + repo_pkgs = session$userData$repo_pkgs() + ) dep_cards <- build_dep_cards(data = dep_metrics, loaded = session$userData$loaded2_db()$name, toggled = session$userData$suggests()) - dep_table <- - if (nrow(dep_metrics) == 0) { - dplyr::tibble(package = character(), type = character(), version = character(), score = character(), decision = character()) - } else { - purrr::map_df(dep_metrics$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) %>% - right_join(dep_metrics, by = "name") %>% - select(package, type, version, score, decision) %>% - mutate(decision = if_else(is.na(decision) | toupper(decision) == "NA", "", decision)) %>% - arrange(package, type) %>% - distinct() - } # Render the report, passing parameters to the rmd file. rmarkdown::render( @@ -321,7 +315,7 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){ com_metrics_raw = comm_data, downloads_plot_data = downloads_plot, dep_cards = dep_cards, - dep_table = dep_table, + dep_table = dep_metrics |> select(-decision_id), metric_tbl = metric_tbl ) ) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index 9bb4b912..78f6ed05 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -64,28 +64,62 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren req(pkgref()) tryCatch( expr = { - depends(pkgref()$dependencies[[1]] %>% dplyr::as_tibble() %>% - mutate(package = stringr::str_replace(package, "\n", " ")) %>% - mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))) + deep_ends <- pkgref()$dependencies[[1]] %>% dplyr::as_tibble() %>% + mutate(package = stringr::str_replace(package, "\n", " ")) %>% + mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")) + + deps_decision_data <- purrr::map_df(deep_ends$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) + if(nrow(deps_decision_data) == 0) { + deps_w_decision <- dplyr::tibble(name = character(0), version = character(0), + score = character(0), decision = character(0), decision_id = character(0)) + } else { + deps_w_decision <- deps_decision_data + } + depends( + deps_w_decision %>% + right_join(deep_ends, by = "name") %>% + select(package, type, name, version, score, decision, decision_id) %>% + arrange(name, type) %>% + distinct() + ) }, error = function(e) { msg <- paste("Detailed dependency information is not available for package", selected_pkg$name()) rlang::warn(msg) rlang::warn(paste("info:", e)) - depends(dplyr::tibble(package = character(0), type = character(0), name = character(0))) + depends(dplyr::tibble(package = character(0), type = character(0), name = character(0), + version = character(0), score = character(0), decision = character(0), + decision_id = character(0))) } ) tryCatch( expr = { - suggests(pkgref()$suggests[[1]] %>% dplyr::as_tibble()%>% - mutate(package = stringr::str_replace(package, "\n", " ")) %>% - mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))) + shrug_jests <- pkgref()$suggests[[1]] %>% dplyr::as_tibble()%>% + mutate(package = stringr::str_replace(package, "\n", " ")) %>% + mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")) + + sugg_decision_data <- purrr::map_df(shrug_jests$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) + if(nrow(sugg_decision_data) == 0) { + suggs_w_decision <- dplyr::tibble(name = character(0), version = character(0), + score = character(0), decision = character(0), decision_id = character(0)) + } else { + suggs_w_decision <- sugg_decision_data + } + suggests( + suggs_w_decision %>% + right_join(shrug_jests, by = "name") %>% + select(package, type, name, version, score, decision, decision_id) %>% + arrange(name, type) %>% + distinct() + ) }, error = function(e) { msg <- paste("Detailed suggests information is not available for package", selected_pkg$name()) rlang::warn(msg) rlang::warn(paste("info:", e)) - suggests(dplyr::tibble(package = character(0), type = character(0), name = character(0))) + suggests(dplyr::tibble(package = character(0), type = character(0), name = character(0), + version = character(0), score = character(0), decision = character(0), + decision_id = character(0))) } ) # this is so the dependencies is also a 0x2 tibble like suggests @@ -115,10 +149,10 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren if (toggled() == 0L || nrow(suggests()) == 0) { return(dplyr::tibble(package = character(0), type = character(0), name = character(0))) } else { - pkginfo <- suggests() %>% as_tibble() + pkginfo <- suggests() %>% dplyr::as_tibble() } } else { - pkginfo <- dplyr::bind_rows(depends(), suggests()) %>% as_tibble() + pkginfo <- dplyr::bind_rows(depends(), suggests()) %>% dplyr::as_tibble() } pkginfo <- pkginfo %>% mutate(package = stringr::str_replace(package, "\n", " ")) %>% @@ -139,10 +173,9 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren } } - purrr::map_df(pkginfo$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) %>% - right_join(pkginfo, by = "name") %>% + pkginfo %>% select(package, type, name, version, score, decision) %>% - arrange(name, type) %>% + arrange(name, type) %>% distinct() }, ignoreInit = TRUE) @@ -198,74 +231,78 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren br(), br(), div(id = "dep_infoboxes", metricGridUI(NS(id, 'metricGrid'))), br(), - fluidRow( - column(4, - tags$strong( - glue::glue("First-order dependencies for package: ", {selected_pkg$name()}) - ) + div(style = "padding-left: 40px;", + HTML(glue::glue("FIRST-ORDER DEPENDENDENCIES OF {selected_pkg$name()}
")), + br(), + fluidRow( + column(4, ""), + column(3, + shinyWidgets::materialSwitch( + inputId = ns("incl_suggests"), + label = "Include Suggests", + value = toggled(), + inline = TRUE, + status = "success" + ) + ), + column(2, + if (pkg_updates$render_upload) { + actionButton( + inputId = ns("update_all_packages"), + label = "Upload all", + icon = icon("fas fa-upload", class = "fa-regular", lib = "font-awesome"), + size = "xs", + style = "height:30px; padding-top:1px;" + ) + } + ) ), - column(2, - shinyWidgets::materialSwitch( - inputId = ns("incl_suggests"), - label = "Include Suggests", - value = toggled(), - inline = TRUE, - status = "success" - ) + br(), + # remove DT "search:" rectangle + tags$head( + tags$style(type = "text/css", ".dataTables_filter {display: none; }") ), - column(2, - if (pkg_updates$render_upload) { - actionButton( - inputId = ns("update_all_packages"), - label = "Upload all", - icon = icon("fas fa-upload", class = "fa-regular", lib = "font-awesome"), - size = "xs", - style = "height:30px; padding-top:1px;" - ) - } - ) - ), - br(), - # remove DT "search:" rectangle - tags$head( - tags$style(type = "text/css", ".dataTables_filter {display: none; }") - ), - fluidRow( - column( - width = 8, - DT::renderDataTable(server = FALSE, { - datatable_custom(data_table(), custom_dom = "lftpi") - }) - ) - ), - br(), br(), - h3(glue::glue("All reverse Dependencies: {length(revdeps())}"), style = "text-align: left;"), - br(), - fluidRow( - column( - width = 8, - h4(glue::glue("Reverse Dependencies available in database: {nrow(table_revdeps_local()) %||% 0}"), style = "text-align: left;"), - br(), - DT::renderDataTable({ - datatable_custom( - table_revdeps_local() |> select(-decision_id), - colnames = c("Package", "Version", "Score", "Decision", "Review Package"), - hide_names = NULL + fluidRow( + column( + width = 9, + DT::renderDataTable(server = FALSE, { + datatable_custom(data_table(), custom_dom = "lftpi") + }) + ) + ), + br(), br(), + + HTML(glue::glue("REVERSE DEPENDENDENCIES OF {selected_pkg$name()}
")), + # h3("Reverse Dependencies", style = "text-align: left;"), + br(), + fluidRow( + column( + width = 9, + h4(glue::glue("Available in database: {nrow(table_revdeps_local()) %||% 0}"), style = "text-align: left;"), + br(), + DT::renderDataTable({ + datatable_custom( + table_revdeps_local() |> select(-decision_id), + colnames = c("Package", "Version", "Score", "Decision", "Review Package"), + hide_names = NULL + ) + }), + br(), br(), + h4(glue::glue("All reverse Dependencies: {length(revdeps())}"), style = "text-align: left;"), + br(), + wellPanel( + renderText(revdeps() %>% sort()), + style = "max-height: 500px; overflow: auto" ) - }), - br(), br(), - wellPanel( - renderText(revdeps() %>% sort()), - style = "max-height: 500px; overflow: auto" ) + ), + br(), br(), + fluidRow(div(id = "comments_for_dep", + if ("general_comment" %in% unlist(credentials$privileges[user$role], use.names = FALSE)) addCommentUI(NS(id, 'add_comment')), + viewCommentsUI(NS(id, 'view_comments'))) ) - ), - br(), br(), - fluidRow(div(id = "comments_for_dep", - if ("general_comment" %in% unlist(credentials$privileges[user$role], use.names = FALSE)) addCommentUI(NS(id, 'add_comment')), - viewCommentsUI(NS(id, 'view_comments'))) - ) - ) # taglist + ) # taglist + ) #div } }) # renderUI diff --git a/R/mod_reportPreview.R b/R/mod_reportPreview.R index 40970915..acaa0782 100644 --- a/R/mod_reportPreview.R +++ b/R/mod_reportPreview.R @@ -192,7 +192,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, DT::renderDataTable({ req(selected_pkg$name()) - datatable_custom(dep_table(), pLength = list(-1), PlChange = FALSE, + datatable_custom(dep_metrics() |> select(-decision_id, -name), custom_dom = "t", pLength = list(-1), PlChange = FALSE, colnames = c("Package", "Type", "Version", "Score", "Decision")) } @@ -450,7 +450,12 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, }) dep_metrics <- eventReactive(list(selected_pkg$name(), session$userData$suggests()), { - get_depends_data(selected_pkg$name(), session$userData$suggests(), db_name = golem::get_golem_options("assessment_db_name")) + get_depends_data(selected_pkg$name(), + session$userData$suggests(), + db_name = golem::get_golem_options("assessment_db_name"), + loaded2_db = session$userData$loaded2_db(), + repo_pkgs = session$userData$repo_pkgs() + ) }) dep_cards <- eventReactive(dep_metrics(), { @@ -461,18 +466,6 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, # Package Dependencies metrics cards. metricGridServer("dep_metricGrid", metrics = dep_cards) - dep_table <- eventReactive(dep_metrics(), { - req(dep_metrics()) - - if (nrow(dep_metrics()) == 0) - return(dplyr::tibble(package = character(), type = character(), version = character(), score = character())) - - purrr::map_df(dep_metrics()$name, ~get_versnScore(.x, session$userData$loaded2_db(), session$userData$repo_pkgs())) %>% - right_join(dep_metrics(), by = "name") %>% - select(package, type, version, score, decision) %>% - arrange(package, type) %>% - distinct() - }) output$communityMetrics_ui <- renderUI({ req(selected_pkg$name()) diff --git a/R/utils.R b/R/utils.R index 8824757c..96440065 100644 --- a/R/utils.R +++ b/R/utils.R @@ -588,7 +588,7 @@ datatable_custom <- function( # Hiding name from DT table. # The - 1 is because js uses 0 index instead of 1 like R target <- which(names(data) %in% hide_names) - 1 - + formattable::as.datatable( formattable::formattable( data, diff --git a/R/utils_build_cards.R b/R/utils_build_cards.R index fd45ca8d..48ff9ae8 100644 --- a/R/utils_build_cards.R +++ b/R/utils_build_cards.R @@ -234,7 +234,7 @@ build_comm_cards <- function(data, db_name = golem::get_golem_options('assessmen #' The 'Build Dependency Cards' function #' #' @param data a data.frame -#' @param loaded a vector of package names loaded to db +#' @param loaded a vector of package names loaded to db #' #' @import dplyr #' @importFrom glue glue @@ -256,6 +256,7 @@ build_dep_cards <- function(data, loaded, toggled){ is_url = numeric(), type = character() ) + deps <- data %>% mutate(base = if_else(name %in% c(rownames(installed.packages(priority = "base"))), "Base", "Non-Base")) %>% @@ -264,7 +265,6 @@ build_dep_cards <- function(data, loaded, toggled){ mutate(upld = if_else(name %in% loaded, 1, 0)) %>% mutate(upld_non_base = if_else((name %in% loaded) & non_base == 1, 1, 0)) - if (toggled == 0L) { deps <- deps %>% mutate(type = factor(type, levels = c("Imports", "Depends", "LinkingTo"), ordered = TRUE)) @@ -308,7 +308,7 @@ build_dep_cards <- function(data, loaded, toggled){ # Card 2: Type Summary # base R replacement for tidyr::complete(type) - x2 <- tibble("type" = levels(deps$type)) + x2 <- dplyr::tibble("type" = levels(deps$type)) y2 <- full_join(x2, deps, by = "type") %>% mutate(type = factor(type, ordered = TRUE)) @@ -340,10 +340,57 @@ build_dep_cards <- function(data, loaded, toggled){ ) - # Card 3: Base-R Packages - x3 <- tibble("base" = levels(deps$base)) - y3 <- full_join(x3, deps, by = "base") + # Card 3: Decision Summary + decision_lst <- if (!is.null(golem::get_golem_options("decision_categories"))) golem::get_golem_options("decision_categories") else c("Low Risk", "Medium Risk", "High Risk") + decision_key <- dplyr::tibble(decision = decision_lst) |> + dplyr::mutate(decision_id = dplyr::row_number()) # I don't think I need this + high_decision <- decision_key |> + dplyr::filter(decision_id == max(decision_key$decision_id)) |> + dplyr::pull(decision) + + + dec_cat_dat <- + deps %>% + mutate(cnt = ifelse(is.na(name), 0, 1)) %>% + mutate(dec_cat = factor(if_else(decision == "" | is.na(decision), "No Decision", decision), + levels = c("No Decision", decision_key$decision))) %>% + mutate(dec_id = if_else(decision == "" | is.na(decision), "0", decision_id)) %>% + group_by(dec_cat, dec_id) %>% + summarize(dec_cat_sum = sum(cnt)) %>% + ungroup() %>% + mutate(dec_cat_pct = 100 * (dec_cat_sum / nrow(deps))) %>% + mutate(dec_cat_disp = if_else(is.nan(dec_cat_pct), + glue::glue('{dec_cat}: {dec_cat_sum} ( 0%)'), + glue::glue('{dec_cat}: {dec_cat_sum} ({format(dec_cat_pct, digits = 1)}%)'))) %>% + arrange(dec_cat) + + if(nrow(dec_cat_dat) == 0) { + dec_cat_rows <- "No Decisions" + } else { + dec_cat_rows <- dec_cat_dat %>% + pull(dec_cat_disp) %>% + paste(., collapse = " \n") + } + + cards <- cards %>% + dplyr::add_row( + name = 'dec_cat_count', + title = 'Decision Summary', + desc = 'Package Dependencies by Decision', + value = dec_cat_rows, + score = "NULL", + succ_icon = 'rocket', + icon_class = "text-info", # this gets overwritten by `type` arg below + is_perc = 0, + is_url = 0, + type = if_else(any(pull(dec_cat_dat, dec_id) == max(decision_key$decision_id)), "danger", "information") + ) + + # Card 4: Base-R Packages + x3 <- dplyr::tibble("base" = levels(deps$base)) + y3 <- full_join(x3, deps, by = "base") + base_cat_rows <- y3 %>% mutate(cnt = ifelse(is.na(name), 0, 1)) %>% @@ -371,7 +418,13 @@ build_dep_cards <- function(data, loaded, toggled){ is_url = 0 ) + + + + + # return cards object cards + } diff --git a/R/utils_get_db.R b/R/utils_get_db.R index 2e370879..04f957d7 100644 --- a/R/utils_get_db.R +++ b/R/utils_get_db.R @@ -221,7 +221,8 @@ get_metric_data <- function(pkg_name, metric_class = 'maintenance', db_name = go dbSelect( "SELECT metric.name, metric.long_name, metric.description, metric.is_perc, - metric.is_url, package_metrics.value, package_metrics.metric_score + metric.is_url, package_metrics.value, package_metrics.metric_score, + 'information' as type FROM metric INNER JOIN package_metrics ON metric.id = package_metrics.metric_id INNER JOIN package on package_metrics.package_id = package.id @@ -245,31 +246,70 @@ get_metric_data <- function(pkg_name, metric_class = 'maintenance', db_name = go #' #' @param pkg_name character name of package #' @param db_name character name (and file path) of the database +#' @param loaded2_db a data.frame containing variables: name, version, score, decision_id, decision +#' @param repo_pkgs a data.frame containing variables: Package & Version, defaulting to output from available.packages() #' #' @import dplyr #' @importFrom stringr str_replace #' #' @returns a data frame with package, type, and name #' @noRd -get_depends_data <- function(pkg_name, suggests, db_name = golem::get_golem_options('assessment_db_name')){ +get_depends_data <- function(pkg_name, + suggests, + db_name = golem::get_golem_options('assessment_db_name'), + loaded2_db = dplyr::tibble(package = character(0), type = character(0), name = character(0), + version = character(0), score = character(0), decision_id = character(0), + decision = character(0) + ), + repo_pkgs = as.data.frame(utils::available.packages()[,1:2])){ pkgref <- get_assess_blob(pkg_name, db_name, metric_lst = c("dependencies", "suggests")) if(suppressWarnings(is.null(nrow(pkgref$dependencies[[1]])) || nrow(pkgref$dependencies[[1]]) == 0)) { - deps <- dplyr::tibble(package = character(0), type = character(0), name = character(0)) + deps <- dplyr::tibble(package = character(0), type = character(0), name = character(0), + version = character(0), score = character(0), decision = character(0), + decision_id = character(0)) } else { - deps <- pkgref$dependencies[[1]] %>% dplyr::as_tibble() %>% + deep_ends <- pkgref$dependencies[[1]] %>% dplyr::as_tibble() %>% mutate(package = stringr::str_replace(package, "\n", " ")) %>% mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")) + + deps_decision_data <- purrr::map_df(deep_ends$name, ~get_versnScore(.x, loaded2_db, repo_pkgs)) + if(nrow(deps_decision_data) == 0) { + deps_w_decision <- dplyr::tibble(name = character(0), version = character(0), + score = character(0), decision = character(0), decision_id = character(0)) + } else { + deps_w_decision <- deps_decision_data + } + deps <- deps_w_decision %>% + right_join(deep_ends, by = "name") %>% + select(package, type, name, version, score, decision, decision_id) %>% + arrange(name, type) %>% + distinct() } if(isTruthy(suggests)) { if(suppressWarnings(is.null(nrow(pkgref$suggests[[1]])) || nrow(pkgref$suggests[[1]]) == 0)) { - sugg <- dplyr::tibble(package = character(0), type = character(0), name = character(0)) + sugg <- dplyr::tibble(package = character(0), type = character(0), name = character(0), + version = character(0), score = character(0), decision = character(0), + decision_id = character(0)) } else { - sugg <- pkgref$suggests[[1]] %>% dplyr::as_tibble() %>% + shrug_jests <- pkgref$suggests[[1]] %>% dplyr::as_tibble() %>% mutate(package = stringr::str_replace(package, "\n", " ")) %>% mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])")) + + sugg_decision_data <- purrr::map_df(shrug_jests$name, ~get_versnScore(.x, loaded2_db, repo_pkgs)) + if(nrow(sugg_decision_data) == 0) { + suggs_w_decision <- dplyr::tibble(name = character(0), version = character(0), + score = character(0), decision = character(0), decision_id = character(0)) + } else { + suggs_w_decision <- sugg_decision_data + } + sugg <- suggs_w_decision %>% + right_join(shrug_jests, by = "name") %>% + select(package, type, name, version, score, decision, decision_id) %>% + arrange(name, type) %>% + distinct() } return(bind_rows(deps, sugg)) } else { @@ -379,7 +419,8 @@ get_assess_blob <- function(pkg_lst, db_name = golem::get_golem_options('assessm get_versnScore <- function(pkg_name, verify_data, cran_pkgs) { if (rlang::is_empty(pkg_name)) - return(list(name = character(), version = character(), score = character())) + return(list(name = character(), version = character(), score = character(), + decision_id = character(), decision = character())) if (pkg_name %in% verify_data$name) { #loaded2_db()$name tmp_df <- verify_data %>% filter(name == pkg_name) %>% select(score, version, decision_id, decision) diff --git a/R/utils_insert_db.R b/R/utils_insert_db.R index 70827ce5..5ed7d170 100644 --- a/R/utils_insert_db.R +++ b/R/utils_insert_db.R @@ -241,7 +241,7 @@ insert_riskmetric_to_db <- function(pkg_name, pkg_version = "", which=c("Suggests"), recursive=FALSE)) %>% unname() %>% sort() } - tbl_suggests <- tibble("package" = sug_vctr, type = "Suggests") + tbl_suggests <- dplyr::tibble("package" = sug_vctr, type = "Suggests") attr(tbl_suggests, "class") <- c('pkg_metric_dependencies', 'pkg_metric', 'data.frame') lst_suggests <- list(suggests = tbl_suggests) mostattributes(lst_suggests) <- attributes(riskmetric_assess$dependencies) diff --git a/dev/run_dev.R b/dev/run_dev.R index 3a02c363..92f199d2 100644 --- a/dev/run_dev.R +++ b/dev/run_dev.R @@ -1,6 +1,6 @@ # Set options here options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode -options(shiny.fullstacktrace = FALSE) +options(shiny.fullstacktrace = TRUE) options(dplyr.summarise.inform = FALSE) # suppress summarise() has grouped output by..." # options(shiny.autoload.r=FALSE) diff --git a/inst/WORDLIST b/inst/WORDLIST index a5b1ad68..50dbc669 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -29,7 +29,6 @@ ShinyProxy Started’ Sys UI -Workstream addComment arg asis @@ -42,7 +41,6 @@ chromote cmd config configs -contrib covr cran databaseView diff --git a/inst/report_downloads/reportDocx.Rmd b/inst/report_downloads/reportDocx.Rmd index b0f27394..7b541831 100644 --- a/inst/report_downloads/reportDocx.Rmd +++ b/inst/report_downloads/reportDocx.Rmd @@ -290,11 +290,20 @@ if('Community Usage Comments' %in% params$report_includes){ `r if ('Package Dependencies' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` +```{r package_dependencies_table_header} + if(any(c('Package Dependencies', 'Dependency Comments') %in% params$report_includes)) { + tagList( + br(), + h3(glue::glue("First Order Dependencies of {params$pkg$name}")), + ) + } +``` + ```{r package_dependencies_table, eval=dm_ind} if('Package Dependencies' %in% params$report_includes) { params$dep_table %>% purrr::set_names(tools::toTitleCase(names(.))) %>% - flextable::flextable(cwidth = c(1.5, 1.25, 1.25, 1.25)) %>% + flextable::flextable(cwidth = c(1.75, 1.0, 1.0, 1.0, .75, 1.5)) %>% flextable::set_table_properties(align = "left") } ``` diff --git a/inst/report_downloads/reportHtml.Rmd b/inst/report_downloads/reportHtml.Rmd index 2797b999..a760fda1 100644 --- a/inst/report_downloads/reportHtml.Rmd +++ b/inst/report_downloads/reportHtml.Rmd @@ -163,8 +163,7 @@ createGrid <- function(metrics){ is_url = metrics$is_url[i] == 1, succ_icon = metrics$succ_icon[i], icon_class = metrics$icon_class[i] - ,type = dplyr::if_else(metrics$name[i] == "downloads_trend" & metrics$value[i] < 0, "danger", "information") - # metrics$type[i] # doesn't exist in table + ,type = metrics$type[i] ) }) }), @@ -180,8 +179,7 @@ createGrid <- function(metrics){ is_url = metrics$is_url[i] == 1, succ_icon = metrics$succ_icon[i], icon_class = metrics$icon_class[i] - ,type = dplyr::if_else(metrics$name[i] == "downloads_trend" & metrics$value[i] < 0, "danger", "information") - # metrics$type[i] # doesn't exist in table + ,type = metrics$type[i] ) }) }), @@ -197,8 +195,7 @@ createGrid <- function(metrics){ is_url = metrics$is_url[i] == 1, succ_icon = metrics$succ_icon[i], icon_class = metrics$icon_class[i] - ,type = dplyr::if_else(metrics$name[i] == "downloads_trend" & metrics$value[i] < 0, "danger", "information") - # metrics$type[i] # doesn't exist in table + ,type = metrics$type[i] ) }) }), @@ -371,6 +368,8 @@ tagList( if ('Package Dependencies' %in% params$report_includes) tagList( createGrid(metrics = params$dep_cards), + br(), + HTML(glue::glue("
First Order Dependencies of {params$pkg$name}
")), br(), # datatable_custom( DT::datatable( diff --git a/inst/report_downloads/reportPdf.Rmd b/inst/report_downloads/reportPdf.Rmd index 773a5c32..8f9cdbef 100644 --- a/inst/report_downloads/reportPdf.Rmd +++ b/inst/report_downloads/reportPdf.Rmd @@ -291,13 +291,22 @@ if('Community Usage Comments' %in% params$report_includes){ kableExtra::kbl(cards, format = 'latex', booktabs = T, linesep = "") %>% kableExtra::kable_styling("basic", latex_options = "hold_position", full_width = F, position = 'left') %>% - kableExtra::column_spec(3, width = "1.5in", latex_valign = "p") + kableExtra::column_spec(3, width = "1.4in", latex_valign = "p") } ``` `r if ('Package Dependencies' %in% params$report_includes) {"\\* Metrics whose score is NA will not impact the package {riskmetric} score"}` +```{r package_dependencies_table_header} + if(any(c('Package Dependencies', 'Dependency Comments') %in% params$report_includes)) { + tagList( + br(), + h3(glue::glue("First Order Dependencies of {params$pkg$name}")) + ) + } +``` + ```{r package_dependencies_table, eval=dm_ind} if('Package Dependencies' %in% params$report_includes) { params$dep_table %>% diff --git a/manifest.json b/manifest.json index 83cfda63..2c664be6 100644 --- a/manifest.json +++ b/manifest.json @@ -4367,7 +4367,7 @@ "Maintainer": "Kevin Ushey ", "Repository": "RSPM", "Date/Publication": "2024-02-29 01:10:07 UTC", - "Built": "R 4.3.3; ; 2024-06-06 17:15:02 UTC; unix" + "Built": "R 4.3.3; ; 2024-06-12 18:43:36 UTC; unix" } }, "reprex": { @@ -6220,7 +6220,7 @@ "checksum": "99c5575cb81828e20a7fe1d205551316" }, "DESCRIPTION": { - "checksum": "c4ce70d1592eea23d969d53b917c4a5b" + "checksum": "c7e19a728e7d1cb04961c5695ed151c2" }, "inst/app/www/css/community_metrics.css": { "checksum": "f08eb25c2ee48ac22ed63b0d18994a04" @@ -6400,13 +6400,13 @@ "checksum": "d3436d70ab382e65f2979ca0c4c20041" }, "inst/report_downloads/reportDocx.Rmd": { - "checksum": "788fc881cc4446504a88888fa55e2cfa" + "checksum": "449e8dcb07732ecd9a0963bada90e53e" }, "inst/report_downloads/reportHtml.Rmd": { - "checksum": "dc9c51d3badaf67a4f13fe5a5bbb57f4" + "checksum": "0e49db815a61c6698acad37894a9c0c1" }, "inst/report_downloads/reportPdf.Rmd": { - "checksum": "86b922fc17ccc912a82a6cb881281b0a" + "checksum": "3c7cfa456a7a171df1f10f9c1690718c" }, "inst/sql_queries/create_comments_table.sql": { "checksum": "514c169e358f7613d8026e6a9fd211ce" @@ -6451,7 +6451,7 @@ "checksum": "5fc0bfdb844b4ce7df8a183e2a4a2f96" }, "inst/WORDLIST": { - "checksum": "ad214434052cd9e20e2542994162b5f7" + "checksum": "52903eb411c9301dc68168bbca5bc4c1" }, "LICENSE": { "checksum": "ab496eda3728cf54db7cbf3e6f752572" @@ -6463,7 +6463,7 @@ "checksum": "97d1232340e04c53088bc8f814133dcd" }, "NEWS.md": { - "checksum": "f9bc97131b3753ea173bff4248b97e1f" + "checksum": "0acbd76cb19bc0ce397df38b33006e6d" }, "R/app_config.R": { "checksum": "c2b61f270b86b6833f0ee39c44a1a440" @@ -6475,7 +6475,7 @@ "checksum": "50d68f46171151cd36457a7154e5a7a3" }, "R/global.R": { - "checksum": "3b969b3b79cfdf02d2a66fe78b3106c5" + "checksum": "dec06e3d38ec3811b87ecb8c85a0c38f" }, "R/mod_aboutInfo_utils.R": { "checksum": "23ff3c99869bd59ed973d031ee2962fd" @@ -6508,7 +6508,7 @@ "checksum": "e22e1f4c044bc9f11c46a5fcdba33063" }, "R/mod_downloadHandler.R": { - "checksum": "20126728855935201f75b0e36d444175" + "checksum": "9c00f033ca9565f3a466e7381025e368" }, "R/mod_introJS_utils_text.R": { "checksum": "d98620a891752cf54b0d0282ddaa4af6" @@ -6532,7 +6532,7 @@ "checksum": "a894eb9114e258feb99b76cdca557cd2" }, "R/mod_packageDependencies.R": { - "checksum": "05b1fbde1ace35aa787552552744b057" + "checksum": "6fffb51829775826e242824f268062b6" }, "R/mod_pkg_explorer_utils.R": { "checksum": "b7792e08cc4a67296c9df0f452c0a72a" @@ -6541,7 +6541,7 @@ "checksum": "dbbfdfde47d106e0deaf20822c69bf94" }, "R/mod_reportPreview.R": { - "checksum": "56d62f285d64f5846cf266c79bac5b6a" + "checksum": "1fff75a23e54c9d8dac895731b03ac3a" }, "R/mod_reweightView.R": { "checksum": "d3988b7b6168f0560dc9525f1c6138ed" @@ -6565,22 +6565,22 @@ "checksum": "b610fc73187b7cd23521deb9339d54cf" }, "R/utils_build_cards.R": { - "checksum": "d18d58e66e64b22eb2fcf5a3a0f59694" + "checksum": "f79316fe637bb1f4038f085621d298f5" }, "R/utils_config_db.R": { "checksum": "74cf2ee5e7283483a88f08d60e3728b0" }, "R/utils_get_db.R": { - "checksum": "270a240f5882ec130989f252fe18011f" + "checksum": "6e87d4d43f93b4a4b556d72b848dc3f1" }, "R/utils_insert_db.R": { - "checksum": "ee28bd9e4f053e7ee936d7d8ef5fe887" + "checksum": "d890c439c8ece5dd9236681efee4ab9c" }, "R/utils_startup.R": { "checksum": "b689ee96f0761480ac65ca22cbbb4980" }, "R/utils.R": { - "checksum": "dd8cda3fb9deb392b6f82798f26bd668" + "checksum": "995d947896038bdcec381ff4b4e94fd0" }, "README.md": { "checksum": "d7e84fce2c891619912b6cc552eecc94" diff --git a/tests/testthat/test-packageDependencies.R b/tests/testthat/test-packageDependencies.R index bbb24f6c..b4996681 100644 --- a/tests/testthat/test-packageDependencies.R +++ b/tests/testthat/test-packageDependencies.R @@ -75,7 +75,12 @@ test_that( app_session$options$golem_options <- list( assessment_db_name = temp_db_loc ) - app_session$userData$loaded2_db <- reactiveVal(dbSelect("SELECT name, version, score FROM package", temp_db_loc)) + app_session$userData$loaded2_db <- reactiveVal( + riskassessment:::dbSelect(" + SELECT name, version, score, decision_id, decision + FROM package as pi + LEFT JOIN decision_categories as dc + ON pi.decision_id = dc.id", temp_db_loc)) # "select name, version, score from package" testServer(packageDependenciesServer, args = testargs, { session$flushReact() diff --git a/tests/testthat/test-reportPreview.R b/tests/testthat/test-reportPreview.R index e91d769c..a424a2a0 100644 --- a/tests/testthat/test-reportPreview.R +++ b/tests/testthat/test-reportPreview.R @@ -61,7 +61,7 @@ test_that("Reactivity of reportPreview", { rvest::html_text() %>% paste(collapse = ", ") - str_expect <- "Vignettes, Report Bugs, Source Control, License, NEWS file, Website, Documentation, Dependencies, NEWS current, Maintainer, Bugs Closure Rate, Test Coverage, First Version Release*, Reverse Dependencies, Latest Version Release*, Monthly downloads trend*, Package Downloads, Dependencies Uploaded*, Type Summary*, Base-R Packages*" + str_expect <- "Vignettes, Report Bugs, Source Control, License, NEWS file, Website, Documentation, Dependencies, NEWS current, Maintainer, Bugs Closure Rate, Test Coverage, First Version Release*, Reverse Dependencies, Latest Version Release*, Monthly downloads trend*, Package Downloads, Dependencies Uploaded*, Base-R Packages*, Type Summary*, Decision Summary*" expect_equal(maint_info, str_expect) app$stop() diff --git a/tests/testthat/test-utils_get_db.R b/tests/testthat/test-utils_get_db.R index 208fc908..38915ffa 100644 --- a/tests/testthat/test-utils_get_db.R +++ b/tests/testthat/test-utils_get_db.R @@ -81,7 +81,7 @@ test_that("utils_get_db functions other than dbSelect", { test_that("get_mm_data works", { mmdata <- get_metric_data(pkg_name, metric_class = "maintenance", db_name = app_db_loc) expect_s3_class(mmdata, "data.frame") - expect_equal(names(mmdata), c("name", "is_perc", "is_url", "value", "title", "desc", "score", "succ_icon", "unsucc_icon", "icon_class")) + expect_equal(names(mmdata), c("name", "is_perc", "is_url", "value", "type", "title", "desc", "score", "succ_icon", "unsucc_icon", "icon_class")) expect_equal(mmdata$name[1], "has_vignettes") }) diff --git a/vignettes/Deployment.Rmd b/vignettes/Deployment.Rmd index 151605ef..86d92c8b 100644 --- a/vignettes/Deployment.Rmd +++ b/vignettes/Deployment.Rmd @@ -155,7 +155,7 @@ Feel free to use this information as you see fit! Similar to the `assessment_db` ```yml default: assessment_db: ./dev/database.sqlite - assessment_db: ./dev/loggit.json + loggit_json: ./dev/loggit.json ```
@@ -170,7 +170,7 @@ Similar to the assessment database, when the `riskassessment::run_app()` functio ```yml default: assessment_db: ./dev/database.sqlite - assessment_db: ./dev/loggit.json + loggit_json: ./dev/loggit.json credential_db: ./dev/credentials.sqlite ``` @@ -201,32 +201,62 @@ Note the ["User Roles and Privileges" guide](../articles/User_Roles_and_Privileg ### Decisions configuration -The **decisions** element contains up to three sub-elements: **categories** (mandatory), **rules**, and **colors**. Here is a snipped from one of the example configurations: +The **decisions** element contains up to three sub-elements: **categories** (mandatory), **rules**, and **colors**. Here is an example configuration we'll walk through together: ```yml decisions: categories: - - Insignificant Risk - - Minor Risk - - Moderate Risk - - Major Risk - - Severe Risk - rules: - Insignificant Risk: - - 0 - - .1 - Severe Risk: - - .7 - - 1 + - Insignificant Risk + - Minor Risk + - Needs Review + - Moderate Risk + - Major Risk + - Severe Risk + rules: + rule_1: + metric: bugs_status + condition: ~ metric_score(.x) <= .25 + decision: Severe Risk + rule_2: + metric: dependencies + condition: ~ length(.x) >= 30 + decision: Major Risk + rule_3: + metric: has_vignettes + condition: ~ .x == 0 + decision: Moderate Risk + Severe Risk: + - .7 + - 1 + Insignificant Risk: + - 0 + - .1 + rule_else: + decision: Needs Review colors: Moderate Risk: !expr grDevices::rgb(52, 235, 229, maxColorValue = 255) ``` +#### Categories -Notice that you can set as many decision `categories` as you wish, but you must specify at least two! If you want to set up automatic decision rules before deploying the app, you can do so using the `rules` element. Just list the category name and underneath it, a mutually exclusive range of values so that when a package is uploaded, if it's risk score falls between those values, it will automatically get labelled with the appropriate decision. Categories not addressed under the `rules` banner will not receive automated decisions. However, users with this privilege can change this configuration in the app at a later time. +Notice that you can set as many decision `categories` as you wish, but you must specify at least two! It's suggested that the category names you define should be ordinal in some way, where the first category is the lowest risk designation and the last category is the highest risk. In the example configuration above, you can see the categories are defined with a low risk category of "Insignificant Risk" and a high risk category of "Severe Risk". If you have a non-ordinal category you'd like to use, like "Needs Review" for example, that's possible - just don't list it first or last. -Similarly for `colors`, you can detail specific colors be assigned to certain categories. If you don't care what color is used for each category, then a color-blind friendly color palette is used to fill in the rest. +#### Rules + +Using the `rules` element, you may set up with automated decision rules prior to launching the app. That is, when a package is uploaded, it will automatically get labelled with the appropriate decision when a `rules` condition is met. These rules are executed in order, from top-to-bottom, so it's important to place rules with greatest priority at the top of the list. To implement a decision based on risk score, list the category name and then a mutually exclusive range of values directly beneath it to label those packages whose risk score falls between those two values. Above, we've defined rules that dictate risk scores between 0.7 and 1 should automatically be categorized as "Severe Risk". Similarly, packages scoring between 0 and 0.1 should get labelled "Insignificant Risk". + +In addition, the configuration file can evaluate expressions to define rules. To do so, the rule needs three elements: `metric`, `condition`, and `decision` as seen above. The `metric` element is simply the name of the `riskmetric` assessment you'd like to evaluate. Next, provide the R code (including `riskmetric` code) to help define your rules using formula syntax. Note: `.x` will be translated to to the selected `metric`'s assessment value. If you wish to convert this to a metric score, use `riskmetric::metric_score(.x)` as shown above. Last, provide the decision category to apply when this condition is met. Above, we specified hypothetical rules 1 - 3 that apply decisions in this manner; Below, we spell out these expressions in sentence format, taking into account that when the previous condition isn't met: + +- packages with a bug closure rate less than 25% should be considered "Severe Risk" +- packages with more than 30 dependencies (and >25% bug close rate) are "Major Risk" +- packages with no vignettes (and <30 dependencies and >25% bug close rate) are"Moderate Risk" + +Categories not addressed under the `rules` banner will not receive automated decisions. However, you can provide an optional `rule_else` element to define a decision category to apply to any packages that don't meet the rules above it. Also, keep in mind that users with privileges to edit decision rules may change any of these configuration in the app at a later time. + +#### Colors + +Last, using the `colors` element you can detail specific colors be assigned to certain categories. Notice that this element will accept an expression to evaluate when launching the application. If you don't care what color is used for a category, then a color-blind friendly color palette is used to fill in those categories not specified.