如何清理渲染分层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 上还有其他答案也会有所帮助。
下面的示例代码生成原始数据的分层 table,用户可以借此指定 table 的分组范围。在 post
我正在尝试将呈现的 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 上还有其他答案也会有所帮助。