-
Notifications
You must be signed in to change notification settings - Fork 1
/
utils_acknowledge_packages.R
86 lines (78 loc) · 2.05 KB
/
utils_acknowledge_packages.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
#' @include internal.R
NULL
#' Acknowledge R packages.
#'
#' This function creates a HTML element for acknowledging R packages.
#'
#' @param x `character` names of package.
#'
#' @param prefix `character` prefix text.
#' Defaults to `"We thank: "`.
#'
#' @param suffix `character` suffix text.
#' Defaults to `" R packages."`.
#'
#' @return `shiny.tag` object.
#'
#' @export
acknowledge_packages <- function(x,
prefix = "We thank the ",
suffix = " R packages.") {
# assert valid argument
assertthat::assert_that(
## x
is.character(x),
assertthat::noNA(x),
length(x) >= 1,
## prefix
assertthat::is.string(prefix),
assertthat::noNA(prefix),
## suffix
assertthat::is.string(suffix),
assertthat::noNA(suffix)
)
# generate acknowledgments
out <- lapply(x, function(x) list(acknowledge_package(x), ", "))
out <- unlist(out, recursive = FALSE, use.names = FALSE)
out <- out[-length(out)]
# create argument
arg <- append(list(class = "text-justify", prefix), out)
arg <- append(arg, list(suffix, .noWS = c("after-begin", "before-end")))
# return result
do.call(htmltools::tags$p, arg)
}
#' Acknowledge an R package.
#'
#' This function creates a HTML element for acknowledging a single R package.
#'
#' @param x `character` names of package.
#'
#' @return `shiny.tag` object.
#'
#' @noRd
acknowledge_package <- function(x) {
# assert valid argument
assertthat::assert_that(
assertthat::is.string(x),
assertthat::noNA(x)
)
# extract url for link
pkg_url <- utils::packageDescription(x)$URL[[1]]
if (is.null(pkg_url)) {
# if no URL, then link to CRAN
href_url <- paste0("https://CRAN.R-project.org/package=", x)
} else if (grepl(",", pkg_url)) {
# if multiple URLs, then extract first
href_url <- strsplit(pkg_url, ",")[[1]][[1]]
} else {
# if single URL, then use that
href_url <- pkg_url
}
# return HTML element
htmltools::tags$a(
href = href_url,
target = "_blank",
x,
.noWS = "outside"
)
}