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)
You are sending the entire Element
column as a vector. You should only send the last value. Try using:
newLabel <- tail(addLabel()$Element, 1)