diff --git a/R/type_loess.R b/R/type_loess.R index 9166620c..164a1d6f 100644 --- a/R/type_loess.R +++ b/R/type_loess.R @@ -1,32 +1,55 @@ -#' LOESS type +#' Loess type +#' +#' @description Type function for plotting a LOESS (LOcal regrESSion) fit. +#' Arguments are passed to \code{\link[stats]{loess}}. #' #' @inheritParams stats::loess +#' @param se logical. If `TRUE` (the default), confidence intervals are drawn. +#' @param level the confidence level required if `se = TRUE`. Default is 0.95. #' @importFrom stats loess loess.control predict +#' @examples +#' # "loess" type convenience string +#' tinyplot(dist ~ speed, data = cars, type = "loess") +#' +#' # Use `type_loess()` to pass extra arguments for customization +#' tinyplot(dist ~ speed, data = cars, type = type_loess(span = 0.5, degree = 1)) #' @export type_loess = function( span = 0.75, degree = 2, family = "gaussian", - control = loess.control()) { + control = loess.control(), + se = TRUE, + level = 0.95 + ) { out = list( - draw = draw_lines(), - data = data_loess(span = span, degree = degree, family = family, control = control), - name = "l" + draw = draw_ribbon(), + data = data_loess(span = span, degree = degree, family = family, control = control, se = se, level = level), + name = if (isTRUE(se)) "ribbon" else "l" ) class(out) = "tinyplot_type" return(out) } -data_loess = function(span, degree, family, control, ...) { +data_loess = function(span, degree, family, control, se, level, ...) { fun = function(datapoints, ...) { - dat = split(datapoints, list(datapoints$facet, datapoints$by)) - dat = lapply(dat, function(x) { - fit = loess(y ~ x, data = x, span = span, degree = degree, family = family, control = control) - x$y = predict(fit, x) - x + datapoints = split(datapoints, list(datapoints$facet, datapoints$by)) + datapoints = Filter(function(k) nrow(k) > 0, datapoints) + datapoints = lapply(datapoints, function(dat) { + fit = loess(y ~ x, data = dat, span = span, degree = degree, family = family, control = control) + if (se == TRUE) { + p = predict(fit, newdata = dat, se = TRUE) + p = ci(p$fit, p$se.fit, conf.level = level, p$df) + dat$y = p$estimate + dat$ymax = p$conf.high + dat$ymin = p$conf.low + } else { + dat$y = predict(fit, dat) + } + dat }) - datapoints = do.call(rbind, dat) + datapoints = do.call(rbind, datapoints) datapoints = datapoints[order(datapoints$facet, datapoints$by, datapoints$x), ] out = list(datapoints = datapoints) return(out) diff --git a/inst/tinytest/_tinysnapshot/model_loess_by.svg b/inst/tinytest/_tinysnapshot/model_loess_by.svg index 162134b6..4b283aee 100644 --- a/inst/tinytest/_tinysnapshot/model_loess_by.svg +++ b/inst/tinytest/_tinysnapshot/model_loess_by.svg @@ -21,17 +21,22 @@ - - - - - -factor(Month) -5 -6 -7 -8 -9 + + + + + + + + + + +factor(Month) +5 +6 +7 +8 +9 @@ -39,32 +44,36 @@ -Wind -I(Temp > 80) +Day +Temp - - - - - -5 -10 -15 -20 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + +60 +70 +80 +90 +100 @@ -73,10 +82,15 @@ - - - - - + + + + + + + + + + diff --git a/inst/tinytest/_tinysnapshot/model_loess_facet.svg b/inst/tinytest/_tinysnapshot/model_loess_facet.svg index 03b876f8..00fa193e 100644 --- a/inst/tinytest/_tinysnapshot/model_loess_facet.svg +++ b/inst/tinytest/_tinysnapshot/model_loess_facet.svg @@ -21,199 +21,287 @@ -Wind -I(Temp > 80) + + + + + + + + + + +Month +5 +6 +7 +8 +9 - - + + - + +Day +Temp + + + + + + + - - - - - -5 -10 -15 -20 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -5 - + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + +60 +70 +80 +90 +100 + +5 + - - + + - + - - - - - -5 -10 -15 -20 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -6 - + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + +60 +70 +80 +90 +100 + +6 + - - + + - + - - - - - -5 -10 -15 -20 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -7 - + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + +60 +70 +80 +90 +100 + +7 + - - + + - + - - - - - -5 -10 -15 -20 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -8 - + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + +60 +70 +80 +90 +100 + +8 + - - + + - + - - - - - -5 -10 -15 -20 - - - - - - - -0.0 -0.2 -0.4 -0.6 -0.8 -1.0 - -9 - - - - - - - - - - - - - - - - + + + + + + + + +0 +5 +10 +15 +20 +25 +30 + + + + + + +60 +70 +80 +90 +100 + +9 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + diff --git a/inst/tinytest/test-models.R b/inst/tinytest/test-models.R index 8eec84fb..9138859c 100644 --- a/inst/tinytest/test-models.R +++ b/inst/tinytest/test-models.R @@ -34,8 +34,7 @@ f = function() { expect_snapshot_plot(f, label = "model_lm_by") f = function() { - plt(I(Temp > 80) ~ Wind | factor(Month), data = airquality, - type = type_loess()) + plt(Temp ~ Day | factor(Month), data = airquality, type = type_loess()) } expect_snapshot_plot(f, label = "model_loess_by") @@ -54,7 +53,6 @@ f = function() { expect_snapshot_plot(f, label = "model_lm_facet") f = function() { - plt(I(Temp > 80) ~ Wind, facet = ~Month, data = airquality, - type = type_loess()) + plt(Temp ~ Day | Month, data = airquality, facet = "by", type = type_loess()) } expect_snapshot_plot(f, label = "model_loess_facet") diff --git a/man/type_loess.Rd b/man/type_loess.Rd index cf1d67c5..64578d74 100644 --- a/man/type_loess.Rd +++ b/man/type_loess.Rd @@ -2,13 +2,15 @@ % Please edit documentation in R/type_loess.R \name{type_loess} \alias{type_loess} -\title{LOESS type} +\title{Loess type} \usage{ type_loess( span = 0.75, degree = 2, family = "gaussian", - control = loess.control() + control = loess.control(), + se = TRUE, + level = 0.95 ) } \arguments{ @@ -23,7 +25,19 @@ type_loess( biweight function. Can be abbreviated.} \item{control}{control parameters: see \code{\link[stats]{loess.control}}.} + +\item{se}{logical. If \code{TRUE} (the default), confidence intervals are drawn.} + +\item{level}{the confidence level required if \code{se = TRUE}. Default is 0.95.} } \description{ -LOESS type +Type function for plotting a LOESS (LOcal regrESSion) fit. +Arguments are passed to \code{\link[stats]{loess}}. +} +\examples{ +# "loess" type convenience string +tinyplot(dist ~ speed, data = cars, type = "loess") + +# Use `type_loess()` to pass extra arguments for customization +tinyplot(dist ~ speed, data = cars, type = type_loess(span = 0.5, degree = 1)) }