Возможно ли реализовать функциональность base-r plot type-b = g в ggplot2?

Ответ 1

Немного хакерский способ сделать это - наложить маленькую черную точку на большую белую точку:

ggplot(pressure, aes(temperature, pressure)) + 
  geom_line() +
  geom_point(size=5, colour="white") + 
  geom_point(size=2) + 
  theme_classic() +
  theme(panel.background = element_rect(colour = "black"))

Кроме того, следуя толщине границы контрольной точки в ggplot, в версии 2.0.0 ggplot2 можно использовать аргумент stroke geom_point для управления толщиной границы, поэтому две точки geom_point можно заменить просто (например) geom_point(size=2, shape=21, fill="black", colour="white", stroke=3), устраняя необходимость наложения точек.

Ответ 2

Один из вариантов, который менее удачен, чем ручное сопоставление цвета обводки с фоном панели, - это предварительно получить фон панели, либо из theme_get для темы по умолчанию, либо с определенной темой, которую вы будете использовать. Использование обведенной формы, например, 21 позволяет сделать внутренний круг черным, а обводку - цветом фона.

library(ggplot2)

bgnd <- theme_get()$panel.background$fill

ggplot(pressure, aes(x = temperature, y = pressure)) + 
  geom_line() + 
  geom_point(shape = 21, fill = "black", size = 2, stroke = 1, color = bgnd)

Пара вопросов SO (здесь один) имеет дело с математикой за сокращение отрезков между точками. Это простая, но утомительная геометрия. Но со времени, когда этот вопрос был впервые опубликован, вышел пакет с lemon, в котором есть что сделать. Он получил аргументы в пользу того, как рассчитать сокращение, которое, вероятно, потребует простой настройки.

library(lemon)

ggplot(pressure, aes(x = temperature, y = pressure)) +
  geom_pointline()

Ответ 3

Хорошо, у меня есть реализация geom, которая не зависит от жесткого кодирования и не должна иметь странных смещений. Это, в сущности, реализация geom_point(), которая рисует траекторию * между точками, рисует большую точку фона с цветами, заданными для фона панели, а затем нормальные точки.

* обратите внимание, что поведение пути заключается не в соединении точек вдоль оси x, а в порядке строк в data.frame который передается ggplot. Вы можете отсортировать данные заранее, если хотите geom_line() поведение geom_line().

Основная проблема для меня заключалась в том, чтобы получить внутреннюю работу кода для рисования geom, чтобы получить тему текущего графика и извлечь цвет фона панели. Из-за этого я очень не уверен, насколько стабильной это будет (и приветствовал бы любые подсказки), но по крайней мере это работает.

РЕДАКТИРОВАТЬ: должно быть более стабильным сейчас

Давайте ggproto, по- ggproto, ggproto объектному коду ggproto:

