Question

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

df.loc[df['g2'].notna(), 'g1'] = df['g2']

我的问题有两个：

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(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)标签中，我希望日期显示为Data，而不是十进制日期。鉴于yearmon的格式设置为gear$date，所以我不确定为什么会这样显示。知道如何解决这个问题吗？

2。数字格式

我尝试四舍五入yearmon，以便只显示1或两位数字，例如通过在我的quantity命令的各个位置使用formatRound(3, 2)，但是它不起作用...知道吗？另外，是否有一种方法可以将renderDataTable()列名称替换为所选的输入，即quantity或Number of fisheries，然后删除Catch (million t)列？

非常感谢您的帮助。期待您的想法：）

Answer 1

您的date可能存在的问题是yearmon不支持类DT（据我从文档获得的数据是数字）（但只是猜测），并显示为数字。为避免这种情况，您可以保留原始的date字符var并添加第二个助手date1进行绘制，并在呈现表格之前将其删除。顺便说一句：我仅在yearmon之后执行一次向rbind的转换。

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

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)

格式化闪亮表中的数字

1 个答案: