
R Under development (unstable) (2021-07-17 r80639) -- "Unsuffered Consequences"
Copyright (C) 2021 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin17.0 (64-bit)

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.

  Natural language support but running in an English locale

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 <- "guides"
> source(file.path('_helper', 'init.R'))
> 
> # - detect_2d_guides -----------------------------------------------------------
> 
> iris.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)")
> 
> all.equal(diffobj:::detect_2d_guides(iris.dply), 4:5)
[1] TRUE
> # wrapping data table with separator (#96)
> 
> DT.txt <- c(
+  "             V1        V2        V3",
+  "   1: 0.3201122 0.6907066 0.5004968",
+  "  ---                              ",
+  "1000: 0.3547379 0.2836985 0.8121208",
+  "            V4        V5",
+  "   1: 0.331665 0.6788726",
+  "  ---                   ",
+  "1000: 0.553012 0.7789110"
+ )
> all.equal(
+  diffobj:::detect_2d_guides(DT.txt),
+  c(1L, 5L)
+ )
[1] TRUE
> # Narrow width
> 
> old.opt <- options(width=40)
> all.equal(diffobj:::detect_2d_guides(capture.output(iris)), c(1, 152))
[1] TRUE
> all.equal(
+   diffobj:::detect_2d_guides(capture.output(USAccDeaths)), c(1, 8, 15)
+ )
[1] TRUE
> # Time series
> all.equal(diffobj:::detect_2d_guides(capture.output(UKgas)), 1)
[1] TRUE
> # no row.names (#111)
> 
> df1 <- capture.output(print(data.frame(a=1:3), row.names=FALSE))
> no.rn.guide <- diffobj:::detect_2d_guides(df1)  # no warning
> all.equal(no.rn.guide, 1L)
[1] TRUE
> 
> df2 <- capture.output(print(data.frame(x="A"), row.names=FALSE))
> no.rn.guide.2 <- diffobj:::detect_2d_guides(df2)  # no warning
> all.equal(no.rn.guide.2, 1L)
[1] TRUE
> options(old.opt)
> 
> # - detect_list_guides ---------------------------------------------------------
> 
> l.1 <- list(1, 1:3, matrix(1:3, 1))
> l.2 <- list(a=1, list(1:3, b=4, c=list(1, b=2)), matrix(1:3, 1))
> c.l.1 <- capture.output(l.1)
> c.l.2 <- capture.output(l.2)
> # cbind(c.l.2, seq_along(c.l.2) %in% diffobj:::detect_list_guides(c.l.2))
> all.equal(diffobj:::detect_list_guides(capture.output(l.1)), c(1, 4, 7))
[1] TRUE
> all.equal(
+   diffobj:::detect_list_guides(capture.output(l.2)),
+   c(1, 5, 8, 12, 15, 20)
+ )
[1] TRUE
> 
> # - detect_matrix_guides -------------------------------------------------------
> mx3 <- mx4 <- mx5 <- mx5a <- mx11 <- matrix(
+  c(
+     "averylongwordthatcanlahblah", "causeasinglewidecolumnblah",
+     "matrixtowrapseveraltimes", "inarrowscreen", "onceuponatime",
+     "agreenduckflew", "overthemountains", "inalongofantelopes",
+     "ineedthreemore", "entriesactually", "nowonlytwomore", "iwaswrongearlier"
+   ),
+   nrow=3, ncol=4
+ )
> mx3.c <- capture.output(mx3)
> all.equal(diffobj:::detect_matrix_guides(mx3.c, NULL), c(1, 5))
[1] TRUE
> 
> dimnames(mx4) <- list(A=NULL, B=NULL)
> mx4.c <- capture.output(mx4)
> all.equal(
+   diffobj:::detect_matrix_guides(mx4.c, dimnames(mx4)), c(1, 2, 6, 7)
+ )
[1] TRUE
> attr(mx5, "blah") <- letters[1:10]
> mx5.c <- capture.output(mx5)
> all.equal(
+   diffobj:::detect_matrix_guides(mx5.c, dimnames(mx5)), c(1, 5)
+ )
[1] TRUE
> # Simple matrices that don't wrap
> 
> mx6 <- mx7 <- mx7.1 <- matrix(1:4, 2)
> 
> mx6.c <- capture.output(mx6)
> all.equal(diffobj:::detect_matrix_guides(mx6.c, dimnames(mx6)), 1)
[1] TRUE
> 
> dimnames(mx7) <- list(A=letters[1:2], B=LETTERS[25:26])
> mx7.c <- capture.output(mx7)
> all.equal(diffobj:::detect_matrix_guides(mx7.c, dimnames(mx7)), c(1, 2))
[1] TRUE
> 
> dimnames(mx7.1) <- list(letters[1:2], B=LETTERS[25:26])
> mx7.1.c <- capture.output(mx7.1)
> all.equal(diffobj:::detect_matrix_guides(mx7.1.c, dimnames(mx7.1)), c(1, 2))
[1] TRUE
> 
> # Single col matrix
> 
> mx8 <- matrix(1:2, 2)
> 
> mx8.c <- capture.output(mx8)
> all.equal(diffobj:::detect_matrix_guides(mx8.c, dimnames(mx8)), 1)
[1] TRUE
> 
> # Wrapping matrices with colnames
> 
> mx9 <- mx3
> dimnames(mx9) <- list(A=letters[1:3], B=LETTERS[20:23])
> mx9.c <- capture.output(mx9)
> all.equal(
+   diffobj:::detect_matrix_guides(mx9.c, dimnames(mx9)), c(1:2, 6:7)
+ )
[1] TRUE
> 
> mx10 <- mx9
> attr(mx10, "blah") <- matrix(1:4, 2)
> mx10.c <- capture.output(mx10)
> all.equal(
+   diffobj:::detect_matrix_guides(mx10.c, dimnames(mx10)), c(1:2, 6:7)
+ )
[1] TRUE
> local({
+   old.opt <- options(width=30L)
+   on.exit(options(old.opt))
+   attr(mx11, "blah") <- letters[1:15]
+   mx11.c <- capture.output(mx11)
+ 
+   all.equal(
+     diffobj:::detect_matrix_guides(mx11.c, dimnames(mx11)), c(1, 5, 9, 13)
+   )
+ })
[1] TRUE
> # - detect_array_guides --------------------------------------------------------
> 
> a.1 <- array(1:6, dim=c(2, 1, 3))
> a.2 <- array(1:6, dim=c(2, 1, 3), dimnames=list(NULL, "X", LETTERS[1:3]))
> a.3 <- array(
+   1:6, dim=c(2, 1, 3),
+   dimnames=list(rows=NULL, cols="X", LETTERS[1:3])
+ )
> a.4 <- `attr<-`(a.3, "hello", "random attribute")
> a.5 <- array(1:36, dim=c(6, 2, 3))
> a.6 <- array(1:2, c(2, 1, 1))
> c.a.1 <- capture.output(a.1)
> c.a.2 <- capture.output(a.2)
> c.a.3 <- capture.output(a.3)
> c.a.4 <- capture.output(a.4)
> c.a.5 <- capture.output(a.5)
> c.a.6 <- capture.output(a.6)
> # helper funs to vizualize the guide line detection
> # viz_dag <- function(capt, obj)
> #   cbind(
> #     capt,
> #     seq_along(capt) %in% diffobj:::detect_array_guides(capt, dimnames(obj))
> #   )
> # viz_dag(c.a.1, a.1)
> # viz_dag(c.a.2, a.2)
> # viz_dag(c.a.3, a.3)
> # viz_dag(c.a.4, a.4)
> # viz_dag(c.a.5, a.5)
> # viz_dag(c.a.6, a.6)
> all.equal(
+   diffobj:::detect_array_guides(c.a.1, dimnames(a.1)),
+   c(1L, 2L, 7L, 8L, 13L, 14L)
+ )
[1] TRUE
> all.equal(
+   diffobj:::detect_array_guides(c.a.2, dimnames(a.2)),
+   c(1L, 2L, 7L, 8L, 13L, 14L)
+ )
[1] TRUE
> all.equal(
+   diffobj:::detect_array_guides(c.a.3, dimnames(a.3)),
+   c(1L, 2L, 8L, 9L, 15L, 16L)
+ )
[1] TRUE
> all.equal(
+   diffobj:::detect_array_guides(c.a.4, dimnames(a.4)),
+   c(1L, 2L, 8L, 9L, 15L, 16L)
+ )
[1] TRUE
> all.equal(
+   diffobj:::detect_array_guides(c.a.5, dimnames(a.5)),
+   c(1L, 2L, 11L, 12L, 21L, 22L)
+ )
[1] TRUE
> all.equal(
+   diffobj:::detect_array_guides(c.a.6, dimnames(a.6)),
+   c(1L, 2L)
+ )
[1] TRUE
> # - detect_s4_guides -----------------------------------------------------------
> 
> setClass("gtest2", slots=c(hello="integer", `good bye`="list"))
> setClass("gtest1",
+   slots=c(
+     sub.class="gtest2", blah="character", gah="list", sub.class.2="gtest2"
+ ) )
> obj <- new(
+   "gtest1",
+   sub.class=new(
+     "gtest2", hello=1:3, `good bye`=list("a", list(l1=5, l2="wow"))
+   ),
+   blah=letters, gah=list(one=1:10, two=LETTERS),
+   sub.class.2=new(
+     "gtest2", hello=3:1, `good bye`=list("B", list(l1=5, l2="wow"))
+   )
+ )
> # note at this point the nested stuff doesn't work, so we're just shooting for
> # the simple match
> 
> c.1 <- capture.output(obj)
> identical(
+   diffobj:::detect_s4_guides(c.1, obj),
+   c(1L, 2L, 21L, 25L, 34L)
+ )
[1] TRUE
> # small diff as that has a non-default show method
> 
> diff <- diffChr("a", "b", format='raw')
> diff.out <- capture.output(show(diff))
> all.equal(
+   diffobj:::detect_s4_guides(diff.out, diff),
+   integer()
+ )
[1] TRUE
> # - custom guide fun -----------------------------------------------------------
> 
> a <- b <- matrix(1:100)
> b[50] <- -99L
> 
> fun1 <- function(x, y) c(1L, 14L, 53L)
> 
> all.equal(as.character(diffPrint(a, b, guides=fun1)), rdsf(100))
[1] TRUE
> if(getRversion() >= "3.2.2") {
+   capture.output( # warn: "If you did not specify a `guides`"
+     trim.err <-
+       as.character(diffPrint(a, b, guides=function(x, y) stop("boom"))),
+     type="message"
+   )
+   all.equal(trim.err, rdsf(200))
+ }
[1] TRUE
Warning message:
In apply_guides(current, cur.capt, guide_fun) :
  `guides*` method produced an error when attempting to compute guide lines ; If you did not specify a `guides` function or define custom `guides*` methods contact maintainer (see `?guides`).  Proceeding without guides.
