How to run R code from inside a JS section of code?

Question

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)

Answer 1

Starting with a portion of your script (just for demonstration, you use the full thing):

script <- '
var Visited = {};
function getSuffix(orgid){
  if (Object.keys(Visited).indexOf(orgid) === -1){Visited[orgid] = 0;}
  else{Visited[orgid]++;}
  return LETTERS[Visited[orgid]];
}'

We can do this:

script <- paste("var LETTERS =", jsonlite::toJSON(c(LETTERS, sapply(LETTERS, function(x) paste0(x, LETTERS)))), ";", script)

Which gives us:

cat(script, "\n")
var LETTERS = ["A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","AA","AB","AC","AD","AE","AF","AG","AH","AI","AJ","AK","AL","AM","AN","AO","AP","AQ","AR","AS","AT","AU","AV","AW","AX","AY","AZ","BA","BB","BC","BD","BE","BF","BG","BH","BI","BJ","BK","BL","BM","BN","BO","BP","BQ","BR","BS","BT","BU","BV","BW","BX","BY","BZ","CA","CB","CC","CD","CE","CF","CG","CH","CI","CJ","CK","CL","CM","CN","CO","CP","CQ","CR","CS","CT","CU","CV","CW","CX","CY","CZ","DA","DB","DC","DD","DE","DF","DG","DH","DI","DJ","DK","DL","DM","DN","DO","DP","DQ","DR","DS","DT","DU","DV","DW","DX","DY","DZ","EA","EB","EC","ED","EE","EF","EG","EH","EI","EJ","EK","EL","EM","EN","EO","EP","EQ","ER","ES","ET","EU","EV","EW","EX","EY","EZ","FA","FB","FC","FD","FE","FF","FG","FH","FI","FJ","FK","FL","FM","FN","FO","FP","FQ","FR","FS","FT","FU","FV","FW","FX","FY","FZ","GA","GB","GC","GD","GE","GF","GG","GH","GI","GJ","GK","GL","GM","GN","GO","GP","GQ","GR","GS","GT","GU","GV","GW","GX","GY","GZ","HA","HB","HC","HD","HE","HF","HG","HH","HI","HJ","HK","HL","HM","HN","HO","HP","HQ","HR","HS","HT","HU","HV","HW","HX","HY","HZ","IA","IB","IC","ID","IE","IF","IG","IH","II","IJ","IK","IL","IM","IN","IO","IP","IQ","IR","IS","IT","IU","IV","IW","IX","IY","IZ","JA","JB","JC","JD","JE","JF","JG","JH","JI","JJ","JK","JL","JM","JN","JO","JP","JQ","JR","JS","JT","JU","JV","JW","JX","JY","JZ","KA","KB","KC","KD","KE","KF","KG","KH","KI","KJ","KK","KL","KM","KN","KO","KP","KQ","KR","KS","KT","KU","KV","KW","KX","KY","KZ","LA","LB","LC","LD","LE","LF","LG","LH","LI","LJ","LK","LL","LM","LN","LO","LP","LQ","LR","LS","LT","LU","LV","LW","LX","LY","LZ","MA","MB","MC","MD","ME","MF","MG","MH","MI","MJ","MK","ML","MM","MN","MO","MP","MQ","MR","MS","MT","MU","MV","MW","MX","MY","MZ","NA","NB","NC","ND","NE","NF","NG","NH","NI","NJ","NK","NL","NM","NN","NO","NP","NQ","NR","NS","NT","NU","NV","NW","NX","NY","NZ","OA","OB","OC","OD","OE","OF","OG","OH","OI","OJ","OK","OL","OM","ON","OO","OP","OQ","OR","OS","OT","OU","OV","OW","OX","OY","OZ","PA","PB","PC","PD","PE","PF","PG","PH","PI","PJ","PK","PL","PM","PN","PO","PP","PQ","PR","PS","PT","PU","PV","PW","PX","PY","PZ","QA","QB","QC","QD","QE","QF","QG","QH","QI","QJ","QK","QL","QM","QN","QO","QP","QQ","QR","QS","QT","QU","QV","QW","QX","QY","QZ","RA","RB","RC","RD","RE","RF","RG","RH","RI","RJ","RK","RL","RM","RN","RO","RP","RQ","RR","RS","RT","RU","RV","RW","RX","RY","RZ","SA","SB","SC","SD","SE","SF","SG","SH","SI","SJ","SK","SL","SM","SN","SO","SP","SQ","SR","SS","ST","SU","SV","SW","SX","SY","SZ","TA","TB","TC","TD","TE","TF","TG","TH","TI","TJ","TK","TL","TM","TN","TO","TP","TQ","TR","TS","TT","TU","TV","TW","TX","TY","TZ","UA","UB","UC","UD","UE","UF","UG","UH","UI","UJ","UK","UL","UM","UN","UO","UP","UQ","UR","US","UT","UU","UV","UW","UX","UY","UZ","VA","VB","VC","VD","VE","VF","VG","VH","VI","VJ","VK","VL","VM","VN","VO","VP","VQ","VR","VS","VT","VU","VV","VW","VX","VY","VZ","WA","WB","WC","WD","WE","WF","WG","WH","WI","WJ","WK","WL","WM","WN","WO","WP","WQ","WR","WS","WT","WU","WV","WW","WX","WY","WZ","XA","XB","XC","XD","XE","XF","XG","XH","XI","XJ","XK","XL","XM","XN","XO","XP","XQ","XR","XS","XT","XU","XV","XW","XX","XY","XZ","YA","YB","YC","YD","YE","YF","YG","YH","YI","YJ","YK","YL","YM","YN","YO","YP","YQ","YR","YS","YT","YU","YV","YW","YX","YY","YZ","ZA","ZB","ZC","ZD","ZE","ZF","ZG","ZH","ZI","ZJ","ZK","ZL","ZM","ZN","ZO","ZP","ZQ","ZR","ZS","ZT","ZU","ZV","ZW","ZX","ZY","ZZ"] ;
var Visited = {};
function getSuffix(orgid){
  if (Object.keys(Visited).indexOf(orgid) === -1){Visited[orgid] = 0;}
  else{Visited[orgid]++;}
  return LETTERS[Visited[orgid]];
}