shinyTree: установить значение переменной, если флажок установлен.

Question

Последующие меры в отношении shinyTree: view without selecting.

library(shiny) 
library(shinyTree) 
server <- shinyServer(function(input, output, session) { 
    output$tree <- renderTree({ 
    sss=list( 'I lorem impsum'= list( 
     'I.1 lorem impsum' = structure(list('I.1.1 lorem impsum'='1', 'I.1.2 lorem impsum'='2'),stopened=TRUE), 
     'I.2 lorem impsum' = structure(list('I.2.1 lorem impsum'='3'), stopened=TRUE))) 
    attr(sss[[1]],"stopened")=TRUE 
    sss 
    }) 
}) 
ui <- shinyUI(
    shiny::fluidPage(
    h4('Shiny hierarchical checkbox') 
    ,shinyTree("tree", checkbox = TRUE) 
) 
) 
shinyApp(ui, server) 

Я хотел бы установить переменную таким образом, что если I.1.2. lorem impsum, то есть, например, значение 4.

Все, что я знаю, это то, что я должен использовать reactive(). Как вы можете видеть here, я научился делать это с помощью checkboxGroupInput s, но мне непонятно, можно ли это сделать даже в пределах shinyTree. Нет документации по этому вопросу, которую я могу найти в Интернете.

Как это можно сделать?

Я также видел функции here, но не знаю, как их использовать.

Answer 1

Как примечание, я действительно шокирован тем, насколько разрешена документация для этого пакета.

Функция get_selected() возвращает вектор, как видно из таблицы GitHub code. Я собираюсь использовать format = "slices".

Рассмотрим следующий код:

library(shiny) 
library(shinyTree) 
ui <- shinyUI(
    shiny::fluidPage(
    h4('Shiny hierarchical checkbox'), 
    shinyTree("tree", checkbox = TRUE), 
    # table of weights 
    fluidRow(column("", 
        tableOutput("Table"), width = 12, 
        align = "center")) 
) 
) 
server <- shinyServer(function(input, output, session) { 
    output$tree <- renderTree({ 
    sss=list( 'I lorem impsum'= list( 
     'I.1 lorem impsum' = structure(list('I.1.1 lorem impsum'='1', 'I.1.2 lorem impsum'='2'),stopened=TRUE), 
     'I.2 lorem impsum' = structure(list('I.2.1 lorem impsum'='3'), stopened=TRUE))) 
    attr(sss[[1]],"stopened")=TRUE 
    sss 
    }) 
    output$Table <- renderPrint({ 

    names(as.data.frame(get_selected(input$tree, format = "slices"))) 

    }) 
}) 
shinyApp(ui, server) 

После выбора I.1.2. Lorem impsum, следующий возвращается:

Это вектор длины 1 с именем столбца. Обратите внимание, что вместо пробелов используются точки.

Таким образом, если мы хотим установить переменную x равного 4 при выборе этой опции, мы должны увидеть, если I.1.2.lorem.impsum в приведенном выше names, а затем выполнить задание.

library(shiny) 
library(shinyTree) 
ui <- shinyUI(
    shiny::fluidPage(
    h4('Shiny hierarchical checkbox'), 
    shinyTree("tree", checkbox = TRUE), 
    fluidRow(column("", 
        tableOutput("Table"), width = 12, 
        align = "center")), 
    fluidRow(column("", 
        tableOutput("Table2"), width = 12, 
        align = "center")) 
) 
) 
server <- shinyServer(function(input, output, session) { 
    output$tree <- renderTree({ 
    sss=list( 'I lorem impsum'= list( 
     'I.1 lorem impsum' = structure(list('I.1.1 lorem impsum'='1', 'I.1.2 lorem impsum'='2'),stopened=TRUE), 
     'I.2 lorem impsum' = structure(list('I.2.1 lorem impsum'='3'), stopened=TRUE))) 
    attr(sss[[1]],"stopened")=TRUE 
    sss 
    }) 

    x <- reactive({ 
    if('I.1.2.lorem.impsum' %in% names(
     as.data.frame(
     get_selected(
      input$tree, format = "slices")))){ 

     x <- 4 

    } 
    }) 


    output$Table <- renderPrint({ 

    names(as.data.frame(get_selected(input$tree, format = "slices"))) 

    }) 

    output$Table2 <- renderTable({ 

    as.data.frame(x()) 

    }) 
}) 
shinyApp(ui, server) 

давая

по желанию.