Merge pull request #14 from pharmaverse/get_fns_with_keyword

Adding `get_fns_with_keyword()` function

DESCRIPTION

@@ -14,13 +14,19 @@ URL: https://pharmaverse.github.io/admiraldiscovery/
 Depends:
     R (>= 4.1)
 Imports: 
+    admiral,
+    admiralonco, 
+    admiralophtha,
+    admiralvaccine,
     dplyr,
     glue,
     gt (>= 0.10.0),
     htmltools,
-    reactable
+    reactable,
+    rlang,
+    stringr,
+    tools
 Suggests: 
-    admiral,
     knitr,
     rmarkdown,
     spelling

NAMESPACE

@@ -1,12 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(get_admrial_deprecated)
+export(get_admrial_superseded)
+export(get_fns_with_keyword)
 export(interactive_discovery)
-importFrom(gt,cols_align)
-importFrom(gt,cols_hide)
-importFrom(gt,cols_label)
-importFrom(gt,cols_width)
-importFrom(gt,fmt_markdown)
-importFrom(gt,gt)
-importFrom(gt,opt_interactive)
-importFrom(gt,pct)
-importFrom(gt,sub_missing)
+importFrom(rlang,"%||%")
+importFrom(rlang,.data)
+importFrom(rlang,.env)

R/admiraldiscovery-package.R

@@ -1,8 +1,14 @@
 #' @keywords internal
-#' @importFrom gt gt cols_hide cols_label fmt_markdown sub_missing
-#'   opt_interactive cols_width pct cols_align
+#' @importFrom rlang .data .env %||%
 "_PACKAGE"
 
 ## usethis namespace: start
 ## usethis namespace: end
 NULL
+
+this_fn_is_not_used <- function() {
+  admiral::ae_event
+  admiralonco::bor_cr
+  admiralophtha::admiralophtha_adbcva
+  admiralvaccine::derive_vars_params
+}

R/get_fns_with_keyword.R

@@ -0,0 +1,89 @@
+#' Find Functions with Keyword
+#'
+#' @description
+#'
+#' `get_admrial_deprecated()`: Returns tibble of all deprecated functions in
+#'   the admiral, admiralonco, admiralophtha, and admiralvaccine packages.
+#'
+#' `get_admrial_superseded()`: Returns tibble of all superseded functions in
+#'   the admiral, admiralonco, admiralophtha, and admiralvaccine packages.
+#'
+#' `get_fns_with_keyword()`: Returns a character vector of functions that have
+#'   the passed keyword in the help file. For example, this function can be used to find all
+#'   deprecated or superseded functions in the admiral universe, as admiral
+#'   package include `#' @keywords deprecated` or `#' @keywords superseded`
+#'   in the function's roxygen2 comments.
+#'
+#' @inheritParams tools::Rd_db
+#' @param keyword string of the keyword to identify
+#'
+#' @return a character vector of function names
+#' @name get_keyword_fns
+#'
+#' @examples
+#' get_admrial_deprecated()
+#' get_admrial_superseded()
+#' get_fns_with_keyword(package = "admiral", keyword = "superseded")
+NULL
+
+#' @rdname get_keyword_fns
+#' @export
+get_admrial_deprecated <- function() {
+  c("admiral", "admiralonco", "admiralophtha", "admiralvaccine") |>
+    lapply(
+      function(x) {
+        dplyr::tibble(
+          package = x,
+          fn = get_fns_with_keyword(package = x, keyword = "deprecated") %||% NA_character_
+        )
+      }
+    ) |>
+    dplyr::bind_rows() |>
+    stats::na.omit()
+}
+
+#' @rdname get_keyword_fns
+#' @export
+get_admrial_superseded <- function() {
+  c("admiral", "admiralonco", "admiralophtha", "admiralvaccine") |>
+    lapply(
+      function(x) {
+        dplyr::tibble(
+          package = x,
+          fn = get_fns_with_keyword(package = x, keyword = "superseded") %||% NA_character_
+        )
+      }
+    ) |>
+    dplyr::bind_rows() |>
+    stats::na.omit()
+}
+
+#' @rdname get_keyword_fns
+#' @export
+get_fns_with_keyword <- function(package, keyword, lib.loc = NULL) {
+  # parse the help files in package
+  db <- tools::Rd_db(package = package)
+
+  # data frame of all exported functions with indicator column indicating if
+  # keyword appears in the help file
+  df_all_fns <-
+    dplyr::tibble(
+      rd_file_name = names(db),
+      rd_file_contents = lapply(.data$rd_file_name, function(x) db[[x]] |> as.character() |> paste(collapse = "")),
+      alias = lapply(.data$rd_file_contents, extract_alias), # these are the function names
+      has_keyword =
+        lapply(.data$rd_file_contents, function(x) stringr::str_detect(x, pattern = glue::glue("\\\\keyword\\{[[keyword]]\\}", .open = "[[", .close = "]]"))) |>
+        unlist()
+    )
+
+  # return vector of all functions with matching keyword in help file
+  df_all_fns |>
+    dplyr::filter(.data$has_keyword) |>
+    dplyr::pull(.data$alias) |>
+    unlist(recursive = TRUE)
+}
+
+
+extract_alias <- function(x) {
+  stringr::str_extract_all(x, "(?<=\\\\alias\\{)(.*?)(?=\\})")
+}

