F implement column group

NAMESPACE

@@ -3,6 +3,7 @@
 export(cheetah)
 export(cheetahOutput)
 export(column_def)
+export(column_group)
 export(renderCheetah)
 import(htmlwidgets)
 import(jsonlite)

R/cheetah.R

@@ -5,6 +5,7 @@
 #' @param data A data frame or matrix to display
 #' @param columns A list of column definitions. Each column can be customized using
 #'   \code{column_def()}.
+#' @param column_group A list of column groups. Each group can be customized using
 #' @param width Width of the widget
 #' @param height Height of the widget
 #' @param elementId The element ID for the widget
@@ -30,6 +31,7 @@
 cheetah <- function(
   data,
   columns = NULL,
+  column_group = NULL,
   width = NULL,
   height = NULL,
   elementId = NULL,
@@ -49,14 +51,21 @@ cheetah <- function(
       is_named_list(columns) & names(columns) %in% colnames(data)
   )
 
+  stopifnot(
+    "If not NULL, `column_groups` must be a named list or list of named lists" =
+      is.null(columns) |
+      is_named_list(column_group) |
+      all(unlist(lapply(column_group, is_named_list)))
+  )
+
   columns <-
     update_col_list_with_classes(data, columns) %>%
     make_table_sortable(sortable = sortable) %>%
     add_field_to_list()
 
   data_json <- toJSON(data, dataframe = "rows")
   # forward options using x
-  x <- list(data = data_json, columns = columns, search = search)
+  x <- list(data = data_json, columns = columns, colGroup = column_group, search = search)
 
   # create widget
   htmlwidgets::createWidget(

R/cheetah_utils.R

@@ -60,8 +60,20 @@
 #' @param sort Whether to sort the column. Default to FALSE. May also be
 #' a JS callback to create custom logic (does not work yet).
 #'
-#' @export
 #' @return A list of column options to pass to the JavaScript API.
+#'
+#' @examples
+#' cheetah(
+#'   iris,
+#'   columns = list(
+#'     Sepal.Length = column_def(name = "Length"),
+#'     Sepal.Width = column_def(name = "Width"),
+#'     Petal.Length = column_def(name = "Length"),
+#'     Petal.Width = column_def(name = "Width")
+#'   )
+#' )
+#'
+#' @export
 column_def <- function(
   name = NULL,
   width = NULL,
@@ -115,3 +127,41 @@ column_def <- function(
     sort = sort
   )
 }
+
+#' Column group definitions
+#'
+#' Creates a column group definition for grouping columns in a Cheetah Grid widget.
+#'
+#' @param name Character string. The name to display for the column group.
+#' @param columns Character vector. The names of the columns to include in this group.
+#' @param header_style Named list of possibleCSS style properties to apply to the column group header.
+#'
+#' @return A list containing the column group definition.
+#'
+#' @examples
+#' cheetah(
+#'   iris,
+#'   columns = list(
+#'     Sepal.Length = column_def(name = "Length"),
+#'     Sepal.Width = column_def(name = "Width"),
+#'     Petal.Length = column_def(name = "Length"),
+#'     Petal.Width = column_def(name = "Width")
+#'   ),
+#'   column_group = list(
+#'     column_group(name = "Sepal", columns = c("Sepal.Length", "Sepal.Width")),
+#'     column_group(name = "Petal", columns = c("Petal.Length", "Petal.Width"))
+#'   )
+#' )
+#'
+#' @export
+column_group <- function(name = NULL, columns, header_style = NULL) {
+  column_style_check(header_style)
+
+  dropNulls(
+    list(
+      caption = name,
+      columns = columns,
+      headerStyle = header_style
+    )
+  )
+}

R/utils.R

@@ -1,5 +1,4 @@
-is_testing <- function ()
-{
+is_testing <- function() {
   identical(Sys.getenv("TESTTHAT"), "true")
 }
 
@@ -92,7 +91,9 @@ update_col_list_with_classes <- function(data, col_list) {
     if (is.null(col_list[[col_name]]$columnType)) {
       if (col_classes[[col_name]] %in% c("numeric", "integer")) {
         col_list[[col_name]]$columnType <- "number"
-      } else if (col_classes[[col_name]] == "factor" && any(in_shiny, is_testing)) {
+      } else if (
+        col_classes[[col_name]] == "factor" && any(in_shiny, is_testing)
+      ) {
         # This is to recover the possible choices for a factor column.
         menu_opt <- lapply(
           unique(data[[col_name]]),
@@ -117,12 +118,16 @@ check_action_type <- function(action = NULL, column_type = NULL) {
 
   valid_actions <- c("input", "check", "radio", "inline_menu")
   if (!action %in% valid_actions) {
-    stop("Invalid action type. Must be one of: ",
-         paste(valid_actions, collapse = ", "))
+    stop(
+      "Invalid action type. Must be one of: ",
+      paste(valid_actions, collapse = ", ")
+    )
   }
 
   # Validate action-column type compatibility
-  if (action == "inline_menu" && any(is.null(column_type), column_type != "menu")) {
+  if (
+    action == "inline_menu" && any(is.null(column_type), column_type != "menu")
+  ) {
     stop("'inline_menu' action can only be used with 'menu' column type")
   }
 }

srcjs/modules/utils.js

@@ -0,0 +1,43 @@
+export function combineColumnsAndGroups(columnsList, colGroups) {
+    // 1. Build a lookup by field
+    const colsByField = {};
+    columnsList.forEach(col => {
+      colsByField[col.field] = col;
+    });
+
+    // 2. Find each group's first member and all members
+    const groupFirst   = colGroups.map(g => g.columns[0]);
+    const groupMembers = colGroups.reduce((acc, g) => acc.concat(g.columns), []);
+
+    const result = [];
+
+    // 3. Iterate in original order
+    columnsList.forEach(col => {
+      const f = col.field;
+      const gi = groupFirst.indexOf(f);
+
+      if (gi !== -1) {
+        // this is the first field of group gi → emit the group
+        const grp = colGroups[gi];
+
+        // build nested column definitions
+        const nested = grp.columns.map(fieldName => colsByField[fieldName]);
+
+        // extract everything except `columns` from grp
+        const { columns, ...grpMeta } = grp;
+
+        result.push({ ...grpMeta, columns: nested });
+
+      } else if (groupMembers.includes(f)) {
+        // a member of some group but not its first → skip
+
+      } else {
+        // standalone column
+        result.push(colsByField[f]);
+      }
+    });
+
+    return result;
+  }
+
+

srcjs/widgets/cheetah.js

@@ -1,5 +1,5 @@
 import 'widgets';
-import { asHeader } from '../modules/header.js';
+import { combineColumnsAndGroups } from '../modules/utils.js';
 import * as cheetahGrid from "cheetah-grid";
 
 HTMLWidgets.widget({
@@ -50,6 +50,10 @@ HTMLWidgets.widget({
           columns = defaultCol;
         }
 
+        if (x.colGroup !== null) {
+          columns = combineColumnsAndGroups(columns, x.colGroup);
+        }
+
         const grid = new cheetahGrid.ListGrid({
           parentElement: document.getElementById(id),
           header: columns,

tests/testthat/_snaps/utils.md

@@ -1,4 +1,4 @@
-# test utils
+# test column defintion
 
     Code
       column_def(message = "test")

tests/testthat/test-utils.R

@@ -1,4 +1,4 @@
-test_that("test utils", {
+test_that("test column defintion", {
   expect_type(column_def(name = "Sepal_Length"), "list")
 
   expect_named(
@@ -25,6 +25,32 @@ test_that("test utils", {
   )
 })
 
+test_that("test column group", {
+  expect_type(
+    column_group(
+      name = "Sepal",
+      columns = c("Sepal.Length", "Sepal.Width")
+    ),
+    "list"
+  )
+
+  expect_named(
+    column_group(
+      name = "Sepal",
+      columns = c("Sepal.Length", "Sepal.Width")
+    ),
+    c(
+      "caption",
+      "columns"
+    )
+  )
+
+  expect_error(
+    column_group(name = "Sepal"),
+    'argument "columns" is missing, with no default'
+  )
+})
+
 test_that("test column style check", {
   columns <- list(
     Sepal.Length = column_def(name = "Sepal_Length"),

vignettes/cheetahR.qmd

@@ -144,6 +144,7 @@ cheetah(
 )
 ```
 
+
 ### Coming soon (TBD)
 
 If you want finer control over the sorting logic and provide your own, you can pass a `htmlwidgets::JS` callback instead:
@@ -165,6 +166,37 @@ cheetah(
 )
 ```
 
+## Column Grouping
+
+cheetahR allows you to group related columns together under a common header using `column_group()`. This creates a hierarchical structure in your table headers, making it easier to organize and understand related data.
+
+To group columns, use the `column_group()` function to define each group and specify which columns belong to it. Then pass the list of column groups to the `column_group` parameter in `cheetah()`.
+
+Here's an example grouping the Sepal and Petal measurements in the iris dataset:
+```{r}
+cheetah(
+  iris,
+  columns = list(
+    Sepal.Length = column_def(name = "Length"),
+    Sepal.Width = column_def(name = "Width"),
+    Petal.Length = column_def(name = "Length"),
+    Petal.Width = column_def(name = "Width")
+  ),
+  column_group = list(
+    column_group(
+      name = "Sepal",
+      columns = c("Sepal.Length", "Sepal.Width"),
+      header_style = list(textAlign = "center", bgColor = "#fbd4dd")
+    ),
+    column_group(
+      name = "Petal",
+      columns = c("Petal.Length", "Petal.Width"),
+      header_style = list(textAlign = "center", bgColor = "#d8edfc")
+    )
+  )
+)
+```
+
 ## Filtering data
 
 You can filter data by setting `search` to either `exact` or `contains` when you call `cheetah()` like so: