如何將 geom_bar、geom_point 和 geom_line 組合成一個圖形？

Question

我正在嘗試使用三個並行條件（CET、RES、END）和對干預的響應（高或低，即 CET_Hi、CET_Lo 等）可視化跨兩個時間點（干預前和干預后）的連續數據點

我想創建一個條形圖，顯示 X 軸上每個條件的平均輸出，並帶有單獨的時間條（前和后）。 然后，我想用線條覆蓋 Pre 和 Post 的各個主題數據點，以連接主題數據點並按顏色對響應進行分組。

我已經使用 ggplot2 和 geom_bar 函數成功創建了條形圖。 我還讓 geom_point 按條件覆蓋各個點，但無法使位置與時間對齊。

ggplot(Leg_Press_Summary, aes(x=Condition, y=Leg_Press, fill=as.factor(Time))) + 
geom_bar(stat="identity", position=position_dodge()) + 
scale_fill_brewer(palette="Blues", name = "Time", labels = c("Pre", "Post")) +
geom_point(data=Phys_Data, aes(x=Condition, y=Leg_Press, colour=Response, fill=as.factor(Time))) +
geom_line(data=Phys_Data, aes(x=Condition, y=Leg_Press, group=Subject)) + 
labs(title="Leg Press", x="Condition", y ="Leg Press (kg)")

我希望 geom_points 會根據時間定位，但是，對於每個條件，它們的點只是堆疊在 Pre 和 Post 條之間的垂直線上。

我的結果：

我正在嘗試重新創建的圖：

我怎樣才能解決這個問題？

下面包含的數據集，我忘記在原始帖子中包含在內。

LegPress
# A tibble: 36 x 5
Subject  Time Condition Response Leg_Press

6     1 CET       CET_Hi        212.
6     2 CET       CET_Hi        300 
9     1 CET       CET_Lo        350 
9     2 CET       CET_Lo        370 
14     1 CET       CET_Hi        330 
14     2 CET       CET_Hi        450 
26     1 CET       CET_Hi        180 
26     2 CET       CET_Hi        250 
28     1 CET       CET_Lo        230 
28     2 CET       CET_Lo        275 
29     1 CET       CET_Lo        330 
29     2 CET       CET_Lo        325 
2     1 RES       RES_Hi        142.
2     2 RES       RES_Hi        225 
16     1 RES       RES_Lo        280 
16     2 RES       RES_Lo        320 
19     1 RES       RES_Hi        205 
19     2 RES       RES_Hi        295 
27     1 RES       RES_Hi        175 
27     2 RES       RES_Hi        260 
31     1 RES       RES_Lo        340 
31     2 RES       RES_Lo        370 
32     1 RES       RES_Lo        310 
32     2 RES       RES_Lo        370 
8     1 END       END_Lo        205 
8     2 END       END_Lo        250 
13     1 END       END_Hi        310 
13     2 END       END_Hi        320 
20     1 END       END_Hi        200 
20     2 END       END_Hi        185 
24     1 END       END_Lo        260 
24     2 END       END_Lo        270 
25     1 END       END_Hi        210 
25     2 END       END_Hi        235 
30     1 END       END_Lo        250 
30     2 END       END_Lo        245 

Answer 1

加載包：

library(dplyr); library(tidyr); library(ggplot2)

根據您的圖形松散地設置示例數據：

set.seed(4)
df <- data.frame(Time = rep(rep(c("pre", "post"), each=20),3),
                 Condition = rep(c("CET", "END", "RES"), each=40),
                 Leg_Press = c(rnorm(20, 275, 20), rnorm(20, 325, 20), rnorm(20, 245, 20), rnorm(320, 251, 20), rnorm(20, 247, 10), rnorm(320, 305, 10)))

為每個條件和時間段生成平均值、最小值和最大值的匯總表：

dat <- df %>% group_by(Time, Condition) %>% summarise(mean = mean(Leg_Press), max = max(Leg_Press), min = min(Leg_Press))
dat$Time <- factor(dat$Time, level=c("pre", "post"))

# # A tibble: 6 x 5
# # Groups:   Time [2]
#   Time  Condition  mean   max   min
#   <fct> <fct>     <dbl> <dbl> <dbl>
# 1 post  CET        283.  373.  209.
# 2 post  END        277.  329.  200.
# 3 post  RES        278.  328.  215.
# 4 pre   CET        273.  326.  191.
# 5 pre   END        276.  323.  197.
# 6 pre   RES        276.  329.  204.

按條件划分的腿部推舉的簡單條形圖，分為前后時間段：

ggplot(dat, aes(Condition, mean, fill=Time)) +
      geom_col(position="dodge")

計算每個點的最大值和最小值的新 x 值：

dat <- dat %>% mutate(new.x = ifelse(Time == "pre", -0.25, 0.25) + as.numeric(as.factor(Condition)))

