Format numbers in Shiny table

Question

I'm building an app to visualize some data, but struggle to obtain a table in the format I want. Here is my code so far:

library(shiny)
library (RCurl)
library(zoo)
library(ggplot2)
library(DT)
library(shinythemes)
library(tidyverse)

Sys.setlocale("LC_TIME", "C")

gear_volume <- read.csv("https://data.mendeley.com/datasets/gpynbmn7f9/1/files/63b5c005-ff83-4dfc-bf4b-87e353b5310d/gear_volume.csv?dl=1", sep = "\t") %>%
  mutate(date = as.yearmon(paste(date),"%b %Y"),
         volume = as.numeric(volume)/10^6,
         variable = "Gear",
         unit = "Catch (million t)") %>%
  rename(quantity = volume)

gear_number <- read.csv("https://data.mendeley.com/datasets/gpynbmn7f9/1/files/789a7b5d-4ade-4913-a1c6-2f33136d33c0/gear_number.csv?dl=1", sep = "\t") %>%
  mutate(date = as.yearmon(paste(date),"%b %Y"),
         count = as.numeric(count),
         variable = "Gear",
         unit = "Number of fisheries") %>%
  rename(quantity = count)

gear <- gear <- rbind(gear_volume, gear_number) %>%
  mutate(date = as.yearmon(paste(date),"%b %Y"))

rm(gear_volume, gear_number)

colors <- c("#B8B9BC", "#0A1D27", "#034149", "#06907B")

##Create plot theme
plot_theme <- theme(legend.position = "none",
                    legend.title = element_blank(),
                    axis.line.x =  element_line(color = "black", size = 0.25),
                    axis.line.y = element_line(color = "black", size = 0.25),
                    axis.ticks = element_line(color = "black", size = 0.25),
                    panel.grid.major = element_blank(),
                    panel.grid.minor = element_blank(),
                    panel.border = element_blank(),
                    panel.background = element_blank(),
                    axis.title.x = element_blank(),
                    axis.text.x = element_text(family = "Arial",size = 11, colour = "black"),
                    axis.title.y = element_text(family = "Arial",size = 12, face = "bold", colour = "black"),
                    axis.text.y = element_text(family = "Arial",size = 11, colour = "black"),
                    plot.margin = unit(c(2,2,2,4),"mm"))

# Define UI for application that draws a stacked area chart + table
ui <- fluidPage(theme = shinytheme("simplex"),
   
   # Application title
   titlePanel("What does the Marine Stewardship Council (MSC) ecolabel certify?"),
   
   # Sidebar with a slider input for number of bins 
   fluidRow(
     column(4,
            selectInput("fishery_unit", label = h4("Display data as:"), 
                        unique(as.character(gear$unit)))
     ),
     column(4,
            sliderInput("date", label = h4("Select time range:"),
                        2000, 2018, value = c(2000, 2018), step = 1, sep = "")
     )
   ),
   # Create a new row for the table.
   tabsetPanel(
     tabPanel("Graphical view", plotOutput("distPlot")),
     tabPanel("Data", dataTableOutput("distTable")))
)

# Define server logic required to draw a stacked area chart
server <- function(input, output) {
  dataInput <- reactive({
    gear[gear$unit==input$fishery_unit,]
  })
  output$distPlot <- renderPlot({
     ggplot(dataInput(), aes(x = date, y = quantity, fill = gear)) +
       geom_area(position = "stack") +
       xlab("") + ylab("Allocation by gear") +
       scale_fill_manual(values = colors) +
       plot_theme +
       scale_x_continuous(limits = input$date, expand = c(0, 0)) +
       scale_y_continuous(expand = c(0, 0))
   })
  output$distTable <- renderDataTable({
    dataInput()
  },
  extensions = "Buttons",
  options = list(
    scrollY = "300px", pageLength = 10, scrollX = TRUE, dom = "Bftsp",
    buttons = c("copy", "csv", "excel"))
  )
}
                                    
                                    
# Run the application 
shinyApp(ui = ui, server = server)

My problem is twofold:

1. Date format

In the Data tab, I'd like the date to be displayed as yearmoninstead of decimal date. I'm not sure why it shows up as that, given that gear$date is formatted as yearmon. Any idea how to solve this?

2. Number format

I've tried to round quantity, so that only 1 or two digits appear, e.g. by using formatRound(3, 2) in various places of my renderDataTable() command, but it did not work... Any idea? Additionally, is there a way to replace the quantity column name by the selected input, i.e. Number of fisheries or Catch (million t) and then remove the unit column?

Thank you so much for you help. Looking forward to you ideas :)

Answer 1

1. The issue with your date is probably that class yearmon (which as far as I got it from the docs is a numeric) is not supported by DT (but just guessing) and shows up as a numeric. To prevent this you can keep the original date character var and add a second helper date1 for plotting and which gets dropped before rendering the table. BTW: I do the conversion to yearmon only once after the rbind.

