Merge pull request #787 from pharmaR/ac-774-p2

Dep Card: Decision Summary
pharmaR · Jun 13, 2024 · c250e68 · c250e68
2 parents 650dd61 + e45bb6a
commit c250e68
Show file tree

Hide file tree

Showing 20 changed files with 346 additions and 166 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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("<span class='h3 center txtasis'>FIRST-ORDER DEPENDENDENCIES OF {selected_pkg$name()}</span><br>")),
+            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("<span class='h3 center txtasis'>REVERSE DEPENDENDENCIES OF {selected_pkg$name()}</span><br>")),
+            # 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
@@ -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
@@ -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,