I have some experience with R by now but very little knowledge of JS. The below reproducible code uses JS to run the package jsTreeR so the user can custom build a hierarchy tree. I would like to replace the JS line in the reproducible code flagged with comment // HELP!! (about halfway down the code, inside the script <- function) with this bit of R code, for generating a sequential list of capital letters from A to ZZ: c(LETTERS, sapply(LETTERS, function(x) paste0(x, LETTERS)))
Any ideas how to do this?
The code allows the user to drag/drop elements from the "Menu" section of the hierarchy tree to the "Drag here to build tree" section beneath, with the structure reflected in the dataframe to the right.
I did find some related questions online but they were extremely outdated. Maybe things have improved since then, such as a nifty package that translates from R to JS. Who knows.
Reproducible code:
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 to build tree",
type = "target",
state = list(opened = TRUE)
)
)
checkCallback <- JS("
function(operation, node, parent, position, more) {
if(operation === 'copy_node') {
var n = parent.children.length;
if(position !== n || parent.id === '#' || node.parent !== 'j1_1' || parent.type !== 'target') {
return false;
}
}
if(operation === 'delete_node') {
if (node.type == 'item'){
text = node.text;
Shiny.setInputValue('deletion', text, {priority: 'event'});
} else if (node.type == 'subitem'){
text = parent.text;
Shiny.setInputValue('deletionsub', text, {priority: 'event'});
}
}
return true;
}"
)
customMenu <- JS("
function customMenu(node) {
var tree = $('#mytree').jstree(true);
var items = {
'delete' : {
'label' : 'Delete',
'action' : function (obj) {
parent = tree.get_node(node.parent);
nodetype = node.type;
orgid = node.orgid;
tree.delete_node(node);
},
'icon' : 'fa fa-trash'
},
};
if (node.type == 'item') {return {'delete':items.delete}}
else return {}
}
"
)
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,
checkCallback = checkCallback,
contextMenu = list(items = customMenu),
types = list(moveable = list(), target = list())
)
script <- '
var LETTERS = ["A", "B", "C", "D", "E", "F"]; // HELP!!
var Visited = {};
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("choice", text, {priority: "event"});
var instance = data.new_instance;
instance.rename_node(node, text);
node.type = "item"
node.basename = basename;
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,verbatimTextOutput("choices"))
)
)
server <- function(input, output, session){
output[["mytree"]] <- renderJstree(mytree)
Choices <- reactiveVal(data.frame(choice = character(0)))
observeEvent(input[["choice"]], {Choices(rbind(Choices(), data.frame(choice = input[["choice"]])))} )
observeEvent(input[["deletion"]], {
item = input[["deletion"]]
matched = which(Choices()$choice == item)
if (length(matched)>0) Choices(Choices()[-matched, , drop = FALSE])
})
output[["choices"]] <- renderPrint({Choices()})
}
shinyApp(ui=ui, server=server)
Starting with a portion of your
script(just for demonstration, you use the full thing):We can do this:
Which gives us: