Created
April 29, 2020 04:49
-
-
Save thebioengineer/2d3ab16aecfccd3e18d60735b9206aba to your computer and use it in GitHub Desktop.
Identifying potential issue with inline printing in tables
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
--- | |
title: "R Notebook" | |
output: html_notebook | |
editor_options: | |
chunk_output_type: inline | |
--- | |
```{r setup} | |
library(tibble) | |
# sample class that should always render as uppercase | |
#' @export | |
as_print_upper <- function(x){ | |
structure( x, class = c("PRINT_UPPER")) | |
} | |
#' @export | |
is_notebook <- function(){ | |
is_notebook_val <- isTRUE(getOption("rstudio.notebook.executing")) | |
if (interactive() & !is_notebook_val) { | |
"1" | |
} else if (is_notebook_val) { | |
"2" | |
} else{ | |
"3" | |
} | |
} | |
#' @export | |
print.PRINT_UPPER <- function(x,..., notebook = is_notebook()){ | |
cat(format(x,..., notebook = notebook)) | |
invisible(x) | |
} | |
#' @export | |
format.PRINT_UPPER <- function(x, ..., notebook = is_notebook()) { | |
func <- switch(notebook, | |
"1" = toupper, | |
"2" = tolower, | |
"3" = function(z){paste(z, "NEW VALUES")} | |
) | |
func(x) | |
} | |
#convert to data.frame | |
#' @export | |
as.data.frame.PRINT_UPPER <- function (x, row.names = NULL, optional = FALSE, ...){ | |
nm = paste(deparse(substitute(x), width.cutoff = 500L), collapse = " ") | |
force(nm) | |
nrows <- length(x) | |
x <- list(x) | |
if (is.null(row.names)) { | |
if (nrows == 0L) | |
row.names <- character() | |
else if (length(row.names <- names(x)) != nrows || anyDuplicated(row.names)) | |
row.names <- .set_row_names(nrows) | |
} | |
if (!is.null(names(x))) | |
names(x) <- NULL | |
if (!optional) | |
names(x) <- nm | |
structure(x, row.names = row.names, class = "data.frame") | |
} | |
``` | |
```{r printing} | |
my_obj <- as_print_upper(c("val1","VAL2","val3")) | |
# with inline turned on, should print all lower case | |
# with inline turned off, should print all upper case | |
my_obj | |
z <- tibble( | |
col = my_obj, | |
val = 1:3 | |
) | |
sapply(z, class) | |
# cases are not respected when printing in line, and class of field | |
# 'col' is marked as character, not class "PRINT_UPPER" in paged_table | |
# and not respecting format... | |
z | |
``` |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment