1

我有两个分面图，并且当给定变量取 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 国，当该 var 的数量明显非零时，Var18 是灰色的。这是因为 A 国的价值为 0。

我想避免使用 Grid::，但是非常感谢任何关于如何克服这个问题的建议！

4

2 回答 2

1

遵循 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)
于 2020-06-18T23:35:30.927 回答
1

所以我找到了一种使用网格修复轴颜色和比例图的方法。基于上述表示：

# 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。

我敢肯定还有更简单的解决方案，但现在这对我有用！

于 2020-06-18T22:15:00.310 回答