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
|
#' Quantify the smoothness of a vector
#'
#' @param x Numeric vector (similar to a time series).
#' @param method Can be `"diff"` (the standard deviation of the standardized
#' differences) or `"cor"` (default, lag-one autocorrelation).
#' @param lag An integer indicating which lag to use. If less than `1`, will be
#' interpreted as expressed in percentage of the length of the vector.
#' @inheritParams skewness
#'
#' @examples
#' x <- (-10:10)^3 + rnorm(21, 0, 100)
#' plot(x)
#' smoothness(x, method = "cor")
#' smoothness(x, method = "diff")
#' @return Value of smoothness.
#' @references https://stats.stackexchange.com/questions/24607/how-to-measure-smoothness-of-a-time-series-in-r
#'
#' @export
smoothness <- function(x,
method = "cor",
lag = 1,
iterations = NULL,
...) {
UseMethod("smoothness")
}
#' @export
smoothness.numeric <- function(x,
method = "cor",
lag = 1,
iterations = NULL,
...) {
if (lag < 1) {
lag <- round(lag * length(x))
}
if (lag <= 0) {
insight::format_error("'lag' cannot be that small.")
}
if (method == "cor") {
smooth_data <- stats::cor(utils::head(x, length(x) - lag), utils::tail(x, length(x) - lag))
} else {
smooth_data <- stats::sd(diff(x, lag = lag)) / abs(mean(diff(x, lag = lag)))
}
if (!is.null(iterations)) {
if (requireNamespace("boot", quietly = TRUE)) {
results <- boot::boot(
data = x,
statistic = .boot_smoothness,
R = iterations,
method = method,
lag = lag
)
out_se <- stats::sd(results$t, na.rm = TRUE)
smooth_data <- data.frame(Smoothness = smooth_data, SE = out_se)
} else {
insight::format_warning("Package 'boot' needed for bootstrapping SEs.")
}
}
class(smooth_data) <- unique(c("parameters_smoothness", class(smooth_data)))
smooth_data
}
#' @export
smoothness.data.frame <- function(x,
method = "cor",
lag = 1,
iterations = NULL,
...) {
.smoothness <-
lapply(
x,
smoothness,
method = method,
lag = lag,
iterations = iterations
)
.smoothness <- cbind(Parameter = names(.smoothness), do.call(rbind, .smoothness))
class(.smoothness) <- unique(c("parameters_smoothness", class(.smoothness)))
.smoothness
}
#' @export
smoothness.default <- function(x,
method = "cor",
lag = 1,
iterations = NULL,
...) {
smoothness(
.factor_to_numeric(x),
method = method,
lag = lag,
iterations = iterations
)
}
# bootstrapping -----------------------------------
.boot_smoothness <- function(data, indices, method, lag) {
datawizard::smoothness(
x = data[indices],
method = method,
lag = lag,
iterations = NULL
)
}
# methods -----------------------------------------
#' @export
as.numeric.parameters_smoothness <- function(x, ...) {
if (is.data.frame(x)) {
x$Smoothness
} else {
as.vector(x)
}
}
#' @export
as.double.parameters_smoothness <- as.numeric.parameters_smoothness
|
