Р: Как объединить прямые линии многоугольника и отрезки с полярными координатами? - PullRequest
Новая
       27

Р: Как объединить прямые линии многоугольника и отрезки с полярными координатами?

2 голосов
/ 15 мая 2019

Допустим, у меня есть линейные данные в 6 направлениях с некоторой длиной. Я хочу сделать диаграмму в стиле «роза ветров». 

###create sample data
a <- c(1,2,3,4,5,6) #directions
perc <- c(0.15,0.05,0.3,0.15,0.05,0.3) #percentual lengths
lab <- c("A", "B", "C", "D", "E", "F") #labels of directions
data <- data.frame(a,perc,lab)

Я пробовал два варианта с ggplot2, используя coord_polar и coord_radar (вдохновленный статьей от Erwan Le Pennec: от параллельного графика до радиолокационного графика ). Каждый из них отчасти правильный и отчасти неправильный (с точки зрения моих ожиданий): 

#similar parameters in both variants:
chart_stuff <- list(
  geom_polygon(aes(x=a, y=perc, col = 1), fill=NA,show.legend = F),
  geom_segment(aes(x=as.factor(a), yend=perc, xend=as.factor(a), y=0), size=2),
  scale_x_discrete(labels=data$lab), 
  scale_y_continuous(labels = scales::percent, limits = c(0,0.31)), 
  theme_light(), 
  theme(axis.title = element_blank())
  )

#chart1
ggplot(data) +  
  chart_stuff+
  coord_polar(start=(-pi/6))+
  ggtitle("coord_polar: wrong polygon, good segments")

#chart2
#coord_radar function with modified start parameter:
coord_radar <- function (theta = "x", start = -pi/6, direction = 1) {
  theta <- match.arg(theta, c("x", "y"))
  r <- if (theta == "x") "y" else "x"
  ggproto("CordRadar", CoordPolar, theta = theta, r = r, start = start, 
          direction = sign(direction),
          is_linear = function(coord) TRUE)
}

ggplot(data) +   
  chart_stuff+
  coord_radar()+
  ggtitle("coord_radar: good polygon, wrong segments")

Выходы:

from https://i.ibb.co/0c8LJrt/charts.png

Итак, я хочу одно изображение с прямыми линиями границы многоугольника и сегментами, представляющими направления (в процентах). Я предполагаю, что ошибка может заключаться в смешении дискретного масштаба с непрерывным, но я не могу ее решить. Есть идеи?

1 Ответ

1 голос
/ 04 июня 2019

Объяснение

В функции draw_panel GeomSegment, является ли система координат линейной или нет влияет на как панель рисуется: 

> GeomSegment$draw_panel
<ggproto method>
  <Wrapper function>
    function (...) 
f(...)

  <Inner function (f)>
    function (data, panel_params, coord, arrow = NULL, arrow.fill = NULL, 
    lineend = "butt", linejoin = "round", na.rm = FALSE) 
{
    data <- remove_missing(data, na.rm = na.rm, c("x", "y", "xend", 
        "yend", "linetype", "size", "shape"), name = "geom_segment")
    if (empty(data)) 
        return(zeroGrob())
    if (coord$is_linear()) {
        coord <- coord$transform(data, panel_params)
        arrow.fill <- arrow.fill %||% coord$colour
        return(segmentsGrob(coord$x, coord$y, coord$xend, coord$yend, 
            default.units = "native", gp = gpar(col = alpha(coord$colour, 
                coord$alpha), fill = alpha(arrow.fill, coord$alpha), 
                lwd = coord$size * .pt, lty = coord$linetype, 
                lineend = lineend, linejoin = linejoin), arrow = arrow))
    }
    data$group <- 1:nrow(data)
    starts <- subset(data, select = c(-xend, -yend))
    ends <- plyr::rename(subset(data, select = c(-x, -y)), c(xend = "x", 
        yend = "y"), warn_missing = FALSE)
    pieces <- rbind(starts, ends)
    pieces <- pieces[order(pieces$group), ]
    GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow, 
        lineend = lineend)
}

coord_polarне является линейным, поскольку по умолчанию CoordPolar$is_linear() оценивается как ЛОЖЬ, поэтому geom_segment отрисовывается на основе GeomPath$draw_panel(...).

coord_radar, с другой стороны, является линейным, поскольку is_linear = function(coord) TRUE включенов его определении, поэтому geom_segment рисуется с использованием segmentsGrob(...).

Обходной путь

Мы можем определить нашу собственную версию GeomSegment, которая использует прежнюю опцию для draw_panel независимо от того, является ли координатаСистема линейна: 

GeomSegment2 <- ggproto("GeomSegment2",
                        GeomSegment,
                        draw_panel = function (data, panel_params, coord, arrow = NULL,
                                               arrow.fill = NULL, lineend = "butt", 
                                               linejoin = "round", na.rm = FALSE) {
                          data <- remove_missing(data, na.rm = na.rm, 
                                                 c("x", "y", "xend", "yend", "linetype", 
                                                   "size", "shape"), 
                                                 name = "geom_segment")                          
                          if (ggplot2:::empty(data)) 
                            return(zeroGrob())
                          # remove option for linear coordinate system
                          data$group <- 1:nrow(data)
                          starts <- subset(data, select = c(-xend, -yend))
                          ends <- plyr::rename(subset(data, select = c(-x, -y)), 
                                               c(xend = "x", yend = "y"), 
                                               warn_missing = FALSE)
                          pieces <- rbind(starts, ends)
                          pieces <- pieces[order(pieces$group), ]
                          GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow, 
                                              lineend = lineend)
                        })

geom_segment2 <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", 
                           ..., arrow = NULL, arrow.fill = NULL, lineend = "butt", 
                           linejoin = "round", na.rm = FALSE, show.legend = NA, 
                           inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomSegment2, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(arrow = arrow, arrow.fill = arrow.fill, 
                      lineend = lineend, linejoin = linejoin, na.rm = na.rm, 
                      ...))
}

Попробуйте: 

chart_stuff <- list(
  geom_polygon(aes(x=a, y=perc, col = 1), fill=NA,show.legend = F),
  # geom_segment2 instead of geom_segment
  geom_segment2(aes(x=as.factor(a), yend=perc, xend=as.factor(a), y=0), size=2), 
  scale_x_discrete(labels=data$lab), 
  scale_y_continuous(labels = scales::percent, limits = c(0,0.31)), 
  theme_light(), 
  theme(axis.title = element_blank())
)

ggplot(data) +   
  chart_stuff+
  coord_radar()+
  ggtitle("coord_radar: good polygon, good segments")

plot

...