javascript - 神秘的 javascript 错误取决于 R shiny 应用程序中使用的绘图对象名称

Question

在下面的应用程序中有一些奇怪的谜团:为什么我不能为我的地 block 使用某些名称？

该应用程序构建为虚拟应用程序，用于更改绘图中轨迹的颜色。1 个按钮影响 2 个绘图中的轨迹 x，每个轨迹有一个按钮。

按钮名称包含两个图的名称，以及它们所针对的轨迹。

当绘图被命名为 plot1、plot2、plot3、plot4 时，一切正常。但它用于的实际程序使用不同的绘图名称。在代码中将 plot1 的所有实例更改为“FP1plot”仍然有效，将 plot3 更改为“FP2plot”仍然有效，但是大多数用于替换 plot3 和 plot 4 的名称都不起作用，并且还使用其他几个名称来替换 plot1 或 plot2 突然导致绘图中断并且不再呈现。

我和帮助我开发这个虚拟应用程序的更有经验的 javascript 用户，都不知道是什么导致了这种随机行为，即一些名称有效，而其他名称无效。

我希望使用的预期名称依次为:'FP1plot'、'CleanFP1'、'FP2plot'、'CleanFP2'。

这是带有 javascript 的有问题的 Shiny 应用程序:

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

jscolor <- c(
  "function toggleColor(id){",
  "  var color = document.getElementById(id).value;", # get the color of the colourpicker
  "  var ids = id.split('-');", # split the ids
  "  var plotAid = ids[2];", #get the id of plotA (FP1plot or 3)
  "  var plotBid = ids[3];", #get the id of plotB (plot2 or 4)
  "  var index = parseInt(ids[4]) -1;", #get the trace number to target
  "  var plotA = document.getElementById(plotAid);", #get the plot element
  "  var dataA = plotA.data;", #access the plot data
  "  var markerA = dataA[index].marker;", #access the plot's markers
  "  markerA.color = color;",  # set the marker color
  "  Plotly.restyle(plotA, {marker: markerA}, [index]);", #restyle plotA
  "  var plotB = document.getElementById(plotBid);", # repeat steps for plot2
  "  var dataB = plotB.data;",
  "  var markerB = dataB[index].marker;",
  "  markerB.color = color;",
  "  Plotly.restyle(plotB, {marker: markerB}, [index]);",
  "};"
)

colourInput2 <- function(inputId, label, value = "white", 
                         showColour = c("both", "text", "background"), 
                         palette = c("square", "limited"), allowedCols = NULL,
                         allowTransparent = FALSE, returnName = FALSE, 
                         onchange){
  input <- colourInput(inputId, label, value, showColour, palette, 
                       allowedCols, allowTransparent, returnName)
  attribs <- c(input$children[[2]]$attribs, onchange = onchange)
  input$children[[2]]$attribs <- attribs
  input
}


ui <- fluidPage(
  tags$head(
    tags$script(HTML(jscolor))  ## to add the javascript to the app
  ),
  fluidRow(
    column(4,plotlyOutput("FP1plot")),
    column(4,plotlyOutput("plot2")),
    column(4,uiOutput('buttons_color_1')
    )
  ),
  fluidRow(
    column(4,plotlyOutput("FP2plot")),
    column(4,plotlyOutput("plot4")),
    column(4,uiOutput('buttons_color_2'))
  )
)

