如何在圖框內直接標記回歸線（沒有圖例）？

Question

數據和以前的內容

這個問題是前一個問題的延續，具有相同的數據，但略有調整。

問題

和以前一樣，這是我想要實現的示例，我想要的部分現在以綠色突出顯示：

現在我不想為特定的回歸線着色，而是想像上面那樣在繪圖窗口中添加一個直接標簽。 我知道通過對數據進行分面，我們可以通過圖例、為線條着色等來實現這一點。我們甚至可以通過使用annotate或geom_text選擇 x 和 y 坐標來手動添加注釋。

但我想要一些不需要圖例或手動確定確切幾何坐標的位置的東西。 有沒有辦法簡單地將標簽添加到繪圖窗口中的回歸線，類似於其他aes函數？ 這是我到目前為止的基本圖，現在刪除了標簽，回歸線着色：

ggplot(slack.work,
       aes(x=Coffee_Cups,
           y=Mins_Work,
           color=Month_Name))+
  geom_point(alpha = .4)+
  geom_smooth(method = "lm",
              se = F)+
  scale_colour_viridis_d()+
  theme_bw()+
  labs(title = "Coffee Cups x Minutes of Productivity",
       subtitle = "Pearson r = .30, p < .001",
       x="Cups of Coffee",
       y="Minutes of Work",
       color="Month")+
  theme(plot.title = element_text(face = "bold",
                                  size = 15,
                                  family = "mono"),
        plot.subtitle = element_text(face = "italic"),
        legend.position = "none")

目前，它看起來像這樣：

但我希望它看起來像這樣：

Answer 1

根據您的情況調整此答案，您可以通過geom_text或ggrepel::geom_text_repel使用stat="smooth"來實現您想要的結果。 棘手的部分是只獲得一個標簽，我在after_stat ifelse

library(ggplot2)

# Levels of Month_Name. 
# Needed to get the month names.
# When using after_stat only get the level number via `group`
levels_month <- levels(factor(slack.work$Month_Name))

ggplot(
  slack.work,
  aes(
    x = Coffee_Cups,
    y = Mins_Work,
    group = Month_Name,
    color = Month_Name == "January"
  )
) +
  geom_point(alpha = .4) +
  geom_smooth(
    data = ~subset(.x, !Month_Name == "January"),
    method = "lm",
    se = F
  ) +
  geom_smooth(
    data = ~subset(.x, Month_Name == "January"),
    method = "lm",
    se = F
  ) +
  ggrepel::geom_text_repel(aes(label = after_stat(ifelse(x %in% range(x)[1], levels_month[group], NA_character_))), 
                            stat = "smooth", method = "lm",
                            nudge_x = -.5, direction = "y") +
  scale_x_continuous(expand = expansion(add = c(.5, 0), mult =.05)) +
  scale_colour_manual(values = c("TRUE" = "steelblue", "FALSE" = "grey65")) +
  annotate("text",
           x = 3,
           y = 800,
           label = "January had the strongest effect on productivity.",
           size = 4,
           color = "steelblue"
  ) +
  theme_bw() +
  labs(
    title = "Coffee Cups x Minutes of Productivity",
    subtitle = "Pearson r = .30, p < .001",
    x = "Cups of Coffee",
    y = "Minutes of Work",
    color = "Month"
  ) +
  theme(
    plot.title = element_text(
      face = "bold",
      size = 15,
      family = "mono"
    ),
    plot.subtitle = element_text(face = "italic")
  ) +
  guides(color = "none")

編輯要擺脫連接線和標簽的線段，您可以將min.segment.length = Inf添加到geom_text_repel ：

... +
ggrepel::geom_text_repel(aes(label = after_stat(ifelse(x %in% range(x)[1], levels_month[group], NA_character_))), 
                            stat = "smooth", method = "lm", min.segment.length = Inf,
                            nudge_x = -.5, direction = "y") +
...