我正在开发一个转换表模块,并正在努力解决如何使用户可以理解输出的问题。我曾经在Excel中准备转换表;使表格清晰易读非常容易,但导出表格输出的数据需要几个小时。现在我的问题与 R 相反:需要几秒钟才能从数百万行数据生成表输出,但表表示远非简单。
首先,我想反映用户的“From”输入(对象transFrom
) 在此反应表的辅助列标题中,如下图所示;关于如何做到这一点有什么建议吗?我对html完全一无所知。我在这里找到了这个解决方案R Shiny 应用程序 - 渲染具有双标题的数据表,我喜欢它,因为它使用 DT,我在整个过程中都使用它(尽管我更喜欢基本 R 表,使用 ShinyrenderTable()
,但我无法做到这一点)。我对此进行了研究,并找到了其他用于起草漂亮表格的软件包,但我避免“软件包膨胀”,而宁愿坚持使用基础R
, Shiny
, data.table
, and DT
如果可能的话,打包。
请注意,列反映了过渡状态 FROM,行反映了过渡状态 TO。
以下是主动渲染上述内容的 MWE 代码:
library(data.table)
library(dplyr)
library(shiny)
# custom table container
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(colspan = 1, ''),
th(colspan = 10, 'From state where initial period is = ')
),
tr(
lapply(colnames(results), th)
)
)
))
data <-
data.frame(
ID = c(1,1,1,2,2,2,3,3,3),
Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X0")
)
ui <- fluidPage(
tags$head(tags$style(".datatables .display {margin-left: 0;}")), # < left-align the table
h4(strong("Base data frame:")),
tableOutput("data"),
h4(strong("Transition table inputs:")),
numericInput("transFrom", "From period:", 1, min = 1, max = 3),
numericInput("transTo", "To period:", 2, min = 1, max = 3),
h4(strong("Output transition table:")),
DTOutput("results"),
)
server <- function(input, output) {
numTransit <- function(x, from=1, to=3){
setDT(x)
unique_state <- unique(x$State)
all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
dcast(x[, .(from_state = State[from],
to_state = State[to]),
by = ID]
[,.N, c("from_state", "to_state")]
[all_states,on = c("from_state", "to_state")],
to_state ~ from_state, value.var = "N"
)
}
results <-
reactive({
results <- numTransit(data,input$transFrom,input$transTo) %>%
replace(is.na(.), 0) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
results <- cbind(results, Sum = rowSums(results[,-1]))
})
output$data <- renderTable(data)
output$results <- renderDT(server=FALSE,{
results() %>%
datatable(rownames = FALSE,
filter = 'none',
container = sketch,
options = list(scrollX = F
, dom = 'ft'
, lengthChange = T
, pagingType = "numbers" # hides Next and Previous buttons
, autoWidth = T
, info = FALSE # hide the "Showing 1 of 2..." at bottom of table
,searching = FALSE # removes search box
),
class = "display"
)
})
}
shinyApp(ui, server)