Измените цвет маркеров трассировки в сюжете с помощью графически прокси, не меняя размер маркера

Question

Я пытаюсь использовать plotlyproxy для изменения color trace, что работает, но проблема в том, что он также меняет размер моих маркеров / legendmarkers.

Давным-давно я обнаружил, что (насколько показывает мое текущее исследование) до сих пор нет способа отдельно установить размер маркеров легенды, чтобы он отличался от маркера сюжета.

Бедствие, если вы хотите построить 5000 точек на точечном графике, если вы спросите меня, когда у вас появятся либо крошечные легенды, либо гигантские маркеры.

Так что вопрос А или ВТип решения: A: найти способ использования plotlyproxy без изменения моих legend marker size или B: найти способ отдельно указать legend таким образом, чтобы это не влияло на стрельбу plotlyproxy

Я приветствую любые отзывы от людей, которые знают об этой проблеме размера легенды.

примечание: возможно, это можно сделать с помощью 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

Вы можете внедрить код JavaScript custon, используя блестящий JS. Здесь я использую некоторые d3, чтобы выбрать элементы легенды и изменить их размер. Это очень смешно, но, к сожалению, насколько я знаю, заговор не дает внутреннего решения.

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() при каждом нажатии кнопки.

Если у вас есть несколько графиков и вы хотите одинакового поведения, вы можете передать идентификатор графика в качестве параметра в js$changelegend() и изменить jsCode соответственно, чтобы справиться с этим.