shinyTree - fixing frozen inputs

server.R

#server.R
source('toTreeJSON.R')
library(shiny)
library(shinyTree)
library(magrittr)

createTree<- function(idTree){
    switch(idTree,
           "A" =   list(A1 = list(A2 = "a", A3 = "b"), A4 = "c"),
           "B" =   list(B1 = list(B2 = "d"), B3 = "e", B4 = "f"))}

shinyServer(function(input, output) {
    
    getIdSelected <- reactive({
        tree <- input$tree
        unlist(get_selected(tree))
    })
    
    output$idSelected <- renderText({ 
        getIdSelected()
    })
    
    output$tree <- renderTree(
        list(A1 = list(A2 = "a", A3 = "b"), A4 = "c")
    )
    
    # observer that updates the tree on input change.
    observe({
        jsInput = toTreeJSON(createTree(input$idTree))
        js$changeTree(jsInput)
        # 0.5 second gap is necessary due to asyncronous nature of javascript
        # i don't really know javascript so couldn't think of another solution
        # would appreciate a suggestion.
        delay(500,{
            js$open()
            js$deselect()
            })
    })
})

toTreeJSON.R

# this functions turns a list prepared for shinyTree package into a json string to be fed directly into treejs.
toTreeJSON = function(list){
    outString = '['
    for (i in 1:length(list)){
        outString %<>% paste0("{'text' : '",  names(list)[i], "'")
        attribs = attributes(list[[i]])
        
        stateAttribs = attribs[grepl('opened|disabled|selected',names(attribs))]
        children = attribs[grepl('names',names(attribs))]
        others = attribs[!grepl('opened|disabled|selected|names',names(attribs))]
        
        if (length(stateAttribs) >0){
            outString %<>% paste0(", 'state' : {")
            for (j in 1:length(stateAttribs)){
                outString %<>% paste0("'",gsub('st','',names(stateAttribs)[j]),"' : ", tolower(stateAttribs[j]))
                if (j < length(stateAttribs)){
                    outString %<>% paste0(",")
                }
            }
            outString %<>% paste('}')
        }
        
        if(length(others)>0){
            for (j in 1:length(others)){
                outString %<>% paste0( ", '",gsub('st','',names(others)[j]),"' : '", others[j],"'")
            }
        }
        
        if (class(list[[i]]) == 'list'){
            outString %<>% paste0(", 'children' : ",toTreeJSON(list[[i]]))
        }
        
        outString %<>% paste0("}")
        if (i < length(list)){
            outString %<>% paste0(",")
        }
        
    }
    outString %<>% paste0(']')
    
    return(outString)
    
}

ui.R

library(shinyTree)
library(shinyjs)
library(V8)
# javascript functions that handle updating.
# changeTree will change the nodes of the tree but it does not care about
# the state data provided with the json input. I use the next two functions to
# force all nodes to open and unselect them all. It should be possible to 
# deal with individual nodes but I didn't get into that.
javaScript = "shinyjs.changeTree = function(params){
    eval(\"$('#tree').jstree(true).settings.core.data=\"+params);
    $('#tree').jstree(true).refresh();
}

shinyjs.open = function(){
 $('#tree').jstree(true).open_all();
}

shinyjs.deselect = function(){
 $('#tree').jstree(true).deselect_all();
}"

shinyUI(
    fluidPage(
        useShinyjs(),
        # allows custom js functions to be called using shinyjs
        extendShinyjs(text = javaScript),
        sidebarLayout(
            sidebarPanel(
                selectInput("idTree",
                            label = "Select a tree",
                            choices = list("A" = "A",
                                           "B" = "B"),
                            selected = "A")
            ),
            mainPanel(
                shinyTree("tree"),
                h4("currently selected:"),
                textOutput("idSelected")
            )
        )
    )
)