/
label-miss.R
88 lines (77 loc) · 2.24 KB
/
label-miss.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
#' Label a missing from one column
#'
#' Label whether a value is missing in a row of one columns.
#'
#' @param x1 a variable of a dataframe
#'
#' @return a vector indicating whether any of these rows had missing values
#'
#' @note can we generalise label_miss to work for any number of variables?
#'
#' @export
#'
#' @seealso [add_any_miss()] [add_label_missings()] [add_label_shadow()]
#'
#' @examples
#'
#' label_miss_1d(airquality$Ozone)
#'
label_miss_1d <- function(x1){
# Catch NULL entries
test_if_null(x1)
# find which are missing and which are not.
temp <- data.frame(x1) %>% is.na %>% rowSums()
# Were all values in x1 originally NA, they would be cast to factor of 1
# and assigned mapped_discrete class. Lets cast it back to NA
if (all(x1 == 1) && inherits(x1, "mapped_discrete")) {
x1[] <- NA
}
as_missing_factor(temp)
}
as_missing_factor <- function(x){
# factor assures that Missing and Not Missing will always have same colour
fct <- factor(
x = ifelse(x == 0, # 0 means not missing, 1 means missing
"Not Missing", # not missing
"Missing"), # missing
levels = c("Not Missing", "Missing")
)
stats::relevel(fct, "Missing")
}
#' label_miss_2d
#'
#' Label whether a value is missing in either row of two columns.
#'
#' @param x1 a variable of a dataframe
#' @param x2 another variable of a dataframe
#'
#' @return a vector indicating whether any of these rows had missing values
#' @export
#'
#' @examples
#'
#' label_miss_2d(airquality$Ozone, airquality$Solar.R)
#'
label_miss_2d <- function(x1, x2){
# Catch NULL entries
if(is.null(x1) | is.null(x2)){
cli::cli_abort(
c(
"Input cannot be NULL",
"We see the first argument, {.arg x1} is: {.cls {class(x1)}}",
"We see the second argument, {.arg x2} is: {.cls {class(x2)}}"
)
)
}
# find which are missing and which are not.
# Were all values in x1/x2 originally NA, they would be cast to factor of 1
# and assigned mapped_discrete class. Lets cast it back to NA
if (all(x1 == 1) && inherits(x1, "mapped_discrete")) {
x1[] <- NA
}
if (all(x2 == 1) && inherits(x2, "mapped_discrete")) {
x2[] <- NA
}
temp <- data.frame(x1,x2) %>% is.na %>% rowSums()
as_missing_factor(temp)
}