我從
使用相同的想法,我嘗試使用我的資料如下:
library(tidyverse)
library(tidytable)
library(ggforce)
library(ggtext)
library(camcorder)
library(bibliometrix)
library(bibliometrixData)
data(management)
M <- metaTagExtraction(management, "AU_CO")
CO <-
tidytable(
Country = unlist(strsplit(M$AU_CO,";"))
, year = rep(M$PY, lengths(strsplit(M$AU_CO,";")))
, nAuPerArt = rep(lengths(strsplit(M$AU_CO,";")),lengths(strsplit(M$AU_CO,";")))
)
df0 <-
CO %>%
summarise.(
frequency = length(Country)
, frequencyFractionalized = sum(1/nAuPerArt)
, .by = c(Country, year)
) %>%
arrange.(Country, year)
df1 <-
df0 %>%
mutate.(
min_year = min(year)
, n_total = sum(frequency)
, .by = Country
) %>%
mutate.(Country = fct_reorder(Country, min_year)) %>%
count(Country, n_total, min_year, year) %>%
mutate.(
a_deg = as.numeric(Country) * 2.7 8.5
, a = a_deg * pi/180
, x = -(year - min(year) 10) * cos(a pi/2.07)
, y = (year - min(year) 10) * sin(a pi/2.07)
, label_a = ifelse(a_deg > 180, 270 - a_deg, 90 - a_deg)
, h = ifelse(a_deg > 180, 1, 0)
, label = ifelse(h == 0,
paste0(Country, " <span style = 'color:darkorange;'>(", n_total, ")</span>"),
paste0(" <span style = 'color:darkorange;'>(", n_total, ")</span>", Country))
) %>%
arrange.(as.character(Country), year)
df1
# df1 %>% view()
Years <-
tidytable(
r = seq(
from = 10
, to = 280
, length.out = 12
)
, l = seq(from = min(df0$year), to = max(df0$year), by = 3)
) %>%
mutate.(
lt = ifelse(row_number.() %% 2 == 0, "dotted", "solid")
)
Years
f1 = "Porpora"
gg_record(dir = "temp", device = "png", width = 10, height = 11, units = "in", dpi = 320)
ggplot(data = df1)
# Purple points
geom_point(data = df1, aes(x = x, y = y, size = n * 10), shape = 21, stroke = 0.15, fill = "purple")
# Year circles
geom_circle(
data = Years
, aes(x0 = 0, y0 = 0, r = r, linetype = lt), size = 0.08, color = "grey50"
)
# Year labels
geom_label(
data = Years
, aes(x = 0, y = r, label = l), size = 3, family = f1, label.padding = unit(0.25, "lines"), label.size = NA, fill = "grey95", color = "grey70")
# Orange points (totals)
geom_point(aes(x = -290 * cos(a pi/2.07), y = 290 * sin(a pi/2.07), size = n_total), stat = "unique", shape = 21, stroke = 0.5, fill = "orange")
# Family names and totals
geom_richtext(aes(x = -305 * cos(a pi/2.07),
y = 305 * sin(a pi/2.07),
label = label,
angle = label_a,
hjust = h), stat = "unique", Country = f1, size = 3.5,
fill = NA, label.color = NA, color = "#0b5029")
# Annotations
annotate("text", 0, 293, label = "Total", Country = f1, color = "orange")
scale_size_continuous(range = c(0, 8))
scale_color_viridis_c(option = "turbo")
coord_fixed(clip = "off", xlim = c(-400, 400))
# labs(
# caption = "<span style = 'font-size:30px;'>Taxonomic publications, 1757-2021</span><br>
# Publications by family and year <span style = 'color:purple;'>(purple circles)</span>and total publications by family <span style = 'color:darkorange;'>(orange circles and text)</span><br>
# <span style = 'color:black;'>Source: World Spider Catalog - Graphic: Georgios Karamanis</span>"
# )
theme_void()
theme(
legend.position = "none",
plot.background = element_rect(fill = "grey95", color = NA),
plot.margin = margin(0, 20, 20, 20),
plot.caption = element_markdown(family = f1, hjust = 0.5, margin = margin(100, 0, -100, 0), size = 14, lineheight = 1.4, color = "#0b5029")
)
產生以下圖表

