如何使用jsTreeR向拖入层次结构节点的元素添加顺序编号？

Question

我正在评估允许用户构建一系列数学操作的层次结构的不同选项，并且正在尝试不同的包，如jsTreeR、shinyTree、shinyDND、sortable和最后手段(放弃对用户友好的可视化方法) rhandsontable。如相关文章如何使用shinyTree、jsTreeR或类似的包构建具有用户输入的拖放层次树？中所解释的

使用下面的可重复代码，我试图从“菜单”节点中将被拖动(或复制)到“拖动此处”节点的元素添加顺序编号。有什么办法吗？更好地解释在图片最下面的这篇文章。

在使用sortable和HTMLwidgets包运行类似的东西(拖放)时，我运行了下面的代码来成功地编号被拖动的元素，但不确定如何在jsTreeR中实现它

tags$head(
    tags$style(HTML('
      #dragTo {list-style-type: none;  counter-reset: css-counter 0;}
      #dragTo > div {counter-increment: css-counter 1;}
      #dragTo > div:before {content: counter(css-counter) ". ";}
      ')
    )
  ),

其中"dragTo“id是在一系列div() HTML函数中设置的：

div(
      div(
        class = ...,
        div(class = "panel-heading", "Drag to here"),
        div(
          class = "...",
          id = "dragTo"
        )
      )
    )

此jstreer问题的可复制代码：

library(jsTreeR)
library(shiny)

nodes <- list(
  list(
    text = "Menu",
    state = list(opened = TRUE),
    children = list(
      list(text = "Dog", type = "moveable", state = list(disabled = TRUE)),
      list(text = "Cat", type = "moveable", state = list(disabled = TRUE)),
      list(text = "Rat", type = "moveable", state = list(disabled = TRUE)),
      list(text = "Bat", type = "moveable", state = list(disabled = TRUE))
    )
  ),
  list(text = "Drag here:", type = "target", state = list(opened = TRUE))
)

checkCallback <- JS(
  "function(operation, node, parent, position, more) { console.log(node);",
  "  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
  "  }",
  "  return true;",      # allow everything else
  "}"
)
  
dnd <- list(
  always_copy = TRUE,
  is_draggable = JS(
    "function(node) {",
    "  return node[0].type === 'moveable';",
    "}"
  )
)

customMenu <- JS(
  "function customMenu(node) {",
  "  var tree = $('#mytree').jstree(true);", 
  "  var items = {",
  "    'delete' : {",
  "      'label'  : 'Delete',",
  "      'action' : function (obj) { tree.delete_node(node); },",
  "      'icon'   : 'glyphicon glyphicon-trash'",
  "     }",
  "  }",
  "  return items;",
  "}")

  
ui <- fluidPage(jstreeOutput("mytree"))  

server <- function(input, output){
  output[["mytree"]] <- renderJstree({
    jstree(
      nodes, 
      dragAndDrop = TRUE, 
      dnd = dnd, 
      checkCallback = checkCallback,
      types = list(moveable = list(), 
                   target = list()),
      contextMenu = list(items = customMenu),
    )
  })

}  

shinyApp(ui, server)

说明：

​

​

Answer 1

将此脚本添加到UI中：

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 text = node.text;
    var index = $("#"+id).index() + 1;
    instance.rename_node(node, index + ". " + text);
  })
});
'

即UI开头处的tags$head(tags$script(HTML(script)))。这是可行的，但您必须仔细定位最后一个位置；正如您所看到的，我在这里犯了一个错误：

​

​