Блог

Я пытаюсь создать пользовательскую функцию, которая расширяет ggplot2. Цель функции состоит в наложении среднего значения с горизонтальными и вертикальными стандартными ошибками. Приведенный ниже код делает все это полностью.

 library(plyr)
library(tidyverse)

summ <- ddply(mtcars,.(),summarise,
              dratSE = sqrt(var(drat))/length(drat),
              mpgSE = sqrt(var(mpg))/length(mpg),
              drat = mean(drat),
              mpg = mean(mpg))

ggplot(data = mtcars, mapping = aes(x = drat, y = mpg))  
  geom_point(shape = 21, fill = 'black', color = 'white', size = 3)   
  geom_errorbarh(data = summ, aes(xmin = drat - dratSE, xmax = drat   dratSE))  
  geom_errorbar(data = summ, aes(ymin = mpg - mpgSE, ymax = mpg mpgSE), width = .1)  
  geom_point(data = summ, color='red',size=4) 

 

В идеале для этого потребовалась бы только такая функция, как geom_scattermeans() выполнение всего этого. Но я не уверен, как эстетика переходит в последующие geom функции ggplot() .

Кроме того, у меня возникли трудности с созданием функции, которая принимает имена столбцов в качестве аргумента и заставляет ее работать ddply() .

