/
web_url.R
229 lines (204 loc) · 6.73 KB
/
web_url.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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
# This file is part of the ipumsr R package created by IPUMS.
# For copyright and licensing information, see the NOTICE and LICENSE files
# in this project's top-level directory, and also on-line at:
# https://github.com/ipums/ipumsr
#' Launch a browser window to an IPUMS metadata page
#'
#' @description
#' Launch the documentation webpage for a given
#' IPUMS project and variable. The project can be provided in the form
#' of an [`ipums_ddi`] object or can be manually specified.
#'
#' This provides access to more extensive variable metadata than may be
#' contained within an `ipums_ddi` object itself.
#'
#' Note that some IPUMS projects (e.g. IPUMS NHGIS) do not have
#' variable-specific pages. In these cases, `ipums_website()` will launch the
#' project's main data selection page.
#'
#' @details
#' If `launch = TRUE`, you will need a valid registration for the specified
#' project to successfully launch the webpage.
#'
#' Not all IPUMS variables are found at webpages that exactly match the variable
#' names that are included in completed extract files (and `ipums_ddi` objects).
#' Therefore, there may be some projects and variables for which
#' `ipums_website()` will launch the page for a different variable or an
#' invalid page.
#'
#' @param x An [`ipums_ddi`] object or the name of an IPUMS project.
#' See [`ipums_data_collections()`] for supported projects.
#' @param var Name of the variable to load. If `NULL`, provides the URL to the
#' project's main data selection site.
#' @param launch If `TRUE`, launch a browser window to the metadata webpage.
#' Otherwise, return the URL for the webpage.
#' @param verbose If `TRUE`, produce warnings when invalid URL specifications
#' are detected.
#' @param homepage_if_missing If `TRUE`, return the IPUMS homepage if the
#' IPUMS project in `x` is not recognized.
#' @param var_label `r lifecycle::badge("deprecated")` Variable label for the
#' provided `var`. This is typically obtained from the input `ipums_ddi`
#' object and is unlikely to be needed.
#' @param project `r lifecycle::badge("deprecated")` Please use `x` instead.
#'
#' @return The URL to the IPUMS webpage for the indicated project and variable
#' (invisibly if `launch = TRUE`)
#'
#' @export
#'
#' @examples
#' ddi <- read_ipums_ddi(ipums_example("cps_00157.xml"))
#'
#' \dontrun{
#' # Launch webpage for particular variable
#' ipums_website(ddi, "MONTH")
#' }
#'
#' # Can also specify an IPUMS project instead of an `ipums_ddi` object
#' ipums_website("IPUMS CPS", var = "RECTYPE", launch = FALSE)
#'
#' # Shorthand project names from `ipums_data_collections()` are also accepted:
#' ipums_website("ipumsi", var = "YEAR", launch = FALSE)
ipums_website <- function(x,
var = NULL,
launch = TRUE,
verbose = TRUE,
homepage_if_missing = FALSE,
project = deprecated(),
var_label = deprecated()) {
UseMethod("ipums_website")
}
#' @export
ipums_website.ipums_ddi <- function(x,
var = NULL,
launch = TRUE,
verbose = TRUE,
homepage_if_missing = FALSE,
project = deprecated(),
var_label = deprecated()) {
if (!missing(project)) {
lifecycle::deprecate_warn(
"0.7.0",
"ipums_website(project = )",
"ipums_website(x = )"
)
}
if (!missing(var_label)) {
lifecycle::deprecate_warn(
"0.7.0",
"ipums_website(var_label = )"
)
var_label <- NULL
}
if (length(var) > 1) {
var <- var[length(var)]
if (verbose) {
rlang::warn(
paste0("Multiple variables specified. Using variable \"", var, "\"")
)
}
}
var <- fix_for_detailed_var(x, var = var, var_label = var_label)
if (!rlang::is_null(var) && !var %in% x$var_info$var_name && verbose) {
rlang::warn(
paste0(
"`var` \"", var, "\" was not found in the provided `ipums_ddi` object"
)
)
}
url <- get_ipums_url(
x$ipums_project,
var = var,
verbose = verbose,
homepage_if_missing = homepage_if_missing
)
if (launch) {
utils::browseURL(url)
invisible(url)
} else {
url
}
}
#' @export
ipums_website.character <- function(x,
var = NULL,
launch = TRUE,
verbose = TRUE,
homepage_if_missing = FALSE,
project = deprecated(),
var_label = deprecated()) {
# This is included only for consistency with previous behavior of
# `ipums_website()`, where `project` was allowed instead of `x`.
# Remove when removing `project` arg.
if (missing(x)) {
x <- project
}
if (!missing(project)) {
lifecycle::deprecate_warn(
"0.7.0",
"ipums_website(project = )",
"ipums_website(x = )"
)
}
if (!missing(var_label)) {
lifecycle::deprecate_warn(
"0.7.0",
"ipums_website(var_label = )"
)
var_label <- NULL
}
if (length(var) > 1) {
var <- var[length(var)]
if (verbose) {
rlang::warn(
paste0("Multiple variables specified. Using variable \"", var, "\"")
)
}
}
var <- fix_for_detailed_var(x, var = var, var_label = var_label)
url <- get_ipums_url(
x,
var = var,
verbose = verbose,
homepage_if_missing = homepage_if_missing
)
if (launch) {
utils::browseURL(url)
invisible(url)
} else {
url
}
}
get_ipums_url <- function(project,
var = NULL,
verbose = TRUE,
homepage_if_missing = FALSE) {
config <- get_proj_config(
project,
default_if_missing = homepage_if_missing,
verbose = verbose
)
if (verbose && !config$has_var_url && !rlang::is_null(var)) {
rlang::warn(
paste0("Cannot give a variable-specific URL for project \"", project, "\"")
)
}
config$var_url(var)
}
# Detailed variables use the same URL as the non-detailed versions of those
# variables. We need to remove the ending "D" from these variable names.
# We identify detailed variables by checking for the text "detailed version"
# in their variable label.
fix_for_detailed_var <- function(object, var, var_label = NULL) {
if (is.null(var_label) & !is.null(object)) {
var_label <- ipums_var_label(object, any_of(var))
}
if (is.null(var_label)) {
return(var)
}
is_det <- grepl("detailed version", tolower(var_label), fixed = TRUE)
if (is_det && fostr_sub(var, -1) == "D") {
var <- fostr_sub(var, 1, -2)
}
var
}