GeomPointPath <- ggproto(
  "GeomPointPath", GeomPoint,
  draw_panel = function(self, data, panel_params, coord, na.rm = FALSE)
  {

    # bgcol <- sys.frame(4)$theme$panel.background$fill
    # if (is.null(bgcol)) {
    #   bgcol <- theme_get()$panel.background$fill
    # }

    # EDIT: More robust bgcol finding -----------
    # Find theme, approach as in https://github.com/tidyverse/ggplot2/issues/3116
    theme <- NULL
    for(i in 1:20) {
      env <- parent.frame(i)
      if("theme" %in% names(env)) {
        theme <- env$theme
        break
      }
    }
    if (is.null(theme)) {
      theme <- theme_get()
    }

    # Lookup likely background fills
    bgcol <- theme$panel.background$fill
    if (is.null(bgcol)) {
      bgcol <- theme$plot.background$fill
    }
    if (is.null(bgcol)) {
      bgcol <- theme$rect$fill
    }
    if (is.null(bgcol)) {
      # Default to white if no fill can be found
      bgcol <- "white"
    }
    # END EDIT ------------------

    if (is.character(data$shape)) {
      data$shape <- ggplot2:::translate_shape_string(data$shape)
    }

    coords <- coord$transform(data, panel_params)

    # Draw background points
    bgpoints <- grid::pointsGrob(
      coords$x, coords$y, pch = coords$shape,
      gp = grid::gpar(
        col = alpha(bgcol, NA), 
        fill = alpha(bgcol, NA),
        fontsize = (coords$size * .pt + coords$stroke * .stroke/2) * coords$mult,
        lwd = coords$stroke * .stroke/2
      )
    )

    # Draw actual points
    mypoints <- grid::pointsGrob(
      coords$x, coords$y, pch = coords$shape, 
      gp = grid::gpar(
        col = alpha(coords$colour, coords$alpha), 
        fill = alpha(coords$fill, coords$alpha), 
        fontsize = coords$size * .pt + coords$stroke * .stroke/2, 
        lwd = coords$stroke * .stroke/2
      )
    )

    # Draw line
    myline <- grid::polylineGrob(
      coords$x, coords$y, 
      id = match(coords$group, unique(coords$group)),
      default.units = "native",
      gp = grid::gpar(
        col = alpha(coords$colour, coords$alpha),
        fill = alpha(coords$colour, coords$alpha),
        lwd = (coords$linesize * .pt),
        lty = coords$linetype,
        lineend = "butt",
        linejoin = "round", linemitre = 10
      )
    )

    # Place graphical objects in a tree
    ggplot2:::ggname(
      "geom_pointpath",
      grid::grobTree(myline, bgpoints, mypoints) 
    )
  },
  # Set some defaults, assures that aesthetic mappings can be made
  default_aes = aes(
    shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5,
    linesize = 0.5, linetype = 1, mult = 3,
  )
)

Наблюдающие люди, возможно, заметили строку bgcol <- sys.frame(4)$theme$panel.background$fill. Я не смог найти другой способ доступа к текущей теме сюжета, не настроив хотя бы несколько других функций для передачи темы в качестве аргумента. В моей версии ggplot (3.1.0) 4-й sys.frame() является средой ggplot2:ggplot_gtable.ggplot_built которой оценивается код рисования geom. Довольно легко представить, что эта функция может быть обновлена в будущем. -which может изменить scoping-, следовательно, предупреждение о стабильности. В качестве резервной копии по умолчанию используются глобальные настройки темы, когда не удается найти текущую тему.

РЕДАКТИРОВАТЬ: теперь должно быть более стабильным

Вперед к обертке слоя, которая в значительной степени говорит сама за себя:

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

Добавление его в ggplot должно быть привычным делом. Просто установите для темы значение theme_gray() по умолчанию, чтобы проверить, действительно ли она принимает текущую сюжетную тему.

theme_set(theme_gray())
g <- ggplot(pressure, aes(temperature, pressure)) +
  geom_pointpath() +
  theme(panel.background = element_rect(fill = "dodgerblue"))

Конечно, этот метод будет затенять линии сетки фоновыми точками, но это был компромисс, который я был готов сделать, чтобы предотвратить сомнительность из-за сокращения пути линии. Размеры линий, типы линий и относительный размер точек фона могут быть установлены с помощью aes(linesize =..., linetype =..., mult =...) или для аргумента ... в geom_pointpath(). Он наследует другую эстетику от GeomPoint.

Ответ 4

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

Я еще немного подумал над этим вопросом и признаю, что геометрический подход действительно лучший подход по сравнению с точечным. Тем не менее, геометрический подход имеет свой собственный набор проблем, а именно, что любая попытка предварительного вычисления координат до времени рисования даст вам некоторый перекос в той или иной форме (см. Следующий вопрос из @Tjebo).

Это почти невозможно знать соотношение сторон или точные размеры сюжета априори, за исключением того, установив соотношение сторон вручную или с помощью space аргумент facet_grid(). Поскольку это невозможно, любой предварительно вычисленный набор координат будет неадекватным, если размер графика будет изменен.

Я бесстыдно украл некоторые хорошие идеи от других людей, так что спасибо @Tjebo и @moody_mudskipper за математику и кредит ggplot guru thomasp85 и пакет ggforce для расчета во время вдохновения.

С этим; сначала мы определим наше ggproto, как и раньше, теперь создадим собственный класс grob для нашего пути. Важной деталью является то, что мы конвертируем наши координаты xy в формальные единицы.

