格式化闪亮表中的数字

Question

我正在构建一个应用程序来可视化一些数据，但很难获得我想要的格式的表格。到目前为止，这是我的代码：

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)

我的问题是双重的：

1.日期格式

在Data 选项卡中，我希望日期显示为yearmon，而不是十进制日期。鉴于gear$date 的格式为yearmon，我不确定它为什么会这样显示。知道如何解决这个问题吗？

2。数字格式

我尝试对quantity 进行四舍五入，以便只出现 1 或 2 位数字，例如通过在我的renderDataTable() 命令的各个位置使用formatRound(3, 2)，但它不起作用......知道吗？此外，有没有办法用选定的输入替换quantity 列名，即Number of fisheries 或Catch (million t)，然后删除unit 列？

非常感谢您的帮助。期待你的想法:)

Answer 1

1. date 的问题可能是 DT 不支持 yearmon 类（据我从文档中得到的是数字）（但只是猜测）并显示为数字.为了防止这种情况，您可以保留原始的 date 字符 var 并添加第二个助手 date1 用于绘图，并且在呈现表格之前将其删除。顺便说一句：在rbind 之后，我只转换为yearmon 一次。

2. 第二个问题比较棘手，但可以这样解决：

   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)
     })
   

这里是完整的可重现代码供参考：

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)