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 <- "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      
> 
> proc.time()
   user  system elapsed 
   0.87    0.18    1.03