Анимация изменений с plotlyProxy в блестящем? - PullRequest
Новая
       22

Анимация изменений с plotlyProxy в блестящем?

1 голос
/ 13 апреля 2019

У меня есть приложение 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 Ответ

1 голос
/ 16 апреля 2019

Не уверен, что этого достаточно, потому что вы явно просили анимацию. Тем не менее, вот решение, обеспечивающее вам ожидаемое поведение путем повторного рестайлинга сюжета: 

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