From 31fbfa5c9ad8f3ea9813843b3f8eaecb235e4462 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Tue, 4 Jun 2024 11:11:24 -0400 Subject: [PATCH 01/21] update some stuff... --- R/mod_downloadHandler.R | 5 ++- R/mod_packageDependencies.R | 57 +++++++++++++++++++++++++------ R/mod_reportPreview.R | 5 ++- R/utils.R | 4 +-- R/utils_build_cards.R | 67 +++++++++++++++++++++++++++++++++---- R/utils_get_db.R | 47 ++++++++++++++++++++++---- man/build_dep_cards.Rd | 2 +- 7 files changed, 158 insertions(+), 29 deletions(-) diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R index 07f88b5b8..bd7072136 100644 --- a/R/mod_downloadHandler.R +++ b/R/mod_downloadHandler.R @@ -277,7 +277,10 @@ 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"), + fun_session = session) dep_cards <- build_dep_cards(data = dep_metrics, loaded = session$userData$loaded2_db()$name, toggled = session$userData$suggests()) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index c6cfd7903..2956dbaaa 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 @@ -96,8 +130,10 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren # send either depends() or both to build_dep_cards(), depending on toggled() if (toggled() == 0L) { cards(build_dep_cards(data = depends(), loaded = session$userData$loaded2_db()$name, toggled = 0L)) + # print(depends()) } else { cards(build_dep_cards(data = dplyr::bind_rows(depends(), suggests()), loaded = session$userData$loaded2_db()$name, toggled = 1L)) + # print(suggests()) } }) @@ -139,10 +175,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) diff --git a/R/mod_reportPreview.R b/R/mod_reportPreview.R index 409709158..b6ed27645 100644 --- a/R/mod_reportPreview.R +++ b/R/mod_reportPreview.R @@ -450,7 +450,10 @@ 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"), + fun_session = session) }) dep_cards <- eventReactive(dep_metrics(), { diff --git a/R/utils.R b/R/utils.R index ca7ab8ada..f6ef6e18d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -585,11 +585,11 @@ 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 + if("decision" %in% colnames(data)) data <- data %>% mutate(decision = dplyr::if_else(is.na(decision) | toupper(decision) == "NA", "", decision)) formattable::as.datatable( formattable::formattable( - data %>% - mutate(decision = if_else(is.na(decision) | toupper(decision) == "NA", "", decision)), + data, list( score = formattable::formatter( "span", diff --git a/R/utils_build_cards.R b/R/utils_build_cards.R index fd45ca8d1..ca8687be7 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 and other info #' #' @import dplyr #' @importFrom glue glue @@ -256,7 +256,9 @@ build_dep_cards <- function(data, loaded, toggled){ is_url = numeric(), type = character() ) + # req(data) + # print(data) deps <- data %>% mutate(base = if_else(name %in% c(rownames(installed.packages(priority = "base"))), "Base", "Non-Base")) %>% mutate(non_base = ifelse(base != "Base", 1, 0)) %>% @@ -264,7 +266,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)) @@ -272,6 +273,7 @@ build_dep_cards <- function(data, loaded, toggled){ deps <- deps %>% mutate(type = factor(type, levels = c("Imports", "Depends", "LinkingTo", "Suggests"), ordered = TRUE)) } + print(deps) # Card 1: Dependencies Uploaded upld_dat <- @@ -343,21 +345,21 @@ 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") - + base_cat_rows <- y3 %>% mutate(cnt = ifelse(is.na(name), 0, 1)) %>% group_by(base) %>% summarize(base_cat_sum = sum(cnt)) %>% ungroup() %>% - mutate(base_cat_pct = 100 * (base_cat_sum / nrow(deps))) %>% + mutate(base_cat_pct = 100 * (base_cat_sum / nrow(deps))) %>% mutate(base_cat_disp = if_else(is.nan(base_cat_pct), glue::glue('{base_cat_sum} ( 0%) '), - glue::glue('{base_cat_sum} ({format(base_cat_pct, digits = 1)}%)'))) %>% - filter(base == "Base") %>% + glue::glue('{base_cat_sum} ({format(base_cat_pct, digits = 1)}%)'))) %>% + filter(base == "Base") %>% pull(base_cat_disp) %>% paste(., collapse = "\n") - + cards <- cards %>% dplyr::add_row( name = 'base_cat_count', @@ -371,7 +373,58 @@ build_dep_cards <- function(data, loaded, toggled){ is_url = 0 ) + + # Card 4: Base-R Packages + + 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 <- tibble::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_rows0 <- + 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) %>% + 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) + print(dec_cat_rows0) + if(nrow(dec_cat_rows0) == 0) { + dec_cat_rows <- "No Decisions" + } else { + dec_cat_rows <- dec_cat_rows0 %>% + 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 = 'boxes-stacked', + icon_class = "text-info", # this gets overwritten by `type` arg below + is_perc = 0, + is_url = 0, + type = if_else(pull(upld_dat, upld_non_base_pct) < 100, "danger", "information") + ) + + + # return cards object cards + } diff --git a/R/utils_get_db.R b/R/utils_get_db.R index 2e3708791..c9496c625 100644 --- a/R/utils_get_db.R +++ b/R/utils_get_db.R @@ -245,31 +245,65 @@ 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 fun_session a shiny session object #' #' @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'), + fun_session){ 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, 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 + } + 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, 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 + } + 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 +413,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/man/build_dep_cards.Rd b/man/build_dep_cards.Rd index aa2ee83ae..2c2304415 100644 --- a/man/build_dep_cards.Rd +++ b/man/build_dep_cards.Rd @@ -9,7 +9,7 @@ build_dep_cards(data, loaded, toggled) \arguments{ \item{data}{a data.frame} -\item{loaded}{a vector of package names loaded to db} +\item{loaded}{a vector of package names and other info} } \description{ The 'Build Dependency Cards' function From cf9fa21ccf925f146ea85d29e007d03091e56155 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Tue, 4 Jun 2024 16:02:46 -0400 Subject: [PATCH 02/21] remove redundant line of code --- R/utils.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 765c101cb..964400656 100644 --- a/R/utils.R +++ b/R/utils.R @@ -588,8 +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 - if("decision" %in% colnames(data)) data <- data %>% mutate(decision = dplyr::if_else(is.na(decision) | toupper(decision) == "NA", "", decision)) - + formattable::as.datatable( formattable::formattable( data, From 4ff9eeacf5d9dfe0329679429e333a48a5f5bdd3 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 09:06:03 -0400 Subject: [PATCH 03/21] add vignette and fix issues with code to get the dep card rendering correctly --- R/mod_packageDependencies.R | 2 -- R/utils_build_cards.R | 30 ++++++++--------- R/utils_get_db.R | 4 +-- dev/run_dev.R | 2 +- man/build_dep_cards.Rd | 2 +- vignettes/Deployment.Rmd | 64 +++++++++++++++++++++++++++---------- 6 files changed, 65 insertions(+), 39 deletions(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index 905141184..992a4530e 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -130,10 +130,8 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren # send either depends() or both to build_dep_cards(), depending on toggled() if (toggled() == 0L) { cards(build_dep_cards(data = depends(), loaded = session$userData$loaded2_db()$name, toggled = 0L)) - # print(depends()) } else { cards(build_dep_cards(data = dplyr::bind_rows(depends(), suggests()), loaded = session$userData$loaded2_db()$name, toggled = 1L)) - # print(suggests()) } }) diff --git a/R/utils_build_cards.R b/R/utils_build_cards.R index ca8687be7..6fb7400d6 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 and other info +#' @param loaded a vector of package names loaded to db #' #' @import dplyr #' @importFrom glue glue @@ -256,9 +256,8 @@ build_dep_cards <- function(data, loaded, toggled){ is_url = numeric(), type = character() ) - # req(data) + - # print(data) deps <- data %>% mutate(base = if_else(name %in% c(rownames(installed.packages(priority = "base"))), "Base", "Non-Base")) %>% mutate(non_base = ifelse(base != "Base", 1, 0)) %>% @@ -273,7 +272,6 @@ build_dep_cards <- function(data, loaded, toggled){ deps <- deps %>% mutate(type = factor(type, levels = c("Imports", "Depends", "LinkingTo", "Suggests"), ordered = TRUE)) } - print(deps) # Card 1: Dependencies Uploaded upld_dat <- @@ -352,14 +350,14 @@ build_dep_cards <- function(data, loaded, toggled){ group_by(base) %>% summarize(base_cat_sum = sum(cnt)) %>% ungroup() %>% - mutate(base_cat_pct = 100 * (base_cat_sum / nrow(deps))) %>% + mutate(base_cat_pct = 100 * (base_cat_sum / nrow(deps))) %>% mutate(base_cat_disp = if_else(is.nan(base_cat_pct), glue::glue('{base_cat_sum} ( 0%) '), - glue::glue('{base_cat_sum} ({format(base_cat_pct, digits = 1)}%)'))) %>% - filter(base == "Base") %>% + glue::glue('{base_cat_sum} ({format(base_cat_pct, digits = 1)}%)'))) %>% + filter(base == "Base") %>% pull(base_cat_disp) %>% paste(., collapse = "\n") - + cards <- cards %>% dplyr::add_row( name = 'base_cat_count', @@ -384,13 +382,13 @@ build_dep_cards <- function(data, loaded, toggled){ dplyr::pull(decision) - dec_cat_rows0 <- + 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) %>% + 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))) %>% @@ -398,11 +396,11 @@ build_dep_cards <- function(data, loaded, toggled){ glue::glue('{dec_cat}: {dec_cat_sum} ( 0%)'), glue::glue('{dec_cat}: {dec_cat_sum} ({format(dec_cat_pct, digits = 1)}%)'))) %>% arrange(dec_cat) - print(dec_cat_rows0) - if(nrow(dec_cat_rows0) == 0) { + + if(nrow(dec_cat_dat) == 0) { dec_cat_rows <- "No Decisions" } else { - dec_cat_rows <- dec_cat_rows0 %>% + dec_cat_rows <- dec_cat_dat %>% pull(dec_cat_disp) %>% paste(., collapse = " \n") } @@ -414,11 +412,11 @@ build_dep_cards <- function(data, loaded, toggled){ desc = 'Package Dependencies by Decision', value = dec_cat_rows, score = "NULL", - succ_icon = 'boxes-stacked', + succ_icon = 'rocket', icon_class = "text-info", # this gets overwritten by `type` arg below is_perc = 0, is_url = 0, - type = if_else(pull(upld_dat, upld_non_base_pct) < 100, "danger", "information") + type = if_else(any(pull(dec_cat_dat, dec_id) == max(decision_key$decision_id)), "danger", "information") ) diff --git a/R/utils_get_db.R b/R/utils_get_db.R index c9496c625..69bab9754 100644 --- a/R/utils_get_db.R +++ b/R/utils_get_db.R @@ -268,7 +268,7 @@ get_depends_data <- function(pkg_name, 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())) + deps_decision_data <- purrr::map_df(deep_ends$name, ~get_versnScore(.x, fun_session$userData$loaded2_db(), fun_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)) @@ -292,7 +292,7 @@ get_depends_data <- function(pkg_name, 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())) + sugg_decision_data <- purrr::map_df(shrug_jests$name, ~get_versnScore(.x, fun_session$userData$loaded2_db(), fun_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)) diff --git a/dev/run_dev.R b/dev/run_dev.R index 3a02c3636..92f199d23 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/man/build_dep_cards.Rd b/man/build_dep_cards.Rd index 2c2304415..aa2ee83ae 100644 --- a/man/build_dep_cards.Rd +++ b/man/build_dep_cards.Rd @@ -9,7 +9,7 @@ build_dep_cards(data, loaded, toggled) \arguments{ \item{data}{a data.frame} -\item{loaded}{a vector of package names and other info} +\item{loaded}{a vector of package names loaded to db} } \description{ The 'Build Dependency Cards' function diff --git a/vignettes/Deployment.Rmd b/vignettes/Deployment.Rmd index 151605efe..86d92c8b8 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.
From ca9817922715422fcfaa2bde4f0f8cc659deedbb Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 09:27:45 -0400 Subject: [PATCH 04/21] update loaded2_db object in test-packageDependencies.R to include decision_id & decsion variables --- tests/testthat/test-packageDependencies.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-packageDependencies.R b/tests/testthat/test-packageDependencies.R index bbb24f6c4..b49966815 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() From ded09af5e75fb3e2165099dca02f3fac2e7003fe Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 10:23:39 -0400 Subject: [PATCH 05/21] change layout of pcakge deps tab --- R/mod_packageDependencies.R | 130 +++++++++++++++++++----------------- R/utils_build_cards.R | 78 +++++++++++----------- 2 files changed, 107 insertions(+), 101 deletions(-) diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index 992a4530e..b712d68f0 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -231,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/utils_build_cards.R b/R/utils_build_cards.R index 6fb7400d6..3689c5082 100644 --- a/R/utils_build_cards.R +++ b/R/utils_build_cards.R @@ -340,47 +340,14 @@ 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") - - base_cat_rows <- - y3 %>% - mutate(cnt = ifelse(is.na(name), 0, 1)) %>% - group_by(base) %>% - summarize(base_cat_sum = sum(cnt)) %>% - ungroup() %>% - mutate(base_cat_pct = 100 * (base_cat_sum / nrow(deps))) %>% - mutate(base_cat_disp = if_else(is.nan(base_cat_pct), - glue::glue('{base_cat_sum} ( 0%) '), - glue::glue('{base_cat_sum} ({format(base_cat_pct, digits = 1)}%)'))) %>% - filter(base == "Base") %>% - pull(base_cat_disp) %>% - paste(., collapse = "\n") - - cards <- cards %>% - dplyr::add_row( - name = 'base_cat_count', - title = 'Base-R Packages', - desc = 'Percent of Packages from Base R', - value = base_cat_rows, - score = "NULL", - succ_icon = 'house-circle-check', - icon_class = "text-info", - is_perc = 0, - is_url = 0 - ) - - - # Card 4: Base-R Packages - + # 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 <- tibble::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 %>% @@ -393,8 +360,8 @@ build_dep_cards <- function(data, loaded, toggled){ 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)}%)'))) %>% + 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) { @@ -404,7 +371,7 @@ build_dep_cards <- function(data, loaded, toggled){ pull(dec_cat_disp) %>% paste(., collapse = " \n") } - + cards <- cards %>% dplyr::add_row( name = 'dec_cat_count', @@ -420,6 +387,41 @@ build_dep_cards <- function(data, loaded, toggled){ ) + # Card 4: Base-R Packages + x3 <- tibble("base" = levels(deps$base)) + y3 <- full_join(x3, deps, by = "base") + + base_cat_rows <- + y3 %>% + mutate(cnt = ifelse(is.na(name), 0, 1)) %>% + group_by(base) %>% + summarize(base_cat_sum = sum(cnt)) %>% + ungroup() %>% + mutate(base_cat_pct = 100 * (base_cat_sum / nrow(deps))) %>% + mutate(base_cat_disp = if_else(is.nan(base_cat_pct), + glue::glue('{base_cat_sum} ( 0%) '), + glue::glue('{base_cat_sum} ({format(base_cat_pct, digits = 1)}%)'))) %>% + filter(base == "Base") %>% + pull(base_cat_disp) %>% + paste(., collapse = "\n") + + cards <- cards %>% + dplyr::add_row( + name = 'base_cat_count', + title = 'Base-R Packages', + desc = 'Percent of Packages from Base R', + value = base_cat_rows, + score = "NULL", + succ_icon = 'house-circle-check', + icon_class = "text-info", + is_perc = 0, + is_url = 0 + ) + + + + + # return cards object cards From 5e5de05b0605198dd46822341ee122e6af776d75 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 11:12:04 -0400 Subject: [PATCH 06/21] Update package dependency layout in reports and fix redundancy in download handler and reportpreview mods --- R/mod_downloadHandler.R | 38 +++++++++++++++++--------- R/mod_reportPreview.R | 40 +++++++++++++++++++--------- inst/report_downloads/reportDocx.Rmd | 11 +++++++- inst/report_downloads/reportHtml.Rmd | 2 ++ inst/report_downloads/reportPdf.Rmd | 9 +++++++ 5 files changed, 74 insertions(+), 26 deletions(-) diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R index 07d10bec7..616759f3c 100644 --- a/R/mod_downloadHandler.R +++ b/R/mod_downloadHandler.R @@ -284,17 +284,31 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){ 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() - } + # this is now down inside of get_depends_data() + # dep_table <- + # if (nrow(dep_metrics) == 0) { + # dplyr::tibble(package = character(), type = character(), version = character(), score = character(), decision = character()) + # } else { + # + # # deps_decision_data <- purrr::map_df(dep_metrics$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 + # # } + # # deps_w_decision %>% + # # right_join(dep_metrics, by = "name") %>% + # # select(package, type, name, version, score, decision) %>% + # # arrange(name, type) %>% + # # distinct() + # 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( @@ -320,7 +334,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_reportPreview.R b/R/mod_reportPreview.R index b6ed27645..245fbb524 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), custom_dom = "t", pLength = list(-1), PlChange = FALSE, colnames = c("Package", "Type", "Version", "Score", "Decision")) } @@ -464,18 +464,32 @@ 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() - }) + # dep_table <- eventReactive(dep_metrics(), { + # req(dep_metrics()) + # + # if (nrow(dep_metrics()) == 0) + # return(dplyr::tibble(package = character(), type = character(), version = character(), score = character(), decision = character())) + # + # + # # deps_decision_data <- purrr::map_df(dep_metrics()$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 + # # } + # # deps_w_decision %>% + # # right_join(dep_metrics(), by = "name") %>% + # # select(package, type, name, version, score, decision) %>% + # # arrange(name, type) %>% + # # distinct() + # + # 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/inst/report_downloads/reportDocx.Rmd b/inst/report_downloads/reportDocx.Rmd index b0f273944..7b541831d 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 2797b999c..3bc210c5e 100644 --- a/inst/report_downloads/reportHtml.Rmd +++ b/inst/report_downloads/reportHtml.Rmd @@ -371,6 +371,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 773a5c325..4775d8a15 100644 --- a/inst/report_downloads/reportPdf.Rmd +++ b/inst/report_downloads/reportPdf.Rmd @@ -298,6 +298,15 @@ 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 %>% From ceff7a528c7056f526e9dca309dc5722ca2b478c Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 11:13:21 -0400 Subject: [PATCH 07/21] remove old redundant code --- R/mod_downloadHandler.R | 25 ------------------------- R/mod_reportPreview.R | 26 -------------------------- 2 files changed, 51 deletions(-) diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R index 616759f3c..8fd836d1c 100644 --- a/R/mod_downloadHandler.R +++ b/R/mod_downloadHandler.R @@ -284,31 +284,6 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){ dep_cards <- build_dep_cards(data = dep_metrics, loaded = session$userData$loaded2_db()$name, toggled = session$userData$suggests()) - # this is now down inside of get_depends_data() - # dep_table <- - # if (nrow(dep_metrics) == 0) { - # dplyr::tibble(package = character(), type = character(), version = character(), score = character(), decision = character()) - # } else { - # - # # deps_decision_data <- purrr::map_df(dep_metrics$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 - # # } - # # deps_w_decision %>% - # # right_join(dep_metrics, by = "name") %>% - # # select(package, type, name, version, score, decision) %>% - # # arrange(name, type) %>% - # # distinct() - # 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( diff --git a/R/mod_reportPreview.R b/R/mod_reportPreview.R index 245fbb524..4fda1df2b 100644 --- a/R/mod_reportPreview.R +++ b/R/mod_reportPreview.R @@ -464,32 +464,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(), decision = character())) - # - # - # # deps_decision_data <- purrr::map_df(dep_metrics()$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 - # # } - # # deps_w_decision %>% - # # right_join(dep_metrics(), by = "name") %>% - # # select(package, type, name, version, score, decision) %>% - # # arrange(name, type) %>% - # # distinct() - # - # 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()) From ce79874e139f20070bbb165bea0f0819b0b1a37f Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 11:39:30 -0400 Subject: [PATCH 08/21] fix one failing test and add global variables --- R/global.R | 5 +++++ tests/testthat/test-reportPreview.R | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/R/global.R b/R/global.R index e5820e98a..e4d0582ed 100644 --- a/R/global.R +++ b/R/global.R @@ -60,6 +60,8 @@ utils::globalVariables( 'Name', 'new_role', 'new_weight', + 'non_base', + 'non_base_sum', 'old_role', 'package', 'Package', @@ -84,6 +86,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/tests/testthat/test-reportPreview.R b/tests/testthat/test-reportPreview.R index e91d769c6..a424a2a09 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() From 7e3d99b2c262d25a8d96362f2c9aad253e76e745 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 11:52:02 -0400 Subject: [PATCH 09/21] update wordlist --- inst/WORDLIST | 2 -- 1 file changed, 2 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index a5b1ad683..50dbc6694 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 From ffe957cd477ab460cb910be5a03efee3e5d2b5d1 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 5 Jun 2024 11:55:57 -0400 Subject: [PATCH 10/21] remove rougue tibble::tibble() call, and use dplyr:: prefix there and on all other tibble() and as_tibble() calls. --- R/global.R | 5 +++++ R/mod_packageDependencies.R | 4 ++-- R/utils_build_cards.R | 6 +++--- R/utils_insert_db.R | 2 +- 4 files changed, 11 insertions(+), 6 deletions(-) diff --git a/R/global.R b/R/global.R index e4d0582ed..af4764e11 100644 --- a/R/global.R +++ b/R/global.R @@ -34,9 +34,14 @@ utils::globalVariables( 'day_month_year', 'decision', 'decision_by', + 'dec_cat', + 'dec_cat_sum', + 'dec_cat_pct', + 'dec_cat_disp', 'decision_cat_disp', 'decision_cat_sum', 'decision_date', + 'decision_id', 'description', 'description', 'downloads', diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R index b712d68f0..78f6ed05a 100644 --- a/R/mod_packageDependencies.R +++ b/R/mod_packageDependencies.R @@ -149,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", " ")) %>% diff --git a/R/utils_build_cards.R b/R/utils_build_cards.R index 3689c5082..48ff9ae8e 100644 --- a/R/utils_build_cards.R +++ b/R/utils_build_cards.R @@ -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)) @@ -342,7 +342,7 @@ build_dep_cards <- function(data, loaded, toggled){ # 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 <- tibble::tibble(decision = decision_lst) |> + 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)) |> @@ -388,7 +388,7 @@ build_dep_cards <- function(data, loaded, toggled){ # Card 4: Base-R Packages - x3 <- tibble("base" = levels(deps$base)) + x3 <- dplyr::tibble("base" = levels(deps$base)) y3 <- full_join(x3, deps, by = "base") base_cat_rows <- diff --git a/R/utils_insert_db.R b/R/utils_insert_db.R index 70827ce54..5ed7d1700 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) From 75b844d0a43ba49a10baeab4cb0e5aa8a7542a94 Mon Sep 17 00:00:00 2001 From: Github Actions Date: Wed, 5 Jun 2024 16:30:53 +0000 Subject: [PATCH 11/21] Re-build manifest file --- manifest.json | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/manifest.json b/manifest.json index 095bae70e..4f5945479 100644 --- a/manifest.json +++ b/manifest.json @@ -6400,13 +6400,13 @@ "checksum": "d3436d70ab382e65f2979ca0c4c20041" }, "inst/report_downloads/reportDocx.Rmd": { - "checksum": "788fc881cc4446504a88888fa55e2cfa" + "checksum": "449e8dcb07732ecd9a0963bada90e53e" }, "inst/report_downloads/reportHtml.Rmd": { - "checksum": "dc9c51d3badaf67a4f13fe5a5bbb57f4" + "checksum": "65972e4c1beeea7e91fcfc668503196b" }, "inst/report_downloads/reportPdf.Rmd": { - "checksum": "86b922fc17ccc912a82a6cb881281b0a" + "checksum": "ecb9a19c6264832e7c8a9d39143335f5" }, "inst/sql_queries/create_comments_table.sql": { "checksum": "514c169e358f7613d8026e6a9fd211ce" @@ -6451,7 +6451,7 @@ "checksum": "5fc0bfdb844b4ce7df8a183e2a4a2f96" }, "inst/WORDLIST": { - "checksum": "ad214434052cd9e20e2542994162b5f7" + "checksum": "52903eb411c9301dc68168bbca5bc4c1" }, "LICENSE": { "checksum": "ab496eda3728cf54db7cbf3e6f752572" @@ -6475,7 +6475,7 @@ "checksum": "50d68f46171151cd36457a7154e5a7a3" }, "R/global.R": { - "checksum": "3b969b3b79cfdf02d2a66fe78b3106c5" + "checksum": "87f66254b0afb272fd6321659259cdc4" }, "R/mod_aboutInfo_utils.R": { "checksum": "23ff3c99869bd59ed973d031ee2962fd" @@ -6508,7 +6508,7 @@ "checksum": "e22e1f4c044bc9f11c46a5fcdba33063" }, "R/mod_downloadHandler.R": { - "checksum": "923e810fb1c8c7afe2d111cd42703579" + "checksum": "c568d64e82a40cb5b84bd185f93e97a1" }, "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": "d6067e801094b87feebddfa0b05b45d4" }, "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": "6483b7bae8a58e0bea456acb68f16bc3" }, "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" From 07cf1499861f36121f7eec4b071022e41c16e8c0 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Thu, 6 Jun 2024 12:00:07 -0400 Subject: [PATCH 12/21] fix type class in html reports --- inst/report_downloads/reportHtml.Rmd | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/inst/report_downloads/reportHtml.Rmd b/inst/report_downloads/reportHtml.Rmd index 3bc210c5e..a760fda14 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] ) }) }), From 3c1e88fed3e316bb0dc978789aa7c9e3b169ef84 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Thu, 6 Jun 2024 12:42:47 -0400 Subject: [PATCH 13/21] reconfigure pdf report and get_depends_data() --- R/mod_downloadHandler.R | 4 +++- R/mod_reportPreview.R | 6 ++++-- R/utils.R | 5 +++++ R/utils_get_db.R | 13 +++++++++---- inst/report_downloads/reportPdf.Rmd | 2 +- 5 files changed, 22 insertions(+), 8 deletions(-) diff --git a/R/mod_downloadHandler.R b/R/mod_downloadHandler.R index 8fd836d1c..7975c299b 100644 --- a/R/mod_downloadHandler.R +++ b/R/mod_downloadHandler.R @@ -280,7 +280,9 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){ dep_metrics <- get_depends_data(this_pkg, session$userData$suggests(), db_name = golem::get_golem_options("assessment_db_name"), - fun_session = session) + 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()) diff --git a/R/mod_reportPreview.R b/R/mod_reportPreview.R index 4fda1df2b..acaa0782a 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_metrics() |> select(-decision_id), custom_dom = "t", 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")) } @@ -453,7 +453,9 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics, get_depends_data(selected_pkg$name(), session$userData$suggests(), db_name = golem::get_golem_options("assessment_db_name"), - fun_session = session) + loaded2_db = session$userData$loaded2_db(), + repo_pkgs = session$userData$repo_pkgs() + ) }) dep_cards <- eventReactive(dep_metrics(), { diff --git a/R/utils.R b/R/utils.R index 964400656..e8f552124 100644 --- a/R/utils.R +++ b/R/utils.R @@ -579,6 +579,11 @@ datatable_custom <- function( stopifnot(is.character(colnames)) colnames <- if(length(colnames) == 0) names(data) else colnames if(length(colnames) != ncol(data)) { + print("\ncolnames:") + print(colnames) + print("\nnames(data):") + print(names(data)) + print(data) warning("number of provided colnames unequal to number of columns in data. Defaulting to original data frame names.") colnames <- names(data) diff --git a/R/utils_get_db.R b/R/utils_get_db.R index 69bab9754..87ab285aa 100644 --- a/R/utils_get_db.R +++ b/R/utils_get_db.R @@ -245,7 +245,8 @@ 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 fun_session a shiny session object +#' @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 @@ -255,7 +256,11 @@ get_metric_data <- function(pkg_name, metric_class = 'maintenance', db_name = go get_depends_data <- function(pkg_name, suggests, db_name = golem::get_golem_options('assessment_db_name'), - fun_session){ + 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")) @@ -268,7 +273,7 @@ get_depends_data <- function(pkg_name, 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, fun_session$userData$loaded2_db(), fun_session$userData$repo_pkgs())) + 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)) @@ -292,7 +297,7 @@ get_depends_data <- function(pkg_name, 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, fun_session$userData$loaded2_db(), fun_session$userData$repo_pkgs())) + 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)) diff --git a/inst/report_downloads/reportPdf.Rmd b/inst/report_downloads/reportPdf.Rmd index 4775d8a15..8f9cdbeff 100644 --- a/inst/report_downloads/reportPdf.Rmd +++ b/inst/report_downloads/reportPdf.Rmd @@ -291,7 +291,7 @@ 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") } ``` From 81a03998f329c2a8b2a682fac34252b0f614b443 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Thu, 6 Jun 2024 12:59:33 -0400 Subject: [PATCH 14/21] fix global var without binding --- R/global.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/global.R b/R/global.R index af4764e11..b3a375682 100644 --- a/R/global.R +++ b/R/global.R @@ -38,6 +38,7 @@ utils::globalVariables( 'dec_cat_sum', 'dec_cat_pct', 'dec_cat_disp', + 'dec_id', 'decision_cat_disp', 'decision_cat_sum', 'decision_date', From 45c824d01a491fb164a1073ebcbb4506d7a8f7e0 Mon Sep 17 00:00:00 2001 From: Github Actions Date: Thu, 6 Jun 2024 18:47:45 +0000 Subject: [PATCH 15/21] Re-build manifest file --- manifest.json | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/manifest.json b/manifest.json index 779cc5949..acf9177f5 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-06 18:46:47 UTC; unix" } }, "reprex": { @@ -6403,10 +6403,10 @@ "checksum": "449e8dcb07732ecd9a0963bada90e53e" }, "inst/report_downloads/reportHtml.Rmd": { - "checksum": "65972e4c1beeea7e91fcfc668503196b" + "checksum": "0e49db815a61c6698acad37894a9c0c1" }, "inst/report_downloads/reportPdf.Rmd": { - "checksum": "ecb9a19c6264832e7c8a9d39143335f5" + "checksum": "3c7cfa456a7a171df1f10f9c1690718c" }, "inst/sql_queries/create_comments_table.sql": { "checksum": "514c169e358f7613d8026e6a9fd211ce" @@ -6475,7 +6475,7 @@ "checksum": "50d68f46171151cd36457a7154e5a7a3" }, "R/global.R": { - "checksum": "87f66254b0afb272fd6321659259cdc4" + "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" @@ -6541,7 +6541,7 @@ "checksum": "dbbfdfde47d106e0deaf20822c69bf94" }, "R/mod_reportPreview.R": { - "checksum": "d6067e801094b87feebddfa0b05b45d4" + "checksum": "1fff75a23e54c9d8dac895731b03ac3a" }, "R/mod_reweightView.R": { "checksum": "d3988b7b6168f0560dc9525f1c6138ed" @@ -6571,7 +6571,7 @@ "checksum": "74cf2ee5e7283483a88f08d60e3728b0" }, "R/utils_get_db.R": { - "checksum": "6483b7bae8a58e0bea456acb68f16bc3" + "checksum": "06aec1c0da86324550c33f54e9c6fd68" }, "R/utils_insert_db.R": { "checksum": "d890c439c8ece5dd9236681efee4ab9c" @@ -6580,7 +6580,7 @@ "checksum": "b689ee96f0761480ac65ca22cbbb4980" }, "R/utils.R": { - "checksum": "995d947896038bdcec381ff4b4e94fd0" + "checksum": "73970f1dc6224cd251eff059748a8a7c" }, "README.md": { "checksum": "d7e84fce2c891619912b6cc552eecc94" From ca81eaa3c2506d2fe55f53512509eedf94a62b0d Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Mon, 10 Jun 2024 10:58:26 -0400 Subject: [PATCH 16/21] update get_metric_data() to include 'type' column --- R/utils_get_db.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/utils_get_db.R b/R/utils_get_db.R index 87ab285aa..04f957d7a 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 From 1e5bcc13d16d72387a4159188caf34b1cc5aeeaf Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Mon, 10 Jun 2024 11:24:52 -0400 Subject: [PATCH 17/21] fix missing 'type' field in mm_data --- tests/testthat/test-utils_get_db.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-utils_get_db.R b/tests/testthat/test-utils_get_db.R index 208fc9084..38915ffae 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") }) From 7e98214ac123c4fcc73f5fe51a2ca465e5a2bc8c Mon Sep 17 00:00:00 2001 From: Github Actions Date: Mon, 10 Jun 2024 15:42:33 +0000 Subject: [PATCH 18/21] Re-build manifest file --- manifest.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/manifest.json b/manifest.json index acf9177f5..46bbfa39f 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 18:46:47 UTC; unix" + "Built": "R 4.3.3; ; 2024-06-10 15:41:43 UTC; unix" } }, "reprex": { @@ -6571,7 +6571,7 @@ "checksum": "74cf2ee5e7283483a88f08d60e3728b0" }, "R/utils_get_db.R": { - "checksum": "06aec1c0da86324550c33f54e9c6fd68" + "checksum": "6e87d4d43f93b4a4b556d72b848dc3f1" }, "R/utils_insert_db.R": { "checksum": "d890c439c8ece5dd9236681efee4ab9c" From 2b739e2cd5bdab73ae42da917174c9d9364f86a5 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 12 Jun 2024 14:41:02 -0400 Subject: [PATCH 19/21] Increment version number to 3.0.0.9024 --- DESCRIPTION | 2 +- NEWS.md | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index fd83d1722..20686c2b5 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 bf828f38b..a54f0b211 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) From eeebb1ed94f66ad5c37e0d8a58d3dd6900a5ec52 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 12 Jun 2024 14:41:34 -0400 Subject: [PATCH 20/21] remove print statements --- R/utils.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/utils.R b/R/utils.R index e8f552124..964400656 100644 --- a/R/utils.R +++ b/R/utils.R @@ -579,11 +579,6 @@ datatable_custom <- function( stopifnot(is.character(colnames)) colnames <- if(length(colnames) == 0) names(data) else colnames if(length(colnames) != ncol(data)) { - print("\ncolnames:") - print(colnames) - print("\nnames(data):") - print(names(data)) - print(data) warning("number of provided colnames unequal to number of columns in data. Defaulting to original data frame names.") colnames <- names(data) From e45bb6a21be61f44621d3411675dace104281167 Mon Sep 17 00:00:00 2001 From: Github Actions Date: Wed, 12 Jun 2024 18:44:34 +0000 Subject: [PATCH 21/21] Re-build manifest file --- manifest.json | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/manifest.json b/manifest.json index 46bbfa39f..2c664be67 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-10 15:41:43 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" @@ -6463,7 +6463,7 @@ "checksum": "97d1232340e04c53088bc8f814133dcd" }, "NEWS.md": { - "checksum": "f9bc97131b3753ea173bff4248b97e1f" + "checksum": "0acbd76cb19bc0ce397df38b33006e6d" }, "R/app_config.R": { "checksum": "c2b61f270b86b6833f0ee39c44a1a440" @@ -6580,7 +6580,7 @@ "checksum": "b689ee96f0761480ac65ca22cbbb4980" }, "R/utils.R": { - "checksum": "73970f1dc6224cd251eff059748a8a7c" + "checksum": "995d947896038bdcec381ff4b4e94fd0" }, "README.md": { "checksum": "d7e84fce2c891619912b6cc552eecc94"