R Shiny + plotly : change color of a trace with javascript without affecting markers and legend in multiple plots

后端 未结 1 914
北海茫月
北海茫月 2021-01-27 07:15

This is a follow up question based on THIS post.

The demo app here is a closer representation of my more complex situation of my real shiny app that I\'m

相关标签:
1条回答
  • 2021-01-27 07:44

    I'm lost :) Let's start. Here is an app allowing to change the marker size:

    library(plotly)
    library(shiny)
    
    js <- paste(c(
      "$(document).ready(function(){",
      "  $('#size').on('change', function(){",
      "    var size = Number(this.value);",
      "    var plot = document.getElementById('plot');",
      "    var data = plot.data;",
      "    $.each(data, function(index,value){",
      "      var marker = data[index].marker;",
      "      marker.size = size;",
      "      Plotly.restyle(plot, {marker: marker}, [index]);",
      "    });",
      "  });",
      "})"), sep = "\n")
    
    ui <- fluidPage(
      tags$head(
        tags$script(HTML(js))
      ),
      plotlyOutput("plot"),
      numericInput("size", "Size", value = 5, min = 1, max = 15)
    )
    
    server <- function(input, output, session) {
    
      output$plot <- renderPlotly({
        p <- plot_ly()
        for(name in c("drat", "wt", "qsec"))
        {
          p <- add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
        }
        p 
      })
    
    }
    
    shinyApp(ui, server)
    

    And here is an app allowing to change the marker color:

    library(plotly)
    library(shiny)
    library(colourpicker)
    library(htmlwidgets)
    
    js <- c(
      "function(el,x){",
      "  $('[id^=Color]').on('change', function(){",
      "    var color = this.value;",
      "    var id = this.id;",
      "    var index = parseInt(id.split('-')[1]) - 1;",
      "    var data = el.data;",
      "    var marker = data[index].marker;",
      "    marker.color = color;",
      "    Plotly.restyle(el, {marker: marker}, [index]);",
      "  });",
      "}")
    
    ui <- fluidPage(
      plotlyOutput("plot"),
      colourInput("Color-1", "Color item 1", value = "blue"),
      colourInput("Color-2", "Color item 2", value = "red"),
      colourInput("Color-3", "Color item 3", value = "green")
    )
    
    server <- function(input, output, session) {
    
      output$plot <- renderPlotly({
        p <- plot_ly()
        for(name in c("drat", "wt", "qsec"))
        {
          p <- add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
        }
        p %>% onRender(js)
      })
    
    }
    
    shinyApp(ui, server)
    

    Does it help?

    0 讨论(0)
提交回复
热议问题