diff --git a/NAMESPACE b/NAMESPACE
index d475b5b6d..1c2e48784 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -46,6 +46,11 @@ S3method(inv_link,gam)
S3method(inv_link,gamm)
S3method(inv_link,glm)
S3method(inv_link,list)
+S3method(is_factor_term,bam)
+S3method(is_factor_term,gam)
+S3method(is_factor_term,gamm)
+S3method(is_factor_term,list)
+S3method(is_factor_term,terms)
S3method(link,bam)
S3method(link,family)
S3method(link,gam)
@@ -72,6 +77,9 @@ S3method(smooth_dim,gamm)
S3method(smooth_dim,mgcv.smooth)
S3method(smooth_samples,default)
S3method(smooth_samples,gam)
+S3method(term_variables,bam)
+S3method(term_variables,gam)
+S3method(term_variables,terms)
S3method(vcov,scam)
S3method(which_smooths,bam)
S3method(which_smooths,default)
@@ -99,6 +107,7 @@ export(inv_link)
export(is_by_smooth)
export(is_continuous_by_smooth)
export(is_factor_by_smooth)
+export(is_factor_term)
export(is_mgcv_smooth)
export(is_mrf_smooth)
export(is_offset)
diff --git a/R/datasets.R b/R/datasets.R
index 63ff70384..9023ba24d 100644
--- a/R/datasets.R
+++ b/R/datasets.R
@@ -77,3 +77,22 @@ NULL
##' @keywords data
##' @docType data
NULL
+
+##' Data from the General Social Survey (GSS) from the National Opinion Research
+##' Center of the University of Chicago
+##'
+##' A subset of the data from the [`carData::GSSvocab`] dataset from the
+##' `carData` package, containing observations from 2016 only.
+##'
+##' @format A data frame with 1858 rows and 3 variables:
+##' * `vocab`: numeric; the number of words out of 10 correct on a vocabulary
+##' test.
+##' * `nativeBorn`: factor; Was the respondent born in the US? A factor with
+##' levels `no` and `yes`.
+##' * `ageGroup`: factor; grouped age of the respondent with levels `18-29`
+##' `30-39`, `40-49`, `50-59`, and `60+`.##'
+##'
+##' @keywords data
+##' @name gss_vocab
+##' @docType data
+NULL
diff --git a/R/evaluate_smooth.R b/R/evaluate_smooth.R
index 354cdc073..01b482bf6 100644
--- a/R/evaluate_smooth.R
+++ b/R/evaluate_smooth.R
@@ -569,33 +569,55 @@
}
mf <- model.frame(object) # data used to fit model
- is_fac <- is.factor(mf[[term]]) # is term a factor?
+
+ ## is_fac <- is.factor(mf[[term]]) # is term a factor?
+ is_fac <- is_factor_term(tt, term)
## match the specific term, with term names mgcv actually uses
## for example in a model with multiple linear predictors, terms in
## nth linear predictor (for n > 1) get appended .{n-1}
ind <- match(term, vars)
-
- ## take the actual mgcv version of the names for the `terms` argument
- evaluated <- as.data.frame(predict(object, newdata = mf, type = 'terms',
- terms = mgcv_names[ind], se = TRUE,
- unconditional = unconditional))
- evaluated <- setNames(evaluated, c("partial", "se"))
- evaluated <- as_tibble(evaluated)
-
+
if (is_fac) {
- levs <- levels(mf[, term])
- newd <- setNames(data.frame(fac = factor(levs, levels = levs)), "value")
- spl <- lapply(split(evaluated, mf[, term]), `[`, i = 1, j = )
- evaluated <- bind_rows(spl)
+ ## check order of term; if > 1 interaction and not handled
+ ord <- attr(tt, "order")[match(term, attr(tt, "term.labels"))]
+ if (ord > 1) {
+ stop("Interaction terms are not currently supported.")
+ }
+ ## facs <- attr(tt, 'factors')[, term]
+ newd <- unique(mf[, term, drop = FALSE])
+ ## ##fac_vars <- rownames(facs)
+ ## fac_vars <- names(facs)[as.logical(facs)]
+ ## facs <- attr(tt, 'factors')[, term]
+ ## newd <- unique(mf[, names(facs)[as.logical(facs)], drop = FALSE])
+ ## ##fac_vars <- rownames(facs)
+ ## fac_vars <- names(facs)[as.logical(facs)]
+ ## ##newd <- unique(mf[, fac_vars, drop = FALSE])
+ other_vars <- setdiff(names(mf), term)
+ other_data <- as_tibble(lapply(mf[other_vars], value_closest_to_median))
+ pred_data <- exec(expand_grid, !!!list(newd, other_data))
+ evaluated <- as.data.frame(predict(object, newdata = pred_data,
+ type = 'terms',
+ terms = term, se = TRUE,
+ unconditional = unconditional,
+ newdata.guaranteed = FALSE))
+ evaluated <- setNames(evaluated, c("partial", "se"))
+ evaluated <- as_tibble(evaluated)
nr <- NROW(evaluated)
+ newd <- setNames(newd, "value")
evaluated <- bind_cols(term = rep(term, nr),
- type = rep(ifelse(is_fac, "factor", "numeric"), nr),
+ type = rep("factor", nr),
newd, evaluated)
} else {
+ ## take the actual mgcv version of the names for the `terms` argument
+ evaluated <- as.data.frame(predict(object, newdata = mf, type = 'terms',
+ terms = mgcv_names[ind], se = TRUE,
+ unconditional = unconditional))
+ evaluated <- setNames(evaluated, c("partial", "se"))
+ evaluated <- as_tibble(evaluated)
nr <- NROW(evaluated)
evaluated <- bind_cols(term = rep(term, nr),
- type = rep(ifelse(is_fac, "factor", "numeric"), nr),
+ type = rep("numeric", nr),
value = mf[[term]],
evaluated)
}
diff --git a/R/utililties.R b/R/utililties.R
index 9780b0e21..8c68d8665 100644
--- a/R/utililties.R
+++ b/R/utililties.R
@@ -805,3 +805,117 @@
out <- TRUE
out
}
+
+##' Is a model term a factor (categorical)?
+##'
+##' Given the name (a term label) of a term in a model, identify if the term is a
+##' factor term or numeric. This is useful when considering interactions, where
+##' terms like `fac1:fac2` or `num1:fac1` may be requested by the user. Only for
+##' terms of the type `fac1:fac2` will this function return `TRUE`.
+##'
+##' @param object an R object on which method dispatch is performed
+##' @param term character; the name of a model term, in the sense of
+##' `attr(terms(object), "term.labels")`. Currently not checked to see if the
+##' term exists in the model.
+##' @param ... arguments passed to other methods.
+##'
+##' @return A logical: `TRUE` if and only if all variables involved in the term
+##' are factors, otherwise `FALSE`.
+##'
+##' @export
+`is_factor_term` <- function(object, term, ...) {
+ UseMethod("is_factor_term", object)
+}
+
+##' @rdname is_factor_term
+##' @export
+`is_factor_term.terms` <- function(object, term, ...) {
+ if (missing(term)) {
+ stop("Argument 'term' must be provided.")
+ }
+ facs <- attr(object, "factors")
+ out <- if (term %in% colnames(facs)) {
+ facs <- facs[, term, drop = FALSE]
+ take <- rownames(facs)[as.logical(facs)]
+ data_types <- attr(object, 'dataClasses')[take]
+ all(data_types == "factor")
+ } else {
+ NULL
+ }
+ out
+}
+
+##' @rdname is_factor_term
+##' @export
+`is_factor_term.gam` <- function(object, term, ...) {
+ object <- terms(object)
+ is_factor_term(object, term, ...)
+}
+
+##' @rdname is_factor_term
+##' @export
+`is_factor_term.bam` <- function(object, term, ...) {
+ object <- terms(object)
+ is_factor_term(object, term, ...)
+}
+
+##' @rdname is_factor_term
+##' @export
+`is_factor_term.gamm` <- function(object, term, ...) {
+ object <- terms(object$gam)
+ is_factor_term(object, term, ...)
+}
+
+##' @rdname is_factor_term
+##' @export
+`is_factor_term.list` <- function(object, term, ...) {
+ if (!is_gamm4(object)) {
+ if (all(vapply(object, inherits, logical(1), "terms"))) {
+ out <- any(unlist(lapply(object, is_factor_term, term)))
+ } else {
+ stop("Don't know how to handle generic list objects.")
+ }
+ } else {
+ object <- terms(object$gam)
+ out <- is_factor_term(object, term, ...)
+ }
+ out
+}
+
+##' Names of variables involved in a specified model term
+##'
+##' Given the name (a term label) of a term in a model, returns the names
+##' of the variables involved in ther term.
+##'
+##' @param object an R object on which method dispatch is performed
+##' @param term character; the name of a model term, in the sense of
+##' `attr(terms(object), "term.labels")`. Currently not checked to see if the
+##' term exists in the model.
+##' @param ... arguments passed to other methods.
+##'
+##' @return A character vector of variable names.
+##'
+`term_variables` <- function(object, term, ...) {
+ UseMethod("terms_variables", object)
+}
+
+##' @rdname term_variables
+##' @export
+`term_variables.terms` <- function(object, term, ...) {
+ facs <- attr(object, "factors")[ , term]
+ names(facs)[as.logical(facs)]
+}
+
+##' @rdname term_variables
+##' @export
+`term_variables.gam` <- function(object, term, ...) {
+ object <- terms(object)
+ term_variables(object, term, ...)
+}
+
+##' @rdname term_variables
+##' @export
+`term_variables.bam` <- function(object, term, ...) {
+ object <- terms(object)
+ term_variables(object, term, ...)
+}
diff --git a/data/gss_vocab.rda b/data/gss_vocab.rda
new file mode 100644
index 000000000..9de380be9
Binary files /dev/null and b/data/gss_vocab.rda differ
diff --git a/man/add_fitted.Rd b/man/add_fitted.Rd
index 75b0e2526..773ddc11b 100644
--- a/man/add_fitted.Rd
+++ b/man/add_fitted.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/add-functions.R
+% Please edit documentation in R/add-methods.R
\name{add_fitted}
\alias{add_fitted}
\title{Add fitted values from a model to a data frame}
diff --git a/man/add_fitted.gam.Rd b/man/add_fitted.gam.Rd
index 697ed212c..490141034 100644
--- a/man/add_fitted.gam.Rd
+++ b/man/add_fitted.gam.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/add-functions.R
+% Please edit documentation in R/add-methods.R
\name{add_fitted.gam}
\alias{add_fitted.gam}
\title{Add fitted values from a GAM to a data frame}
diff --git a/man/add_residuals.Rd b/man/add_residuals.Rd
index 74844aa23..82c371978 100644
--- a/man/add_residuals.Rd
+++ b/man/add_residuals.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/add-functions.R
+% Please edit documentation in R/add-methods.R
\name{add_residuals}
\alias{add_residuals}
\title{Add residuals from a model to a data frame}
diff --git a/man/add_residuals.gam.Rd b/man/add_residuals.gam.Rd
index ac9a29e65..35ac21774 100644
--- a/man/add_residuals.gam.Rd
+++ b/man/add_residuals.gam.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/add-functions.R
+% Please edit documentation in R/add-methods.R
\name{add_residuals.gam}
\alias{add_residuals.gam}
\title{Add residuals from a GAM to a data frame}
diff --git a/man/gss_vocab.Rd b/man/gss_vocab.Rd
new file mode 100644
index 000000000..9f40e2b50
--- /dev/null
+++ b/man/gss_vocab.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/datasets.R
+\docType{data}
+\name{gss_vocab}
+\alias{gss_vocab}
+\title{Data from the General Social Survey (GSS) from the National Opinion Research
+Center of the University of Chicago}
+\format{
+A data frame with 1858 rows and 3 variables:
+\itemize{
+\item \code{vocab}: numeric; the number of words out of 10 correct on a vocabulary
+test.
+\item \code{nativeBorn}: factor; Was the respondent born in the US? A factor with
+levels \code{no} and \code{yes}.
+\item \code{ageGroup}: factor; grouped age of the respondent with levels \code{18-29}
+\code{30-39}, \code{40-49}, \code{50-59}, and \verb{60+}.##'
+}
+}
+\description{
+A subset of the data from the \code{\link[carData:GSSvocab]{carData::GSSvocab}} dataset from the
+\code{carData} package, containing observations from 2016 only.
+}
+\keyword{data}
diff --git a/man/is_factor_term.Rd b/man/is_factor_term.Rd
new file mode 100644
index 000000000..25db10f6d
--- /dev/null
+++ b/man/is_factor_term.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utililties.R
+\name{is_factor_term}
+\alias{is_factor_term}
+\alias{is_factor_term.terms}
+\alias{is_factor_term.gam}
+\alias{is_factor_term.bam}
+\alias{is_factor_term.gamm}
+\alias{is_factor_term.list}
+\title{Is a model term a factor (categorical)?}
+\usage{
+is_factor_term(object, term, ...)
+
+\method{is_factor_term}{terms}(object, term, ...)
+
+\method{is_factor_term}{gam}(object, term, ...)
+
+\method{is_factor_term}{bam}(object, term, ...)
+
+\method{is_factor_term}{gamm}(object, term, ...)
+
+\method{is_factor_term}{list}(object, term, ...)
+}
+\arguments{
+\item{object}{an R object on which method dispatch is performed}
+
+\item{term}{character; the name of a model term, in the sense of
+\code{attr(terms(object), "term.labels")}. Currently not checked to see if the
+term exists in the model.}
+
+\item{...}{arguments passed to other methods.}
+}
+\value{
+A logical: \code{TRUE} if and only if all variables involved in the term
+are factors, otherwise \code{FALSE}.
+}
+\description{
+Given the name (a term label) of a term in a model, identify if the term is a
+factor term or numeric. This is useful when considering interactions, where
+terms like \code{fac1:fac2} or \code{num1:fac1} may be requested by the user. Only for
+terms of the type \code{fac1:fac2} will this function return \code{TRUE}.
+}
diff --git a/man/term_variables.Rd b/man/term_variables.Rd
new file mode 100644
index 000000000..72712442e
--- /dev/null
+++ b/man/term_variables.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utililties.R
+\name{term_variables}
+\alias{term_variables}
+\alias{term_variables.terms}
+\alias{term_variables.gam}
+\alias{term_variables.bam}
+\title{Names of variables involved in a specified model term}
+\usage{
+term_variables(object, term, ...)
+
+\method{term_variables}{terms}(object, term, ...)
+
+\method{term_variables}{gam}(object, term, ...)
+
+\method{term_variables}{bam}(object, term, ...)
+}
+\arguments{
+\item{object}{an R object on which method dispatch is performed}
+
+\item{term}{character; the name of a model term, in the sense of
+\code{attr(terms(object), "term.labels")}. Currently not checked to see if the
+term exists in the model.}
+
+\item{...}{arguments passed to other methods.}
+}
+\value{
+A character vector of variable names.
+}
+\description{
+Given the name (a term label) of a term in a model, returns the names
+of the variables involved in ther term.
+}
diff --git a/tests/figs/draw-methods/draw-2d-smooth.svg b/tests/figs/draw-methods/draw-2d-smooth.svg
index d3202eb0f..3a18e6888 100644
--- a/tests/figs/draw-methods/draw-2d-smooth.svg
+++ b/tests/figs/draw-methods/draw-2d-smooth.svg
@@ -47,7 +47,7 @@
-
+
diff --git a/tests/figs/draw-methods/draw-am-with-2d-smooth.svg b/tests/figs/draw-methods/draw-am-with-2d-smooth.svg
index 456e92368..1add40fe6 100644
--- a/tests/figs/draw-methods/draw-am-with-2d-smooth.svg
+++ b/tests/figs/draw-methods/draw-am-with-2d-smooth.svg
@@ -47,7 +47,7 @@
-
+
diff --git a/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth-with-fixed-scales.svg b/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth-with-fixed-scales.svg
index 2e37bfb83..8ac43d94e 100644
--- a/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth-with-fixed-scales.svg
+++ b/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth-with-fixed-scales.svg
@@ -1886,12 +1886,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth.svg b/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth.svg
index 545956e11..d847478ba 100644
--- a/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth.svg
+++ b/tests/figs/draw-methods/draw-am-with-factor-by-variable-smooth.svg
@@ -1900,12 +1900,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/draw-methods/draw-evaulated-2d-smooth-standard-errors.svg b/tests/figs/draw-methods/draw-evaulated-2d-smooth-standard-errors.svg
index 3a1f56cfc..e04d2b1f8 100644
--- a/tests/figs/draw-methods/draw-evaulated-2d-smooth-standard-errors.svg
+++ b/tests/figs/draw-methods/draw-evaulated-2d-smooth-standard-errors.svg
@@ -38,22 +38,22 @@
-
+
-
-
-
-
+
+
+
+
-
-
+
+
-
+
diff --git a/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by-fixed-scales.svg b/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by-fixed-scales.svg
index 4c8d11d0e..22a252084 100644
--- a/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by-fixed-scales.svg
+++ b/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by-fixed-scales.svg
@@ -1678,12 +1678,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by.svg b/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by.svg
index a45255bc1..6e02c4cb8 100644
--- a/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by.svg
+++ b/tests/figs/draw-methods/draw-gam-model-with-ranef-smooth-factor-by.svg
@@ -1675,12 +1675,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/draw-methods/draw-gam-with-select-and-parametric-is-true.svg b/tests/figs/draw-methods/draw-gam-with-select-and-parametric-is-true.svg
index 0ccb6aa4f..3fa65e3c4 100644
--- a/tests/figs/draw-methods/draw-gam-with-select-and-parametric-is-true.svg
+++ b/tests/figs/draw-methods/draw-gam-with-select-and-parametric-is-true.svg
@@ -1436,12 +1436,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/draw-methods/draw-gam-without-select-and-parametric-is-true.svg b/tests/figs/draw-methods/draw-gam-without-select-and-parametric-is-true.svg
index 545956e11..d847478ba 100644
--- a/tests/figs/draw-methods/draw-gam-without-select-and-parametric-is-true.svg
+++ b/tests/figs/draw-methods/draw-gam-without-select-and-parametric-is-true.svg
@@ -1900,12 +1900,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/draw-methods/draw-issue-39-empty-plots.svg b/tests/figs/draw-methods/draw-issue-39-empty-plots.svg
index 520484eaf..6802469d6 100644
--- a/tests/figs/draw-methods/draw-issue-39-empty-plots.svg
+++ b/tests/figs/draw-methods/draw-issue-39-empty-plots.svg
@@ -772,11 +772,11 @@
-
+
-
+
@@ -835,11 +835,11 @@
-
+
-
+
diff --git a/tests/figs/draw-methods/draw-std-error-of-2d-smooth.svg b/tests/figs/draw-methods/draw-std-error-of-2d-smooth.svg
index 3a1f56cfc..e04d2b1f8 100644
--- a/tests/figs/draw-methods/draw-std-error-of-2d-smooth.svg
+++ b/tests/figs/draw-methods/draw-std-error-of-2d-smooth.svg
@@ -38,22 +38,22 @@
-
+
-
-
-
-
+
+
+
+
-
-
+
+
-
+
diff --git a/tests/figs/test-by-variables/draw-gam-user-select-and-parametric-true.svg b/tests/figs/test-by-variables/draw-gam-user-select-and-parametric-true.svg
index 646d21228..976426c89 100644
--- a/tests/figs/test-by-variables/draw-gam-user-select-and-parametric-true.svg
+++ b/tests/figs/test-by-variables/draw-gam-user-select-and-parametric-true.svg
@@ -505,12 +505,12 @@
-
-
-
-
+
+
+
+
diff --git a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-1.svg b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-1.svg
index b3d5f24bf..dcc16948f 100644
--- a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-1.svg
+++ b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-1.svg
@@ -36,27 +36,27 @@
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
diff --git a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-2.svg b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-2.svg
index f248c8d65..52a9e89a0 100644
--- a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-2.svg
+++ b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-2.svg
@@ -40,32 +40,32 @@
-
+
-
+
-
+
+
-
-
+
+
-
-
+
-
+
-
-
-
-
-
-
+
+
+
+
+
+
diff --git a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-3.svg b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-3.svg
index 71601e9ee..92c021275 100644
--- a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-3.svg
+++ b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-3.svg
@@ -24,49 +24,49 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -78,32 +78,32 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--5
-0
-5
-Effect
-
-
-
-
-
-
+
+
+-5
+0
+5
+Effect
+
+
+
+
+
+
te(week,latitude)
@@ -117,61 +117,61 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -183,32 +183,32 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--4
-0
-4
-Effect
-
-
-
-
-
-
+
+
+-4
+0
+4
+Effect
+
+
+
+
+
+
By: species; sp1
te(week,latitude)
@@ -223,48 +223,48 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -276,38 +276,38 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--4
--2
-0
-2
-4
-Effect
-
-
-
-
-
-
-
-
-
-
+
+
+-4
+-2
+0
+2
+4
+Effect
+
+
+
+
+
+
+
+
+
+
By: species; sp2
te(week,latitude)
@@ -322,39 +322,42 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -366,38 +369,32 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--0.00050
--0.00025
-0.00000
-0.00025
-0.00050
-Effect
-
-
-
-
-
-
-
-
-
-
+
+
+-2e-04
+0e+00
+2e-04
+Effect
+
+
+
+
+
+
By: species; sp3
te(week,latitude)
@@ -412,39 +409,39 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -456,38 +453,38 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--0.10
--0.05
-0.00
-0.05
-0.10
-Effect
-
-
-
-
-
-
-
-
-
-
+
+
+-0.10
+-0.05
+0.00
+0.05
+0.10
+Effect
+
+
+
+
+
+
+
+
+
+
By: species; sp4
te(week,latitude)
@@ -502,60 +499,60 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -567,32 +564,32 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--2
-0
-2
-Effect
-
-
-
-
-
-
+
+
+-2
+0
+2
+Effect
+
+
+
+
+
+
By: species; sp5
te(week,latitude)
@@ -607,50 +604,50 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -662,32 +659,32 @@
-
-
-
-
-
-
-0
-10
-20
-30
-40
-50
-week
+
+
+
+
+
+
+0
+10
+20
+30
+40
+50
+week
latitude
-
-
--5
-0
-5
-Effect
-
-
-
-
-
-
+
+
+-5
+0
+5
+Effect
+
+
+
+
+
+
By: species; sp6
te(week,latitude)
@@ -702,37 +699,37 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -746,18 +743,18 @@
-
-
-
-
-
-
-sp1
-sp2
-sp3
-sp4
-sp5
-sp6
-species
+
+
+
+
+
+
+sp1
+sp2
+sp3
+sp4
+sp5
+sp6
+species
Partial effect of species
diff --git a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-5.svg b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-5.svg
index 5c34ddb03..2179458f4 100644
--- a/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-5.svg
+++ b/tests/figs/test-hgam-paper-models/hgam-paper-bird-move-model-5.svg
@@ -46,32 +46,32 @@
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
+
-
-
+
+
-
-
+
+
-
+
@@ -151,30 +151,30 @@
-
+
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
+
-
+
+
-
-
+
+
-
-
+
+
@@ -255,28 +255,28 @@
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
-
-
-
-
-
-
+
+
+
+
+
+
@@ -350,30 +350,30 @@
-
+
-
+
-
+
-
+
+
-
-
-
+
-
+
+
@@ -456,28 +456,28 @@
-
-
+
+
+
-
-
+
-
+
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
+
@@ -505,7 +505,7 @@
latitude
--5
+-5
0
5
Effect
@@ -551,28 +551,28 @@
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
+
-
-
-
+
+
+
-
-
-
-
+
+
+
+
@@ -661,7 +661,7 @@
-
+
diff --git a/tests/testthat/test-evaluate-parametric-terms.R b/tests/testthat/test-evaluate-parametric-terms.R
new file mode 100644
index 000000000..f6e1367b0
--- /dev/null
+++ b/tests/testthat/test-evaluate-parametric-terms.R
@@ -0,0 +1,73 @@
+# Test evaluate_parametric_terms
+
+## load packages
+library("testthat")
+library("gratia")
+library("mgcv")
+
+context("Tests of evaluate_parametric_terms():")
+data(gss_vocab, package = "gratia")
+
+m <- gam(vocab ~ nativeBorn * ageGroup, data = gss_vocab, method = 'ML')
+
+test_that("evaluate_parametric_terms() works with factor terms", {
+ ## evaluate parametric terms directly
+ term <- "nativeBorn"
+ expect_silent(para <- evaluate_parametric_term(m, term = term))
+ expect_s3_class(para, "evaluated_parametric_term")
+ expect_s3_class(para, "tbl_df")
+ expect_s3_class(para, "tbl")
+ expect_s3_class(para, "data.frame")
+ expect_named(para,
+ c("term", "type", "value", "partial",
+ "se", "upper", "lower"))
+
+ expect_error(evaluate_parametric_term(m, term = "foo"),
+ "Term is not in the parametric part of model: ",
+ fixed = TRUE)
+
+ expect_warning(evaluate_parametric_term(m, term = c('nativeBorn', 'ageGroup')),
+ "More than one `term` requested; using the first ",
+ fixed = TRUE)
+})
+
+
+set.seed(0)
+## fake some data...
+f1 <- function(x) {exp(2 * x)}
+f2 <- function(x) {
+ 0.2*x^11*(10*(1-x))^6+10*(10*x)^3*(1-x)^10
+}
+f3 <- function(x) {x*0}
+
+n <- 200
+sig2 <- 4
+x0 <- rep(1:4,50)
+x1 <- runif(n, 0, 1)
+x2 <- runif(n, 0, 1)
+x3 <- runif(n, 0, 1)
+e <- rnorm(n, 0, sqrt(sig2))
+y <- 2*x0 + f1(x1) + f2(x2) + f3(x3) + e
+df <- data.frame(x0 = x0, x1 = x1, x2 = x2, x3 = x3, y = y,
+ fx0 = factor(x0))
+
+## fit
+mod <- gam(y ~ x0 + s(x1) + s(x2) + s(x3), data = df)
+
+test_that("evaluate_parametric_terms() works with parametric terms", {
+ ## evaluate parametric terms directly
+ expect_silent(para <- evaluate_parametric_term(mod, term = "x0"))
+ expect_s3_class(para, "evaluated_parametric_term")
+ expect_s3_class(para, "tbl_df")
+ expect_s3_class(para, "tbl")
+ expect_s3_class(para, "data.frame")
+ expect_named(para, c("term","type","value","partial","se","upper","lower"))
+
+ expect_error(evaluate_parametric_term(mod, term = "foo"),
+ "Term is not in the parametric part of model: ",
+ fixed = TRUE)
+
+ expect_warning(evaluate_parametric_term(mod, term = c('x0', 'x1')),
+ "More than one `term` requested; using the first ",
+ fixed = TRUE)
+})
diff --git a/tests/testthat/test-evaluate-smooth-methods.R b/tests/testthat/test-evaluate-smooth-methods.R
index c93510028..3513b9491 100644
--- a/tests/testthat/test-evaluate-smooth-methods.R
+++ b/tests/testthat/test-evaluate-smooth-methods.R
@@ -131,45 +131,6 @@ test_that("evaluate_2d_smooth works for a 2d factor by smooth", {
expect_is(sm, "data.frame")
})
-test_that("evaluate_parametric_terms() works with parametric terms", {
- set.seed(0)
- ## fake some data...
- f1 <- function(x) {exp(2 * x)}
- f2 <- function(x) {
- 0.2*x^11*(10*(1-x))^6+10*(10*x)^3*(1-x)^10
- }
- f3 <- function(x) {x*0}
-
- n <- 200
- sig2 <- 4
- x0 <- rep(1:4,50)
- x1 <- runif(n, 0, 1)
- x2 <- runif(n, 0, 1)
- x3 <- runif(n, 0, 1)
- e <- rnorm(n, 0, sqrt(sig2))
- y <- 2*x0 + f1(x1) + f2(x2) + f3(x3) + e
- df <- data.frame(x0 = x0, x1 = x1, x2 = x2, x3 = x3, y = y)
-
- ## fit
- mod <- gam(y ~ x0 + s(x1) + s(x2) + s(x3), data = df)
-
- ## evaluate parametric terms directly
- expect_silent(para <- evaluate_parametric_term(mod, term = "x0"))
- expect_s3_class(para, "evaluated_parametric_term")
- expect_s3_class(para, "tbl_df")
- expect_s3_class(para, "tbl")
- expect_s3_class(para, "data.frame")
- expect_named(para, c("term","type","value","partial","se","upper","lower"))
-
- expect_error(evaluate_parametric_term(mod, term = "foo"),
- "Term is not in the parametric part of model: ",
- fixed = TRUE)
-
- expect_warning(evaluate_parametric_term(mod, term = c('x0', 'x1')),
- "More than one `term` requested; using the first ",
- fixed = TRUE)
-})
-
test_that("evaluate_fs_smooth() ", {
## simulate example... from ?mgcv::factor.smooth.interaction
set.seed(0)