waldo/ 0000755 0001762 0000144 00000000000 14120163722 011356 5 ustar ligges users waldo/NAMESPACE 0000644 0001762 0000144 00000001235 14120157774 012610 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(compare_proxy,Descriptor)
S3method(compare_proxy,EnumDescriptor)
S3method(compare_proxy,EnumValueDescriptor)
S3method(compare_proxy,FieldDescriptor)
S3method(compare_proxy,FileDescriptor)
S3method(compare_proxy,Message)
S3method(compare_proxy,MethodDescriptor)
S3method(compare_proxy,ServiceDescriptor)
S3method(compare_proxy,data.table)
S3method(compare_proxy,default)
S3method(compare_proxy,xml_node)
S3method(print,waldo_compare)
export(compare)
export(compare_proxy)
import(rlang)
importFrom(glue,glue)
importFrom(methods,.hasSlot)
importFrom(methods,is)
importFrom(methods,slot)
importFrom(methods,slotNames)
waldo/LICENSE 0000644 0001762 0000144 00000000045 13637650412 012373 0 ustar ligges users YEAR: 2020
COPYRIGHT HOLDER: RStudio
waldo/README.md 0000644 0001762 0000144 00000010037 14107730523 012642 0 ustar ligges users
# waldo
[](https://codecov.io/gh/r-lib/waldo?branch=master)
[](https://github.com/r-lib/waldo/actions)
The goal of waldo is to find and concisely describe the difference
between a pair of R objects, with the primary goal of making it easier
to figure out what’s gone wrong in your unit tests.
`waldo::compare()` is inspired by `all.equal()`, but takes additional
care to generate actionable insights by:
- Ordering the differences from most important to least important.
- Displaying the values of atomic vectors that are actually different.
- Carefully using colour to emphasise changes (while still being
readable when colour isn’t available).
- Using R code (not a text description) to show where differences
arise.
- Where possible, comparing elements by name, rather than by position.
- Erring on the side of producing too much output, rather than too
little.
## Installation
You can install the released version of waldo from
[CRAN](https://CRAN.R-project.org) with:
``` r
install.packages("waldo")
```
## Comparisons
``` r
library(waldo)
```
When comparing atomic vectors, `compare()` produces diffs (thanks to
[diffobj](https://github.com/brodieG/diffobj)) that highlight additions,
deletions, and changes, along with a little context:
- Addition
``` asciicast
compare(c("a", "b", "c"), c("a", "b"))
```
- Deletion
``` asciicast
compare(c("a", "b"), c("a", "b", "c"))
```
- Change
``` asciicast
compare(c("a", "b", "c"), c("a", "B", "c"))
```
- Long vectors with short differences only show local context around
changes, not everything that’s the same.
``` asciicast
compare(c("X", letters), c(letters, "X"))
```
Depending on the relative size of the differences and the width of your
console you’ll get one of three displays:
- The default display is to show the vectors one atop the other:
``` asciicast
compare(letters[1:5], letters[1:6])
```
- If there’s not enough room for that, the two vectors are shown
side-by-side:
``` asciicast
options(width = 20)
compare(letters[1:5], letters[1:6])
```
- And if there’s still not enough room for side-by-side, the each
element is given its own line:
``` asciicast
options(width = 10)
compare(letters[1:5], letters[1:6])
```
When comparing more complex objects, waldo creates an executable code
path telling you where the differences lie:
- Unnamed lists are compared by position:
``` asciicast
compare(list(factor("x")), list(1L))
```
- Named lists, including data frames, are compared by name. For
example, note that the following comparison reports a difference in
the class and names, but not the values of the columns.
``` asciicast
df1 <- data.frame(x = 1:3, y = 3:1)
df2 <- tibble::tibble(rev(df1))
compare(df1, df2)
```
- Recursion can be arbitrarily deep:
``` asciicast
x <- list(a = list(b = list(c = list(structure(1, e = 1)))))
y <- list(a = list(b = list(c = list(structure(1, e = "a")))))
compare(x, y)
```
waldo/man/ 0000755 0001762 0000144 00000000000 14120161300 012117 5 ustar ligges users waldo/man/waldo-package.Rd 0000644 0001762 0000144 00000001446 14073210415 015123 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/waldo-package.R
\docType{package}
\name{waldo-package}
\alias{waldo}
\alias{waldo-package}
\title{waldo: Find Differences Between R Objects}
\description{
Compare complex R objects and reveal the key
differences. Designed particularly for use in testing packages where
being able to quickly isolate key differences makes understanding test
failures much easier.
}
\seealso{
Useful links:
\itemize{
\item \url{https://waldo.r-lib.org}
\item \url{https://github.com/r-lib/waldo}
\item Report bugs at \url{https://github.com/r-lib/waldo/issues}
}
}
\author{
\strong{Maintainer}: Hadley Wickham \email{hadley@rstudio.com}
Other contributors:
\itemize{
\item RStudio [copyright holder]
}
}
\keyword{internal}
waldo/man/compare_proxy.Rd 0000644 0001762 0000144 00000002477 14075620577 015340 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/proxy.R
\name{compare_proxy}
\alias{compare_proxy}
\title{Proxy for waldo comparison}
\usage{
compare_proxy(x, path = "x")
}
\arguments{
\item{x}{An object.}
\item{path}{Path}
}
\value{
A list with two components:
\itemize{
\item \code{object}: the modified object
\item \code{path}: an updated path showing what modification was applied
}
}
\description{
Use this generic to override waldo's default comparison if you need to
override the defaults (typically because your object stores data in an
external pointer).
waldo comes with methods for a few common cases:
\itemize{
\item data.table: the \code{.internal.selfref} attribute is set to \code{NULL}. This is
an external pointer that is used for performance optimisation, and
doesn't affect the data.
\item \code{xml2::xml_node}: the underlying XML data is stored in memory in C,
behind an external pointer, so the we best can do is to convert the
object to a string.
\item Classes from the \code{RProtoBuf} package: like XML objects, these store
data in memory in C++ and only expose string names to R. Fortunately,
these have well-understood string representations that we can use for
comparisons. See
\url{https://developers.google.com/protocol-buffers/docs/reference/cpp/google.protobuf.text_format}
}
}
waldo/man/figures/ 0000755 0001762 0000144 00000000000 14120161300 013563 5 ustar ligges users waldo/man/figures/README/ 0000755 0001762 0000144 00000000000 14107730175 014541 5 ustar ligges users waldo/man/figures/README/unnamed-chunk-12.svg 0000644 0001762 0000144 00000003612 14107730523 020236 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-2.svg 0000644 0001762 0000144 00000002761 14107730520 020156 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-11.svg 0000644 0001762 0000144 00000003432 14107730523 020235 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-5.svg 0000644 0001762 0000144 00000004226 14107730521 020160 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-9.svg 0000644 0001762 0000144 00000001553 14107730522 020165 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-10.svg 0000644 0001762 0000144 00000003703 14107730522 020234 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-4.svg 0000644 0001762 0000144 00000003103 14107730521 020150 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-6.svg 0000644 0001762 0000144 00000003113 14107730521 020153 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-7.svg 0000644 0001762 0000144 00000004164 14107730522 020164 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-3.svg 0000644 0001762 0000144 00000002777 14107730520 020166 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-8.svg 0000644 0001762 0000144 00000002746 14107730522 020171 0 ustar ligges users waldo/man/compare.Rd 0000644 0001762 0000144 00000014577 14075620577 014103 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/compare.R
\name{compare}
\alias{compare}
\title{Compare two objects}
\usage{
compare(
x,
y,
...,
x_arg = "old",
y_arg = "new",
tolerance = NULL,
max_diffs = if (in_ci()) Inf else 10,
ignore_srcref = TRUE,
ignore_attr = "waldo_opts",
ignore_encoding = TRUE,
ignore_function_env = FALSE,
ignore_formula_env = FALSE,
list_as_map = FALSE
)
}
\arguments{
\item{x, y}{Objects to compare. \code{y} is treated as the reference object
so messages describe how \code{x} is different to \code{y}}
\item{...}{A handful of other arguments are supported with a warning for
backward compatability. These include:
\itemize{
\item \code{all.equal()} arguments \code{checkNames} and \code{check.attributes}
\item \code{testthat::compare()} argument \code{tol}
}
All other arguments are ignored with a warning.}
\item{x_arg, y_arg}{Name of \code{x} and \code{y} arguments, used when generated paths
to internal components. These default to "old" and "new" since it's
most natural to supply the previous value then the new value.}
\item{tolerance}{If non-\code{NULL}, used as threshold for ignoring small
floating point difference when comparing numeric vectors. Setting to
any non-\code{NULL} value will cause integer and double vectors to be compared
based on their values, rather than their types.
It uses the same algorithm as \code{\link[=all.equal]{all.equal()}}, i.e., first we generate
\code{x_diff} and \code{y_diff} by subsetting \code{x} and \code{y} to look only locations
with differences. Then we check that
\code{mean(abs(x_diff - y_diff)) / mean(abs(y_diff))} (or just
\code{mean(abs(x_diff - y_diff))} if \code{y_diff} is small) is less than
\code{tolerance}.}
\item{max_diffs}{Control the maximum number of differences shown. The
default shows 10 differences when run interactively and all differences
when run in CI. Set \code{max_diffs = Inf} to see all differences.}
\item{ignore_srcref}{Ignore differences in function \code{srcref}s? \code{TRUE} by
default since the \code{srcref} does not change the behaviour of a function,
only its printed representation.}
\item{ignore_attr}{Ignore differences in specified attributes?
Supply a character vector to ignore differences in named attributes.
By default the \code{"waldo_opts"} attribute is listed in \code{ignore_attr} so
that changes to it are not reported; if you customize \code{ignore_attr}, you
will probably want to do this yourself.
For backward compatibility with \code{all.equal()}, you can also use \code{TRUE},
to all ignore differences in all attributes. This is not generally
recommended as it is a blunt tool that will ignore many important
functional differences.}
\item{ignore_encoding}{Ignore string encoding? \code{TRUE} by default, because
this is R's default behaviour. Use \code{FALSE} when specifically concerned
with the encoding, not just the value of the string.}
\item{ignore_function_env, ignore_formula_env}{Ignore the environments of
functions and formulas, respectively? These are provided primarily for
backward compatibility with \code{all.equal()} which always ignores these
environments.}
\item{list_as_map}{Compare lists as if they are mappings between names and
values. Concretely, this drops \code{NULLs} in both objects and sorts named
components.}
}
\value{
A character vector with class "waldo_compare". If there are no
differences it will have length 0; otherwise each element contains the
description of a single difference.
}
\description{
This compares two R objects, identifying the key differences. It:
\itemize{
\item Orders the differences from most important to least important.
\item Displays the values of atomic vectors that are actually different.
\item Carefully uses colour to emphasise changes (while still being readable
when colour isn't available).
\item Uses R code (not a text description) to show where differences arise.
\item Where possible, it compares elements by name, rather than by position.
\item Errs on the side of producing too much output, rather than too little.
}
\code{compare()} is an alternative to \code{\link[=all.equal]{all.equal()}}.
}
\section{Controlling comparisons}{
There are two ways for an object (rather than the person calling \code{compare()}
or \code{expect_equal()} to control how it is compared to other objects.
First, if the object has an S3 class, you can provide a \code{\link[=compare_proxy]{compare_proxy()}}
method that provides an alternative representation of the object; this is
particularly useful if important data is stored outside of R, e.g. in
an external pointer.
Alternatively, you can attach an attribute called \code{"waldo_opts"} to your
object. This should be a list of compare options, using the same names
and possible values as the arguments to this function. This option
is ignored by default (\code{ignore_attr}) so that you can set the options in
the object that you control. (If you don't want to see the attributes
interactively, you could attach them in a \code{\link[=compare_proxy]{compare_proxy()}} method.)
Options supplied in this way also affect all the children. This means
options are applied in the following order, from lowest to highest
precedence:
\enumerate{
\item Defaults from \code{compare()}.
\item The \code{waldo_opts} for the parents of \code{x}.
\item The \code{waldo_opts} for the parents of \code{y}.
\item The \code{waldo_opts} for \code{x}.
\item The \code{waldo_opts} for \code{y}.
\item User-specified arguments to \code{compare()}.
}
Use these techniques with care. If you accidentally cover up an important
difference you can create a confusing situation where \code{x} and \code{y} behave
differently but \code{compare()} reports no differences in the underlying objects.
}
\examples{
# Thanks to diffobj package comparison of atomic vectors shows differences
# with a little context
compare(letters, c("z", letters[-26]))
compare(c(1, 2, 3), c(1, 3))
compare(c(1, 2, 3), c(1, 3, 4, 5))
compare(c(1, 2, 3), c(1, 2, 5))
# More complex objects are traversed, stopping only when the types are
# different
compare(
list(x = list(y = list(structure(1, z = 2)))),
list(x = list(y = list(structure(1, z = "a"))))
)
# Where possible, recursive structures are compared by name
compare(iris, rev(iris))
compare(list(x = "x", y = "y"), list(y = "y", x = "x"))
# Otherwise they're compared by position
compare(list("x", "y"), list("x", "z"))
compare(list(x = "x", x = "y"), list(x = "x", y = "z"))
}
waldo/DESCRIPTION 0000644 0001762 0000144 00000002111 14120163722 013057 0 ustar ligges users Package: waldo
Title: Find Differences Between R Objects
Version: 0.3.1
Authors@R:
c(person(given = "Hadley",
family = "Wickham",
role = c("aut", "cre"),
email = "hadley@rstudio.com"),
person(given = "RStudio",
role = "cph"))
Description: Compare complex R objects and reveal the key
differences. Designed particularly for use in testing packages where
being able to quickly isolate key differences makes understanding test
failures much easier.
License: MIT + file LICENSE
URL: https://waldo.r-lib.org, https://github.com/r-lib/waldo
BugReports: https://github.com/r-lib/waldo/issues
Imports: cli, diffobj (>= 0.3.4), fansi, glue, methods, rematch2, rlang
(>= 0.4.10), tibble
Suggests: testthat (>= 3.0.0), covr, R6, withr, xml2
Encoding: UTF-8
RoxygenNote: 7.1.2
Config/testthat/edition: 3
NeedsCompilation: no
Packaged: 2021-09-14 17:58:24 UTC; hadley
Author: Hadley Wickham [aut, cre],
RStudio [cph]
Maintainer: Hadley Wickham
Repository: CRAN
Date/Publication: 2021-09-14 18:20:02 UTC
waldo/tests/ 0000755 0001762 0000144 00000000000 14120161300 012506 5 ustar ligges users waldo/tests/testthat/ 0000755 0001762 0000144 00000000000 14120163722 014360 5 ustar ligges users waldo/tests/testthat/test-diff.R 0000644 0001762 0000144 00000003264 14074351553 016406 0 ustar ligges users test_that("paired diffs", {
expect_snapshot({
"no difference"
diff_element(c("a", "b"), c("a", "b"))
"single change"
diff_element(c("a", "b", "c"), c("a", "b"))
diff_element(c("a", "b"), c("a", "b", "c"))
diff_element(c("a", "B", "c"), c("a", "b", "c"))
"multiple contexts"
diff_element(
c("a", "b", letters, "a", "b", "c", letters, "X"),
c("a", "b", "c", letters, "a", "b", letters, "Y")
)
"truncation"
diff_element(c("X", letters), letters)
diff_element(c(letters, "X"), letters)
"zero length"
diff_element(letters[1:10], character())
diff_element(character(), letters[1:10])
})
})
test_that("side-by-side diffs", {
expect_snapshot({
x <- c("a", "a")
diff_element(c(x, "a", "b", "c"), c(x, "a", "b"), width = 20)
diff_element(c(x, "a", "b"), c(x, "a", "b", "c"), width = 20)
diff_element(c(x, "a", "B", "c"), c(x, "a", "b", "c"), width = 20)
"context"
diff_element(c(letters, "a", "b"), c(letters, "a", "b", "c"), width = 20)
})
})
test_that("element-wise diffs", {
expect_snapshot({
diff_element(c("a", "b", "c", "d"), c("a", "b"), width = 10)
diff_element(c("a", "b"), c("a", "b", "c", "d"), width = 10)
diff_element(c("a", "B", "C", "d"), c("a", "b", "c", "d"), width = 10)
"context"
diff_element(c(letters, "a", "b"), c(letters, "a", "b", "c"), width = 10)
})
})
test_that("only interleave if change has equal number of lines", {
expect_snapshot({
x <- letters # to anchor diffs
diff_element(c(x, 1:2, x), c(x, -(1:2), x), width = 10)
diff_element(c(x, 1:3, x), c(x, -(1:2), x), width = 10)
diff_element(c(x, 1:2, x), c(x, -(1:3), x), width = 10)
})
})
waldo/tests/testthat/test-compare-class.R 0000644 0001762 0000144 00000000541 14073210415 020210 0 ustar ligges users test_that("can construct compare object", {
x <- new_compare("Hi!")
expect_s3_class(x, "waldo_compare")
})
test_that("print method covers main cases", {
old <- Sys.getenv("CI")
Sys.setenv(CI = "false")
on.exit(Sys.setenv(CI = old))
expect_snapshot({
new_compare()
new_compare(letters[1:3])
new_compare(letters[1:11])
})
})
waldo/tests/testthat/f2.R 0000644 0001762 0000144 00000000034 13641461304 015013 0 ustar ligges users function(x = 1, y = 2) {
}
waldo/tests/testthat/test-ses.R 0000644 0001762 0000144 00000002554 14115424043 016260 0 ustar ligges users test_that("can parse three main formats", {
del <- ses(c("a", "b", "c"), c("a", "b"))
expect_equal(del, ses_df(3, 3, "d", 2, 2))
add <- ses(c("a", "b"), c("a", "b", "c"))
expect_equal(add, ses_df(2, 2, "a", 3, 3))
mod <- ses(c("a", "B", "c"), c("a", "b", "c"))
expect_equal(mod, ses_df(2, 2, "c", 2, 2))
})
test_that("can parse multi-element changes", {
del <- ses(c("a", "b", "c", "d"), c("a", "b"))
expect_equal(del, ses_df(3, 4, "d", 2, 2))
add <- ses(c("a", "b"), c("a", "b", "c", "d"))
expect_equal(add, ses_df(2, 2, "a", 3, 4))
})
test_that("can parse large numbers", {
del <- ses(c(letters,"x"), letters)
expect_equal(del, ses_df(27, 27, "d", 26, 26))
})
test_that("ses_elementwise() matches seq() for exact matches", {
expect_equal(
ses_elementwise(letters[1:4], letters[1:4]),
ses(letters[1:4], letters[1:4])
)
expect_equal(
ses_elementwise(letters[1:4], letters[1:2]),
ses(letters[1:4], letters[1:2])
)
expect_equal(
ses_elementwise(letters[1:2], letters[1:4]),
ses(letters[1:2], letters[1:4])
)
})
test_that("ses_elementwise() matches seq() for missing values", {
expect_equal(
ses_elementwise(NA, TRUE),
ses(NA, TRUE)
)
expect_equal(
ses_elementwise(TRUE, NA),
ses(TRUE, NA)
)
expect_equal(
ses_elementwise(c(NA, TRUE), c(NA, FALSE)),
ses(c(NA, TRUE), c(NA, FALSE))
)
})
waldo/tests/testthat/test-compare.R 0000644 0001762 0000144 00000021040 14107557511 017113 0 ustar ligges users test_that("same object has no differences", {
x <- 1:10
expect_equal(compare_structure(x, x), character())
})
test_that("attributes compare by name", {
x <- structure(list(), a = "a", b = "b")
y <- structure(list(), b = "b", a = "a")
expect_equal(compare_structure(x, y), character())
})
test_that("unnnamed lists compare all positions", {
x <- list(1, 2)
y <- list(3, 4)
expect_length(compare(x, y), 2)
})
test_that("can control number of differences", {
x <- as.list(letters)
y <- as.list(LETTERS)
expect_snapshot(compare(x, y, max_diffs = 1))
expect_snapshot(compare(x, y, max_diffs = Inf))
expect_snapshot(compare(letters, LETTERS, max_diffs = 1))
expect_snapshot(compare(letters, LETTERS, max_diffs = 10))
expect_snapshot(compare(letters, LETTERS, max_diffs = 20))
expect_snapshot(compare(letters, LETTERS, max_diffs = Inf))
})
test_that("can optionally ignore attributes", {
opts <- compare_opts(ignore_attr = TRUE)
x <- y <- 1:5
attr(y, "a") <- "b"
expect_equal(compare_structure(x, y, opts = opts), character())
# Ignores class
class(y) <- "foofy"
expect_equal(compare_structure(x, y, opts = opts), character())
# Ignores names
x <- list(x = 1)
y <- list(y = 1)
expect_equal(compare_structure(x, y, opts = opts), character())
})
test_that("can optionally ignore selected attributes", {
x <- y <- 1:5
attr(y, "a") <- "b"
attr(y, "b") <- "b"
opts <- compare_opts(ignore_attr = c("a", "b"))
expect_equal(compare_structure(x, y, opts = opts), character())
expect_snapshot({
compare(x, y, ignore_attr = "a")
})
# Ignores names
x <- list(x = 1)
y <- list(y = 1)
opts <- compare_opts(ignore_attr = "names")
expect_equal(compare_structure(x, y, opts = opts), character())
})
test_that("can optionally ignore function/formula envs", {
f1a <- y ~ x
f1b <- local(y ~ x)
expect_equal(length(compare(f1a, f1b, ignore_formula_env = TRUE)), 0)
f2a <- function(x) x + 1
f2b <- local(function(x) x + 1)
expect_equal(length(compare(f2a, f2b, ignore_function_env = TRUE)), 0)
})
test_that("don't strictly compare row names", {
df1 <- df2 <- data.frame(x = 1:2)
rownames(df2) <- 1:2
expect_equal(compare_structure(df1, df2), character())
})
test_that("can ignore minor numeric differences", {
x <- 1:3
expect_equal(compare_structure(x, as.numeric(x), opts = compare_opts(tolerance = 0)), character())
expect_equal(compare_structure(x, x + 1e-9, opts = compare_opts(tolerance = 1e-6)), character())
})
test_that("ignores S3 [[ methods", {
expect_snapshot({
x <- as.POSIXlt("2020-01-01")
y <- as.POSIXlt("2020-01-02")
compare(x, y)
x <- package_version("1.0.0")
y <- package_version("1.1.0")
compare(x, y)
})
})
test_that("can optionally compare encoding", {
x <- c("fa\xE7ile", "fa\ue7ile")
Encoding(x) <- c("latin1", "UTF-8")
y <- rev(x)
expect_snapshot({
compare(x, y)
compare(x, y, ignore_encoding = FALSE)
})
})
test_that("lists compare by name, where possible", {
expect_snapshot({
"extra y"
compare(list("a", "b"), list("a", "b", "c"))
compare(list(a = "a", b = "b"), list(a = "a", b = "b", c = "c"))
"extra x"
compare(list("a", "b", "c"), list("a", "b"))
compare(list(a = "a", b = "b", c = "c"), list(a = "a", b= "b"))
"different order"
compare(list(a = "a", b = "b"), list(b = "b", a = "a"))
"invalid names uses position"
compare(list(a = "a", "b"), list(a = "a", "c"))
compare(list(a = "a", a = "b"), list(a = "a", a = "c"))
})
})
test_that("can request lists treated as maps", {
compare_map <- function(x, y) compare(x, y, list_as_map = TRUE)
expect_equal(
compare_map(list(x = 1, 2, y = 3), list(y = 3, 2, x = 1)),
new_compare()
)
expect_equal(
compare_map(list(x = 1, y = NULL, NULL), list(x = 1)),
new_compare()
)
# But duplicated names are still reported
expect_snapshot(
compare_map(list(x = 1, y = 1, y = 2), list(x = 1, y = 1))
)
})
test_that("can compare with `missing_arg()`", {
expect_snapshot({
compare(missing_arg(), missing_arg())
compare(missing_arg(), sym("a"))
compare(sym("a"), missing_arg())
})
expect_snapshot({
"when in a list symbol #79"
compare(list(sym("a")), list())
compare(list(), list(sym("a")))
})
})
test_that("comparing functions gives useful diffs", {
expect_snapshot({
"equal"
f1 <- function(x = 1, y = 2) {}
f2 <- function(x = 1, y = 2) {}
compare(f1, f2)
f2 <- source(test_path("f2.R"), local = TRUE, keep.source = TRUE)$value
compare(f1, f2)
"pritimives"
compare(`[`, sum)
compare(sum, prod)
"diff formals"
f3 <- function(x = 1, y = 1, z = 1) {}
compare(f1, f3)
"diff body"
f4 <- function(x = 1, y = 2) { x + y }
compare(f1, f4)
compare(f1, f4, ignore_srcref = FALSE)
"diff environment"
environment(f1) <- base_env()
environment(f2) <- global_env()
compare(f1, f2)
})
})
test_that("can choose to compare srcrefs", {
expect_snapshot({
f1 <- f2 <- function() {}
attr(f2, "srcref") <- "{ }"
compare(f2, f1)
compare(f2, f1, ignore_srcref = FALSE)
})
})
test_that("can compare atomic vectors", {
expect_snapshot({
compare(1:3, 10L + 1:3)
compare(c(TRUE, FALSE, NA, TRUE), c(FALSE, FALSE, FALSE))
})
})
test_that("can compare S3 objects", {
expect_snapshot({
compare(factor("a"), 1L)
compare(factor("a"), globalenv())
compare(factor("a"), as.Date("1970-01-02"))
compare(
structure(function() {}, class = "foo"),
factor("a")
)
})
})
test_that("can compare S4 objects", {
setClass("A", slots = c(x = "character"))
setClass("B", contains = "A")
expect_snapshot({
"Non S4"
compare(new("A", x = "1"), 1)
compare(new("A", x = "1"), globalenv())
compare(new("A", x = "1"), factor("x"))
"S4"
compare(new("A", x = "1"), new("A", x = "1"))
compare(new("A", x = "1"), new("A", x = "2"))
compare(new("A", x = "1"), new("B", x = "1"))
"S4 with extra attributes"
new <- old <- new("A", x = "1")
attr(new, "bar") <- 2
compare(new, old)
})
})
test_that("can compare R6 objects", {
expect_snapshot({
goofy <- R6::R6Class("goofy", public = list(
initialize = function(x) self$x <- x,
x = 10
))
froofy <- R6::R6Class("froofy", inherit = goofy, public = list(
y = 10
))
"Non R6"
compare(goofy$new(1), 1)
compare(goofy$new(1), globalenv())
compare(goofy$new(1), factor("x"))
"R6"
compare(goofy$new(1), goofy$new(1))
compare(goofy$new(1), goofy$new("a"))
compare(goofy$new(1), froofy$new(1))
# https://github.com/r-lib/waldo/issues/84
compare(froofy$new(1), froofy$new(1)$clone())
})
})
test_that("comparing language objects gives useful diffs", {
expect_snapshot({
compare(quote(a), quote(b))
compare(quote(a + b), quote(b + c))
x <- y <- quote(foo(1:3))
y[[2]] <- 1:3
compare(x, y)
compare(expression(1, a, a + b), expression(1, a, a + b))
compare(expression(1, a, a + b), expression(1, a, a + c))
})
})
test_that("compare_proxy() can change type", {
local_bindings(
compare_proxy.foo = function(x, path) {
list(object = 10, path = paste0("proxy(", path, ")"))
},
.env = global_env()
)
expect_equal(
compare(structure(1, class = "foo"), structure("x", class = "foo")),
new_compare()
)
})
test_that("compare_proxy() modifies path", {
local_bindings(
compare_proxy.foo = function(x, path) {
list(object = list(x = x$x), path = paste0("proxy(", path, ")"))
},
.env = global_env()
)
foo1 <- structure(list(x = 1), class = "foo")
foo2 <- structure(list(x = 2), class = "foo")
expect_snapshot(compare(foo1, foo2))
})
test_that("options have correct precedence", {
x <- list(1)
x_tolerant <- structure(x, waldo_opts = list(tolerance = 0))
x_intolerant <- structure(x, waldo_opts = list(tolerance = NULL))
y <- list(1L)
y_tolerant <- structure(y, waldo_opts = list(tolerance = 0))
y_intolerant <- structure(y, waldo_opts = list(tolerance = NULL))
# Starts from global defaults
expect_length(compare(x, y), 1)
# Options beats nothing
expect_length(compare(x, y_tolerant), 0)
expect_length(compare(x_tolerant, y), 0)
# y beats x
expect_length(compare(x_intolerant, y_tolerant), 0)
expect_length(compare(x_tolerant, y_intolerant), 1)
# User supplied beats y
expect_length(compare(x_intolerant, y_tolerant, tolerance = NULL), 1)
})
test_that("options inherited by children", {
x <- structure(list(list(1)), waldo_opts = list(tolerance = 0))
y <- list(list(1L))
expect_length(compare(x, y), 0)
})
waldo/tests/testthat/_snaps/ 0000755 0001762 0000144 00000000000 14110717455 015652 5 ustar ligges users waldo/tests/testthat/_snaps/diff.md 0000644 0001762 0000144 00000007654 14115424250 017111 0 ustar ligges users # paired diffs
Code
# no difference
diff_element(c("a", "b"), c("a", "b"))
Output
v No differences
Code
# single change
diff_element(c("a", "b", "c"), c("a", "b"))
Output
`x`: "a" "b" "c"
`y`: "a" "b"
Code
diff_element(c("a", "b"), c("a", "b", "c"))
Output
`x`: "a" "b"
`y`: "a" "b" "c"
Code
diff_element(c("a", "B", "c"), c("a", "b", "c"))
Output
`x`: "a" "B" "c"
`y`: "a" "b" "c"
Code
# multiple contexts
diff_element(c("a", "b", letters, "a", "b", "c", letters, "X"), c("a", "b", "c",
letters, "a", "b", letters, "Y"))
Output
`x[1:5]`: "a" "b" "a" "b" "c"
`y[1:6]`: "a" "b" "c" "a" "b" "c"
`x[28:34]`: "z" "a" "b" "c" "a" "b" "c"
`y[29:34]`: "z" "a" "b" "a" "b" "c"
`x[55:58]`: "x" "y" "z" "X"
`y[55:58]`: "x" "y" "z" "Y"
Code
# truncation
diff_element(c("X", letters), letters)
Output
`x[1:4]`: "X" "a" "b" "c"
`y[1:3]`: "a" "b" "c"
Code
diff_element(c(letters, "X"), letters)
Output
`x[24:27]`: "x" "y" "z" "X"
`y[24:26]`: "x" "y" "z"
Code
# zero length
diff_element(letters[1:10], character())
Output
`x`: "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
`y`:
Code
diff_element(character(), letters[1:10])
Output
`x`:
`y`: "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
# side-by-side diffs
Code
x <- c("a", "a")
diff_element(c(x, "a", "b", "c"), c(x, "a", "b"), width = 20)
Output
x | y
[2] "a" | "a" [2]
[3] "a" | "a" [3]
[4] "b" | "b" [4]
[5] "c" -
Code
diff_element(c(x, "a", "b"), c(x, "a", "b", "c"), width = 20)
Output
x | y
[2] "a" | "a" [2]
[3] "a" | "a" [3]
[4] "b" | "b" [4]
- "c" [5]
Code
diff_element(c(x, "a", "B", "c"), c(x, "a", "b", "c"), width = 20)
Output
x | y
[1] "a" | "a" [1]
[2] "a" | "a" [2]
[3] "a" | "a" [3]
[4] "B" - "b" [4]
[5] "c" | "c" [5]
Code
# context
diff_element(c(letters, "a", "b"), c(letters, "a", "b", "c"), width = 20)
Output
x | y
[26] "z" | "z" [26]
[27] "a" | "a" [27]
[28] "b" | "b" [28]
- "c" [29]
# element-wise diffs
Code
diff_element(c("a", "b", "c", "d"), c("a", "b"), width = 10)
Output
x vs y
"a"
"b"
- "c"
- "d"
Code
diff_element(c("a", "b"), c("a", "b", "c", "d"), width = 10)
Output
x vs y
"a"
"b"
+ "c"
+ "d"
Code
diff_element(c("a", "B", "C", "d"), c("a", "b", "c", "d"), width = 10)
Output
x vs y
"a"
- "B"
+ "b"
- "C"
+ "c"
"d"
Code
# context
diff_element(c(letters, "a", "b"), c(letters, "a", "b", "c"), width = 10)
Output
x[26:28] vs y[26:29]
"y"
"z"
"a"
"b"
+ "c"
# only interleave if change has equal number of lines
Code
x <- letters
diff_element(c(x, 1:2, x), c(x, -(1:2), x), width = 10)
Output
x[24:31] vs y[24:31]
"x"
"y"
"z"
- "1"
+ "-1"
- "2"
+ "-2"
"a"
"b"
"c"
Code
diff_element(c(x, 1:3, x), c(x, -(1:2), x), width = 10)
Output
x[24:32] vs y[24:31]
"x"
"y"
"z"
- "1"
- "2"
- "3"
+ "-1"
+ "-2"
"a"
"b"
"c"
Code
diff_element(c(x, 1:2, x), c(x, -(1:3), x), width = 10)
Output
x[24:31] vs y[24:32]
"x"
"y"
"z"
- "1"
- "2"
+ "-1"
+ "-2"
+ "-3"
"a"
"b"
"c"
waldo/tests/testthat/_snaps/proxy.md 0000644 0001762 0000144 00000000662 14115424250 017352 0 ustar ligges users # xml2 proxy generates useful comparisons
Code
x1a <- xml2::read_xml("1")
x1b <- xml2::read_xml("1")
compare(x1a, x1b)
Output
v No differences
Code
x2 <- xml2::read_xml("2")
compare(x1a, x2)
Output
lines(as.character(old)) vs lines(as.character(new))
""
- "1"
+ "2"
""
waldo/tests/testthat/_snaps/compare-class.md 0000644 0001762 0000144 00000000650 14115424245 020723 0 ustar ligges users # print method covers main cases
Code
new_compare()
Output
v No differences
Code
new_compare(letters[1:3])
Output
a
b
c
Code
new_compare(letters[1:11])
Output
a
b
c
d
e
f
g
h
i
j
And 1 more differences ...
waldo/tests/testthat/_snaps/compare-opts.md 0000644 0001762 0000144 00000000676 14115424245 020613 0 ustar ligges users # other arguments are ignored with a warning
Code
compare(1, 1, 1)
Warning
Unused arguments (1)
Output
v No differences
---
Code
compare(1, 1, abc = 1)
Warning
Unused arguments (abc = 1)
Output
v No differences
---
Code
compare(1, 1, abc = 1, xyz = 2)
Warning
Unused arguments (abc = 1, xyz = 2)
Output
v No differences
waldo/tests/testthat/_snaps/compare-value.md 0000644 0001762 0000144 00000016406 14115424246 020741 0 ustar ligges users # character comparison
Code
# no difference
compare_character(c("a", "b"), c("a", "b"))
Output
v No differences
Code
# single change
compare_character(c("a", "b", "c"), c("a", "b"))
Output
`x`: "a" "b" "c"
`y`: "a" "b"
Code
compare_character(c("a", "b"), c("a", "b", "c"))
Output
`x`: "a" "b"
`y`: "a" "b" "c"
Code
compare_character(c("a", "B", "c"), c("a", "b", "c"))
Output
`x`: "a" "B" "c"
`y`: "a" "b" "c"
Code
# multiple contexts
compare_character(c("a", "b", letters, "a", "b", "c", letters, "X"), c("a", "b",
"c", letters, "a", "b", letters, "Y"))
Output
`x[1:5]`: "a" "b" "a" "b" "c"
`y[1:6]`: "a" "b" "c" "a" "b" "c"
`x[28:34]`: "z" "a" "b" "c" "a" "b" "c"
`y[29:34]`: "z" "a" "b" "a" "b" "c"
`x[55:58]`: "x" "y" "z" "X"
`y[55:58]`: "x" "y" "z" "Y"
Code
# truncation
compare_character(c("X", letters), letters)
Output
`x[1:4]`: "X" "a" "b" "c"
`y[1:3]`: "a" "b" "c"
Code
compare_character(c(letters, "X"), letters)
Output
`x[24:27]`: "x" "y" "z" "X"
`y[24:26]`: "x" "y" "z"
Code
# large diff
compare(letters, c(letters[1:20], "a"))
Output
`old[18:26]`: "r" "s" "t" "u" "v" "w" "x" "y" "z"
`new[18:21]`: "r" "s" "t" "a"
# multiline comparison
Code
compare_character("A\nthe apple is red\nC\n", "A\nthe apple was red\nC\n")
Output
`lines(x)`: "A" "the apple is red" "C" ""
`lines(y)`: "A" "the apple was red" "C" ""
Code
compare_character("A\nthe apple is red and green\nC\n",
"A\nthe apple is red\nC\n")
Output
`lines(x)`: "A" "the apple is red and green" "C" ""
`lines(y)`: "A" "the apple is red" "C" ""
Code
compare_character("A\nthe apple is red and green\nC\n",
"A\nI like bananas\nC\n")
Output
`lines(x)`: "A" "the apple is red and green" "C" ""
`lines(y)`: "A" "I like bananas" "C" ""
Code
# trailing newlines are correctly compared
compare("x\n", "x")
Output
`lines(old)`: "x" ""
`lines(new)`: "x"
# multi-element multi-line comparisons get indices
Code
compare(c("a", "b", "c\nd"), c("a", "b", "c\ne"))
Output
`lines(old[[3]])`: "c" "d"
`lines(new[[3]])`: "c" "e"
# show elementwise differences of random permutations
Code
compare(letters[1:15], letters[c(14, 4, 12, 11, 13, 3, 10, 5, 1, 7, 9, 15, 6, 8,
2)], max_diffs = Inf)
Output
`old`: "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
`new`: "n" "d" "l" "k" "m" "c" "j" "e" "a" "g" "i" "o" "f" "h" "b"
Code
compare(letters[1:15], letters[c(3, 13, 6, 10, 11, 9, 4, 5, 15, 2, 12, 14, 8, 7,
1)], max_diffs = Inf)
Output
`old`: "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
`new`: "c" "m" "f" "j" "k" "i" "d" "e" "o" "b" "l" "n" "h" "g" "a"
Code
compare(letters[1:15], letters[c(12, 13, 1, 2, 5, 6, 11, 15, 10, 14, 9, 7, 3, 4,
8)], max_diffs = Inf)
Output
`old`: "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
`new`: "l" "m" "a" "b" "e" "f" "k" "o" "j" "n" "i" "g" "c" "d" "h"
# favour smart diff over elementwise when total length is the same
Code
compare(c(1, 2, 3, 4, 5), c(1, 2, 10, 3, 4, 5))
Output
`old`: 1 2 3 4 5
`new`: 1 2 10 3 4 5
Code
compare(c(1, 2, 4, 5), c(1, 2, 3, 4, 5))
Output
`old`: 1 2 4 5
`new`: 1 2 3 4 5
# numeric comparison
Code
# no difference
compare_numeric(1:3, 1:3)
Output
v No differences
Code
compare_numeric(c(1, NA), c(1, NA))
Output
v No differences
Code
compare_numeric(c(NA, 1), c(1, NA))
Output
`x`: NA 1
`y`: 1 NA
Code
# simple change
compare_numeric(c(1, 2, 3), c(1, 2))
Output
`x`: 1 2 3
`y`: 1 2
Code
compare_numeric(c(1, 2), c(1, 2, 3))
Output
`x`: 1 2
`y`: 1 2 3
Code
compare_numeric(c(1, 10, 3), c(1, 2, 3))
Output
`x`: 1 10 3
`y`: 1 2 3
Code
# equal length
x <- c(1, 2, 3)
compare_numeric(x, x + c(-1, 0, 1) * 0.001)
Output
`x`: 1.000 2.000 3.000
`y`: 0.999 2.000 3.001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-04)
Output
`x`: 1.0000 2.0000 3.0000
`y`: 0.9999 2.0000 3.0001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-05)
Output
`x`: 1.00000 2.00000 3.00000
`y`: 0.99999 2.00000 3.00001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-06)
Output
`x`: 1.000000 2.000000 3.000000
`y`: 0.999999 2.000000 3.000001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-07)
Output
`x`: 1.0000000 2.0000000 3.0000000
`y`: 0.9999999 2.0000000 3.0000001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-08)
Output
v No differences
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-08, tolerance = 0)
Output
`x`: 1.00000000 2.00000000 3.00000000
`y`: 0.99999999 2.00000000 3.00000001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-09, tolerance = 0)
Output
`x`: 1.000000000 2.000000000 3.000000000
`y`: 0.999999999 2.000000000 3.000000001
Code
compare_numeric(x, x + c(-1, 0, 1) * 1e-10, tolerance = 0)
Output
`x`: 1.0000000000 2.0000000000 3.0000000000
`y`: 0.9999999999 2.0000000000 3.0000000001
Code
# unequal length
compare_numeric(c(1, 2, NA), c(1, 2 + 1e-07, NA, 3))
Output
`x[2:3]`: 2
`y`: 1 2.0000001 3
# numeric comparison works on factors
Code
f1 <- factor(c("a", "b", "c"))
f2 <- factor(c("a", "c", "b"), c("a", "c", "b"))
compare(f1, f2)
Output
`levels(old)`: "a" "b" "c"
`levels(new)`: "a" "c" "b"
Code
f3 <- factor(c("a", "B", "c"))
compare(f1, f3)
Output
`levels(old)`: "a" "b" "c"
`levels(new)`: "B" "a" "c"
`old`: 1 2 3
`new`: 2 1 3
# shows row-by-row diff for numeric matrices
Code
x <- y <- matrix(1:4, nrow = 2)
y[2, 2] <- 5L
compare(x, y)
Output
old vs new
[,1] [,2]
old[1, ] 1 3
- old[2, ] 2 4
+ new[2, ] 2 5
# falls back to regular display if printed representation the same
Code
x <- y <- matrix(1:4, nrow = 2)
y[2, 2] <- y[2, 2] + 1e-10
compare(x, y)
Output
`old` is an integer vector (1, 2, 3, 4)
`new` is a double vector (1, 2, 3, 4.0000000001)
# logical comparisons minimise extraneous diffs
Code
compare_logical(x1, x2)
Output
`x[1:4]`: TRUE TRUE TRUE TRUE
`y[1:4]`: FALSE TRUE TRUE TRUE
`x[22:28]`: TRUE TRUE TRUE TRUE TRUE TRUE TRUE
`y[22:28]`: TRUE TRUE TRUE FALSE TRUE TRUE TRUE
`x[47:50]`: TRUE TRUE TRUE TRUE
`y[47:50]`: TRUE TRUE TRUE FALSE
---
Code
compare_logical(x3, x4)
Output
`x[1:3]`: TRUE FALSE TRUE
`y[1:4]`: FALSE TRUE FALSE TRUE
`x[48:50]`: FALSE TRUE FALSE
`y[49:52]`: FALSE TRUE FALSE TRUE
waldo/tests/testthat/_snaps/compare-data-frame.md 0000644 0001762 0000144 00000004004 14116654211 021613 0 ustar ligges users # informative diff for additions and deletions
Code
df <- data.frame(x = 1:5, y = 5:1)
compare(df, unrowname(df[1:3, ]))
Output
`attr(old, 'row.names')`: 1 2 3 4 5
`attr(new, 'row.names')`: 1 2 3
old vs new
x y
old[1, ] 1 5
old[2, ] 2 4
old[3, ] 3 3
- old[4, ] 4 2
- old[5, ] 5 1
`old$x`: 1 2 3 4 5
`new$x`: 1 2 3
`old$y`: 5 4 3 2 1
`new$y`: 5 4 3
Code
compare(df, unrowname(df[c(1, 5, 2, 3, 4, 5), ]))
Output
`attr(old, 'row.names')[3:5]`: 3 4 5
`attr(new, 'row.names')[3:6]`: 3 4 5 6
old vs new
x y
old[1, ] 1 5
+ new[2, ] 5 1
old[2, ] 2 4
old[3, ] 3 3
old[4, ] 4 2
`old$x[1:4]`: 1 2 3 4
`new$x[1:5]`: 1 5 2 3 4
`old$y[1:4]`: 5 4 3 2
`new$y[1:5]`: 5 1 4 3 2
# informative diff for changes
Code
df1 <- data.frame(x = 1:3, y = 1, z = c("a", "b", "c"), stringsAsFactors = FALSE)
df2 <- data.frame(x = c(1, 100, 3), y = 1, z = c("a", "B", "c"),
stringsAsFactors = FALSE)
compare(df1, df2)
Output
old vs new
x z
old[1, ] 1 a
- old[2, ] 2 b
+ new[2, ] 100 B
old[3, ] 3 c
`old$x` is an integer vector (1, 2, 3)
`new$x` is a double vector (1, 100, 3)
`old$z`: "a" "b" "c"
`new$z`: "a" "B" "c"
# converts factors to strings
Code
compare(df1, df2)
Output
`levels(old$x)`: "a" "b" "c"
`levels(new$x)`: "a" "b" "d"
# works when nrow(df) > option(max.print)
Code
withr::local_options(max.print = 1)
df1 <- data.frame(a = 1:2, b = 1:2)
df2 <- data.frame(a = c(1, 3), b = 1:2)
compare(df1, df2)
Output
old vs new
a
old[1, ] 1
- old[2, ] 2
+ new[2, ] 3
`old$a` is an integer vector (1, 2)
`new$a` is a double vector (1, 3)
waldo/tests/testthat/_snaps/compare.md 0000644 0001762 0000144 00000032664 14115424250 017626 0 ustar ligges users # can control number of differences
Code
compare(x, y, max_diffs = 1)
Output
`old[[1]]`: "a"
`new[[1]]`: "A"
And 25 more differences ...
---
Code
compare(x, y, max_diffs = Inf)
Output
`old[[1]]`: "a"
`new[[1]]`: "A"
`old[[2]]`: "b"
`new[[2]]`: "B"
`old[[3]]`: "c"
`new[[3]]`: "C"
`old[[4]]`: "d"
`new[[4]]`: "D"
`old[[5]]`: "e"
`new[[5]]`: "E"
`old[[6]]`: "f"
`new[[6]]`: "F"
`old[[7]]`: "g"
`new[[7]]`: "G"
`old[[8]]`: "h"
`new[[8]]`: "H"
`old[[9]]`: "i"
`new[[9]]`: "I"
`old[[10]]`: "j"
`new[[10]]`: "J"
`old[[11]]`: "k"
`new[[11]]`: "K"
`old[[12]]`: "l"
`new[[12]]`: "L"
`old[[13]]`: "m"
`new[[13]]`: "M"
`old[[14]]`: "n"
`new[[14]]`: "N"
`old[[15]]`: "o"
`new[[15]]`: "O"
`old[[16]]`: "p"
`new[[16]]`: "P"
`old[[17]]`: "q"
`new[[17]]`: "Q"
`old[[18]]`: "r"
`new[[18]]`: "R"
`old[[19]]`: "s"
`new[[19]]`: "S"
`old[[20]]`: "t"
`new[[20]]`: "T"
`old[[21]]`: "u"
`new[[21]]`: "U"
`old[[22]]`: "v"
`new[[22]]`: "V"
`old[[23]]`: "w"
`new[[23]]`: "W"
`old[[24]]`: "x"
`new[[24]]`: "X"
`old[[25]]`: "y"
`new[[25]]`: "Y"
`old[[26]]`: "z"
`new[[26]]`: "Z"
---
Code
compare(letters, LETTERS, max_diffs = 1)
Output
`old`: "a" and 25 more...
`new`: "A" ...
---
Code
compare(letters, LETTERS, max_diffs = 10)
Output
`old`: "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" and 16 more...
`new`: "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" ...
---
Code
compare(letters, LETTERS, max_diffs = 20)
Output
old | new
[1] "a" - "A" [1]
[2] "b" - "B" [2]
[3] "c" - "C" [3]
[4] "d" - "D" [4]
[5] "e" - "E" [5]
[6] "f" - "F" [6]
[7] "g" - "G" [7]
[8] "h" - "H" [8]
[9] "i" - "I" [9]
[10] "j" - "J" [10]
[11] "k" - "K" [11]
[12] "l" - "L" [12]
[13] "m" - "M" [13]
[14] "n" - "N" [14]
[15] "o" - "O" [15]
[16] "p" - "P" [16]
[17] "q" - "Q" [17]
[18] "r" - "R" [18]
[19] "s" - "S" [19]
[20] "t" - "T" [20]
... ... ... and 6 more ...
---
Code
compare(letters, LETTERS, max_diffs = Inf)
Output
old | new
[1] "a" - "A" [1]
[2] "b" - "B" [2]
[3] "c" - "C" [3]
[4] "d" - "D" [4]
[5] "e" - "E" [5]
[6] "f" - "F" [6]
[7] "g" - "G" [7]
[8] "h" - "H" [8]
[9] "i" - "I" [9]
[10] "j" - "J" [10]
[11] "k" - "K" [11]
[12] "l" - "L" [12]
[13] "m" - "M" [13]
[14] "n" - "N" [14]
[15] "o" - "O" [15]
[16] "p" - "P" [16]
[17] "q" - "Q" [17]
[18] "r" - "R" [18]
[19] "s" - "S" [19]
[20] "t" - "T" [20]
[21] "u" - "U" [21]
[22] "v" - "V" [22]
[23] "w" - "W" [23]
[24] "x" - "X" [24]
[25] "y" - "Y" [25]
[26] "z" - "Z" [26]
# can optionally ignore selected attributes
Code
compare(x, y, ignore_attr = "a")
Output
`attr(old, 'b')` is absent
`attr(new, 'b')` is a character vector ('b')
# ignores S3 [[ methods
Code
x <- as.POSIXlt("2020-01-01")
y <- as.POSIXlt("2020-01-02")
compare(x, y)
Output
`old$mday`: 1
`new$mday`: 2
`old$wday`: 3
`new$wday`: 4
`old$yday`: 0
`new$yday`: 1
Code
x <- package_version("1.0.0")
y <- package_version("1.1.0")
compare(x, y)
Output
`old[[1]]`: 1 0 0
`new[[1]]`: 1 1 0
# can optionally compare encoding
Code
compare(x, y)
Output
v No differences
Code
compare(x, y, ignore_encoding = FALSE)
Output
`Encoding(old)`: "latin1" "UTF-8"
`Encoding(new)`: "UTF-8" "latin1"
# lists compare by name, where possible
Code
# extra y
compare(list("a", "b"), list("a", "b", "c"))
Output
`old` is length 2
`new` is length 3
`old[[3]]` is absent
`new[[3]]` is a character vector ('c')
Code
compare(list(a = "a", b = "b"), list(a = "a", b = "b", c = "c"))
Output
`old` is length 2
`new` is length 3
`names(old)`: "a" "b"
`names(new)`: "a" "b" "c"
`old$c` is absent
`new$c` is a character vector ('c')
Code
# extra x
compare(list("a", "b", "c"), list("a", "b"))
Output
`old` is length 3
`new` is length 2
`old[[3]]` is a character vector ('c')
`new[[3]]` is absent
Code
compare(list(a = "a", b = "b", c = "c"), list(a = "a", b = "b"))
Output
`old` is length 3
`new` is length 2
`names(old)`: "a" "b" "c"
`names(new)`: "a" "b"
`old$c` is a character vector ('c')
`new$c` is absent
Code
# different order
compare(list(a = "a", b = "b"), list(b = "b", a = "a"))
Output
`names(old)`: "a" "b"
`names(new)`: "b" "a"
Code
# invalid names uses position
compare(list(a = "a", "b"), list(a = "a", "c"))
Output
`old[[2]]`: "b"
`new[[2]]`: "c"
Code
compare(list(a = "a", a = "b"), list(a = "a", a = "c"))
Output
`old[[2]]`: "b"
`new[[2]]`: "c"
# can request lists treated as maps
Code
compare_map(list(x = 1, y = 1, y = 2), list(x = 1, y = 1))
Output
`old` is length 3
`new` is length 2
`names(old)`: "x" "y" "y"
`names(new)`: "x" "y"
`old[[3]]` is a double vector (2)
`new[[3]]` is absent
# can compare with `missing_arg()`
Code
compare(missing_arg(), missing_arg())
Output
v No differences
Code
compare(missing_arg(), sym("a"))
Output
`old` is absent
`new` is a symbol
Code
compare(sym("a"), missing_arg())
Output
`old` is a symbol
`new` is absent
---
Code
# when in a list symbol #79
compare(list(sym("a")), list())
Output
`old` is length 1
`new` is length 0
`old[[1]]` is a symbol
`new[[1]]` is absent
Code
compare(list(), list(sym("a")))
Output
`old` is length 0
`new` is length 1
`old[[1]]` is absent
`new[[1]]` is a symbol
# comparing functions gives useful diffs
Code
# equal
f1 <- (function(x = 1, y = 2) { })
f2 <- (function(x = 1, y = 2) { })
compare(f1, f2)
Output
v No differences
Code
f2 <- source(test_path("f2.R"), local = TRUE, keep.source = TRUE)$value
compare(f1, f2)
Output
v No differences
Code
# pritimives
compare(`[`, sum)
Output
`old` is `.Primitive("[")`
`new` is `.Primitive("sum")`
Code
compare(sum, prod)
Output
`old` is `.Primitive("sum")`
`new` is `.Primitive("prod")`
Code
# diff formals
f3 <- (function(x = 1, y = 1, z = 1) { })
compare(f1, f3)
Output
`formals(old)` is length 2
`formals(new)` is length 3
`names(formals(old))`: "x" "y"
`names(formals(new))`: "x" "y" "z"
`formals(old)$y`: 2
`formals(new)$y`: 1
`formals(old)$z` is absent
`formals(new)$z` is a double vector (1)
Code
# diff body
f4 <- (function(x = 1, y = 2) {
x + y
})
compare(f1, f4)
Output
`body(old)`: `{` `}`
`body(new)`: `{` ` x + y` `}`
Code
compare(f1, f4, ignore_srcref = FALSE)
Output
`attr(old, 'srcref')`: 2 8 2 33 8 33 2 2
`attr(new, 'srcref')`: 14 8 16 1 8 1 14 16
`attr(body(old), 'srcref')` is length 1
`attr(body(new), 'srcref')` is length 2
`attr(body(old), 'srcref')[[1]]`: 2 31 2 31 31 31 2 2
`attr(body(new), 'srcref')[[1]]`: 14 31 14 31 31 31 14 14
`attr(body(old), 'srcref')[[2]]` is absent
`attr(body(new), 'srcref')[[2]]` is an S3 object of class , an integer vector
`attr(body(old), 'wholeSrcref')`: 1 0 2 33 0 33 1 2
`attr(body(new), 'wholeSrcref')`: 1 0 16 1 0 1 1 16
`body(old)`: `{` `}`
`body(new)`: `{` ` x + y` `}`
Code
# diff environment
environment(f1) <- base_env()
environment(f2) <- global_env()
compare(f1, f2)
Output
`environment(old)` is
`environment(new)` is
# can choose to compare srcrefs
Code
f1 <- f2 <- (function() { })
attr(f2, "srcref") <- "{ }"
compare(f2, f1)
Output
v No differences
Code
compare(f2, f1, ignore_srcref = FALSE)
Output
`attr(old, 'srcref')` is a character vector ('{ }')
`attr(new, 'srcref')` is an S3 object of class , an integer vector
# can compare atomic vectors
Code
compare(1:3, 10L + 1:3)
Output
`old`: 1 2 3
`new`: 11 12 13
Code
compare(c(TRUE, FALSE, NA, TRUE), c(FALSE, FALSE, FALSE))
Output
`old`: TRUE FALSE TRUE
`new`: FALSE FALSE FALSE
# can compare S3 objects
Code
compare(factor("a"), 1L)
Output
`old` is an S3 object of class , an integer vector
`new` is an integer vector (1)
Code
compare(factor("a"), globalenv())
Output
`old` is an S3 object of class , an integer vector
`new` is an environment
Code
compare(factor("a"), as.Date("1970-01-02"))
Output
`old` is an S3 object of class , an integer vector
`new` is an S3 object of class , a double vector
Code
compare(structure(function() { }, class = "foo"), factor("a"))
Output
`old` is an S3 object of class , a function
`new` is an S3 object of class , an integer vector
# can compare S4 objects
Code
# Non S4
compare(new("A", x = "1"), 1)
Output
`old` is an S4 object of class
`new` is a double vector (1)
Code
compare(new("A", x = "1"), globalenv())
Output
`old` is an S4 object of class
`new` is an environment
Code
compare(new("A", x = "1"), factor("x"))
Output
`old` is an S4 object of class
`new` is an S3 object of class , an integer vector
Code
# S4
compare(new("A", x = "1"), new("A", x = "1"))
Output
v No differences
Code
compare(new("A", x = "1"), new("A", x = "2"))
Output
`old@x`: "1"
`new@x`: "2"
Code
compare(new("A", x = "1"), new("B", x = "1"))
Output
`is(old)`: "A"
`is(new)`: "B" "A"
Code
# S4 with extra attributes
new <- old <- new("A", x = "1")
attr(new, "bar") <- 2
compare(new, old)
Output
`attr(old, 'bar')` is a double vector (2)
`attr(new, 'bar')` is absent
# can compare R6 objects
Code
goofy <- R6::R6Class("goofy", public = list(initialize = function(x) self$x <-
x, x = 10))
froofy <- R6::R6Class("froofy", inherit = goofy, public = list(y = 10))
# Non R6
compare(goofy$new(1), 1)
Output
`old` is an R6 object of class
`new` is a double vector (1)
Code
compare(goofy$new(1), globalenv())
Output
`old` is an R6 object of class
`new` is an environment
Code
compare(goofy$new(1), factor("x"))
Output
`old` is an R6 object of class
`new` is an S3 object of class , an integer vector
Code
# R6
compare(goofy$new(1), goofy$new(1))
Output
v No differences
Code
compare(goofy$new(1), goofy$new("a"))
Output
`old$x` is a double vector (1)
`new$x` is a character vector ('a')
Code
compare(goofy$new(1), froofy$new(1))
Output
`class(old)`: "goofy" "R6"
`class(new)`: "froofy" "goofy" "R6"
`old` is length 3
`new` is length 4
`names(old)`: "clone" "initialize" "x"
`names(new)`: "clone" "initialize" "x" "y"
`old$y` is absent
`new$y` is a double vector (10)
Code
compare(froofy$new(1), froofy$new(1)$clone())
Output
v No differences
# comparing language objects gives useful diffs
Code
compare(quote(a), quote(b))
Output
`old` is `a`
`new` is `b`
Code
compare(quote(a + b), quote(b + c))
Output
`old`: `a + b`
`new`: `b + c`
Code
x <- y <- quote(foo(1:3))
y[[2]] <- 1:3
compare(x, y)
Output
`old[[2]]` is a call
`new[[2]]` is an integer vector (1, 2, 3)
Code
compare(expression(1, a, a + b), expression(1, a, a + b))
Output
v No differences
Code
compare(expression(1, a, a + b), expression(1, a, a + c))
Output
`old[[3]]`: `a + b`
`new[[3]]`: `a + c`
# compare_proxy() modifies path
Code
compare(foo1, foo2)
Output
`proxy(old)$x`: 1
`proxy(new)$x`: 2
waldo/tests/testthat/test-compare-opts.R 0000644 0001762 0000144 00000001144 14075101361 020071 0 ustar ligges users test_that("all.equal arguments warned an preserved", {
expect_warning(
opts <- compare_opts(checkNames = FALSE),
"checkNames"
)
expect_equal(opts$ignore_attr, TRUE)
expect_warning(
opts <- compare_opts(check.attributes = FALSE),
"check.attributes"
)
expect_equal(opts$ignore_attr, TRUE)
expect_warning(
opts <- compare_opts(tol = 1),
"tol"
)
expect_equal(opts$tolerance, 1)
})
test_that("other arguments are ignored with a warning", {
expect_snapshot(compare(1, 1, 1))
expect_snapshot(compare(1, 1, abc = 1))
expect_snapshot(compare(1, 1, abc = 1, xyz = 2))
})
waldo/tests/testthat/test-num_equal.R 0000644 0001762 0000144 00000001463 13651043011 017446 0 ustar ligges users test_that("num_equal returns early", {
expect_equal(num_equal(1, 1:2), FALSE)
expect_equal(num_equal(1, 2, NULL), FALSE)
expect_equal(num_equal(1, 1), TRUE)
expect_equal(num_equal(1, NA), FALSE)
expect_equal(num_equal(c(1, NA), c(1, NA)), TRUE)
})
test_that("tolerance is relative", {
expect_equal(num_equal(1000, 1001, tolerance = 1e-3), TRUE)
expect_equal(num_equal(1000, 1002, tolerance = 1e-3), FALSE)
})
test_that("tolerance is absolute for small values", {
expect_equal(num_equal(0, 0.0009, tolerance = 0.0010), TRUE)
expect_equal(num_equal(0, 0.0010, tolerance = 0.0010), FALSE)
})
test_that("tolerance works the same way for negative values", {
expect_equal(num_equal(4, 4 + 2 * .Machine$double.eps ^ 0.5), TRUE)
expect_equal(num_equal(-4, -4 - 2 * .Machine$double.eps ^ 0.5), TRUE)
})
waldo/tests/testthat/test-utils.R 0000644 0001762 0000144 00000000536 14075617165 016642 0 ustar ligges users test_that("as_map() leaves unnnamed components alone", {
expect_equal(as_map(c(c = 5, 2, b = 3, 4, a = 1)), c(a = 1, 2, b = 3, 4, c = 5))
expect_equal(as_map(c(c = 3, b = 2, a = 1)), c(a = 1, b = 2, c = 3))
expect_equal(as_map(3:1), c(3:1))
})
test_that("as_map() strips NULLs", {
expect_equal(as_map(list(a = 1, b = NULL)), list(a = 1))
})
waldo/tests/testthat/test-compare-data-frame.R 0000644 0001762 0000144 00000003136 14116654210 021112 0 ustar ligges users test_that("informative diff for additions and deletions", {
expect_snapshot({
df <- data.frame(x = 1:5, y = 5:1)
compare(df, unrowname(df[1:3, ]))
compare(df, unrowname(df[c(1, 5, 2, 3, 4, 5), ]))
})
})
test_that("informative diff for changes", {
expect_snapshot({
df1 <- data.frame(x = 1:3, y = 1, z = c("a", "b", "c"), stringsAsFactors = FALSE)
df2 <- data.frame(x = c(1, 100, 3), y = 1, z = c("a", "B", "c"), stringsAsFactors = FALSE)
compare(df1, df2)
})
})
test_that("can set tolerance", {
df1 <- data.frame(x = 1)
df2 <- data.frame(x = 1.001)
expect_length(compare(df1, df2, tolerance = 0.1), 0)
})
test_that("converts factors to strings", {
df1 <- data.frame(x = factor(c("a", "b", "c")))
df2 <- data.frame(x = factor(c("a", "b", "d")))
expect_snapshot({
compare(df1, df2)
})
})
test_that("works when nrow(df) > option(max.print)", {
expect_snapshot({
withr::local_options("max.print" = 1)
df1 <- data.frame(a = 1:2, b = 1:2)
df2 <- data.frame(a = c(1, 3), b = 1:2)
compare(df1, df2)
})
})
test_that("only used for appropriate data frames", {
df <- data.frame(x = 1)
expect_equal(compare_data_frame(df, df), NULL)
expect_equal(compare_data_frame(df, data.frame()), NULL)
expect_equal(compare_data_frame(df, data.frame(y = 1)), NULL)
expect_equal(compare_data_frame(df, data.frame(x = FALSE)), NULL)
expect_equal(compare_data_frame(df, data.frame(x = structure(1, a = 1))), NULL)
expect_equal(compare_data_frame(data.frame(), data.frame()), NULL)
df$y <- list(1:10)
expect_equal(compare_data_frame(df, data.frame()), NULL)
})
waldo/tests/testthat/test-compare-value.R 0000644 0001762 0000144 00000010157 14110717705 020231 0 ustar ligges users test_that("character comparison", {
expect_snapshot({
"no difference"
compare_character(c("a", "b"), c("a", "b"))
"single change"
compare_character(c("a", "b", "c"), c("a", "b"))
compare_character(c("a", "b"), c("a", "b", "c"))
compare_character(c("a", "B", "c"), c("a", "b", "c"))
"multiple contexts"
compare_character(
c("a", "b", letters, "a", "b", "c", letters, "X"),
c("a", "b", "c", letters, "a", "b", letters, "Y")
)
"truncation"
compare_character(c("X", letters), letters)
compare_character(c(letters, "X"), letters)
"large diff"
compare(letters, c(letters[1:20], "a"))
})
})
test_that("multiline comparison", {
expect_snapshot({
compare_character("A\nthe apple is red\nC\n", "A\nthe apple was red\nC\n")
compare_character("A\nthe apple is red and green\nC\n", "A\nthe apple is red\nC\n")
compare_character("A\nthe apple is red and green\nC\n", "A\nI like bananas\nC\n")
"trailing newlines are correctly compared"
compare("x\n", "x")
})
})
test_that("multi-element multi-line comparisons get indices", {
expect_snapshot({
compare(c("a", "b", "c\nd"), c("a", "b", "c\ne"))
})
})
test_that("show elementwise differences of random permutations", {
expect_snapshot({
compare(letters[1:15], letters[c(14, 4, 12, 11, 13, 3, 10, 5, 1, 7, 9, 15, 6, 8, 2)], max_diffs = Inf)
compare(letters[1:15], letters[c(3, 13, 6, 10, 11, 9, 4, 5, 15, 2, 12, 14, 8, 7, 1)], max_diffs = Inf)
compare(letters[1:15], letters[c(12, 13, 1, 2, 5, 6, 11, 15, 10, 14, 9, 7, 3, 4, 8)], max_diffs = Inf)
})
})
test_that("favour smart diff over elementwise when total length is the same", {
expect_snapshot({
compare(c(1, 2, 3, 4, 5), c(1, 2, 10, 3, 4, 5))
compare(c(1, 2, 4, 5), c(1, 2, 3, 4, 5))
})
})
test_that("numeric comparison", {
expect_snapshot({
"no difference"
compare_numeric(1:3, 1:3)
compare_numeric(c(1, NA), c(1, NA))
compare_numeric(c(NA, 1), c(1, NA))
"simple change"
compare_numeric(c(1, 2, 3), c(1, 2))
compare_numeric(c(1, 2), c(1, 2, 3))
compare_numeric(c(1, 10, 3), c(1, 2, 3))
"equal length"
x <- c(1, 2, 3)
compare_numeric(x, x + c(-1, 0, 1) * 1e-3)
compare_numeric(x, x + c(-1, 0, 1) * 1e-4)
compare_numeric(x, x + c(-1, 0, 1) * 1e-5)
compare_numeric(x, x + c(-1, 0, 1) * 1e-6)
compare_numeric(x, x + c(-1, 0, 1) * 1e-7)
compare_numeric(x, x + c(-1, 0, 1) * 1e-8)
compare_numeric(x, x + c(-1, 0, 1) * 1e-8, tolerance = 0)
compare_numeric(x, x + c(-1, 0, 1) * 1e-9, tolerance = 0)
compare_numeric(x, x + c(-1, 0, 1) * 1e-10, tolerance = 0)
"unequal length"
compare_numeric(c(1, 2, NA), c(1, 2 + 1e-7, NA, 3))
})
})
test_that("numeric comparison works on factors", {
expect_snapshot({
f1 <- factor(c("a", "b", "c"))
f2 <- factor(c("a", "c", "b"), c("a", "c", "b"))
compare(f1, f2)
f3 <- factor(c("a", "B", "c"))
compare(f1, f3)
})
})
test_that("shows row-by-row diff for numeric matrices", {
expect_snapshot({
x <- y <- matrix(1:4, nrow = 2)
y[2, 2] <- 5L
compare(x, y)
})
})
test_that("falls back to regular display if printed representation the same", {
expect_snapshot({
x <- y <- matrix(1:4, nrow = 2)
y[2, 2] <- y[2, 2] + 1e-10
compare(x, y)
})
})
test_that("logical comparisons minimise extraneous diffs", {
x1 <- x2 <- rep(TRUE, 50)
x2[c(1, 25, 50)] <- FALSE
expect_snapshot(compare_logical(x1, x2))
x3 <- rep(c(TRUE, FALSE), 25)
x4 <- rep(c(FALSE, TRUE), 26)
expect_snapshot(compare_logical(x3, x4))
})
test_that("min_digits correctly computed digits needed for comparison", {
expect_equal(min_digits(0.21, 0.23), 2)
expect_equal(min_digits(1.93, 1.92), 2)
expect_equal(min_digits(1, 1.1), 1)
expect_equal(min_digits(1, 1.01), 2)
expect_equal(min_digits(1, 1.001), 3)
expect_equal(min_digits(1, 1.0001), 4)
expect_equal(min_digits(1, 1.00001), 5)
expect_equal(min_digits(1, 1.000001), 6)
expect_equal(min_digits(1, 1.0000001), 7)
expect_equal(min_digits(1, 1.00000001), 8)
expect_equal(min_digits(1, 1.000000001), 9)
expect_equal(min_digits(1, 1.0000000001), 10)
})
waldo/tests/testthat/test-proxy.R 0000644 0001762 0000144 00000000360 14107732266 016652 0 ustar ligges users test_that("xml2 proxy generates useful comparisons", {
expect_snapshot({
x1a <- xml2::read_xml("1")
x1b <- xml2::read_xml("1")
compare(x1a, x1b)
x2 <- xml2::read_xml("2")
compare(x1a, x2)
})
})
waldo/tests/testthat.R 0000644 0001762 0000144 00000000066 13637650533 014522 0 ustar ligges users library(testthat)
library(waldo)
test_check("waldo")
waldo/R/ 0000755 0001762 0000144 00000000000 14107732672 011572 5 ustar ligges users waldo/R/compare-value.R 0000644 0001762 0000144 00000004426 14110717433 014453 0 ustar ligges users compare_logical <- function(x, y, paths = c("x", "y"), max_diffs = Inf) {
diff_element(
encodeString(x), encodeString(y), paths,
quote = NULL,
max_diffs = max_diffs
)
}
compare_character <- function(x, y, paths = c("x", "y"), quote = "\"", max_diffs = Inf) {
if (multiline(x) || multiline(y)) {
x <- split_by_line(x)
y <- split_by_line(y)
opts <- compare_opts(max_diffs = max_diffs)
if (length(x) == 1 && length(y) == 1) {
new_compare(compare_by_line1(x, y, paths, opts))
} else {
new_compare(compare_by_line(x, y, paths, opts))
}
} else {
diff_element(x, y, paths, quote = quote, max_diffs = max_diffs)
}
}
compare_numeric <- function(x, y, paths = c("x", "y"), tolerance = default_tol(), max_diffs = Inf) {
if (num_equal(x, y, tolerance)) {
return(new_compare())
}
if (!is.null(dim(x)) && identical(dim(x), dim(y))) {
rows <- printed_rows(x, y, paths = paths)
out <- diff_rows(rows, paths = paths, max_diffs = max_diffs)
if (length(out) > 0) {
return(out)
}
}
if (length(x) == length(y)) {
digits <- min_digits(x, y)
x_fmt <- num_exact(x, digits = digits)
y_fmt <- num_exact(y, digits = digits)
} else {
# Not align, so need to find max number of digits
x_fmt <- as.character(x)
y_fmt <- as.character(y)
}
out <- diff_element(
x_fmt, y_fmt, paths,
quote = NULL,
justify = "right",
max_diffs = max_diffs
)
if (length(out) > 0) {
out
} else {
glue::glue("{paths[[1]]} != {paths[[2]]} but don't know how to show the difference")
}
}
# Helpers -----------------------------------------------------------------
num_exact <- function(x, digits = 6) {
sprintf(paste0("%0.", digits, "f"), x)
}
# Minimal number of digits needed to show differences
min_digits <- function(x, y) {
attributes(x) <- NULL
attributes(y) <- NULL
digits(abs(x - y))
}
# This looks ok:
# grid <- 10 ^ seq(0, -6, length.out = 1e3)
# plot(grid, sapply(grid, digits), log = "x")
digits <- function(x) {
x <- x[!is.na(x) & x != 0]
if (length(x) == 0) {
return(0)
}
scale <- -log10(min(x))
if (scale <= 0) {
# Don't add digits if x > 1
0L
} else {
# Need to first round roughly to avoid tiny FP differences
ceiling(round(scale, digits = 2))
}
}
waldo/R/utils.R 0000644 0001762 0000144 00000006751 14075620577 013072 0 ustar ligges users oo_type <- function(x) {
if (is.object(x)) {
if (isS4(x)) {
"S4"
} else {
if (inherits(x, "R6")) {
"R6"
} else {
"S3"
}
}
} else {
"base"
}
}
friendly_type_of <- function(x) {
if (is_missing(x)) {
return("absent")
}
if (!is.object(x)) {
return(friendly_type(typeof(x)))
}
if (!isS4(x)) {
if (inherits(x, "R6")) {
klass <- paste(setdiff(class(x), "R6"), collapse = "/")
paste0("an R6 object of class <", klass, ">")
} else {
paste0(
"an S3 object of class <", paste(class(x), collapse = "/"), ">, ",
friendly_type(typeof(x))
)
}
} else {
paste0("an S4 object of class <", is(x), ">")
}
}
friendly_type <- function(type) {
switch(type,
logical = "a logical vector",
integer = "an integer vector",
numeric = ,
double = "a double vector",
complex = "a complex vector",
character = "a character vector",
raw = "a raw vector",
string = "a string",
list = "a list",
NULL = "NULL",
environment = "an environment",
externalptr = "a pointer",
weakref = "a weak reference",
S4 = "an S4 object",
name = ,
symbol = "a symbol",
language = "a call",
pairlist = "a pairlist node",
expression = "an expression vector",
quosure = "a quosure",
formula = "a formula",
char = "an internal string",
promise = "an internal promise",
... = "an internal dots object",
any = "an internal `any` object",
bytecode = "an internal bytecode object",
primitive = ,
builtin = ,
special = "a primitive function",
closure = "a function",
type
)
}
short_val <- function(x) {
if (is.object(x) || !is_atomic(x)) {
return("")
}
if (is.character(x)) {
x <- encodeString(x, quote = "'")
}
if (length(x) > 5) {
x <- c(x[1:5], "...")
}
paste0(" (", paste0(x, collapse = ", "), ")")
}
attrs <- function(x, ignore) {
out <- attributes(x)
names <- setdiff(names2(out), ignore)
first <- intersect(c("class", "names", "dim"), names)
rest <- sort(setdiff(names, first))
out[c(first, rest)]
}
is_numeric <- function(x) is_integer(x) || is_double(x)
in_ci <- function() {
isTRUE(as.logical(Sys.getenv("CI", "FALSE")))
}
if (getRversion() < "3.3.0") {
strrep <- function(x, times) {
vapply(
times,
function(n) paste(rep(x, n), collapse = ""),
FUN.VALUE = character(1)
)
}
}
fansi_align <- function(x, width = NULL, justify = c("left", "right")) {
justify <- arg_match(justify)
nchar <- fansi::nchar_ctl(x)
width <- width %||% max(nchar)
padding <- strrep(" ", pmax(0, width - nchar))
switch(justify,
left = paste0(x, padding),
right = paste0(padding, x)
)
}
split_by_line <- function(x) {
trailing_nl <- grepl("\n$", x)
x <- strsplit(x, "\n")
x[trailing_nl] <- lapply(x[trailing_nl], c, "")
x
}
multiline <- function(x) any(grepl("\n", x))
default_tol <- function() .Machine$double.eps^0.5
merge_lists <- function(...) {
all <- compact(list(...))
Reduce(utils::modifyList, all, init = list())
}
compact <- function(x) {
is_null <- vapply(x, is.null, logical(1))
x[!is_null]
}
as_map <- function(x) {
# Remove nulls
is_null <- vapply(x, is.null, logical(1))
x <- x[!is_null]
# Sort named components, preserving positions of unnamed
nx <- names2(x)
is_named <- nx != ""
if (any(is_named)) {
idx <- seq_along(x)
idx[is_named] <- idx[is_named][order(nx[is_named])]
x <- x[idx]
}
x
}
waldo/R/waldo-package.R 0000644 0001762 0000144 00000000364 13637461573 014425 0 ustar ligges users #' @keywords internal
#' @import rlang
#' @importFrom glue glue
"_PACKAGE"
# The following block is used by usethis to automatically manage
# roxygen namespace tags. Modify with care!
## usethis namespace: start
## usethis namespace: end
NULL
waldo/R/compare-class.R 0000644 0001762 0000144 00000001150 14073632206 014435 0 ustar ligges users
new_compare <- function(x = character(), max_diffs = if (in_ci()) Inf else 10) {
stopifnot(is.character(x))
structure(x, max_diffs = max_diffs, class = "waldo_compare")
}
#' @export
print.waldo_compare <- function(x, n = attr(x, "max_diffs"), ...) {
stopifnot(is.numeric(n) && length(n) == 1 && n >= 1)
if (length(x) == 0) {
cli::cat_bullet("No differences", bullet = "tick", bullet_col = "green")
} else {
if (length(x) > n) {
x <- c(x[seq_len(n)], glue("And {length(x) - floor(n)} more differences ..."))
}
cat(paste0(x, collapse = "\n\n"), "\n", sep = "")
}
invisible(x)
}
waldo/R/compare-opts.R 0000644 0001762 0000144 00000003127 14075617165 014334 0 ustar ligges users compare_opts <- function(...,
tolerance = NULL,
max_diffs = if (in_ci()) Inf else 10,
ignore_srcref = TRUE,
ignore_attr = FALSE,
ignore_encoding = TRUE,
ignore_function_env = FALSE,
ignore_formula_env = FALSE,
list_as_map = FALSE
) {
base <- old_opts(...)
waldo <- list(
tolerance = tolerance,
max_diffs = max_diffs,
ignore_srcref = ignore_srcref,
ignore_attr = ignore_attr,
ignore_encoding = ignore_encoding,
ignore_function_env = ignore_function_env,
ignore_formula_env = ignore_formula_env,
list_as_map = list_as_map
)
utils::modifyList(waldo, base)
}
old_opts <- function(..., tol, check.attributes, checkNames) {
out <- list()
if (!missing(tol)) {
warn("`tol` is deprecated; please use `tolerance` instead")
out$tolerance <- tol
}
if (!missing(check.attributes)) {
warn("`check.attributes` is deprecated; please use `ignore_attr` instead")
out$ignore_attr <- !check.attributes
}
if (!missing(checkNames)) {
warn("`checkNames` no longer supported; please use `ignore_attr` instead")
out$ignore_attr <- !checkNames
}
if (!missing(...)) {
args <- substitute(...())
exprs <- vapply(args, expr_deparse, character(1))
names <- names2(args)
exprs <- ifelse(names == "", exprs, paste0(names, " = ", exprs))
warn(paste0("Unused arguments (", paste0(exprs, collapse = ', '), ")"))
}
out
}
waldo/R/num_equal.R 0000644 0001762 0000144 00000001143 14076070023 013670 0 ustar ligges users num_equal <- function(x, y, tolerance = .Machine$double.eps ^ 0.5) {
if (length(x) != length(y)) {
return(FALSE)
}
if (any(is.na(x) != is.na(y))) {
return(FALSE)
}
attributes(x) <- NULL
attributes(y) <- NULL
same <- is.na(x) | x == y
if (is.null(tolerance)) {
return(all(same))
} else if (all(same)) {
return(TRUE)
}
x_diff <- x[!same]
y_diff <- y[!same]
avg_diff <- mean(abs(x_diff - y_diff))
avg_y <- mean(abs(y_diff))
# compute relative difference when y is "large"
if (avg_y > tolerance) {
avg_diff <- avg_diff / avg_y
}
avg_diff < tolerance
}
waldo/R/compare-data-frame.R 0000644 0001762 0000144 00000005731 14116654143 015344 0 ustar ligges users compare_data_frame <- function(x, y, paths = c("x", "y"), opts = compare_opts()) {
# Only show row diffs if columns are atomic, have same names and types and there are rows
if (!all_atomic(x) || !all_atomic(y)) {
return()
}
if (!same_cols(x, y)) {
return()
}
if (nrow(x) == 0 || nrow(y) == 0) {
return()
}
rows <- df_rows(x, y, paths = paths, tolerance = opts$tolerance)
if (is.null(rows)) {
return()
}
diff_rows(rows, paths = paths, max_diffs = opts$max_diffs)
}
diff_rows <- function(rows, paths = c("x", "y"), max_diffs = 10) {
diffs <- ses_shortest(rows$x, rows$y)
if (length(diffs) == 0) {
return(new_compare())
}
# Align with diffs
header <- paste0(" ", names(rows$header), cli::style_bold(rows$header))
format <- lapply(diffs, function(diff) {
path_label <- paste0(paths[[1]], " vs ", paths[[2]])
lines <- line_by_line(rows$x, rows$y, diff, max_diffs = max_diffs)
paste0(c(path_label, header, lines), collapse = "\n")
})
new_compare(unlist(format, recursive = FALSE))
}
# Make a character matrix of formatted cell values
df_rows <- function(x, y, paths = c("x", "y"), tolerance = NULL) {
x <- factor_to_char(x)
y <- factor_to_char(y)
# If same length, drop identical columns
if (nrow(x) == nrow(y)) {
is_equal <- function(x, y) {
if (is_numeric(x)) {
num_equal(x, y, tolerance = tolerance)
} else {
identical(x, y)
}
}
same <- vapply(seq_along(x), function(j) is_equal(x[[j]], y[[j]]), logical(1))
x <- x[!same]
y <- y[!same]
}
if (ncol(x) == 0) {
return()
}
printed_rows(as.data.frame(x), as.data.frame(y), row.names = FALSE, paths = paths)
}
# join together two rectangles then print - this takes advantage of all the
# logic built into base R to get nice printing
printed_rows <- function(x, y, ..., paths = c("x", "y")) {
joint <- rbind(x, y)
if (!is.data.frame(joint)) {
rownames(joint) <- rep("", nrow(joint))
}
n <- nrow(joint) * ncol(joint)
lines <- utils::capture.output(print(joint, ..., width = 500, max = n))
row_idx <- c(seq_len(nrow(x)), seq_len(nrow(y)))
row_idx <- paste0(rep(paths, c(nrow(x), nrow(y))), "[", row_idx, ", ]")
names(lines) <- format(c("", row_idx), align = "right")
list(
header = lines[1],
x = lines[2:(nrow(x) + 1)],
y = lines[(nrow(x) + 2):length(lines)]
)
}
same_cols <- function(x, y) {
if (!identical(names(x), names(y))) {
return(FALSE)
}
for (j in seq_along(x)) {
if (!is.numeric(x[[j]]) || !is.numeric(y[[j]])) {
if (!identical(typeof(x[[j]]), typeof(y[[j]]))) {
return(FALSE)
}
}
if (!identical(attributes(x[[j]]), attributes(y[[j]]))) {
return(FALSE)
}
}
TRUE
}
factor_to_char <- function(x) {
is_factor <- vapply(x, is.factor, logical(1))
x[is_factor] <- lapply(x[is_factor], as.character)
x
}
unrowname <- function(x) {
row.names(x) <- NULL
x
}
all_atomic <- function(x) {
all(vapply(x, is_atomic, logical(1)))
}
waldo/R/ses.R 0000644 0001762 0000144 00000007616 14115424220 012503 0 ustar ligges users #
#
# * `lar`: Add the lines in range `r` of the second file
# after line `l` of the first file.
# * `fct`: Replace the lines in range `f` of the first file
# with lines in range `t` of the second file.
# * `rdl`: Delete the lines in range `r` from the first file; line `l` is
# where they would have appeared in the second file had they not been deleted.
ses <- function(x, y) {
attributes(x) <- NULL
attributes(y) <- NULL
if (is.character(x)) {
x <- enc2utf8(x)
y <- enc2utf8(y)
}
out <- diffobj::ses(x, y, warn = FALSE)
out <- rematch2::re_match(out, paste0(
"(?:(?\\d+),)?(?\\d+)",
"(?[acd])",
"(?:(?\\d+),)?(?\\d+)"
))[1:5]
out$x1 <- ifelse(out$x1 == "", out$x2, out$x1)
out$y1 <- ifelse(out$y1 == "", out$y2, out$y1)
out$x1 <- as.integer(out$x1)
out$x2 <- as.integer(out$x2)
out$y1 <- as.integer(out$y1)
out$y2 <- as.integer(out$y2)
out
}
ses_elementwise <- function(x, y) {
n_x <- length(x)
n_y <- length(y)
n <- min(n_x, n_y)
id <- seq_len(n)
same <- (is.na(x[id]) & is.na(y[id])) | x[id] == y[id]
same[is.na(same)] <- FALSE
neq <- id[!same]
if (length(neq) == 0) {
n_x <- length(x)
n_y <- length(y)
if (length(x) > length(y)) {
return(ses_df(n_y + 1, n_x, "d", n_y, n_y))
} else if (length(x) < length(y)) {
return(ses_df(n_x, n_x, "a", n_x + 1, n_y))
} else {
return(ses_df(integer(), integer(), character(), integer(), integer()))
}
}
new_group <- c(TRUE, neq[-1] - 1 != neq[-length(neq)])
group_id <- cumsum(new_group)
diffs <- unname(split(neq, group_id))
x1 <- y1 <- vapply(diffs, function(x) x[[1]], integer(1))
x2 <- y2 <- vapply(diffs, function(x) x[[length(x)]], integer(1))
t <- rep("c", length(diffs))
if (length(y) > length(x)) {
y2[[length(diffs)]] <- n_y
} else if (length(x) > length(y)) {
x2[[length(diffs)]] <- n_x
}
ses_df(x1, x2, t, y1, y2)
}
ses_shortest <- function(x, y, size = 3) {
ses1 <- ses(x, y)
if (nrow(ses1) == 0) {
return(list())
}
ses2 <- ses_elementwise(x, y)
context1 <- ses_chunks(ses1, length(x), length(y), size = size)
context2 <- ses_chunks(ses2, length(x), length(y), size = size)
diff_length <- function(ses) ses$x2[nrow(ses)] - ses$x1[[1]] + 1
diff1 <- sum(vapply(context1, diff_length, double(1)), na.rm = TRUE)
diff2 <- sum(vapply(context2, diff_length, double(1)))
if (diff1 == diff2) {
# If contextual diffs are same length, break tie using total
# number of changes
if (diff_length(ses1) < diff_length(ses2)) {
context1
} else {
context2
}
} else if (diff1 < diff2) {
context1
} else {
context2
}
}
ses_chunks <- function(diff, n_x, n_y, size = 3) {
# Compute context around each individual diff
diff$x_start <- pmax(diff$x1 - size, 1)
diff$x_end <- pmin(diff$x2 + size, n_x)
diff$y_start <- pmax(diff$y1 - size, 1)
diff$y_end <- pmin(diff$y2 + size, n_y)
# Split up into non-contiguous chunks
new_group <- c(TRUE, diff$x_start[-1] > diff$x_end[-nrow(diff)])
group_id <- cumsum(new_group)
diffs <- unname(split(diff, group_id))
# Fill in rows that are the same in x and y
lapply(diffs, diff_complete)
}
diff_complete <- function(diff) {
n <- nrow(diff)
diff$pos <- 1:n
ctxt <- data.frame(
pos = 1:(n + 1) - 0.5,
x1 = c(diff$x_start[[1]], diff$x2 + 1),
x2 = c(diff$x1 - 1, diff$x_end[[n]]),
t = "x",
y1 = c(diff$y_start[[1]], diff$y2 + 1),
y2 = c(diff$y1 - 1, diff$y_end[[n]])
)
out <- rbind(diff[names(ctxt)], ctxt)
# Interleave in correct order
out <- out[order(out$pos), , drop = FALSE]
out$pos <- NULL
# Drop rows with no data
needed <- (out$x2 - out$x1) >= 0 | (out$y2 - out$y1) >= 0
out[needed, , drop = FALSE]
}
ses_df <- function(x1, x2, t, y1, y2) {
tibble::tibble(x1 = x1, x2 = x2, t = t, y1 = y1, y2 = y2)
}
waldo/R/proxy.R 0000644 0001762 0000144 00000004342 14107732156 013076 0 ustar ligges users #' Proxy for waldo comparison
#'
#' @description
#' Use this generic to override waldo's default comparison if you need to
#' override the defaults (typically because your object stores data in an
#' external pointer).
#'
#' waldo comes with methods for a few common cases:
#'
#' * data.table: the `.internal.selfref` attribute is set to `NULL`. This is
#' an external pointer that is used for performance optimisation, and
#' doesn't affect the data.
#'
#' * `xml2::xml_node`: the underlying XML data is stored in memory in C,
#' behind an external pointer, so the we best can do is to convert the
#' object to a string.
#'
#' * Classes from the `RProtoBuf` package: like XML objects, these store
#' data in memory in C++ and only expose string names to R. Fortunately,
#' these have well-understood string representations that we can use for
#' comparisons. See
#'
#'
#' @param x An object.
#' @param path Path
#' @return A list with two components:
#' * `object`: the modified object
#' * `path`: an updated path showing what modification was applied
#' @export
compare_proxy <- function(x, path = "x") {
UseMethod("compare_proxy")
}
#' @export
compare_proxy.default <- function(x, path) {
list(object = x, path = path)
}
#' @export
compare_proxy.data.table <- function(x, path) {
attr(x, ".internal.selfref") <- NULL
list(object = x, path = path)
}
#' @export
compare_proxy.xml_node <- function(x, path) {
list(object = as.character(x), path = paste0("as.character(", path, ")"))
}
# RProtoBuf objects -------------------------------------------------------
compare_protobuf <- function(x, path) {
list(object = x$toString, path = paste0(path, "$toString()"))
}
#' @export
compare_proxy.Message <- compare_protobuf
#' @export
compare_proxy.Descriptor <- compare_protobuf
#' @export
compare_proxy.EnumDescriptor <- compare_protobuf
#' @export
compare_proxy.FieldDescriptor <- compare_protobuf
#' @export
compare_proxy.ServiceDescriptor <- compare_protobuf
#' @export
compare_proxy.FileDescriptor <- compare_protobuf
#' @export
compare_proxy.EnumValueDescriptor <- compare_protobuf
#' @export
compare_proxy.MethodDescriptor <- compare_protobuf
waldo/R/diff.R 0000644 0001762 0000144 00000014077 14076106574 012637 0 ustar ligges users diff_align <- function(diff, x, y) {
n <- nrow(diff)
x_out <- character()
y_out <- character()
x_idx <- integer()
y_idx <- integer()
for (i in seq_len(n)) {
row <- diff[i, , drop = FALSE]
x_i <- seq2(row$x1, row$x2)
y_i <- seq2(row$y1, row$y2)
# Sometimes (last row?) a change is really one change + many additions
if (row$t == "c" && length(x_i) != length(y_i)) {
m <- max(length(x_i), length(y_i))
length(x_i) <- m
length(y_i) <- m
}
x_out <- c(x_out, switch(row$t,
a = c(col_x(x[x_i]), NA[y_i]),
c = col_c(x[x_i]),
d = col_d(x[x_i]),
x = col_x(x[x_i])
))
y_out <- c(y_out, switch(row$t,
a = col_a(y[y_i]),
c = col_c(y[y_i]),
d = c(col_x(y[y_i]), NA[x_i]),
x = col_x(y[y_i])
))
x_idx <- c(x_idx, x_i[x_i != 0], if (row$t == "a") NA[y_i])
y_idx <- c(y_idx, y_i[y_i != 0], if (row$t == "d") NA[x_i])
}
# Ensure both contexts are same length
if (length(x_out) != length(y_out)) {
# TODO: need to figure out when to truncate from left vs right
len <- min(length(x_out), length(y_out))
x_out <- x_out[seq(length(x_out) - len + 1, length(x_out))]
y_out <- y_out[seq(length(y_out) - len + 1, length(y_out))]
x_idx <- x_idx[seq(length(x_idx) - len + 1, length(x_idx))]
y_idx <- y_idx[seq(length(y_idx) - len + 1, length(y_idx))]
}
x_slice <- make_slice(x, x_idx)
y_slice <- make_slice(y, y_idx)
list(
x = x_out,
y = y_out,
x_slice = x_slice,
y_slice = y_slice,
x_idx = x_idx,
y_idx = y_idx
)
}
# Only want to show slice if it's partial
make_slice <- function(x, idx) {
if (all(is.na(idx))) {
return(NULL)
}
idx <- range(idx, na.rm = TRUE)
if (idx[[1]] <= 1 && idx[[2]] >= length(x)) {
NULL
} else {
idx
}
}
col_a <- function(x) ifelse(is.na(x), NA, cli::col_blue(x))
col_d <- function(x) ifelse(is.na(x), NA, cli::col_yellow(x))
col_c <- function(x) ifelse(is.na(x), NA, cli::col_green(x))
col_x <- function(x) ifelse(is.na(x), NA, cli::col_grey(x))
# values ------------------------------------------------------------------
diff_element <- function(x, y, paths = c("x", "y"),
quote = "\"",
justify = "left",
max_diffs = 10,
width = getOption("width")) {
diff <- ses_shortest(x, y)
if (length(diff) == 0) {
return(new_compare())
}
if (!is.null(quote)) {
x <- encodeString(x, quote = quote)
y <- encodeString(y, quote = quote)
}
format <- lapply(diff, format_diff_matrix,
x = x,
y = y,
paths = paths,
justify = justify,
width = width,
max_diffs = max_diffs
)
new_compare(unlist(format, recursive = FALSE))
}
format_diff_matrix <- function(diff, x, y, paths,
justify = "left",
width = getOption("width"),
max_diffs = 10) {
alignment <- diff_align(diff, x, y)
mat <- rbind(alignment$x, alignment$y)
mat[is.na(mat)] <- ""
n <- min(ncol(mat), max_diffs)
n_trunc <- ncol(mat) - n
# Label slices, if needed
x_path_label <- label_path(paths[[1]], alignment$x_slice)
y_path_label <- label_path(paths[[2]], alignment$y_slice)
# Paired lines ---------------------------------------------------------------
mat_out <- cbind(paste0("`", c(x_path_label, y_path_label), "`:"), mat)
if (n_trunc > 0) {
mat_out <- mat_out[, seq_len(n + 1)]
mat_out <- cbind(mat_out, c(paste0("and ", n_trunc, " more..."), "..."))
}
out <- apply(mat_out, 2, fansi_align, justify = justify)
rows <- apply(out, 1, paste, collapse = " ")
if (fansi::nchar_ctl(rows[[1]]) <= width) {
return(paste0(rows, collapse = "\n"))
}
# Side-by-side ---------------------------------------------------------------
x_idx_out <- label_idx(alignment$x_idx)
y_idx_out <- label_idx(alignment$y_idx)
idx_width <- max(nchar(x_idx_out), nchar(y_idx_out))
divider <- ifelse(mat[1,] == mat[2, ], "|", "-")
mat_out <- cbind(c(paths[[1]], "|", paths[[2]]), rbind(mat[1, ], divider, mat[2, ]))
if (n_trunc > 0) {
mat_out <- mat_out[, seq_len(n + 1)]
mat_out <- cbind(mat_out, c("...", "", "..."))
x_idx_out <- c(x_idx_out[seq_len(n)], "...")
y_idx_out <- c(y_idx_out[seq_len(n)], paste0("and ", n_trunc, " more ..."))
}
mat_out <- rbind(
format(c("", x_idx_out), justify = "right"),
mat_out,
format(c("", y_idx_out), justify = "left")
)
out <- apply(mat_out, 1, fansi_align, justify = "left")
rows <- apply(out, 1, paste, collapse = " ")
if (fansi::nchar_ctl(rows[[1]]) <= width) {
return(paste0(rows, collapse = "\n"))
}
# Line-by-line ---------------------------------------------------------------
lines <- line_by_line(x, y, diff, max_diffs = max_diffs)
paste0(
paste0(x_path_label, " vs ", y_path_label), "\n",
paste0(lines, collapse = "\n")
)
}
line_by_line <- function(x, y, diff, max_diffs = 10) {
lines <- character()
line_a <- function(x) if (length(x) > 0) col_a(paste0("+ ", names(x), x))
line_d <- function(x) if (length(x) > 0) col_d(paste0("- ", names(x), x))
line_x <- function(x) if (length(x) > 0) col_x(paste0(" ", names(x), x))
n <- min(max_diffs, nrow(diff))
n_trunc <- nrow(diff) - n
for (i in seq_len(n)) {
row <- diff[i, , drop = FALSE]
x_i <- seq2(row$x1, row$x2)
y_i <- seq2(row$y1, row$y2)
lines <- c(lines, switch(row$t,
x = line_x(x[x_i]),
a = c(line_x(x[x_i]), line_a(y[y_i])),
c = interleave(line_d(x[x_i]), line_a(y[y_i])),
d = line_d(x[x_i])
))
}
if (n_trunc > 0) {
lines <- c(lines, paste0("and ", n_trunc, " more ..."))
}
lines
}
interleave <- function(x, y) {
# Only interleave if same number of lines
if (length(x) == length(y)) {
ord <- c(seq_along(x), seq_along(y))
c(x, y)[order(ord)]
} else {
c(x, y)
}
}
label_path <- function(path, slice) {
if (is.null(slice)) {
path
} else {
paste0(path, "[", slice[[1]], ":", slice[[2]], "]")
}
}
label_idx <- function(idx) {
ifelse(is.na(idx), "", paste0("[", idx, "]"))
}
waldo/R/compare.R 0000644 0001762 0000144 00000037175 14110717425 013351 0 ustar ligges users #' Compare two objects
#'
#' @description
#' This compares two R objects, identifying the key differences. It:
#'
#' * Orders the differences from most important to least important.
#' * Displays the values of atomic vectors that are actually different.
#' * Carefully uses colour to emphasise changes (while still being readable
#' when colour isn't available).
#' * Uses R code (not a text description) to show where differences arise.
#' * Where possible, it compares elements by name, rather than by position.
#' * Errs on the side of producing too much output, rather than too little.
#'
#' `compare()` is an alternative to [all.equal()].
#'
#' @section Controlling comparisons:
#'
#' There are two ways for an object (rather than the person calling `compare()`
#' or `expect_equal()` to control how it is compared to other objects.
#' First, if the object has an S3 class, you can provide a [compare_proxy()]
#' method that provides an alternative representation of the object; this is
#' particularly useful if important data is stored outside of R, e.g. in
#' an external pointer.
#'
#' Alternatively, you can attach an attribute called `"waldo_opts"` to your
#' object. This should be a list of compare options, using the same names
#' and possible values as the arguments to this function. This option
#' is ignored by default (`ignore_attr`) so that you can set the options in
#' the object that you control. (If you don't want to see the attributes
#' interactively, you could attach them in a [compare_proxy()] method.)
#'
#' Options supplied in this way also affect all the children. This means
#' options are applied in the following order, from lowest to highest
#' precedence:
#'
#' 1. Defaults from `compare()`.
#' 1. The `waldo_opts` for the parents of `x`.
#' 1. The `waldo_opts` for the parents of `y`.
#' 1. The `waldo_opts` for `x`.
#' 1. The `waldo_opts` for `y`.
#' 1. User-specified arguments to `compare()`.
#'
#' Use these techniques with care. If you accidentally cover up an important
#' difference you can create a confusing situation where `x` and `y` behave
#' differently but `compare()` reports no differences in the underlying objects.
#'
#' @param x,y Objects to compare. `y` is treated as the reference object
#' so messages describe how `x` is different to `y`
#' @param x_arg,y_arg Name of `x` and `y` arguments, used when generated paths
#' to internal components. These default to "old" and "new" since it's
#' most natural to supply the previous value then the new value.
#' @param ... A handful of other arguments are supported with a warning for
#' backward compatability. These include:
#'
#' * `all.equal()` arguments `checkNames` and `check.attributes`
#' * `testthat::compare()` argument `tol`
#'
#' All other arguments are ignored with a warning.
#' @param tolerance If non-`NULL`, used as threshold for ignoring small
#' floating point difference when comparing numeric vectors. Setting to
#' any non-`NULL` value will cause integer and double vectors to be compared
#' based on their values, rather than their types.
#'
#' It uses the same algorithm as [all.equal()], i.e., first we generate
#' `x_diff` and `y_diff` by subsetting `x` and `y` to look only locations
#' with differences. Then we check that
#' `mean(abs(x_diff - y_diff)) / mean(abs(y_diff))` (or just
#' `mean(abs(x_diff - y_diff))` if `y_diff` is small) is less than
#' `tolerance`.
#' @param max_diffs Control the maximum number of differences shown. The
#' default shows 10 differences when run interactively and all differences
#' when run in CI. Set `max_diffs = Inf` to see all differences.
#' @param ignore_srcref Ignore differences in function `srcref`s? `TRUE` by
#' default since the `srcref` does not change the behaviour of a function,
#' only its printed representation.
#' @param ignore_attr Ignore differences in specified attributes?
#' Supply a character vector to ignore differences in named attributes.
#' By default the `"waldo_opts"` attribute is listed in `ignore_attr` so
#' that changes to it are not reported; if you customize `ignore_attr`, you
#' will probably want to do this yourself.
#'
#' For backward compatibility with `all.equal()`, you can also use `TRUE`,
#' to all ignore differences in all attributes. This is not generally
#' recommended as it is a blunt tool that will ignore many important
#' functional differences.
#' @param ignore_function_env,ignore_formula_env Ignore the environments of
#' functions and formulas, respectively? These are provided primarily for
#' backward compatibility with `all.equal()` which always ignores these
#' environments.
#' @param ignore_encoding Ignore string encoding? `TRUE` by default, because
#' this is R's default behaviour. Use `FALSE` when specifically concerned
#' with the encoding, not just the value of the string.
#' @param list_as_map Compare lists as if they are mappings between names and
#' values. Concretely, this drops `NULLs` in both objects and sorts named
#' components.
#' @returns A character vector with class "waldo_compare". If there are no
#' differences it will have length 0; otherwise each element contains the
#' description of a single difference.
#' @export
#' @examples
#' # Thanks to diffobj package comparison of atomic vectors shows differences
#' # with a little context
#' compare(letters, c("z", letters[-26]))
#' compare(c(1, 2, 3), c(1, 3))
#' compare(c(1, 2, 3), c(1, 3, 4, 5))
#' compare(c(1, 2, 3), c(1, 2, 5))
#'
#' # More complex objects are traversed, stopping only when the types are
#' # different
#' compare(
#' list(x = list(y = list(structure(1, z = 2)))),
#' list(x = list(y = list(structure(1, z = "a"))))
#' )
#'
#' # Where possible, recursive structures are compared by name
#' compare(iris, rev(iris))
#'
#' compare(list(x = "x", y = "y"), list(y = "y", x = "x"))
#' # Otherwise they're compared by position
#' compare(list("x", "y"), list("x", "z"))
#' compare(list(x = "x", x = "y"), list(x = "x", y = "z"))
#'
compare <- function(x, y, ...,
x_arg = "old", y_arg = "new",
tolerance = NULL,
max_diffs = if (in_ci()) Inf else 10,
ignore_srcref = TRUE,
ignore_attr = "waldo_opts",
ignore_encoding = TRUE,
ignore_function_env = FALSE,
ignore_formula_env = FALSE,
list_as_map = FALSE
) {
opts <- compare_opts(
...,
tolerance = tolerance,
max_diffs = max_diffs,
ignore_srcref = ignore_srcref,
ignore_attr = ignore_attr,
ignore_encoding = ignore_encoding,
ignore_formula_env = ignore_formula_env,
ignore_function_env = ignore_function_env,
list_as_map = list_as_map
)
# Record options overridden by user
opts$user_specified <- intersect(names(opts), names(match.call()))
out <- compare_structure(x, y, paths = c(x_arg, y_arg), opts = opts)
new_compare(out, max_diffs)
}
compare_structure <- function(x, y, paths = c("x", "y"), opts = compare_opts()) {
if (!is_missing(x)) {
proxy <- compare_proxy(x, paths[[1]])
x <- proxy$object
paths[[1]] <- proxy$path
}
if (!is_missing(y)) {
proxy <- compare_proxy(y, paths[[2]])
y <- proxy$object
paths[[2]] <- proxy$path
}
opts <- merge_lists(opts,
attr(x, "waldo_opts"),
attr(y, "waldo_opts"),
opts[opts$user_specified]
)
if (is_identical(x, y, opts)) {
return(character())
}
# Compare type
term <- compare_terminate(x, y, paths,
tolerance = opts$tolerance,
ignore_attr = opts$ignore_attr
)
if (length(term) > 0) {
return(term)
}
if (is_list(x) && opts$list_as_map) {
x <- as_map(x)
y <- as_map(y)
}
out <- character()
# Then length
if ((is_list(x) || is_pairlist(x)) && length(x) != length(y)) {
out <- c(out, should_be("length {length(x)}", "length {length(y)}"))
}
# Then attributes/slots
if (isS4(x)) {
out <- c(out, compare_character(is(x), is(y), glue("is({paths})")))
out <- c(out, compare_by_slot(x, y, paths, opts))
# S4 objects can have attributes that are not slots
out <- c(out, compare_by_attr(
attrs(x, c(slotNames(x), "class")),
attrs(y, c(slotNames(y), "class")),
paths, opts)
)
} else if (!isTRUE(opts$ignore_attr)) {
if (is_call(x) && opts$ignore_formula_env) {
attr(x, ".Environment") <- NULL
attr(y, ".Environment") <- NULL
}
if ((is_closure(x) || is_call(x)) && opts$ignore_srcref) {
x <- zap_srcref(x)
y <- zap_srcref(y)
}
out <- c(out, compare_by_attr(attrs(x, opts$ignore_attr), attrs(y, opts$ignore_attr), paths, opts))
}
# Then contents
if (is_list(x) || is_pairlist(x) || is.expression(x)) {
if (is.data.frame(x) && is.data.frame(y)) {
out <- c(out, compare_data_frame(x, y, paths, opts = opts))
}
x <- unclass(x)
y <- unclass(y)
ignore_names <- isTRUE(opts$ignore_attr) || "names" %in% opts$ignore_attr
if (!ignore_names && is_dictionaryish(x) && is_dictionaryish(y)) {
out <- c(out, compare_by_name(x, y, paths, opts))
} else {
out <- c(out, compare_by_pos(x, y, paths, opts))
}
} else if (is_environment(x)) {
if (env_has(x, ".__enclos_env__")) {
# enclosing env of methods is object env
opts$ignore_function_env <- TRUE
x_fields <- as.list(x)
y_fields <- as.list(y)
x_fields$.__enclos_env__ <- NULL
y_fields$.__enclos_env__ <- NULL
# Can't use as.list(sorted = TRUE), https://github.com/r-lib/waldo/issues/84
x_fields <- x_fields[order(names(x_fields))]
y_fields <- y_fields[order(names(y_fields))]
out <- c(out, compare_structure(x_fields, y_fields, paths, opts = opts))
} else {
out <- c(out, should_be("", ""))
}
} else if (is_closure(x)) {
if (opts$ignore_function_env) {
environment(x) <- emptyenv()
environment(y) <- emptyenv()
}
out <- c(out, compare_by_fun(x, y, paths, opts))
} else if (is_primitive(x)) {
out <- c(out, should_be("`{deparse(x)}`", "`{deparse(y)}`"))
} else if (is_symbol(x)) {
out <- c(out, should_be("`{deparse(x)}`", "`{deparse(y)}`"))
} else if (is_call(x)) {
attributes(x) <- NULL
attributes(y) <- NULL
if (!identical(x, y)) {
diff <- compare_character(
deparse(x), deparse(y), paths,
quote = "`",
max_diffs = opts$max_diffs
)
if (length(diff) == 0) {
# Fallback if deparse equal but AST different
diff <- compare_structure(as.list(x), as.list(y), paths, opts = opts)
}
out <- c(out, diff)
}
} else if (is_atomic(x)) {
if (is_character(x) && !opts$ignore_encoding) {
out <- c(out, compare_character(
Encoding(x), Encoding(y), glue("Encoding({paths})"),
max_diffs = opts$max_diffs
))
}
out <- c(out, switch(typeof(x),
integer = ,
complex = ,
double = compare_numeric(x, y, paths,
tolerance = opts$tolerance,
max_diffs = opts$max_diffs
),
logical = compare_logical(x, y, paths, max_diffs = opts$max_diffs),
raw = ,
character = compare_character(x, y, paths, max_diffs = opts$max_diffs)
))
} else if (typeof(x) == "externalptr") {
x <- utils::capture.output(print(x))
y <- utils::capture.output(print(y))
out <- c(out, should_be("{x}", "{y}"))
} else if (!isS4(x)) {
abort(glue("{paths[[1]]}: unsupported type {typeof(x)}"))
}
out
}
# Fast path for "identical" elements - in the long run we'd eliminate this
# by re-writing all of waldo in C, but this gives us a nice performance boost
# with for a relatively low cost in the meantime.
is_identical <- function(x, y, opts) {
# These comparisons aren't 100% correct because they don't affect comparison
# of character vectors/functions further down the tree. But I think that's
# unlikely to have an impact in practice since they're opt-in.
if (is_character(x) && is_character(y) && !opts$ignore_encoding) {
identical(x, y) && identical(Encoding(x), Encoding(y))
} else if (is_function(x) && is_function(y) && !opts$ignore_srcref) {
identical(x, y) && identical(attr(x, "srcref"), attr(y, "srcref"))
} else {
identical(x, y)
}
}
compare_terminate <- function(x, y, paths,
tolerance = NULL,
ignore_attr = FALSE) {
type_x <- friendly_type_of(x)
type_y <- friendly_type_of(y)
if (is_missing(x) && !is_missing(y)) {
type_y <- col_d(type_y)
} else if (!is_missing(x) && is_missing(y)) {
type_x <- col_a(type_x)
} else {
type_x <- col_c(type_x)
type_y <- col_c(type_y)
}
type_mismatch_msg <- should_be("{type_x}{short_val(x)}", "{type_y}{short_val(y)}")
# missing needs to be treated here because `typeof(missing_arg())` is symbol
if (is_missing(x) != is_missing(y)) {
return(type_mismatch_msg)
}
if (typeof(x) == typeof(y) && oo_type(x) == oo_type(y)) {
return(character())
}
if (isTRUE(ignore_attr) && (typeof(x) == typeof(y))) {
return(character())
}
if (!is.null(tolerance) && is_numeric(x) && is_numeric(y)) {
return(character())
}
# don't care about difference between builtin and special
if (is_primitive(x) && is_primitive(y)) {
return(should_be("`{deparse(x)}`", "`{deparse(y)}`"))
}
type_mismatch_msg
}
should_be <- function(x, y) {
string <- paste0(
"`{paths[[1]]}` is ", x, "\n",
"`{paths[[2]]}` is ", y
)
glue(string, .envir = caller_env(), .trim = FALSE)
}
# compare_each ------------------------------------------------------------
compare_by <- function(index_fun, extract_fun, path_fun) {
function(x, y, paths, opts) {
idx <- index_fun(x, y)
if (length(idx) == 0)
return(character())
x_paths <- path_fun(paths[[1]], idx)
y_paths <- path_fun(paths[[2]], idx)
out <- character()
for (i in seq_along(idx)) {
out <- c(out, compare_structure(
x = extract_fun(x, idx[[i]]),
y = extract_fun(y, idx[[i]]),
paths = c(x_paths[[i]], y_paths[[i]]),
opts = opts)
)
}
out
}
}
index_name <- function(x, y) union(names(x), names(y))
extract_name <- function(x, i) if (has_name(x, i)) .subset2(x, i) else missing_arg()
path_name <- function(path, i) glue("{path}${i}")
compare_by_name <- compare_by(index_name, extract_name, path_name)
index_pos <- function(x, y) seq_len(max(length(x), length(y)))
extract_pos <- function(x, i) if (i <= length(x)) .subset2(x, i) else missing_arg()
path_pos <- function(path, i) glue("{path}[[{i}]]")
compare_by_pos <- compare_by(index_pos, extract_pos, path_pos)
path_line <- function(path, i) glue("lines({path}[[{i}]])")
compare_by_line <- compare_by(index_pos, extract_pos, path_line)
path_line1 <- function(path, i) glue("lines({path})")
compare_by_line1 <- compare_by(index_pos, extract_pos, path_line1)
path_attr <- function(path, i) {
# from ?attributes, excluding row.names() because it's not a simple accessor
funs <- c("comment", "class", "dim", "dimnames", "levels", "names", "tsp")
ifelse(i %in% funs, glue("{i}({path})"), glue("attr({path}, '{i}')"))
}
compare_by_attr <- compare_by(index_name, extract_name, path_attr)
#' @importFrom methods slotNames .hasSlot slot is
index_slot <- function(x, y) union(slotNames(x), slotNames(y))
extract_slot <- function(x, i) if (.hasSlot(x, i)) slot(x, i) else missing_arg()
path_slot <- function(path, i) glue("{path}@{i}")
compare_by_slot <- compare_by(index_slot, extract_slot, path_slot)
extract_fun <- function(x, i) switch(i, fn_body(x), fn_fmls(x), fn_env(x))
path_fun <- function(path, i) {
fun <- unname(c("body", "formals", "environment")[i])
glue("{fun}({path})")
}
compare_by_fun <- compare_by(function(x, y) 1:3, extract_fun, path_fun)
waldo/NEWS.md 0000644 0001762 0000144 00000011620 14120161270 012450 0 ustar ligges users # waldo 0.3.1
* `compare()`ing data frames now works independently of `option(max.print)`
(#105).
* Fixed regression when comparing vectors with missing values (#102).
# waldo 0.3.0
* `compare()` is now considerably faster when comparing complex objects that
don't have any differences (thanks to strategic use of `identical()`) (#86).
* `compare()` gains two improvements to low-level diffs:
* Structurally identical data frames (#78) and numeric matrices (#76) gain
a row-by-row diff that makes it easier to see where exactly values differ.
* An element-by-element diff will be automatically used if it's shorter than
the "smart" diff. This improves diff quality when comparing two vectors
that aren't really related (#68).
* `compare()` gains a `list_as_map` argument thanks to an idea from @dmurdoch.
It allows you to compare the behaviour of two lists when they are used to
connect names to values (i.e. the list is operating as a map or dictionary).
It removes `NULL`s and sorts named components (#72).
* The objects involved in `compare()` (as opposed to the caller of `compare()`)
gained much greater ability to control the comparison.
* Objects can now contain a `waldo_opts` attribute, a list with the same
names and valid values as the arguments to `compare()`, which overrides
the default comparisons (@dmurdoch).
* `compare_proxy()` is now called earlier (before type comparison) making
it more flexible (#65).
* `compare_proxy()` gains a second argument, `path`, used to report how the
proxy changed the object. This makes it easier to see when and how a proxy
is used (#73).
* Proxies now exist for comparing RProtoBuf objects, converting them to
proto text format (#82, @michaelquinn32).
* Comparing a list with symbol to a list without that element no longer errors
(@mgirlich, #79).
# waldo 0.2.5
* On platforms without UTF-8 support, strings that differ only in their
encoding are now correctly considered to be identical (#66).
# waldo 0.2.4
* Additional arguments to `compare()` generate a more informative warning
(#58).
* Numbers use a better algorithm for picking the number of decimal places to
show (#63).
* ASTs with identical deparsed strings now show exactly how the AST differs.
Source references are now more comprehensively stripped using
`rlang::zap_srcrefs()`
* S3 objects now show the base type, and no longer fails when the types are
incompatible.
# waldo 0.2.3
* `compare()` gains a new `max_diffs` argument that allows you to control
the maximum number of differences shown. Set `max_diffs = Inf` to
see all differences (#49)
* Logical vectors fall back to element-by-element comparison in more cases
(#51).
* Long-form diff no longer confuses additions and deletions (#52, @krlmlr).
# waldo 0.2.2
* Handle S4 objects that have attributes that are not slots.
* Additions are now coloured blue and deletions yellow (instead of the
opposite).
# waldo 0.2.1
* `compare()` now labels output as `old` and `new`, since that's the most
natural way to use it.
* `compare()` can selectively ignore attributes by providing vector to
`ignore_attr` (#45).
* `print()` method gets `n` argument to allow explicitly specifying number of
differences to show (@mnazarov).
* Improvements to comparison display:
* Zero length vectors compare robustly (#39)
* Line-by-line comparisons show modifications as deletion then addition,
rather than addition then deletion (#44).
* Differences between numeric vectors are more robust, particularly in the
presence of missing values (#43). The number of digits selected has also
been slightly improved so that you're more likely to get exactly the
number of digits needed.
# waldo 0.2.0
* All objects: class (#26) and names (#31) are ignored when ignoring attributes.
* Numeric and logical vectors: clearer display of differences. Numbers
are right-aligned, and we show the numbers not the differences.
* Character vectors: a trailing newline is no longer ignored (#37).
* Lists: all elements of the unnamed lists are compared, not just the last! (#32)
* Lists: unclassed prior to comparison (#21).
* Data frames: The internal representation of row names is no longer used;
instead we use the same result of `rownames()` (#23).
* Environments: New `ignore_formula_env` and `ignore_function_env` arguments to
ignore formula and function environments for compatibility with `all.equal()`
(#24).
* Expression objects: can now be compared (#29).
* Calls: srcrefs and attributes are ignored.
---
* `compare_proxy()` is now exported so that you can provide methods if your
objects need special handling (particularly needed for objects that contain
external pointers) (#22).
* Fixed a partial argument name in `as.list()`.
# waldo 0.1.0
* Added a `NEWS.md` file to track changes to the package.
waldo/MD5 0000644 0001762 0000144 00000005632 14120163722 011674 0 ustar ligges users 7ad6bafd822769b2a1e5b813a46f3abb *DESCRIPTION
5174dfc514f0941d2edd4b0b4c9941dd *LICENSE
3ca47adae3c2c9c889e0d996b1aa1d98 *NAMESPACE
ac39695fdd242a3cb136065994d7e642 *NEWS.md
e2921f1b1c70550d2ac90f88bd084718 *R/compare-class.R
82824f392f9888f33ac57c9052f6f159 *R/compare-data-frame.R
019d8d01dbbeb48dfb908b44c347bb66 *R/compare-opts.R
5bfa96bb3a1889aa13de4a22d9e23542 *R/compare-value.R
759c480ea84ec208db9057d4a52b616c *R/compare.R
5188c0abbdbd169bc8d33ac64e85c368 *R/diff.R
3216206301c3fb693970748bd6183d82 *R/num_equal.R
ed56504522589dc57e693dffdf628b59 *R/proxy.R
c1f65930b1f581f616aaa297e8aad927 *R/ses.R
18b1e7a62bbece267389dc580cbbc710 *R/utils.R
c4b3e4830bd1915c2332c1f325f10a95 *R/waldo-package.R
89b2318a52e0fa50a848c7c5de898b0a *README.md
56a847b7a33a5dfda458dba65509c30e *man/compare.Rd
bb72263886e7dcd7bf001db5a09356f7 *man/compare_proxy.Rd
a9df26854eaa171c3fae58b4f66aad54 *man/figures/README/unnamed-chunk-10.svg
ffd1ad2ec1c69826757a6acf1c07d887 *man/figures/README/unnamed-chunk-11.svg
99530802de16f65edaa2daf187290e47 *man/figures/README/unnamed-chunk-12.svg
1ec02329f8d5527ecf707d952f2551a3 *man/figures/README/unnamed-chunk-2.svg
9c54e410015b1a87b138de47c78b06c3 *man/figures/README/unnamed-chunk-3.svg
5e4d8b8e1a5efe485cadd64fb42f8527 *man/figures/README/unnamed-chunk-4.svg
129e3ae141daf6ca888fe2b572d635aa *man/figures/README/unnamed-chunk-5.svg
eecaa9c38208c701fdd43b9226ca5245 *man/figures/README/unnamed-chunk-6.svg
43dea80267c700829a0dd9240d014a9a *man/figures/README/unnamed-chunk-7.svg
08d564ab035191c51462839697c724db *man/figures/README/unnamed-chunk-8.svg
b3ee06745833673792f52423ecbc3cc2 *man/figures/README/unnamed-chunk-9.svg
14e51dc1e2f2618d768a9e6a92205351 *man/waldo-package.Rd
8586af7172136e962563a5a7e6c53155 *tests/testthat.R
b931b43036bf2c66a19f9d8578e0e430 *tests/testthat/_snaps/compare-class.md
d84d47751666a5570ee502aa0a1f70cb *tests/testthat/_snaps/compare-data-frame.md
c2d78b60e3236abb82172c0337ebe32b *tests/testthat/_snaps/compare-opts.md
f35d8c9e9f1f860699c491045507b9d0 *tests/testthat/_snaps/compare-value.md
3c279d0ced6a2ac5ed7a7308bb6c899f *tests/testthat/_snaps/compare.md
2df20b96552271e99d4fb5a923ba7ae7 *tests/testthat/_snaps/diff.md
08ca0f8059a19a48cd62f59cb05748aa *tests/testthat/_snaps/proxy.md
7dfc8dcb328b76cae6f9c7f5ca9c0441 *tests/testthat/f2.R
0141511eeeaec51b3959145b37a5efc8 *tests/testthat/test-compare-class.R
57b7c57b7f012b18247477eece28d684 *tests/testthat/test-compare-data-frame.R
f11ea680ea30726171d2f730343fb8db *tests/testthat/test-compare-opts.R
06f51dafcde28ca7d1c7aa40d04efa7f *tests/testthat/test-compare-value.R
a106cdad80a704032b396839b7abc13d *tests/testthat/test-compare.R
5c5c5fc75460eb70a27758f9637af005 *tests/testthat/test-diff.R
56d0b508b369f8b31e6edbf1573c5f93 *tests/testthat/test-num_equal.R
5fffd57c02b28a0e60460f0d305b55a5 *tests/testthat/test-proxy.R
9de0e996a6bffee4ec41a45310e5c5fc *tests/testthat/test-ses.R
b75d927ae3fe65d01561b87954aec896 *tests/testthat/test-utils.R
- Deletion
``` asciicast
compare(c("a", "b"), c("a", "b", "c"))
```
- Change
``` asciicast
compare(c("a", "b", "c"), c("a", "B", "c"))
```
- Long vectors with short differences only show local context around
changes, not everything that’s the same.
``` asciicast
compare(c("X", letters), c(letters, "X"))
```
Depending on the relative size of the differences and the width of your
console you’ll get one of three displays:
- The default display is to show the vectors one atop the other:
``` asciicast
compare(letters[1:5], letters[1:6])
```
- If there’s not enough room for that, the two vectors are shown
side-by-side:
``` asciicast
options(width = 20)
compare(letters[1:5], letters[1:6])
```
- And if there’s still not enough room for side-by-side, the each
element is given its own line:
``` asciicast
options(width = 10)
compare(letters[1:5], letters[1:6])
```
When comparing more complex objects, waldo creates an executable code
path telling you where the differences lie:
- Unnamed lists are compared by position:
``` asciicast
compare(list(factor("x")), list(1L))
```
- Named lists, including data frames, are compared by name. For
example, note that the following comparison reports a difference in
the class and names, but not the values of the columns.
``` asciicast
df1 <- data.frame(x = 1:3, y = 3:1)
df2 <- tibble::tibble(rev(df1))
compare(df1, df2)
```
- Recursion can be arbitrarily deep:
``` asciicast
x <- list(a = list(b = list(c = list(structure(1, e = 1)))))
y <- list(a = list(b = list(c = list(structure(1, e = "a")))))
compare(x, y)
```
waldo/man/ 0000755 0001762 0000144 00000000000 14120161300 012117 5 ustar ligges users waldo/man/waldo-package.Rd 0000644 0001762 0000144 00000001446 14073210415 015123 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/waldo-package.R
\docType{package}
\name{waldo-package}
\alias{waldo}
\alias{waldo-package}
\title{waldo: Find Differences Between R Objects}
\description{
Compare complex R objects and reveal the key
differences. Designed particularly for use in testing packages where
being able to quickly isolate key differences makes understanding test
failures much easier.
}
\seealso{
Useful links:
\itemize{
\item \url{https://waldo.r-lib.org}
\item \url{https://github.com/r-lib/waldo}
\item Report bugs at \url{https://github.com/r-lib/waldo/issues}
}
}
\author{
\strong{Maintainer}: Hadley Wickham \email{hadley@rstudio.com}
Other contributors:
\itemize{
\item RStudio [copyright holder]
}
}
\keyword{internal}
waldo/man/compare_proxy.Rd 0000644 0001762 0000144 00000002477 14075620577 015340 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/proxy.R
\name{compare_proxy}
\alias{compare_proxy}
\title{Proxy for waldo comparison}
\usage{
compare_proxy(x, path = "x")
}
\arguments{
\item{x}{An object.}
\item{path}{Path}
}
\value{
A list with two components:
\itemize{
\item \code{object}: the modified object
\item \code{path}: an updated path showing what modification was applied
}
}
\description{
Use this generic to override waldo's default comparison if you need to
override the defaults (typically because your object stores data in an
external pointer).
waldo comes with methods for a few common cases:
\itemize{
\item data.table: the \code{.internal.selfref} attribute is set to \code{NULL}. This is
an external pointer that is used for performance optimisation, and
doesn't affect the data.
\item \code{xml2::xml_node}: the underlying XML data is stored in memory in C,
behind an external pointer, so the we best can do is to convert the
object to a string.
\item Classes from the \code{RProtoBuf} package: like XML objects, these store
data in memory in C++ and only expose string names to R. Fortunately,
these have well-understood string representations that we can use for
comparisons. See
\url{https://developers.google.com/protocol-buffers/docs/reference/cpp/google.protobuf.text_format}
}
}
waldo/man/figures/ 0000755 0001762 0000144 00000000000 14120161300 013563 5 ustar ligges users waldo/man/figures/README/ 0000755 0001762 0000144 00000000000 14107730175 014541 5 ustar ligges users waldo/man/figures/README/unnamed-chunk-12.svg 0000644 0001762 0000144 00000003612 14107730523 020236 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-2.svg 0000644 0001762 0000144 00000002761 14107730520 020156 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-11.svg 0000644 0001762 0000144 00000003432 14107730523 020235 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-5.svg 0000644 0001762 0000144 00000004226 14107730521 020160 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-9.svg 0000644 0001762 0000144 00000001553 14107730522 020165 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-10.svg 0000644 0001762 0000144 00000003703 14107730522 020234 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-4.svg 0000644 0001762 0000144 00000003103 14107730521 020150 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-6.svg 0000644 0001762 0000144 00000003113 14107730521 020153 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-7.svg 0000644 0001762 0000144 00000004164 14107730522 020164 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-3.svg 0000644 0001762 0000144 00000002777 14107730520 020166 0 ustar ligges users waldo/man/figures/README/unnamed-chunk-8.svg 0000644 0001762 0000144 00000002746 14107730522 020171 0 ustar ligges users waldo/man/compare.Rd 0000644 0001762 0000144 00000014577 14075620577 014103 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/compare.R
\name{compare}
\alias{compare}
\title{Compare two objects}
\usage{
compare(
x,
y,
...,
x_arg = "old",
y_arg = "new",
tolerance = NULL,
max_diffs = if (in_ci()) Inf else 10,
ignore_srcref = TRUE,
ignore_attr = "waldo_opts",
ignore_encoding = TRUE,
ignore_function_env = FALSE,
ignore_formula_env = FALSE,
list_as_map = FALSE
)
}
\arguments{
\item{x, y}{Objects to compare. \code{y} is treated as the reference object
so messages describe how \code{x} is different to \code{y}}
\item{...}{A handful of other arguments are supported with a warning for
backward compatability. These include:
\itemize{
\item \code{all.equal()} arguments \code{checkNames} and \code{check.attributes}
\item \code{testthat::compare()} argument \code{tol}
}
All other arguments are ignored with a warning.}
\item{x_arg, y_arg}{Name of \code{x} and \code{y} arguments, used when generated paths
to internal components. These default to "old" and "new" since it's
most natural to supply the previous value then the new value.}
\item{tolerance}{If non-\code{NULL}, used as threshold for ignoring small
floating point difference when comparing numeric vectors. Setting to
any non-\code{NULL} value will cause integer and double vectors to be compared
based on their values, rather than their types.
It uses the same algorithm as \code{\link[=all.equal]{all.equal()}}, i.e., first we generate
\code{x_diff} and \code{y_diff} by subsetting \code{x} and \code{y} to look only locations
with differences. Then we check that
\code{mean(abs(x_diff - y_diff)) / mean(abs(y_diff))} (or just
\code{mean(abs(x_diff - y_diff))} if \code{y_diff} is small) is less than
\code{tolerance}.}
\item{max_diffs}{Control the maximum number of differences shown. The
default shows 10 differences when run interactively and all differences
when run in CI. Set \code{max_diffs = Inf} to see all differences.}
\item{ignore_srcref}{Ignore differences in function \code{srcref}s? \code{TRUE} by
default since the \code{srcref} does not change the behaviour of a function,
only its printed representation.}
\item{ignore_attr}{Ignore differences in specified attributes?
Supply a character vector to ignore differences in named attributes.
By default the \code{"waldo_opts"} attribute is listed in \code{ignore_attr} so
that changes to it are not reported; if you customize \code{ignore_attr}, you
will probably want to do this yourself.
For backward compatibility with \code{all.equal()}, you can also use \code{TRUE},
to all ignore differences in all attributes. This is not generally
recommended as it is a blunt tool that will ignore many important
functional differences.}
\item{ignore_encoding}{Ignore string encoding? \code{TRUE} by default, because
this is R's default behaviour. Use \code{FALSE} when specifically concerned
with the encoding, not just the value of the string.}
\item{ignore_function_env, ignore_formula_env}{Ignore the environments of
functions and formulas, respectively? These are provided primarily for
backward compatibility with \code{all.equal()} which always ignores these
environments.}
\item{list_as_map}{Compare lists as if they are mappings between names and
values. Concretely, this drops \code{NULLs} in both objects and sorts named
components.}
}
\value{
A character vector with class "waldo_compare". If there are no
differences it will have length 0; otherwise each element contains the
description of a single difference.
}
\description{
This compares two R objects, identifying the key differences. It:
\itemize{
\item Orders the differences from most important to least important.
\item Displays the values of atomic vectors that are actually different.
\item Carefully uses colour to emphasise changes (while still being readable
when colour isn't available).
\item Uses R code (not a text description) to show where differences arise.
\item Where possible, it compares elements by name, rather than by position.
\item Errs on the side of producing too much output, rather than too little.
}
\code{compare()} is an alternative to \code{\link[=all.equal]{all.equal()}}.
}
\section{Controlling comparisons}{
There are two ways for an object (rather than the person calling \code{compare()}
or \code{expect_equal()} to control how it is compared to other objects.
First, if the object has an S3 class, you can provide a \code{\link[=compare_proxy]{compare_proxy()}}
method that provides an alternative representation of the object; this is
particularly useful if important data is stored outside of R, e.g. in
an external pointer.
Alternatively, you can attach an attribute called \code{"waldo_opts"} to your
object. This should be a list of compare options, using the same names
and possible values as the arguments to this function. This option
is ignored by default (\code{ignore_attr}) so that you can set the options in
the object that you control. (If you don't want to see the attributes
interactively, you could attach them in a \code{\link[=compare_proxy]{compare_proxy()}} method.)
Options supplied in this way also affect all the children. This means
options are applied in the following order, from lowest to highest
precedence:
\enumerate{
\item Defaults from \code{compare()}.
\item The \code{waldo_opts} for the parents of \code{x}.
\item The \code{waldo_opts} for the parents of \code{y}.
\item The \code{waldo_opts} for \code{x}.
\item The \code{waldo_opts} for \code{y}.
\item User-specified arguments to \code{compare()}.
}
Use these techniques with care. If you accidentally cover up an important
difference you can create a confusing situation where \code{x} and \code{y} behave
differently but \code{compare()} reports no differences in the underlying objects.
}
\examples{
# Thanks to diffobj package comparison of atomic vectors shows differences
# with a little context
compare(letters, c("z", letters[-26]))
compare(c(1, 2, 3), c(1, 3))
compare(c(1, 2, 3), c(1, 3, 4, 5))
compare(c(1, 2, 3), c(1, 2, 5))
# More complex objects are traversed, stopping only when the types are
# different
compare(
list(x = list(y = list(structure(1, z = 2)))),
list(x = list(y = list(structure(1, z = "a"))))
)
# Where possible, recursive structures are compared by name
compare(iris, rev(iris))
compare(list(x = "x", y = "y"), list(y = "y", x = "x"))
# Otherwise they're compared by position
compare(list("x", "y"), list("x", "z"))
compare(list(x = "x", x = "y"), list(x = "x", y = "z"))
}
waldo/DESCRIPTION 0000644 0001762 0000144 00000002111 14120163722 013057 0 ustar ligges users Package: waldo
Title: Find Differences Between R Objects
Version: 0.3.1
Authors@R:
c(person(given = "Hadley",
family = "Wickham",
role = c("aut", "cre"),
email = "hadley@rstudio.com"),
person(given = "RStudio",
role = "cph"))
Description: Compare complex R objects and reveal the key
differences. Designed particularly for use in testing packages where
being able to quickly isolate key differences makes understanding test
failures much easier.
License: MIT + file LICENSE
URL: https://waldo.r-lib.org, https://github.com/r-lib/waldo
BugReports: https://github.com/r-lib/waldo/issues
Imports: cli, diffobj (>= 0.3.4), fansi, glue, methods, rematch2, rlang
(>= 0.4.10), tibble
Suggests: testthat (>= 3.0.0), covr, R6, withr, xml2
Encoding: UTF-8
RoxygenNote: 7.1.2
Config/testthat/edition: 3
NeedsCompilation: no
Packaged: 2021-09-14 17:58:24 UTC; hadley
Author: Hadley Wickham [aut, cre],
RStudio [cph]
Maintainer: Hadley Wickham