利用plotlyProxy 添加跟踪而不重新绘制图表 - R Shiny

Question

我希望重新编码下面的图，以利用

plotlyProxy

，以便在添加其他系列（在本例中为置信区间）时，整个图不会重新渲染。这是针对 R Shiny 应用程序的，需要查看 CI 的值。

我似乎找不到

plotlyProxyInvoke

的方法，在JS中指定

add_ribbons()

方法。

见下图：

library(plotly)

month <- c('January', 'February', 'March', 'April', 'May', 'June', 'July',
           'August', 'September', 'October', 'November', 'December')

ci_high_2014 <- c(28.8, 28.5, 37.0, 56.8, 69.7, 79.7, 78.5, 77.8, 74.1, 62.6, 45.3, 39.9)
ci_low_2014 <- c(12.7, 14.3, 18.6, 35.5, 49.9, 58.0, 60.0, 58.6, 51.7, 45.2, 32.2, 29.1)

data <- data.frame(month, ci_high_2014, ci_low_2014)

data$average_2014 <- rowMeans(data[,c("ci_high_2014", "ci_low_2014")])

#The default order will be alphabetized unless specified as below:
data$month <- factor(data$month, levels = data[["month"]])


    plot_ly() %>%
      add_trace(
        data = data,
        x = ~month,
        y = ~average_2014,
        type = 'scatter',
        mode = 'lines',
        name = "Average"
        )%>%       
      add_ribbons(
        inherit = FALSE,
        data = data,
        x = ~month,
        ymin = ~average_2014,
        ymax = ~ci_high_2014,
        name = "CI hi",
        line = list(color = 'rgba(0, 0, 0, 0)'),
        fillcolor = 'rgba(255, 0, 0, 0.4)'
      ) %>%
      add_ribbons(
        inherit = FALSE,
        data = data,
        x = ~month,
        ymin = ~average_2014,
        ymax = ~ci_low_2014,
        name = "CI lo",
        line = list(color = 'rgba(0, 0, 0, 0)'),
        fillcolor = 'rgba(255, 0, 0, 0.4)'
      ) %>%
      layout(hovermode = "x unified")

我当前的工作解决方案仅添加了 CI 的线条，而不是功能区。 见下图：

library(shiny)
library(shinyWidgets)
library(plotly)

month <- c('January', 'February', 'March', 'April', 'May', 'June', 'July',
           'August', 'September', 'October', 'November', 'December')

ci_high_2014 <- c(28.8, 28.5, 37.0, 56.8, 69.7, 79.7, 78.5, 77.8, 74.1, 62.6, 45.3, 39.9)
ci_low_2014 <- c(12.7, 14.3, 18.6, 35.5, 49.9, 58.0, 60.0, 58.6, 51.7, 45.2, 32.2, 29.1)

data <- data.frame(month, ci_high_2014, ci_low_2014)

data$average_2014 <- rowMeans(data[,c("ci_high_2014", "ci_low_2014")])

#The default order will be alphabetized unless specified as below:
data$month <- factor(data$month, levels = data[["month"]])


ui <- fluidPage(
  titlePanel("plotlyProxy add Ribbons"),
  
  sidebarLayout(
    sidebarPanel(
      materialSwitch(inputId = "ci",
                     label =  "Add CI",
                     value = FALSE)
    ),
    mainPanel(
      plotlyOutput(outputId = "plot")
    )
  )
)

server <- function(input, output, session = session){
  
  output$plot <- renderPlotly({
    
    plot_ly() %>%
      add_trace(
        data = data,
        x = ~month,
        y = ~average_2014,
        type = 'scatter',
        mode = 'lines',
        name = "Average"
      ) %>%
      layout(hovermode = "x unified")
  })
  
  observeEvent(input$ci, {
    
    if(input$ci){
      
      plotlyProxy("plot",
                  session = session) %>% 
        plotlyProxyInvoke(
          method = "addTraces",
          list(
            # How to specify ribbons and ymin / ymax here?
            x = as.list(data$month),
            y = as.list(data$ci_high_2014),
            name = "CI high"
            )
          ) %>% 
        plotlyProxyInvoke(
          method = "addTraces",
          list(
            # How to specify ribbons and ymin / ymax here?
            x = as.list(data$month),
            y = as.list(data$ci_low_2014),
            name = "CI low"
            )
          )
    }else{
      plotlyProxy(outputId = "plot",
                  session) %>%
        plotlyProxyInvoke("deleteTraces", list(-1)) %>%
        plotlyProxyInvoke("deleteTraces", list(-1))
    }
  })
  
}
  

