1

So I need to create action buttons in R shiny based on the number of rows in dataframe, upon googling for the solution now able to create the action buttons dynamically but I was not able to label it according to the values in the data frame.

Here is my 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])))

    )
  })
})

When I execute the above scripts, It shows only one action button with the values as in the dataframe.

Expected output

Here in Server.R I am creating dataframe but in real time I will be fetching it through other calculation where the number of rows is not fixed which implies the number of action buttons are also not predefined, Number of action button will be equal to the number of rows in the data frame also, the label of action button should be same as the values in the data frame.

Learner
  • 118
  • 10

1 Answers1

1

You only get one action button out, because your apply loop only has one number in it. You take 1:ncol(mat) eventhough your data.frame has only one column.

I changed two things:

  1. I replaced buttons inside the lapply-function with 1:nrow(mat)
  2. I used mat[i,1] because your values are in the rows. If in your data the values you want on the action buttons are in one vector you can keep using [i]

The 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)
5th
  • 2,097
  • 3
  • 22
  • 41