Shiny - populate static HTML table with filtered data based on input

Question

I am currently working on a Shiny app which displays a static HTML table, sourced from another file, because of the size of the HTML code. The table is initialized with an empty data table in order to render the empty table. Above the HTML table are normal selectizeInput fields which filter a data table in the background (via a observe() function). The HTML table should then be populated with the filtered data table.

I am stuck at the process of updating the HTML table with the "new" data table. I tried sourcing the table again in the observe() - no change. I initialized the data table as reactiveValue and wrapped the HTML table with the reactive()-Function - again no change.

Here is a toy example which somewhat resembles my Shiny app:

app.R

library(shiny)

ui <- fluidPage(

 fluidRow(
    column(width = 6, uiOutput("cars"))
  ),
  fluidRow(
    column(width = 6, htmlOutput("html.table"))
  )
)

server <- function(input, output) {
  
  filtered_cars <- data.frame(matrix("NA", nrow = 1, ncol = 4, dimnames = list("NA", c("mpg","cyl","disp","hp"))))
  
  source("server_html_table.R",  local = TRUE)
   
  output$cars <- renderUI({
    selectizeInput(
      inputId = "cars",
      label = NULL,
      choices = rownames(mtcars),
      options = list(placeholder = 'Cars')
    )
  })
  
  output$html.table <- renderUI({
    html.table
  })
  
  observeEvent(input$cars, {
    filtered_cars <- subset(mtcars, rownames(mtcars) %in% input$cars)
    #some kind of update for the html table missing
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

server_html_table.R

html.table <- tags$table(style = "border: 1px solid black; padding: 1%; width: 100%;",
                    tags$tr(
                            tags$th("Car Name"),
                            tags$th("MPG"),
                            tags$th("CYL"),
                            tags$th("DISP"),
                            tags$th("HP")

                    ),
                    tags$tr(
                            tags$td(rownames(filtered_cars)),
                            tags$td(filtered_cars$mpg),
                            tags$td(filtered_cars$cyl),
                            tags$td(filtered_cars$disp),
                            tags$td(filtered_cars$hp)
                   )
            )

As you can see, the table cells do not update. I am aware that there is some kind of update function missing in the observeEvent (like updateSelectizeInput()), but I cannot figure out a way to code it on my own.

I am grateful for any form of ideas or tips!

EDIT #1: Maybe to make the point about the HTML table clearer - I am displaying a Profit and Loss table in my app which needs to be build manually via HTML. Hence, I cannot use the usual dataTableOutput() and renderDataTable() functions. As the table relies heavily on CSS, the usage of basic HTML is much easier than the htmlTable package.

score 4 · Accepted Answer · answered May 17 '17 at 11:35

I found a solution to my problem!

The static html table is wraped in a function, which will be sourced once on startup in the server part of the app and then called in the renderUI() function. The render-function will be triggered every time a user changes the menu. Here I filter the dataframe regarding to the input and pass it to the "build_table" function. Each cell of the table is then populated with the needed values from the dataframe via indexes. The function return the full html table back to the renderUI().

This is the toy example from above, adjusted to the working solution:

app.R

library(shiny)

ui <- fluidPage(

  fluidRow(
           column(width = 6, uiOutput("cars"))
  ),
  fluidRow(
    column(width = 6, htmlOutput("html.table"))
  )
)

server <- function(input, output) {

  source("server_html_table.R",  local = TRUE)

  output$cars <- renderUI({
    selectizeInput(
      inputId = "cars",
      label = NULL,
      choices = rownames(mtcars),
      options = list(placeholder = 'Cars')
    )
  })

  output$html.table <- renderUI({

    input$cars

    isolate({

      filtered_cars <- subset(mtcars, rownames(mtcars) %in% input$cars)

      build_table(filtered_cars)
    })
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

server_html_table.R

build_table <- function(data){

  html.table <- tags$table(style = "border: 1px solid black; padding: 1%; width: 100%;",
                          tags$tr(
                                  tags$th("Car Name"),
                                  tags$th("MPG"),
                                  tags$th("CYL"),
                                  tags$th("DISP"),
                                  tags$th("HP")

                          ),
                          tags$tr(
                                  tags$td(rownames(data)),
                                  tags$td(data$mpg),
                                  tags$td(data$cyl),
                                  tags$td(data$disp),
                                  tags$td(data$hp)
                         )
                  )

  return(html.table)
}

Shiny - populate static HTML table with filtered data based on input

1 Answers1

Linked