server <- function(input, output, session) {
  #functions to make colorinput IDs
  COLElement_1 <-    function(idx){sprintf("COL_button_FP1plot_plot2_%d",idx)}
  COLElement_2 <-    function(idx){sprintf("COL_button_FP2plot_plot4_%d",idx)}


  TheColors <- c('#383838', '#5b195b','#1A237E', '#000080', '#224D17', '#cccc00', '#b37400',  '#990000', 
                 '#505050',  '#a02ca0',  '#000099', '#2645e0', '#099441', '#e5e500', '#cc8400', '#cc0000', 
                 '#737373', '#e53fe5', '#0000FF', '#4479e1',  '#60A830', '#ffff00','#e69500', '#ff0000', 
                 '#b2b2b2', '#eb6ceb', '#6666ff', '#d0a3ff', '#9FDA40',  '#ffff7f', '#ffa500', '#ff4c4c',
                 '#d9d9d9',  '#f198f1',  '#C5CAE9','#BBDEFB','#D9DF1D', '#ffffcc','#ffc04d', '#ff9999')

  values <- reactiveValues(colors1 = TheColors, colors2 = sort(TheColors))
  lapply(c(1:2), function(i) {
    output[[paste('buttons_color_', i,sep = '')]] <- renderUI({
      inputs <- lapply(1:3, function(x) {  ## 3 in my app changes based on clustering output of my model
        Idname <- if(i == 1) { COLElement_1(x) } else {COLElement_2(x) }
        colour_input <- colourInput2(inputId = Idname, label = NULL,
                                     palette = "limited", allowedCols = TheColors,
                                     value = isolate(values[[paste('colors', i, sep = '')]][x]),
                                     showColour = "background", returnName = FALSE, 
                                     onchange = "toggleColor(this.id)")
        div(colour_input,
            style = "height: 30px; width: 30px; border-radius: 6px;  border-width: 2px; text-align:center; padding: 0px; display:block; margin: 10px"
        )
      })
      do.call(tagList, inputs)
    })
    # useless: outputOptions(output, paste('buttons_color_', i,sep = ''), suspendWhenHidden=FALSE)
  })


  myplotly <- function(THEPLOT, xvar, setnr) {
    markersize <- 2
    markerlegendsize <- 10
    colors <- isolate ({values[[paste('colors', setnr, sep = '')]]  })
    p <- plot_ly(source = paste('plotlyplot', THEPLOT, sep = '.'))
    p <-  add_trace(p, data = mtcars, x = mtcars[[xvar]], y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
    p <- layout(p, title = 'mtcars group by cyl with switching colors')
    p <- plotly_build(p)
    p 
  }

  output$FP1plot <- renderPlotly({ myplotly('FP1plot', 'hp', 1) })
  output$plot2 <- renderPlotly({ myplotly('plot2', 'disp', 1)})
  output$FP2plot <- renderPlotly({ myplotly('FP2plot','hp', 2)})
  output$plot4 <- renderPlotly({ myplotly('plot4', 'disp', 2)})

}

shinyApp(ui, server)

更新应用程序，使用 S.L. 的解决方法但绘图现在在启动时以错误的颜色呈现

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

jscolor <- c(
  "function toggleColor(id){",
  "  var color = document.getElementById(id).value;", # get the color of the colourpicker
  "  var ids = id.split('_');", # split the id
  "  var plotAid = ids[2];", #get the id of plotA (plotw or 3)
  "  var plotBid = ids[3];", #get the id of plotB (CleanFP1 or 4)
  "  var index = parseInt(ids[4]) - 1;", #get the trace number to target
  "  var plotA = document.getElementById(plotAid);", #get the plot element
  "  if(plotA.innerHTML !== ''){",
  "    var dataA = plotA.data;", #access the plot data
  "    var markerA = dataA[index].marker;", #access the plot's markers
  "    markerA.color = color;",  # set the marker color
  "    Plotly.restyle(plotA, {marker: markerA}, [index]);", #restyle plotA
  "  }",
  "  var plotB = document.getElementById(plotBid);", # repeat steps for CleanFP1
  "  if(plotB.innerHTML !== ''){",
  "    var dataB = plotB.data;",
  "    var markerB = dataB[index].marker;",
  "    markerB.color = color;",
  "    Plotly.restyle(plotB, {marker: markerB}, [index]);",
  "  }",
  "};"
)

colourInput2 <- function(inputId, label, value = "white", 
                         showColour = c("both", "text", "background"), 
                         palette = c("square", "limited"), allowedCols = NULL,
                         allowTransparent = FALSE, returnName = FALSE, 
                         onchange){
  input <- colourInput(inputId, label, value, showColour, palette, 
                       allowedCols, allowTransparent, returnName)
  attribs <- c(input$children[[2]]$attribs, onchange = onchange)
  input$children[[2]]$attribs <- attribs
  input
}


ui <- fluidPage(
  tags$head(
    tags$script(HTML(jscolor))  ## to add the javascript to the app
  ),
  fluidRow(
    column(4,plotlyOutput("FP1plot")),
    column(4,plotlyOutput("CleanFP1")),
    column(4,uiOutput('buttons_color_1')
    )
  ),
  fluidRow(
    column(4,plotlyOutput("FP2plot")),
    column(4,plotlyOutput("CleanFP2")),
    column(4,uiOutput('buttons_color_2'))
  )
)

server <- function(input, output, session) {
  #functions to make colorinput IDs
  COLElement_1 <-    function(idx){sprintf("COL_button_FP1plot_CleanFP1_%d",idx)}
  COLElement_2 <-    function(idx){sprintf("COL_button_FP2plot_CleanFP2_%d",idx)}

  TheColors <- c('#383838',  '#000080',  '#b37400',
                 '#737373', '#e53fe5', '#0000FF', '#4479e1',  '#60A830', '#ffff00','#e69500', '#ff0000', 
                 '#b2b2b2', '#eb6ceb', '#6666ff', '#d0a3ff', '#9FDA40',  '#ffff7f', '#ffa500', '#ff4c4c',
                 '#d9d9d9',  '#f198f1',  '#C5CAE9','#BBDEFB','#D9DF1D', '#ffffcc','#ffc04d', '#ff9999')

  values <- reactiveValues(colors1 = TheColors, colors2 = sort(TheColors))
  lapply(c(1:2), function(i) {
    output[[paste('buttons_color_', i,sep = '')]] <- renderUI({
      inputs <- lapply(1:3, function(x) {  ## 3 in my app changes based on clustering output of my model
        Idname <- if(i == 1) { COLElement_1(x) } else {COLElement_2(x) }
        colour_input <- colourInput2(inputId = Idname, label = NULL,
                                     palette = "limited", allowedCols = TheColors,
                                     value = isolate(values[[paste('colors', i, sep = '')]][x]),
                                     showColour = "background", returnName = FALSE, 
                                     onchange = "toggleColor(this.id)")
        div(colour_input,
            style = "height: 30px; width: 30px; border-radius: 6px;  border-width: 2px; text-align:center; padding: 0px; display:block; margin: 10px"
        )
      })
      do.call(tagList, inputs)
    })
    # useless: outputOptions(output, paste('buttons_color_', i,sep = ''), suspendWhenHidden=FALSE)
  })


  myplotly <- function(THEPLOT, xvar, setnr) {
    markersize <- 2
    markerlegendsize <- 10
    colors <- isolate ({values[[paste('colors', setnr, sep = '')]]  })
    p <- plot_ly(source = paste('plotlyplot', THEPLOT, sep = '.'))
    p <-  add_trace(p, data = mtcars, x = mtcars[[xvar]], y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
    p <- layout(p, title = 'mtcars group by cyl with switching colors')
    p <- plotly_build(p)
    p 
  }

  output$FP1plot <- renderPlotly({ myplotly('FP1plot', 'hp', 1) })
  output$CleanFP1 <- renderPlotly({ myplotly('CleanFP1', 'disp', 1)})
  output$FP2plot <- renderPlotly({ myplotly('FP2plot','hp', 2)})
  output$CleanFP2 <- renderPlotly({ myplotly('CleanFP2', 'disp', 2)})

}

shinyApp(ui, server)

补充问题:
事实证明，Plotly.restyle 有在运行时替换所有标记属性的恶习。在这种情况下，我们现在成功更新了颜色，但是我们丢失了所有尺寸和其他样式属性，因为当 Plotly.restyle 在没有输入这些属性的情况下运行时，它们被默认值替换。为了获得一个完全有效的 javascript 解决方案，我们似乎还需要收集大小输入等以完全重新设置标记的样式......

Answer 1

我不明白为什么行为取决于 ID，但这里有一个解决方法:

jscolor <- c(
  "function toggleColor(id){",
  "  var color = document.getElementById(id).value;", # get the color of the colourpicker
  "  var ids = id.split('_');", # split the id
  "  var plotAid = ids[2];", #get the id of plotA (plotw or 3)
  "  var plotBid = ids[3];", #get the id of plotB (plot2 or 4)
  "  var index = parseInt(ids[4]) - 1;", #get the trace number to target
  "  var plotA = document.getElementById(plotAid);", #get the plot element
  "  if(plotA.innerHTML !== ''){",
  "    var dataA = plotA.data;", #access the plot data
  "    var markerA = dataA[index].marker;", #access the plot's markers
  "    markerA.color = color;",  # set the marker color
  "    Plotly.restyle(plotA, {marker: markerA}, [index]);", #restyle plotA
  "  }",
  "  var plotB = document.getElementById(plotBid);", # repeat steps for plot2
  "  if(plotB.innerHTML !== ''){",
  "    var dataB = plotB.data;",
  "    var markerB = dataB[index].marker;",
  "    markerB.color = color;",
  "    Plotly.restyle(plotB, {marker: markerB}, [index]);",
  "  }",
  "};"
)

编辑

如 OP 所述，此解决方法在启动时存在问题。这是另一个解决方法。它只是增加了 1 毫秒的延迟。

jscolor <- c(
  "function toggleColor0(id){",
  "  var color = document.getElementById(id).value;", # get the color of the colourpicker
  "  var ids = id.split('_');", # split the id
  "  var plotAid = ids[2];", #get the id of plotA (plotw or 3)
  "  var plotBid = ids[3];", #get the id of plotB (plot2 or 4)
  "  var index = parseInt(ids[4]) - 1;", #get the trace number to target
  "  var plotA = document.getElementById(plotAid);", #get the plot element
  "  var dataA = plotA.data;", #access the plot data
  "  var markerA = dataA[index].marker;", #access the plot's markers
  "  markerA.color = color;",  # set the marker color
  "  Plotly.restyle(plotA, {marker: markerA}, [index]);", #restyle plotA
  "  var plotB = document.getElementById(plotBid);", # repeat steps for plot2
  "  var dataB = plotB.data;",
  "  var markerB = dataB[index].marker;",
  "  markerB.color = color;",
  "  Plotly.restyle(plotB, {marker: markerB}, [index]);",
  "};",
  "function toggleColor(id){",
  "  setTimeout(function(){toggleColor0(id);}, 1);",
  "}"
)

事实上这也适用于 0ms 的延迟:

setTimeout(function(){toggleColor0(id);}, 0);