R Динамическое меню Shinydashboard

Я пытаюсь создать несколько menuItem динамически, это может быть просто, но я не понимаю.

library(shiny)
library(shinydashboard)
port_tables<-c("tab1","tab2","tab3","tab4") # These are from a DB connection in the original code
function(input, output) {
    output$smenu1 <- renderMenu({
      sidebarMenu( id = "tabs",
          h4("Tables",style="color:yellow;margin-left:20px;"),
          paste("menuItem(\"",port_tables,"\",tabName=\"",port_tables,"\",icon=icon('th'))",collapse=",")
        )
     })
  )

Элементы меню из функции paste не разрешаются (я получаю результат функции вставки на боковой панели). Я пробовал eval, eval(parse(paste(...))), оба не работали - что мне не хватает?


r shinydashboard
person Sri    schedule 23.09.2015    source источник
comment
Я только что протестировал следующее, и это привело к сбою моего сеанса R-studio: text1<-paste("menuItem(\"",port_tables,"\",tabName=\"",port_tables,"\",icon=icon('th'))") и sapply(text1,function(x)eval(parse(text=x)))   -  person Sri    schedule 23.09.2015

Ответы (2)


arrow_upward
5
arrow_downward

Я не мог понять, о чем вы просите, но вот пример чего-то с динамическим меню.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic Menu"),
  dashboardSidebar(
    sidebarMenuOutput(outputId = "dy_menu")
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "main",
              textInput(inputId = "new_menu_name", 
                        label = "New Menu Name"),
              actionButton(inputId = "add",
                           label = "Add Menu")
      )
    )
  )
)

server <- function(input, output, session){

  output$dy_menu <- renderMenu({
    menu_list <- list(
      menuItem("Add Menu Items", tabName = "main", selected = TRUE),
      menu_vals$menu_list)
    sidebarMenu(.list = menu_list)
  })

  menu_vals = reactiveValues(menu_list = NULL)
  observeEvent(eventExpr = input$add,
               handlerExpr = {
                 menu_vals$menu_list[[length(menu_vals$menu_list) + 1]] <- menuItem(input$new_menu_name,
                                                                                    tabName = input$new_menu_name) 
               })

}

shinyApp(ui, server)
person Sam Helmich    schedule 01.12.2015

arrow_upward
1
arrow_downward

Я изменил код следующим образом, и он сработал:

library(shiny)
library(shinydashboard)
port_tables<-c("tab1","tab2","tab3","tab4") # These are from a DB connection in the original code
text1<-paste("menuItem(\"",port_tables,"\",tabName=\"",port_tables,"\",icon=icon('th'))")
text2<-paste("sidebarMenu(id = 'tabs',textInput('port', 'Enter port:'),h4('Tables',style='color:yellow;margin-left:20px;'),",paste(text1,collapse=","),paste(")"))
function(input, output) {
output$smenu1 <- renderMenu({
eval(parse(text=text2))
 })
)

Итак, ключ помещает все содержимое sidebarMenu в текстовое поле и оценивает его

person Sri    schedule 25.09.2015