CODEWITHSUNDEEP
rshiny
January
January

Reputation: 17110

Separate reactive element for table header and table body

In Shiny / R, I would like to update table body and table header independently. Consider this example:

library( shiny )
tt <- read.table( text="  id      blah       foo
1  1      adsf foo1
2  2      ioiu foo2
3  3 ioiuoiuer foo3", stringsAsFactors= F ) 

runApp( list( 
  ui= basicPage( 
    tags$table(
      uiOutput( "myheader" ),
      uiOutput( "mybody" )

    )

  ),

  server= function( input, output ) { 

    output$myheader <- renderUI({
      tags$thead(
        tags$tr( lapply( colnames( tt ), function( x ) tags$th( x ) ) )
      )

    })

    output$mybody <- renderUI({
      rows <- list()
      for( i in 1:nrow( tt ) ) {
        rows[[i]] <- tags$tr( lapply( tt[i,], function( x ) tags$td( x ) ) )
      }

      tags$tbody( rows )
    })
  } ) )

In theory, I am creating separately the body and header elements of the table. However, the way the shiny is rendering the page, both elements end up outside of the table:

enter image description here

Is it possible (and if yes, then how) to update the table header and body separately in Shiny?

Short explanation why I'm not using the default xtable or dataTable: I have a very large data frame in R, so I don't want to use dataTable. Filtering, searching, sorting and paging should all be done on the server side. However, as I want to have all these nice gimmicks, I need to re-implement data frame to HTML table conversion. I run into a problem with radio buttons in the table header -- when the table is redisplayed, the buttons are reset and trigger another event. The easiest solution (also, more elegant) would be to render the table body separately from the table head.

Upvotes: 0

Views: 502

Answers (1)

Vincent
Vincent

Reputation: 5249

I am not sure why this happens in your code. However, the code chunk below produces a table as you expect. Would this work for your application?

myheader <- reactive({
  tags$thead(
    tags$tr( lapply( colnames( tt ), function( x ) tags$th( x ) ) )
  )
})


mybody <- reactive({
  rows <- list()
  for( i in 1:nrow( tt ) ) {
    rows[[i]] <- tags$tr( lapply( tt[i,], function( x ) tags$td( x ) ) )
  }

  tags$tbody( rows )
})

output$mytable <- renderUI({
    tags$table(
      myheader(),
      mybody()
    )
})

Upvotes: 2

Related Questions