为什么这个闪亮的Handler不能正确地更新客户机的JS部分？

Question

在底部运行可再现代码时，我在左边呈现的树中得到奇怪的结果，如下图所示。在使用处理程序时，或者在JS脚本中，我做错了什么？

“元素”读取树的位置，"Elements2“进行一些示例转换，"Elements2”中的元素列应该使用闪亮的处理程序返回给客户端，以重新命名树节点。

​

​

可复制代码：

library(dplyr)
library(jsTreeR)
library(shiny)

nodes <- list(
  list(
    text = "Menu",
    state = list(opened = TRUE),
    children = list(
      list(text = "Bog",type = "moveable"),list(text = "Hog",type = "moveable")
    )
  ),
  list(text = "Drag here",type = "target",state = list(opened = TRUE))
)

dnd <- list(
  always_copy = TRUE,
  inside_pos = "last", 
  is_draggable = JS(
    "function(node) {",
    "  return node[0].type === 'moveable';",
    "}"
  )
)

mytree <- jstree(nodes,dragAndDrop=TRUE,dnd = dnd,types=list(moveable=list(),target=list()))

script <- '
var LETTERS = ["A", "B", "C", "D", "E"];
var Visited = {};
function updateSubItems(parent){
  var tree = $("#mytree").jstree(true);
  for (var i = 0; i< parent.children.length; ++i){
    sibling = tree.get_node(parent.children[i]);
    tree.rename_node(sibling, parent.text + " - " + (i+1))
  }
}
// Returns letter of a new copied node
function getSuffix(orgid){
  if (Object.keys(Visited).indexOf(orgid) === -1){
    Visited[orgid] = 0;
  }else{
    Visited[orgid]++;
  }
  return LETTERS[Visited[orgid]];
}
$(document).ready(function(){
  $("#mytree").on("copy_node.jstree", function(e, data){
    var orgid = data.original.id;
    var node    = data.node;
    var id      = node.id;
    var basename= node.text;
    var text    = basename + " " + getSuffix(orgid); 
    Shiny.setInputValue("Element", text, {priority: "event"});
    var instance  = data.new_instance;
    instance.rename_node(node, text);
    node.type     = "item";
    // the shiny handler below receives newLabel from the server for injecting labels to tree
    Shiny.addCustomMessageHandler("injectLabel", function(newLabel) {
      instance.rename_node(node, newLabel);
    });
    node.orgid    = orgid;
    var tree        = $("#mytree").jstree(true);
  });
});
'

ui <- fluidPage(
  tags$div(class = "header", checked = NA,tags$p(tags$script(HTML(script)))),
  fluidRow(
    column(width = 4,jstreeOutput("mytree")),
    column(width = 8,fluidRow(verbatimTextOutput("Elements"),verbatimTextOutput("Elements2")))
  )
)

server <- function(input, output, session){
  output[["mytree"]] <- renderJstree(mytree)
  
  Elements <- reactiveVal(data.frame(Element = character(0)))
  
  observeEvent(input[["Element"]], {Elements(rbind(Elements(), data.frame(Element = input[["Element"]])))} )

  addLabel <- reactive({if(nrow(Elements()>0)){
    addLabel <- Elements()
    addLabel <- addLabel %>% 
      group_by(Element) %>%
      mutate(ElementCount = row_number()) %>%
      ungroup() %>%
      mutate(Element = paste(Element,"-",ElementCount)) %>% select(-ElementCount)
    addLabel  
  }})
  
  output[["Elements"]] <- renderPrint({Elements()})
  output[["Elements2"]] <- renderPrint({as.data.frame(addLabel())})
 
  observe({
    newLabel <- addLabel()$Element
    session$sendCustomMessage("injectLabel", newLabel)
  })
}

shinyApp(ui=ui, server=server)

Answer 1

您要将整个Element列作为向量发送。您应该只发送最后一个值。试着使用：

newLabel <- tail(addLabel()$Element, 1)