レーダーチャートの作り方

こちらで紹介しているコードは、改変・転載・二次配布等は全てOKです。常識の範囲内でご活用ください。また、コードが動作しない時は一報いただけると助かります。

使い方

サンプルデータの準備

tbl <- tibble(
  Group = c(rep('X', 5), rep('Y', 5)),
  Category = rep(c('国語', '数学', '社会', '理科', '英語'), 2),
  Value = c(3, 5, 2, 8, 7, 10, 3, 9, 6, 5),
) %>%
  mutate(Category = factor(Category, levels = c('国語', '数学', '社会', '理科', '英語'))) 

サンプルデータの内容

サンプルコード

render_radar(tbl,
             name = Category,
             value = Value,
             fill = Group,
             alpha = 0.5,
             breaks = seq(0, 10, 2),
             breaks_label = T,
             breaks_label_alpha = 0.5,
             family = 'Osaka')

出力結果

生成用コード

# install.package('tidyverse')
library(tidyverse)

# Rendering a radar chart
render_radar <- function(df, ..., name, value,
                         fill = NULL,
                         alpha = 1,
                         font_size = 10,
                         breaks = 0:10,
                         breaks_label = FALSE,
                         breaks_label_alpha = 1,
                         breaks_label_font_size = 2,
                         family = '') {
  
  # NSE
  name_quo <- rlang::enquo(name)
  value_quo <- rlang::enquo(value)
  fill_quo <- rlang::enquo(fill)

  # Check arguments
  if (!is.data.frame(df)) {
    stop('df must be a data frame')
  }
  
  # Create breaks df And custom coordinate system
  name_levels <- pull(df, !!name_quo) %>% unique()
  breaks.df <- crossing(x = name_levels, y = breaks)
  cord_radar <- ggproto('CordRadar',
                        CoordPolar,
                        theta = 'x',
                        r = 'y',
                        start = -pi/length(name_levels),
                        direction = 1,
                        is_linear = function(coord) TRUE)
  
  # Initialize plot
  g <- ggplot(df, aes(x = !!name_quo, y = !!value_quo)) +
    geom_line(data = breaks.df, aes(x = x, y = y, group = x), size = 0.15) +
    geom_polygon(data = breaks.df, aes(x = x, y = y, group = y), size = 0.15, colour = 'black', alpha = 0) +
    cord_radar +
    labs(x = NULL, y = NULL) +
    theme_bw(base_family = family) +
    theme(axis.text.x = element_text(family = family, size = font_size),
          axis.ticks.y = element_blank(),
          axis.text.y = element_blank(),
          panel.grid.major = element_blank())

  # Conditionally add color
  if (is.null(rlang::eval_tidy(fill_quo, data = df))) {
    g <- g + geom_point(aes()) +
      geom_polygon(aes(group = 1), color = 'black', alpha = alpha)
  } else {
    g <- g + geom_point(aes(colour = !!fill_quo)) +
      geom_polygon(aes(group = !!fill_quo, colour = !!fill_quo, fill = !!fill_quo), alpha = alpha)
  }

  # Conditionally add the breaks_label
  if (breaks_label) {
    breaks_label.df <- data.frame(x = 1, y = breaks)
    g <- g + geom_label(data = breaks_label.df,
                        aes(x = x, y = y, label = y),
                        fill = 'white',
                        alpha = breaks_label_alpha,
                        size = breaks_label_font_size,
                        family = family)
  }

  # Return the plot
  g
}
Sponsored Link