diff --git a/DESCRIPTION b/DESCRIPTION index ff5a04312e..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"), @@ -69,13 +69,14 @@ Imports: evaluate (>= 0.8), base64enc, jsonlite, - tibble, - rprojroot + rprojroot, + methods 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..e2edae9e91 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,6 +73,6 @@ export(tufte_handout) export(word_document) export(yaml_front_matter) import(htmltools) +import(methods) 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..60ffaf6d24 100644 --- a/R/html_paged.R +++ b/R/html_paged.R @@ -1,3 +1,91 @@ +# 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 + } + + 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) + } + + 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("") + + paste0(" [", dim_desc(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 @@ -18,7 +106,7 @@ paged_table_html <- function(x) { function(columnIdx) { column <- data[[columnIdx]] baseType <- class(column)[[1]] - tibbleType <- tibble::type_sum(column) + tibbleType <- paged_table_type_sum(column) list( label = if (!is.null(columnNames)) columnNames[[columnIdx]] else "", @@ -51,7 +139,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 <- paged_table_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") 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}