R Shiny - 增加 header 行 kable table 'sticky'
R Shiny - Make additional header row of kable table 'sticky'
kableExtra
包有一个很棒的函数,叫做 add_header_above()
,它在输出 table 的实际列名之上创建一个额外的 header 行。这对于分组数据非常有用。当在 kable_styling()
中设置 fixed_thead = TRUE
时,实际的列名在向下滚动时会被冻结,但这个额外的 header 行不会。
这是一个最简单的 shiny
应用程序,可以说明我的意思。请注意,如果您在 RStudio 查看器中查看应用程序,则普通列 header 和其他列都不是粘性的。 运行 而是在适当的网络浏览器中。
library(shiny)
library(magrittr)
ui <- fluidPage(
tableOutput("table")
)
server <- function(input, output, session) {
output$table <- function() {
knitr::kable(mtcars) %>%
kableExtra::kable_styling(fixed_thead = TRUE) %>%
kableExtra::add_header_above(c(" " = 1, "Header 1" = 5, "Header 2" = 6))
}
}
shinyApp(ui, server)
如何使使用 add_header_above()
创建的附加 header 行具有粘性? 我想我需要合并一些 CSS 或 JavaScript 在应用程序中执行此操作。
library(shiny)
library(magrittr)
CSS <- "
thead tr th {
position: sticky;
background-color: white;
}
thead tr:nth-child(1) th {
top: 0;
}
"
JS <- "
$(document).ready(function(){
setTimeout(function(){
var h = $('thead tr:nth-child(1)').height();
$('thead tr:nth-child(2) th').css('top', h);
}, 500);
});
"
ui <- fluidPage(
tags$head(
tags$style(HTML(CSS)),
tags$script(HTML(JS))
),
uiOutput("table")
)
server <- function(input, output, session) {
output$table <- renderUI({
tabl <- knitr::kable(mtcars) %>%
kableExtra::add_header_above(c(" " = 1, "Header 1" = 5, "Header 2" = 6)) %>%
kableExtra::kable_styling()
HTML(tabl)
})
}
shinyApp(ui, server)
灵感来自@Stéphane Laurent 的回答。下面是一种更通用的方法,用于将粘性 属性 应用于任意数量的 headers.
library(shiny)
library(magrittr)
JS <- "
$(document).ready(function() {
var myInterval = setInterval(function() {
// clear interval after the table's DOM is available
if ($('thead').length) {
clearInterval(myInterval);
}
// setting css
$('thead tr th').css('position', 'sticky').css('background', 'white');
var height = 0;
for (var i = 0, length = $('thead tr').length; i < length; i++) {
var header = $('thead tr:nth-child(' + i + ')');
height += header.length ? header.height() : 0;
$('thead tr:nth-child(' + (i + 1) + ') th').css('top', height);
}
}, 500);
});
"
ui <- fluidPage(
tags$head(
tags$script(HTML(JS))
),
tableOutput("table")
)
server <- function(input, output, session) {
output$table <- function() {
knitr::kable(mtcars) %>%
kableExtra::add_header_above(c(" " = 1, "Header 1" = 5, "Header 2" = 6)) %>%
kableExtra::add_header_above(c(" " = 1, "Header" = 11)) %>%
kableExtra::kable_styling()
}
}
shinyApp(ui, server)
如果您不希望您的主app.R
拥有所有Javascript,您可以将代码移动到不同的文件,请参阅:Include a javascript file in Shiny app。
kableExtra
包有一个很棒的函数,叫做 add_header_above()
,它在输出 table 的实际列名之上创建一个额外的 header 行。这对于分组数据非常有用。当在 kable_styling()
中设置 fixed_thead = TRUE
时,实际的列名在向下滚动时会被冻结,但这个额外的 header 行不会。
这是一个最简单的 shiny
应用程序,可以说明我的意思。请注意,如果您在 RStudio 查看器中查看应用程序,则普通列 header 和其他列都不是粘性的。 运行 而是在适当的网络浏览器中。
library(shiny)
library(magrittr)
ui <- fluidPage(
tableOutput("table")
)
server <- function(input, output, session) {
output$table <- function() {
knitr::kable(mtcars) %>%
kableExtra::kable_styling(fixed_thead = TRUE) %>%
kableExtra::add_header_above(c(" " = 1, "Header 1" = 5, "Header 2" = 6))
}
}
shinyApp(ui, server)
如何使使用 add_header_above()
创建的附加 header 行具有粘性? 我想我需要合并一些 CSS 或 JavaScript 在应用程序中执行此操作。
library(shiny)
library(magrittr)
CSS <- "
thead tr th {
position: sticky;
background-color: white;
}
thead tr:nth-child(1) th {
top: 0;
}
"
JS <- "
$(document).ready(function(){
setTimeout(function(){
var h = $('thead tr:nth-child(1)').height();
$('thead tr:nth-child(2) th').css('top', h);
}, 500);
});
"
ui <- fluidPage(
tags$head(
tags$style(HTML(CSS)),
tags$script(HTML(JS))
),
uiOutput("table")
)
server <- function(input, output, session) {
output$table <- renderUI({
tabl <- knitr::kable(mtcars) %>%
kableExtra::add_header_above(c(" " = 1, "Header 1" = 5, "Header 2" = 6)) %>%
kableExtra::kable_styling()
HTML(tabl)
})
}
shinyApp(ui, server)
灵感来自@Stéphane Laurent 的回答。下面是一种更通用的方法,用于将粘性 属性 应用于任意数量的 headers.
library(shiny)
library(magrittr)
JS <- "
$(document).ready(function() {
var myInterval = setInterval(function() {
// clear interval after the table's DOM is available
if ($('thead').length) {
clearInterval(myInterval);
}
// setting css
$('thead tr th').css('position', 'sticky').css('background', 'white');
var height = 0;
for (var i = 0, length = $('thead tr').length; i < length; i++) {
var header = $('thead tr:nth-child(' + i + ')');
height += header.length ? header.height() : 0;
$('thead tr:nth-child(' + (i + 1) + ') th').css('top', height);
}
}, 500);
});
"
ui <- fluidPage(
tags$head(
tags$script(HTML(JS))
),
tableOutput("table")
)
server <- function(input, output, session) {
output$table <- function() {
knitr::kable(mtcars) %>%
kableExtra::add_header_above(c(" " = 1, "Header 1" = 5, "Header 2" = 6)) %>%
kableExtra::add_header_above(c(" " = 1, "Header" = 11)) %>%
kableExtra::kable_styling()
}
}
shinyApp(ui, server)
如果您不希望您的主app.R
拥有所有Javascript,您可以将代码移动到不同的文件,请参阅:Include a javascript file in Shiny app。