-
-
Notifications
You must be signed in to change notification settings - Fork 22
/
change_scale.R
119 lines (90 loc) · 2.6 KB
/
change_scale.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
#' Rescale a numeric variable
#'
#' Rescale a numeric variable. This scales all numeric variables in the range 0 - 1.
#'
#' @inheritParams standardize.data.frame
#'
#' @param x Object.
#' @param to New range of values of the data after rescaling.
#' @param range Initial (old) range of values. If \code{NULL}, will take the range of data.
#' @param ... Arguments passed to or from other methods.
#'
#' @examples
#' change_scale(c(0, 1, 5, -5, -2))
#' change_scale(c(0, 1, 5, -5, -2), to = c(-5, 5))
#'
#' head(change_scale(iris))
#' @seealso \code{\link{normalize}} \code{\link{standardize}} \code{\link{ranktransform}}
#' @return A rescaled object.
#' @export
change_scale <- function(x, ...) {
UseMethod("change_scale")
}
#' @rdname change_scale
#' @export
change_scale.numeric <- function(x, to = c(0, 100), range = NULL, verbose = TRUE, ...) {
# Warning if all NaNs
if (all(is.na(x))) {
return(x)
}
# Warning if only one value
if (length(unique(x)) == 1 && is.null(range)) {
if (verbose) {
warning(paste0("A `range` must be provided for data with only one observation."))
}
return(x)
}
if (is.null(range)) {
range <- c(min(x, na.rm = TRUE), max(x, na.rm = TRUE))
}
min <- ifelse(is.na(range[1]), min(x, na.rm = TRUE), range[1])
max <- ifelse(is.na(range[2]), max(x, na.rm = TRUE), range[2])
new_min <- ifelse(is.na(to[1]), min, to[1])
new_max <- ifelse(is.na(to[2]), max, to[2])
out <- as.vector((new_max - new_min) / (max - min) * (x - min) + new_min)
out
}
#' @export
change_scale.factor <- function(x, ...) {
x
}
#' @rdname change_scale
#' @export
change_scale.grouped_df <- function(x, select = NULL, exclude = NULL, to = c(0, 100), range = NULL, ...) {
info <- attributes(x)
# dplyr >= 0.8.0 returns attribute "indices"
grps <- attr(x, "groups", exact = TRUE)
# dplyr < 0.8.0?
if (is.null(grps)) {
grps <- attr(x, "indices", exact = TRUE)
grps <- lapply(grps, function(x) x + 1)
} else {
grps <- grps[[".rows"]]
}
x <- as.data.frame(x)
for (rows in grps) {
x[rows, ] <- change_scale(
x[rows, ],
select = select,
exclude = exclude,
to = to,
range = range,
...
)
}
# set back class, so data frame still works with dplyr
attributes(x) <- info
x
}
#' @rdname change_scale
#' @export
change_scale.data.frame <- function(x, select = NULL, exclude = NULL, to = c(0, 100), range = NULL, ...) {
if (is.null(select)) {
select <- names(x)
}
if (!is.null(exclude)) {
select <- setdiff(select, exclude)
}
x[select] <- lapply(x[select], change_scale, to = to, range = range)
x
}