1NAME <- "guides" 2source(file.path('_helper', 'init.R')) 3 4# - detect_2d_guides ----------------------------------------------------------- 5 6iris.dply <- c("Source: local data frame [150 x 5]", "Groups: Species [3]", "", " Sepal.Length Sepal.Width", " (dbl) (dbl)", "1 5.1 3.5", "2 4.9 3.0", "3 4.7 3.2", "4 4.6 3.1", "5 5.0 3.6", "6 5.4 3.9", "7 4.6 3.4", "8 5.0 3.4", "9 4.4 2.9", "10 4.9 3.1", ".. ... ...", "Variables not shown: Petal.Length", " (dbl), Petal.Width (dbl), Species", " (fctr)") 7 8all.equal(diffobj:::detect_2d_guides(iris.dply), 4:5) 9# wrapping data table with separator (#96) 10 11DT.txt <- c( 12 " V1 V2 V3", 13 " 1: 0.3201122 0.6907066 0.5004968", 14 " --- ", 15 "1000: 0.3547379 0.2836985 0.8121208", 16 " V4 V5", 17 " 1: 0.331665 0.6788726", 18 " --- ", 19 "1000: 0.553012 0.7789110" 20) 21all.equal( 22 diffobj:::detect_2d_guides(DT.txt), 23 c(1L, 5L) 24) 25# Narrow width 26 27old.opt <- options(width=40) 28all.equal(diffobj:::detect_2d_guides(capture.output(iris)), c(1, 152)) 29all.equal( 30 diffobj:::detect_2d_guides(capture.output(USAccDeaths)), c(1, 8, 15) 31) 32# Time series 33all.equal(diffobj:::detect_2d_guides(capture.output(UKgas)), 1) 34# no row.names (#111) 35 36df1 <- capture.output(print(data.frame(a=1:3), row.names=FALSE)) 37no.rn.guide <- diffobj:::detect_2d_guides(df1) # no warning 38all.equal(no.rn.guide, 1L) 39 40df2 <- capture.output(print(data.frame(x="A"), row.names=FALSE)) 41no.rn.guide.2 <- diffobj:::detect_2d_guides(df2) # no warning 42all.equal(no.rn.guide.2, 1L) 43options(old.opt) 44 45# - detect_list_guides --------------------------------------------------------- 46 47l.1 <- list(1, 1:3, matrix(1:3, 1)) 48l.2 <- list(a=1, list(1:3, b=4, c=list(1, b=2)), matrix(1:3, 1)) 49c.l.1 <- capture.output(l.1) 50c.l.2 <- capture.output(l.2) 51# cbind(c.l.2, seq_along(c.l.2) %in% diffobj:::detect_list_guides(c.l.2)) 52all.equal(diffobj:::detect_list_guides(capture.output(l.1)), c(1, 4, 7)) 53all.equal( 54 diffobj:::detect_list_guides(capture.output(l.2)), 55 c(1, 5, 8, 12, 15, 20) 56) 57 58# - detect_matrix_guides ------------------------------------------------------- 59mx3 <- mx4 <- mx5 <- mx5a <- mx11 <- matrix( 60 c( 61 "averylongwordthatcanlahblah", "causeasinglewidecolumnblah", 62 "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime", 63 "agreenduckflew", "overthemountains", "inalongofantelopes", 64 "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier" 65 ), 66 nrow=3, ncol=4 67) 68mx3.c <- capture.output(mx3) 69all.equal(diffobj:::detect_matrix_guides(mx3.c, NULL), c(1, 5)) 70 71dimnames(mx4) <- list(A=NULL, B=NULL) 72mx4.c <- capture.output(mx4) 73all.equal( 74 diffobj:::detect_matrix_guides(mx4.c, dimnames(mx4)), c(1, 2, 6, 7) 75) 76attr(mx5, "blah") <- letters[1:10] 77mx5.c <- capture.output(mx5) 78all.equal( 79 diffobj:::detect_matrix_guides(mx5.c, dimnames(mx5)), c(1, 5) 80) 81# Simple matrices that don't wrap 82 83mx6 <- mx7 <- mx7.1 <- matrix(1:4, 2) 84 85mx6.c <- capture.output(mx6) 86all.equal(diffobj:::detect_matrix_guides(mx6.c, dimnames(mx6)), 1) 87 88dimnames(mx7) <- list(A=letters[1:2], B=LETTERS[25:26]) 89mx7.c <- capture.output(mx7) 90all.equal(diffobj:::detect_matrix_guides(mx7.c, dimnames(mx7)), c(1, 2)) 91 92dimnames(mx7.1) <- list(letters[1:2], B=LETTERS[25:26]) 93mx7.1.c <- capture.output(mx7.1) 94all.equal(diffobj:::detect_matrix_guides(mx7.1.c, dimnames(mx7.1)), c(1, 2)) 95 96# Single col matrix 97 98mx8 <- matrix(1:2, 2) 99 100mx8.c <- capture.output(mx8) 101all.equal(diffobj:::detect_matrix_guides(mx8.c, dimnames(mx8)), 1) 102 103# Wrapping matrices with colnames 104 105mx9 <- mx3 106dimnames(mx9) <- list(A=letters[1:3], B=LETTERS[20:23]) 107mx9.c <- capture.output(mx9) 108all.equal( 109 diffobj:::detect_matrix_guides(mx9.c, dimnames(mx9)), c(1:2, 6:7) 110) 111 112mx10 <- mx9 113attr(mx10, "blah") <- matrix(1:4, 2) 114mx10.c <- capture.output(mx10) 115all.equal( 116 diffobj:::detect_matrix_guides(mx10.c, dimnames(mx10)), c(1:2, 6:7) 117) 118local({ 119 old.opt <- options(width=30L) 120 on.exit(options(old.opt)) 121 attr(mx11, "blah") <- letters[1:15] 122 mx11.c <- capture.output(mx11) 123 124 all.equal( 125 diffobj:::detect_matrix_guides(mx11.c, dimnames(mx11)), c(1, 5, 9, 13) 126 ) 127}) 128# - detect_array_guides -------------------------------------------------------- 129 130a.1 <- array(1:6, dim=c(2, 1, 3)) 131a.2 <- array(1:6, dim=c(2, 1, 3), dimnames=list(NULL, "X", LETTERS[1:3])) 132a.3 <- array( 133 1:6, dim=c(2, 1, 3), 134 dimnames=list(rows=NULL, cols="X", LETTERS[1:3]) 135) 136a.4 <- `attr<-`(a.3, "hello", "random attribute") 137a.5 <- array(1:36, dim=c(6, 2, 3)) 138a.6 <- array(1:2, c(2, 1, 1)) 139c.a.1 <- capture.output(a.1) 140c.a.2 <- capture.output(a.2) 141c.a.3 <- capture.output(a.3) 142c.a.4 <- capture.output(a.4) 143c.a.5 <- capture.output(a.5) 144c.a.6 <- capture.output(a.6) 145# helper funs to vizualize the guide line detection 146# viz_dag <- function(capt, obj) 147# cbind( 148# capt, 149# seq_along(capt) %in% diffobj:::detect_array_guides(capt, dimnames(obj)) 150# ) 151# viz_dag(c.a.1, a.1) 152# viz_dag(c.a.2, a.2) 153# viz_dag(c.a.3, a.3) 154# viz_dag(c.a.4, a.4) 155# viz_dag(c.a.5, a.5) 156# viz_dag(c.a.6, a.6) 157all.equal( 158 diffobj:::detect_array_guides(c.a.1, dimnames(a.1)), 159 c(1L, 2L, 7L, 8L, 13L, 14L) 160) 161all.equal( 162 diffobj:::detect_array_guides(c.a.2, dimnames(a.2)), 163 c(1L, 2L, 7L, 8L, 13L, 14L) 164) 165all.equal( 166 diffobj:::detect_array_guides(c.a.3, dimnames(a.3)), 167 c(1L, 2L, 8L, 9L, 15L, 16L) 168) 169all.equal( 170 diffobj:::detect_array_guides(c.a.4, dimnames(a.4)), 171 c(1L, 2L, 8L, 9L, 15L, 16L) 172) 173all.equal( 174 diffobj:::detect_array_guides(c.a.5, dimnames(a.5)), 175 c(1L, 2L, 11L, 12L, 21L, 22L) 176) 177all.equal( 178 diffobj:::detect_array_guides(c.a.6, dimnames(a.6)), 179 c(1L, 2L) 180) 181# - detect_s4_guides ----------------------------------------------------------- 182 183setClass("gtest2", slots=c(hello="integer", `good bye`="list")) 184setClass("gtest1", 185 slots=c( 186 sub.class="gtest2", blah="character", gah="list", sub.class.2="gtest2" 187) ) 188obj <- new( 189 "gtest1", 190 sub.class=new( 191 "gtest2", hello=1:3, `good bye`=list("a", list(l1=5, l2="wow")) 192 ), 193 blah=letters, gah=list(one=1:10, two=LETTERS), 194 sub.class.2=new( 195 "gtest2", hello=3:1, `good bye`=list("B", list(l1=5, l2="wow")) 196 ) 197) 198# note at this point the nested stuff doesn't work, so we're just shooting for 199# the simple match 200 201c.1 <- capture.output(obj) 202identical( 203 diffobj:::detect_s4_guides(c.1, obj), 204 c(1L, 2L, 21L, 25L, 34L) 205) 206# small diff as that has a non-default show method 207 208diff <- diffChr("a", "b", format='raw') 209diff.out <- capture.output(show(diff)) 210all.equal( 211 diffobj:::detect_s4_guides(diff.out, diff), 212 integer() 213) 214# - custom guide fun ----------------------------------------------------------- 215 216a <- b <- matrix(1:100) 217b[50] <- -99L 218 219fun1 <- function(x, y) c(1L, 14L, 53L) 220 221all.equal(as.character(diffPrint(a, b, guides=fun1)), rdsf(100)) 222if(getRversion() >= "3.2.2") { 223 capture.output( # warn: "If you did not specify a `guides`" 224 trim.err <- 225 as.character(diffPrint(a, b, guides=function(x, y) stop("boom"))), 226 type="message" 227 ) 228 all.equal(trim.err, rdsf(200)) 229} 230# "must produce an integer vector" 231try(diffobj:::apply_guides(1:26, LETTERS, function(x, y) 35L)) 232 233# - errors --------------------------------------------------------------------- 234 235try(guidesStr(1:26, rep(NA_character_, 26)))# "Cannot compute guides" 236try(guidesPrint(1:26, rep(NA_character_, 26)))# "Cannot compute guides" 237 238# - corner cases --------------------------------------------------------------- 239 240all.equal( 241 diffobj:::split_by_guides(letters, integer()), 242 list(structure(letters, idx=seq_along(letters))) 243) 244try(guidesStr(1:26, rep(NA_character_, 26))) # "Cannot compute guides" 245try(guidesPrint(1:26, rep(NA_character_, 26))) # "Cannot compute guides" 246 247# - issue 117 - 2d guide failure ----------------------------------------------- 248 249# Thanks to Sebastian Meyer (@bastician) for MRE 250a <- b <- data.frame(ID = 0, value = 1) 251b$value <- 2 252a <- a[c(rep(1, 86), 2)] 253b <- b[c(rep(1, 86), 2)] 254diffPrint(a, b, mode = "unified", format='raw', context=0) 255