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