在 R 中使用 ggplot2 或 plotly 创建子弹图

Create Bullet Graph using ggplot2 or plotly in R

我正在尝试找到一种为分类变量和数值变量构建子弹图的方法。我的原始数据样本如下所示:

| Name   | count |
|--------|-------|
| Alex   | 89    |
| Bob    | 85    |
| David  | 76    |
| Mike   | 64    |
| Jess   | 50    |
| Steve  | 45    |
| Elina  | 29    |
| Ethan  | 20    |
| Jordan | 10    |
| Jim    | 5     |

它被复制为

name = c("Alex","Bob","David","Mike","Jess","Steve","Elina","Ethan","Jordan","Jim")
count= c(89,85,76,64,50,45,29,20,10,5)
data= data.frame(name, count, stringsAsFactors = TRUE)

我不知道如何创建 target/threshold 值和子弹图。我尝试引用此 link Create with ggplot2 a barplot with bar bullet in it,但我无法使用它获得正确的图表。有人可以帮我根据这个数据集创建子弹图吗?

输出应该类似于下图:

为此需要创建一个虚拟数据来表示每个名称的排名,如下所示

name = c("Alex","Bob","David","Mike","Jess","Steve","Elina","Ethan","Jordan","Jim")
count= c(89,85,76,64,50,45,29,20,10,5)
data = data.frame(name, count, stringsAsFactors = TRUE)

library(dplyr)
library(ggplot2)

data <- data %>%
  mutate(width = seq(.8, .1, length.out = nrow(data)))

bullet_base <- data.frame(rank = c("Poor", "Ok", "Good", "Excellent"),
  value = c(20, 20, 20, 40))
bullet_base_rep <- 
  do.call("rbind", replicate(nrow(data), bullet_base, simplify = FALSE)) %>%
  mutate(name = sort(rep(data$name, 4) ))

head(bullet_base_rep, 10)
#>         rank value  name
#> 1       Poor    20  Alex
#> 2         Ok    20  Alex
#> 3       Good    20  Alex
#> 4  Excellent    40  Alex
#> 5       Poor    20   Bob
#> 6         Ok    20   Bob
#> 7       Good    20   Bob
#> 8  Excellent    40   Bob
#> 9       Poor    20 David
#> 10        Ok    20 David

现在我们只需要用正确的颜色绘制它们。我没有白线,因为您没有提供任何关于应该使用什么来为该图的每个条绘制交叉线的信息。

bullet_colors <- c("#E9FFE3", "#A3D694", "#61AB40", "#318100")
names(bullet_colors) <- c("Poor", "Ok", "Good", "Excellent")

ggplot() +
  geom_bar(data = bullet_base_rep, 
    aes(x = name, y = value, fill = rank), stat = "identity",
    position = "stack") +
  geom_bar(data = data, 
    aes(x = name, y = count), fill = "black", width = .2,
    stat = "identity") +
  scale_fill_manual(values = bullet_colors) +
  coord_flip(expand = FALSE)

reprex package (v2.0.0)

于 2021-05-29 创建
# Change the order of Excellent -> Poor
bullet_base <- data.frame(rank = c("Excellent", "Good", "Ok", "Poor"),
  value = c(20, 20, 20, 40))
bullet_base_rep <- 
  do.call("rbind", replicate(nrow(data), bullet_base, simplify = FALSE)) %>%
  mutate(name = sort(rep(data$name, 4) ))

# For drawing in certain order change the value to factor type
# ggplot will draw the last level first when draw graph
bullet_base_rep$rank <- factor(bullet_base_rep$rank,
  levels = c("Poor", "Ok", "Good", "Excellent"))
head(bullet_base_rep, 10)
#>         rank value  name
#> 1  Excellent    20  Alex
#> 2       Good    20  Alex
#> 3         Ok    20  Alex
#> 4       Poor    40  Alex
#> 5  Excellent    20   Bob
#> 6       Good    20   Bob
#> 7         Ok    20   Bob
#> 8       Poor    40   Bob
#> 9  Excellent    20 David
#> 10      Good    20 David

bullet_colors <- c("#E9FFE3", "#A3D694", "#61AB40", "#318100")
names(bullet_colors) <- c("Poor", "Ok", "Good", "Excellent")

ggplot() +
  geom_bar(data = bullet_base_rep, 
    aes(x = name, y = value, fill = rank), stat = "identity",
    position = "stack") +
  geom_bar(data = data, 
    aes(x = name, y = count), fill = "black", width = .2,
    stat = "identity") +
  scale_fill_manual(values = bullet_colors) +
  coord_flip(expand = FALSE)

reprex package (v2.0.0)

于 2021-05-30 创建