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

```test_that('fsets without colnames', {
set.seed(35423)
m <- matrix(runif(12), ncol=3)
v <- letters[1:3]
s <- matrix(0, nrow=3, ncol=3)
diag(s) <- 1

f <- fsets(m, vars=v, specs=s)
expect_true(is.fsets(f))
expect_that(class(f), equals(c('fsets', 'matrix')))
expect_that(vars(f), equals(letters[1:3]))
expect_that(specs(f), equals(s))

mat <- as.matrix(f)
expect_true(is.matrix(mat))
expect_that(mat, equals(m))
expect_error(vars(mat))
expect_error(specs(mat))

df <- as.data.frame(f)
expect_true(is.data.frame(df))
expect_that(ncol(df), equals(3))
expect_that(nrow(df), equals(4))
expect_that(df[, 1], equals(m[, 1]))
expect_that(df[, 2], equals(m[, 2]))
expect_that(df[, 3], equals(m[, 3]))
expect_error(vars(df))
expect_error(specs(df))

#---------
v2 <- v
names(v2) <- LETTERS[1:3]
s2 <- s
colnames(s2) <- LETTERS[1:3]
rownames(s2) <- LETTERS[1:3]

f2 <- f
vars(f2) <- v
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- f
specs(f2) <- s
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- f
vars(f2) <- v2
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- f
specs(f2) <- s2
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- fsets(m, vars=v2, specs=s)
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- fsets(m, vars=v, specs=s2)
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))
})

test_that('fsets with colnames', {
set.seed(35423)
m <- matrix(runif(12), ncol=3)
colnames(m) <- LETTERS[1:3]
v <- letters[1:3]
s <- matrix(0, nrow=3, ncol=3)
diag(s) <- 1

f <- fsets(m, vars=v, specs=s)
expect_true(is.fsets(f))
expect_that(colnames(f), equals(LETTERS[1:3]))
expect_that(class(f), equals(c('fsets', 'matrix')))
expect_that(vars(f), equals(letters[1:3]))
expect_that(specs(f), equals(s))

mat <- as.matrix(f)
expect_true(is.matrix(mat))
expect_that(mat, equals(m))
expect_that(colnames(mat), equals(LETTERS[1:3]))
expect_error(vars(mat))
expect_error(specs(mat))

df <- as.data.frame(f)
expect_true(is.data.frame(df))
expect_that(ncol(df), equals(3))
expect_that(nrow(df), equals(4))
expect_that(colnames(df), equals(LETTERS[1:3]))
expect_that(df[, 1], equals(m[, 1]))
expect_that(df[, 2], equals(m[, 2]))
expect_that(df[, 3], equals(m[, 3]))
expect_error(vars(df))
expect_error(specs(df))

#---------
v2 <- v
names(v2) <- LETTERS[1:3]
s2 <- s
colnames(s2) <- LETTERS[1:3]
rownames(s2) <- LETTERS[1:3]

f2 <- f
vars(f2) <- v
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_that(colnames(f2), equals(LETTERS[1:3]))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- f
specs(f2) <- s
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_that(colnames(f2), equals(LETTERS[1:3]))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- f
vars(f2) <- v2
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_that(colnames(f2), equals(LETTERS[1:3]))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- f
specs(f2) <- s2
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_that(colnames(f2), equals(LETTERS[1:3]))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- fsets(m, vars=v2, specs=s)
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_that(colnames(f2), equals(LETTERS[1:3]))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))

f2 <- fsets(m, vars=v, specs=s2)
expect_true(is.fsets(f2))
expect_that(class(f2), equals(c('fsets', 'matrix')))
expect_that(vars(f2), equals(letters[1:3]))
expect_that(specs(f2), equals(s))
expect_that(colnames(f2), equals(LETTERS[1:3]))
expect_null(names(vars(f2)))
expect_null(colnames(specs(f2)))
expect_null(rownames(specs(f2)))
})

test_that('non fsets', {
expect_false(is.fsets(matrix(3, ncol=3, nrow=3)))
})

test_that('fsets [ ]', {
orig <- matrix(runif(100), ncol=10)
colnames(orig) <- letters[1:10]
x <- fsets(orig,
vars=as.character(1:10),
specs=matrix(0, nrow=10, ncol=10))

res <- x[1:5, ]
expect_equal(as.matrix(res), orig[1:5, ])
expect_equal(vars(res), vars(x))
expect_equal(specs(res), specs(x))

res <- x[-3, ]
expect_equal(as.matrix(res), orig[-3, ])
expect_equal(vars(res), vars(x))
expect_equal(specs(res), specs(x))

res <- x[3, ]
expect_equal(as.matrix(res), orig[3, , drop=FALSE])
expect_equal(vars(res), vars(x))
expect_equal(specs(res), specs(x))

res <- x[, 2:4]
expect_equal(as.matrix(res), orig[, 2:4])
expect_equal(vars(res), vars(x)[2:4])
expect_equal(specs(res), specs(x)[2:4, 2:4])

res <- x[1:5, 2:4]
expect_equal(as.matrix(res), orig[1:5, 2:4])
expect_equal(vars(res), vars(x)[2:4])
expect_equal(specs(res), specs(x)[2:4, 2:4])

res <- x[5, 4]
expect_equal(as.matrix(res), orig[5, 4, drop=FALSE])
expect_equal(vars(res), vars(x)[4])
expect_equal(specs(res), specs(x)[4, 4, drop=FALSE])

res <- x[, letters[2:4]]
expect_equal(as.matrix(res), orig[, 2:4])
expect_equal(vars(res), vars(x)[2:4])
expect_equal(specs(res), specs(x)[2:4, 2:4])

res <- x[1:5, letters[2:4]]
expect_equal(as.matrix(res), orig[1:5, 2:4])
expect_equal(vars(res), vars(x)[2:4])
expect_equal(specs(res), specs(x)[2:4, 2:4])

res <- x[5, letters[4]]
expect_equal(as.matrix(res), orig[5, 4, drop=FALSE])
expect_equal(vars(res), vars(x)[4])
expect_equal(specs(res), specs(x)[4, 4, drop=FALSE])
})

test_that('rbind of two fsets', {
set.seed(3335)

m1 <- matrix(runif(12), ncol=3)
m2 <- matrix(runif(24), ncol=3)
s <- matrix(0, nrow=3, ncol=3)
diag(s) <- 1
f1 <- fsets(m1, vars=letters[1:3], specs=s)
f2 <- fsets(m2, vars=letters[1:3], specs=s)

r <- rbind(f1, f2)
expect_equal(as.matrix(r), rbind(m1, m2))
expect_equal(vars(r), letters[1:3])
expect_equal(specs(r), s)
})
```

## 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.