当服务器中建立colourInput时,R Shiny用javascript绘图地更新痕迹颜色

时间:2019-03-11 13:05:09

标签: javascript r shiny plotly r-plotly

这是上一个问题here

的修改版本

在此应用程序中(更好地反映了我的真实应用程序),发生以下情况:

我有两组情节,
-一组的2个图显示相同的迹线,只是绘制了不同的列
-每个情节都在我的应用中的不同页面上
-这两个图应链接到1组colourInputs,在第2页上
-colourInputs内置在服务器中,renderUI * 1

* 1:由于这个原因,我相信p %>% onRender(js)方法将无法正常工作,正如我在THIS问题中看到的YNbuttons问题

目标: 如果colourInput 'COL_button_plot1_plot2_N'进行了更改->更改colortraceN-1 plot1(* 2)的plot2

* 2:跟踪号为0-n,,因此colourinput nr -1

我更改了colorInputs的命名代码,以包含它们应针对的两个图的名称:

COLElement_1 <-    function(idx){sprintf("COL_button_plot1_plot2_%d",idx)}

我怀疑我们需要将onclick = "toggleColor(this.id)")附加在colourInput上而不是{{1}上的onRender()上,因为plot

到目前为止,我已经尝试过尝试一种JavaScript,该JavaScript可以获取2个图ID和数据并具有重设样式功能,但是我仍在坚持如何使其按应用程序预期的那样工作。至少可能有助于将想法传播出去。

renderUI()

测试应用程序:

uiOutput()

更新的应用程序: 多亏了答案,得到了可行的解决方案,但是当我开始更改绘图名称时,它就会中断。在这里,我将“ plot1”的所有引用都更改为plotx。

colourInputs

1 个答案:

答案 0 :(得分:1)

您的JS代码中有一些错别字,this.value不返回颜色选择器的值。

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 (plot1 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]);",
  "};"
)

现在让我们修改colourInput,允许使用onchange属性:

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
}

server.R中:

  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)
  })