|
25 | 25 | #' # an html table with a CSS class "usedthese" |
26 | 26 | #' usedthese::used_here("mean(c(1, 2, 3))\nsum(c(1, 2, 3))") |
27 | 27 | #' |
28 | | -used_here <- \(fil = knitr::current_input()) { |
| 28 | +used_here <- \(fil = current_input()) { |
29 | 29 | if (is.null(fil)) { |
30 | | - rlang::abort( |
31 | | - "If you are knitting the current document, i.e. you clicked the Render button, then leave fil unspecified. If you are running the code chunks, then ensure you library the packages first in a fresh R session and specify the saved filename quoted.", |
32 | | - fil = fil |
33 | | - ) |
| 30 | + cli_abort(c( |
| 31 | + "`fil` must be either `current_input()` or a saved filename", |
| 32 | + "i" = "When knitting a qmd/Rmd, `fil` defaults to `current_input()`.", |
| 33 | + "i" = "When running a code chunk, quote a saved filename.", |
| 34 | + "x" = "You specified fil = {fil}." |
| 35 | + )) |
34 | 36 | } |
35 | 37 |
|
36 | 38 | old <- options(knitr.duplicate.label = "allow") |
37 | | - withr::defer(options(old)) |
| 39 | + defer(options(old)) |
38 | 40 |
|
39 | | - if (stringr::str_ends(fil, "Rmd|qmd|rmarkdown")) { |
40 | | - purrr::walk(fil, knitr::purl, quiet = TRUE, documentation = 0) |
| 41 | + if (str_ends(fil, "Rmd|qmd|rmarkdown")) { |
| 42 | + walk(fil, purl, quiet = TRUE, documentation = 0) |
| 43 | + fil <- str_replace(fil, "Rmd|qmd|rmarkdown", "R") |
| 44 | + } |
| 45 | + |
| 46 | + pkg_loaded <- .packages() |> set_names() |
| 47 | + funs_origin <- get_loaded_pkg_imports(pkg_loaded[pkg_loaded != "usedthese"]) |
| 48 | + funs_scouted <- conflict_scout() |> unlist() |> bind_rows() |
41 | 49 |
|
42 | | - fil <- stringr::str_replace(fil, "Rmd|qmd|rmarkdown", "R") |
| 50 | + if (nrow(funs_scouted) > 0) { |
| 51 | + funs_scouted <- summarise_funs_scouted(funs_scouted) |
| 52 | + } else { |
| 53 | + funs_scouted <- tibble(pkg_preferred = "zzz", func = "zzz") |
43 | 54 | } |
44 | 55 |
|
45 | | - pckg_loaded <- .packages() |> |
46 | | - rlang::set_names() |
| 56 | + funs_augmented <- pkg_loaded |> |
| 57 | + get_funs_loaded() |> |
| 58 | + augment_funs_loaded(funs_origin, funs_scouted) |
47 | 59 |
|
48 | | - funs_loaded <- pckg_loaded |> |
49 | | - purrr::map(\(x) base::ls(stringr::str_c("package:", x))) |> |
50 | | - tibble::enframe("pckg_loaded", "func") |> |
51 | | - tidyr::unnest(func) |
| 60 | + fil |> |
| 61 | + extract_highlighted_funs() |> |
| 62 | + summarise_funs_used(funs_augmented) |> |
| 63 | + print_with_class() |
| 64 | +} |
52 | 65 |
|
53 | | - get_mode <- \(x) { |
54 | | - ux <- unique(x) |
55 | | - ux[which.max(tabulate(match(x, ux)))] |
56 | | - } |
57 | 66 |
|
58 | | - funs_origin <- pckg_loaded |> |
59 | | - purrr::map(getNamespaceImports) |> |
60 | | - purrr::list_flatten() |> |
61 | | - tibble::enframe() |> |
62 | | - dplyr::filter(value != "TRUE") |> |
63 | | - tidyr::unnest(value) |> |
64 | | - tidyr::separate_wider_delim(name, "_", names = c("pckg_loaded", "pckg_origin")) |> |
65 | | - dplyr::rename(func = value) |> |
66 | | - dplyr::mutate(pckg_origin = get_mode(pckg_origin), .by = func) |> |
67 | | - dplyr::distinct() |
68 | | - |
69 | | - funs_scouted <- conflicted::conflict_scout() |> |
70 | | - unlist() |> |
71 | | - dplyr::bind_rows() |
72 | 67 |
|
73 | | - if (nrow(funs_scouted) > 0) { |
74 | | - funs_scouted <- funs_scouted |> |
75 | | - tidyr::pivot_longer(tidyselect::everything(), names_to = "func") |> |
76 | | - dplyr::mutate(func = stringr::str_remove(func, "\\d$")) |> |
77 | | - dplyr::summarise(pckg_preferred = stringr::str_flatten_comma(value, na.rm = TRUE), .by = func) |
78 | | - } else { |
79 | | - funs_scouted <- tibble::tibble(pckg_preferred = "zzz", func = "zzz") |
80 | | - } |
| 68 | +#' Get loaded functions |
| 69 | +#' |
| 70 | +#' @rdname used_here |
| 71 | +#' @usage NULL |
| 72 | +get_funs_loaded <- \(x) { |
| 73 | + map(x, \(x) ls(str_c("package:", x))) |> |
| 74 | + enframe("pkg_loaded", "func") |> |
| 75 | + unnest(func) |
| 76 | +} |
81 | 77 |
|
82 | | - funs_augmented <- funs_loaded |> |
83 | | - dplyr::left_join(funs_origin, dplyr::join_by(pckg_loaded, func)) |> |
84 | | - dplyr::left_join(funs_scouted, dplyr::join_by(func)) |> |
85 | | - dplyr::group_by(func) |> |
86 | | - tidyr::fill(pckg_origin, .direction = "updown") |> |
87 | | - dplyr::mutate( |
88 | | - pckg_loaded = dplyr::coalesce(pckg_origin, pckg_loaded), |
89 | | - pckg_loaded = dplyr::coalesce(pckg_preferred, pckg_loaded) |
90 | | - ) |> |
91 | | - dplyr::select(pckgx = pckg_loaded, func) |> |
92 | | - dplyr::arrange(func, pckgx) |> |
93 | | - dplyr::distinct(func, .keep_all = TRUE) |
94 | | - |
95 | | - funs_coded <- fil |> |
96 | | - readr::read_lines() |> |
97 | | - highr::hi_latex(fallback = TRUE) |> |
98 | | - stringr::str_extract_all("([a-zA-Z_]+::)?\\\\hlkwd\\{([^\\{\\}]*(?=\\}))") |> |
99 | | - purrr::list_c() |> |
100 | | - tibble::as_tibble() |> |
101 | | - tidyr::separate_wider_regex(value, c(pckg = ".*?", "\\\\hlkwd\\{", func = ".*")) |> |
102 | | - dplyr::mutate(pckg = stringr::str_remove(pckg, "::") |> dplyr::na_if("")) |
103 | | - |
104 | | - funs_used <- |
105 | | - funs_coded |> |
106 | | - dplyr::left_join(funs_augmented, dplyr::join_by(func)) |> |
107 | | - dplyr::mutate(pckg = dplyr::coalesce(pckg, pckgx)) |> |
108 | | - dplyr::count(pckg, func) |> |
109 | | - dplyr::mutate(func = stringr::str_c(func, "[", n, "]")) |> |
110 | | - dplyr::summarise(func = stringr::str_c(func, collapse = ", "), .by = pckg) |> |
111 | | - tidyr::drop_na() |
112 | | - |
113 | | - funs_used |> |
114 | | - knitr::kable( |
115 | | - format = "html", |
116 | | - table.attr = "class = 'usedthese'", |
117 | | - col.names = c("Package", "Function") |
| 78 | +#' Get mode |
| 79 | +#' |
| 80 | +#' @rdname used_here |
| 81 | +#' @usage NULL |
| 82 | +get_mode <- \(x) { |
| 83 | + ux <- unique(x) |
| 84 | + ux[which.max(tabulate(match(x, ux)))] |
| 85 | +} |
| 86 | + |
| 87 | +#' Get the Imports of loaded packages |
| 88 | +#' |
| 89 | +#' @rdname used_here |
| 90 | +#' @usage NULL |
| 91 | +get_loaded_pkg_imports <- \(x){ |
| 92 | + map(x, getNamespaceImports) |> |
| 93 | + list_flatten() |> |
| 94 | + enframe() |> |
| 95 | + filter(value != "TRUE") |> |
| 96 | + unnest(value) |> |
| 97 | + separate_wider_delim(name, "_", names = c("pkg_loaded", "pkg_origin")) |> |
| 98 | + rename(func = value) |> |
| 99 | + mutate(pkg_origin = get_mode(pkg_origin), .by = func) |> |
| 100 | + distinct() |
| 101 | +} |
| 102 | + |
| 103 | +#' Summarise functions scouted |
| 104 | +#' |
| 105 | +#' @rdname used_here |
| 106 | +#' @usage NULL |
| 107 | +summarise_funs_scouted <- \(x){ |
| 108 | + pivot_longer(x, everything(), names_to = "func") |> |
| 109 | + mutate(func = str_remove(func, "\\d$")) |> |
| 110 | + summarise( |
| 111 | + pkg_preferred = str_flatten_comma(value, na.rm = TRUE), |
| 112 | + .by = func |
| 113 | + ) |
| 114 | +} |
| 115 | + |
| 116 | +#' Augment functions loaded |
| 117 | +#' |
| 118 | +#' @rdname used_here |
| 119 | +#' @usage NULL |
| 120 | +augment_funs_loaded <- \(x, y, z){ |
| 121 | + left_join(x, y, join_by(pkg_loaded, func)) |> |
| 122 | + left_join(z, join_by(func)) |> |
| 123 | + group_by(func) |> |
| 124 | + fill(pkg_origin, .direction = "updown") |> |
| 125 | + mutate( |
| 126 | + pkg_loaded = coalesce(pkg_origin, pkg_loaded), |
| 127 | + pkg_loaded = coalesce(pkg_preferred, pkg_loaded) |
118 | 128 | ) |> |
119 | | - kableExtra::kable_styling("striped") |
| 129 | + select(pkgx = pkg_loaded, func) |> |
| 130 | + arrange(func, pkgx) |> |
| 131 | + distinct(func, .keep_all = TRUE) |
| 132 | +} |
| 133 | + |
| 134 | +#' Extract code-highlighted functions |
| 135 | +#' |
| 136 | +#' @rdname used_here |
| 137 | +#' @usage NULL |
| 138 | +extract_highlighted_funs <- \(x){ |
| 139 | + read_lines(x) |> |
| 140 | + hi_latex(fallback = TRUE) |> |
| 141 | + str_extract_all("([a-zA-Z_]+::)?\\\\hlkwd\\{([^\\{\\}]*(?=\\}))") |> |
| 142 | + list_c() |> |
| 143 | + as_tibble() |> |
| 144 | + separate_wider_regex(value, c(pkg = ".*?", "\\\\hlkwd\\{", func = ".*")) |> |
| 145 | + mutate(pkg = str_remove(pkg, "::") |> na_if("")) |
| 146 | +} |
| 147 | + |
| 148 | +#' Summarise functions used |
| 149 | +#' |
| 150 | +#' @rdname used_here |
| 151 | +#' @usage NULL |
| 152 | +summarise_funs_used <- \(x, y){ |
| 153 | + left_join(x, y, join_by(func)) |> |
| 154 | + mutate(pkg = coalesce(pkg, pkgx)) |> |
| 155 | + count(pkg, func) |> |
| 156 | + mutate(func = str_c(func, "[", n, "]")) |> |
| 157 | + summarise(func = str_c(func, collapse = ", "), .by = pkg) |> |
| 158 | + drop_na() |
| 159 | +} |
| 160 | + |
| 161 | +#' Print summary table with class |
| 162 | +#' |
| 163 | +#' @rdname used_here |
| 164 | +#' @usage NULL |
| 165 | +print_with_class <- \(x){ |
| 166 | + kable( |
| 167 | + x, |
| 168 | + format = "html", |
| 169 | + table.attr = "class = 'usedthese'", # essential for used_here() |
| 170 | + col.names = c("Package", "Function") |
| 171 | + ) |> |
| 172 | + kable_styling("striped") |
120 | 173 | } |
0 commit comments