epipredict/man/smooth_quantile_reg.Rd at 10b5b615655e1d997ddc7ca70c26184e2841a1b6 · cmu-delphi/epipredict · GitHub

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
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/make_smooth_quantile_reg.R
\name{smooth_quantile_reg}
\alias{smooth_quantile_reg}
\title{Smooth quantile regression}
\usage{
smooth_quantile_reg(
  mode = "regression",
  engine = "smoothqr",
  outcome_locations = NULL,
  quantile_levels = c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95),
  degree = 3L
)
}
\arguments{
\item{mode}{A single character string for the type of model.
The only possible value for this model is "regression".}

\item{engine}{Character string naming the fitting function. Currently, only
"rq" and "grf" are supported.}

\item{outcome_locations}{Defaults to the vector \code{1:ncol(y)} but if the
responses are observed at a different spacing (or appear in a different
order), that information should be used here. This
argument will be mapped to the \code{ahead} argument of \code{\link[smoothqr:smooth_qr]{smoothqr::smooth_qr()}}.}

\item{quantile_levels}{A scalar or vector of values in (0, 1) to determine which
quantiles to estimate (default is the set 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95).}

\item{degree}{the number of polynomials used for response smoothing. Must
be no more than the number of responses.}
}
\description{
\code{smooth_quantile_reg()} generates a quantile regression model \emph{specification} for
the \href{https://www.tidymodels.org/}{tidymodels} framework. Currently, the
only supported engine is \code{\link[smoothqr:smooth_qr]{smoothqr::smooth_qr()}}.
}
\examples{
library(smoothqr)
tib <- data.frame(
  y1 = rnorm(100), y2 = rnorm(100), y3 = rnorm(100),
  y4 = rnorm(100), y5 = rnorm(100), y6 = rnorm(100),
  x1 = rnorm(100), x2 = rnorm(100)
)
qr_spec <- smooth_quantile_reg(quantile_levels = c(.2, .5, .8), outcome_locations = 1:6)
ff <- qr_spec \%>\% fit(cbind(y1, y2, y3, y4, y5, y6) ~ ., data = tib)
p <- predict(ff, new_data = tib)

x <- -99:99 / 100 * 2 * pi
y <- sin(x) + rnorm(length(x), sd = .1)
fd <- x[length(x) - 20]
XY <- smoothqr::lagmat(y[1:(length(y) - 20)], c(-20:20))
XY <- tibble::as_tibble(XY)
qr_spec <- smooth_quantile_reg(quantile_levels = c(.2, .5, .8), outcome_locations = 20:1)
tt <- qr_spec \%>\% fit_xy(x = XY[, 21:41], y = XY[, 1:20])

library(tidyr)
library(dplyr)
pl <- predict(
  object = tt,
  new_data = XY[max(which(complete.cases(XY[, 21:41]))), 21:41]
)
pl <- pl \%>\%
  unnest(.pred) \%>\%
  mutate(distn = nested_quantiles(distn)) \%>\%
  unnest(distn) \%>\%
  mutate(
    x = x[length(x) - 20] + ahead / 100 * 2 * pi,
    ahead = NULL
  ) \%>\%
  pivot_wider(names_from = quantile_levels, values_from = values)
plot(x, y, pch = 16, xlim = c(pi, 2 * pi), col = "lightgrey")
curve(sin(x), add = TRUE)
abline(v = fd, lty = 2)
lines(pl$x, pl$`0.2`, col = "blue")
lines(pl$x, pl$`0.8`, col = "blue")
lines(pl$x, pl$`0.5`, col = "red")

library(ggplot2)
ggplot(data.frame(x = x, y = y), aes(x)) +
  geom_ribbon(data = pl, aes(ymin = `0.2`, ymax = `0.8`), fill = "lightblue") +
  geom_point(aes(y = y), colour = "grey") + # observed data
  geom_function(fun = sin, colour = "black") + # truth
  geom_vline(xintercept = fd, linetype = "dashed") + # end of training data
  geom_line(data = pl, aes(y = `0.5`), colour = "red") + # median prediction
  theme_bw() +
  coord_cartesian(xlim = c(0, NA)) +
  ylab("y")
}
\seealso{
\code{\link[=fit.model_spec]{fit.model_spec()}}, \code{\link[=set_engine]{set_engine()}}
}