Динамически называйте кнопки действий в R блестящими из значений в фрейме данных

Question

Так что мне нужно создать кнопки действий в R блестящие на основе количества строк в dataframe, после поиска в Google решения теперь можно динамически создавать кнопки действий, но я не смог пометить их в соответствии со значениями вфрейм данных.

Вот мой UI.R

library(shiny)
library(shinydashboard) 
library(DT)
shinyUI(
  dashboardPage(
    dashboardHeader(title = div(img(src="new.png", height = 40, width = 200),"IPT dashboard",width = 300)),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
        menuItem("Vehicle Data", tabName = "VehicleData", icon = icon("table")),
        menuItem("Driver Behaviour", tabName = "DriverBehaviour", icon = icon("th")),
        menuItem("Vehicle Information", tabName = "Vehicleinfo", icon = icon("th")),
        menuItem("Crash Report", tabName = "crashreport", icon = icon("th")),
        menuItem("Emission Report", tabName = "Emissionreport", icon = icon("th")),
        menuItem("Fuel Economy", tabName = "FuelEconomy", icon = icon("th")),
        menuItem("View Location", tabName = "viewloc", icon = icon("th")),
        menuItem("detctest", tabName = "dtctest", icon = icon("th"))

      ),
      width = "200px"
    ),
    dashboardBody(
      tabItems(
        tabItem("dashboard",
                tabsetPanel(
                  tabPanel( title = "Real Time",
                            br(),
                            fluidRow(
                              box(
                                tags$head(
                                  tags$style(HTML("
                                                  .box { overflow-y: auto; }
                                                  " )
                                  )
                                  ),

                                height = "300px",
                                width =2,
                                h3("Trouble Code(s)", align="left"),
                                 column(1, uiOutput("go_buttons"))


                                  )
  )#tabitemsclose
  )#dashbodyclose
)#pageclose
)#uiclose

Server.R

library(shiny)
library(DT)

shinyServer(function(input,output)
{
  options(digits = 22)
output$go_buttons  <- renderUI({
  mat <- as.data.frame(c("P01","p02","p03"))

  buttons <- as.list(1:ncol(mat))
  buttons <- lapply(buttons, function(i)
  {
    btName <- paste0(mat[i])
    fluidRow(
      br(),
      column(2,actionButton(btName,paste(mat[i])))

    )
  })
})

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

Expected output

Здесь, в Server.R я создаю фрейм данных, но в реальном времени я буду извлекать его с помощью другого вычисления, где число строк не фиксировано, что подразумевает количество действийкнопки также не предопределены, Количество кнопок действия будет равно количеству строк во фрейме данных, метка кнопки действия должна совпадать со значениями в фрейме данных.

Answer 1

Вы получаете только одну кнопку действия, потому что в вашем цикле применения есть только один номер.Вы берете 1:ncol(mat) даже если ваш data.frame имеет только один столбец.

Я изменил две вещи:

1. Я заменил buttons внутри lapply -функции на 1:nrow(mat)
2. Я использовал mat[i,1], потому что ваши значения в строках.Если в ваших данных нужные вам значения для кнопок действий находятся в одном векторе, вы можете продолжать использовать [i]

app.r:

library(shiny)
library(shinydashboard) 
library(DT)

### ui.r
ui <- shinyUI(dashboardPage(
    dashboardHeader(title = div(img(src="new.png", height = 40, width = 200),"IPT dashboard",width = 300)),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
        menuItem("Vehicle Data", tabName = "VehicleData", icon = icon("table")),
        menuItem("Driver Behaviour", tabName = "DriverBehaviour", icon = icon("th")),
        menuItem("Vehicle Information", tabName = "Vehicleinfo", icon = icon("th")),
        menuItem("Crash Report", tabName = "crashreport", icon = icon("th")),
        menuItem("Emission Report", tabName = "Emissionreport", icon = icon("th")),
        menuItem("Fuel Economy", tabName = "FuelEconomy", icon = icon("th")),
        menuItem("View Location", tabName = "viewloc", icon = icon("th")),
        menuItem("detctest", tabName = "dtctest", icon = icon("th"))

      ),
      width = "200px"
    ),
    dashboardBody(tabItems(
        tabItem("dashboard",
                tabsetPanel(
                  tabPanel( title = "Real Time",
                            br(),
                            fluidRow(
                              box(
                                tags$head(
                                  tags$style(HTML("
                                                  .box { overflow-y: auto; }
                                                  " )
                                  )
                                  ),

                                height = "300px",
                                width =2,
                                h3("Trouble Code(s)", align="left"),
                                column(1, uiOutput("go_buttons"))


                                  )))))
                              ) #tabitemsclose
                  )#dashbodyclose
                )#pageclose
        ) #uiclose

### server.r
server <- function(input, output, session){ 
  options(digits = 22)
  output$go_buttons  <- renderUI({
    mat <- as.data.frame(c("P01","p02","p03"),stringsAsFactors = FALSE)

    buttons <- lapply(1:nrow(mat), function(i)
    {
      btName <- paste0(mat[i,1])
      fluidRow(
        br(),
        column(2,actionButton(btName,paste(mat[i,1])))
      )
    })
    return(buttons)
  }) 
}

shinyApp(ui, server)