> # "must produce an integer vector"
> try(diffobj:::apply_guides(1:26, LETTERS, function(x, y) 35L))
Error in diffobj:::apply_guides(1:26, LETTERS, function(x, y) 35L) : 
  `guides*` method must produce an integer vector containing unique index values for the `obj.as.chr` vector; If you did not specify a `guides` function or define custom `guides*` methods contact maintainer (see `?guides`).  Proceeding without guides.
> 
> # - errors ---------------------------------------------------------------------
> 
> try(guidesStr(1:26, rep(NA_character_, 26)))# "Cannot compute guides"
Error in guidesStr(1:26, rep(NA_character_, 26)) : 
  Cannot compute guides if `obj.as.chr` contains NAs
> try(guidesPrint(1:26, rep(NA_character_, 26)))# "Cannot compute guides"
Error in guidesPrint(1:26, rep(NA_character_, 26)) : 
  Cannot compute guides if `obj.as.chr` contains NAs
> 
> # - corner cases ---------------------------------------------------------------
> 
> all.equal(
+   diffobj:::split_by_guides(letters, integer()),
+   list(structure(letters, idx=seq_along(letters)))
+ )
[1] TRUE
> try(guidesStr(1:26, rep(NA_character_, 26))) # "Cannot compute guides"
Error in guidesStr(1:26, rep(NA_character_, 26)) : 
  Cannot compute guides if `obj.as.chr` contains NAs
> try(guidesPrint(1:26, rep(NA_character_, 26))) # "Cannot compute guides"
Error in guidesPrint(1:26, rep(NA_character_, 26)) : 
  Cannot compute guides if `obj.as.chr` contains NAs
> 
> # - issue 117 - 2d guide failure -----------------------------------------------
> 
> # Thanks to Sebastian Meyer (@bastician) for MRE
> a <- b <- data.frame(ID = 0, value = 1)
> b$value <- 2
> a <- a[c(rep(1, 86), 2)]
> b <- b[c(rep(1, 86), 2)]
> diffPrint(a, b, mode = "unified", format='raw', context=0)
< a            
> b            
@@ 16 / 16 @@  
~   value      
< 1     1      
> 1     2      
> 
