基于多面图中变量值的颜色轴文本
Color axis text based on variable value in a faceted plot
我有两个多面图，当给定变量的值为 NA 或 0 时，我希望轴文本为灰色。这目前适用于单个图，但当我对它们进行多面化时，文本颜色不匹配与酒吧价值。请参阅下面的代表：
# create df
text <-
" country domain var_name perc color
A 'domain c Val2 NA grey
A 'domain c' Val1 NA grey
A 'domain c' Val3 0.01670 orange
A 'domain c' Val8 0.00000 grey
A 'domain c' Val9 NA grey
A 'domain c' Val11 0.02510 orange
A 'domain c' Val19 0.01890 orange
A 'domain d' Val16 0.04840 purple
A 'domain a' Val5 0.00776 darkolivegreen4
A 'domain a' Val6 0.02390 darkolivegreen4
A 'domain a' Val7 0.00247 darkolivegreen4
A 'domain a' Val10 0.03840 darkolivegreen4
A 'domain a' Val13 0.02490 darkolivegreen4
A 'domain a' Val18 NA grey
A 'domain b' Val4 0.01630 navy
A 'domain b' Val14 0.01610 navy
A 'domain b' Val12 0.05180 navy
A 'domain b' Val17 0.01770 navy
A 'domain b' Val15 0.03550 navy
B 'domain c' Val2 0.01440 orange
B 'domain c' Val1 NA grey
B 'domain c' Val3 0.02590 orange
B 'domain c' Val8 0.00000 grey
B 'domain c' Val9 NaN grey
B 'domain c' Val11 0.02900 orange
B 'domain c' Val19 0.00000 grey
B 'domain d' Val16 0.00261 purple
B 'domain a' Val5 0.10900 darkolivegreen4
B 'domain a' Val6 0.00702 darkolivegreen4
B 'domain a' Val7 0.01330 darkolivegreen4
B 'domain a' Val10 0.00861 darkolivegreen4
B 'domain a' Val13 0.06050 darkolivegreen4
B 'domain a' Val18 0.07770 darkolivegreen4
B 'domain b' Val4 0.00797 navy
B 'domain b' Val14 0.05230 navy
B 'domain b' Val12 0.04290 navy
B 'domain b' Val17 0.03190 navy
B 'domain b' Val15 0.06940 navy"
tbl <- read.table(text = text, header = T, fill = T)
# overwrite coord_polar function
cp <- coord_polar(theta = "x")
cp$is_free <- function() TRUE
# plot
p <-
ggplot(tbl, aes(x = forcats::as_factor(var_name), y = perc)) +
cp +
geom_bar(stat = "identity", aes(fill = color)) +
scale_y_continuous(labels = scales::label_percent()) +
scale_fill_identity(name = "Domain") +
facet_grid(. ~ country, scales = "fixed") +
theme_bw() +
theme(aspect.ratio = 1,
strip.text = element_text(size = 16),
axis.title = element_text(size = 18),
title = element_text(size = 20),
axis.text.x = element_text(colour = tbl$color, face = "bold"),
legend.text = element_text(size = 14))
p
生成这张图片：
请注意，对于国家 B，当该变量的数量明显非零时，Var18 是灰色的。这是因为 A 国的那个值是 0。
我想避免使用 Grid::，但非常感谢任何有关如何克服此问题的建议！
所以我找到了一种使用网格修复轴颜色和比例图的方法。基于上述代表：
# Generate a function to get the legend of one of the ggplots
get_legend<-function(myggplot){
tmp <- ggplot_gtable(ggplot_build(myggplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
# From the full dataset, find the value of the country with the highest percent of any var_name
max <- round(max(tbl$perc), digits = 2)
# create a sequence of length 6 from 0 to the largest perc value
max_seq <- seq(0, max, length = 6)
# initiate empty list
my_list <- list()
# list of countries to loop through
my_sub <- c("A", "B")
现在我们遍历每个国家，将每个国家的地块保存到空列表中。
for(i in my_sub){
### Wrangle
tbl_sub <-
tbl %>%
dplyr::mutate(country = as.factor(country),
domain = as.factor(domain)) %>%
dplyr::filter(country == i),
dplyr::mutate(perc = ifelse(is.na(perc), 0, perc))
# Create custom coord_polar arguments
cp <- coord_polar(theta = "x", clip = "off")
cp$is_free <- function() TRUE
p <-
ggplot(dplyr::filter(tbl_sub, country == i),
aes(x = forcats::as_factor(var_name),
y = perc)) +
cp +
geom_bar(stat = "identity", aes(fill = color)) +
facet_grid(. ~ country, scales = "fixed") +
scale_y_continuous(breaks = c(max_seq),
labels = scales::label_percent(),
limits = c(0, max(max_seq))) +
scale_fill_identity(guide = "legend",
name = "Domain",
labels = c(darkolivegreen4 = "domain a",
orange = "domain c",
navy = "domain b" ,
purple = "domain d",
grey = "not applicable")) +
labs(x = "",
y = "") +
theme_bw() +
theme(aspect.ratio = 1,
panel.border = element_blank(),
strip.text = element_text(size = 16),
axis.title = element_text(size = 18),
title = element_text(size = 20),
axis.text.x = element_text(colour = tbl_new$color, face = "bold"),
legend.text = element_text(size = 14))
my_list[[i]] <- p
}
现在我们在列表中有了绘图，我们想玩转图例并使用 grid:: 和 gridExtra 将所有内容绘制在一起。
# pull legend from first ggplot in the list
legend <- get_legend(my_list[[1]])
# remove legends from all the plots in the list
for(i in 1:length(my_list)){
my_list[[i]] <- my_list[[i]] + theme(legend.position = "none")
}
# plot everything together
p <- grid.arrange(arrangeGrob(
grobs = my_list,
nrow = round(length(my_sub)/2, 0),
left = textGrob("Y axis",
gp = gpar(fontsize = 20),
rot = 90),
bottom = textGrob("X axis",
gp = gpar(fontsize = 20),
vjust = -3),
top = textGrob("Big plot",
gp = gpar(fontsize = 28, vjust = 2))),
legend = legend,
widths = c(9,1,1),
clip = F)
这会产生这张图片：
这些图按比例缩放到具有最大 perc 值 (0 - 11%) 的国家/地区，并且每个国家/地区都有唯一的灰色值，具体取决于 perc 列中是否有 0 或 NA。
我敢肯定还有更简单的解决方案，但现在这对我有用！
遵循 Z.Lin 的建议并使用 geom_text 会更快一些。这是一个快速的解决方法，但并不理想，因为文本不会在最边缘结束，而且无论出于何种原因，我都无法让 clip = off 在 coord_polar 中工作。
（我对数据做了一些修改，因为它很难阅读）
library(ggplot2)
maxval <- max(tbl$perc, na.rm = T)
ggplot(tbl, aes(x = var_name, y = perc)) +
coord_polar(theta = "x") +
geom_col(aes(fill = color)) +
geom_text(aes(x = var_name, y = maxval + 0.02, color = color, label = var_name),
size = 10*5/14) +
scale_fill_identity(name = "Domain") +
scale_color_identity(name = "Domain") +
facet_grid(. ~ country, scales = "fixed") +
theme_minimal(base_size = 10) +
theme(axis.text.x = element_blank())
#> Warning: Removed 6 rows containing missing values (position_stack).
数据
text <-
"country domain var_name perc color
A domainc Val2 NA grey
A domainc Val1 NA grey
A domainc Val3 0.01670 orange
A domainc Val8 0.00000 grey
A domainc Val9 NA grey
A domainc Val11 0.02510 orange
A domainc Val19 0.01890 orange
A domaind Val16 0.04840 purple
A domaina Val5 0.00776 darkolivegreen4
A domaina Val6 0.02390 darkolivegreen4
A domaina Val7 0.00247 darkolivegreen4
A domaina Val10 0.03840 darkolivegreen4
A domaina Val13 0.02490 darkolivegreen4
A domaina Val18 NA grey
A domainb Val4 0.01630 navy
A domainb Val14 0.01610 navy
A domainb Val12 0.05180 navy
A domainb Val17 0.01770 navy
A domainb Val15 0.03550 navy
B domainc Val2 0.01440 orange
B domainc Val1 NA grey
B domainc Val3 0.02590 orange
B domainc Val8 0.00000 grey
B domainc Val9 NaN grey
B domainc Val11 0.02900 orange
B domainc Val19 0.00000 grey
B domaind Val16 0.00261 purple
B domaina Val5 0.10900 darkolivegreen4
B domaina Val6 0.00702 darkolivegreen4
B domaina Val7 0.01330 darkolivegreen4
B domaina Val10 0.00861 darkolivegreen4
B domaina Val13 0.06050 darkolivegreen4
B domaina Val18 0.07770 darkolivegreen4
B domainb Val4 0.00797 navy
B domainb Val14 0.05230 navy
B domainb Val12 0.04290 navy
B domainb Val17 0.03190 navy
B domainb Val15 0.06940 navy"
tbl <- data.table::fread(text = text, header = T, fill = T)
我有两个多面图，当给定变量的值为 NA 或 0 时，我希望轴文本为灰色。这目前适用于单个图，但当我对它们进行多面化时，文本颜色不匹配与酒吧价值。请参阅下面的代表：
# create df
text <-
" country domain var_name perc color
A 'domain c Val2 NA grey
A 'domain c' Val1 NA grey
A 'domain c' Val3 0.01670 orange
A 'domain c' Val8 0.00000 grey
A 'domain c' Val9 NA grey
A 'domain c' Val11 0.02510 orange
A 'domain c' Val19 0.01890 orange
A 'domain d' Val16 0.04840 purple
A 'domain a' Val5 0.00776 darkolivegreen4
A 'domain a' Val6 0.02390 darkolivegreen4
A 'domain a' Val7 0.00247 darkolivegreen4
A 'domain a' Val10 0.03840 darkolivegreen4
A 'domain a' Val13 0.02490 darkolivegreen4
A 'domain a' Val18 NA grey
A 'domain b' Val4 0.01630 navy
A 'domain b' Val14 0.01610 navy
A 'domain b' Val12 0.05180 navy
A 'domain b' Val17 0.01770 navy
A 'domain b' Val15 0.03550 navy
B 'domain c' Val2 0.01440 orange
B 'domain c' Val1 NA grey
B 'domain c' Val3 0.02590 orange
B 'domain c' Val8 0.00000 grey
B 'domain c' Val9 NaN grey
B 'domain c' Val11 0.02900 orange
B 'domain c' Val19 0.00000 grey
B 'domain d' Val16 0.00261 purple
B 'domain a' Val5 0.10900 darkolivegreen4
B 'domain a' Val6 0.00702 darkolivegreen4
B 'domain a' Val7 0.01330 darkolivegreen4
B 'domain a' Val10 0.00861 darkolivegreen4
B 'domain a' Val13 0.06050 darkolivegreen4
B 'domain a' Val18 0.07770 darkolivegreen4
B 'domain b' Val4 0.00797 navy
B 'domain b' Val14 0.05230 navy
B 'domain b' Val12 0.04290 navy
B 'domain b' Val17 0.03190 navy
B 'domain b' Val15 0.06940 navy"
tbl <- read.table(text = text, header = T, fill = T)
# overwrite coord_polar function
cp <- coord_polar(theta = "x")
cp$is_free <- function() TRUE
# plot
p <-
ggplot(tbl, aes(x = forcats::as_factor(var_name), y = perc)) +
cp +
geom_bar(stat = "identity", aes(fill = color)) +
scale_y_continuous(labels = scales::label_percent()) +
scale_fill_identity(name = "Domain") +
facet_grid(. ~ country, scales = "fixed") +
theme_bw() +
theme(aspect.ratio = 1,
strip.text = element_text(size = 16),
axis.title = element_text(size = 18),
title = element_text(size = 20),
axis.text.x = element_text(colour = tbl$color, face = "bold"),
legend.text = element_text(size = 14))
p
生成这张图片：
请注意，对于国家 B，当该变量的数量明显非零时，Var18 是灰色的。这是因为 A 国的那个值是 0。
我想避免使用 Grid::，但非常感谢任何有关如何克服此问题的建议！
所以我找到了一种使用网格修复轴颜色和比例图的方法。基于上述代表：
# Generate a function to get the legend of one of the ggplots
get_legend<-function(myggplot){
tmp <- ggplot_gtable(ggplot_build(myggplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
# From the full dataset, find the value of the country with the highest percent of any var_name
max <- round(max(tbl$perc), digits = 2)
# create a sequence of length 6 from 0 to the largest perc value
max_seq <- seq(0, max, length = 6)
# initiate empty list
my_list <- list()
# list of countries to loop through
my_sub <- c("A", "B")
现在我们遍历每个国家，将每个国家的地块保存到空列表中。
for(i in my_sub){
### Wrangle
tbl_sub <-
tbl %>%
dplyr::mutate(country = as.factor(country),
domain = as.factor(domain)) %>%
dplyr::filter(country == i),
dplyr::mutate(perc = ifelse(is.na(perc), 0, perc))
# Create custom coord_polar arguments
cp <- coord_polar(theta = "x", clip = "off")
cp$is_free <- function() TRUE
p <-
ggplot(dplyr::filter(tbl_sub, country == i),
aes(x = forcats::as_factor(var_name),
y = perc)) +
cp +
geom_bar(stat = "identity", aes(fill = color)) +
facet_grid(. ~ country, scales = "fixed") +
scale_y_continuous(breaks = c(max_seq),
labels = scales::label_percent(),
limits = c(0, max(max_seq))) +
scale_fill_identity(guide = "legend",
name = "Domain",
labels = c(darkolivegreen4 = "domain a",
orange = "domain c",
navy = "domain b" ,
purple = "domain d",
grey = "not applicable")) +
labs(x = "",
y = "") +
theme_bw() +
theme(aspect.ratio = 1,
panel.border = element_blank(),
strip.text = element_text(size = 16),
axis.title = element_text(size = 18),
title = element_text(size = 20),
axis.text.x = element_text(colour = tbl_new$color, face = "bold"),
legend.text = element_text(size = 14))
my_list[[i]] <- p
}
现在我们在列表中有了绘图，我们想玩转图例并使用 grid:: 和 gridExtra 将所有内容绘制在一起。
# pull legend from first ggplot in the list
legend <- get_legend(my_list[[1]])
# remove legends from all the plots in the list
for(i in 1:length(my_list)){
my_list[[i]] <- my_list[[i]] + theme(legend.position = "none")
}
# plot everything together
p <- grid.arrange(arrangeGrob(
grobs = my_list,
nrow = round(length(my_sub)/2, 0),
left = textGrob("Y axis",
gp = gpar(fontsize = 20),
rot = 90),
bottom = textGrob("X axis",
gp = gpar(fontsize = 20),
vjust = -3),
top = textGrob("Big plot",
gp = gpar(fontsize = 28, vjust = 2))),
legend = legend,
widths = c(9,1,1),
clip = F)
这会产生这张图片：
这些图按比例缩放到具有最大 perc 值 (0 - 11%) 的国家/地区，并且每个国家/地区都有唯一的灰色值，具体取决于 perc 列中是否有 0 或 NA。
我敢肯定还有更简单的解决方案，但现在这对我有用！
遵循 Z.Lin 的建议并使用 geom_text 会更快一些。这是一个快速的解决方法，但并不理想，因为文本不会在最边缘结束，而且无论出于何种原因，我都无法让 clip = off 在 coord_polar 中工作。
（我对数据做了一些修改，因为它很难阅读）
library(ggplot2)
maxval <- max(tbl$perc, na.rm = T)
ggplot(tbl, aes(x = var_name, y = perc)) +
coord_polar(theta = "x") +
geom_col(aes(fill = color)) +
geom_text(aes(x = var_name, y = maxval + 0.02, color = color, label = var_name),
size = 10*5/14) +
scale_fill_identity(name = "Domain") +
scale_color_identity(name = "Domain") +
facet_grid(. ~ country, scales = "fixed") +
theme_minimal(base_size = 10) +
theme(axis.text.x = element_blank())
#> Warning: Removed 6 rows containing missing values (position_stack).
数据
text <-
"country domain var_name perc color
A domainc Val2 NA grey
A domainc Val1 NA grey
A domainc Val3 0.01670 orange
A domainc Val8 0.00000 grey
A domainc Val9 NA grey
A domainc Val11 0.02510 orange
A domainc Val19 0.01890 orange
A domaind Val16 0.04840 purple
A domaina Val5 0.00776 darkolivegreen4
A domaina Val6 0.02390 darkolivegreen4
A domaina Val7 0.00247 darkolivegreen4
A domaina Val10 0.03840 darkolivegreen4
A domaina Val13 0.02490 darkolivegreen4
A domaina Val18 NA grey
A domainb Val4 0.01630 navy
A domainb Val14 0.01610 navy
A domainb Val12 0.05180 navy
A domainb Val17 0.01770 navy
A domainb Val15 0.03550 navy
B domainc Val2 0.01440 orange
B domainc Val1 NA grey
B domainc Val3 0.02590 orange
B domainc Val8 0.00000 grey
B domainc Val9 NaN grey
B domainc Val11 0.02900 orange
B domainc Val19 0.00000 grey
B domaind Val16 0.00261 purple
B domaina Val5 0.10900 darkolivegreen4
B domaina Val6 0.00702 darkolivegreen4
B domaina Val7 0.01330 darkolivegreen4
B domaina Val10 0.00861 darkolivegreen4
B domaina Val13 0.06050 darkolivegreen4
B domaina Val18 0.07770 darkolivegreen4
B domainb Val4 0.00797 navy
B domainb Val14 0.05230 navy
B domainb Val12 0.04290 navy
B domainb Val17 0.03190 navy
B domainb Val15 0.06940 navy"
tbl <- data.table::fread(text = text, header = T, fill = T)