こちらで紹介しているコードは、改変・転載・二次配布等は全て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
}