如何在geom_smooth之后而不是在geom_line之后显示直接标记？

Question

我正在使用直接标签来注释我的情节。正如你在这张图片中看到的那样，标签是在geom_line之后，但是我想在geom_smooth之后使用它们。这是直接标签支持的吗？或任何其他想法如何实现这一目标？提前谢谢！

这是我的代码：

library("ggplot2")
set.seed(124234345)

# Generate data
df.2 <- data.frame("n_gram" = c("word1"),
                   "year" = rep(100:199),
                   "match_count" = runif(100 ,min = 1000 , max = 2000))

df.2 <- rbind(df.2, data.frame("n_gram" = c("word2"),
                      "year" = rep(100:199),
                      "match_count" = runif(100 ,min = 1000 , max = 2000)) )

# plot
ggplot(df.2, aes(year, match_count, group=n_gram, color=n_gram)) +
  geom_line(alpha = I(7/10), color="grey", show_guide=F) +
  stat_smooth(size=2, span=0.3, se=F, show_guide=F) +
  geom_dl(aes(label=n_gram), method = "last.bumpup", show_guide=F) +
  xlim(c(100,220))

Answer 1

此答案采用@ celt-Ail答案的基本概念，而不是函数，基数R和直接标签，而是尝试一种整齐的方法，从here窃取了多个loess的代码模型。

很高兴听到建议的改进。

set.seed(124234345)

# Generate data
df.2 <- data.frame("n_gram" = c("word1"),
                   "year" = rep(100:199),
                   "match_count" = runif(100 ,min = 1000 , max = 2000))

df.2 <- rbind(df.2, data.frame("n_gram" = c("word2"),
                               "year" = rep(100:199),
                               "match_count" = runif(100 ,min = 1000 , max = 2000)) )

#example of loess for multiple models
#https://stackoverflow.com/a/55127487/4927395
library(dplyr)
library(tidyr)
library(purrr)
library(ggplot2)

models <- df.2 %>%
  tidyr::nest(-n_gram) %>%
  dplyr::mutate(
    # Perform loess calculation on each CpG group
    m = purrr::map(data, loess,
                   formula = match_count ~ year, span = .3),
    # Retrieve the fitted values from each model
    fitted = purrr::map(m, `[[`, "fitted")
  )

# Apply fitted y's as a new column
results <- models %>%
  dplyr::select(-m) %>%
  tidyr::unnest()

#find final x values for each group
my_last_points <- results %>% group_by(n_gram) %>% summarise(year = max(year, na.rm=TRUE))

#Join dataframe of predictions to group labels
my_last_points$pred_y <- left_join(my_last_points, results)

# Plot with loess line for each group
ggplot(results, aes(x = year, y = match_count, group = n_gram, colour = n_gram)) +
  geom_line(alpha = I(7/10), color="grey", show.legend=F) +
  #stat_smooth(size=2, span=0.3, se=F, show_guide=F)
  geom_point() +
  geom_line(aes(y = fitted))+  
  geom_text(data = my_last_points, aes(x=year+5, y=pred_y$fitted, label = n_gram))

Answer 2

# use stat smooth with geom_dl to get matching direct labels.
span <- 0.3
ggplot(df.2, aes(year, match_count, group=n_gram, color=n_gram)) +
  geom_line(alpha = I(7/10), color="grey") +
  stat_smooth(size=2, span=span, se=F) +
  geom_dl(aes(label=n_gram), method = "last.qp", stat="smooth", span=span) +
  xlim(c(100,220))+
  guides(colour="none")

Answer 3

这不是你要求的，因为我不知道如何做到这一点，但这可能对你更有用，因为你会减少标签的绘图区域：

PLOT <- ggplot(df.2, aes(year, match_count, group=n_gram, color=n_gram)) +
  geom_line(alpha = I(7/10), color="grey", show_guide=F) +
  stat_smooth(size=2, span=0.3, se=F, show_guide=F) 

mymethod <- list(
    "top.points", 
    dl.move("word1", hjust=-6.65, vjust=13),
    dl.move("word2", hjust =-7.9, vjust=20.25)
)

direct.label(PLOT, mymethod)

产生：

您也可以尝试：

mymethod <- list(
    "top.points", 
    dl.move("word1", hjust=-6, vjust=14),
    dl.move("word2", hjust =-7.1, vjust=19.5)
)

ggplot(df.2, aes(year, match_count, group=n_gram, color=n_gram)) +
  geom_line(alpha = I(7/10), color="grey", show_guide=F) +
  xlim(c(100,220))+
  stat_smooth(size=2, span=0.3, se=F, show_guide=F) +
  geom_dl(aes(label=n_gram), method = mymethod, show_guide=F)

产生：

注意：要打印到其他图形设备（这是Windows rgui），您需要调整vjust并调整以适应。但如果有更直接的方式会更好。

Answer 4

我会在这里回答我自己的问题，因为我想出了感谢Tyler Rinker的回应。

这就是我用loess（）来解决它以获得标签位置的方法。

 # Function to get last Y-value from loess
funcDlMove <- function (n_gram) {

  model <- loess(match_count ~ year, df.2[df.2$n_gram==n_gram,], span=0.3)
  Y <- model$fitted[length(model$fitted)]
  Y <- dl.move(n_gram, y=Y,x=200)
  return(Y)
}

index <- unique(df.2$n_gram)
mymethod <- list(
  "top.points", 
  lapply(index, funcDlMove)
  )

# Plot

PLOT <- ggplot(df.2, aes(year, match_count, group=n_gram, color=n_gram)) +
  geom_line(alpha = I(7/10), color="grey", show_guide=F) +
  stat_smooth(size=2, span=0.3, se=F, show_guide=F)

direct.label(PLOT, mymethod)

将生成此图：http://i.stack.imgur.com/FGK1w.png