R Shiny datatable group rows for legibility

Question

I have a dataframe of orders assigned to different people:

x<-data.frame(id = c("AAA", "AAA", "AAA", "BBB", "BBB", "CCC"), 
              name = c("Alice", "Alice", "Alice", "Bob", "Bob", "Charlie"),
              prod = c("T-Shirt", "Pants", "Socks", "Socks", "Pants", "T-Shirt"))

which I would like to display in a Shiny application. Here is a MRE:

library(shiny)
library(tidyverse)

runApp(list(

  ui = basicPage(
    dataTableOutput('mytable')
  ),

  server = function(input, output) {
    output$mytable = renderDataTable({
      x
    })
  }
))

Although this example displays the data exactly as expected given the data frame, I was wondering if it would be possible to change how the data are displayed to the end user (to aid legibility).

I would like the table to be grouped by id so that the first row of each id contains all information (across rows) before carriage-returning the products in the prod column. When the next unique id is reached, a new row would be created. I would like the output to look like this:

https://ibb.co/KhvgnbK

Answer 1

How about this:

library(shiny)
library(tidyverse)
library(knitr)
library(kableExtra)

runApp(list(

    ui = basicPage(
        tableOutput('mytable')
    ),

    server = function(input, output) {

        x <- data.frame(id = c("AAA", "AAA", "AAA", "BBB", "BBB", "CCC"), 
                      name = c("Alice", "Alice", "Alice", "Bob", "Bob", "Charlie"),
                      prod = c("T-Shirt", "Pants", "Socks", "Socks", "Pants", "T-Shirt"))

        output$mytable <- function() {
            x %>% 
            kable(align = "c", "html") %>%
                kable_styling(bootstrap_options = "striped", full_width = F, position = "left",font_size = 12)%>%
                column_spec(1, bold = T) %>%
                collapse_rows(columns = c(1,2), valign = "middle")
        }
    }
))

Alternatively, if you're comfortable with a bit of javascript and you like data.table better you can use datatables-rowsgroup.js, which is further discussed here

Answer 2

Not the most elegant but here:

library(shiny)
library(tidyverse)

runApp(list(

    ui = basicPage(
        dataTableOutput('mytable')
    ),

    server = function(input, output) {
        output$mytable = renderDataTable({
            for(i in nrow(x):2){
                if(x$id[i] == x$id[i-1])
                    x$id[i] <- ''
                if(x$name[i] == x$name[i-1])
                    x$name[i] <- ''
            }
            x
        })
    }
))

Update You could also use the DT package and then use the class parameter here:

library(shiny)
library(tidyverse)
library(DT)

runApp(list(

    ui = basicPage(
        dataTableOutput('mytable')
    ),

    server = function(input, output) {
        output$mytable = renderDataTable({
            for(i in nrow(x):2){
                if(x$id[i] == x$id[i-1])
                    x$id[i] <- ''
                if(x$name[i] == x$name[i-1])
                    x$name[i] <- ''
            }
            datatable(x, rownames = FALSE, class = "compact") # or use "hover"
        })
    }
))