Nothing
context("Detect violated edits")
test_that("Numerical edit violations are detected",{
expect_equivalent(
violatedEdits(
editmatrix(c( "x+3*y==2*z", "x==z")),
data.frame(
x = c(0,2,1),
y = c(0,0,1),
z = c(0,1,1))
)[,,drop=FALSE],
matrix(c(FALSE,FALSE,TRUE,FALSE,TRUE,FALSE),nrow=3)
)
# with a tolerance
expect_equivalent(
violatedEdits(
editmatrix(c( "x+3*y==2*z", "x==z")),
data.frame(
x = c(0,2,1),
y = c(0,0,1),
z = c(0,1,1)),
tol=100
)[,,drop=FALSE],
matrix(c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE),nrow=3)
)
})
test_that("An empty editmatrix is always valid",{
expect_equivalent(
violatedEdits(
editmatrix("x==1")[0],
data.frame(
x = c(0,2,1),
y = c(0,0,1),
z = c(0,1,1))
)[,,drop=FALSE],
matrix(nrow=3, ncol=0)
)
expect_equivalent(
violatedEdits(
editmatrix("x==1")[0],
c(x = 0,y = 0,z = 0)
)[,,drop=FALSE],
matrix(nrow=1, ncol=0)
)
})
test_that("violation of inequalities are detected",{
expect_true(violatedEdits(editmatrix("x<0"),c(x=1))[1])
expect_true(violatedEdits(editmatrix("x<0"),c(x=0))[1])
expect_true(violatedEdits(editmatrix("x<0"),c(x=0,tol=1e-8))[1])
expect_false(violatedEdits(editmatrix("x<0"),c(x=-1))[1])
expect_true(all(
violatedEdits(
editmatrix("x < y"),
data.frame(x=c(1,2),y=c(-1,3)))==c(TRUE,FALSE))
)
})
test_that("summary.violatedEdits works when no edits are violated",{
expect_equal(summary(violatedEdits(
editmatrix("x+y==z"),
c(x=1,y=2,z=3)
)),NULL)
})
test_that("summary.violatedEdits works with NA's",{
expect_equal(summary(violatedEdits(
editmatrix("x+y==z"),
c(x=1,y=2,z=NA)
)),NULL)
})
test_that("NA's in data are handled correctly by violatededits.editmatrix",{
expect_identical(
violatedEdits(editmatrix(c('x==0','y==0')),c(x=NA,y=1))[,],
c(num1=NA,num2=TRUE)
)
expect_identical(
violatedEdits(editmatrix(c('x>0','y==0')),c(x=NA,y=1))[,],
c(num1=NA,num2=TRUE)
)
expect_identical(
violatedEdits(editmatrix(c('x>0','y==0','x+y>=1')),c(x=NA,y=1))[,],
c(num1=NA,num2=TRUE,num3=NA)
)
expect_identical(
violatedEdits(editmatrix(c('x==0','y==0')),data.frame(x=c(NA,1),y=c(1,NA)))[,],
array(c(NA,TRUE,TRUE,NA),dim=c(2,2),dimnames=list(record=1:2,edit=c('num1','num2')))
)
expect_identical(
violatedEdits(editmatrix(c('x==0','y==0')),c(x=NA,y=1),tol=0.1)[,],
c(num1=NA,num2=TRUE)
)
expect_identical(
violatedEdits(editmatrix(c('x>0','y==0')),c(x=NA,y=1),tol=0.1)[,],
c(num1=NA,num2=TRUE)
)
expect_identical(
violatedEdits(editmatrix(c('x>0','y==0','x+y>=1')),c(x=NA,y=1),tol=0.1)[,],
c(num1=NA,num2=TRUE,num3=NA)
)
expect_identical(
violatedEdits(editmatrix(c('x==0','y==0')),data.frame(x=c(NA,1),y=c(1,NA)),tol=0.1)[,],
array(c(NA,TRUE,TRUE,NA),dim=c(2,2),dimnames=list(record=1:2,edit=c('num1','num2')))
)
})
test_that("categorical edit violations are detected",{
E <- editarray(c(
"gender %in% c('male','female')",
"pregnant %in% c(TRUE, FALSE)",
"if( gender == 'male' ) !pregnant"))
dat <- data.frame(
gender=c('male','male','female','cylon'),
pregnant=c(TRUE,FALSE,TRUE,TRUE)
)
expect_equivalent(
violatedEdits(E,dat)[,,drop=FALSE],
matrix(c(
FALSE, FALSE, TRUE,
FALSE, FALSE, FALSE,
FALSE, FALSE, FALSE,
TRUE, FALSE, FALSE),byrow=TRUE,nrow=4)
)
expect_equivalent(
violatedEdits(E,dat,datamodel=FALSE)[,,drop=FALSE],
matrix(c(
TRUE,
FALSE,
FALSE,
FALSE),byrow=TRUE,nrow=4)
)
})
test_that("Empty editarray is handled correctly",{
expect_equivalent(
violatedEdits(editarray(expression()),data.frame(x="a",y="b"))[,,drop=FALSE],
array(logical(0),dim=c(1,0))
)
expect_equivalent(
violatedEdits(editarray(expression()),data.frame(x=c("a","a"),y=c("b","b")))[,,drop=FALSE],
array(logical(0),dim=c(2,0))
)
})
#for ( d in dir("../../../pkg/R",full.names=TRUE) ) dmp <- source(d)
test_that("Pure numerical editset",{
expect_true(
violatedEdits(
E = editset("x + y == z"),
dat = data.frame(x=1,y=1,z=1)
)[1,1]
)
})
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.