# tests/testthat/test-fcut.R In lfl: Linguistic Fuzzy Logic

```test_that('fcut for factor', {
x <- factor(c('a', 'b', 'a', 'c', 'c', 'b', 'c'))
res <- fcut(x)

expect_true(is.matrix(res))
expect_equal(ncol(res), 3)
expect_equal(nrow(res), 7)
expect_equal(colnames(res), c('x=a', 'x=b', 'x=c'))
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), rep('x', 3))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(rep(0, 3*3),
nrow=3,
ncol=3))
expect_true(is.fsets(res))

expect_equivalent(as.matrix(res)[1, 1], 1)
expect_equivalent(as.matrix(res)[1, 2], 0)
expect_equivalent(as.matrix(res)[1, 3], 0)

expect_equivalent(as.matrix(res)[2, 1], 0)
expect_equivalent(as.matrix(res)[2, 2], 1)
expect_equivalent(as.matrix(res)[2, 3], 0)

expect_equivalent(as.matrix(res)[3, 1], 1)
expect_equivalent(as.matrix(res)[3, 2], 0)
expect_equivalent(as.matrix(res)[3, 3], 0)

expect_equivalent(as.matrix(res)[4, 1], 0)
expect_equivalent(as.matrix(res)[4, 2], 0)
expect_equivalent(as.matrix(res)[4, 3], 1)

expect_equivalent(as.matrix(res)[5, 1], 0)
expect_equivalent(as.matrix(res)[5, 2], 0)
expect_equivalent(as.matrix(res)[5, 3], 1)

expect_equivalent(as.matrix(res)[6, 1], 0)
expect_equivalent(as.matrix(res)[6, 2], 1)
expect_equivalent(as.matrix(res)[6, 3], 0)

expect_equivalent(as.matrix(res)[7, 1], 0)
expect_equivalent(as.matrix(res)[7, 2], 0)
expect_equivalent(as.matrix(res)[7, 3], 1)
})

test_that('fcut for logical', {
x <- c(TRUE, FALSE, FALSE, TRUE)
res <- fcut(x)

expect_true(is.matrix(res))
expect_equal(ncol(res), 2)
expect_equal(nrow(res), 4)
expect_equal(colnames(res), c('x', 'not.x'))
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), rep('x', 2))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(0, nrow=2, ncol=2))
expect_true(is.fsets(res))

expect_equivalent(as.matrix(res)[1, 1], 1)
expect_equivalent(as.matrix(res)[1, 2], 0)

expect_equivalent(as.matrix(res)[2, 1], 0)
expect_equivalent(as.matrix(res)[2, 2], 1)

expect_equivalent(as.matrix(res)[3, 1], 0)
expect_equivalent(as.matrix(res)[3, 2], 1)

expect_equivalent(as.matrix(res)[4, 1], 1)
expect_equivalent(as.matrix(res)[4, 2], 0)
})

test_that('fcut of numeric by single triangle', {
x <- 0:100
res <- fcut(x,
breaks=c(0, 50, 100),
type='triangle')

expect_true(is.matrix(res))
expect_equal(ncol(res), 1)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), 'x=1')
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), 'x')
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(0,
nrow=1,
ncol=1))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[26, 1], 0.5)
expect_equivalent(as.matrix(res)[51, 1], 1)
expect_equivalent(as.matrix(res)[76, 1], 0.5)
expect_equivalent(as.matrix(res)[101, 1], 0)
expect_true(is.fsets(res))
})

test_that('fcut of numeric by multiple triangles', {
x <- 0:100
res <- fcut(x,
breaks=c(0, 25, 50, 75, 100),
type='triangle')

expect_true(is.matrix(res))
expect_equal(ncol(res), 3)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), c('x=1', 'x=2', 'x=3'))
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), rep('x', 3))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(rep(0, 3*3),
nrow=3,
ncol=3))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[26, 1], 1)
expect_equivalent(as.matrix(res)[51, 1], 0)
expect_equivalent(as.matrix(res)[76, 1], 0)
expect_equivalent(as.matrix(res)[101, 1], 0)

expect_equivalent(as.matrix(res)[1, 2], 0)
expect_equivalent(as.matrix(res)[26, 2], 0)
expect_equivalent(as.matrix(res)[51, 2], 1)
expect_equivalent(as.matrix(res)[76, 2], 0)
expect_equivalent(as.matrix(res)[101, 2], 0)

expect_equivalent(as.matrix(res)[1, 3], 0)
expect_equivalent(as.matrix(res)[26, 3], 0)
expect_equivalent(as.matrix(res)[51, 3], 0)
expect_equivalent(as.matrix(res)[76, 3], 1)
expect_equivalent(as.matrix(res)[101, 3], 0)
expect_true(is.fsets(res))
})

test_that('fcut of numeric with merge 1:3', {
x <- 0:100
res <- fcut(x,
breaks=c(0, 25, 50, 75, 100),
type='triangle',
merge=1:3)

expect_true(is.matrix(res))
expect_equal(ncol(res), 6)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), c('x=1', 'x=2', 'x=3',
'x=1|x=2', 'x=2|x=3',
'x=1|x=2|x=3'))
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), rep('x', 6))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(c(0,0,0,1,0,1,
0,0,0,1,1,1,
0,0,0,0,1,1,
0,0,0,0,0,1,
0,0,0,0,0,1,
0,0,0,0,0,0),
byrow=TRUE,
nrow=6))
expect_true(is.fsets(res))
})

test_that('fcut of numeric with merge 2', {
x <- 0:100
res <- fcut(x,
breaks=c(0, 25, 50, 75, 100),
type='triangle',
merge=2)

expect_true(is.matrix(res))
expect_equal(ncol(res), 2)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), c('x=1|x=2', 'x=2|x=3'))
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), rep('x', 2))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(rep(0, 2*2),
nrow=2,
ncol=2))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[26, 1], 1)
expect_equivalent(as.matrix(res)[30, 1], 1)
expect_equivalent(as.matrix(res)[51, 1], 1)
expect_equivalent(as.matrix(res)[76, 1], 0)
expect_equivalent(as.matrix(res)[101, 1], 0)

expect_equivalent(as.matrix(res)[1, 2], 0)
expect_equivalent(as.matrix(res)[26, 2], 0)
expect_equivalent(as.matrix(res)[51, 2], 1)
expect_equivalent(as.matrix(res)[60, 2], 1)
expect_equivalent(as.matrix(res)[76, 2], 1)
expect_equivalent(as.matrix(res)[101, 2], 0)
expect_true(is.fsets(res))
})

test_that('fcut of numeric with merge 1,3', {
x <- 0:100
res <- fcut(x,
breaks=c(0, 25, 50, 75, 100),
type='triangle',
merge=c(1,3))

expect_true(is.matrix(res))
expect_equal(ncol(res), 4)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), c('x=1', 'x=2', 'x=3',
'x=1|x=2|x=3'))
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), rep('x', 4))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(c(0,0,0,1,
0,0,0,1,
0,0,0,1,
0,0,0,0),
byrow=TRUE,
nrow=4))
expect_true(is.fsets(res))
})

test_that('fcut of matrix', {
x <- matrix(1:100, byrow=TRUE, ncol=4)
colnames(x) <- letters[1:4]

res <- fcut(x,
breaks=c(1, 30, 60, 100),
type='triangle')

expect_true(is.fsets(res))
expect_equal(ncol(res), 8)
expect_equal(nrow(res), 25)
expect_equal(colnames(res), c('a=1', 'a=2', 'b=1', 'b=2', 'c=1', 'c=2', 'd=1', 'd=2'))
expect_equal(vars(res), c(rep('a', 2), rep('b', 2), rep('c', 2), rep('d', 2)))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(0,
nrow=8,
ncol=8))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[8, 3], 1)
expect_equivalent(as.matrix(res)[15, 7], 0)
})

test_that('fcut of data frame', {
x <- matrix(1:100, byrow=TRUE, ncol=4)
colnames(x) <- letters[1:4]

res <- fcut(as.data.frame(x),
breaks=c(1, 30, 60, 100),
type='triangle')

expect_true(is.fsets(res))
expect_equal(ncol(res), 8)
expect_equal(nrow(res), 25)
expect_equal(colnames(res), c('a=1', 'a=2', 'b=1', 'b=2', 'c=1', 'c=2', 'd=1', 'd=2'))
expect_equal(vars(res), c(rep('a', 2), rep('b', 2), rep('c', 2), rep('d', 2)))
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(0,
nrow=8,
ncol=8))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[8, 3], 1)
expect_equivalent(as.matrix(res)[15, 7], 0)
})

test_that('fcut for custom function factory', {
func <- function(a, b, c) {
f <- triangular(a, b, c)
return(function(x) f(x)^2)
}

x <- 0:100
res <- fcut(x,
breaks=c(0, 50, 100),
type=func)

expect_true(is.fsets(res))
expect_equal(ncol(res), 1)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), 'x=1')
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), 'x')
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(0,
nrow=1,
ncol=1))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[26, 1], 0.25)
expect_equivalent(as.matrix(res)[51, 1], 1)
expect_equivalent(as.matrix(res)[76, 1], 0.25)
expect_equivalent(as.matrix(res)[101, 1], 0)
expect_true(is.fsets(res))
})

test_that('fcut for custom function', {
func <- function(x, a, b, c) {
f <- triangular(a, b, c)
return(f(x)^2)
}

x <- 0:100
res <- fcut(x,
breaks=c(0, 50, 100),
type=func)

expect_true(is.fsets(res))
expect_equal(ncol(res), 1)
expect_equal(nrow(res), 101)
expect_equal(colnames(res), 'x=1')
expect_true(inherits(res, 'fsets'))
expect_equivalent(vars(res), 'x')
expect_equal(names(vars(res)), NULL)
expect_equal(specs(res), matrix(0,
nrow=1,
ncol=1))

expect_equivalent(as.matrix(res)[1, 1], 0)
expect_equivalent(as.matrix(res)[26, 1], 0.25)
expect_equivalent(as.matrix(res)[51, 1], 1)
expect_equivalent(as.matrix(res)[76, 1], 0.25)
expect_equivalent(as.matrix(res)[101, 1], 0)
expect_true(is.fsets(res))
})
```

## Try the lfl package in your browser

Any scripts or data that you put into this service are public.

lfl documentation built on Sept. 8, 2022, 5:08 p.m.