在不更改标记大小的情况下，使用绘图代理更改轨迹标记的颜色

Question

我正在尝试使用plotlyproxy 来更改trace 的color，这可行， 但问题是，它还会改变我的标记/legendmarkers 的大小。

很久以前，我发现（据我目前的研究显示）仍然无法单独将图例标记的大小设置为与绘图标记不同。

如果你想在散点图中绘制 5000 个点，如果你问我最终得到的是微小的图例或巨大的情节标记，那将是一场灾难。

所以问题是 A 或 B 解决方案类型： A：想办法在不改变我的legendmarkersize的情况下使用plotlyproxy 要么 B：找到一种在plotlyproxy 触发时不受影响的方式单独调整legend 的大小

我欢迎了解此图例大小问题的人提供任何反馈。

注意：可能这可以使用 javascript 完成，但如果在这种情况下，我可能需要提供有关我正在开发的实际应用程序的更多信息以使其正常工作

这是展示它的虚拟应用程序：

library(plotly)
library(shiny)
library(htmlwidgets)
library(colourpicker)


ui <- fluidPage(
  fluidRow(
     column(8,
           plotlyOutput("plot1")
    ),
    column(2,
                   colourpicker::colourInput(inputId = 'markercolor', label = 'X',
           palette = "limited", 
           showColour = "background", returnName = TRUE),
           selectInput(inputId = 'traceNo', label = 'Trace', choices = c(1:3), selected = 1),
           br(),
           h5('Switch'),
           actionButton(inputId = 'Switch', label = icon('refresh'), style = "color: #f7ad6e;   background-color: white;  border-color: #f7ad6e;
                        height: 40px; width: 40px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px")
    )
  )
)

server <- function(input, output, session) {
  # values <- reactiveValues()


  observeEvent(input$Switch, { 
    plotlyProxy("plot1", session) %>%
      plotlyProxyInvoke("restyle", list(marker = list(color = input$markercolor)), list(as.numeric(input$traceNo)-1))
    })

  output$plot1 <- renderPlotly({
    markersize <- 4
    markerlegendsize <- 20
   colors <- c('red', 'blue', 'black')
    p1 <- plot_ly()
    p1 <-  add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
    p1 <- layout(p1, title = 'mtcars group by cyl with switching colors')
    p1 <- plotly_build(p1)

    ## this is a bit of a hack to change the size of the legend markers to not be equal to the plot marker size. 
    ## it makes a list of 1 size value for each marker in de trace in the plot, and another half of with sizes that are a lot bigger.
    ## the legend marker size is effectively the average size of all markers of a trace
    for(i in seq(1, length(sort(unique(mtcars$cyl) )))) {
      length.group <- nrow(mtcars[which(mtcars$cyl  == sort(unique(mtcars$cyl))[i]), ])
      p1$x$data[[i]]$marker$size <- c(rep(markersize,length.group), rep(c(-markersize+2*markerlegendsize), length.group))
    }
    p1
  })
}

shinyApp(ui, server)

Answer 1

您可以使用 shinyJS 注入自定义 JavaScript 代码。在这里，我使用一些 d3 来选择图例项并更改它们的大小。它非常hacky，但不幸的是，据我所知，plotly 不提供内部解决方案。

library(plotly)
library(shiny)
library(htmlwidgets)
library(colourpicker)
library(shinyjs)

jsCode <- "shinyjs.changelegend = function(){
var paths = d3.select('#plot1').
select('.legend').
select('.scrollbox').
selectAll('.traces').
select('.scatterpts')
.attr('d','M8,0A8,8 0 1,1 0,-8A8,8 0 0,1 8,0Z');}"

ui <- fluidPage(
  tags$script(src = "https://d3js.org/d3.v4.min.js"),
  useShinyjs(),
  extendShinyjs(text = jsCode),
  fluidRow(
    column(8,
           plotlyOutput("plot1")
    ),
    column(2,
           colourpicker::colourInput(inputId = 'markercolor', label = 'X',
                                     palette = "limited", 
                                     showColour = "background", returnName = TRUE),
           selectInput(inputId = 'traceNo', label = 'Trace', choices = c(1:3), selected = 1),
           br(),
           h5('Switch'),
           actionButton(inputId = 'Switch', label = icon('refresh'), style = "color: #f7ad6e;   background-color: white;  border-color: #f7ad6e;
                        height: 40px; width: 40px; border-radius: 6px;  border-width: 2px; text-align: center;  line-height: 50%; padding: 0px; display:block; margin: 2px")
           )
    ),
  tags$div(id = "test")
  )

server <- function(input, output, session) {
  # values <- reactiveValues()


  observeEvent(input$Switch, { 
    plotlyProxy("plot1", session) %>%
      plotlyProxyInvoke("restyle", list(marker = list(color = input$markercolor)), list(as.numeric(input$traceNo)-1))
  })

  observeEvent(input$Switch,{
    js$changelegend()
  })

  output$plot1 <- renderPlotly({
    markersize <- 4
    markerlegendsize <- 20
    colors <- c('red', 'blue', 'black')
    p1 <- plot_ly()
    p1 <-  add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
    p1 <- layout(p1, title = 'mtcars group by cyl with switching colors')
    p1 <- plotly_build(p1)

    # this is a bit of a hack to change the size of the legend markers to not be equal to the plot marker size.
    # it makes a list of 1 size value for each marker in de trace in the plot, and another half of with sizes that are a lot bigger.
    # the legend marker size is effectively the average size of all markers of a trace
    for(i in seq(1, length(sort(unique(mtcars$cyl) )))) {
      length.group <- nrow(mtcars[which(mtcars$cyl  == sort(unique(mtcars$cyl))[i]), ])
      p1$x$data[[i]]$marker$size <- c(rep(markersize,length.group), rep(c(-markersize+2*markerlegendsize), length.group))
    }
    return(p1)
  })

}

shinyApp(ui, server)

自定义javascript代码在jsCode中定义，在extendShinyjs()中初始化。最后，每当单击按钮时，它都会在js$changelegend() 中调用。

如果您有多个绘图并且想要相同的行为，您可以将绘图 ID 作为参数传递给 js$changelegend() 并相应地更改 jsCode 以处理此问题。