shinyApp(ui, server)

Answer 1

从头开始创建功能区需要一些努力。据我了解文档和

add_ribbons()

的实现，plotly.js 中没有带状跟踪。相反，这是使用具有属性

fill="toself"

的线条轨迹创建的，它类似地连接线条的第一个和最后一个点并填充封闭区域。也就是说，没有

ymin

和

ymax

属性。相反，您创建一个功能区，您必须连接功能区下限和上限的向量，其中必须以相反的顺序放置，即您必须将数据作为

y = c(ymin, rev(ymax))

和

x = c(x, rev(x))

传递到

addTraces 

.

library(shiny)
library(shinyWidgets)
library(plotly)

month <- c(
  "January", "February", "March", "April", "May", "June", "July",
  "August", "September", "October", "November", "December"
)

ci_high_2014 <- c(28.8, 28.5, 37.0, 56.8, 69.7, 79.7, 78.5, 77.8, 74.1, 62.6, 45.3, 39.9)
ci_low_2014 <- c(12.7, 14.3, 18.6, 35.5, 49.9, 58.0, 60.0, 58.6, 51.7, 45.2, 32.2, 29.1)

data <- data.frame(month, ci_high_2014, ci_low_2014)

data$average_2014 <- rowMeans(data[, c("ci_high_2014", "ci_low_2014")])

# The default order will be alphabetized unless specified as below:
data$month <- factor(data$month, levels = data[["month"]])


ui <- fluidPage(
  titlePanel("plotlyProxy add Ribbons"),
  sidebarLayout(
    sidebarPanel(
      materialSwitch(
        inputId = "ci",
        label = "Add CI",
        value = FALSE
      )
    ),
    mainPanel(
      plotlyOutput(outputId = "plot")
    )
  )
)

server <- function(input, output, session = session) {
  output$plot <- renderPlotly({
    plot_ly() %>%
      add_trace(
        data = data,
        x = ~month,
        y = ~average_2014,
        type = "scatter",
        mode = "lines",
        name = "Average"
      ) %>%
      layout(hovermode = "x unified")
  })

  observeEvent(input$ci, {
    if (input$ci) {
      plotlyProxy("plot",
        session = session
      ) %>%
        plotlyProxyInvoke(
          method = "addTraces",
          list(
            x = as.list(
              c(
                data$month,
                rev(data$month)
              )
            ),
            y = as.list(
              c(
                data$average_2014,
                rev(data$ci_high_2014)
              ),
            ),
            name = "CI hi",
            type = "scatter",
            mode = "lines",
            fill = "toself",
            hoveron = "points",
            line = list(color = "rgba(0, 0, 0, 0)"),
            fillcolor = "rgba(255, 0, 0, 0.4)",
            inherit = FALSE
          )
        ) %>%
        plotlyProxyInvoke(
          method = "addTraces",
          list(
            x = as.list(
              c(data$month, rev(data$month))
            ),
            y = as.list(
              c(data$average_2014, rev(data$ci_low_2014)),
            ),
            name = "CI low",
            type = "scatter",
            mode = "lines",
            fill = "toself",
            hoveron = "points",
            line = list(color = "rgba(0, 0, 0, 0)"),
            fillcolor = "rgba(255, 0, 0, 0.4)",
            inherit = FALSE
          )
        )
    } else {
      plotlyProxy(
        outputId = "plot",
        session
      ) %>%
        plotlyProxyInvoke("deleteTraces", list(-1, -2))
    }
  })
}


shinyApp(ui, server)