-
Notifications
You must be signed in to change notification settings - Fork 3
/
check.R
84 lines (83 loc) · 2.91 KB
/
check.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
#' Check data frame columns against currently set restrictions
#'
#' Once the DUA crosswalk and level have been set, a working data
#' frame can be checked against active data element restrictions. The
#' data frame must pass before it can be writen using
#' \code{write_dua_df()}.
#'
#' @param df Data frame to check against set DUA restriction level.
#' @examples
#' ## --------------
#' ## Setup
#' ## --------------
#' ## set DUA crosswalk
#' dua_cw <- system.file('extdata', 'dua_cw.csv', package = 'duawranglr')
#' set_dua_cw(dua_cw)
#' ## read in data
#' admin <- system.file('extdata', 'admin_data.csv', package = 'duawranglr')
#' df <- read_dua_file(admin)
#' ## --------------
#'
#' ## set restriction level
#' set_dua_level('level_iii')
#'
#' ## show restrictions
#' see_dua_level(show_restrictions = TRUE)
#'
#' ## see variables in administrative data file
#' names(df)
#'
#' ## remove restrictive variables
#' df <- dplyr::select(df, -c(sid,sname,tname))
#'
#' ## confirm
#' check_dua_restrictions(df)
#'
#' @export
check_dua_restrictions <- function(df) {
## check if DUA has been set
if (!exists('dua_env', mode = 'environment') || !dua_env[['dua_set']]) {
stop('Must set DUA first with -set_dua_cw()-.', call. = FALSE)
}
## check if already passed
if (dua_env[['check_pass']]) {
messager__('Data set has passed check and may be saved.')
} else {
## check if DUA level has been set
if (!dua_env[['level_set']]) {
stop('Must set DUA level with -set_dua_level()-.', call. = FALSE)
}
## check if needs to be deidentified and, if so, if it has
if (!dua_env[['deidentified']] && dua_env[['deidentify_required']]) {
if (is.null(dua_env[['deidentify_column']])) {
stop('ID column not set. Set using -set_dua_level()- ',
'or with id_col argument in -deid_dua()-.',
call. = FALSE)
} else {
stop('ID column ',
dua_env[['deidentify_column']],
' has not been deidentified. Use -deid_dua()-.',
call. = FALSE)
}
}
## check data frame
col_vec <- vector()
restrict <- unlist(dua_env[['restrictions']][[dua_env[['dua_level']]]])
for (col in names(df)) {
if (col %in% restrict) {
col_vec <- c(col_vec, col)
}
}
## write message and pass check if true
if (length(col_vec > 0)) {
text <- 'The following variables are not allowed at ' %+%
'the current data usage level restriction [ ' %+%
dua_env[['dua_level']] %+%
' ] and MUST BE REMOVED before saving:'
messager__(text, var_vec = col_vec)
} else {
dua_env[['check_pass']] <- TRUE
messager__('Data set has passed check and may be saved.')
}
}
}