2. The second issue(s) are more tricky but can be solved like so:

   output$distTable <- renderDataTable({
       dataInput() %>% 
         # Rename 'quantity' to 'input$fishery_unit' using tidy evaluation
         rename(!!sym(input$fishery_unit) := quantity) %>% 
         # Drop 'unit' and helper 'date1' columns
         select(-unit, -date1) %>% 
         # Convert to DT::datatable
         DT::datatable(extensions = "Buttons",
                       options = list(
                         scrollY = "300px", pageLength = 10, scrollX = TRUE, dom = "Bftsp",
                         buttons = c("copy", "csv", "excel")
                       )) %>% 
         # Format the former quantity column, which we renamed to input$fishery_unit
         formatRound(input$fishery_unit, 1)
     })
   

For reference here is the full reproducible code:

library(shiny)
library (RCurl)
library(zoo)
library(ggplot2)
library(DT)
library(shinythemes)
library(tidyverse)

Sys.setlocale("LC_TIME", "C")

gear_volume <- read.csv("https://data.mendeley.com/datasets/gpynbmn7f9/1/files/63b5c005-ff83-4dfc-bf4b-87e353b5310d/gear_volume.csv?dl=1", sep = "\t") %>%
  mutate(volume = as.numeric(volume)/10^6,
         variable = "Gear",
         unit = "Catch (million t)") %>%
  rename(quantity = volume)

gear_number <- read.csv("https://data.mendeley.com/datasets/gpynbmn7f9/1/files/789a7b5d-4ade-4913-a1c6-2f33136d33c0/gear_number.csv?dl=1", sep = "\t") %>%
  mutate(count = as.numeric(count),
         variable = "Gear",
         unit = "Number of fisheries") %>%
  rename(quantity = count)

gear <- gear <- rbind(gear_volume, gear_number) %>%  
  # Add helper "date1" 
  mutate(date1 = as.yearmon(paste(date),"%b %Y"))

rm(gear_volume, gear_number)

colors <- c("#B8B9BC", "#0A1D27", "#034149", "#06907B")

##Create plot theme
plot_theme <- theme(legend.position = "none",
                    legend.title = element_blank(),
                    axis.line.x =  element_line(color = "black", size = 0.25),
                    axis.line.y = element_line(color = "black", size = 0.25),
                    axis.ticks = element_line(color = "black", size = 0.25),
                    panel.grid.major = element_blank(),
                    panel.grid.minor = element_blank(),
                    panel.border = element_blank(),
                    panel.background = element_blank(),
                    axis.title.x = element_blank(),
                    axis.text.x = element_text(family = "Arial",size = 11, colour = "black"),
                    axis.title.y = element_text(family = "Arial",size = 12, face = "bold", colour = "black"),
                    axis.text.y = element_text(family = "Arial",size = 11, colour = "black"),
                    plot.margin = unit(c(2,2,2,4),"mm"))

# Define UI for application that draws a stacked area chart + table
ui <- fluidPage(theme = shinytheme("simplex"),
                
                # Application title
                titlePanel("What does the Marine Stewardship Council (MSC) ecolabel certify?"),
                
                # Sidebar with a slider input for number of bins 
                fluidRow(
                  column(4,
                         selectInput("fishery_unit", label = h4("Display data as:"), 
                                     unique(as.character(gear$unit)))
                  ),
                  column(4,
                         sliderInput("date", label = h4("Select time range:"),
                                     2000, 2018, value = c(2000, 2018), step = 1, sep = "")
                  )
                ),
                # Create a new row for the table.
                tabsetPanel(
                  tabPanel("Graphical view", plotOutput("distPlot")),
                  tabPanel("Data", dataTableOutput("distTable")))
)

# Define server logic required to draw a stacked area chart
server <- function(input, output) {
  dataInput <- reactive({
    gear[gear$unit==input$fishery_unit,]
  })
  output$distPlot <- renderPlot({
    # Use "date1" for plotting
    ggplot(dataInput(), aes(x = date1, y = quantity, fill = gear)) +
      geom_area(position = "stack") +
      xlab("") + ylab("Allocation by gear") +
      scale_fill_manual(values = colors) +
      plot_theme +
      scale_x_continuous(limits = input$date, expand = c(0, 0)) +
      scale_y_continuous(expand = c(0, 0))
  })
  output$distTable <- renderDataTable({
    dataInput() %>% 
      rename(!!sym(input$fishery_unit) := quantity) %>% 
      select(-unit, -date1) %>% 
      DT::datatable(extensions = "Buttons",
                    options = list(
                      scrollY = "300px", pageLength = 10, scrollX = TRUE, dom = "Bftsp",
                      buttons = c("copy", "csv", "excel")
                    )) %>% 
      formatRound(input$fishery_unit, 1)
  })
}

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