GeomPointPath <- ggproto(
  "GeomPointPath", GeomPoint,
  draw_panel = function(data, panel_params, coord, na.rm = FALSE){

    # Default geom point behaviour
    if (is.character(data$shape)) {
      data$shape <- translate_shape_string(data$shape)
    }
    coords <- coord$transform(data, panel_params)
    my_points <- pointsGrob(
      coords$x, 
      coords$y, 
      pch = coords$shape, 
      gp = gpar(col = alpha(coords$colour, coords$alpha), 
                fill = alpha(coords$fill, coords$alpha), 
                fontsize = coords$size * .pt + coords$stroke * .stroke/2, 
                lwd = coords$stroke * .stroke/2))

    # New behaviour
    ## Convert x and y to units
    x <- unit(coords$x, "npc")
    y <- unit(coords$y, "npc")

    ## Make custom grob class
    my_path <- grob(
      x = x,
      y = y,
      mult = (coords$size * .pt + coords$stroke * .stroke/2) * coords$mult,
      name = "pointpath",
      gp = grid::gpar(
        col = alpha(coords$colour, coords$alpha),
        fill = alpha(coords$colour, coords$alpha),
        lwd = (coords$linesize * .pt),
        lty = coords$linetype,
        lineend = "butt",
        linejoin = "round", linemitre = 10
      ),
      vp = NULL,
      ### Now this is the important bit:
      cl = 'pointpath'
    )

    ## Combine grobs
    ggplot2:::ggname(
      "geom_pointpath",
      grid::grobTree(my_path, my_points) 
    )
  },
  # Adding some defaults for lines and mult
  default_aes = aes(
    shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5,
    linesize = 0.5, linetype = 1, mult = 0.5,
  )
)

Благодаря магии объектно-ориентированного программирования мы теперь можем написать новый метод для нашего нового класса grob. Хотя это может быть неинтересно само по себе, особенно интересно, если мы напишем этот метод для makeContent, который вызывается каждый раз, когда рисуется grob. Итак, давайте напишем метод, который вызывает математические операции с точными координатами, которые графическое устройство будет использовать:

# Make hook for drawing
makeContent.pointpath <- function(x){
  # Convert npcs to absolute units
  x_new <- convertX(x$x, "mm", TRUE)
  y_new <- convertY(x$y, "mm", TRUE)

  # Do trigonometry stuff
  hyp <- sqrt(diff(x_new)^2 + diff(y_new)^2)
  sin_plot <- diff(y_new) / hyp 
  cos_plot <- diff(x_new) / hyp

  diff_x0_seg <- head(x$mult, -1) * cos_plot
  diff_x1_seg <- (hyp - head(x$mult, -1)) * cos_plot
  diff_y0_seg <- head(x$mult, -1) * sin_plot
  diff_y1_seg <- (hyp - head(x$mult, -1)) * sin_plot

  x0 = head(x_new, -1) + diff_x0_seg
  x1 = head(x_new, -1) + diff_x1_seg
  y0 = head(y_new, -1) + diff_y0_seg
  y1 = head(y_new, -1) + diff_y1_seg
  keep <- unclass(x0) < unclass(x1)

  # Remove old xy coordinates
  x$x <- NULL
  x$y <- NULL

  # Supply new xy coordinates
  x$x0 <- unit(x0, "mm")[keep]
  x$x1 <- unit(x1, "mm")[keep]
  x$y0 <- unit(y0, "mm")[keep]
  x$y1 <- unit(y1, "mm")[keep]

  # Set to segments class
  class(x)[1] <- 'segments'
  x
}

Теперь все, что нам нужно, это оболочка слоя, как и раньше, которая не делает ничего особенного:

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

Демонстрация:

g <- ggplot(pressure, aes(temperature, pressure)) +
  # Ribbon for showing no point-over-point background artefacts
  geom_ribbon(aes(ymin = pressure - 50, ymax = pressure + 50), alpha = 0.2) +
  geom_pointpath()

И это должно быть стабильным для любого измененного соотношения сторон. Вы можете указать aes(mult =...) или просто mult =... для контроля размера промежутков между сегментами. По умолчанию он пропорционален размерам точек, поэтому изменение размера точек при сохранении контуров зазора является сложной задачей. Сегменты, которые короче двухкратного зазора, удаляются.