Deploying dataTableOutput in shiny in R; improving layout of table contents

Question

I have a dataTableOutput within my shiny app and I am trying to improve the layout of the contents within it. I will demonstrate what it looks like and then describe what I am aiming for:-

Data

#relevant libraries
library(wakefield)#for generating the Status variable
library(dplyr)
library(stringi)
library(Pareto)
library(uuid)
library(ggplot2)
library(data.table)
library(shiny)
library(DT)


#mock data creation
set.seed(1)
#data<-data.frame()
Date<-seq(as.Date("2015-01-01"), as.Date("2015-12-31"), by = "1 day")
Date<-sample(rep(Date,each=10),replace = T)

event<-r_sample_factor(x = c("Wrestling", "Drama", 
                                    "Information", "Football", "Rugby", "Movie", "Music", "News"), n=length(Date))

channel<-r_sample_factor(x = c("Channel 1", "Channel 2", "Channel 3", "Channel 4"), n=length(Date))

Hour<-r_sample_factor(x = c(0:23), n=length(Date))

Group<-r_sample_factor(x = c("A","B","C","D","E"), n=length(Date))

#creating user ID

set.seed(1)

n_users <- 100
n_rows <- 3650

relative_probs <- rPareto(n = n_users, t = 1, alpha = 0.3, truncation = 500) 
unique_ids <- UUIDgenerate(n = n_users)

AnonID <- sample(unique_ids, size = n_rows, prob = relative_probs, replace = TRUE)


data<-data.frame(AnonID,Group,Date,Hour,channel,event)
data$Hour<-as.numeric(data$Hour)
head(data)

Shiny app


#ui================================
ui<-fluidPage(
  titlePanel("Example panel"),
  tabsetPanel(
    tabPanel("example text",
             sidebarPanel(width = 4,
                          dateRangeInput("daterange","Select dates", format = "yyyy-mm-dd",
                                         start = min("2015-01-01"),
                                         end = max("2015-01-10")),
                          numericInput("hourmin", "Select mininum hour",10,0,23),
                          numericInput("hourmax", "Select maximum hour", 22,0,23),
                          pickerInput("channel", "Select channel",
                                      choices = unique(channel), options = list('actions-box'=T,'live-search'=T),multiple = T)),#end of sidebarPanel
             mainPanel(
               column(width = 10, plotOutput("barplot", width = "100%")),
                      column(width = 8, dataTableOutput("table"))
             )#end of mainPanel
                          
             )
             )#end of tabPanel
  )#end of tabsetPanel
)#end of fluidPage


#server===========================================

server<-function(input,output,session){

  
 rv <- reactiveVal(NULL)  
  
  observe({
    
    rv(data)
  
    output$table<-renderDT({
      rv()%>%
        arrange(desc(Date))%>%
        filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
        filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
        filter(channel %in% input$channel)%>%  
        group_by(channel,Date)%>%
        arrange(Date)%>%
        summarise(Programme=paste0(Hour,":",substr(event,1,3)), .groups = 'drop')%>%
        #mutate(rn=rowid(Date))%>%
        pivot_wider(names_from = Date,values_from = Programme) # %>%
        #select(-rn)
    })
    
    output$barplot<-renderPlot({
      
      rv()%>%
        filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
        filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
        filter(channel %in% input$channel)%>%
        group_by(Date,Group)%>%
        summarise(UniqueID=n_distinct(AnonID))%>%
        ggplot()+
        geom_bar(aes(x=Date,y=UniqueID, fill=Group), stat = "identity", position = "dodge")
        
      
    })
    
    })#end of observe
  }

shinyApp(ui,server)

Which will give you this:-

My desired output would be to have the lines within each cell of the table to be stacked on top of each other like bullet points. So instead of looking like this:-

#current look

channel  | 2015-01-01    | 2015-01-02   |...|....
------------------------------------------
Channel 1| 10:Mus,12:Dra |21:New,18:Foo |
------------------------------------------
Channel 2|               |12:New,20:Inf |  
------------------------------------------
Channel 3|20:Rug         |21:New        |
------------------------------------------
Channel 4|               |22:Inf,11:New,13:Rug

I would like it to look more like this:-

#desired look

channel  | 2015-01-01    | 2015-01-02   |...|....
------------------------------------------
Channel 1|10:Mus         |21:New
         |12:Dra         |18:Foo
------------------------------------------
Channel 2|               |12:New
         |               |20:Inf
---------------------------------------------
...
...

Can anyone advise on how I could get the output in my data table cells to look like that?

Thanks!

Deploying dataTableOutput in shiny in R; improving layout of table contents

Answers (1)

Related Questions