Nothing
## Options can be set
# warning on nonexistent option
expect_warning(voptions(fiets=3))
# invalid 'raise' value -- not implemented yet
#expect_error(voptions(raise='aap'))
# this should run without problems
reset(voptions)
expect_equal(voptions('raise')[[1]],'none')
## match_cells",{
d1 <- data.frame(id=paste(1:3),x=1:3,y=4:6)
d2 <- data.frame(id=paste(4:1),y=4:7,x=1:4)
expect_equal(
names(match_cells(d1,d2,id='id')[[1]])
,names(match_cells(d1,d2,id='id')[[2]])
)
expect_equal(
as.character(match_cells(d1,d2,id='id')[[1]][,'id'])
, as.character(match_cells(d1,d2,id='id')[[2]][,'id'])
)
## validating/indicating expressions can be named
expect_equal(names(validator(aap=x>3)),'aap')
expect_equal(names(indicator(fiets=mean(x))),'fiets')
## cells works",{
cls <- cells(women, women)
expect_equivalent(cls[,1], cls[,2])
d <- as.data.frame(cls)
expect_true(inherits(d, "data.frame"))
expect_equal(nrow(d), 9*2)
expect_equal(ncol(d), 3)
# code for these methods in confrontation.R
## other methods for 'variables
expect_equal(variables(women),c("height","weight"))
expect_equal(variables(as.list(women)),c("height","weight"))
expect_equal(variables(as.environment(women)),c("height","weight"))
## compare works
d1 <- data.frame(x=1:3,y=4:6)
d2 <- data.frame(x=c(NA,2,NA),y=c(4,5,NA))
v <- validator(x>0,y<5)
a <- array(
c( 6,6,0,0,0,4,4,0,2,2,0
,6,3,3,0,3,2,2,0,1,1,0 ),dim=c(11,2)
)
expect_equivalent(unclass(compare(v,d1,d2)),a)
d <- as.data.frame(compare(v,d1,d2))
expect_true(inherits(d,"data.frame"))
expect_equal(ncol(d),3)
expect_equal(nrow(d),11*2)
## comparison objects can be plotted
d1 <- data.frame(x=1:3,y=4:6)
d2 <- data.frame(x=c(NA,2,NA),y=c(4,5,NA))
rules <- validator(x>0,y<5)
expect_silent(plot(compare(rules, d1,d2)))
expect_silent(plot(cells(d1,d2)))
expect_equal(length(barplot(cells(d1,d2))),2)
expect_equal(length(barplot(compare(rules, d1,d2))),2)
## blocks works
v <- validator(x + y > z, q > 0, z + x == 3)
expect_equivalent(v$blocks()[[1]],c(1,3))
expect_equivalent(v$blocks()[[2]],2)
v <- validator(
x > 0
, y > 0
, x + y == z
, u + v == w
, u > 0)
expect_equal(length(v$blocks()),2)
v <- validator(x +y ==z, x+z>0)
expect_equal(length(v$blocks()),1)
## %vin% ----
expect_identical(
c("a","b") %vin% integer(0)
, logical(2)
)
expect_identical(
c("a","b") %vin% c("a","c","d")
, c(TRUE, FALSE)
)
expect_identical(
c("a",NA) %vin% c("a","c","d")
, c(TRUE, NA)
)
expect_identical(
c(NA,"b") %vin% c("a","c","d")
, c(NA,FALSE)
)
expect_identical(
c("a","b") %vin% c(NA,"c","d")
, c(NA,NA)
)
expect_identical(
c("a","b") %vin% c("a",NA,"d")
, c(TRUE,NA)
)
## utility record selector functions
expect_equal(
satisfying(women, validator(height>60))
, subset(women, height>60)
)
expect_equal(
satisfying(women, check_that(women, height>60))
, subset(women, height>60)
)
expect_equal(
violating(women, validator(height<=60))
, subset(women, height>60)
)
expect_equal(
violating(women, check_that(women, height<=60))
, subset(women, height>60)
)
local({
women[1,1] <- NA
expect_equal(
lacking(women, validator(height<=60))
, women[1,,drop=FALSE]
)
expect_equal(
lacking(women, check_that(women, height<=60))
, women[1,,drop=FALSE]
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.