用plotlyProxy生动地呈现变化吗?

时间:2019-04-12 22:19:33

标签: r animation shiny plotly

我有一个Shiny应用程序,该应用程序具有根据用户输入通过plotlyProxy()进行修改的可打印图形。现在,图形修改是瞬时且突然的,因此我试图使用plotly的动画帧进行平滑更改的编码。

例如,一些可复制的代码:

# reproducible code for stack overflow 
library(plotly)
library(tidyverse)

lvls <- c("lv1", "lv2", "lv3", "lv4")
dat <- data.frame(var1 = sample(lvls, 300, replace = T))

ui <- fluidPage(
  plotlyOutput("plot")

)

server <- function(input, output, session) {

  output$info <- renderPrint(event_data("plotly_click"))

  output$plot <- renderPlotly({
    p <- plot_ly(dat, x = ~var1) %>% 
      add_histogram()
    p
  })

  observeEvent(event_data("plotly_click"),
               {
                 click <- event_data("plotly_click")
                 level <- click$x
                 opacity <- lvls %>% 
                   as_tibble() %>% 
                   mutate(opacity = ifelse(value == level, 1, .15)) %>% 
                   .$opacity

                 plotlyProxy("plot", session) %>% 
                   plotlyProxyInvoke("restyle",
                                     list(marker.opacity = list(opacity)))

               })


}

shinyApp(ui = ui, server = server)

运行此应用程序并单击每个条形时,由于plotlyProxy(),选中的条形将突出显示,而无需重新渲染图。如何使用plotly的动画帧使突出显示过渡平滑?

1 个答案:

答案 0 :(得分:1)

不确定这是否足够,因为您明确要求动画。尽管如此,这是一个解决方案,可以通过重复重新绘制图来为您提供预期的行为:

library(plotly)
library(tidyverse)

lvls <- c("lv1", "lv2", "lv3", "lv4")
dat <- data.frame(var1 = sample(lvls, 300, replace = T))

ui <- fluidPage(
  plotlyOutput("plot")
)

server <- function(input, output, session) {

  output$info <- renderPrint(event_data("plotly_click"))

  output$plot <- renderPlotly({
    p <- plot_ly(dat, x = ~var1) %>% 
      add_histogram()
    p
  })

  observeEvent(event_data("plotly_click"), {
    click <- event_data("plotly_click")
    level <- click$x

    opacityVec <- seq(.1,1,.1)
    revOpacityVec <- rev(opacityVec)

    for(i in seq_along(opacityVec)){
      opacity <- lvls %>% 
        as_tibble() %>% 
        mutate(opacity = ifelse(value == level, opacityVec[i], revOpacityVec[i])) %>% 
        .$opacity

      plotlyProxy("plot", session) %>% 
        plotlyProxyInvoke("restyle",
                          list(marker.opacity = list(opacity)))

      Sys.sleep(0.03)
    }

  })

}

shinyApp(ui = ui, server = server)