repr/0000755000175100001440000000000013016103555011237 5ustar hornikusersrepr/tests/0000755000175100001440000000000012701751631012405 5ustar hornikusersrepr/tests/testthat.R0000644000175100001440000000006412701751631014370 0ustar hornikuserslibrary(testthat) library(repr) test_check('repr') repr/tests/testthat/0000755000175100001440000000000013016103555014241 5ustar hornikusersrepr/tests/testthat/test_repr_packageIQR.r0000644000175100001440000000202212745104067020465 0ustar hornikuserscontext('reprs of packageIQR') options(stringsAsFactors = FALSE) test_that('repr_html outputs the right html code', { x = vignette() html = repr_html(x) # reprs must return length 1 strings expect_identical(length(html), 1L) expect_is(html, 'character') # test the content no_vignettes_found = '

Vignettes

\n

No vignettes found

\n' expect_true(nchar(html) > nchar(no_vignettes_found)) # there should be at least a few vignettes expect_identical(repr_html(vignette(package = 'repr')), no_vignettes_found) # we don't want to output the LibPath column expect_false(grepl('LibPath', html)) }) test_that('repr_text outputs the right text', { x = vignette() txt = repr_text(x) # reprs must return length 1 strings expect_identical(length(txt), 1L) expect_is(txt, 'character') # test the content no_vignettes_found = 'no vignettes found' expect_true(nchar(txt) > nchar(no_vignettes_found)) # there should be at least a few vignettes expect_identical(repr_text(vignette(package = 'repr')), no_vignettes_found) }) repr/tests/testthat/test_vector.r0000644000175100001440000000213712753563626017010 0ustar hornikuserscontext('Vectors') test_that('empty vectors display correctly', { expect_identical(repr_html(logical(0L)), '') }) test_that('1 element vectors display correctly', { expect_identical(repr_html(1), '1') }) test_that('plain vectors display correctly', { expect_identical(repr_html(c(1, 2)), '
    \t
  1. 1
    2. \t
  2. 2
') }) test_that('named vectors display correctly', { expect_identical(repr_html(c(a = 1, b = 2)), '
\t
a
\t\t
1
\t
b
\t\t
2
') }) test_that('factors display correctly', { expect_identical(repr_html(factor(c('a', 'b'))), '
    \t
  1. a
    2. \t
  2. b
') }) test_that('Dates display correctly', { expect_identical(repr_html(as.Date('1111-11-11')), '') }) test_that('Date vectors display correctly', { expect_identical(repr_html(c(as.Date('1111-11-11'), as.Date('1212-12-12'))), '
    \t
    2. \t
') }) repr/tests/testthat/test_list.r0000644000175100001440000000102412717557442016452 0ustar hornikuserscontext('Lists') test_that('plain lists display correctly', { expect_identical(repr_html(list(1, 2)), '
    \t
  1. 1
    2. \t
  2. 2
') }) test_that('named lists display correctly', { expect_identical(repr_html(list(a = 1, b = 2)), '
\t
$a
\t\t
1
\t
$b
\t\t
2
') }) test_that('lists with unknown element types don’t display', { methods::setClass('__unknown', methods::representation(n = 'character')) expect_identical(repr_html(list(1, methods::new('__unknown'))), NULL) }) repr/tests/testthat/test_escaping.r0000644000175100001440000001612312745112424017262 0ustar hornikuserscontext('LaTeX and HTML escaping') has_dt <- requireNamespace('data.table', quietly = TRUE) has_dplyr <- requireNamespace('dplyr', quietly = TRUE) expect_equivalent_string <- function(result, expectation){ "Only use ' as a string delimiter in strings." expect_identical(gsub('"', "'", x = result), expectation) } test_that('simple LaTeX escaping works', { expect_identical(latex_escape('\\'), '\\textbackslash{}') expect_identical(latex_escape('{}'), '\\{\\}') expect_identical(latex_escape('$'), '\\$') expect_identical(latex_escape('^'), '\\textasciicircum{}') expect_identical(latex_escape('_'), '\\_') expect_identical(latex_escape('%'), '\\%') expect_identical(latex_escape('#'), '\\#') expect_identical(latex_escape('&'), '\\&') expect_identical(latex_escape('~'), '\\textasciitilde{}') expect_identical(latex_escape('|'), '\\textbar{}') expect_identical(latex_escape('[]'), '{[}{]}') }) test_that('simple HTML escaping works', { expect_identical(html_escape('&'), '&') expect_identical(html_escape('<'), '<') expect_identical(html_escape('>'), '>') }) test_that('LaTeX escaping in vectors works', { expect_equivalent_string(repr_latex('['), "'{[}'") expect_equivalent_string(repr_latex(c('[', '|')), "\\begin{enumerate*} \\item '{[}' \\item '\\textbar{}' \\end{enumerate*} ") }) test_that('HTML escaping in vectors works', { expect_equivalent_string(repr_html('<'), "'<'") expect_equivalent_string(repr_html(c('<', '&')), "
    \t
  1. '<'
    2. \t
  2. '&'
") }) test_that('LaTeX escaping in matrices works', { expect_identical(repr_latex(matrix(c('[', '{', '%', '#'), 2, 2, TRUE)), '\\begin{tabular}{ll} \t {[} & \\{\\\\ \t \\% & \\#\\\\ \\end{tabular} ') expect_identical(repr_latex(matrix(c(']', '}', '&', '_'), 2, 2, TRUE, list(c('$', '#'), c('%', '|')))), '\\begin{tabular}{r|ll} & \\% & \\textbar{}\\\\ \\hline \t\\$ & {]} & \\}\\\\ \t\\# & \\& & \\_\\\\ \\end{tabular} ') }) test_that('HTML escaping in matrices works', { expect_identical(repr_html(matrix(c('[', '{', '%', '#'), 2, 2, TRUE)), ' \t \t
[{
%#
') expect_identical(repr_html(matrix(c(']', '}', '&', '_'), 2, 2, TRUE, list(c('$', '#'), c('%', '|')))), ' \t \t
%|
$]}
#&_
') }) test_that('LaTeX escaping in lists works', { expect_equivalent_string(repr_latex(list(lbr = '[')), "\\textbf{\\$lbr} = '{[}'") expect_equivalent_string(repr_latex(list(`&` = '%')), "\\textbf{\\$`\\&`} = '\\%'") }) test_that('HTML escaping in lists works', { expect_equivalent_string(repr_html(list(lt = '<')), "$lt = '<'") expect_equivalent_string(repr_html(list(`&` = '<')), "$`&` = '<'") }) test_that('Factors are maintained in small arrays for text', { df <- data.frame(a = 1:4, b = factor(1:4, levels = 1:4, labels = c("A", "B", "C", "D"))) expected <- " a b\n1 1 A\n2 2 B\n3 3 C\n4 4 D" expect_identical(repr_text(df), expected) if (has_dt) { dt <- data.table::as.data.table(df) answer <- repr_text(dt) expect_identical(answer, expected) } if (has_dplyr) { dtbl <- dplyr::as.tbl(df) answer <- repr_text(dtbl) expect_identical(answer, expected) } }) test_that('Factors are maintained in small arrays for HTML', { df <- data.frame(a = 1:4, b = factor(1:4, levels = 1:4, labels = c("A", "B", "C", "D"))) # Sometimes extra whitespace is added, different than what I expected. # That's fine, just strip out all white space. expected <- gsub('\\s', '', ' \t \t \t \t
ab
1A
2B
3C
4D
', perl = TRUE) answer <- gsub('\\s', '', repr_html(df), perl = TRUE) expect_identical(answer, expected) if (has_dt) { dt <- data.table::as.data.table(df) answer <- gsub('\\s', '', repr_html(dt), perl = TRUE) expect_identical(answer, expected) } if (has_dplyr) { dtbl <- dplyr::as.tbl(df) answer <- gsub('\\s', '', repr_html(dtbl), perl = TRUE) expect_identical(answer, expected) } }) test_that('Factors are sanitized in small data.frames for HTML', { df <- data.frame(a = 1:4, b = factor(1:4, levels = 1:4, labels = c("A&", "B>", "C", "D"))) # Sometimes extra whitespace is added, different than what I expected. # That's fine, just strip out all white space. expected <- gsub('\\s', '', ' \t \t \t \t
ab
1A&
2B>
3C
4D
', perl = TRUE) answer <- gsub('\\s', '', repr_html(df), perl = TRUE) expect_identical(answer, expected) if (has_dt) { dt <- data.table::as.data.table(df) answer <- gsub('\\s', '', repr_html(df), perl = TRUE) expect_identical(answer, expected) } if (has_dplyr) { dtbl <- dplyr::as.tbl(df) answer <- gsub('\\s', '', repr_html(dtbl), perl = TRUE) expect_identical(answer, expected) } }) test_that('Factors are maintained in small arrays for LaTeX', { df <- data.frame(a = 1:4, b = factor(1:4, levels = 1:4, labels = c("A", "B", "C", "D"))) # Sometimes extra whitespace is added, different than what I expected. # That's fine, just strip out all white space. expected <- gsub('\\s', '', '\\begin{tabular}{r|ll} a & b\\\\ \\hline \t1 & A\\\\ \t2 & B\\\\ \t3 & C\\\\ \t4 & D\\\\ \\end{tabular} ', perl = TRUE) answer <- gsub('\\s', '', repr_latex(df), perl = TRUE) expect_identical(answer, expected) if (has_dt) { dt <- data.table::as.data.table(df) answer <- gsub('\\s', '', repr_latex(dt), perl = TRUE) expect_identical(answer, expected) } if (has_dplyr) { dtbl <- dplyr::as.tbl(df) answer <- gsub('\\s', '', repr_latex(dtbl), perl = TRUE) expect_identical(answer, expected) } }) test_that('Factors are sanitized in small data.frames for LaTeX', { df <- data.frame(a = 1:4, b = factor(1:4, levels = 1:4, labels = c("A&", "B%", "_C_", "D"))) # Sometimes extra whitespace is added, different than what I expected. # That's fine, just strip out all white space. expected <- gsub('\\s', '', '\\begin{tabular}{r|ll} a & b\\\\ \\hline \t1 & A\\&\\\\ \t2 & B\\%\\\\ \t3 & \\_C\\_\\\\ \t4 & D\\\\ \\end{tabular} ', perl = TRUE) answer <- gsub('\\s', '', repr_latex(df), perl = TRUE) expect_identical(answer, expected) if (has_dt) { dt <- data.table::as.data.table(df) answer <- gsub('\\s', '', repr_latex(dt), perl = TRUE) expect_identical(answer, expected) } if (has_dplyr) { dtbl <- dplyr::as.tbl(df) answer <- gsub('\\s', '', repr_latex(dtbl), perl = TRUE) expect_identical(answer, expected) } }) test_that('vector entries with consecutive spaces get wrapped', { v <- c('one space', 'two spaces') expect_identical(repr_html(v), "
    \t
  1. 'one space'
    2. \t
  2. 'two spaces'
") }) repr/tests/testthat/test_array_df.r0000644000175100001440000000250012745112200017242 0ustar hornikuserscontext('Arrays and data.frames') options(stringsAsFactors = FALSE) test_that('empty data.frames work', { expect_identical(repr_html(data.frame()), '') expect_identical(repr_html(as.data.frame(matrix(integer(0L), 1L, 0L))), '') # no data.frame without colnames possible }) test_that('empty matrices work', { expect_identical(repr_html(matrix(integer(0L), 0L, 0L)), '') expect_identical(repr_html(matrix(integer(0L), 1L, 0L)), '') expect_identical(repr_html(matrix(integer(0L), 0L, 1L)), '') }) test_that('factors display correctly', { df = data.frame(a = factor('iamafactor')) expect_identical(repr_html(df), ' \t
a
iamafactor
') }) test_that('mixed factors and strings display correctly', { df = data.frame(a = 'iamastring', b = factor('iamafactor')) expect_true(is.factor(df$b)) expect_identical(repr_html(df), ' \t
ab
iamastringiamafactor
') }) test_that('date display correctly', { df = data.frame(a = as.POSIXct('2016-05-28 10:00:00', tz = 'UTC')) expect_identical(repr_html(df), ' \t
a
2016-05-28 10:00:00
') }) repr/tests/testthat/test_array_manipulation.r0000644000175100001440000003222513016060323021360 0ustar hornikuserscontext('Array and vector truncation') options(stringsAsFactors = FALSE) has_dt <- requireNamespace('data.table', quietly = TRUE) has_dplyr <- requireNamespace('dplyr', quietly = TRUE) #has_dt <- FALSE test_that('max rows and cols are reasonable', { rows <- getOption('repr.matrix.max.rows') cols <- getOption('repr.matrix.max.cols') expect_identical(length(rows), 1L) expect_identical(length(cols), 1L) expect_false(is.null(rows)) expect_false(is.na(rows)) expect_false(is.null(rows)) expect_false(is.na(rows)) expect_true(rows >= 2L) expect_true(cols >= 2L) expect_true(rows < .Machine$integer.max) expect_true(cols < .Machine$integer.max) }) test_that('ellip_limit_arr doesn\'t change arrays that are small', { # Make sure the limits are reasonable before we test. orig_rows_limit <- getOption('repr.matrix.max.rows') orig_cols_limit <- getOption('repr.matrix.max.cols') if (orig_rows_limit < 6L) { options('repr.matrix.max.rows' = 6L) } if (orig_cols_limit < 3L) { options('repr.matrix.max.cols' = 3L) } # Run some tests. test_mat <- matrix(1:10, ncol = 2) test_df <- data.frame(V1 = 1:5, V2 = 6:10) expected_mat <- matrix(c(format(1:5), format(6:10)), ncol = 2) expected_df_mat <- structure(expected_mat, dimnames = list(1:5, c('V1', 'V2'))) limited_mat <- ellip_limit_arr(test_mat) limited_df_mat <- ellip_limit_arr(test_df) expect_identical(limited_mat, expected_mat) expect_identical(limited_df_mat, expected_df_mat) if (has_dt) { test_dt <- data.table::as.data.table(test_mat) limited_dt_mat <- ellip_limit_arr(test_dt) expect_identical(limited_dt_mat, expected_df_mat) } if (has_dplyr) { test_tbl <- dplyr::as.tbl(test_df) limited_tbl_mat <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl_mat, expected_df_mat) } # Reset limits if (getOption('repr.matrix.max.rows') != orig_rows_limit) { options('repr.matrix.max.rows' = orig_rows_limit) } if (getOption('repr.matrix.max.cols') != orig_cols_limit) { options('repr.matrix.max.cols' = orig_cols_limit) } }) test_that('ellip_limit_arr limits arrays that are wide (but not long)', { # Make sure the limits are reasonable before we test. orig_rows_limit <- getOption('repr.matrix.max.rows') orig_cols_limit <- getOption('repr.matrix.max.cols') if (orig_rows_limit < 6L) { options('repr.matrix.max.rows' = 6L) } test_mat <- matrix(16:1, nrow = 2L) test_df <- as.data.frame(test_mat) # We'll test even and odd limits, sticking with small numbers to keep things sane. options('repr.matrix.max.cols' = 4L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c('16', '15', '14', '13', ellip_h, ellip_h, '4', '3', '2', '1'), nrow = 2L) expected_df_mat <- as.matrix(data.frame(V1 = c(16, 15), V2 = c(14, 13), ellips = rep(ellip_h, 2L), V7 = c(4, 3), V8 = c(2, 1))) colnames(expected_df_mat)[[3]] <- ellip_h rownames(expected_df_mat) <- 1:2 # TODO: is this correct or should it rather not have those expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { test_dt <- data.table::as.data.table(test_mat) limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { test_tbl <- dplyr::as.tbl(test_df) limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Repeat with an odd limit. options('repr.matrix.max.cols' = 5L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c('16', '15', '14', '13', '12', '11', ellip_h, ellip_h, '4', '3', '2', '1'), nrow = 2L) expected_df_mat <- as.matrix(data.frame(V1 = c(16, 15), V2 = c(14, 13), V3 = c(12, 11), ellips = rep(ellip_h, 2L), V7 = c(4, 3), V8 = c(2, 1))) colnames(expected_df_mat)[[4]] <- ellip_h rownames(expected_df_mat) <- 1:2 # TODO: see above expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Reset limits if (getOption('repr.matrix.max.rows') != orig_rows_limit) { options('repr.matrix.max.rows' = orig_rows_limit) } if (getOption('repr.matrix.max.cols') != orig_cols_limit) { options('repr.matrix.max.cols' = orig_cols_limit) } }) test_that('ellip_limit_arr limits arrays that are long (but not wide)', { # Make sure the limits are reasonable before we test. orig_rows_limit <- getOption('repr.matrix.max.rows') orig_cols_limit <- getOption('repr.matrix.max.cols') if (orig_cols_limit < 3L) { options('repr.matrix.max.cols' = 3L) } test_mat <- matrix(16:1, ncol = 2L) test_df <- as.data.frame(test_mat) options('repr.matrix.max.rows' = 4L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c( '16', '15', ellip_v, '10', ' 9', '8', '7', ellip_v, '2', '1'), ncol = 2L) expected_df_mat <- as.matrix(data.frame( V1 = c('16', '15', ellip_v, '10', ' 9'), V2 = c('8', '7', ellip_v, '2', '1'))) rownames(expected_df_mat) <- c('1', '2', ellip_v, '7', '8') expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { test_dt <- data.table::as.data.table(test_mat) limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { test_tbl <- dplyr::as.tbl(test_df) limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Repeat with an odd limit. options('repr.matrix.max.rows' = 5L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c( '16', '15', '14', ellip_v, '10', ' 9', '8', '7', '6', ellip_v, '2', '1'), ncol = 2L) expected_df_mat <- as.matrix(data.frame( V1 = c('16', '15', '14', ellip_v, '10', ' 9'), V2 = c('8', '7', '6', ellip_v, '2', '1'))) rownames(expected_df_mat) <- c('1', '2', '3', ellip_v, '7', '8') expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Reset limits if (getOption('repr.matrix.max.rows') != orig_rows_limit) { options('repr.matrix.max.rows' = orig_rows_limit) } if (getOption('repr.matrix.max.cols') != orig_cols_limit) { options('repr.matrix.max.cols' = orig_cols_limit) } }) test_that('ellip_limit_arr preserves rownames when limiting rows', { # Make sure the limits are reasonable before we test. orig_rows_limit <- getOption('repr.matrix.max.rows') orig_cols_limit <- getOption('repr.matrix.max.cols') if (orig_cols_limit < 3L) { options('repr.matrix.max.cols' = 3L) } test_mat <- matrix(16:1, ncol = 2L, dimnames = list(letters[1:8], NULL)) test_df <- as.data.frame(test_mat) options('repr.matrix.max.rows' = 4L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_rownames <- c(letters[1:2], ellip_v, letters[7:8]) expected_mat <- matrix(c( '16', '15', ellip_v, '10', ' 9', '8', '7', ellip_v, '2', '1'), ncol = 2L, dimnames = list(expected_rownames, NULL)) expected_df_mat <- as.matrix(data.frame( V1 = c('16', '15', ellip_v, '10', ' 9'), V2 = c('8', '7', ellip_v, '2', '1'), row.names = expected_rownames)) expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { test_dt <- data.table::as.data.table(test_mat) rownames(test_dt) <- rownames(test_mat) # force keeping rownames limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { test_tbl <- dplyr::as.tbl(test_df) limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Repeat with an odd limit. options('repr.matrix.max.rows' = 5L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_rownames <- c(letters[1:3], ellip_v, letters[7:8]) expected_mat <- matrix(c( '16', '15', '14', ellip_v, '10', ' 9', '8', '7', '6', ellip_v, '2', '1'), ncol = 2L, dimnames = list(expected_rownames, NULL)) expected_df_mat <- as.matrix(data.frame( V1 = c('16', '15', '14', ellip_v, '10', ' 9'), V2 = c('8', '7', '6', ellip_v, '2', '1'), row.names = expected_rownames)) expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Reset limits if (getOption('repr.matrix.max.rows') != orig_rows_limit) { options('repr.matrix.max.rows' = orig_rows_limit) } if (getOption('repr.matrix.max.cols') != orig_cols_limit) { options('repr.matrix.max.cols' = orig_cols_limit) } }) test_that('ellip_limit_arr limits arrays that are long and wide', { # Make sure the limits are reasonable before we test. orig_rows_limit <- getOption('repr.matrix.max.rows') orig_cols_limit <- getOption('repr.matrix.max.cols') # Make a 7x7 because I want to test with limits of 4, 5 and 6. I want to test # both the normal cases and the weird case where a dimension is one less than # the limit (and therefore the 'smaller' output array is actually the same dim # as the original) test_mat <- matrix(1:49, ncol = 7) test_df <- as.data.frame(test_mat) # We'll test with even and odd limits (but not all combinations of the two) # Test with small numbers to keep things reasonable. options('repr.matrix.max.rows' = 4L) options('repr.matrix.max.cols' = 4L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c( '1', '2', ellip_v, '6', '7', '8', '9', ellip_v, '13', '14', ellip_h, ellip_h, ellip_d, ellip_h, ellip_h, '36', '37', ellip_v, '41', '42', '43', '44', ellip_v, '48', '49'), nrow = 5L) expected_df_mat <- as.matrix(as.data.frame(expected_mat)) colnames(expected_df_mat) <- c('V1', 'V2', ellip_h, 'V6', 'V7') rownames(expected_df_mat) <- c('1', '2', ellip_v, '6', '7') expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { test_dt <- data.table::as.data.table(test_mat) limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { test_tbl <- dplyr::as.tbl(test_df) limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } options('repr.matrix.max.rows' = 5L) options('repr.matrix.max.cols' = 5L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c( '1', '2', '3', ellip_v, '6', '7', ' 8', ' 9', '10', ellip_v, '13', '14', '15', '16', '17', ellip_v, '20', '21', ellip_h, ellip_h, ellip_h, ellip_d, ellip_h, ellip_h, '36', '37', '38', ellip_v,'41', '42', '43', '44', '45', ellip_v, '48', '49'), nrow = 6L) expected_df_mat <- as.matrix(as.data.frame(expected_mat)) colnames(expected_df_mat) <- c('V1', 'V2', 'V3', ellip_h, 'V6', 'V7') rownames(expected_df_mat) <- c('1', '2', '3', ellip_v, '6', '7') expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } options('repr.matrix.max.rows' = 6L) options('repr.matrix.max.cols' = 6L) limited_mat <- ellip_limit_arr(test_mat) limited_df <- ellip_limit_arr(test_df) expected_mat <- matrix(c( '1', '2', '3', ellip_v, '5', '6', '7', ' 8', ' 9', '10', ellip_v, '12', '13', '14', '15', '16', '17', ellip_v, '19', '20', '21', ellip_h, ellip_h, ellip_h, ellip_d, ellip_h, ellip_h, ellip_h, '29', '30', '31', ellip_v, '33', '34', '35', '36', '37', '38', ellip_v, '40', '41', '42', '43', '44', '45', ellip_v, '47', '48', '49'), nrow = 7L) expected_df_mat <- as.matrix(as.data.frame(expected_mat, stringsAsFactors = FALSE)) colnames(expected_df_mat) <- c('V1', 'V2', 'V3', ellip_h, 'V5', 'V6', 'V7') rownames(expected_df_mat) <- c('1', '2', '3', ellip_v, '5', '6', '7') expect_identical(limited_mat, expected_mat) expect_identical(limited_df, expected_df_mat) if (has_dt) { limited_dt <- ellip_limit_arr(test_dt) expect_identical(limited_dt, expected_df_mat) } if (has_dplyr) { limited_tbl <- ellip_limit_arr(test_tbl) expect_identical(limited_tbl, expected_df_mat) } # Reset limits if (getOption('repr.matrix.max.rows') != orig_rows_limit) { options('repr.matrix.max.rows' = orig_rows_limit) } if (getOption('repr.matrix.max.cols') != orig_cols_limit) { options('repr.matrix.max.cols' = orig_cols_limit) } }) repr/NAMESPACE0000644000175100001440000000454613016062243012465 0ustar hornikusers# Generated by roxygen2: do not edit by hand S3method(repr_html,"function") S3method(repr_html,Date) S3method(repr_html,character) S3method(repr_html,complex) S3method(repr_html,data.frame) S3method(repr_html,default) S3method(repr_html,factor) S3method(repr_html,help_files_with_topic) S3method(repr_html,htmlwidget) S3method(repr_html,integer) S3method(repr_html,list) S3method(repr_html,logical) S3method(repr_html,matrix) S3method(repr_html,numeric) S3method(repr_html,packageIQR) S3method(repr_javascript,default) S3method(repr_jpg,default) S3method(repr_jpg,recordedplot) S3method(repr_json,default) S3method(repr_latex,"function") S3method(repr_latex,Date) S3method(repr_latex,character) S3method(repr_latex,complex) S3method(repr_latex,data.frame) S3method(repr_latex,default) S3method(repr_latex,factor) S3method(repr_latex,help_files_with_topic) S3method(repr_latex,integer) S3method(repr_latex,list) S3method(repr_latex,logical) S3method(repr_latex,matrix) S3method(repr_latex,numeric) S3method(repr_markdown,"function") S3method(repr_markdown,Date) S3method(repr_markdown,character) S3method(repr_markdown,complex) S3method(repr_markdown,data.frame) S3method(repr_markdown,default) S3method(repr_markdown,factor) S3method(repr_markdown,integer) S3method(repr_markdown,list) S3method(repr_markdown,logical) S3method(repr_markdown,matrix) S3method(repr_markdown,numeric) S3method(repr_pdf,default) S3method(repr_pdf,recordedplot) S3method(repr_png,default) S3method(repr_png,recordedplot) S3method(repr_svg,default) S3method(repr_svg,recordedplot) S3method(repr_text,data.frame) S3method(repr_text,default) S3method(repr_text,help_files_with_topic) S3method(repr_text,htmlwidget) S3method(repr_text,matrix) S3method(repr_text,packageIQR) S3method(repr_text,recordedplot) export(format2repr) export(mime2repr) export(repr) export(repr_html) export(repr_javascript) export(repr_jpg) export(repr_json) export(repr_latex) export(repr_markdown) export(repr_option_defaults) export(repr_pdf) export(repr_png) export(repr_svg) export(repr_text) importFrom(grDevices,cairo_pdf) importFrom(grDevices,dev.off) importFrom(grDevices,jpeg) importFrom(grDevices,pdf) importFrom(grDevices,png) importFrom(grDevices,replayPlot) importFrom(grDevices,svg) importFrom(tools,Rd2HTML) importFrom(tools,Rd2latex) importFrom(tools,Rd2txt) importFrom(utils,capture.output) importFrom(utils,head) importFrom(utils,tail) repr/R/0000755000175100001440000000000013016062243011436 5ustar hornikusersrepr/R/repr_help_files_with_topic.r0000644000175100001440000000477212745100605017231 0ustar hornikusers# override utils:::print.help_files_with_topic #' Representations of help #' #' @param obj Help topic to create a representation for #' @param ... ignored #' #' @aliases repr_text.help_files_with_topic repr_html.help_files_with_topic repr_latex.help_files_with_topic #' @name repr_*.help_files_with_topic NULL fetch_rd_db <- getFromNamespace('fetchRdDB', 'tools') # copy of utils:::.getHelpFile, necessary because CRAN doesn’t like us using ::: get_help_file <- function(file) { path <- dirname(file) dirpath <- dirname(path) if (!file.exists(dirpath)) stop(sprintf('invalid %s argument', sQuote('file'))) pkgname <- basename(dirpath) rd_db <- file.path(path, pkgname) if (!file.exists(paste(rd_db, 'rdx', sep = '.'))) stop(sprintf('package %s exists but was not installed under R >= 2.10.0 so help cannot be accessed', sQuote(pkgname))) fetch_rd_db(rd_db, basename(file)) } #' @importFrom utils capture.output #' @importFrom tools Rd2HTML repr_help_files_with_topic_generic <- function(obj, Rd2_) { topic <- attr(obj, 'topic') #type <- attr(obj, 'type') #should we make this html by setting some option? #tried_all_packages <- attr(obj, 'tried_all_packages') #TODO: handle tried_all_packages paths <- as.character(obj) if (length(paths) == 0) { return(paste(gettextf('No documentation for %s in specified packages and libraries:', sQuote(topic)), gettextf('you could try %s', sQuote(paste0('??', topic))), sep = '\n')) } #TODO: handle multiple file <- paths[[1]] pkgname <- basename(dirname(dirname(file))) rd <- get_help_file(file) output <- capture.output(Rd2_(rd, package = pkgname, outputEncoding = 'UTF-8')) if (identical(Rd2_, Rd2HTML)) { head.end.idx <- which(output == '') body.end.idx <- which(output == '') rm.idx <- c(seq_len(head.end.idx), body.end.idx) output <- output[-rm.idx] } #TODO: replace all the Rd-specific envs in latex paste(output, collapse = '\n') } #' @name repr_*.help_files_with_topic #' @importFrom tools Rd2txt #' @export repr_text.help_files_with_topic <- function(obj, ...) repr_help_files_with_topic_generic(obj, Rd2txt) #' @name repr_*.help_files_with_topic #' @importFrom tools Rd2HTML #' @export repr_html.help_files_with_topic <- function(obj, ...) repr_help_files_with_topic_generic(obj, Rd2HTML) #TODO: markdown #' @name repr_*.help_files_with_topic #' @importFrom tools Rd2latex #' @export repr_latex.help_files_with_topic <- function(obj, ...) repr_help_files_with_topic_generic(obj, Rd2latex) repr/R/repr_recordedplot.r0000644000175100001440000001303212745114270015344 0ustar hornikusersis_cairo_installed <- function() requireNamespace('Cairo', quietly = TRUE) # checking capability of X11 is slow, the short circult logic avoids # this if any other devices are found. check_capability <- function(dev) { devices <- c(dev, 'aqua', 'cairo', 'X11') for (d in devices) { if (capabilities(d)) return(TRUE) } FALSE } plot_title <- function(p, default = NULL) { for (call in rev(p[[1]])) { args <- call[[2]] if (isTRUE(args[[1]]$name == 'C_title') && !is.null(args[[2]])) { return(args[[2]]) } } default } #' Plot representations #' #' \code{repr_text.recordedplot} only returns a small info string containing the title (if any) #' while the others return a character vector (SVG) a raw vector (the rest) containing the image data. #' #' All parameters can also be specified using the eponymous \code{repr.plot.*} \link{repr-options}. #' #' @param obj The plot to create a representation for #' @param width Plot area width in inches (default: 7) #' @param height Plot area height in inches (default: 7) #' @param bg Background color (default: white) #' @param pointsize Text height in pt (default: 12) #' @param antialias Which kind of antialiasing to use for for lines and text? 'gray', 'subpixel' or 'none'? (default: gray) #' @param res For PNG and JPEG, specifies the PPI for rasterization (default: 120) #' @param quality For JPEG, determines the compression quality in \% (default: 90) #' @param family Font family for SVG and PDF. 'sans', 'serif', 'mono' or a specific one (default: sans) #' @param ... ignored #' #' @examples #' dev.new() #' dev.control(displaylist = 'enable') #' plot(sqrt, main = 'Square root') #' p <- recordPlot() #' dev.off() #' #' repr_text(p) #' #' @aliases repr_text.recordedplot repr_png.recordedplot repr_jpg.recordedplot repr_svg.recordedplot repr_pdf.recordedplot #' @name repr_*.recordedplot #' @export repr_text.recordedplot <- function(obj, ...) { title <- plot_title(obj) if (is.null(title)) { 'plot without title' } else { sprintf('Plot with title %s', dQuote(title)) } } #' @importFrom grDevices replayPlot dev.off repr_recordedplot_generic <- function(obj, ext, binary, dev.cb) { tf <- tempfile(fileext = ext) dev.cb(tf) replayPlot(obj) dev.off() if (binary) readBin(tf, raw(), file.info(tf)$size) else readChar(tf, file.info(tf)$size, useBytes = TRUE) } ### BITMAPS ### #' @name repr_*.recordedplot #' @importFrom grDevices png #' @export repr_png.recordedplot <- function(obj, width = getOption('repr.plot.width'), height = getOption('repr.plot.height'), bg = getOption('repr.plot.bg'), pointsize = getOption('repr.plot.pointsize'), antialias = getOption('repr.plot.antialias'), #special res = getOption('repr.plot.res'), ...) { if (!is_cairo_installed() && !check_capability('png')) return(NULL) dev.cb <- function(tf) if (is_cairo_installed()) Cairo::Cairo(width, height, tf, 'png', pointsize, bg, 'transparent', 'in', res) else png(tf, width, height, 'in', pointsize, bg, res, antialias = antialias) repr_recordedplot_generic(obj, '.png', TRUE, dev.cb) } #' @name repr_*.recordedplot #' @importFrom grDevices jpeg #' @export repr_jpg.recordedplot <- function(obj, width = getOption('repr.plot.width'), height = getOption('repr.plot.height'), bg = getOption('repr.plot.bg'), pointsize = getOption('repr.plot.pointsize'), antialias = getOption('repr.plot.antialias'), #special res = getOption('repr.plot.res'), quality = getOption('repr.plot.quality'), ...) { if (!is_cairo_installed() && !check_capability('jpeg')) return(NULL) dev.cb <- function(tf) if (is_cairo_installed()) Cairo::Cairo(width, height, tf, 'jpeg', pointsize, bg, 'transparent', 'in', res, quality = quality) else jpeg(tf, width, height, 'in', pointsize, quality, bg, res, antialias = antialias) repr_recordedplot_generic(obj, '.jpg', TRUE, dev.cb) } ### VECTOR ### #' @name repr_*.recordedplot #' @importFrom grDevices svg #' @export repr_svg.recordedplot <- function(obj, width = getOption('repr.plot.width'), height = getOption('repr.plot.height'), bg = getOption('repr.plot.bg'), pointsize = getOption('repr.plot.pointsize'), antialias = getOption('repr.plot.antialias'), #special family = getOption('repr.plot.family'), ...) { if (!is_cairo_installed() && !capabilities('cairo')) return(NULL) #only cairo can do SVG dev.cb <- function(tf) if (is_cairo_installed()) Cairo::Cairo(width, height, tf, 'svg', pointsize, bg, 'transparent', 'in') else svg(tf, width, height, pointsize, FALSE, family, bg, antialias) repr_recordedplot_generic(obj, '.svg', FALSE, dev.cb) } #' @name repr_*.recordedplot #' @importFrom grDevices cairo_pdf pdf #' @export repr_pdf.recordedplot <- function(obj, width = getOption('repr.plot.width'), height = getOption('repr.plot.height'), bg = getOption('repr.plot.bg'), pointsize = getOption('repr.plot.pointsize'), antialias = getOption('repr.plot.antialias'), #special family = getOption('repr.plot.family'), ...) repr_recordedplot_generic(obj, '.pdf', TRUE, function(tf) { title <- plot_title(obj, 'Untitled plot') if (capabilities('aqua')) # no import since R CMD check would complain grDevices::quartz(title, width, height, pointsize, family, antialias, 'pdf', tf, bg) else if (is_cairo_installed()) Cairo::Cairo(width, height, tf, 'pdf', pointsize, bg, 'transparent', 'in') else if (capabilities('cairo')) cairo_pdf(tf, width, height, pointsize, FALSE, family, bg, antialias) else pdf(tf, width, height, FALSE, family, title, bg = bg, pointsize = pointsize) }) repr/R/repr_matrix_df.r0000644000175100001440000001732213016062243014633 0ustar hornikusers#' Tabular data representations #' #' HTML and LaTeX representations of Matrix-like objects #' #' @param obj The matrix or data.frame to create a representation for #' @param ... ignored #' @param colspec The colspec for the LaTeX table. The default is given by the option \code{repr.matrix.latex.colspec} #' #' @seealso \link{repr-options} for \code{repr.matrix.latex.colspec} #' #' @aliases repr_html.matrix repr_html.data.frame repr_latex.matrix repr_latex.data.frame #' @name repr_*.matrix/data.frame #' @include utils.r NULL # There is currently a problem on windows which can't display chars in th # text/plain output, which are not available in the current locale. # See https://github.com/IRkernel/repr/issues/28#issuecomment-208574856 #' @importFrom utils capture.output .char_fallback <- function(char, default) { real_len <- nchar(char) r_len <- nchar(capture.output(cat(char))) if (real_len == r_len) char else default } ellip_h <- .char_fallback('\u22EF', '...') ellip_v <- .char_fallback('\u22EE', '...') ellip_d <- .char_fallback('\u22F1', '') # These are used for factor, so make sure they are unique ellipses <- unique(c(ellip_h, ellip_v, ellip_d)) arr_partition <- function(a, rows, cols) { stopifnot(rows >= 2L, cols >= 2L) many_rows <- rows < nrow(a) many_cols <- cols < ncol(a) # create sequences of indices to bisect rows and columns if (many_rows) { upper <- seq_len(ceiling(rows / 2)) lower <- seq.int(nrow(a) - floor(rows / 2) + 1L, nrow(a)) } if (many_cols) { left <- seq_len(ceiling(cols / 2)) right <- seq.int(ncol(a) - floor(cols / 2) + 1L, ncol(a)) } # assign a list of parts that can be coerced to strings if (many_rows && many_cols) { structure(list( ul = a[upper, left], ll = a[lower, left], ur = a[upper, right], lr = a[lower, right]), omit = 'both') } else if (many_rows) { structure(list( upper = a[upper, , drop = FALSE], lower = a[lower, , drop = FALSE]), omit = 'rows') } else if (many_cols) { structure(list( left = a[, left, drop = FALSE], right = a[, right, drop = FALSE]), omit = 'cols') } else { structure(list(full = a), omit = 'none') } } arr_parts_format <- function(parts) structure(lapply(parts, arr_part_format), omit = attr(parts, 'omit')) arr_part_format <- function(part) { f_part <- if (is.data.frame(part)) { vapply(part, format, character(nrow(part))) } else { # format(part) would work, but e.g. would left-pad *both* rows of matrix(7:10, 2L) instead of one apply(part, 2L, format) } # vapply returns a vector for 1-column dfs dim(f_part) <- dim(part) dimnames(f_part) <- dimnames(part) f_part } #' @importFrom utils head tail arr_parts_combine <- function(parts, rownms, colnms) { omit <- attr(parts, 'omit') mat <- switch(omit, rows = rbind(parts$upper, ellip_v, parts$lower, deparse.level = 0L), cols = cbind(parts$left, ellip_h, parts$right, deparse.level = 0L), none = parts$full, both = rbind( cbind(parts$ul, ellip_h, parts$ur, deparse.level = 0L), c(rep(ellip_v, ncol(parts$ul)), ellip_d, rep(ellip_v, ncol(parts$ur))), cbind(parts$ll, ellip_h, parts$lr, deparse.level = 0L))) # If there were no dimnames before, as is often true for matrices, don't assign them. if (omit %in% c('rows', 'both') && !is.null(rownms)) { # everything except ellip_v is to fix rownames for tbls, which explicitly set them to 1:n when subsetting rownames(mat) <- c(head(rownms, nrow(parts[[1]])), ellip_v, tail(rownms, nrow(parts[[2]]))) } if (omit %in% c('cols', 'both') && !is.null(colnms)) { colnames(mat)[[ncol(parts[[1]]) + 1L]] <- ellip_h } mat } # returns a character array with optionally a section of columns and rows in the middle replaced by ellipses ellip_limit_arr <- function( a, rows = getOption('repr.matrix.max.rows'), cols = getOption('repr.matrix.max.cols') ) { parts <- arr_partition(a, rows, cols) stopifnot(match('ll', names(parts)) %in% c(NA, 2L)) # lower has to come second if available f_parts <- arr_parts_format(parts) arr_parts_combine(f_parts, rownames(a), colnames(a)) } # HTML -------------------------------------------------------------------- repr_matrix_generic <- function( x, wrap, header_wrap, corner, head, body_wrap, row_wrap, row_head, cell, escape_fun = identity, ..., rows = getOption('repr.matrix.max.rows'), cols = getOption('repr.matrix.max.cols') ) { has_std_df_rownames <- is.data.frame(x) && identical(rownames(x), as.character(seq_len(nrow(x)))) has_rownames <- !is.null(rownames(x)) && nrow(x) > 0 && !has_std_df_rownames has_colnames <- !is.null(colnames(x)) && ncol(x) > 0 if (!has_rownames && !has_colnames && 0L %in% dim(x)) return('') x <- ellip_limit_arr(x, rows, cols) header <- '' if (has_colnames) { headers <- sprintf(head, escape_fun(colnames(x))) if (has_rownames) headers <- c(corner, headers) header <- sprintf(header_wrap, paste(headers, collapse = '')) } rows <- lapply(seq_len(nrow(x)), function(r) { row <- escape_fun(slice_row(x, r)) cells <- sprintf(cell, format(row)) if (has_rownames) { row_head <- sprintf(row_head, escape_fun(rownames(x)[[r]])) cells <- c(row_head, cells) } sprintf(row_wrap, paste(cells, collapse = '')) }) body <- sprintf(body_wrap, paste(rows, collapse = '')) sprintf(wrap, header, body) } #' @name repr_*.matrix/data.frame #' @export repr_html.matrix <- function(obj, ...) repr_matrix_generic( obj, '\n%s%s
\n', '%s\n', '', '%s', '\n%s\n', '\t%s\n', '%s', '%s', escape_fun = html_escape_vec, ...) #' @name repr_*.matrix/data.frame #' @export repr_html.data.frame <- repr_html.matrix # LaTeX ------------------------------------------------------------------- #' @name repr_*.matrix/data.frame #' @export repr_latex.matrix <- function(obj, ..., colspec = getOption('repr.matrix.latex.colspec')) { cols <- paste0(paste(rep(colspec$col, ncol(obj)), collapse = ''), colspec$end) if (!is.null(rownames(obj))) { row_head <- colspec$row_head if (is.null(row_head)) row_head <- colspec$row.head # backwards compat cols <- paste0(colspec$row_head, cols) } r <- repr_matrix_generic( obj, sprintf('\\begin{tabular}{%s}\n%%s%%s\\end{tabular}\n', cols), '%s\\\\\n\\hline\n', ' &', ' %s &', '%s', '\t%s\\\\\n', '%s &', ' %s &', escape_fun = latex_escape_vec, ...) #TODO: remove this quick’n’dirty post processing gsub(' &\\', '\\', r, fixed = TRUE) } #' @name repr_*.matrix/data.frame #' @export repr_latex.data.frame <- repr_latex.matrix # Markdown ------------------------------------------------------------------- #' @name repr_*.matrix/data.frame #' @export repr_markdown.matrix <- function(obj, ...) { rows <- list(...)$rows if (is.null(rows)) rows <- getOption('repr.matrix.max.rows') out_rows <- min(nrow(obj), rows + 1L) underline <- paste(rep('---', out_rows), collapse = '|') repr_matrix_generic( obj, '\n%s%s\n', sprintf('%%s\n|%s|\n', underline), '| | ', '%s | ', '%s\n', '| %s\n', '%s | ', '%s | ', escape_fun = identity, # TODO ..., rows = rows) } #' @name repr_*.matrix/data.frame #' @export repr_markdown.data.frame <- repr_markdown.matrix # Text ------------------------------------------------------------------- #' @name repr_*.matrix/data.frame #' @importFrom utils capture.output #' @export repr_text.matrix <- function(obj, ...) { if (inherits(obj, c('tbl', 'data.table'))) { # Coerce to data.frame to avoid special printing in dplyr and data.table. obj <- as.data.frame(obj) } limited_obj <- ellip_limit_arr(obj, ...) print_output <- capture.output(print(limited_obj, quote = FALSE)) paste(print_output, collapse = '\n') } #' @name repr_*.matrix/data.frame #' @export repr_text.data.frame <- repr_text.matrix repr/R/package.r0000644000175100001440000000057212575256653013243 0ustar hornikusers#' The repr package #' #' @details #' The LaTeX repr of vectors needs \code{\\usepackage[inline]{enumitem}} #' #' The LaTeX repr of functions with the \code{repr.function.highlight} option set to FALSE needs \code{\\usepackage{minted}} #' #' @seealso \link{repr}, \link{repr-options}, \link{repr-generics}, \link{repr_text} #' #' @docType package #' @name repr-package NULL repr/R/repr_function.r0000644000175100001440000000312513016033502014473 0ustar hornikusers#' Representations of functions #' #' @param obj Function to create a representation for #' @param highlight Should code highlighting be performed #' @param fenced Should a fenced code block instead of an indented one be used? #' @param ... ignored #' #' @aliases repr_html.function repr_latex.function repr_markdown.function #' @name repr_*.function #' @include utils.r NULL repr_function_generic <- function(f, fmt, escape, high_wrap, norm_wrap, highlight) { code <- deparse(f) if (highlight) { if (!requireNamespace('highr')) stop(sprintf('Tried to create a %s representation of a function with highlighting, but the `highlight` package is not installed!', fmt)) code <- highr::hilight(code, fmt) wrap <- high_wrap } else { code <- escape(code) wrap <- norm_wrap } sprintf(wrap, paste(code, collapse = '\n')) } #' @name repr_*.function #' @export repr_html.function <- function(obj, highlight = getOption('repr.function.highlight'), ...) { wrap <- '
%s
' repr_function_generic(obj, 'html', html_escape, wrap, wrap, highlight, ...) } #' @name repr_*.function #' @export repr_latex.function <- function(obj, highlight = getOption('repr.function.highlight'), ...) { minted_wrap <- '\\begin{minted}{r}\n%s\n\\end{minted}' repr_function_generic(obj, 'latex', latex_escape, '%s', minted_wrap, highlight, ...) } #' @name repr_*.function #' @export repr_markdown.function <- function(obj, fenced = TRUE, ...) { code <- deparse(obj) if (fenced) { code <- c('```r', code, '```') } else { code <- paste0('\t', code) } paste(code, collapse = '\n') } repr/R/utils.r0000644000175100001440000000733412745105241012774 0ustar hornikusershtml_specials <- list('&' = '&', '<' = '<', '>' = '>') html_escape <- function(text) { for (chr in names(html_specials)) { text <- gsub(chr, html_specials[[chr]], text, fixed = TRUE) } consec_spaces <- grepl(' ', text) text[consec_spaces] <- sprintf('%s', text[consec_spaces]) text } latex_specials <- list( '\\' = '\\textbackslash{}', '{' = '\\{', '}' = '\\}', '$' = '\\$', '^' = '\\textasciicircum{}', '_' = '\\_', '%' = '\\%', '#' = '\\#', '&' = '\\&', '~' = '\\textasciitilde{}', '[' = '{[}', ']' = '{]}', '|' = '\\textbar{}') latex_escape <- function(text) { for (chr in names(latex_specials)) { text <- gsub(chr, latex_specials[[chr]], text, fixed = TRUE) } # undo superfluous escape gsub('\\textbackslash\\{\\}', '\\textbackslash{}', text, fixed = TRUE) } .escape_names <- function(obj, escape_type) { # Generic function for escaping names. # Depending on the object type, names, rownames and colnames may be the same or different # Capture all three before changing them. # Note that the resulting names may not be valid R syntax. # escape_type must be 'latex' or 'html' stopifnot(any(escape_type == c('html', 'latex'))) obj_names <- names(obj) obj_rownames <- rownames(obj) obj_colnames <- colnames(obj) detect_specials <- match.fun(paste0('any_', escape_type, '_specials')) escape_specials <- match.fun(paste0(escape_type, '_escape')) if (detect_specials(obj_names)) names(obj) <- escape_specials(obj_names) if (detect_specials(obj_rownames)) rownames(obj) <- escape_specials(obj_rownames) if (detect_specials(obj_colnames)) colnames(obj) <- escape_specials(obj_colnames) return(obj) } .any_specials <- function(char_vec, specials_list) { # Use this function to avoid setting names unnecessarily (and thereby copying the object many times). if (inherits(char_vec, c('character', 'factor'))) any(vapply(names(specials_list), grepl, logical(length(char_vec)), char_vec, fixed = TRUE)) else FALSE } .escape_vec <- function(vec, escape_type = c('html', 'latex')) { escape_type <- match.arg(escape_type) # .escape_vec should never change the class of its input. # That seems useful, since functions like ellip_limit_arr check class. if (!is.vector(vec) && !is.factor(vec)) { stop('expected `vec` to be a vector or factor but it is a ', paste(class(vec), collapse = ', ')) } detect_specials <- match.fun(paste0('any_', escape_type, '_specials')) escape_specials <- match.fun(paste0(escape_type, '_escape')) if (detect_specials(vec)) { if (is.factor(vec)) { levels(vec) <- escape_specials(levels(vec)) } else { vec <- escape_specials(vec) # regular character vec } } return(vec) } slice_row <- function(df, row) { # Slice an array, kind of like unlist(obj[row, ]), but respecting factors and # upcasting as necessary. slice <- c(df[row, ], recursive = TRUE) col_classes <- vapply(df, class, FUN.VALUE = character(1L)) for (col_idx in which(col_classes == 'factor')) { # This syntax doesn't work with matrices, but factor matrices are close to # impossible. See: http://stackoverflow.com/a/28724756 slice[col_idx] <- levels(df[[col_idx]])[df[[row, col_idx]]] } slice } r_quote <- function(char_vec) paste0("'", sub("'", "\\'", char_vec, fixed = TRUE), "'") # Create the actually-used functions from the shells above. latex_escape_names <- function(obj) .escape_names(obj, 'latex') html_escape_names <- function(obj) .escape_names(obj, 'html') any_latex_specials <- function(char_vec) .any_specials(char_vec, latex_specials) any_html_specials <- function(char_vec) .any_specials(char_vec, html_specials) latex_escape_vec <- function(vec) .escape_vec(vec, 'latex') html_escape_vec <- function(vec) .escape_vec(vec, 'html') repr/R/repr_packageIQR.r0000644000175100001440000000304612715365526014642 0ustar hornikusers#' packageIQR representations #' #' Text representations of packageIQR objects like the list of available example data or vignettes #' #' @param obj The packageIQR obj to create a representation for #' @param ... ignored #' #' @examples #' repr_html(data(package = 'base')) #' repr_text(vignette(package = 'highr')) #' #' @name repr_*.packageIQR #' @export repr_text.packageIQR <- function(obj, ...) { # this is mostly copied from utils:::print.packageIQR db <- as.data.frame(obj$results, stringsAsFactors = FALSE) idx_by_pkg <- split(seq_len(nrow(db)), db$Package) db_by_pkg <- lapply(idx_by_pkg, function(ind) db[ind, ]) output <- character(0L) for (pkg_name in names(db_by_pkg)) { package <- db_by_pkg[[pkg_name]] output <- c( output, sprintf('%s in package %s:\n', obj$title, sQuote(pkg_name)), formatDL(package$Item, package$Title)) } if (length(db_by_pkg) == 0L) output <- c(output, sprintf('no %s found', tolower(obj$title))) if (!is.null(obj$footer)) output <- c(output, paste0('\n', obj$footer)) # add 2 \n paste(output, collapse = '\n') } #' @name repr_*.packageIQR #' @export repr_html.packageIQR <- function(obj, ...) { db <- as.data.frame(obj$results, stringsAsFactors = FALSE)[c('Package', 'Item', 'Title')] title <- sprintf('

%s

', obj$title) content <- if (nrow(db) == 0L) { sprintf('

No %s found

', tolower(obj$title)) } else { repr_html(db, rows = 1000L) } footer <- sprintf('

%s

', obj$footer) # will be character(0L) if is.null(footer) paste(title, content, footer, sep = '\n') } repr/R/repr_list.r0000644000175100001440000000456312745106261013643 0ustar hornikusers#' Representations of lists #' #' @param obj The list to create a representation for #' @param ... ignored #' #' @aliases repr_html.list repr_markdown.list repr_latex.list #' @name repr_*.list #' @include utils.r NULL repr_list_generic <- function( vec, fmt, enum_item, named_item, only_named_item, enum_wrap, named_wrap = enum_wrap, ..., numeric_item = named_item, item_uses_numbers = FALSE, escape_fun = identity) { nms <- names(vec) if (!is.null(nms)) { nms <- as.character(sapply(nms, as.name, USE.NAMES = FALSE)) # adds `` around special chars nms <- escape_fun(nms) } # This does escaping, so no need to escape the content again mapped <- lapply(vec, format2repr[[fmt]]) # if any elements cannot be represented, return NULL if (any(vapply(vec, is.null, logical(1)) != vapply(mapped, is.null, logical(1)))) { NULL } else if (length(mapped) == 1 && !is.null(nms)) { sprintf(only_named_item, nms, mapped[[1]]) } else { entries <- if (!is.null(nms)) { vapply(seq_along(mapped), function(i) { nm <- nms[[i]] if (is.na(nm) || nchar(nm) == 0) { sprintf(numeric_item, i, mapped[[i]]) } else { sprintf(named_item, nms[[i]], mapped[[i]]) } }, character(1)) } else if (item_uses_numbers) { sprintf(enum_item, seq_along(mapped), mapped) } else { sprintf(enum_item, mapped) } wrap <- if (is.null(nms)) enum_wrap else named_wrap sprintf(wrap, paste0(entries, collapse = '')) } } #' @name repr_*.list #' @export repr_html.list <- function(obj, ...) repr_list_generic( obj, 'html', '\t
  • %s
    • \n', '\t
    $%s
    \n\t\t
    %s
    \n', '$%s = %s', '
      \n%s
    \n', '
    \n%s
    \n', numeric_item = '\t
    [[%s]]
    \n\t\t
    %s
    \n', escape_fun = html_escape) #' @name repr_*.list #' @export repr_markdown.list <- function(obj, ...) repr_list_generic( obj, 'markdown', '%s. %s\n', '$%s\n: %s\n', '**$%s** = %s', '%s\n\n', numeric_item = '[[%s]]\n: %s\n', item_uses_numbers = TRUE, escape_fun = html_escape) #' @name repr_*.list #' @export repr_latex.list <- function(obj, ...) repr_list_generic( obj, 'latex', '\\item %s\n', '\\item[\\$%s] %s\n', '\\textbf{\\$%s} = %s', enum_wrap = '\\begin{enumerate}\n%s\\end{enumerate}\n', named_wrap = '\\begin{description}\n%s\\end{description}\n', numeric_item = '\\item[{[[%s]]}] %s\n', escape_fun = latex_escape) repr/R/generics.r0000644000175100001440000001025012745100413013416 0ustar hornikusers#' Dynamic representation #' #' Specify an object and a format to represent it in. Will \link{stop}\code{()} if no such format is known. #' #' @param obj The object to create a representation for #' @param format The representation format. \code{repr_} is then called. (default: Call \link{repr_text}) #' @param ... delegated to the specific \code{repr_} function #' #' @return A character or raw vector of that format or NULL if none is defined. #' Only the \code{'text'} format is defined for everything (via \link{print}\code{()}) #' #' @seealso \link{repr_text}, \link{repr-generics} #' @export repr <- function(obj, format = 'text', ...) { delegate <- format2repr[[format]] if (is.null(delegate)) stop(sprintf('Repr format %s not known', format)) delegate(obj, ...) } #' Text representation #' #' The only representation defined per default for everthing (via \link{print}\code{()}) #' #' @param obj The object to \link{print} and then return the output #' @param ... ignored #' #' @seealso \link{repr-generics} for other generics #' @export repr_text <- function(obj, ...) UseMethod('repr_text', obj) #' @name repr_text #' @importFrom utils capture.output #' @export repr_text.default <- function(obj, ...) { paste(capture.output(print(obj)), collapse = '\n') } #' Representations for specific formats #' #' @param obj The object to create a repr for #' @param ... parameters of the specific \code{repr_*} functions #' #' @seealso \link{repr_text} for the only repr that is always defined #' @aliases #' repr_html repr_html.default #' repr_markdown repr_markdown.default #' repr_latex repr_latex.default #' repr_json repr_json.default #' repr_javascript repr_javascript.default #' repr_pdf repr_pdf.default #' repr_png repr_png.default #' repr_jpg repr_jpg.default #' repr_svg repr_svg.default #' @name repr-generics NULL #' @name repr-generics #' @export repr_html <- function(obj, ...) UseMethod('repr_html', obj) #' @name repr-generics #' @export repr_html.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_markdown <- function(obj, ...) UseMethod('repr_markdown', obj) #' @name repr-generics #' @export repr_markdown.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_latex <- function(obj, ...) UseMethod('repr_latex', obj) #' @name repr-generics #' @export repr_latex.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_json <- function(obj, ...) UseMethod('repr_json', obj) #' @name repr-generics #' @export repr_json.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_javascript <- function(obj, ...) UseMethod('repr_javascript', obj) #' @name repr-generics #' @export repr_javascript.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_pdf <- function(obj, ...) UseMethod('repr_pdf', obj) #' @name repr-generics #' @export repr_pdf.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_png <- function(obj, ...) UseMethod('repr_png', obj) #' @name repr-generics #' @export repr_png.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_jpg <- function(obj, ...) UseMethod('repr_jpg', obj) #' @name repr-generics #' @export repr_jpg.default <- function(obj, ...) NULL #' @name repr-generics #' @export repr_svg <- function(obj, ...) UseMethod('repr_svg', obj) #' @name repr-generics #' @export repr_svg.default <- function(obj, ...) NULL #' Lists mapping mime types (\code{mime2repr}) or format names (\code{format2repr}) to \code{repr} functions #' #' @format Lists of length 10 mapping mime/name to function #' #' @examples #' names(mime2repr) #' names(format2repr) #' #' @aliases mime2repr format2repr #' @name *2repr #' @export mime2repr <- list( 'text/plain' = repr_text, 'text/html' = repr_html, 'text/markdown' = repr_markdown, 'text/latex' = repr_latex, 'application/json' = repr_json, 'application/javascript' = repr_javascript, 'application/pdf' = repr_pdf, 'image/png' = repr_png, 'image/jpeg' = repr_jpg, 'image/svg+xml' = repr_svg) #' @name *2repr #' @export format2repr <- sapply( c('text', 'html', 'markdown', 'latex', 'json', 'javascript', 'pdf', 'png', 'jpg', 'svg'), function(n) get(paste0('repr_', n))) repr/R/repr_htmlwidget.r0000644000175100001440000000127412701751631015033 0ustar hornikusers#' HTML widget representations #' #' Standalone HTML representation and dummy text representation #' #' @param obj The htmlwidget to create a representation for #' @param ... ignored #' #' @name repr_*.htmlwidget #' @export repr_text.htmlwidget <- function(obj, ...) 'HTML widgets cannot be represented in plain text (need html)' #' @name repr_*.htmlwidget #' @export repr_html.htmlwidget <- function(obj, ...) { if (!requireNamespace('htmlwidgets', quietly = TRUE)) stop('repr_html.htmlwidget called without loadable htmlwidgets') htmlfile <- tempfile(fileext = '.html') on.exit(unlink(htmlfile)) htmlwidgets::saveWidget(obj, htmlfile) readChar(htmlfile, file.info(htmlfile)$size) } repr/R/repr_vector.r0000644000175100001440000001116312753563626014177 0ustar hornikusers#' Representations of vectors #' #' @param obj The vector to create a representation for #' @param ... ignored #' #' @aliases #' repr_markdown.logical repr_markdown.integer repr_markdown.complex repr_markdown.numeric repr_markdown.factor repr_markdown.character repr_markdown.Date #' repr_latex.logical repr_latex.integer repr_latex.complex repr_latex.numeric repr_latex.factor repr_latex.character repr_latex.Date #' repr_html.logical repr_html.integer repr_html.complex repr_html.numeric repr_html.factor repr_html.character repr_html.Date #' @name repr_*.vector #' @include repr_list.r #' @include utils.r NULL # repr_text is defined via print repr_vector_generic <- function( vec, enum_item, named_item, only_named_item, enum_wrap, named_wrap = enum_wrap, ..., numeric_item = named_item, individual_wrap = NULL, # will be passed the vector items twice so needs 2 times %s item_uses_numbers = FALSE, escape_fun = identity) { if (length(vec) == 0) return('') nms <- names(vec) if (!is.null(nms)) nms <- escape_fun(nms) qt <- is.character(vec) && getOption('repr.vector.quote') char_vec <- escape_fun(if (qt) r_quote(vec) else as.character(vec)) if (!is.null(individual_wrap)) { char_vec <- sprintf(individual_wrap, char_vec, char_vec) } if (length(char_vec) > 1) { entries <- if (!is.null(nms)) vapply(seq_along(char_vec), function(i) { nm <- nms[[i]] if (is.na(nm) || nchar(nm) == 0) { sprintf(numeric_item, i, char_vec[[i]]) } else { sprintf(named_item, nms[[i]], char_vec[[i]]) } }, character(1)) else if (item_uses_numbers) sprintf(enum_item, seq_along(char_vec), char_vec) else sprintf(enum_item, char_vec) wrap <- if (is.null(nms)) enum_wrap else named_wrap sprintf(wrap, paste0(entries, collapse = '')) } else if (is.null(nms)) { char_vec } else { sprintf(only_named_item, nms, char_vec) } } # HTML -------------------------------------------------------------------- repr_html_wrapper <- function(obj, individual_wrap, ...) repr_vector_generic( obj, '\t
  • %s
    • \n', '\t
    %s
    \n\t\t
    %s
    \n', '%s: %s', '
      \n%s
    \n', '
    \n%s
    \n', escape_fun = html_escape, individual_wrap = individual_wrap) #' @name repr_*.vector #' @export repr_html.logical <- function(obj, ...) repr_html_wrapper(obj, NULL, ...) #' @name repr_*.vector #' @export repr_html.integer <- repr_html.logical #' @name repr_*.vector #' @export repr_html.complex <- repr_html.logical #' @name repr_*.vector #' @export repr_html.numeric <- repr_html.logical #' @name repr_*.vector #' @export repr_html.factor <- repr_html.logical #' @name repr_*.vector #' @export repr_html.character <- repr_html.logical #' @name repr_*.vector #' @export repr_html.Date <- function(obj, ...) repr_html_wrapper(obj, '', ...) # Markdown ---------------------------------------------------------------- #' @name repr_*.vector #' @export repr_markdown.logical <- function(obj, ...) repr_vector_generic( html_escape_names(obj), '%s. %s\n', '%s\n: %s', '**%s:** %s', '%s\n\n', item_uses_numbers = TRUE, escape_fun = html_escape) #' @name repr_*.vector #' @export repr_markdown.integer <- repr_markdown.logical #' @name repr_*.vector #' @export repr_markdown.complex <- repr_markdown.logical #' @name repr_*.vector #' @export repr_markdown.numeric <- repr_markdown.logical #' @name repr_*.vector #' @export repr_markdown.factor <- repr_markdown.logical #' @name repr_*.vector #' @export repr_markdown.character <- repr_markdown.logical #' @name repr_*.vector #' @export repr_markdown.Date <- repr_markdown.logical # LaTeX ------------------------------------------------------------------- #' @name repr_*.vector #' @export repr_latex.logical <- function(obj, ...) repr_vector_generic( latex_escape_names(obj), # escape vector names, regardless of class '\\item %s\n', '\\item[%s] %s\n', '\\textbf{%s:} %s', enum_wrap = '\\begin{enumerate*}\n%s\\end{enumerate*}\n', named_wrap = '\\begin{description*}\n%s\\end{description*}\n', only_named_item = '\\textbf{%s:} %s', escape_fun = latex_escape) #' @name repr_*.vector #' @export repr_latex.integer <- repr_latex.logical #' @name repr_*.vector #' @export repr_latex.complex <- repr_latex.logical #' @name repr_*.vector #' @export repr_latex.numeric <- repr_latex.logical #' @name repr_*.vector #' @export repr_latex.factor <- repr_latex.logical #' @name repr_*.vector #' @export repr_latex.character <- repr_latex.logical #' @name repr_*.vector #' @export repr_latex.Date <- repr_latex.logical repr/R/options.r0000644000175100001440000000610213016033502013307 0ustar hornikusers#' repr options #' #' These options are used to control the behavior of repr when not calling it directly. Use \code{\link[base]{options}(repr.* = ...)} and \code{\link[base]{getOption}('repr.*')} to set and get them, respectively. #' #' Once this package is loaded, all options are set to defaults which weren’t set beforehand. #' #' Setting all options set to \code{NULL} are reset to defaults when reloading the package (or calling \code{repr:::.onload()}). #' #' @section Options: #' #' \describe{ #' #' \item{\code{repr.plot.*}}{ #' Those are for representations of \code{recordedplot} instances: #' \describe{ #' \item{\code{repr.plot.width}}{Plotting area width in inches (default: 7)} #' \item{\code{repr.plot.height}}{Plotting area height in inches (default: 7)} #' \item{\code{repr.plot.pointsize}}{Text height in pt (default: 12)} #' \item{\code{repr.plot.bg}}{Background color (default: white)} #' \item{\code{repr.plot.antialias}}{Which kind of antialiasing to use for for lines and text? 'gray', 'subpixel' or 'none'? (default: gray)} #' \item{\code{repr.plot.res}}{PPI for rasterization (default: 120)} #' \item{\code{repr.plot.quality}}{Quality of JPEG format in \% (default: 90)} #' \item{\code{repr.plot.family}}{Vector font family. 'sans', 'serif', 'mono' or a specific one (default: sans)} #' } #' } #' \item{\code{repr.vector.quote}}{ #' Output quotation marks for character vectors? (default: TRUE) #' } #' \item{\code{repr.matrix.max.rows}}{ #' How many rows to display at max. Will insert a row with vertical ellipses to show elision. (default: 60) #' } #' \item{\code{repr.matrix.max.cols}}{ #' How many cols to display at max. Will insert a column with horizontal ellipses to show elision. (default: 20) #' } #' \item{\code{repr.matrix.latex.colspec}}{ #' How to layout LaTeX tables when representing matrices or data.frames. #' List of \code{row.head}, other \code{col}, and \code{end} strings. #' \code{end} mainly exists for when you want a vertical line there (default: 'r|', 'l', and '') #' } #' \item{\code{repr.function.highlight}}{ #' Use the \code{highr} package to insert highlighting instructions into the code? Needs that package to be installed. (default: FALSE) #' } #' #' } #' #' @name repr-options NULL plot_defaults <- list( repr.plot.width = 7, repr.plot.height = 7, repr.plot.pointsize = 12, repr.plot.bg = 'white', repr.plot.antialias = 'gray', #nice medium-res DPI repr.plot.res = 120, #jpeg quality bumped from default repr.plot.quality = 90, #vector font family repr.plot.family = 'sans') class_defaults <- list( repr.vector.quote = TRUE, repr.matrix.max.rows = 60, repr.matrix.max.cols = 20, repr.matrix.latex.colspec = list(row_head = 'r|', col = 'l', end = ''), repr.function.highlight = FALSE) #' @name repr-options #' @export repr_option_defaults <- c(plot_defaults, class_defaults) .onLoad <- function(libname = NULL, pkgname = NULL) { for (opt_name in names(repr_option_defaults)) { if (is.null(getOption(opt_name))) do.call(options, repr_option_defaults[opt_name]) # single []: name stays } } repr/README.md0000644000175100001440000000550013016033502012510 0ustar hornikusersrepr [![Build Status](https://travis-ci.org/IRkernel/repr.svg?branch=master)](https://travis-ci.org/IRkernel/repr) ==== String and byte representations for all kinds of R objects. This package exists to reliably create readable text (and viewable image) representations of data without the side effects [`print()`][print] can cause, such as invoking a [pager][file_show] and plotting to a plot device. In other words, all repr functions and methods are pure. It is intended to be the basis of several packages that need to create rich text and graphics from R objects, such as [Jupyter][]’s [IRkernel][], [knitr][], and others, such as a future more powerful replacement for `R CMD Rd2pdf`. [print]: https://stat.ethz.ch/R-manual/R-devel/library/base/html/print.html [file_show]: https://stat.ethz.ch/R-manual/R-devel/library/base/html/file.show.html [Jupyter]: http://jupyter.org/ [IRkernel]: https://github.com/IRkernel/IRkernel [knitr]: http://yihui.name/knitr/ Exports ------- `repr` is a function delegating to the individual `repr_*` functions. `repr_*`, e.g. `repr_text`, `repr_html`, and `repr_png` emit single-element character vectors or raw vectors. They have parameters also configurable via global `options`. `mime2repr` is a list mapping all known mimetypes to `repr_*` functions, e.g. `mime2repr[['application/pdf']]` is `repr_pdf`. `format2repr` does the same for simple format names. So `format2repr$markdown` is `repr_markdown`. Imports ------- Per default, `repr` will not use any packages not part of the R distribution. Only if you want to use `repr_html.function` and `repr_latex.function`, and specify the parameter `highlight` or option `repr.function.highlight` to be `TRUE`, then be sure to have [highr][] installed. [highr]: https://github.com/yihui/highr Formats ------- Currently, the actually emitted formats are: * Plain text, for everything, using `capture.output(print(thing))`. This will fail if `print(thing)` plots it instead. Please report classes which do that and aren’t handled yet (such as `recordedplot`). * HTML, Markdown, and LaTeX, which are emitted for everything non-graphical * PNG, JPG, SVG, and PDF for everything graphical (ATM just `recordedplot`) Why not Pander? --------------- [Pander][] Is very configurable and does the same as this one, only just for Markdown. Why don’t we use it and use [Pandoc][] to convert to other formats like it? Because it just emits [Markdown][], which is the least semantic format available. A roundtrip through Markdown will undoubtedly create sub-par HTML and LaTeX. Also Pander supports only text. Plots and images are also important to represent. Pander is however awesome for high-quality Markdown so this project might want to depend on it. [Pander]: http://rapporter.github.io/pander/ [Pandoc]: http://pandoc.org/ [Markdown]: http://whatismarkdown.com/ repr/MD50000644000175100001440000000400013016103555011541 0ustar hornikusersf669ab84d1ca1dc411023b7e4da52b1a *DESCRIPTION b44d5a779f46f5040c17c073e27bc6b2 *NAMESPACE 48e7a7197cc617eeae8e658f161b1f53 *R/generics.r a3a68a191df3cd7d24e3338c3aeced5e *R/options.r fa4ce413fec349492f9491d7d5c26c3d *R/package.r e9453c2f452e165d361e9cfdb9422e92 *R/repr_function.r 516b42730fba17394592ad971315e886 *R/repr_help_files_with_topic.r e47a748f068ecad761049f7c370b94fb *R/repr_htmlwidget.r f532e2d44add2fb61da5ab4e0451ab77 *R/repr_list.r 686b9d6509af5ab9ad207ccabae085c7 *R/repr_matrix_df.r 5ec2264e76be0e450932a227478e583c *R/repr_packageIQR.r 7edad54706e4a37a22c4b048523efd71 *R/repr_recordedplot.r 399ee70bc18a15ee048c97a1223af36f *R/repr_vector.r 43108e95618bdb74800e3c98dac304db *R/utils.r f41af3df0c411ade0fe170bed49b9f5a *README.md 952a37a1dc89beff285fed595002a00e *man/repr-generics.Rd 2923fc948a516f98a7f5eb20315c53dd *man/repr-options.Rd 1f27339314e4b3be8aa96d371c46c3df *man/repr-package.Rd 18bc582e6c0a8aa0dada58bfdba548cd *man/repr.Rd 3a41816d3ae10afd5ffee737e2dc4e43 *man/repr_-times-.function.Rd 487b225fdf0a63344b8863caf6fd083d *man/repr_-times-.help_files_with_topic.Rd 37dcef06cfb0b9ba239879219ac3e503 *man/repr_-times-.htmlwidget.Rd 7e65e55ecf7e37d5342f8880efe57c48 *man/repr_-times-.list.Rd 57e3608d4b959adfd890a3e97e4e681c *man/repr_-times-.matrix-slash-data.frame.Rd 07d7b8c01b5439371fb17e95b644234e *man/repr_-times-.packageIQR.Rd 1d85925472abc6e9d01915dcf68b1fcb *man/repr_-times-.recordedplot.Rd 2eee5f63e50d9cb9cacba954006bb01a *man/repr_-times-.vector.Rd b9bd35447dbb9782d0ca680480173f7d *man/repr_text.Rd 6227f9d756456fa05d4577422415d22b *man/times-2repr.Rd 286f184c95373dbc4e2d2539f77aa555 *tests/testthat.R a46842bbfdebb6615163ffa6397ce443 *tests/testthat/test_array_df.r bf1fd51d222990f8b8deed84dd128746 *tests/testthat/test_array_manipulation.r 605db826495b40f40dff6b568960a42c *tests/testthat/test_escaping.r 8a6bec6efdfbb0e914c795841adea5b5 *tests/testthat/test_list.r a0eb8b9ea0adcfaf9553de4753ab44c8 *tests/testthat/test_repr_packageIQR.r 156a9825ef0fcad572538d58e46b7cc9 *tests/testthat/test_vector.r repr/DESCRIPTION0000644000175100001440000000252113016103555012745 0ustar hornikusersPackage: repr Title: Serializable Representations Version: 0.10 Authors@R: c( person('Philipp', 'Angerer', email = 'phil.angerer@gmail.com', role = c('aut', 'cre')), person('Thomas', 'Kluyver', email = 'thomas@kluyver.me.uk', role = 'aut'), person('Jan', 'Schulz', email = 'jasc@gmx.net', role = 'aut'), person('abielr', role = 'ctb'), person('Denilson', 'Figueiredo de Sa', role = 'ctb'), person('Jim', 'Hester', role = 'ctb'), person('karldw', role = 'ctb') ) Maintainer: Philipp Angerer Description: String and binary representations of objects for several formats / mime types. Depends: R (>= 3.0.1) Imports: utils, grDevices Suggests: methods, highr, Cairo, testthat Enhances: data.table, dplyr, htmlwidgets License: GPL-3 LazyData: true Encoding: UTF-8 Collate: 'generics.r' 'options.r' 'package.r' 'utils.r' 'repr_function.r' 'repr_help_files_with_topic.r' 'repr_htmlwidget.r' 'repr_list.r' 'repr_matrix_df.r' 'repr_packageIQR.r' 'repr_recordedplot.r' 'repr_vector.r' RoxygenNote: 5.0.1 NeedsCompilation: no Packaged: 2016-11-25 16:31:22 UTC; phil Author: Philipp Angerer [aut, cre], Thomas Kluyver [aut], Jan Schulz [aut], abielr [ctb], Denilson Figueiredo de Sa [ctb], Jim Hester [ctb], karldw [ctb] Repository: CRAN Date/Publication: 2016-11-25 19:48:13 repr/man/0000755000175100001440000000000013016062243012010 5ustar hornikusersrepr/man/repr_-times-.htmlwidget.Rd0000644000175100001440000000077112701751631016764 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_htmlwidget.r \name{repr_*.htmlwidget} \alias{repr_*.htmlwidget} \alias{repr_html.htmlwidget} \alias{repr_text.htmlwidget} \title{HTML widget representations} \usage{ \method{repr_text}{htmlwidget}(obj, ...) \method{repr_html}{htmlwidget}(obj, ...) } \arguments{ \item{obj}{The htmlwidget to create a representation for} \item{...}{ignored} } \description{ Standalone HTML representation and dummy text representation } repr/man/repr_text.Rd0000644000175100001440000000076712626153613014335 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.r \name{repr_text} \alias{repr_text} \alias{repr_text.default} \title{Text representation} \usage{ repr_text(obj, ...) \method{repr_text}{default}(obj, ...) } \arguments{ \item{obj}{The object to \link{print} and then return the output} \item{...}{ignored} } \description{ The only representation defined per default for everthing (via \link{print}\code{()}) } \seealso{ \link{repr-generics} for other generics } repr/man/repr_-times-.packageIQR.Rd0000644000175100001440000000116612715365532016570 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_packageIQR.r \name{repr_*.packageIQR} \alias{repr_*.packageIQR} \alias{repr_html.packageIQR} \alias{repr_text.packageIQR} \title{packageIQR representations} \usage{ \method{repr_text}{packageIQR}(obj, ...) \method{repr_html}{packageIQR}(obj, ...) } \arguments{ \item{obj}{The packageIQR obj to create a representation for} \item{...}{ignored} } \description{ Text representations of packageIQR objects like the list of available example data or vignettes } \examples{ repr_html(data(package = 'base')) repr_text(vignette(package = 'highr')) } repr/man/times-2repr.Rd0000644000175100001440000000107012626153613014456 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.r \docType{data} \name{*2repr} \alias{*2repr} \alias{format2repr} \alias{mime2repr} \title{Lists mapping mime types (\code{mime2repr}) or format names (\code{format2repr}) to \code{repr} functions} \format{Lists of length 10 mapping mime/name to function} \usage{ mime2repr format2repr } \description{ Lists mapping mime types (\code{mime2repr}) or format names (\code{format2repr}) to \code{repr} functions } \examples{ names(mime2repr) names(format2repr) } \keyword{datasets} repr/man/repr_-times-.matrix-slash-data.frame.Rd0000644000175100001440000000231313016062243021214 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_matrix_df.r \name{repr_*.matrix/data.frame} \alias{repr_*.matrix/data.frame} \alias{repr_html.data.frame} \alias{repr_html.matrix} \alias{repr_latex.data.frame} \alias{repr_latex.matrix} \alias{repr_markdown.data.frame} \alias{repr_markdown.matrix} \alias{repr_text.data.frame} \alias{repr_text.matrix} \title{Tabular data representations} \usage{ \method{repr_html}{matrix}(obj, ...) \method{repr_html}{data.frame}(obj, ...) \method{repr_latex}{matrix}(obj, ..., colspec = getOption("repr.matrix.latex.colspec")) \method{repr_latex}{data.frame}(obj, ..., colspec = getOption("repr.matrix.latex.colspec")) \method{repr_markdown}{matrix}(obj, ...) \method{repr_markdown}{data.frame}(obj, ...) \method{repr_text}{matrix}(obj, ...) \method{repr_text}{data.frame}(obj, ...) } \arguments{ \item{obj}{The matrix or data.frame to create a representation for} \item{...}{ignored} \item{colspec}{The colspec for the LaTeX table. The default is given by the option \code{repr.matrix.latex.colspec}} } \description{ HTML and LaTeX representations of Matrix-like objects } \seealso{ \link{repr-options} for \code{repr.matrix.latex.colspec} } repr/man/repr-package.Rd0000644000175100001440000000076012626153100014642 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/package.r \docType{package} \name{repr-package} \alias{repr-package} \title{The repr package} \description{ The repr package } \details{ The LaTeX repr of vectors needs \code{\\usepackage[inline]{enumitem}} The LaTeX repr of functions with the \code{repr.function.highlight} option set to FALSE needs \code{\\usepackage{minted}} } \seealso{ \link{repr}, \link{repr-options}, \link{repr-generics}, \link{repr_text} } repr/man/repr-options.Rd0000644000175100001440000000460113016033502014735 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/options.r \docType{data} \name{repr-options} \alias{repr-options} \alias{repr_option_defaults} \title{repr options} \format{An object of class \code{list} of length 13.} \usage{ repr_option_defaults } \description{ These options are used to control the behavior of repr when not calling it directly. Use \code{\link[base]{options}(repr.* = ...)} and \code{\link[base]{getOption}('repr.*')} to set and get them, respectively. } \details{ Once this package is loaded, all options are set to defaults which weren’t set beforehand. Setting all options set to \code{NULL} are reset to defaults when reloading the package (or calling \code{repr:::.onload()}). } \section{Options}{ \describe{ \item{\code{repr.plot.*}}{ Those are for representations of \code{recordedplot} instances: \describe{ \item{\code{repr.plot.width}}{Plotting area width in inches (default: 7)} \item{\code{repr.plot.height}}{Plotting area height in inches (default: 7)} \item{\code{repr.plot.pointsize}}{Text height in pt (default: 12)} \item{\code{repr.plot.bg}}{Background color (default: white)} \item{\code{repr.plot.antialias}}{Which kind of antialiasing to use for for lines and text? 'gray', 'subpixel' or 'none'? (default: gray)} \item{\code{repr.plot.res}}{PPI for rasterization (default: 120)} \item{\code{repr.plot.quality}}{Quality of JPEG format in \% (default: 90)} \item{\code{repr.plot.family}}{Vector font family. 'sans', 'serif', 'mono' or a specific one (default: sans)} } } \item{\code{repr.vector.quote}}{ Output quotation marks for character vectors? (default: TRUE) } \item{\code{repr.matrix.max.rows}}{ How many rows to display at max. Will insert a row with vertical ellipses to show elision. (default: 60) } \item{\code{repr.matrix.max.cols}}{ How many cols to display at max. Will insert a column with horizontal ellipses to show elision. (default: 20) } \item{\code{repr.matrix.latex.colspec}}{ How to layout LaTeX tables when representing matrices or data.frames. List of \code{row.head}, other \code{col}, and \code{end} strings. \code{end} mainly exists for when you want a vertical line there (default: 'r|', 'l', and '') } \item{\code{repr.function.highlight}}{ Use the \code{highr} package to insert highlighting instructions into the code? Needs that package to be installed. (default: FALSE) } } } \keyword{datasets} repr/man/repr_-times-.help_files_with_topic.Rd0000644000175100001440000000117012626153636021160 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_help_files_with_topic.r \name{repr_*.help_files_with_topic} \alias{repr_*.help_files_with_topic} \alias{repr_html.help_files_with_topic} \alias{repr_latex.help_files_with_topic} \alias{repr_text.help_files_with_topic} \title{Representations of help} \usage{ \method{repr_text}{help_files_with_topic}(obj, ...) \method{repr_html}{help_files_with_topic}(obj, ...) \method{repr_latex}{help_files_with_topic}(obj, ...) } \arguments{ \item{obj}{Help topic to create a representation for} \item{...}{ignored} } \description{ Representations of help } repr/man/repr-generics.Rd0000644000175100001440000000256412626153613015063 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.r \name{repr-generics} \alias{repr-generics} \alias{repr_html} \alias{repr_html.default} \alias{repr_javascript} \alias{repr_javascript.default} \alias{repr_jpg} \alias{repr_jpg.default} \alias{repr_json} \alias{repr_json.default} \alias{repr_latex} \alias{repr_latex.default} \alias{repr_markdown} \alias{repr_markdown.default} \alias{repr_pdf} \alias{repr_pdf.default} \alias{repr_png} \alias{repr_png.default} \alias{repr_svg} \alias{repr_svg.default} \title{Representations for specific formats} \usage{ repr_html(obj, ...) \method{repr_html}{default}(obj, ...) repr_markdown(obj, ...) \method{repr_markdown}{default}(obj, ...) repr_latex(obj, ...) \method{repr_latex}{default}(obj, ...) repr_json(obj, ...) \method{repr_json}{default}(obj, ...) repr_javascript(obj, ...) \method{repr_javascript}{default}(obj, ...) repr_pdf(obj, ...) \method{repr_pdf}{default}(obj, ...) repr_png(obj, ...) \method{repr_png}{default}(obj, ...) repr_jpg(obj, ...) \method{repr_jpg}{default}(obj, ...) repr_svg(obj, ...) \method{repr_svg}{default}(obj, ...) } \arguments{ \item{obj}{The object to create a repr for} \item{...}{parameters of the specific \code{repr_*} functions} } \description{ Representations for specific formats } \seealso{ \link{repr_text} for the only repr that is always defined } repr/man/repr_-times-.list.Rd0000644000175100001440000000074712626153100015563 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_list.r \name{repr_*.list} \alias{repr_*.list} \alias{repr_html.list} \alias{repr_latex.list} \alias{repr_markdown.list} \title{Representations of lists} \usage{ \method{repr_html}{list}(obj, ...) \method{repr_markdown}{list}(obj, ...) \method{repr_latex}{list}(obj, ...) } \arguments{ \item{obj}{The list to create a representation for} \item{...}{ignored} } \description{ Representations of lists } repr/man/repr.Rd0000644000175100001440000000140512626153100013246 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.r \name{repr} \alias{repr} \title{Dynamic representation} \usage{ repr(obj, format = "text", ...) } \arguments{ \item{obj}{The object to create a representation for} \item{format}{The representation format. \code{repr_} is then called. (default: Call \link{repr_text})} \item{...}{delegated to the specific \code{repr_} function} } \value{ A character or raw vector of that format or NULL if none is defined. Only the \code{'text'} format is defined for everything (via \link{print}\code{()}) } \description{ Specify an object and a format to represent it in. Will \link{stop}\code{()} if no such format is known. } \seealso{ \link{repr_text}, \link{repr-generics} } repr/man/repr_-times-.function.Rd0000644000175100001440000000142212626153613016435 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_function.r \name{repr_*.function} \alias{repr_*.function} \alias{repr_html.function} \alias{repr_latex.function} \alias{repr_markdown.function} \title{Representations of functions} \usage{ \method{repr_html}{function}(obj, highlight = getOption("repr.function.highlight"), ...) \method{repr_latex}{function}(obj, highlight = getOption("repr.function.highlight"), ...) \method{repr_markdown}{function}(obj, fenced = TRUE, ...) } \arguments{ \item{obj}{Function to create a representation for} \item{highlight}{Should code highlighting be performed} \item{...}{ignored} \item{fenced}{Should a fenced code block instead of an indented one be used?} } \description{ Representations of functions } repr/man/repr_-times-.vector.Rd0000644000175100001440000000330712753563626016130 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_vector.r \name{repr_*.vector} \alias{repr_*.vector} \alias{repr_html.Date} \alias{repr_html.character} \alias{repr_html.complex} \alias{repr_html.factor} \alias{repr_html.integer} \alias{repr_html.logical} \alias{repr_html.numeric} \alias{repr_latex.Date} \alias{repr_latex.character} \alias{repr_latex.complex} \alias{repr_latex.factor} \alias{repr_latex.integer} \alias{repr_latex.logical} \alias{repr_latex.numeric} \alias{repr_markdown.Date} \alias{repr_markdown.character} \alias{repr_markdown.complex} \alias{repr_markdown.factor} \alias{repr_markdown.integer} \alias{repr_markdown.logical} \alias{repr_markdown.numeric} \title{Representations of vectors} \usage{ \method{repr_html}{logical}(obj, ...) \method{repr_html}{integer}(obj, ...) \method{repr_html}{complex}(obj, ...) \method{repr_html}{numeric}(obj, ...) \method{repr_html}{factor}(obj, ...) \method{repr_html}{character}(obj, ...) \method{repr_html}{Date}(obj, ...) \method{repr_markdown}{logical}(obj, ...) \method{repr_markdown}{integer}(obj, ...) \method{repr_markdown}{complex}(obj, ...) \method{repr_markdown}{numeric}(obj, ...) \method{repr_markdown}{factor}(obj, ...) \method{repr_markdown}{character}(obj, ...) \method{repr_markdown}{Date}(obj, ...) \method{repr_latex}{logical}(obj, ...) \method{repr_latex}{integer}(obj, ...) \method{repr_latex}{complex}(obj, ...) \method{repr_latex}{numeric}(obj, ...) \method{repr_latex}{factor}(obj, ...) \method{repr_latex}{character}(obj, ...) \method{repr_latex}{Date}(obj, ...) } \arguments{ \item{obj}{The vector to create a representation for} \item{...}{ignored} } \description{ Representations of vectors } repr/man/repr_-times-.recordedplot.Rd0000644000175100001440000000525012626153100017270 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/repr_recordedplot.r \name{repr_*.recordedplot} \alias{repr_*.recordedplot} \alias{repr_jpg.recordedplot} \alias{repr_pdf.recordedplot} \alias{repr_png.recordedplot} \alias{repr_svg.recordedplot} \alias{repr_text.recordedplot} \title{Plot representations} \usage{ \method{repr_text}{recordedplot}(obj, ...) \method{repr_png}{recordedplot}(obj, width = getOption("repr.plot.width"), height = getOption("repr.plot.height"), bg = getOption("repr.plot.bg"), pointsize = getOption("repr.plot.pointsize"), antialias = getOption("repr.plot.antialias"), res = getOption("repr.plot.res"), ...) \method{repr_jpg}{recordedplot}(obj, width = getOption("repr.plot.width"), height = getOption("repr.plot.height"), bg = getOption("repr.plot.bg"), pointsize = getOption("repr.plot.pointsize"), antialias = getOption("repr.plot.antialias"), res = getOption("repr.plot.res"), quality = getOption("repr.plot.quality"), ...) \method{repr_svg}{recordedplot}(obj, width = getOption("repr.plot.width"), height = getOption("repr.plot.height"), bg = getOption("repr.plot.bg"), pointsize = getOption("repr.plot.pointsize"), antialias = getOption("repr.plot.antialias"), family = getOption("repr.plot.family"), ...) \method{repr_pdf}{recordedplot}(obj, width = getOption("repr.plot.width"), height = getOption("repr.plot.height"), bg = getOption("repr.plot.bg"), pointsize = getOption("repr.plot.pointsize"), antialias = getOption("repr.plot.antialias"), family = getOption("repr.plot.family"), ...) } \arguments{ \item{obj}{The plot to create a representation for} \item{...}{ignored} \item{width}{Plot area width in inches (default: 7)} \item{height}{Plot area height in inches (default: 7)} \item{bg}{Background color (default: white)} \item{pointsize}{Text height in pt (default: 12)} \item{antialias}{Which kind of antialiasing to use for for lines and text? 'gray', 'subpixel' or 'none'? (default: gray)} \item{res}{For PNG and JPEG, specifies the PPI for rasterization (default: 120)} \item{quality}{For JPEG, determines the compression quality in \% (default: 90)} \item{family}{Font family for SVG and PDF. 'sans', 'serif', 'mono' or a specific one (default: sans)} } \description{ \code{repr_text.recordedplot} only returns a small info string containing the title (if any) while the others return a character vector (SVG) a raw vector (the rest) containing the image data. } \details{ All parameters can also be specified using the eponymous \code{repr.plot.*} \link{repr-options}. } \examples{ dev.new() dev.control(displaylist = 'enable') plot(sqrt, main = 'Square root') p <- recordPlot() dev.off() repr_text(p) }