ggplot(data=dat) +
  geom_col(aes(Condition, mean, fill=Time), position="dodge") +
  geom_point(aes(x=new.x, y=max)) +
  geom_point(aes(x=new.x, y=min)) 

要為每個組繪制線條，您需要為每組最大值和最小值設置一個數據框。

max.frame <- dat %>% 
     group_by(Condition) %>% 
     mutate(t2 = Time) %>% 
     spread(Time, max) %>% 
     summarise(x1 = min(new.x), x2 = max(new.x), y1 = mean(pre, na.rm=T), y2 = mean(post, na.rm=T))

# # A tibble: 3 x 5
#   Condition    x1    x2    y1    y2
#   <fct>     <dbl> <dbl> <dbl> <dbl>
# 1 CET        0.75  1.25  326.  373.
# 2 END        1.75  2.25  323.  329.
# 3 RES        2.75  3.25  329.  328.

min.frame <- dat %>% 
      group_by(Condition) %>% 
      mutate(t2 = Time) %>% 
      spread(Time, min) %>% 
      summarise(x1 = min(new.x), x2 = max(new.x), y1 = mean(pre, na.rm=T), y2 = mean(post, na.rm=T))

# # A tibble: 3 x 5
#   Condition    x1    x2    y1    y2
#   <fct>     <dbl> <dbl> <dbl> <dbl>
# 1 CET        0.75  1.25  191.  209.
# 2 END        1.75  2.25  197.  200.
# 3 RES        2.75  3.25  204.  215.

基於三個框架的繪圖：

ggplot() +
  geom_col(data=dat, aes(Condition, mean, fill=Time), position="dodge") +
  geom_segment(data=max.frame, aes(x=x1, y=y1, xend = x2, yend = y2)) +
  geom_segment(data=min.frame, aes(x=x1, y=y1, xend = x2, yend = y2)) +
  geom_point(data=dat, aes(x=new.x, y=max)) +
  geom_point(data=dat, aes(x=new.x, y=min)) 

Answer 2

它認為這是您想要使用faceting 的情況：

library(tidyverse)  

Phys_Data <- data.frame(stringsAsFactors=FALSE,
     Subject = c(6, 6, 9, 9, 14, 14, 26, 26, 28, 28, 29, 29, 2, 2, 16, 16, 19,
                 19, 27, 27, 31, 31, 32, 32, 8, 8, 13, 13, 20, 20, 24, 24, 25,
                 25, 30, 30),
        Time = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1,
                 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
   Condition = c("CET", "CET", "CET", "CET", "CET", "CET", "CET", "CET", "CET",
                 "CET", "CET", "CET", "RES", "RES", "RES", "RES", "RES", "RES",
                 "RES", "RES", "RES", "RES", "RES", "RES", "END", "END", "END",
                 "END", "END", "END", "END", "END", "END", "END", "END", "END"),
    Response = c("CET_Hi", "CET_Hi", "CET_Lo", "CET_Lo", "CET_Hi", "CET_Hi",
                 "CET_Hi", "CET_Hi", "CET_Lo", "CET_Lo", "CET_Lo", "CET_Lo",
                 "RES_Hi", "RES_Hi", "RES_Lo", "RES_Lo", "RES_Hi", "RES_Hi",
                 "RES_Hi", "RES_Hi", "RES_Lo", "RES_Lo", "RES_Lo", "RES_Lo", "END_Lo",
                 "END_Lo", "END_Hi", "END_Hi", "END_Hi", "END_Hi", "END_Lo",
                 "END_Lo", "END_Hi", "END_Hi", "END_Lo", "END_Lo"),
   Leg_Press = c(212, 300, 350, 370, 330, 450, 180, 250, 230, 275, 330, 325,
                 142, 225, 280, 320, 205, 295, 175, 260, 340, 370, 310, 370,
                 205, 250, 310, 320, 200, 185, 260, 270, 210, 235, 250, 245)
)

Phys_Data %>%
  mutate(
    Time = as.factor(Time),
    Response = str_split_fixed(Response, "_", 2)[,2]
  ) %>%
  ggplot(aes(x=Time, y=Leg_Press, fill=Time)) +
    facet_wrap(~Condition, strip.position = "bottom") +
    geom_col(
      data = ~group_by(.x, Time, Condition) %>%
        summarize(Leg_Press = mean(Leg_Press)) %>%
        ungroup()
    ) +
    scale_fill_brewer(palette="Blues", name = "Time", labels = c("Pre", "Post")) +
    geom_point(aes(color=Response)) +
    geom_line(aes(color=Response, group=Subject)) +
    labs(title="Leg Press", x = "Condition", y ="Leg Press (kg)") +
    theme(
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank()
    )

^{由reprex 包(v0.3.0) 於 2019 年 9 月 4 日創建}