Table header

R/cards.R

@@ -731,7 +731,7 @@ dropdownDivider <- function() {
 #'   )
 #' }
 #' @export
-bs4ValueBox <- function(value, subtitle, icon = NULL, color = NULL, width = 3,
+bs4ValueBox <- function(value, subtitle = NULL, icon = NULL, color = NULL, width = 3,
                         href = NULL, footer = NULL, gradient = FALSE, elevation = NULL) {
   if (!is.null(icon)) {
     tagAssert(icon, type = "i")
@@ -775,7 +775,9 @@ bs4ValueBox <- function(value, subtitle, icon = NULL, color = NULL, width = 3,
   innerTag <- shiny::tags$div(
     class = "inner",
     value,
-    shiny::tags$p(class = "small-box-subtitle", subtitle)
+    if (!is.null(subtitle)) {
+      shiny::tags$p(class = "small-box-subtitle", subtitle)
+    }
   )
 
   iconTag <- if (!is.null(icon)) {
@@ -802,7 +804,8 @@ bs4ValueBox <- function(value, subtitle, icon = NULL, color = NULL, width = 3,
         shiny::icon("arrow-circle-right")
       )
     } else {
-      shiny::tags$div(class = "small-box-footer", style = "height: 30px;")
+      NULL
+      # shiny::tags$div(class = "small-box-footer", style = "height: 30px;")
     }
   }
 

R/useful-items.R

@@ -317,7 +317,7 @@ bs4Carousel <- function(..., id, indicators = TRUE, width = 12, .list = NULL) {
     navs <- lapply(seq_along(items), FUN = function(i) {
       # if we found an active item, all other active items are ignored.
       active <- if (found_active) {
-         FALSE
+        FALSE
       } else {
         sum(grep(x = items[[i]]$attribs$class, pattern = "active")) == 1
       }
@@ -363,7 +363,7 @@ bs4Carousel <- function(..., id, indicators = TRUE, width = 12, .list = NULL) {
       # previous
       shiny::tags$a(
         class = "carousel-control-prev",
-       `data-target` = paste0("#", id),
+        `data-target` = paste0("#", id),
         href = "#",
         role = "button",
         `data-slide` = "prev",
@@ -1484,7 +1484,7 @@ bs4ListGroupItem <- function(..., title = NULL, subtitle = NULL,
   if (active && disabled) {
     stop("active and disabled cannot be TRUE at the same time!")
   }
-
+  
   list(
     body = ...,
     title = title,
@@ -2652,6 +2652,11 @@ bs4Sortable <- function(..., width = 12) {
 #' @param bordered Whether to display border between elements. FALSE by default.
 #' @param striped Whether to displayed striped in elements. FALSE by default.
 #' @param width Table width. 12 by default.
+#' @param header_attributes a named list of attributes for each
+#' header, which need to be the length of the number of columns
+#' in the data. For example, 
+#' `list(list(class = "col-3"), list(class = "col-5"))` 
+#' changes with width fo the column, or you can use `list(width="25\%)`.
 #' 
 #' @examples
 #' if (interactive()) {
@@ -2676,6 +2681,12 @@ bs4Sortable <- function(..., width = 12) {
 #'   server = function(input, output) { }
 #'  )
 #'  
+#'  
+#'  header_attributes = rep(list(list(width = "20%")), 5)
+#'  header_attributes[2] = list(
+#'  c(header_attributes[[2]],
+#'  list(style="background-color:#FF0000")
+#'  ))
 #'  # with shiny tags as input
 #'  shinyApp(
 #'   ui = dashboardPage(
@@ -2703,7 +2714,8 @@ bs4Sortable <- function(..., width = 12) {
 #'             )
 #'           ),
 #'           list("$2,500 USD", "NA", "NA", "test", "NA")
-#'         )
+#'         ),
+#'         header_attributes = header_attributes
 #'       )
 #'     ), 
 #'     footer = dashboardFooter()
@@ -2717,7 +2729,8 @@ bs4Sortable <- function(..., width = 12) {
 #'
 #' @export
 bs4Table <- function(data, cardWrap = FALSE, bordered = FALSE, 
-                     striped = FALSE, width = 12) {
+                     striped = FALSE, width = 12,
+                     header_attributes = NULL) {
 
   # handle theme
   tableCl <- "table"
@@ -2728,18 +2741,32 @@ bs4Table <- function(data, cardWrap = FALSE, bordered = FALSE,
       !inherits(data, "data.frame")) {
     stop("data must be a dataframe, tibble or list")
   }
-
-  if (inherits(data, "data.frame")) {
-
-    # column headers
-    tableHead <- shiny::tags$thead(
+  make_table_header = function(x, header_attributes = NULL) {
+    if (is.null(header_attributes)) {
+      header_attributes = lapply(1:length(x), function(r) NULL)
+    }
+    if (!is.null(header_attributes)) {
+      stopifnot(length(header_attributes) == length(x))
+    } 
+    shiny::tags$thead(
       shiny::tags$tr(
         lapply(
-          seq_along(colnames(data)), 
-          function(i) shiny::tags$th(colnames(data)[[i]])
+          seq_along(x), 
+          function(i) {
+            args = append(x[[i]], header_attributes[[i]])
+            args = as.list(args)
+            do.call(shiny::tags$th, args = args)
+          }
         ) 
       )
     )
+  }
+
+  if (inherits(data, "data.frame")) {
+
+    # column headers
+    tableHead <- make_table_header(colnames(data),
+                                   header_attributes = header_attributes)
 
     table <- lapply(seq_len(nrow(data)), function(i) {
       bs4TableItems(
@@ -2754,14 +2781,8 @@ bs4Table <- function(data, cardWrap = FALSE, bordered = FALSE,
   } else if (inherits(data, "list")) {
 
     # column headers
-    tableHead <- shiny::tags$thead(
-      shiny::tags$tr(
-        lapply(
-          seq_along(names(data[[1]])), 
-          function(i) shiny::tags$th(names(data[[1]])[[i]])
-        ) 
-      )
-    )
+    tableHead <- make_table_header(names(data[[1]]),
+                                   header_attributes = header_attributes)
 
     table <- lapply(seq_along(data), function(i) {
       bs4TableItems(