如何在ggplotly动画中添加注释？

Question

我正在为r中的作业创建动画情节图，我在那里比较几个具有不同观察数量的模型。我想添加一个注释，显示当前模型的RMSE是什么 - 这意味着我希望文本与滑块一起更改。有什么简单的方法可以做到吗？

这是我存储在GitHub上的数据集。已经创建了带有RMSE的变量：data

基础ggplot图形如下：

library(tidyverse)
library(plotly)
p <- ggplot(values_predictions, aes(x = x))  +
    geom_line(aes(y = preds_BLR, frame = n, colour = "BLR")) +
    geom_line(aes(y = preds_RLS, frame = n, colour = "RLS")) + 
    geom_point(aes(x = x, y = target, frame = n, colour = "target"), alpha = 0.3) + 
    geom_line(aes(x = x, y = sin(2 * pi * x), colour = "sin(2*pi*x)"), alpha = 0.3)  +
    ggtitle("Comparison of performance) + 
    labs(y = "predictions and targets", colour = "colours")

这被转换为plotly，我已经在Plotly图中添加了一个动画：

plot <- ggplotly(p) %>%
        animation_opts(easing = "linear",redraw = FALSE)
plot

谢谢！

Answer 1

您可以使用annotate函数向ggplot图表添加注释：http://ggplot2.tidyverse.org/reference/annotate.html

df <- data.frame(x = rnorm(100, mean = 10), y = rnorm(100, mean = 10))

# Build model
fit <- lm(x ~ y, data = df)

# function finds RMSE
RMSE <- function(error) { sqrt(mean(error^2)) }

library(ggplot2)
ggplot(df, aes(x, y)) +
  geom_point() +
  annotate("text",  x = Inf, y  = Inf, hjust = 1.1, vjust = 2, 
           label = paste("RMSE", RMSE(fit$residuals)) )

在ggplot和plotly之间转换似乎有点问题。但是，此解决方法here显示了可以使用的解决方法：

ggplotly(plot) %>%
  layout(annotations = list(x = 12, y = 13, text = paste("RMSE",
    RMSE(fit$residuals)), showarrow = F))

Answer 2

这里是一个示例，该示例使用内置的可变数据集（与ggplotly相关的文本）添加依赖数据的文本。

library(plotly)
library(ggplot2)
library(dplyr)

mydata = iris %>% rename(variable1=Sepal.Length, variable2= Sepal.Width)

shift_right = 0.1 # number from 0-1 where higher = more right
shift_down = 0.02 # number from 0-1 where higher = more down

p = ggplot(mydata, aes(variable1,variable2))+
    annotate(geom = "text",
             label = paste0("Cor = ",as.character(round(cor.test(mydata$variable1,mydata$variable2)$estimate,2))),
             x = min(mydata$variable1)+abs(shift_right*(min(mydata$variable1)-max(mydata$variable1))), 
             y =  max(mydata$variable2)-abs(shift_down*(min(mydata$variable2)-max(mydata$variable2))), size=4)+
    geom_point()

ggplotly(p) %>%  style(hoverinfo = "none", traces = 1) # remove hover on text