如何在 R 中自定义哑铃图

How to customize a dumbbell plot in R

我有以下生成点图的代码:


##Create variables
Subpopulation <- c("Female", "Female", "Male", "Male", "Low income","Low income", "Income < 65k", "Income < 65k",
              "Student", "Student", "Teacher", "Teacher", "Professor", "Professor", "Black", "Black",
              "Hispanic", "Hispanic", "Conservative", "Conservative",  "Liberal",
              "Liberal", "Progressive", "Progressive")

Treatment <- c("Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro",
           "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro")

Value <- c("57.3", "87.1", "62.54", "74.4", "54.6", "86.2", "41.3", "61.1", "39.6", "72.7", "63.5", "82.8",
             "64.6", "11.1", "37.4", "74.5", "58.6", "77.8", "47.6", "80", "75.6", "89", "54.1", "83.3")


mydf <- data.frame(Subpopulation, Treatment, Value) ##data
mydf$Value <- as.numeric (mydf$Value)


mydf %>% 
  ggplot(aes(x= Value, y= Subpopulation)) +
  geom_line(aes(group = Subpopulation))+
  geom_point(aes(color=Treatment), size=3) +
  theme_classic(12)+
  theme(legend.position="top")+
  scale_color_brewer(palette="Dark2")


这是图表:

我想创建一个标签来显示每个变量的 Pro 和 Treatment 之间的差异。我还想在 x 轴上的点 41.5 和 72.2(它们是平均线)上创建两条垂直线(我更喜欢虚线)。

这是一种可能的解决方案:

library(tidyverse)

Subpopulation <- c("Female", "Female", "Male", "Male", "Low income","Low income", "Income < 65k", "Income < 65k",
                   "Student", "Student", "Teacher", "Teacher", "Professor", "Professor", "Black", "Black",
                   "Hispanic", "Hispanic", "Conservative", "Conservative",  "Liberal",
                   "Liberal", "Progressive", "Progressive")
Treatment <- c("Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro",
               "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro", "Treatment", "Pro")
Value <- c("57.3", "87.1", "62.54", "74.4", "54.6", "86.2", "41.3", "61.1", "39.6", "72.7", "63.5", "82.8",
           "64.6", "11.1", "37.4", "74.5", "58.6", "77.8", "47.6", "80", "75.6", "89", "54.1", "83.3")
mydf <- data.frame(Subpopulation, Treatment, Value) ##data
mydf$Value <- as.numeric(mydf$Value)

mydf %>%
  group_by(Subpopulation) %>%
  mutate(Difference = Value - lead(Value),
         Position = Value - (0.5 * Difference)) %>%
  ggplot(aes(x = Value, y = Subpopulation)) +
  geom_vline(xintercept = c(41.5, 72.2),
             lty = 2, alpha = 0.5) +
  geom_line(aes(group = Subpopulation)) +
  geom_point(aes(color = Treatment), size=3) +
  geom_text(aes(label = abs(Difference),
                y = Subpopulation,
                x = Position),
            nudge_y = 0.2) +
  theme_classic(base_size = 12) +
  theme(legend.position = "top") +
  scale_color_brewer(palette = "Dark2")
#> Warning: Removed 12 rows containing missing values (geom_text).

reprex package (v2.0.1)

于 2022-03-18 创建

编辑

如果要向 'average' 行添加标签,一种选择是:

mydf %>%
  group_by(Subpopulation) %>%
  mutate(Difference = Value - lead(Value),
         Position = Value - (0.5 * Difference)) %>%
  ggplot(aes(x = Value, y = Subpopulation)) +
  geom_vline(xintercept = c(41.5, 72.2),
             lty = 2, alpha = 0.5) +
  annotate(geom = "text",
           x = c(41.5),
           y = "",
           label = "Average: 41.5") +
  annotate(geom = "text",
           x = c(72.2),
           y = "",
           label = "Average: 72.2") +
  coord_cartesian(clip = "off") +
  geom_line(aes(group = Subpopulation)) +
  geom_point(aes(color = Treatment), size=3) +
  geom_text(aes(label = abs(Difference),
                y = Subpopulation,
                x = Position),
            nudge_y = 0.25, size = 3) +
  theme_classic(base_size = 12) +
  theme(legend.position = "top") +
  scale_color_brewer(palette = "Dark2") +
  theme(axis.ticks.y = element_line(colour = c("transparent",
                                               rep("black", 12))))
#> Warning: Removed 12 rows containing missing values (geom_text).

reprex package (v2.0.1)

于 2022-03-18 创建