Блог

Хороший день.

У меня есть кое-какое задание.

 library(shiny)
ui <- fluidPage(
  DT::dataTableOutput('tbl')
)

library(DT)

data <- data.frame(list(
  good = c('a','b','c'),
  city = c('chicago', 'denver','colorado'),
  stock = c(1,2,3),
  transit = c(4,5,6)
))

server <- function(input, output) {
  
 output$tbl <- DT::renderDataTable({
   data%>%
     tidyr::pivot_wider(names_from = city, values_from = c('stock', 'transit'),
                        values_fill = 0, names_glue = '{city}_{.value}')%>%
     dplyr::select(order(names(.)))%>%
     dplyr::relocate(good)
 }) 
 
}
 

Мне нужно, чтобы заголовок был двухуровневым, но количество столбцов (городов) всегда разное.
поэтому стандартный вариант с контейнером не подходит, где нужно сразу указывать количество столбцов

необходимость…

Спасибо!!!

Вы можете использовать knitr::kable . Это будет работать для любого количества столбцов и любого количества городов.

 library(shiny)
library(knitr)
library(kableExtra)

ui <- fluidPage(
  htmlOutput('tbl')
)

library(DT)

data <- data.frame(list(
  good = c('a','b','c'),
  city = c('chicago', 'denver','colorado'),
  stock = c(1,2,3),
  transit = c(4,5,6)
))

server <- function(input, output) {
  
  output$tbl <- renderText({
    data%>%
      tidyr::pivot_wider(names_from = city, values_from = c('stock', 'transit'),
                         values_fill = 0, names_glue = '{city}_{.value}')%>%
      dplyr::select(order(names(.)))%>%
      dplyr::relocate(good) -> tmp
    
    cols <- names(tmp)
    names(tmp) <- sub('.*_', '', cols)
    tmp %>%
      knitr::kable(type = 'text') %>%
      kable_styling(
        font_size = 15,
        bootstrap_options = c("striped", "hover", "condensed")
      ) %>%
      add_header_above(c('', table(sub('_.*', '', cols[-1]))))
  }) 
  
}

shinyApp(ui, server)