График подсолнечника с использованием ggplot2

Я думал, что это будет очень сложно, но благодаря этому замечательному ответу о нестандартных формах в ggplot2 я смог это сделать.

Библиотека фигур по умолчанию, используемая R, недостаточно обширна для этого, поэтому вам нужно использовать grid, чтобы создавать свои собственные фигуры, рисуя линии между координатами по вашему выбору. ggpmisc позволит вам добавить эти гробы в ggplot с помощью «geom_grob». Вот код:

library(ggpmisc)
library(grid)
library(dplyr)
library(ggplot2)

set.seed(pi)

## Function to make shape based on count
make_shape <- function(n){
  
  # We need our new shapes to have the same aspect ratio as the whole plot
  dev_size <- dev.size()
  dev_ratio <- dev_size[2]/dev_size[1]
  
  # If n == 1, make a point
  if (n == 1) grob <- pointsGrob(0.5, 0.5, pch = 16)
  else {
    
    ## If n > 1, define the extremeties of the 'star'
    ## (A sequence of length n that starts at 1 nth of the circle and ends at a whole circle)
    extremities <- 2 * pi * seq(1/n, 1, length.out = n)
    
    ## Create x and y vectors for the points of the shape
    x <- y <- numeric(2 * n - 1)
    
    ## Odd elemetns of x are the sin() of the angles of the extremities
    ## Use dev_ratio to get the lengths of each petal consistent
    x[seq_along(x) %% 2 == 1] <- unit(0.5 + 0.15 * dev_ratio * sin(extremities), "npc")
    ## At even elemnts of x, we go back to the centre, creating a star shape
    x[seq_along(x) %% 2 == 0] <- 0.5
    
    ## Odd elements of y are the cos() of the angles
    y[seq_along(y) %% 2 == 1] <- unit(0.5 + 0.15 * cos(extremities), "npc")
    y[seq_along(y) %% 2 == 0] <- 0.5
    
    ## Create a grob
    grob <- linesGrob(x, y , gp = gpar(lwd = 2))
  }
  grob
}

test <- tibble(
  x = 1:10,
  count = 1:10
) |> 
  rowwise() |> 
  mutate(shape = list(make_shape(count)))

ggplot(test) + 
  geom_grob(aes(x, y = "Shapes",  label = shape)) +
  scale_x_continuous(breaks = 1:10) + 
  
  labs(y = NULL, x = "N", title = "Sunflower plot example") + 
  theme_minimal()+ 
  theme(panel.grid.minor = element_blank(),
        panel.grid.major.y = element_blank())

^{Created on 2024-05-29 with reprex v2.1.0}

Вдохновленный комментарием капитана Хэта ниже, для независимости от соотношения сторон вы можете сделать это:

sunflower_plot <- function(
  d, 
  petal_len = 0.05, 
  petal_col = "red", 
  dot_col = "black") 
{
  dev_size <- dev.size()
  dev_ratio <- dev_size[2]/dev_size[1]

  tmp <- d %>% 
    # Prepare 
    group_by(x, y) %>% 
    # How many petals are needed at this point?   
    summarise (N = n(), .groups = "keep") %>% 
    # Define the petals
    group_map(
      function(.x, .y) {
        .x  %>% 
          expand(nesting(x, y, N), n = (1:N)) %>% 
          mutate(
            Theta = 2 * n * pi / N,
            x1 = ifelse(N == 1, x, x + petal_len * sin(Theta) * dev_ratio),
            y1 = ifelse(N == 1, y, y + petal_len * cos(Theta))
          )
      },
      .keep = TRUE
    ) %>% 
    bind_rows() 
  tmp %>%
    ggplot() +
      # Draw the petals for non-singleton points
      geom_segment(
       aes(x = x, y = y, xend = x1, yend = y1), 
       colour = petal_col
      ) +
      # Draw singleton points
      geom_point(
        data = tmp %>% filter(N == 1), 
        aes(x = x, y = y), 
        colour = dot_col
      )
}

tb %>% sunflower_plot()

который дает

и

для образца с соотношением сторон, отличным от 1. Постоянная длина лепестков не будет сохранена, если соотношение сторон будет изменено после создания графика. (Например, при изменении размера панели просмотра RStudio.)

В качестве альтернативы вы можете использовать coord_fixed, чтобы исправить соотношение сторон графика, даже если размер графика был изменен после его создания. Однако это может означать, что не все окно используется для отображения графика.

sunflower_plot1 <- function(
  d, 
  petal_len = 0.05, 
  petal_col = "red", 
  dot_col = "black", 
  ratio = 1
) {
  tmp <- d %>% 
    group_by(x, y) %>% 
    summarise (N = n(), .groups = "keep") %>% 
    group_map(
      function(.x, .y) {
        .x  %>% 
          expand(nesting(x, y, N), n = (1:N)) %>% 
          mutate(
            Theta = 2 * n * pi / N,
            x1 = ifelse(N == 1, x, x + petal_len * sin(Theta) * ratio),
            y1 = ifelse(N == 1, y, y + petal_len * cos(Theta))
          )
      },
      .keep = TRUE
    ) %>% 
    bind_rows() 
  tmp %>%
    ggplot() +
      geom_segment(
        aes(x = x, y = y, xend = x1, yend = y1), 
        colour = petal_col
      ) +
      geom_point(
        data = tmp %>% filter(N == 1), 
        aes(x = x, y = y), 
        colour = dot_col
      ) +
      coord_fixed(ratio)
}

tb %>% sunflower_plot(ratio = 0.25)

Для сюжета, который одновременно реагирует на изменения соотношения сторон и заполняет область просмотра, я думаю, вам нужно будет определить новый geom.

Поздний вариант для рассмотрения (на примере набора данных mtcars).

У подсолнуха ограничено 8 лепестков (количество лепестков, вероятно, станет труднее различить в большем количестве), поэтому потребуется группирование для количества более 8.

library(ggfoundry)
#> Loading required package: ggplot2
library(dplyr)
library(patchwork)

# geom_count
p1 <- ggplot(mtcars, aes(cyl, carb)) +
  geom_count() +
  geom_text(aes(label = after_stat(n)), stat = "sum", colour = "white") +
  ggtitle("geom_count") +
  theme_bw()

# sunflower
shapes <- shapes_cast() |>
  filter(set == "flower") |>
  pull(shape)

p2 <- 
  ggplot(mtcars, aes(cyl, carb)) +
  geom_casting(aes(shape = factor(after_stat(n)), group = after_stat(n)), 
               size = 0.25, stat = "sum", colour = "#582d03", fill = "#ffdb3b") +
  scale_shape_manual(values = shapes) +
  labs(title = "Sunflower with ggfoundry", shape = "Petals") +
  theme_bw()

# Plot side-by-side
p1 + p2 + plot_layout(guides = "collect", axes = "collect")

^{Created on 2024-05-31 with reprex v2.1.0}