R 中的文本注释

Question

我在图表中添加了文本注释。不幸的是，当我的一个图有多个文本时（例如 Product A），我的想法就不起作用了。如果我们选择 Product A，则不会显示任何内容。带有我想在图表和图形上显示的文本的数据框：

        Date Product Value  Text
1 2020-01-03       A    61 Hello
2 2020-01-07       A    27 Hello
3 2020-01-04       B    57 Hello
4 2020-01-05       C   147 Hello
5 2020-01-06       D    31 Hello

我的代码：

library(shiny)
library(plotly)
library(shinyWidgets)
set.seed(666)

df1 <- data.frame(Date = rep(seq(as.Date("2020-01-03"), by="day", len=12),10,replace = TRUE), 
                  Product = rep(LETTERS[1:10], each = 12), 
                  Value = sample(c(0:300),120, replace = T))

df2 <- data.frame(Date = rep(seq(as.Date("2020-01-03"), by="day", len=5),replace = TRUE), 
                  Product = rep(c(LETTERS[1:4],"A"), each = 1), 
                  Text = rep("Hello",5))

df1 <- full_join(df1, df2, by=c("Product","Date"))

ui <- fluidPage(
  pickerInput("All", "Choose", multiple = F, choices = unique(df1$Product)                                          ,
              options = list(`max-options` = 4,size = 10)),
  plotlyOutput('plot')
  
)
server <- function(input, output) {
  
  trend<- reactive({
    df1 %>% 
      filter(Product %in% input$All) %>% 
      arrange(Date) %>% 
      droplevels()
  })
  output$plot <- renderPlotly({
    
    mdata2 <- trend()
    mdata2<-mdata2 %>% drop_na(Text)

    annotations = list()
    annotation <- list(x = mdata2$Date,
                       y = mdata2$Value,
                       text = mdata2$Text,
                       showarrow = T)
    
    annotations[[i]] <- annotation
      
    plot_ly(data=trend(), x=~Date,  y = ~Value,
            type = 'scatter', mode = 'lines+markers')%>%
      layout(annotations = annotations) 
  })
 
}
shinyApp(ui = ui, server = server)

Answer 1

您的对象 annotations[[i]] 未正确定义。试试这个

library(shiny)
library(plotly)
library(shinyWidgets)
set.seed(666)

df1 <- data.frame(Date = rep(seq(as.Date("2020-01-03"), by="day", len=12),10,replace = TRUE), 
                  Product = rep(LETTERS[1:10], each = 12), 
                  Value = sample(c(0:300),120, replace = T))

df2 <- data.frame(Date = rep(seq(as.Date("2020-01-03"), by="day", len=5),replace = TRUE), 
                  Product = rep(c(LETTERS[1:4],"A"), each = 1), 
                  Text = rep("Hello",5))

df1 <- full_join(df1, df2, by=c("Product","Date"))

ui <- fluidPage(
  pickerInput("All", "Choose", multiple = F, choices = unique(df1$Product)                                          ,
              options = list(`max-options` = 4,size = 10)),
  plotlyOutput('plot')
  
)
server <- function(input, output) {
  
  trend<- reactive({
    df1 %>% 
      filter(Product %in% input$All) %>% 
      arrange(Date) %>% 
      droplevels()
  })
  output$plot <- renderPlotly({
    
    mdata2 <- trend() %>% drop_na(Text)
    
    annotations <- c() 
    n <- nrow(mdata2)
    if (n>0) {
      lapply(1:n, function(i){
        rowdata <- mdata2[i,]
        annotation <- data.frame(x = rowdata$Date,
                                 y = rowdata$Value,
                                 text = rowdata$Text,
                                 showarrow = T)
        annotations <<- rbind(annotations, annotation)
      })
    }
    
    
    plot_ly(data=trend(), x=~Date,  y = ~Value,
            type = 'scatter', mode = 'lines+markers') %>%
      layout(annotations = annotations)
  })
  
}
shinyApp(ui = ui, server = server)

R 中的文本注释

Text Annotations in R

annotations

r

render

shiny