From 6ff13567702c0f81f6622e74bdcc35d8498929ff Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 30 Jun 2021 02:02:18 -0500 Subject: [PATCH 01/12] create missing rebase merge message file --- R/reactable.R | 63 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 61 insertions(+), 2 deletions(-) diff --git a/R/reactable.R b/R/reactable.R index 47fbb60d..9c1d6e65 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -97,6 +97,15 @@ #' #' To set the width of a column, see [colDef()]. #' @param height Height of the table in pixels. Defaults to `"auto"` for automatic sizing. +#' @param title String of title to appear above table, defaults to NULL. +#' @param subtitle String of subtitle to appear above table, defaults to NULL. +#' @param caption String of title to appear below table, defaults to NULL. +#' @param logo Logo (htmltools::img object) to appear below table, defaults to NULL. +#' @param titleStyle CSS styling of title, defaults to NULL, +#' @param subtitleStyle CSS styling of subtitle, defaults to NULL, +#' @param captionStyle CSS styling of caption underneath table, defaults to NULL. +#' @param logoStyle CSS styling of logo underneath table, defaults to `float: right;margin-right:10px;width:200px;`. +#' @param fonts List of Google fonts to import. #' @param theme Theme options for the table, specified by #' [reactableTheme()]. Defaults to the global `reactable.theme` option. #' Can also be a function that returns a [reactableTheme()] or `NULL`. @@ -151,7 +160,8 @@ #' )) #' #' @export -reactable <- function(data, columns = NULL, columnGroups = NULL, +reactable <- function(data, + columns = NULL, columnGroups = NULL, rownames = NULL, groupBy = NULL, sortable = TRUE, resizable = FALSE, filterable = FALSE, searchable = FALSE, defaultColDef = NULL, defaultColGroup = NULL, @@ -167,6 +177,15 @@ reactable <- function(data, columns = NULL, columnGroups = NULL, showSortIcon = TRUE, showSortable = FALSE, class = NULL, style = NULL, rowClass = NULL, rowStyle = NULL, fullWidth = TRUE, width = "auto", height = "auto", + title = NULL, + subtitle = NULL, + caption = NULL, + logo = NULL, + titleStyle = NULL, + subtitleStyle = NULL, + captionStyle = NULL, + logoStyle = NULL, + fonts = NULL, theme = getOption("reactable.theme"), language = getOption("reactable.language"), elementId = NULL) { @@ -611,9 +630,49 @@ reactable <- function(data, columns = NULL, columnGroups = NULL, key = if (!isV2()) dataKey )) + # add elements (title, subtitle, caption, logo) + content_tags <- list(title = title, + subtitle = subtitle, + table = component, + caption = caption, + logo = logo) + + content_tags <- Filter(Negate(is.null), content_tags) + + content_tags <- lapply(seq_along(content_tags), function(i){ + name <- names(content_tags)[[i]] + x <- content_tags[[i]] + if("reactR_component" %in% class(x)) return(x) + htmltools::tags$div(x, id = paste0("reactable-",name)) + }) + + # content_tags <- list() + # + # if(!is.null(title)) content_tags$title_tag <- htmltools::tags$div(title, id = "reactable-title") + # if(!is.null(subtitle)) content_tags$subtitle_tag <- htmltools::tags$div(subtitle, id = "reactable-subtitle") + # content_tags$component <- component + # if(!is.null(caption)) content_tags$caption_tag <- htmltools::tags$div(caption, id = "reactable-caption") + # if(!is.null(logo)) content_tags$logo_tag <- htmltools::tags$div(logo, id = "reactable-logo") + + if(!is.null(fonts)){ + font_import <- import_fonts(fonts) + font_tag <- htmltools::tags$style(font_import) + content_tags$font_tag <- font_tag + } + + if(is.null(logoStyle)) logoStyle <- "float: right;margin-right:10px;width:200px;" + + content_tags$style_tag <- htmltools::tags$style(paste0("#reactable-title {",titleStyle,"} + #reactable-subtitle {",subtitleStyle,"} + #reactable-caption {",captionStyle,"} + #reactable-logo img {",logoStyle,"}")) + + content_tags <- unname(content_tags) + content <- htmltools::tag("div", content_tags) + htmlwidgets::createWidget( name = widgetName, - reactR::reactMarkup(component), + reactR::reactMarkup(content), width = width, height = height, # Don't limit width when rendered inside an R Notebook From eaed0f5392bd08a02604f7be8d2b6221b8dbda53 Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 30 Jun 2021 02:37:25 -0500 Subject: [PATCH 02/12] remove obsolete comments --- R/reactable.R | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/R/reactable.R b/R/reactable.R index 9c1d6e65..b40aa2f3 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -646,14 +646,8 @@ reactable <- function(data, htmltools::tags$div(x, id = paste0("reactable-",name)) }) - # content_tags <- list() - # - # if(!is.null(title)) content_tags$title_tag <- htmltools::tags$div(title, id = "reactable-title") - # if(!is.null(subtitle)) content_tags$subtitle_tag <- htmltools::tags$div(subtitle, id = "reactable-subtitle") - # content_tags$component <- component - # if(!is.null(caption)) content_tags$caption_tag <- htmltools::tags$div(caption, id = "reactable-caption") - # if(!is.null(logo)) content_tags$logo_tag <- htmltools::tags$div(logo, id = "reactable-logo") + # import fonts if font param is not null if(!is.null(fonts)){ font_import <- import_fonts(fonts) font_tag <- htmltools::tags$style(font_import) @@ -667,8 +661,8 @@ reactable <- function(data, #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) - content_tags <- unname(content_tags) - content <- htmltools::tag("div", content_tags) + + content <- htmltools::tag("div", unname(content_tags)) htmlwidgets::createWidget( name = widgetName, From 4cb38c8b21c0806fb80709788c4ba39b82a9c34d Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 30 Jun 2021 02:37:53 -0500 Subject: [PATCH 03/12] fix getAttribs for newly nested attribs --- tests/testthat/test-reactable.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-reactable.R b/tests/testthat/test-reactable.R index aaa51767..784d46eb 100644 --- a/tests/testthat/test-reactable.R +++ b/tests/testthat/test-reactable.R @@ -1,6 +1,6 @@ library(htmltools) -getAttribs <- function(widget) widget$x$tag$attribs +getAttribs <- function(widget) widget$x$tag$children[[1]]$attribs test_that("reactable handles invalid args", { expect_error(reactable(1)) From 9688715e8e211bd7f69aab972063737e91b3bd5b Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 30 Jun 2021 03:36:08 -0500 Subject: [PATCH 04/12] add import googlefonts fct --- R/reactable.R | 11 +++++------ R/utils.R | 6 ++++++ 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/R/reactable.R b/R/reactable.R index b40aa2f3..d45c4eca 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -105,7 +105,7 @@ #' @param subtitleStyle CSS styling of subtitle, defaults to NULL, #' @param captionStyle CSS styling of caption underneath table, defaults to NULL. #' @param logoStyle CSS styling of logo underneath table, defaults to `float: right;margin-right:10px;width:200px;`. -#' @param fonts List of Google fonts to import. +#' @param googlefonts List of Google fonts to import. #' @param theme Theme options for the table, specified by #' [reactableTheme()]. Defaults to the global `reactable.theme` option. #' Can also be a function that returns a [reactableTheme()] or `NULL`. @@ -185,7 +185,7 @@ reactable <- function(data, subtitleStyle = NULL, captionStyle = NULL, logoStyle = NULL, - fonts = NULL, + googlefonts = NULL, theme = getOption("reactable.theme"), language = getOption("reactable.language"), elementId = NULL) { @@ -646,10 +646,9 @@ reactable <- function(data, htmltools::tags$div(x, id = paste0("reactable-",name)) }) - - # import fonts if font param is not null - if(!is.null(fonts)){ - font_import <- import_fonts(fonts) + # import fonts if googlefonts param is not null + if(!is.null(googlefonts)){ + font_import <- import_googlefonts(fonts = googlefonts) font_tag <- htmltools::tags$style(font_import) content_tags$font_tag <- font_tag } diff --git a/R/utils.R b/R/utils.R index 759048cf..f54b34eb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,6 +2,12 @@ #' @export htmlwidgets::JS +import_googlefonts <- function(fonts){ + font_names <- gsub(" ", "+", unlist(fonts)) + imports <- paste0("@import url('https://fonts.googleapis.com/css?family=",font_names,"');") + paste0(imports, collapse = "") +} + mergeLists <- function(a, b) { if (is.null(a)) { a <- list() From 7641442df3cdf504d588f7f7629308b3f988022a Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 30 Jun 2021 04:42:15 -0500 Subject: [PATCH 05/12] tidy styles --- R/reactable.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/reactable.R b/R/reactable.R index d45c4eca..efeef742 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -655,10 +655,10 @@ reactable <- function(data, if(is.null(logoStyle)) logoStyle <- "float: right;margin-right:10px;width:200px;" - content_tags$style_tag <- htmltools::tags$style(paste0("#reactable-title {",titleStyle,"} - #reactable-subtitle {",subtitleStyle,"} - #reactable-caption {",captionStyle,"} - #reactable-logo img {",logoStyle,"}")) + content_tags$style_tag <- + htmltools::tags$style( + paste0( + "#reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) content <- htmltools::tag("div", unname(content_tags)) From 7d7103ef3318ad834570429089ed70e1d30889d7 Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Tue, 10 Aug 2021 10:34:37 -0500 Subject: [PATCH 06/12] add tableBackground param --- R/reactable.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/reactable.R b/R/reactable.R index efeef742..38c90c1b 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -106,6 +106,7 @@ #' @param captionStyle CSS styling of caption underneath table, defaults to NULL. #' @param logoStyle CSS styling of logo underneath table, defaults to `float: right;margin-right:10px;width:200px;`. #' @param googlefonts List of Google fonts to import. +#' @param tableBackground Background color behind table. #' @param theme Theme options for the table, specified by #' [reactableTheme()]. Defaults to the global `reactable.theme` option. #' Can also be a function that returns a [reactableTheme()] or `NULL`. @@ -185,6 +186,7 @@ reactable <- function(data, subtitleStyle = NULL, captionStyle = NULL, logoStyle = NULL, + tableBackground = NULL, googlefonts = NULL, theme = getOption("reactable.theme"), language = getOption("reactable.language"), @@ -658,7 +660,7 @@ reactable <- function(data, content_tags$style_tag <- htmltools::tags$style( paste0( - "#reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) + "body {background-color: ",tableBackground,";} #reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) content <- htmltools::tag("div", unname(content_tags)) From 08208944ec91d3b5c4143a8cf09052a16e77a67d Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 11 Aug 2021 06:45:56 -0500 Subject: [PATCH 07/12] fix reactable table background --- R/reactable.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/reactable.R b/R/reactable.R index 38c90c1b..290f7165 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -660,8 +660,7 @@ reactable <- function(data, content_tags$style_tag <- htmltools::tags$style( paste0( - "body {background-color: ",tableBackground,";} #reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) - + ".reactable {background-color:",tableBackground,";} #reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) content <- htmltools::tag("div", unname(content_tags)) From fdde971f3840084b6331d225a24466da29d51524 Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 11 Aug 2021 09:09:11 -0500 Subject: [PATCH 08/12] adapt height of background and padding --- R/reactable.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/reactable.R b/R/reactable.R index 290f7165..f15f5f88 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -657,10 +657,12 @@ reactable <- function(data, if(is.null(logoStyle)) logoStyle <- "float: right;margin-right:10px;width:200px;" + backgroundStyle <- paste0("background-color:",tableBackground,";padding: 10px;height: 100%;") + content_tags$style_tag <- htmltools::tags$style( paste0( - ".reactable {background-color:",tableBackground,";} #reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) + ".reactable {",backgroundStyle,"} #reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}")) content <- htmltools::tag("div", unname(content_tags)) From 15eb70f340a7e83c7bf41831ff598938700cfacb Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Wed, 11 Aug 2021 09:28:22 -0500 Subject: [PATCH 09/12] replace tableBackground with backgroundStyle --- R/reactable.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/reactable.R b/R/reactable.R index f15f5f88..1254fb88 100644 --- a/R/reactable.R +++ b/R/reactable.R @@ -106,7 +106,7 @@ #' @param captionStyle CSS styling of caption underneath table, defaults to NULL. #' @param logoStyle CSS styling of logo underneath table, defaults to `float: right;margin-right:10px;width:200px;`. #' @param googlefonts List of Google fonts to import. -#' @param tableBackground Background color behind table. +#' @param backgroundStyle CSS styling of background behind table, defaults to NULL. #' @param theme Theme options for the table, specified by #' [reactableTheme()]. Defaults to the global `reactable.theme` option. #' Can also be a function that returns a [reactableTheme()] or `NULL`. @@ -186,7 +186,7 @@ reactable <- function(data, subtitleStyle = NULL, captionStyle = NULL, logoStyle = NULL, - tableBackground = NULL, + backgroundStyle = NULL, googlefonts = NULL, theme = getOption("reactable.theme"), language = getOption("reactable.language"), @@ -657,8 +657,6 @@ reactable <- function(data, if(is.null(logoStyle)) logoStyle <- "float: right;margin-right:10px;width:200px;" - backgroundStyle <- paste0("background-color:",tableBackground,";padding: 10px;height: 100%;") - content_tags$style_tag <- htmltools::tags$style( paste0( From 6bd33243c964b0f5450347dff32dfa1c370a76df Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Mon, 16 Aug 2021 04:44:37 -0500 Subject: [PATCH 10/12] update getAttribs fct --- tests/testthat/test-reactable.R | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-reactable.R b/tests/testthat/test-reactable.R index 784d46eb..223f530c 100644 --- a/tests/testthat/test-reactable.R +++ b/tests/testthat/test-reactable.R @@ -1,6 +1,18 @@ library(htmltools) -getAttribs <- function(widget) widget$x$tag$children[[1]]$attribs +# getAttribs <- function(widget) widget$x$tag$children[[3]]$attribs + +getChildrenAttribs <- function(widget) widget$x$tag$children %>% purrr::map(~ .x$attribs) + +getAttribs <- function(widget){ + children_attribs <- getChildrenAttribs(widget) + table_attribs <- children_attribs %>% purrr::keep(~ !is.null(.x$data)) + table_attribs[[1]] +} + + + +# ls <- widget$x$tag$children %>% purrr::map(function(.x){grepl("id=\\\"reactable-", .x)}) test_that("reactable handles invalid args", { expect_error(reactable(1)) @@ -169,6 +181,16 @@ test_that("reactable", { expect_equal(attribs$style, list("border-bottom" = "1px solid", top = "50px")) }) +test_that("extra elements created", { + tbl <- reactable(data.frame(x = "a", stringsAsFactors = TRUE), + title = "some title", + subtitle = "some subtitle", + caption = "some caption", + logo = "some logo") + + +}) + test_that("data can be a matrix", { data <- matrix(c(1, 2, 3, 4), nrow = 2) tbl <- reactable(data) From d155aaef504feec5ec8a3d0c245098aea0c0691e Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Mon, 16 Aug 2021 05:13:10 -0500 Subject: [PATCH 11/12] add getElement function to test --- tests/testthat/test-reactable.R | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-reactable.R b/tests/testthat/test-reactable.R index 223f530c..ffa2cb6d 100644 --- a/tests/testthat/test-reactable.R +++ b/tests/testthat/test-reactable.R @@ -1,18 +1,31 @@ library(htmltools) -# getAttribs <- function(widget) widget$x$tag$children[[3]]$attribs - getChildrenAttribs <- function(widget) widget$x$tag$children %>% purrr::map(~ .x$attribs) getAttribs <- function(widget){ children_attribs <- getChildrenAttribs(widget) - table_attribs <- children_attribs %>% purrr::keep(~ !is.null(.x$data)) + table_attribs <- children_attribs %>% purrr::compact("data") table_attribs[[1]] } +getElement <- function(widget, elementType){ + children_attribs <- getChildrenAttribs(widget) + element_ids <- children_attribs %>% purrr::compact("id") %>% unlist() + + if(length(element_ids) == 0) return(warning("Table does not have extra elements.")) + + if(!elementType %in% c("title", "subtitle", "caption", "logo")) return(warning("Not a valid elementType.")) + type <- paste0("reactable-", elementType) -# ls <- widget$x$tag$children %>% purrr::map(function(.x){grepl("id=\\\"reactable-", .x)}) + if(!type %in% element_ids) stop("Table does not have ", elementType, " element.") + + element_index <- match(type, element_ids) + + if(elementType %in% c("caption", "logo")) element_index <- element_index + 1 + + widget$x$tag$children[[element_index]][[3]][[1]] +} test_that("reactable handles invalid args", { expect_error(reactable(1)) From 8d49033c437bb06b203fd7296115e65d803747ee Mon Sep 17 00:00:00 2001 From: Lena Mangold Date: Mon, 16 Aug 2021 05:21:23 -0500 Subject: [PATCH 12/12] add tests for extra elements --- tests/testthat/test-reactable.R | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-reactable.R b/tests/testthat/test-reactable.R index ffa2cb6d..bc986d10 100644 --- a/tests/testthat/test-reactable.R +++ b/tests/testthat/test-reactable.R @@ -18,7 +18,7 @@ getElement <- function(widget, elementType){ type <- paste0("reactable-", elementType) - if(!type %in% element_ids) stop("Table does not have ", elementType, " element.") + if(!type %in% element_ids) stop("Table does not have a ", elementType, " element.") element_index <- match(type, element_ids) @@ -195,12 +195,28 @@ test_that("reactable", { }) test_that("extra elements created", { + title <- "some title" + subtitle <- "some subtitle" + caption <- "some caption" + logo <- "logo" + + tbl <- reactable(data.frame(x = "a", stringsAsFactors = TRUE), + title = title, + subtitle = subtitle, + caption = caption, + logo = logo) + + expect_equal(getElement(tbl, elementType = "title"), title) + expect_equal(getElement(tbl, elementType = "subtitle"), subtitle) + expect_equal(getElement(tbl, elementType = "caption"), caption) + expect_equal(getElement(tbl, elementType = "logo"), logo) + tbl <- reactable(data.frame(x = "a", stringsAsFactors = TRUE), - title = "some title", - subtitle = "some subtitle", - caption = "some caption", - logo = "some logo") + subtitle = subtitle, + caption = caption, + logo = logo) + expect_error(getElement(tbl, elementType = "title"), "Table does not have a title element.") })