R 帮助 - ggplot - 只能获取右侧条形的位置或颜色，不能同时获取两者

Question

我正在制作一个地块，其中对植物的生长进行地上植物测量和地下测量。我想显示 y 轴上从 0 开始向上的地上测量值和 y 轴上从 0 开始向下的地下测量值（我仍然希望其值为正值）。我有三个治疗组和两个样本组，我希望将治疗显示在 x 轴上。我几乎可以通过下面的代码到达那里。

但是-

1. 我希望每个样本的条形在 x 轴上相交，目前所有条形都被躲避。当我从

   position = position_dodge()

   中移除

   geom_bar()

   时，样本条堆叠起来。我该怎么做才能让每个样本条在中间相遇。当我改变

   ggplot(aes(fill = Sample)

   时，我得到了我想要的图表结构，但我无法让条形变为正确的颜色。

2. 下面的 0 y 轴标签 - 有没有办法可以屏蔽这些标签，以便即使底层数字为负数，我也可以在轴上使用正数？我尝试用

   labels = scales::label_number(accuracy = 1)

   代替

   labels = function(y) ifelse(y < 0, abs(y), y)

   来做到这一点，它可以使 0 两边的数字均为正数，但是它们会变成非常长的小数。我无法找到一种方法来使用这两种方法来进行简单编号并使以下 0 数字为正数。

这是到目前为止的代码：

# Load libraries
library(ggplot2)
library(dplyr)
library(scales)

# Sample data with 2 samples and 3 treatments
data <- data.frame(
  Sample = rep(c("Sample1", "Sample2"), each = 3),
  Treatment = rep(c("Treatment1", "Treatment2", "Treatment3"), times = 2),
  ShootLength = c(10, 12, 11, 9, 13, 14),
  RootLength = c(7, 6, 8, 6, 7, 9)
)

# Add random variation to simulate repeated measurements
set.seed(123)
data_long <- data.frame(
  Sample = rep(data$Sample, each = 6),
  Treatment = rep(data$Treatment, each = 6),
  Type = rep(c("ShootLength", "RootLength"), times = 18),
  Length = c(
    rnorm(18, mean = rep(data$ShootLength, each = 3), sd = 1),
    rnorm(18, mean = rep(data$RootLength, each = 3), sd = 1)
  )
)


# Summarize data for mean and standard deviation
data_summary <- data_long %>%
  group_by(Sample, Treatment, Type) %>%
  summarise(
    Mean = mean(Length),
    SD = sd(Length),
    .groups = "drop"
  )

# Mutate so RootLength is negative to appear below x axis
data_summary <- data_summary %>%
  mutate(
    StackedOffset = ifelse(Type == "RootLength", -Mean, Mean), # Adjust for below-ground
    SD_Pos = SD,                                                 # Standard deviation remains positive
    FillGroup = paste(Sample, Type, sep = "_")                   # New variable for combined colors
  )

# Plot
ggplot(data_summary, aes(x = Treatment, y = StackedOffset, fill = FillGroup)) +
  geom_bar(stat = "identity", position = position_dodge(), width = 0.5, color = "black") +
  geom_errorbar(
    aes(
      ymin = StackedOffset - SD_Pos,
      ymax = StackedOffset + SD_Pos
    ),
    position = position_dodge(0.5), width = 0.2, color = "black"
  ) +
  scale_y_continuous(
    name = "Shoot Length (Above Ground)",
    breaks = seq(-max(data_summary$Mean + data_summary$SD), max(data_summary$Mean + data_summary$SD), by = 1),
    labels = scales::label_number(accuracy = 1),
    sec.axis = sec_axis(~ ., name = "Root Length (Below Ground)", labels = function(y) abs(y))
  ) +
  scale_fill_manual(
    values = c(
      "Sample1_ShootLength" = "red",         # Sample1 above ground
      "Sample1_RootLength" = "blue",        # Sample1 below ground
      "Sample2_ShootLength" = "darkred", # Sample2 above ground
      "Sample2_RootLength" = "darkblue" # Sample2 below ground
    )
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    panel.grid.major.y = element_line(color = "gray", size = 0.5),
    panel.grid.major.x = element_blank()
  ) +
  labs(
    x = "Treatment",
    y = "Length",
    fill = "Sample & Type",
    title = "Shoot and Root Lengths by Treatment and Sample"
  )

Answer 1

1人份 我会完全删除position_dodge()以允许条形堆叠。然后创建一个新的 x 轴定位系统，将每个样本的测量结果直接放在彼此的顶部。更新 x 轴标签以显示处理和样品信息。我保留了条形宽度，虽然我认为通常使条形比胡须更宽，但这是你的选择。

2人份 使用

custom custom_breaks

和

custom_labels

函数。

# Load libraries
library(ggplot2)
library(dplyr)
library(scales)

# Sample data with 2 samples and 3 treatments
data <- data.frame(
  Sample = rep(c("Sample1", "Sample2"), each = 3),
  Treatment = rep(c("Treatment1", "Treatment2", "Treatment3"), times = 2),
  ShootLength = c(10, 12, 11, 9, 13, 14),
  RootLength = c(7, 6, 8, 6, 7, 9)
)

# Add random variation to simulate repeated measurements
set.seed(123)
data_long <- data.frame(
  Sample = rep(data$Sample, each = 6),
  Treatment = rep(data$Treatment, each = 6),
  Type = rep(c("ShootLength", "RootLength"), times = 18),
  Length = c(
    rnorm(18, mean = rep(data$ShootLength, each = 3), sd = 1),
    rnorm(18, mean = rep(data$RootLength, each = 3), sd = 1)
  )
)

# Summarize data for mean and standard deviation
data_summary <- data_long %>%
  group_by(Sample, Treatment, Type) %>%
  summarise(
    Mean = mean(Length),
    SD = sd(Length),
    .groups = "drop"
  )

# Mutate so RootLength is negative to appear below x axis
data_summary <- data_summary %>%
  mutate(
    StackedOffset = ifelse(Type == "RootLength", -Mean, Mean),
    SD_Pos = SD,
    FillGroup = paste(Sample, Type, sep = "_"),
    # Create a new x-axis position for each sample
    x_position = paste(Treatment, Sample)
  )

# Create custom breaks and labels function for y-axis
custom_breaks <- function(x) {
  max_value <- max(abs(ceiling(x)))
  seq(-max_value, max_value, by = 1) # adjust spacing of labels here :)
}

custom_labels <- function(x) {
  sprintf("%.f", abs(x)) # adjust decimal numbers more: "%.1f" or "%.2f"
}

# Create new x-axis positions
x_positions <- unique(data_summary$x_position)
x_numeric <- seq_along(x_positions)
names(x_numeric) <- x_positions

data_summary$x_num <- x_numeric[data_summary$x_position]

# Plot
ggplot(data_summary, aes(x = x_num, y = StackedOffset, fill = FillGroup)) +
  geom_bar(
    stat = "identity",
    width = 0.2,
    color = "black"
  ) +
  geom_errorbar(
    aes(
      ymin = StackedOffset - SD_Pos,
      ymax = StackedOffset + SD_Pos
    ),
    width = 0.2,
    color = "black"
  ) +
  scale_x_continuous(
    breaks = x_numeric,
    labels = c("Treatment1\nSample1", "Treatment1\nSample2", 
               "Treatment2\nSample1", "Treatment2\nSample2",
               "Treatment3\nSample1", "Treatment3\nSample2")
  ) +
  scale_y_continuous(
    name = "Shoot Length (Above Ground)",
    breaks = custom_breaks,
    labels = custom_labels,
    sec.axis = sec_axis(
      ~ .,
      name = "Root Length (Below Ground)",
      breaks = custom_breaks,
      labels = custom_labels
    )
  ) +
  scale_fill_manual(
    values = c(
      "Sample1_ShootLength" = "red",
      "Sample1_RootLength" = "blue",
      "Sample2_ShootLength" = "darkred",
      "Sample2_RootLength" = "darkblue"
    )
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    panel.grid.major.y = element_line(color = "gray", size = 0.5),
    panel.grid.major.x = element_blank()
  ) +
  labs(
    x = "Treatment and Sample",
    y = "Length",
    fill = "Sample & Type",
    title = "Shoot and Root Lengths by Treatment and Sample"
  )

输出