-
Notifications
You must be signed in to change notification settings - Fork 28
/
Copy pathdatagen-methods.R
122 lines (116 loc) · 3.86 KB
/
datagen-methods.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
120
121
122
#' Generate data over the range of variables used in smooths
#'
#' @description
#'
#' `r lifecycle::badge('deprecated')`
#'
#' For each smooth in a GAM, generate new data over the range of the variables
#' involved in a smooth. This function is deprecated as it is only useful for a
#' very narrow use-case. Use [data_slice()] instead.
#'
#' @param x an object for which new data is required. Currently objects of
#' classes `"gam"`, and `"gamm"` are supported, as are smooths from **mgcv**
#' inheriting from class `"mgcv.smooth"`.
#' @param n numeric; the number of data values to generate per term in each
#' smooth.
#' @param data data frame; for `"mgcv.smooth"` objects, the data used to fit
#' the GAM need to be supplied.
#' @param ... arguments passed to methods
#' @return A data frame of new values spread over the range of the
#' observed values.
#'
#' @author Gavin L. Simpson
#'
#' @rdname datagen
#'
#' @keywords internal
`datagen` <- function(x, ...) {
UseMethod("datagen")
}
#' @export
#' @rdname datagen
`datagen.mgcv.smooth` <- function(x, n = 100, data, ...) {
lifecycle::deprecate_warn("0.9.0", "datagen()", "data_slice()")
d <- smooth_dim(x) # how many dimensions in smooth
term <- smooth_terms(x) # what term are we dealing with
## some smooths can't be plotted, esp n-d ones where n > 2
if (!x$plot.me || d > 2L) {
out <- data.frame() # FIXME: or should we throw error/message
}
if (d == 1L) { # 1-d smooths
xvals <- data[[term]]
newvals <- seq_min_max(xvals, n = n)
<
7F3A
/div> out <- data.frame(smooth = rep(smooth_label(x), n), x = newvals)
} else if (d == 2L) { # 2-d smooths
xvals <- data[[term[1]]]
zvals <- data[[term[2]]]
newx <- seq_min_max(xvals, n = n)
newz <- seq_min_max(zvals, n = n)
out <- expand.grid(x1 = newx, x2 = newz)
out <- cbind(smooth = rep(smooth_label(x), n^2), out)
} else {
stop("Cannot handle smooths of three (3) or more terms.")
}
out
}
#' @export
#' @rdname datagen
`datagen.fs.interaction` <- function(x, n = 100, data, ...) {
lifecycle::deprecate_warn("0.9.0", "datagen()", "data_slice()")
d <- smooth_dim(x) # how many dimensions in smooth
term <- smooth_variable(x) # what term are we dealing with
fterm <- smooth_factor_variable(x) # get factor associated with smooth
## term should be length 2, which is the smooth variable
term <- term[term != fterm]
## some smooths can't be plotted, esp n-d ones where n > 2
if (!x$plot.me || d > 2L) {
out <- data.frame() # FIXME: or should we throw error/message
}
## get new values of continuous var
xvals <- data[[term]]
newx <- seq(min(xvals), max(xvals), length.out = n)
## get the factor var and its levels
f <- data[[fterm]]
fvals <- levels(f)
nlevs <- nlevels(f)
out <- setNames(
expand.grid(x = newx, f = fvals),
c(term, fterm)
)
out <- cbind(smooth = rep(smooth_label(x), n * nlevs), out)
out # return
}
#' @export
#' @rdname datagen
`datagen.gam` <- function(x, smooth = NULL, n = 200, ...) {
lifecycle::deprecate_warn("0.9.0", "datagen()", "data_slice()")
if (is.null(smooth)) {
stop("Argument 'smooth' must be specified and not 'NULL'.")
}
if (length(smooth) > 1L) {
stop("More than one smooth requested in argument 'smooth'.")
}
sm <- smooths(x)
select <- check_user_select_smooths(sm, select = smooth)
datagen(get_smooths_by_id(x, which(select))[[1L]],
n = n, data = x[["model"]]
)
}
#' @export
#' @rdname datagen
`datagen.gamm` <- function(x, ...) {
lifecycle::deprecate_warn("0.9.0", "datagen()", "data_slice()")
if (!is.gamm(x)) {
stop("Model doesn't appear to be a 'gamm()' model object.")
}
datagen(x[["gam"]], ...)
}
#' @export
#' @rdname datagen
`datagen.list` <- function(x, ...) {
lifecycle::deprecate_warn("0.9.0", "datagen()", "data_slice()")
if (!is_gamm4(x)) {
stop("Model doesn't appear to be a 'gamm4()' model object.")
}
datagen(x[["gam"]], ...)
}