在 plotlyProxyInvoke addTraces 之后调整大小

Question

我正在编写一个 shiny 应用程序，其中 plotly 箱线图中的一些数据点根据通过单击leaflet 地图。

突出显示已通过 plotlyProxyInvoke 和方法 addTraces 完成，因为我无法绕过 relayout 方法。这种方法的问题在于，在 plotlyProxyInvoke 添加新点后，具有许多离散类的箱线图会调整 x 轴的大小。

我希望以下最小可重现示例有助于理解我的观点。在示例中，observe 和 plotlyProxyInvoke 由操作按钮触发。

library(data.table)
library(shiny)
library(plotly)

set.seed(1234)
my_data <- data.table(class = rep(LETTERS[1:20], 10),
                      val = rnorm(200, 0, 1),
                      type = sample(c(0:10), 200, replace = TRUE))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      width = 3,
      actionButton("button", "Find type = 1")
    ),
    mainPanel(
      plotlyOutput("boxplot")
    )
  )
)

# Plotly Boxplot
server <- function(input, output, session) {
  output$boxplot <- renderPlotly({
    plot_ly(source = "boxplot") %>%
      add_trace(
        data = my_data,
        x = ~class,
        y = ~val,
        color = ~I("gray"),
        marker = list(
          color = "black"
        ),
        line = list(color = "black"),
        type = "box",
        boxpoints = "all",
        pointpos = 0,
        jitter = 0.5
      ) %>%
      layout(
        xaxis = list(
          fixedrange = TRUE
        ),
        yaxis = list(
          fixedrange = TRUE
        )
      )
  })

  # Highlight points for type = 1 ----------------------------------------------
  observeEvent(input$button, {
    
    plotlyProxy("boxplot", session) %>%
      plotlyProxyInvoke(
        method = "addTraces",
        list(
          x = my_data[type == 1, class],
          y = my_data[type == 1, val],
          type = "scatter",
          mode = "markers",
          hoverinfo = "skip",
          marker = list(
            opacity = 1,
            color = "red",
            size = 10
          )
        )
      )
  })
}

# Run the application
shinyApp(ui = ui, server = server)

当然，理想的行为是避免调整大小并突出显示实际点，而不是添加一些新点。谢谢。

Answer 1

以下是如何使用 Plotly.restyle 以编程方式 select 点，从而避免添加新的轨迹。

更多信息请查看代码中的注释：

library(data.table)
library(shiny)
library(plotly)

set.seed(1234)
my_data <- data.table(
  class = rep(LETTERS[1:20], 10),
  val = rnorm(200, 0, 1),
  type = sample(c(0:10), 200, replace = TRUE)
)
setorder(my_data, type) # order matters: so that the selection corresponds to the internal pointNumber (see e.g. click events)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(width = 3,
               actionButton("button", "Find type = 1")),
  mainPanel(plotlyOutput("boxplot"))
))

# Plotly Boxplot
server <- function(input, output, session) {
  output$boxplot <- renderPlotly({
    # set color for selected points
    # run schema()
    # and navigate: object -> traces -> box -> attributes -> selected -> marker
    # for more info
    plot_ly(source = "boxplot", selected = list(marker = list(color = "red"))) %>%
      add_trace(
        data = my_data,
        x = ~ class,
        y = ~ val,
        color = ~ I("gray"),
        marker = list(color = "black"),
        line = list(color = "black"),
        type = "box",
        boxpoints = "all",
        pointpos = 0,
        jitter = 0.5
      ) %>%
      layout(xaxis = list(fixedrange = TRUE),
             yaxis = list(fixedrange = TRUE))
  })
  
  boxProxy <- plotlyProxy("boxplot", session)
  
  
  # Highlight points for type == 1 ------------------------------------------
  observeEvent(input$button, {
    # traceNumber = 0
    plotlyProxyInvoke(boxProxy, "restyle", list(selectedpoints = list(which(
      my_data$type == 1
    ))), 0)
  })
  
  # doubleclick events ------------------------------------------------------
  # run schema()
  # and navigate: object -> traces -> bar -> attributes -> selectedpoints -> description
  observeEvent(event_data(event = "plotly_doubleclick", source = "boxplot"),
               {
                 # deselecting all points for all traces
                 plotlyProxyInvoke(
                   boxProxy,
                   "restyle",
                   list(
                     selectedpoints = NULL,
                     selected = list(marker = list(color = "black")),
                     unselected = list(marker = list(opacity = 0.4))
                   )
                 ) 
               })
  
}

shinyApp(ui = ui, server = server)

Edit：另一种方法基于第二条轨迹而不是 selectedpoints:

library(data.table)
library(shiny)
library(plotly)

set.seed(1234)
my_data <- data.table(class = rep(LETTERS[1:20], 10),
                      val = rnorm(200, 0, 1),
                      type = sample(c(0:10), 200, replace = TRUE))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      width = 3,
      actionButton("button", "Find type = 1")
    ),
    mainPanel(
      plotlyOutput("boxplot")
    )
  )
)

# Plotly Boxplot
server <- function(input, output, session) {
  output$boxplot <- renderPlotly({
    plot_ly(source = "boxplot") %>%
      add_trace(
        data = my_data,
        x = ~class,
        y = ~val,
        color = ~I("gray"),
        marker = list(
          color = "black"
        ),
        line = list(color = "black"),
        type = "box",
        boxpoints = "all",
        pointpos = 0,
        jitter = 0.5
      ) %>% add_trace(
        data = my_data[type == 1],
        x = ~class,
        y = ~val,
        type = "scatter",
        mode = "markers",
        hoverinfo = "skip",
        marker = list(
          opacity = 1,
          color = "black"
        )
      ) %>% 
      layout(
        xaxis = list(
          fixedrange = TRUE
        ),
        yaxis = list(
          fixedrange = TRUE
        )
      )
  })
  
  boxProxy <- plotlyProxy("boxplot", session)
  
  # Highlight points for type == 1 ------------------------------------------
  observeEvent(input$button, {
    plotlyProxyInvoke(boxProxy, "restyle", list(marker = list(
      opacity = 1,
      color = "red"
    )), 1)
  })
  
  # doubleclick events ------------------------------------------------------
  # run schema()
  # and navigate: object -> traces -> bar -> attributes -> selectedpoints -> description
  observeEvent(event_data(event = "plotly_doubleclick", source = "boxplot"),
               {
                 plotlyProxyInvoke(boxProxy, "restyle", list(marker = list(
                   opacity = 1,
                   color = "black"
                 )), 1)
               })

}

# Run the application
shinyApp(ui = ui, server = server)

在 plotlyProxyInvoke addTraces 之后调整大小

plotly resized after plotlyProxyInvoke addTraces

r

shiny

plotly

r-plotly