Why is this Shiny Handler not correctly updating the JS section of the client?

When running the reproducible code at the bottom, I get the strange results in the tree rendered on the left as illustrated in the image below. What am I doing wrong, in my use of the handlers or perhaps in JS script?

“Elements” reads the positions of the tree, “Elements2” does a bit of example transformation, and the Element column in “Elements2” should feed back to the client using Shiny handlers to relabel the tree nodes.

Reproducible code:

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

You are sending the entire Element column as a vector. You should only send the last value. Try using:

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

Advertisement

Answer