Я думаю plyr , что на данный момент это довольно несуществующее. Я бы рекомендовал этот dplyr пакет. При программировании с dplyr помощью вы можете использовать {{ (фигурные-фигурные или охватывающие, как указано в документации) для правильного цитирования выражений.

 library(ggplot2)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

geom_point_error <- function(data, x, y, color = 'red', size = 4) {
  
  data <- dplyr::summarise(
    data,
    x_se = sqrt(var({{x}}))/length({{x}}),
    y_se = sqrt(var({{y}}))/length({{y}}),
    x = mean({{x}}),
    y = mean({{y}})
  )
  
  list(
    geom_errorbarh(data = data,
                   mapping = aes(y = y,
                                 xmin = x - x_se, xmax = x   x_se), inherit.aes = F),
    geom_errorbar(data = data,
                  mapping = aes(x = x,
                                ymin = y - y_se, ymax = y   y_se), width = .1,inherit.aes = F),
    geom_point(data = data,
               mapping = aes(x = x, y = y),
               color = color, size = size)
  )
}

ggplot(data = mtcars, mapping = aes(x = drat, y = mpg))  
  geom_point(shape = 21, fill = 'black', color = 'white', size = 3)   
  geom_point_error(mtcars, x = drat, y = mpg)
 

^{Создано 2021-05-17 пакетом reprex (v1.0.0)}

Вторым вариантом было бы создать свой собственный ggproto Geom , чтобы обрабатывать эти вычисления внутри ggplot2 , но сейчас это немного чересчур.

Поскольку мой первый ответ все еще является более простым решением, я решил оставить его. Этот ответ должен приблизить ОП к их цели.

Создание объекта ggproto может быть громоздким в зависимости от того, что вы пытаетесь сделать. В вашем случае вы объединяете 3 ggproto Geoms класса вместе с возможностью нового Stat .

Эти три геомы являются:

• GeomErrorbar
• GeomErrorbarh
• GeomPoint

Чтобы начать, иногда вам просто нужно наследовать от одного из классов и перезаписать метод, но для объединения всех трех вместе вам потребуется проделать больше работы.

Давайте сначала рассмотрим, как каждый из них Geoms рисует свои grid объекты. В зависимости от Geom того, находится ли он в одной из этих функций draw_layer() , draw_panel() , и draw_group() . К счастью, каждая из геом, которые мы хотим использовать, использует только draw_panel() то, что означает для нас немного меньше работы — мы просто вызовем эти методы напрямую и построим новый grobTree объект. Нам просто нужно будет быть осторожными, чтобы все правильные параметры соответствовали нашему новому Geom draw_panel() методу.

Прежде чем мы приступим к написанию нашего собственного draw_panel , мы должны сначала рассмотреть setup_params() и setup_data() функции. Иногда они изменяют данные прямо за воротами. Эти шаги обычно полезны для автоматической обработки и часто используются для стандартизации/преобразования данных. Хорошим примером является GeomTile и GeomRect , по сути, они являются одними и теми же Geom s, но их setup_data() функции различаются, потому что они по-разному параметризованы.

Давайте предположим, что вы хотите назначить только x эстетику и y эстетику, а вычисления xmin , ymin ,, и оставьте xmax ymax для геомов/статистики.

К счастью, GeomPoint просто возвращает данные без изменений, поэтому нам нужно GeomErrorbar будет сначала включить GeomErrorbarh и. setup_data() Чтобы пропустить некоторые шаги, я просто собираюсь создать новый Stat , который позаботится о преобразовании этих ценностей для нас в рамках compute_group() метода.

Обратите внимание здесь GeomErrorbar и GeomErrorbarh позвольте включить еще один параметр — width и height , соответственно, который определяет ширину плоских участков полос ошибок.

кроме того, в рамках этих функций каждый будет создавать свои собственные xmin , xmax , ymin , ymax — поэтому нам нужно будет различать эти параметры.

Сначала загрузите необходимую информацию в пространство имен

 library(ggplot2)
library(grid)
"%||%" <- ggplot2:::`%||%`
 

Начните с нового Stat , я решил назвать это PointError

 StatPointError <- ggproto(
  "StatPointError",
  Stat,
  #having `width` and `height` as named parameters here insure
  #that they will be available to the `Stat` ggproto object.
  compute_group = function(data, scales, width = NULL, height = NULL){
    data$width <- data$width %||% width %||% (resolution(data$x, FALSE)*0.9)
    data$height <- data$height %||% height %||% (resolution(data$y, FALSE)*0.9)
    
    data <- transform(
      data,
      x = mean(x),
      y = mean(y),
      # positions for flat parts of vertical error bars
      xmin = mean(x) - width /2,
      xmax = mean(x)   width / 2,
      width = NULL, 
      # y positions of vertical error bars
      ymin = mean(y) - sqrt(var(y))/length(y),
      ymax = mean(y)   sqrt(var(y))/length(y),
      #positions for flat parts of horizontal error bars
      ymin_h = mean(y) - height /2,
      ymax_h = mean(y)   height /2,
      height = NULL,
      # x positions of horizontal error bars
      xmin_h = mean(x) - sqrt(var(x))/length(x),
      xmax_h = mean(x)   sqrt(var(x))/length(x)
    )
    unique(data)
  }
)
 

Теперь, что касается забавной части , то Geom , опять же, я собираюсь PointError использовать это имя как последовательное.

 GeomPointError <- ggproto(
  "GeomPointError",
  GeomPoint,
  #include some additional defaults
  default_aes = aes(
    shape = 19,
    colour = "black",
    size = 1.5, # error bars have defaults of 0.5 - you may want to add another parameter?
    fill = NA,
    alpha = NA,
    linetype = 1,
    stroke = 0.5, # for GeomPoint
    width = 0.5,  # for GeomErrorbar
    height = 0.5, # for GeomErrorbarh
  ),
  draw_panel = function(data, panel_params, coord, width = NULL, height = NULL, na.rm = FALSE) {
    #make errorbar grobs
    data_errbar <- data
    data_errbar[["size"]] <- 0.5
    errorbar_grob <- GeomErrorbar$draw_panel(data = data_errbar,
                                             panel_params = panel_params, coord = coord, 
                                             width = width, flipped_aes = FALSE)
    #re-parameterize errbarh data
    data_errbarh <- transform(data, 
                              xmin = xmin_h, xmax = xmax_h, ymin = ymin_h, ymax = ymax_h,
                              xmin_h = NULL, xmax_h = NULL, ymin_h = NULL, ymax_h = NULL,
                              size = 0.5)
    #make errorbarh grobs
    errorbarh_grob <- GeomErrorbarh$draw_panel(data = data_errbarh,
                                               panel_params = panel_params, coord = coord,
                                               height = height)
    point_grob <- GeomPoint$draw_panel(data = data, panel_params = panel_params,
                                       coord = coord, na.rm = na.rm)
    gt <- grobTree(
      errorbar_grob,
      errorbarh_grob,
      point_grob, name = 'geom_point_error')
    gt
  }
)
 

Наконец, нам нужна функция для вызова пользователем, которая создаст Layer объект.

 geom_point_error <- function(mapping = NULL, data = NULL,
                             position = "identity",
                             ...,
                             na.rm = FALSE,
                             show.legend = NA,
                             inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = StatPointError,
    geom = GeomPointError,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}
 

Теперь мы можем проверить, правильно ли это работает

 ggplot(data = mtcars, mapping = aes(x = drat, y = mpg))  
  geom_point(shape = 21, fill = 'black', color = 'white', size = 3)  
  geom_point_error(color = "red", width = .1, height = .3)
 

 ggplot(data = mtcars, mapping = aes(x = drat, y = mpg))  
  geom_point(shape = 21, fill = 'black', color = 'white', size = 3)  
  geom_point_error(aes(color = hp>100))
 

^{Создано 2021-05-18 пакетом reprex (v1.0.0)}

Очевидно, что вы могли бы сделать с этим гораздо больше, включив дополнительную эстетику по умолчанию, чтобы вы могли отдельно контролировать цвет и размер линий/точек (возможно, захотите переопределить GeomPointError$setup_data() , чтобы все отображалось правильно).

Наконец, эта геометрия довольно наивна в том смысле, что она предполагает x y , что сопоставления данных и являются непрерывными. Он по-прежнему работает со смешиванием непрерывного и дискретного, но выглядит немного обалденно

 ggplot(mpg, aes(cty, model))  
    geom_point()  
    geom_point_error(color = 'red')