从数据框

Question

所以我需要根据dataframe中的行数在R闪亮中创建动作按钮，在谷歌上搜索现在能够动态创建动作按钮的解决方案但是我无法根据数据框中的值。

这是我的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)