如何清理渲染分层table的显示输出?

How to clean up the displayed output of a rendered stratification table?

下面的示例代码生成原始数据的分层 table,用户可以借此指定 table 的分组范围。在 post .

中查看更完整的灵活分层示例 table

我正在尝试将呈现的 table 中的范围输出格式化为我行业中使用的标准([ ### - ### ]。如何修改代码以便范围是这样显示的吗?请参阅底部的图片,更好地解释我正在尝试做的事情。

我可能需要将数字分隔符从“-”更改为 <> 或反映相等性的等效项,如下图所示。

示例代码如下:

library(dplyr)
library(shiny)
library(tidyverse)

ui <-  fluidPage(
  fluidRow(
    column(6,), 
    column(6, uiOutput("time"), 
              numericInput(label = "Stratification ranges:", 'strat_gap','',value=5,step=1,width = '100%')), 
  ),
  fluidRow(
    column(6, h5(strong("Raw data:")),
              tableOutput("data")), 
    column(6, h5(strong("Stratified data:")),
              tableOutput("strat_data"))
  )
)

server <- function(input, output, session) {
  data <- 
      data.frame(
        ID = c(1,1,2,2,2,2,3,3,3),
        Period_1 = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-02", "2020-03", "2020-04"),
        Period_2 = c(1, 2, 1, 2, 3, 4, 1, 2, 3),
        Category = c("Toad", "Toad", "Stool", "Stool", "Stool", "Stool","Toad","Toad","Toad"),
        Values = c(-5, 25, 35, 45, 55, 87, 10, 20, 30)
      )
  
  output$data <- renderTable(data)
  
  output$strat_data <- renderTable({
    breaks <- seq(min(data[,5], na.rm=TRUE), 
                  max(data[,5], na.rm=TRUE), 
                  by=input$strat_gap)
    if(max(breaks) < max(data[,5], na.rm=TRUE)){breaks <- c(breaks, max(breaks) + input$strat_gap)}
    data <- data %>%   
      mutate(sumvar = cut(!!sym("Values"), breaks=breaks, include.lowest=TRUE)) %>% 
      group_by(sumvar) %>%
      summarise(Count = n(), Values = sum(!!sym("Values"))) %>%
      complete(sumvar, fill = list(Count = 0, Values = 0)) %>%
      ungroup %>%
      mutate(Count_pct = sprintf("%.1f%%", (Count/sum(Count))*100), 
             Values_pct = sprintf("%.1f%%", (Values/sum(Values))*100)) %>% 
      dplyr::select(everything(), Count, Count_pct, Values, Values_pct)
    names(data)[1] <- "Ranges"
    data
  })
  
}

shinyApp(ui, server)

下面是修改后的 output$strat_data... 代码(server 部分)反映了 oskjerv 提出的解决方案(添加的 2 行已标记):

output$strat_data <- renderTable({
    breaks <- seq(min(data[,5], na.rm=TRUE), 
                  max(data[,5], na.rm=TRUE), 
                  by=input$strat_gap)
    if(max(breaks) < max(data[,5], na.rm=TRUE)){breaks <- c(breaks, max(breaks) + input$strat_gap)}
    
    data <- data %>%   
      mutate(sumvar = cut(!!sym("Values"), breaks=breaks, include.lowest=TRUE)) %>% 
      group_by(sumvar) %>%
        summarise(Count = n(), Values = sum(!!sym("Values"))) %>%
        complete(sumvar, fill = list(Count = 0, Values = 0)) %>%
      ungroup %>%
      mutate(Count_pct = sprintf("%.1f%%", (Count/sum(Count))*100), 
             Values_pct = sprintf("%.1f%%", (Values/sum(Values))*100)) %>% 
      dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
      mutate( sumvar = str_replace(sumvar, "^\(", "[")) %>% # ADDED
      mutate( sumvar = str_replace(sumvar, "\,", " to "))   # ADDED
    
    names(data)[1] <- "Ranges"
    data
  })

您可能应该使用 str_replace 和正则表达式。

https://regexr.com/ 是一个很好的起点。

例如,下面的代码将字符串开头的左括号替换为 [

^ 是一个锚点,在字符串的开头匹配。 \是对括号进行转义,因为(在使用正则表达式时还有其他作用。

str_replace("(-0,5]", "^\(", "[")

我相信 SO 上还有其他答案也会有所帮助。