R/interactive.R

@@ -71,25 +71,43 @@ interactive_discovery <- function(type = c("gt", "reactable")) {
 
 .gt_discovery <- function() {
   admiraldiscovery::discovery |>
+    dplyr::left_join(
+      get_admrial_deprecated() |> dplyr::mutate(deprecated = TRUE),
+      by = c("package", "fn")
+    ) |>
+    dplyr::left_join(
+      get_admrial_superseded() |> dplyr::mutate(superseded = TRUE),
+      by = c("package", "fn")
+    ) |>
     dplyr::mutate(
       function_link = glue::glue("[`{package}::{fn}()`]({fn_url})"),
       .after = "fn_url"
     ) |>
     dplyr::mutate(
       resource1_link = glue::glue("[{resource1_text}]({resource1_url})")
     ) |>
-    gt() |>
-    cols_hide(columns = c("fn", "fn_url", "package", "dataset_type",
-                          "resource1_text", "resource1_url")) |>
-    cols_label(
+    gt::gt() |>
+    gt::cols_hide(columns = c("fn", "fn_url", "package", "dataset_type",
+                          "resource1_text", "resource1_url",
+                          "deprecated", "superseded")) |>
+    gt::cols_label(
       function_link = "Function",
       resource1_link = "Resources"
     ) |>
-    fmt_markdown(columns = c("function_link", "resource1_link")) |>
-    sub_missing(missing_text = "")  |>
-    cols_width(c(dataset, dataset_type, variable) ~ pct(8)) |>
-    cols_align(align = "left") |>
-    opt_interactive(
+    # color deprecated/superseded functions
+    gt::tab_style(
+      style = gt::cell_fill(color = '#ffb3ba'),
+      locations = gt::cells_body(columns = gt::everything(), rows = .data$deprecated)
+    ) |>
+    gt::tab_style(
+      style = gt::cell_fill(color = '#ffffba'),
+      locations = gt::cells_body(columns = gt::everything(), rows = .data$superseded)
+    ) |>
+    gt::fmt_markdown(columns = c("function_link", "resource1_link")) |>
+    gt::sub_missing(missing_text = "")  |>
+    gt::cols_width(c(dataset, dataset_type, variable) ~ gt::pct(8)) |>
+    gt::cols_align(align = "left") |>
+    gt::opt_interactive(
       use_search = TRUE,
       use_filters = TRUE,
       use_resizers = TRUE,

inst/WORDLIST

@@ -1,3 +1,8 @@
 ADaM
 ORCID
+admiralonco
+admiralophtha
+admiralvaccine
 reactable
+roxygen
+tibble