こちらで紹介しているコードは、改変・転載・二次配布等は全てOKです。常識の範囲内でご活用ください。また、コードが動作しない時は一報いただけると助かります。
使い方
サンプルデータの準備
1 2 3 4 5 6 | 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 ( '国語' , '数学' , '社会' , '理科' , '英語' ))) |
サンプルデータの内容

サンプルコード
1 2 3 4 5 6 7 8 9 | 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' ) |
出力結果

生成用コード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | # 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 } |