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
|
#' @title Convert data to factors
#' @name to_factor
#'
#' @details
#' Convert data to numeric by converting characters to factors and factors to
#' either numeric levels or dummy variables. The "counterpart" to convert
#' variables into numeric is `to_numeric()`.
#'
#' @param x A data frame or vector.
#' @param ... Arguments passed to or from other methods.
#' @inheritParams find_columns
#' @inheritParams categorize
#'
#' @inheritSection center Selection of variables - the `select` argument
#'
#' @return A factor, or a data frame of factors.
#'
#' @examples
#' str(to_factor(iris))
#'
#' # use labels as levels
#' data(efc)
#' str(efc$c172code)
#' head(to_factor(efc$c172code))
#' @export
to_factor <- function(x, ...) {
UseMethod("to_factor")
}
#' @export
to_factor.default <- function(x, verbose = TRUE, ...) {
if (isTRUE(verbose)) {
insight::format_alert(
sprintf("Converting into factors values currently not possible for variables of class `%s`.", class(x)[1])
)
}
x
}
#' @export
to_factor.factor <- function(x, ...) {
x
}
#' @export
to_factor.numeric <- function(x, ...) {
# preserve labels
variable_label <- attr(x, "label", exact = TRUE)
value_labels <- attr(x, "labels", exact = TRUE)
# make sure we have matching labels
if (!is.null(value_labels)) {
value_labels <- value_labels[value_labels %in% x]
}
# to factor
x <- as.factor(x)
# use value labels as levels
if (!is.null(value_labels)) {
try(levels(x) <- names(value_labels), silent = TRUE)
}
# add back variable label
attr(x, "label") <- variable_label
x
}
#' @export
to_factor.logical <- to_factor.numeric
#' @export
to_factor.character <- to_factor.numeric
#' @export
to_factor.Date <- to_factor.numeric
#' @rdname to_factor
#' @export
to_factor.data.frame <- function(x,
select = NULL,
exclude = NULL,
ignore_case = FALSE,
append = FALSE,
regex = FALSE,
verbose = TRUE,
...) {
# sanity check, return as is for complete numeric
if (all(sapply(x, is.factor))) {
return(x)
}
# evaluate arguments
select <- .select_nse(select,
x,
exclude,
ignore_case,
regex = regex,
verbose = verbose
)
# drop factors, when append is not FALSE
if (!isFALSE(append)) {
select <- colnames(x[select])[!sapply(x[select], is.factor)]
}
# process arguments
args <- .process_std_args(
x,
select,
exclude,
weights = NULL,
append,
append_suffix = "_f",
force = FALSE,
preserve_value_labels = TRUE,
keep_character = TRUE
)
# update processed arguments
x <- args$x
select <- args$select
x[select] <- lapply(x[select], to_factor, verbose = verbose, ...)
x
}
|
