Как создать пользовательскую статистику сглаживания ggplot2 (не просто пользовательскую модель lm или glm) - PullRequest
Новая
       19

Как создать пользовательскую статистику сглаживания ggplot2 (не просто пользовательскую модель lm или glm)

0 голосов
/ 22 февраля 2019

У меня есть функция, которая вычисляет медиану и 90% CI, используя движущееся окно.Поэтому для каждого x = seq(xmin, xmax, by = wStep) я возвращаю медиану и квантили 5% и 95% для всех y, у которых x значения меньше, чем wSize/2.Я хочу отобразить это как линию и ленту, используя ggplot2, создав пользовательскую функцию сглаживания stat_movingwindow().Я могу создать желаемый результат, используя geom_smooth(data = ..., stat = "identity"): 

moveWin <- function(d, wSize = 0.5, wStep = 0.1, 
  f = function(x) quantile(x, prob = c(0.05,0.50,0.95), na.rm = TRUE)
){
  x <- seq(min(d$x), max(d$x), by = wStep)
  y <- matrix(NA, ncol = 3, nrow = length(x))
  for(i in seq_along(x)){
    y[i, ] <- f(d[abs(d$x - x[i]) < wSize/2, ]$y)
  }
  y <- as.tibble(y)
  colnames(y) <- c("ymin","y","ymax")
  y$x <- x
  return(as.tibble(y))
}

set.seed(123)
d <- tibble(
 x= sqrt(seq(0,1,length.out = 50))*10,
 y= rnorm(50)
)

ggplot(data = d) + aes(x = x, y = y) +
  geom_smooth(
    data    = function(d) moveWin(d, wSize = 1, wStep = 0.1), 
    mapping = aes(ymin = ymin, ymax= ymax),
    stat    = "identity") + 
  geom_point() + scale_x_continuous(breaks = 1:10)

ggplot with moving window smoothing

После виньетки Расширение ggplot2 , этокод, который я придумал до сих пор.Однако проблема в том, что это не показывает ленту.Может быть, мне нужен какой-то способ объявить, что эта пользовательская статистика обеспечивает эстетику ymin и ymax .Как получить следующий код для вывода результата, аналогичного приведенному выше? 

StatMovingWindow <- ggproto("StatMovingWindow", Stat,
  compute_group = function(data, scales, wSize, wStep, fun) {
    moveWin(data, wSize = wSize, wStep = wStep, f = fun)
  },

  required_aes = c("x", "y")
)
stat_movingwindow <- function(mapping = NULL, data = NULL, 
  fun = function(d) quantile(d, probs = c(0.05, 0.50, 0.95), na.rm = TRUE),
  wStep = 0.1, wSize = 1,
  geom = "smooth", position = "identity", show.legend = NA, inherit.aes = TRUE,
  ...
){
  layer(
    stat = StatMovingWindow, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(wStep = wStep, wSize = wSize, fun = fun, ...)
  )
}

ggplot(data = d) + aes(x = x, y = y) +
  stat_movingwindow(wStep = 0.1, wSize = 1) + 
  geom_point() + scale_x_continuous(breaks = 1:10)

custom smoothing stat does not show a ribbon

1 Ответ

0 голосов
/ 22 февраля 2019

В вашем коде для stat_movingwindow строка для соответствующего geom: geom = "smooth": 

stat_movingwindow <- function(mapping = NULL, data = NULL, 
  fun = function(d) quantile(d, probs = c(0.05, 0.50, 0.95), na.rm = TRUE),
  wStep = 0.1, wSize = 1,
  geom = "smooth", # <- look here
  position = "identity", show.legend = NA, inherit.aes = TRUE,
  ...
){
  layer(
    stat = StatMovingWindow, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(wStep = wStep, wSize = wSize, fun = fun, ...)
  )
}

Проверяя код для geom_smooth, мы видим, что он включает параметр se = TRUE,и использует GeomSmooth в качестве своего geom: 

> geom_smooth
function (mapping = NULL, data = NULL, stat = "smooth", position = "identity", 
    ..., method = "auto", formula = y ~ x, se = TRUE, # <- look here
    na.rm = FALSE, 
    show.legend = NA, inherit.aes = TRUE) 
{
    params <- list(na.rm = na.rm, se = se, ...)
    if (identical(stat, "smooth")) {
        params$method <- method
        params$formula <- formula
    }
    layer(data = data, mapping = mapping, stat = stat, geom = GeomSmooth, # <- and here
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = params)
}

Копая глубже в GeomSmooth, мы видим, что его функция draw_group (которая отвечает за построение сглаженной линии) имеет se = FALSE в качестве параметра по умолчанию.

Из кода, если se == FALSE, has_ribbon также будет FALSE, хотя в ваших данных есть и ymax, и ymin, благодаря функции StatMovingWindow$compute_group.А это в свою очередь означает, что единственный результат GeomLine$draw_panel(path, panel_params, coord) будет возвращен один, без GeomRibbon$draw_group(ribbon, panel_params, coord). 

> GeomSmooth$draw_group
<ggproto method>
  <Wrapper function>
    function (...) 
f(...)

  <Inner function (f)>
    function (data, panel_params, coord, se = FALSE) # <- look here
{
    ribbon <- transform(data, colour = NA)
    path <- transform(data, alpha = NA)
    has_ribbon <- se && !is.null(data$ymax) && !is.null(data$ymin) # <- and here
    gList(if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord), 
          GeomLine$draw_panel(path, panel_params, coord))
}

Короче говоря, параметр geom_smooth по умолчанию se = TRUE переопределяет поведение по умолчаниюв GeomSmooth$draw_group, (то же самое относится и к stat_smooth), и мы должны сделать то же самое в stat_movingwindow, если мы хотим достичь того же результата.

Если вы ожидаете, что обычно вам понадобится лентадля построения графика вы можете включить se = TRUE в качестве параметра в ваше определение для stat_movingwindow.Если это будет происходить на разовой основе, вы можете вместо этого включить его в свой код вместо этого.

...