Merge branch 'master' into refactor-heading-component

* master:
  Add options related to the table <div> (#285)
  Have the table ID be settable, random, or absent in `gt()` (#286)

NAMESPACE

@@ -64,6 +64,7 @@ export(md)
 export(one_of)
 export(pct)
 export(px)
+export(random_id)
 export(render_gt)
 export(row_group_order)
 export(starts_with)

R/gt.R

@@ -15,7 +15,7 @@
 #' (perhaps unique across the entire table or unique within groups).
 #'
 #' Row groups can also be created by passing a `grouped_df` to `gt()` by using
-#' the `dplyr::group_by()` function on the table data. In this way, two or more
+#' the [dplyr::group_by()] function on the table data. In this way, two or more
 #' columns of categorical data can be used to make row groups. The
 #' `stub_group.sep` argument allows for control in how the row group label will
 #' appear in the display table.
@@ -27,6 +27,9 @@
 #'   group labels for generation of stub row groups.
 #' @param rownames_to_stub An option to take rownames from the input `data`
 #'   table as row captions in the display table stub.
+#' @param id The table ID. By default, this will be a random ID as generated by
+#'   the [random_id()] function. If set to `NULL` then no table ID will be
+#'   applied.
 #' @param stub_group.sep The separator to use between consecutive group names (a
 #'   possibility when providing `data` as a `grouped_df` with multiple groups)
 #'   in the displayed stub row group label.
@@ -70,8 +73,18 @@ gt <- function(data,
                rowname_col = "rowname",
                groupname_col = "groupname",
                rownames_to_stub = FALSE,
+               id = random_id(),
                stub_group.sep = getOption("gt.stub_group.sep", " - ")) {
 
+  opts_df <- gt_options_default()
+
+  # Add the table ID to the `id` parameter
+  if (!is.null(id)) {
+
+    opts_df <- opts_df_set(
+      opts_df, "table_id", id)
+  }
+
   # If the option to place rownames in the stub
   # is taken, then the `stub_df` data frame will
   # be pre-populated with rownames in the `rowname`
@@ -235,8 +248,8 @@ gt <- function(data,
   # Apply the input data table as an attribute
   attr(data_tbl, "data_df") <- data
 
-  # Apply the default theme options data frame as an attribute
-  attr(data_tbl, "opts_df") <- gt_options_default()
+  # Apply the `opts_df` data frame as an attribute
+  attr(data_tbl, "opts_df") <- opts_df
 
   # Apply an empty `formats` list as an attribute
   attr(data_tbl, "formats") <- list()

R/gt_options_default.R

@@ -1,10 +1,17 @@
 gt_options_default <- function() {
 
   dplyr::tribble(
-    ~parameter,                           ~scss, ~category,             ~value,
+    ~parameter,                          ~scss,  ~category,             ~value,
+    "container_width",                   FALSE,  "container",           "auto",
+    "container_height",                  FALSE,  "container",           "auto",
+    "container_overflow_x",              FALSE,  "container",           "auto",
+    "container_overflow_y",              FALSE,  "container",           "auto",
+    "table_id",                          FALSE,  "table",               NA_character_,
+    "table_width",                        TRUE,  "table",               "auto",
     "table_font_size",                    TRUE,  "table",               "16px",
     "table_background_color",             TRUE,  "table",               "#FFFFFF",
-    "table_width",                        TRUE,  "table",               "auto",
+    "margin_left",                        TRUE,  "table",               "auto",
+    "margin_right",                       TRUE,  "table",               "auto",
     "table_border_top_style",             TRUE,  "table",               "solid",
     "table_border_top_width",             TRUE,  "table",               "2px",
     "table_border_top_color",             TRUE,  "table",               "#A8A8A8",
@@ -63,6 +70,7 @@ gt_options_default <- function() {
     "sourcenotes_border_top_width",       TRUE,  "table",               "2px",
     "sourcenotes_border_top_color",       TRUE,  "table",               "#A8A8A8",
     "sourcenote_font_size",               TRUE,  "sourcenote",          "90%",
-    "sourcenote_padding",                 TRUE,  "sourcenote",          "4px") %>%
+    "sourcenote_padding",                 TRUE,  "sourcenote",          "4px",
+    ) %>%
     as.data.frame()
 }

R/helpers.R

@@ -935,6 +935,20 @@ px <- function(x) {
   paste0(x, "px")
 }
 
+#' Helper for creating a random `id` for a \pkg{gt} table
+#'
+#' This helper function is to be used with `id` argument of the [gt()] function.
+#' The `id` option in [gt()] uses `random_id()` by default however we can
+#' optionally supply a custom `id` value, or, use `NULL` for no ID at all.
+#'
+#' @param n The number of lowercase letters to use for the random ID.
+#' @family helper functions
+#' @export
+random_id <- function(n = 10) {
+
+  paste(sample(letters, n, replace = TRUE), collapse = "")
+}
+
 #' Perform LaTeX escaping
 #'
 #' Text may contain several characters with special meanings in LaTeX. This

R/print.R

@@ -42,22 +42,37 @@ as.tags.gt_tbl <- function(x, ...) {
   # Generate the HTML table
   html_table <- render_as_html(data = x)
 
-  # Create a random `id` tag
-  id <- paste(sample(letters, 10, 10), collapse = "")
+  # Extract the `opts_df` data frame object from `x`
+  opts_df <- attr(x, "opts_df", exact = TRUE)
+
+  # Get options related to the enclosing <div>
+  id <- opts_df_get(opts_df, option = "table_id")
+  container_overflow_x <- opts_df_get(opts_df, option = "container_overflow_x")
+  container_overflow_y <- opts_df_get(opts_df, option = "container_overflow_y")
+  container_width <- opts_df_get(opts_df, option = "container_width")
+  container_height <- opts_df_get(opts_df, option = "container_height")
+
+  # If the ID hasn't been set, set `id` as NULL
+  if (is.na(id)) {
+    id <- NULL
+  }
 
   # Compile the SCSS as CSS
   css <- compile_scss(data = x, id = id)
 
   # Attach the dependency to the HTML table
-  html_tbl <-
-    htmltools::tagList(
-      htmltools::tags$style(htmltools::HTML(css)),
-      htmltools::tags$div(
-        id = id,
-        style = htmltools::css(`overflow-x` = "auto"),
-        htmltools::HTML(html_table)
-      )
-    )
+  html_tbl <- htmltools::tagList(
+    htmltools::tags$style(htmltools::HTML(css)),
+    tags$div(
+      id = id,
+      style = htmltools::css(
+        `overflow-x` = container_overflow_x,
+        `overflow-y` = container_overflow_y,
+        width = container_width,
+        height = container_height
+        ),
+      htmltools::HTML(html_table))
+  )
 
   html_tbl
 }

R/shiny.R

@@ -1,22 +1,84 @@
 #' A \pkg{gt} display table render function for use in Shiny
 #'
-#' @param expr An expression that creates a \pkg{gt} table object.
+#' With `render_gt()` we can create a reactive \pkg{gt} table that works
+#' wonderfully once assigned to an output slot (with [gt_output()]). This
+#' function is to be used within Shiny's `server()` component. We have some
+#' options for controlling the size of the container holding the \pkg{gt} table.
+#' The `width` and `height` arguments allow for sizing the container, and the
+#' `align` argument allows us to align the table within the container (some
+#' other fine-grained options for positioning are available in the
+#' [tab_options()] function).
+#'
+#' We need to ensure that we have the \pkg{shiny} package installed first. This
+#' is easily by using `install.packages("shiny")`. More information on creating
+#' Shiny apps can be found at the \href{https://shiny.rstudio.com}{Shiny Site}.
+#'
+#' @param expr An expression that creates a \pkg{gt} table object. For sake of
+#'   convenience, a data frame or tibble can be used here (it will be
+#'   automatically introduced to [gt()] with its default options).
+#' @param width,height The width and height of the table's container. Either can
+#'   be specified as a single-length character with units of pixels or as a
+#'   percentage. If provided as a single-length numeric vector, it is assumed
+#'   that the value is given in units of pixels. The [px()] and [pct()] helper
+#'   functions can also be used to pass in numeric values and obtain values as
+#'   pixel or percent units.
+#' @param align The alignment of the table in its container. By default, this is
+#'   `"center"`. Other options are `"left"` and `"right"`.
 #' @param env The environment in which to evaluate the `expr`.
-#' @param quoted Is `expr`` a quoted expression (with `quote()`)? This is useful
+#' @param quoted Is `expr` a quoted expression (with `quote()`)? This is useful
 #'   if you want to save an expression in a variable.
 #' @param outputArgs A list of arguments to be passed through to the implicit
 #'   call to [gt_output()] when `render_gt` is used in an interactive R Markdown
 #'   document.
-#' @seealso \link{gt_output}()
+#'
+#' @examples
+#' # Here is a Shiny app (contained within
+#' # a single file) that (1) prepares a
+#' # gt table, (2) sets up the `ui` with
+#' # `gt_output()`, and (3) sets up the
+#' # `server` with a `render_gt()` that
+#' # uses the `gt_tbl` object as the input
+#' # expression
+#'
+#' gt_tbl <-
+#'   gtcars %>%
+#'   gt() %>%
+#'   cols_hide(contains("_"))
+#'
+#' ui <- fluidPage(
+#'
+#'   gt_output(outputId = "table")
+#' )
+#'
+#' server <- function(input,
+#'                    output,
+#'                    session) {
+#'
+#'   output$table <-
+#'     render_gt(
+#'       expr = gt_tbl,
+#'       height = px(600),
+#'       width = px(600)
+#'     )
+#' }
+#'
+#' \dontrun{
+#' shinyApp(ui, server)
+#' }
 #' @family Shiny functions
 #' @export
 render_gt <- function(expr,
+                      width = NULL,
+                      height = NULL,
+                      align = NULL,
                       env = parent.frame(),
                       quoted = FALSE,
                       outputArgs = list()) {
 
+  # Ensure that the shiny package is available
   check_shiny()
 
+  # Install the expression as a function
   func <-
     shiny::installExprFunction(
       expr = expr,
@@ -32,6 +94,21 @@ render_gt <- function(expr,
         return(NULL)
       }
 
+      # If the `expr` is an object that doesn't inherit from `gt_tbl`,
+      # simply use `gt()` with no options to create the gt table
+      if (!inherits(result, "gt_tbl")) {
+        result <- result %>% gt()
+      }
+
+      # Modify some gt table options via `tab_options()`
+      result <-
+        result %>%
+        tab_options(
+          container.width = width,
+          container.height = height,
+          table.align = align
+        )
+
       html_tbl <- as.tags.gt_tbl(result)
 
       dependencies <-
@@ -53,13 +130,60 @@ render_gt <- function(expr,
 
 #' Create a \pkg{gt} display table output element for Shiny
 #'
+#' Using `gt_output()` we can render a reactive \pkg{gt} table, a process
+#' initiated by using the [render_gt()] function in the `server` component of a
+#' Shiny app. The `gt_output()` call is to be used in the Shiny `ui` component,
+#' the position and context wherein this call is made determines the where the
+#' \pkg{gt} table is rendered on the app page. It's important to note that the
+#' ID given during the [render_gt()] call is needed as the `outputId` in
+#' `gt_output()` (e.g., **server**: `output$<id> <- render_gt(...)`; **ui**:
+#' `gt_output(outputId = "<id>"`).
+#'
+#' We need to ensure that we have the \pkg{shiny} package installed first. This
+#' is easily by using `install.packages("shiny")`. More information on creating
+#' Shiny apps can be found at the \href{https://shiny.rstudio.com}{Shiny Site}.
+#'
 #' @param outputId An output variable from which to read the table.
-#' @return A \pkg{gt} table output element that can be included in a panel.
-#' @seealso \link{render_gt}()
+#'
+#' @examples
+#' # Here is a Shiny app (contained within
+#' # a single file) that (1) prepares a
+#' # gt table, (2) sets up the `ui` with
+#' # `gt_output()`, and (3) sets up the
+#' # `server` with a `render_gt()` that
+#' # uses the `gt_tbl` object as the input
+#' # expression
+#'
+#' gt_tbl <-
+#'   gtcars %>%
+#'   gt() %>%
+#'   cols_hide(contains("_"))
+#'
+#' ui <- fluidPage(
+#'
+#'   gt_output(outputId = "table")
+#' )
+#'
+#' server <- function(input,
+#'                    output,
+#'                    session) {
+#'
+#'   output$table <-
+#'     render_gt(
+#'       expr = gt_tbl,
+#'       height = px(600),
+#'       width = px(600)
+#'     )
+#' }
+#'
+#' \dontrun{
+#' shinyApp(ui, server)
+#' }
 #' @family Shiny functions
 #' @export
 gt_output <- function(outputId) {
 
+  # Ensure that the shiny package is available
   check_shiny()
 
   shiny::htmlOutput(outputId)
@@ -69,7 +193,8 @@ check_shiny <- function() {
 
   if (!requireNamespace("shiny", quietly = TRUE)) {
 
-    stop("Please install the shiny package before using this function\n\n\t",
-         "install.packages(\"shiny\")", call. = FALSE)
+    stop("Please install the *shiny* package before using this function:\n",
+         "* Use `install.packages(\"shiny\")`",
+         call. = FALSE)
   }
 }