-
Notifications
You must be signed in to change notification settings - Fork 2
/
matrix_mechanism.R
63 lines (52 loc) · 1.58 KB
/
matrix_mechanism.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
#' Add Selected Mechanisms
#'
#' @param data input data
#' @param inj_col ecode and diagnosis column indices
#' @param ... keyword list
#'
#' @return return the input with additional mechanism variables
#' @export
#' @importFrom purrr map2_dfc
#'
#' @examples
#' library(dplyr)
#' library(purrr)
#' dat <- data.frame(
#' d1 = c("T63023", "X92821", "X99100", "T360x"),
#' d2 = c("T65823", "Y030x0", "T17200", "V0100x")
#' )
#'
#' dat %>% matrix_mechanism(inj_col = c(1, 2), "firearm", "fall")
#'
#' @seealso \code{\link{matrix_matched_mechanism}} for a more efficient approach
#'
#'
matrix_mechanism <- function(data, inj_col, ...) {
requireNamespace("dplyr", quietly = T)
# utility function making ... a regex
select_keyword <- function(...) {
if(!length(list(...))) {
keywd <- ""
}
else {
keywd <- paste(list(...), collapse = "|")
}
keywd
}
icd10cm_inj <- icd10cm_mech_regex %>%
filter(grepl(select_keyword(...), mechanism, ignore.case = T, perl = T))
list_int_mech <- icd10cm_inj %>%
pull(intent_mechanism)
list_expr <- icd10cm_inj %>% pull(icd10cm_regex)
# utility function to add field names
add_field_names <- function(data = data, inj_col, var_name, expr) {
var_name <- quo_name(var_name)
data %>%
mutate(!!var_name := find_diag(., expr = expr, colvec = inj_col)) %>%
select(!!var_name)
}
# add the new fields to the original data
dat2 <- map2_dfc(.x = list_int_mech, .y = list_expr,
~ add_field_names(data = data, inj_col = inj_col, var_name = .x, expr = .y))
data %>% bind_cols(dat2)
}