但是,我在生成的圖表方面面臨兩個問題。
- 如何正確對齊粉紅色點?
- 如何使用整個圓圈作為國名?
已編輯
尋找可用于不同資料集的更簡潔和可重現的代碼。最好尋找可以處理不同資料集的通用函式。
uj5u.com熱心網友回復:
您可以在函式內對 x 和 y 值進行計算,以構建ggplot將圓一直延伸并為標簽提供正確高度的函式。
我已經調整了一個函式來處理其他資料集。這需要一個整潔格式的資料集,其中:
- '年' 列
- 每個“事件”一行
- 分組變數(例如國家/地區)
我使用這里的諾貝爾獎獲得者資料作為示例資料集來展示實際中的函式。資料設定:
library(tidyverse)
library(ggforce)
library(ggtext)
nobel <- read_csv("archive.csv")
# Filtering in this example to create a plottable dataset
nobel_filt <- nobel %>%
mutate(country = fct_lump_n(factor(`Birth Country`), n = 50)) %>%
filter(country != "Other")
nobel_filt
#> # A tibble: 883 x 19
#> Year Category Prize Motivation `Prize Share` `Laureate ID` `Laureate Type`
#> <dbl> <chr> <chr> <chr> <chr> <dbl> <chr>
#> 1 1901 Chemistry The ~ "\"in rec~ 1/1 160 Individual
#> 2 1901 Literature The ~ "\"in spe~ 1/1 569 Individual
#> 3 1901 Medicine The ~ "\"for hi~ 1/1 293 Individual
#> 4 1901 Peace The ~ <NA> 1/2 462 Individual
#> 5 1901 Peace The ~ <NA> 1/2 463 Individual
#> 6 1901 Physics The ~ "\"in rec~ 1/1 1 Individual
#> 7 1902 Chemistry The ~ "\"in rec~ 1/1 161 Individual
#> 8 1902 Literature The ~ "\"the gr~ 1/1 571 Individual
#> 9 1902 Medicine The ~ "\"for hi~ 1/1 294 Individual
#> 10 1902 Peace The ~ <NA> 1/2 464 Individual
#> # ... with 873 more rows, and 12 more variables: Full Name <chr>,
#> # Birth Date <date>, Birth City <chr>, Birth Country <chr>, Sex <chr>,
#> # Organization Name <chr>, Organization City <chr>,
#> # Organization Country <chr>, Death Date <date>, Death City <chr>,
#> # Death Country <chr>, country <fct>
然后,此函式將資料框作為引數,以及要分組的列的名稱和標記時間段的列的名稱。它不是超級簡潔,因為有很多資料處理正在進行。但希望在一個函式中它更整潔。
circle_plot <- function(data, group_var, time_var) {
df_full <-
data %>%
select(group = {{group_var}}, year = {{time_var}}) %>%
mutate(group = factor(group),
group = fct_reorder(group, year, .fun = min),
order = as.numeric(group))
year_vals <-
tibble(year = as.character(seq(min(df_full$year), max(df_full$year), 1)),
level = 1 1:length(year))
y_vals <- year_vals %>%
bind_rows(tribble(~ year, ~ level,
"total", max(year_vals$level) 5,
"title", max(year_vals$level) 10
))
year_labs <-
tibble(year = as.character(floor(seq(
min(df_full$year), max(df_full$year), length.out = 10
)))) %>%
left_join(y_vals, by = "year")
x_len <- max(df_full$order)
df_ang <- df_full %>%
mutate(year = as.character(year)) %>%
count(group, order, year) %>%
left_join(y_vals, by = "year") %>%
mutate(a_deg = order * 350/x_len 5,
x = - level * cos(a_deg * pi/180 pi/2.07),
y = level * sin(a_deg * pi/180 pi/2.07))
df_lab <- df_ang %>%
group_by(group, a_deg) %>%
summarise(n_total = n()) %>%
mutate(
group_name = str_trunc(as.character(group), 30),
label_a = ifelse(a_deg > 180, 270 - a_deg, 90 - a_deg),
h = ifelse(a_deg > 180, 1, 0),
label = ifelse(
h == 0,
paste0(
group_name,
" <span style = 'color:darkorange;'>(",
n_total,
")</span>"
),
paste0(
"<span style = 'color:darkorange;'>(",
n_total,
")</span> ",
group_name
)
),
year = "title"
) %>%
left_join(y_vals, by = "year") %>%
mutate(
x = -level * cos(a_deg * pi / 180 pi / 2.07),
y = level * sin(a_deg * pi / 180 pi / 2.07),
total_x = -(level - 5) * cos(a_deg * pi / 180 pi / 2.07),
total_y = (level - 5) * sin(a_deg * pi / 180 pi / 2.07)
)
ggplot()
geom_circle(
data = year_labs,
aes(
x0 = 0,
y0 = 0,
r = level
),
size = 0.08,
color = "grey50"
)
geom_label(
data = year_labs,
aes(x = 0, y = level, label = year),
size = 3,
label.padding = unit(0.25, "lines"),
label.size = NA,
fill = "grey95",
color = "grey70"
)
geom_point(
data = df_ang,
aes(x = x, y = y, size = n),
shape = 21,
stroke = 0.15,
fill = "purple"
)
geom_point(
data = df_lab,
aes(total_x, total_y,
size = n_total
),
stat = "unique",
shape = 21,
stroke = 0.5,
fill = "orange"
)
geom_richtext(
data = df_lab,
aes(x, y,
label = label,
angle = label_a,
hjust = h
),
stat = "unique",
size = 4,
fill = NA,
label.color = NA,
color = "#0b5029"
)
annotate(
"text",
0,
y = y_vals[y_vals$year=="total",]$level,
label = "Total",
color = "orange",
size = 4,
vjust = 0
)
scale_size_continuous(range = c(1, 9))
scale_color_viridis_c(option = "turbo")
coord_fixed(clip = "off", xlim = c(-120, 120))
theme_void()
theme(
legend.position = "none",
plot.background = element_rect(fill = "grey95", color = NA),
plot.margin = margin(100, 180, 150, 180),
)
}
circle_plot(nobel_filt, `Birth Country`, Year)
# ggsave("test.png", height = 10, width = 10)
這將創建以下圖表:

最大的麻煩(正如您在此處看到的)將更改邊距以適應長標簽并匯出適合文本大小/年份圈數的繪圖大小。這可能必須在每個圖上進行試驗。您可以margin將函式內的呼叫調整為合理的默認值,或者theme向函式呼叫添加更多元素,如下所示:
circle_plot(nobel_filt, `Birth Country`, Year)
theme(plot.margin = margin(80, 150, 120, 150))
希望有幫助!
由reprex 包(v2.0.1)于 2021 年 12 月 27 日創建
轉載請註明出處,本文鏈接:https://www.uj5u.com/net/395365.html
