r - 当其他系列完全丢失时，使用 ggplot 调整闪避条形图的宽度

Question

我准备了以下函数来使用 ggplot 绘制闪避图:

frq_dodge2 <- function(chart_data) {

  sapphire<-c("#00A8C8","#006D9E","#002C77","#A6E2EF","#51d5ee","#1d5cc7")
  g<-ggplot(chart_data, aes(x=X, y=value,fill=Q))

  chart <-  g+ 
    geom_bar(position = position_dodge2(preserve = "single",width=0.9),stat='identity') +
    scale_fill_manual(values = sapphire)+
    labs(x= NULL, y= NULL, subtitle=NULL) +       
    ylab(NULL) +
    geom_text(chart_data = subset(chart_data,value!=0),aes(label=paste0(value,"%")),
              position=position_dodge2(width=0.9), vjust=-0.25,
              size=3,fontface="bold", colour="#404040") +
    labs(x=NULL, y=NULL)+
    scale_y_continuous( labels = number_format(suffix = "%"),
                        limits = c(min(0,min(chart_data$value)+min(chart_data$value)),
                                   max(0,max(chart_data$value) + max(chart_data$value) / 10)))+
    scale_x_discrete(labels = function(x) str_wrap(x, width = 10),limits=unique(chart_data$Stats))    
  chart
}

当数据中的一个系列完全丢失时出现问题，条形图太宽，看起来不太好。例如，对于下面的数据，条形图绘制得太宽。

> dput(expat)
structure(list(X = structure(c(1L, 1L), .Label = c("Less than 50", 
"50-100", "100-250", "250-500", "500-1000", "1000-3000", "3000-5000", 
"more than 5000"), class = "factor"), Q = structure(1:2, .Label = c("2018 (Actual)", 
"2019 (Forecast)"), class = "factor"), value = c(100, 100)), class = "data.frame", row.names = c(NA, 
-2L))

frq_dodge2(expat) 将给出图形输出

而在其他数据中，其他系列未完全缺失的情节是可以的:

> dput(localplus)
structure(list(X = structure(c(6L, 1L, 6L, 2L, 1L), .Label = c("Less than 50", 
"50-100", "100-250", "250-500", "500-1000", "1000-3000", "3000-5000", 
"more than 5000"), class = "factor"), Q = structure(c(1L, 1L, 
2L, 2L, 2L), .Label = c("2018 (Actual)", "2019 (Forecast)"), class = "factor"), 
    value = c(14, 86, 11, 22, 67)), class = "data.frame", row.names = c(NA, 
-5L))

我曾使用preserve =“single”来修复条形宽度，以防其他系列中丢失数据，但如果其他系列在数据中完全丢失(例如在expat中)，则这没有帮助。

有什么办法可以解决这个问题吗？

Answer 1

如 this answer 中所述，您需要在 x 缩放调用中设置 drop = FALSE。
在你的函数中，这是最后一行:

scale_x_discrete(labels = function(x) str_wrap(x, width = 10), drop = F)

对我来说，这会产生以下结果:

编辑:删除 x 轴上不需要的标签

只需检查缺少哪些级别并将其标签更改为 ""。完整的功能因此变为:

frq_dodge2 <- function(chart_data) {
  
  sapphire<-c("#00A8C8","#006D9E","#002C77","#A6E2EF","#51d5ee","#1d5cc7")
  g<-ggplot(chart_data, aes(x=X, y=value,fill=Q))
  
  lvs <- levels(chart_data$X)
  miss_lvs <- which(!lvs%in%unique(chart_data$X))
  lvl_labs <- lvs
  lvl_labs[miss_lvs] <- ""
  
  chart <-  g+ 
    geom_bar(position = position_dodge2(preserve = "single",width=0.9),stat='identity') +
    scale_fill_manual(values = sapphire)+
    labs(x= NULL, y= NULL, subtitle=NULL) +       
    ylab(NULL) +
    geom_text(data = subset(chart_data,value!=0),aes(label=paste0(value,"%")),
              position=position_dodge2(width=0.9), vjust=-0.25,
              size=3,fontface="bold", colour="#404040") +
    labs(x=NULL, y=NULL)+
    scale_y_continuous( labels = number_format(suffix = "%"),
                        limits = c(min(0,min(chart_data$value)+min(chart_data$value)),
                                   max(0,max(chart_data$value) + max(chart_data$value) / 10)))+
    scale_x_discrete(labels = lvl_labs, drop = F)    
  chart
}

和产量

顺便说一句，您在 geom_text 中写入了 chart_data =subset...，而不是 data =subset... .