From 100b382a58e1b1732e141799dd05eac54286b85f Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 15:35:09 -0700 Subject: [PATCH 1/8] remove dependency to tibble --- DESCRIPTION | 4 +-- NAMESPACE | 1 - R/html_notebook.R | 1 - R/html_paged.R | 83 +++++++++++++++++++++++++++++++++++++++++++++-- R/render.R | 6 +++- 5 files changed, 88 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ff5a04312e..cdeba7e31c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -69,13 +69,13 @@ Imports: evaluate (>= 0.8), base64enc, jsonlite, - tibble, rprojroot Suggests: shiny (>= 0.11), tufte, testthat, - digest + digest, + tibble SystemRequirements: pandoc (>= 1.12.3) - http://pandoc.org URL: http://rmarkdown.rstudio.com License: GPL-3 diff --git a/NAMESPACE b/NAMESPACE index 893dd79d43..a363e25f73 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -74,5 +74,4 @@ export(word_document) export(yaml_front_matter) import(htmltools) import(rprojroot) -import(tibble) importFrom(evaluate,evaluate) diff --git a/R/html_notebook.R b/R/html_notebook.R index 91813499b3..4f962e793d 100644 --- a/R/html_notebook.R +++ b/R/html_notebook.R @@ -16,7 +16,6 @@ #' \code{html_notebook}, see \href{http://rmarkdown.rstudio.com/r_notebook_format.html}{http://rmarkdown.rstudio.com/r_notebook_format.html}. #' #' @importFrom evaluate evaluate -#' @import tibble #' @export html_notebook <- function(toc = FALSE, toc_depth = 3, diff --git a/R/html_paged.R b/R/html_paged.R index 73ee439bea..a6eb92cbb4 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -1,4 +1,83 @@ paged_table_html <- function(x) { + "%||%" <- function(x, y) { + if(is.null(x)) y else x + } + + big_mark <- function(x, ...) { + mark <- if (identical(getOption("OutDec"), ",")) "." else "," + formatC(x, big.mark = mark, ...) + } + + dim_desc <- function(x) { + dim <- dim(x) %||% length(x) + format_dim <- vapply(dim, big_mark, character(1)) + format_dim[is.na(dim)] <- "??" + paste0(format_dim, collapse = " \u00d7 ") + } + + is_atomic <- function(x) { + is.atomic(x) && !is.null(x) + } + + is_vector <- function(x) { + is_atomic(x) || is.list(x) + } + + is_vector_s3 <- function(x) UseMethod("is_vector_s3") + is_vector_s3.ordered <- function(x) TRUE + is_vector_s3.factor <- function(x) TRUE + is_vector_s3.Date <- function(x) TRUE + is_vector_s3.POSIXct <- function(x) TRUE + is_vector_s3.difftime <- function(x) TRUE + is_vector_s3.data.frame <- function(x) TRUE + is_vector_s3.default <- function(x) !is.object(x) && is_vector(x) + + size_sum <- function(x) { + if (!is_vector_s3(x)) return("") + + paste0(" [", dim_desc(x), "]" ) + } + + obj_sum <- function(x) { + switch(class(x)[[1]], + POSIXlt = rep("POSIXlt", length(x)), + list = vapply(x, obj_sum, character(1L)), + paste0(.rs.dataCaptureFormatType(x), size_sum(x)) + ) + } + + type_sum <- function(x) + { + format_sum <- switch (class(x)[[1]], + ordered = "ord", + factor = "fctr", + POSIXt = "dttm", + difftime = "time", + Date = date, + data.frame = class(x)[[1]], + tbl_df = "tibble", + NULL + ) + if (!is.null(format_sum)) { + format_sum + } else if (!is.object(x)) { + switch(typeof(x), + logical = "lgl", + integer = "int", + double = "dbl", + character = "chr", + complex = "cplx", + closure = "fun", + environment = "env", + typeof(x) + ) + } else if (!isS4(x)) { + paste0("S3: ", class(x)[[1]]) + } else { + paste0("S4: ", methods::is(x)[[1]]) + } + } + addRowNames = .row_names_info(data, type = 1) > 0 maxPrint <- getOption("max.print", 1000) @@ -18,7 +97,7 @@ paged_table_html <- function(x) { function(columnIdx) { column <- data[[columnIdx]] baseType <- class(column)[[1]] - tibbleType <- tibble::type_sum(column) + tibbleType <- type_sum(column) list( label = if (!is.null(columnNames)) columnNames[[columnIdx]] else "", @@ -51,7 +130,7 @@ paged_table_html <- function(x) { is_list <- vapply(data, is.list, logical(1)) data[is_list] <- lapply(data[is_list], function(x) { - summary <- tibble::obj_sum(x) + summary <- obj_sum(x) paste0("<", summary, ">") }) diff --git a/R/render.R b/R/render.R index bbc20734ee..a692fd7bc8 100644 --- a/R/render.R +++ b/R/render.R @@ -802,8 +802,12 @@ resolve_df_print <- function(df_print) { if (!is.function(df_print)) { if (df_print == "kable") df_print <- knitr::kable - else if (df_print == "tibble") + else if (df_print == "tibble") { + if (!requireNamespace("tibble", quietly = TRUE)) + stop("Printing 'tibble' without 'tibble' package available") + df_print <- function(x) print(tibble::as_tibble(x)) + } else if (df_print == "paged") df_print <- function(x) knitr::asis_output(paged_table_html(x)) else if (df_print == "default") From fdc27466ca29f75b825ef0b78eb7bd08a8dfc0c9 Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 16:18:12 -0700 Subject: [PATCH 2/8] use type_sum for obj_sum while formatting paged table --- R/html_paged.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/html_paged.R b/R/html_paged.R index a6eb92cbb4..55041be561 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -38,14 +38,6 @@ paged_table_html <- function(x) { paste0(" [", dim_desc(x), "]" ) } - obj_sum <- function(x) { - switch(class(x)[[1]], - POSIXlt = rep("POSIXlt", length(x)), - list = vapply(x, obj_sum, character(1L)), - paste0(.rs.dataCaptureFormatType(x), size_sum(x)) - ) - } - type_sum <- function(x) { format_sum <- switch (class(x)[[1]], @@ -78,6 +70,14 @@ paged_table_html <- function(x) { } } + obj_sum <- function(x) { + switch(class(x)[[1]], + POSIXlt = rep("POSIXlt", length(x)), + list = vapply(x, obj_sum, character(1L)), + paste0(type_sum(x), size_sum(x)) + ) + } + addRowNames = .row_names_info(data, type = 1) > 0 maxPrint <- getOption("max.print", 1000) From bd59b4ff7eafcb77be936f91cc2ec2c49199ccc1 Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 18:45:48 -0700 Subject: [PATCH 3/8] add methods to imports --- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/html_paged.R | 1 + man/shiny_prerendered_server_start_code.Rd | 4 ++-- 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cdeba7e31c..5dfb921110 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -69,7 +69,8 @@ Imports: evaluate (>= 0.8), base64enc, jsonlite, - rprojroot + rprojroot, + methods Suggests: shiny (>= 0.11), tufte, diff --git a/NAMESPACE b/NAMESPACE index a363e25f73..e2edae9e91 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,5 +73,6 @@ export(tufte_handout) export(word_document) export(yaml_front_matter) import(htmltools) +import(methods) import(rprojroot) importFrom(evaluate,evaluate) diff --git a/R/html_paged.R b/R/html_paged.R index 55041be561..b7a6863bda 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -1,3 +1,4 @@ +#' @import methods paged_table_html <- function(x) { "%||%" <- function(x, y) { if(is.null(x)) y else x diff --git a/man/shiny_prerendered_server_start_code.Rd b/man/shiny_prerendered_server_start_code.Rd index f856883f67..0da168e9a6 100644 --- a/man/shiny_prerendered_server_start_code.Rd +++ b/man/shiny_prerendered_server_start_code.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/shiny_prerendered.R \name{shiny_prerendered_server_start_code} \alias{shiny_prerendered_server_start_code} -\title{Get the initialization code for a shiny_prerendered server instance} +\title{Get the server startup code for a shiny_prerendered server instance} \usage{ shiny_prerendered_server_start_code(server_envir) } @@ -10,7 +10,7 @@ shiny_prerendered_server_start_code(server_envir) \item{server_envir}{Shiny server environment to get code for} } \description{ -Get the initialization code for a shiny_prerendered server instance +Get the server startup code for a shiny_prerendered server instance } \keyword{internal} From 1c4cd5bf9c42b8b1e6d7328fc667d5b7acadabd9 Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 18:50:59 -0700 Subject: [PATCH 4/8] refactored type_sum into paged_table_type_sum for reuse --- R/html_paged.R | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/R/html_paged.R b/R/html_paged.R index b7a6863bda..56184d60e8 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -1,5 +1,6 @@ -#' @import methods -paged_table_html <- function(x) { +# paged_table_type_sum and paged_table_obj_sum should be replaced +# by tibble::type_sum once tibble supports R 3.0.0. +paged_table_type_sum <- function(x) { "%||%" <- function(x, y) { if(is.null(x)) y else x } @@ -71,14 +72,19 @@ paged_table_html <- function(x) { } } - obj_sum <- function(x) { - switch(class(x)[[1]], - POSIXlt = rep("POSIXlt", length(x)), - list = vapply(x, obj_sum, character(1L)), - paste0(type_sum(x), size_sum(x)) - ) - } + type_sum(x) +} +paged_table_obj_sum <- function(x) { + switch(class(x)[[1]], + POSIXlt = rep("POSIXlt", length(x)), + list = vapply(x, paged_table_obj_sum, character(1L)), + paste0(paged_table_type_sum(x), size_sum(x)) + ) +} + +#' @import methods +paged_table_html <- function(x) { addRowNames = .row_names_info(data, type = 1) > 0 maxPrint <- getOption("max.print", 1000) @@ -98,7 +104,7 @@ paged_table_html <- function(x) { function(columnIdx) { column <- data[[columnIdx]] baseType <- class(column)[[1]] - tibbleType <- type_sum(column) + tibbleType <- paged_table_type_sum(column) list( label = if (!is.null(columnNames)) columnNames[[columnIdx]] else "", @@ -131,7 +137,7 @@ paged_table_html <- function(x) { is_list <- vapply(data, is.list, logical(1)) data[is_list] <- lapply(data[is_list], function(x) { - summary <- obj_sum(x) + summary <- paged_table_obj_sum(x) paste0("<", summary, ">") }) From f973b8bc664217fa6441cfd2edac62a8ee79beaa Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 19:03:18 -0700 Subject: [PATCH 5/8] refactor paged_table_obj_sum --- R/html_paged.R | 72 +++++++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/R/html_paged.R b/R/html_paged.R index 56184d60e8..8972187f75 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -1,6 +1,42 @@ # paged_table_type_sum and paged_table_obj_sum should be replaced # by tibble::type_sum once tibble supports R 3.0.0. paged_table_type_sum <- function(x) { + type_sum <- function(x) + { + format_sum <- switch (class(x)[[1]], + ordered = "ord", + factor = "fctr", + POSIXt = "dttm", + difftime = "time", + Date = date, + data.frame = class(x)[[1]], + tbl_df = "tibble", + NULL + ) + if (!is.null(format_sum)) { + format_sum + } else if (!is.object(x)) { + switch(typeof(x), + logical = "lgl", + integer = "int", + double = "dbl", + character = "chr", + complex = "cplx", + closure = "fun", + environment = "env", + typeof(x) + ) + } else if (!isS4(x)) { + paste0("S3: ", class(x)[[1]]) + } else { + paste0("S4: ", methods::is(x)[[1]]) + } + } + + type_sum(x) +} + +paged_table_obj_sum <- function(x) { "%||%" <- function(x, y) { if(is.null(x)) y else x } @@ -40,42 +76,6 @@ paged_table_type_sum <- function(x) { paste0(" [", dim_desc(x), "]" ) } - type_sum <- function(x) - { - format_sum <- switch (class(x)[[1]], - ordered = "ord", - factor = "fctr", - POSIXt = "dttm", - difftime = "time", - Date = date, - data.frame = class(x)[[1]], - tbl_df = "tibble", - NULL - ) - if (!is.null(format_sum)) { - format_sum - } else if (!is.object(x)) { - switch(typeof(x), - logical = "lgl", - integer = "int", - double = "dbl", - character = "chr", - complex = "cplx", - closure = "fun", - environment = "env", - typeof(x) - ) - } else if (!isS4(x)) { - paste0("S3: ", class(x)[[1]]) - } else { - paste0("S4: ", methods::is(x)[[1]]) - } - } - - type_sum(x) -} - -paged_table_obj_sum <- function(x) { switch(class(x)[[1]], POSIXlt = rep("POSIXlt", length(x)), list = vapply(x, paged_table_obj_sum, character(1L)), From 5ff2c1856c7f372d9535abf7438825d64c251a97 Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 19:06:29 -0700 Subject: [PATCH 6/8] prevent ns clash by renaming is_vector_s3 fix call to is_vector --- R/html_paged.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/html_paged.R b/R/html_paged.R index 8972187f75..282fa99e38 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -61,17 +61,17 @@ paged_table_obj_sum <- function(x) { is_atomic(x) || is.list(x) } - is_vector_s3 <- function(x) UseMethod("is_vector_s3") - is_vector_s3.ordered <- function(x) TRUE - is_vector_s3.factor <- function(x) TRUE - is_vector_s3.Date <- function(x) TRUE - is_vector_s3.POSIXct <- function(x) TRUE - is_vector_s3.difftime <- function(x) TRUE - is_vector_s3.data.frame <- function(x) TRUE - is_vector_s3.default <- function(x) !is.object(x) && is_vector(x) + paged_table_is_vector_s3 <- function(x) UseMethod("paged_table_is_vector_s3") + paged_table_is_vector_s3.ordered <- function(x) TRUE + paged_table_is_vector_s3.factor <- function(x) TRUE + paged_table_is_vector_s3.Date <- function(x) TRUE + paged_table_is_vector_s3.POSIXct <- function(x) TRUE + paged_table_is_vector_s3.difftime <- function(x) TRUE + paged_table_is_vector_s3.data.frame <- function(x) TRUE + paged_table_is_vector_s3.default <- function(x) !is.object(x) && is_vector(x) size_sum <- function(x) { - if (!is_vector_s3(x)) return("") + if (!paged_table_is_vector_s3(x)) return("") paste0(" [", dim_desc(x), "]" ) } From aee62900658e1579754ea676f70ff5891bac4479 Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Wed, 2 Nov 2016 19:06:36 -0700 Subject: [PATCH 7/8] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5dfb921110..a20779180b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rmarkdown Type: Package Title: Dynamic Documents for R -Version: 1.1.9012 +Version: 1.1.9013 Authors@R: c( person("JJ", "Allaire", role = c("aut", "cre"), email = "jj@rstudio.com"), person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"), From 415b0bc6820bf8eb9a1cd05e91e235469e869d08 Mon Sep 17 00:00:00 2001 From: Javier Luraschi Date: Thu, 3 Nov 2016 10:12:43 -0700 Subject: [PATCH 8/8] avoid using s3 within method --- R/html_paged.R | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/R/html_paged.R b/R/html_paged.R index 282fa99e38..60ffaf6d24 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -61,14 +61,16 @@ paged_table_obj_sum <- function(x) { is_atomic(x) || is.list(x) } - paged_table_is_vector_s3 <- function(x) UseMethod("paged_table_is_vector_s3") - paged_table_is_vector_s3.ordered <- function(x) TRUE - paged_table_is_vector_s3.factor <- function(x) TRUE - paged_table_is_vector_s3.Date <- function(x) TRUE - paged_table_is_vector_s3.POSIXct <- function(x) TRUE - paged_table_is_vector_s3.difftime <- function(x) TRUE - paged_table_is_vector_s3.data.frame <- function(x) TRUE - paged_table_is_vector_s3.default <- function(x) !is.object(x) && is_vector(x) + paged_table_is_vector_s3 <- function(x) { + switch(class(x)[[1]], + ordered = TRUE, + factor = TRUE, + Date = TRUE, + POSIXct = TRUE, + difftime = TRUE, + data.frame = TRUE, + !is.object(x) && is_vector(x)) + } size_sum <- function(x) { if (!paged_table_is_vector_s3(x)) return("")