repr/ 0000755 0001751 0000144 00000000000 13071707460 011245 5 ustar hornik users repr/tests/ 0000755 0001751 0000144 00000000000 12701452540 012402 5 ustar hornik users repr/tests/testthat.R 0000644 0001751 0000144 00000000064 12701452540 014365 0 ustar hornik users library(testthat)
library(repr)
test_check('repr')
repr/tests/testthat/ 0000755 0001751 0000144 00000000000 13071707460 014247 5 ustar hornik users repr/tests/testthat/test_repr_packageIQR.r 0000644 0001751 0000144 00000002022 12750127736 020471 0 ustar hornik users context('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 \nNo 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.r 0000644 0001751 0000144 00000002424 13071655660 017001 0 ustar hornik users context('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)),
'
\t1
\t2
')
})
test_that('character vectors add quotes to non-NA', {
expect_identical(repr_html(c('a', NA, 'c')),
"
\t'a'
\tNA
\t'c'
")
})
test_that('named vectors display correctly', {
expect_identical(repr_html(c(a = 1, b = 2)),
'
\ta
\t\t1
\tb
\t\t2
')
})
test_that('factors display correctly', {
expect_identical(repr_html(factor(c('a', 'b'))),
'
\ta
\tb
')
})
test_that('Dates display correctly', {
expect_identical(repr_html(as.Date('1111-11-11')), '1111-11-11 ')
})
test_that('Date vectors display correctly', {
expect_identical(repr_html(c(as.Date('1111-11-11'), as.Date('1212-12-12'))),
'
\t1111-11-11 1212-12-12
')
})
repr/tests/testthat/test_list.r 0000644 0001751 0000144 00000001024 12723271501 016434 0 ustar hornik users context('Lists')
test_that('plain lists display correctly', {
expect_identical(repr_html(list(1, 2)), '
\t1
\t2
')
})
test_that('named lists display correctly', {
expect_identical(repr_html(list(a = 1, b = 2)), '
\t$a
\t\t1
\t$b
\t\t2
')
})
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.r 0000644 0001751 0000144 00000016255 13071657765 017307 0 ustar hornik users context('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('unprintables get escaped', {
expect_identical(repr_html('\1'), "'\\001'")
})
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'<'
\t'&'
")
})
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)),
'
')
expect_identical(repr_html(matrix(c(']', '}', '&', '_'), 2, 2, TRUE, list(c('$', '#'), c('%', '|')))),
'
')
})
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', '',
'
',
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', '',
'
',
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'one space'
\t'two spaces'
")
})
repr/tests/testthat/test_array_df.r 0000644 0001751 0000144 00000002500 12750127736 017262 0 ustar hornik users context('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),
'
')
})
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),
'
a b
\tiamastring iamafactor
')
})
test_that('date display correctly', {
df = data.frame(a = as.POSIXct('2016-05-28 10:00:00', tz = 'UTC'))
expect_identical(repr_html(df),
'
')
})
repr/tests/testthat/test_array_manipulation.r 0000644 0001751 0000144 00000032225 13071654625 021377 0 ustar hornik users context('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/NAMESPACE 0000644 0001751 0000144 00000005012 13071655671 012470 0 ustar hornik users # 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,data.table)
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_html,shiny.tag.list)
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,data.table)
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,data.table)
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)
S3method(repr_text,shiny.tag.list)
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/ 0000755 0001751 0000144 00000000000 13071661344 011446 5 ustar hornik users repr/R/repr_help_files_with_topic.r 0000644 0001751 0000144 00000004772 12750127736 017243 0 ustar hornik users # 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 == '