8

プロットに注釈を付けるためにdirectlabelsを使用しています。この写真でわかるように、ラベルはgeom_lineの後にありますが、geom_smoothの後にあります。これはdirectlabelsでサポートされていますか？またはこれを達成する方法の他のアイデアはありますか？前もって感謝します！

ここに画像の説明を入力してください

これは私のコードです：

library(ggplot2)
library(directlabels)

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))
4

4 に答える 4

4

この回答は、@ celt-Ailの回答の基本概念を採用しており、関数、ベースR、および直接ラベルではなく、整然としたアプローチを試み、ここから複数の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))

direct_label

于 2020-04-22T10:14:00.040 に答える
3 
# 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")
于 2013-10-22T05:20:57.793 に答える
0

方法がわからないため、これはあなたが求めていたものではありませんが、ラベルへのプロット領域が少なくなるため、これはより便利な場合があります。

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を微調整し、それに合わせて調整する必要があります。しかし、もっと直接的な方法があればもっといいでしょう。

于 2012-04-08T19:01:45.253 に答える
-1

タイラー・リンカーからの返答のおかげでそれを理解したので、私はここで私自身の質問に答えるつもりです。

これが、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

于 2012-04-09T06:46:21.200 に答える