I am trying to generate sequential numbering for elements dragged-in (copied-over) from one hierarchy tree node to another node, while giving the user the option of where to drop the element in the target node. The sequential numbering should reflect the target node ordering of elements, as shown in the illustrations at the bottom of this post. Reproducible code is below. Any suggestions for how to do this?
Please note that for the sake of code brevity, I've deleted some very nice features. But when I finish exploring the jsTreeR package, I'll post the entire thing so users can see the complete benefits.
This is a follow-on to post How to pull specific node elements from a jsTree into an R data frame?
Reproducible code:
library(jsTreeR)
library(shiny)
nodes <- list(
list(
text = "Menu",
state = list(opened = TRUE),
children = list(
list(
text = "A",
type = "moveable",
state = list(disabled = TRUE)
),
list(
text = "B",
type = "moveable",
state = list(disabled = TRUE)
)
)
),
list(
text = ">>> Drag here <<<",
type = "target",
state = list(opened = TRUE)
)
)
checkCallback <- JS(
"function(operation, node, parent, position, more) { ",
" if(operation === 'copy_node') {",
" if(parent.id === '#' || node.parent !== 'j1_1' || parent.type !== 'target') {",
" return false;", # prevent moving an item above or below the root
" }", # and moving inside an item except a 'target' item
" }",
" if(operation === 'delete_node') {",
" Shiny.setInputValue('deletion', position + 1);",
" }",
" return true;", # allow everything else
"}"
)
dnd <- list(
always_copy = TRUE,
is_draggable = JS(
"function(node) {",
" return node[0].type === 'moveable';",
"}"
)
)
mytree <- jstree(
nodes, dragAndDrop = TRUE, dnd = dnd, checkCallback = checkCallback,
types = list(moveable = list(), target = list())
)
script <- '
$(document).ready(function(){
$("#mytree").on("copy_node.jstree", function(e, data){
var instance = data.new_instance;
var node = data.node;
var id = node.id;
var index = $("#"+id).index() + 1;
var text = index + ". " + node.text;
Shiny.setInputValue("choice", text);
instance.rename_node(node, text);
});
});
'
library(shiny)
ui <- fluidPage(
tags$head(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"]], {Choices(Choices()[-input[["deletion"]], , drop = FALSE])})
output[["choices"]] <- renderPrint({Choices()})
}
shinyApp(ui, server)
Illustration:
Edit in response to first comment so that user can only drag/copy into the last position of "Drag here" node:
Reproducible code (the 2 additions to OP are flagged with # comments):
nodes <- list(nodes <- list(
list(
text = "Menu",
state = list(opened = TRUE),
children = list(
list(
text = "A",
type = "moveable",
state = list(disabled = TRUE)
),
list(
text = "B",
type = "moveable",
state = list(disabled = TRUE)
),
list( # ADDED A 3rd ELEMENT
text = "C",
type = "moveable",
state = list(disabled = TRUE)
)
)
),
list(
text = ">>> Drag here <<<",
type = "target",
state = list(opened = TRUE)
)
)
checkCallback <- JS(
"function(operation, node, parent, position, more) { ",
" if(operation === 'copy_node') {",
" if(parent.id === '#' || node.parent !== 'j1_1' || parent.type !== 'target') {",
" return false;",
" }",
" }",
" if(operation === 'delete_node') {",
" Shiny.setInputValue('deletion', position + 1);",
" }",
" return true;",
"}"
)
dnd <- list(
always_copy = TRUE,
inside_pos = "last", # ADDED LAST POSITION
is_draggable = JS(
"function(node) {",
" return node[0].type === 'moveable';",
"}"
)
)
mytree <- jstree(
nodes, dragAndDrop = TRUE, dnd = dnd, checkCallback = checkCallback,
types = list(moveable = list(), target = list())
)
script <- '
$(document).ready(function(){
$("#mytree").on("copy_node.jstree", function(e, data){
var instance = data.new_instance;
var node = data.node;
var id = node.id;
var index = $("#"+id).index() + 1;
var text = index + ". " + node.text;
Shiny.setInputValue("choice", text);
instance.rename_node(node, text);
});
});
'
library(shiny)
ui <- fluidPage(
tags$head(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"]], {Choices(Choices()[-input[["deletion"]], , drop = FALSE])})
output[["choices"]] <- renderPrint({Choices()})
}
shinyApp(ui, server)
And now illustrations of the problem with the attempt to guide added elements to the last position:
To drop only into the last position: