R Under development (unstable) (2025-04-19 r88162 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > NAME <- "trim" > source(file.path('_helper', 'init.R')) > > .mx.base <- matrix( + c( + "averylongwordthatcanlahblah", "causeasinglewidecolumnblah", + "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime", + "agreenduckflew", "overthemountains", "inalongofantelopes", + "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier" + ), + nrow=3, ncol=4 + ) > > # - Atomic --------------------------------------------------------------------- > > set.seed(1) > x <- capture.output(1:50) > y <- capture.output(factor(sample(letters, 50, replace=TRUE))) > > all.equal( + diffobj:::strip_atomic_rh(x), + c(" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25", "26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50") + ) [1] TRUE > all.equal( + diffobj:::strip_atomic_rh(y), + c("g j o x f x y r q b f e r j u m s z j u y f q d g k a j w i m p m e v r u c", "s k v q u o n u a m t s", "Levels: a b c d e f g i j k m n o p q r s t u v w x y z") + ) [1] TRUE > all.equal(diffobj:::which_atomic_rh(capture.output(1:5)), 1) [1] TRUE > > all.equal(as.character(diffPrint(1:3, 2:6, trim=FALSE)), rdsf(50)) [1] TRUE > > # bad headers > > bh <- c("[1] a b c", "[4] d e f", "[5] h") > all.equal(diffobj:::which_atomic_rh(bh), integer()) [1] TRUE > > # - Matrix > mx1 <- mx2 <- matrix(1:3, 3) > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx1), dimnames(mx1)), + c(" [,1]", " 1", " 2", " 3") + ) [1] TRUE > # shouldn't strip headers from attributes > attr(mx2, "blah") <- matrix(1:2, 2) > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx2), dimnames(mx2)), + c(" [,1]", " 1", " 2", " 3", "attr(,\"blah\")", " [,1]", "[1,] 1", "[2,] 2") + ) [1] TRUE > # Matrices that wrap > > mx3 <- mx4 <- mx5 <- mx6 <- .mx.base > old.opt <- options(width=30) > > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx3), dimnames(mx3)), + c(" [,1] ", "\"averylongwordthatcanlahblah\"", "\"causeasinglewidecolumnblah\" ", "\"matrixtowrapseveraltimes\" ", " [,2] ", "\"inarrowscreen\" ", "\"onceuponatime\" ", "\"agreenduckflew\"", " [,3] ", "\"overthemountains\" ", "\"inalongofantelopes\"", "\"ineedthreemore\" ", " [,4] ", "\"entriesactually\" ", "\"nowonlytwomore\" ", "\"iwaswrongearlier\"") + ) [1] TRUE > # Add rownames; should no longer strip > > rownames(mx4) <- 2:4 > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx4), dimnames(mx4)), + capture.output(mx4) + ) [1] TRUE > # Attributes don't have stuff stripped > > attr(mx6, "blah") <- letters[1:15] > > all.equal( + diffobj:::strip_matrix_rh(capture.output(mx6), dimnames(mx6)), + c(" [,1] ", "\"averylongwordthatcanlahblah\"", "\"causeasinglewidecolumnblah\" ", "\"matrixtowrapseveraltimes\" ", " [,2] ", "\"inarrowscreen\" ", "\"onceuponatime\" ", "\"agreenduckflew\"", " [,3] ", "\"overthemountains\" ", "\"inalongofantelopes\"", "\"ineedthreemore\" ", " [,4] ", "\"entriesactually\" ", "\"nowonlytwomore\" ", "\"iwaswrongearlier\"", "attr(,\"blah\")", " [1] \"a\" \"b\" \"c\" \"d\" \"e\" \"f\"", " [7] \"g\" \"h\" \"i\" \"j\" \"k\" \"l\"", "[13] \"m\" \"n\" \"o\"") + ) [1] TRUE > # Single row matrix > > all.equal( + diffobj:::which_matrix_rh(capture.output(matrix(1:2, nrow=1)), NULL), 2 + ) [1] TRUE > options(width=80) > > # - Table ---------------------------------------------------------------------- > > old.opt <- options(width=30) > > # Data frames > > df1 <- as.data.frame(.mx.base) > all.equal( + diffobj:::strip_table_rh(capture.output(df1)), + c(" V1", "averylongwordthatcanlahblah", " causeasinglewidecolumnblah", " matrixtowrapseveraltimes", " V2", " inarrowscreen", " onceuponatime", "agreenduckflew", " V3", " overthemountains", "inalongofantelopes", " ineedthreemore", " V4", " entriesactually", " nowonlytwomore", "iwaswrongearlier") + ) [1] TRUE > df2 <- df1[c(2, 1, 3), ] > > all.equal( + diffobj:::strip_table_rh(capture.output(df2)), + capture.output(df2) + ) [1] TRUE > # Rownames that start from one and sequential, should get stripped; also, > # colon allowed > > df3 <- df1 > rownames(df3) <- paste0(1:3, ":") > all.equal( + diffobj:::strip_table_rh(capture.output(df3)), + c(" V1", "averylongwordthatcanlahblah", " causeasinglewidecolumnblah", " matrixtowrapseveraltimes", " V2", " inarrowscreen", " onceuponatime", "agreenduckflew", " V3", " overthemountains", "inalongofantelopes", " ineedthreemore", " V4", " entriesactually", " nowonlytwomore", "iwaswrongearlier") + ) [1] TRUE > # Try ts > > all.equal( + diffobj:::strip_table_rh(capture.output(USAccDeaths)), + capture.output(USAccDeaths) + ) [1] TRUE > # Set it so first year is 1 > > USAD2 <- USAccDeaths > tsp(USAD2)[1:2] <- tsp(USAD2)[1:2] - 1972 > > all.equal( + diffobj:::strip_table_rh(capture.output(USAD2)), + c(" Jan Feb Mar Apr", " 9007 8106 8928 9137", " 7750 6981 8038 8422", " 8162 7306 8124 7870", " 7717 7461 7767 7925", " 7792 6957 7726 8106", " 7836 6892 7791 8192", " May Jun Jul Aug", "10017 10826 11317 10744", " 8714 9512 10120 9823", " 9387 9556 10093 9620", " 8623 8945 10078 9179", " 8890 9299 10625 9302", " 9115 9434 10484 9827", " Sep Oct Nov Dec", " 9713 9938 9161 8927", " 8743 9129 8710 8680", " 8285 8466 8160 8034", " 8037 8488 7874 8647", " 8314 8850 8265 8796", " 9110 9070 8633 9240") + ) [1] TRUE > # single row data frame > > all.equal(c(diffobj:::which_table_rh(capture.output(data.frame(1, 2)))), 2) [1] TRUE > > # More than 10 rows data.frame > > all.equal( + c(diffobj:::which_table_rh(capture.output(head(Puromycin, 10L)))), + 2:11 + ) [1] TRUE > # Bad wrap > > bw <- c( + " bad", "1 123", "2 456", + " dab", "1 123", "2 456", + " abd", "1 123") > > all.equal( + diffobj:::wtr_help(bw, diffobj:::.pat.tbl), + c(2L, 3L, 5L, 6L) + ) [1] TRUE > > # - Array > a <- array(1:6, c(3, 1, 2)) > a.c <- capture.output(a) > all.equal( + diffobj:::strip_array_rh(a.c, dimnames(a)), + c(", , 1", "", " [,1]", " 1", " 2", " 3", "", ", , 2", "", " [,1]", " 4", " 5", " 6", "") + ) [1] TRUE > viz_sarh <- function(capt, obj) + cbind( + capt, + as.integer( + seq_along(capt) %in% diffobj:::which_array_rh(capt, dimnames(obj)) + ) + ) > a1 <- a2 <- a3 <- a4 <- array( + "averylongphrasethatwillforcemytwocolumnarraytowrapblahblah", c(2, 2, 2) + ) > ca1 <- capture.output(a1) > viz_sarh(ca1, a1) capt [1,] ", , 1" [2,] "" [3,] " [,1] " [4,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " [,2] " [7,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " [,1] " [13,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " [,2] " [16,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [1,] "0" [2,] "0" [3,] "0" [4,] "1" [5,] "1" [6,] "0" [7,] "1" [8,] "1" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "1" [14,] "1" [15,] "0" [16,] "1" [17,] "1" [18,] "0" > all.equal( + diffobj:::which_array_rh(ca1, dimnames(a1)), + c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) + ) [1] TRUE > colnames(a2) <- c("ABC", "DEF") > ca2 <- capture.output(a2) > viz_sarh(ca2, a2) capt [1,] ", , 1" [2,] "" [3,] " ABC " [4,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " DEF " [7,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " ABC " [13,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " DEF " [16,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [1,] "0" [2,] "0" [3,] "0" [4,] "1" [5,] "1" [6,] "0" [7,] "1" [8,] "1" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "1" [14,] "1" [15,] "0" [16,] "1" [17,] "1" [18,] "0" > all.equal( + diffobj:::which_array_rh(ca2, dimnames(a2)), + c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) + ) [1] TRUE > rownames(a3) <- 1:2 > ca3 <- capture.output(a3) > viz_sarh(ca3, a3) capt [1,] ", , 1" [2,] "" [3,] " [,1] " [4,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " [,2] " [7,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " [,1] " [13,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " [,2] " [16,] "1 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "2 \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [1,] "0" [2,] "0" [3,] "0" [4,] "0" [5,] "0" [6,] "0" [7,] "0" [8,] "0" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "0" [14,] "0" [15,] "0" [16,] "0" [17,] "0" [18,] "0" > all.equal(diffobj:::which_array_rh(ca3, dimnames(a3)), integer(0L)) [1] TRUE > > attr(a4, "blahblah") <- matrix(1:4, 2) > ca4 <- capture.output(a4) > viz_sarh(ca4, a4) capt [1,] ", , 1" [2,] "" [3,] " [,1] " [4,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [5,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [6,] " [,2] " [7,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [8,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [9,] "" [10,] ", , 2" [11,] "" [12,] " [,1] " [13,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [14,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [15,] " [,2] " [16,] "[1,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [17,] "[2,] \"averylongphrasethatwillforcemytwocolumnarraytowrapblahblah\"" [18,] "" [19,] "attr(,\"blahblah\")" [20,] " [,1] [,2]" [21,] "[1,] 1 3" [22,] "[2,] 2 4" [1,] "0" [2,] "0" [3,] "0" [4,] "1" [5,] "1" [6,] "0" [7,] "1" [8,] "1" [9,] "0" [10,] "0" [11,] "0" [12,] "0" [13,] "1" [14,] "1" [15,] "0" [16,] "1" [17,] "1" [18,] "0" [19,] "0" [20,] "0" [21,] "0" [22,] "0" > all.equal( + diffobj:::which_array_rh(ca4, dimnames(a4)), + c(4L, 5L, 7L, 8L, 13L, 14L, 16L, 17L) + ) [1] TRUE > options(width=80) > > # - List ----------------------------------------------------------------------- > > l1 <- list( + matrix(1:4, 2), b=list(abc=c(letters, LETTERS), list(matrix(4:1, 2))) + ) > l1.c <- capture.output(l1) > all.equal( + diffobj:::strip_list_rh(l1.c, l1), + c("[[1]]", " [,1] [,2]", " 1 3", " 2 4", "", "$b", "$b$abc", "\"a\" \"b\" \"c\" \"d\" \"e\" \"f\" \"g\" \"h\" \"i\" \"j\" \"k\" \"l\" \"m\" \"n\" \"o\" \"p\" \"q\" \"r\" \"s\"", "\"t\" \"u\" \"v\" \"w\" \"x\" \"y\" \"z\" \"A\" \"B\" \"C\" \"D\" \"E\" \"F\" \"G\" \"H\" \"I\" \"J\" \"K\" \"L\"", "\"M\" \"N\" \"O\" \"P\" \"Q\" \"R\" \"S\" \"T\" \"U\" \"V\" \"W\" \"X\" \"Y\" \"Z\"", "", "$b[[2]]", "$b[[2]][[1]]", " [,1] [,2]", " 4 2", " 3 1", "", "", "") + ) [1] TRUE > > a <- list(list()) > aa <- list(list(), "a") > b <- list("a", list()) > c <- list(list("a"), "b") > d <- list("a", "b", "c") > > identical( + diffobj:::strip_list_rh(capture.output(d), d), + c("[[1]]", "\"a\"", "", "[[2]]", "\"b\"", "", "[[3]]", "\"c\"", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(a), a), + c("[[1]]", "list()", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(aa), aa), + c("[[1]]", "list()", "", "[[2]]", "\"a\"", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(b), b), + c("[[1]]", "\"a\"", "", "[[2]]", "list()", "") + ) [1] TRUE > identical( + diffobj:::strip_list_rh(capture.output(c), c), + c("[[1]]", "[[1]][[1]]", "\"a\"", "", "", "[[2]]", "\"b\"", "") + ) [1] TRUE > > # - custom trim fun ------------------------------------------------------------ > > a <- matrix(100:102) > b <- matrix(101:103) > fun1 <- function(x, y) cbind(rep(1L, 4), rep(5L, 4)) > > all.equal(as.character(diffPrint(a, b, trim=fun1)), rdsf(100)) [1] TRUE > if(getRversion() >= "3.2.2") { + capture.output( + trim.err <- as.character(diffPrint(a, b, trim=function(x, y) stop("boom"))), + type="message" + ) # warn: "If you did not specify a `trim`" + all.equal(trim.err, rdsf(200)) + } [1] TRUE Warning message: In apply_trim(current, cur.capt.p, etc@trim) : `trim*` method produced an error when attempting to trim ; If you did not specify a `trim` function or define custom `trim*` methods contact maintainer (see `?trim`). Proceeding without trimming. > # purposefully bad trim fun > > try( # "method return value must be a two " + diffPrint(1:100, 2:100, trim=function(x, y) TRUE) + ) Error in apply_trim(target, tar.capt.p, etc@trim) : `trim*` method return value must be a two column integer matrix with no NAs; If you did not specify a `trim` function or define custom `trim*` methods contact maintainer (see `?trim`). Proceeding without trimming. > try( # "Invalid trim function" + diffobj:::apply_trim(letters, letters, function(x) TRUE), + ) Error in diffobj:::apply_trim(letters, letters, function(x) TRUE) : Invalid trim function (does not have at least two arguments). If you did not customize the trim function contact maintainer; see `?trim` > try(# "must have as many rows" + diffobj:::apply_trim( + letters, letters, function(x, y) cbind(1:25, 1:25) + ) + ) Error in diffobj:::apply_trim(letters, letters, function(x, y) cbind(1:25, : `trim*` method output matrix must have as many rows as object character representation has elements; If you did not specify a `trim` function or define custom `trim*` methods contact maintainer (see `?trim`). Proceeding without trimming. > > # - s4 ------------------------------------------------------------------------- > > setClass("DOTrimTest", slots=c(a="numeric", b="list", c="matrix")) > obj <- new( + "DOTrimTest", a=1:40, b=list(a=1, letters, NULL), c=matrix(1:9, 3) + ) > all.equal( + diffobj:::strip_s4_rh(capture.output(obj), obj), rdsf(300) + ) [1] TRUE > > > proc.time() user system elapsed 0.92 0.10 1.03