tests/testthat/test-cbind.fsets.R

In beerda/lfl: Linguistic Fuzzy Logic

test_that('cbind of two fsets', {
    x <- 0:10 * 10
    y <- 0:10 * 10
    a <- fcut(x, breaks=c(0, 25, 50, 75, 100), merge=1:2)    #x1, x2, x3, x1|2, x2|3
    b <- fcut(y, breaks=c(0, 30, 70, 80, 100), merge=c(1,3)) #y1, y2, y3, y1|2|3

    expect_silent(res <- cbind(a, b))


    expectedNames <- c('x=1', 'x=2', 'x=3',
                       'x=1|x=2', 'x=2|x=3',
                       'y=1', 'y=2', 'y=3',
                       'y=1|y=2|y=3')

    expect_true(is.matrix(res))
    expect_equal(ncol(res), 9)
    expect_equal(nrow(res), 11)
    expect_equal(colnames(res), expectedNames)
    expect_true(inherits(res, 'fsets'))

    expectedVars <- c(rep('x', 5), rep('y', 4))

    expect_equal(vars(res), expectedVars)
    expect_equal(specs(res), matrix(c(0,0,0,1,0, 0,0,0,0,
                                      0,0,0,1,1, 0,0,0,0,
                                      0,0,0,0,1, 0,0,0,0,
                                      0,0,0,0,0, 0,0,0,0,
                                      0,0,0,0,0, 0,0,0,0,

                                      0,0,0,0,0, 0,0,0,1,
                                      0,0,0,0,0, 0,0,0,1,
                                      0,0,0,0,0, 0,0,0,1,
                                      0,0,0,0,0, 0,0,0,0),
                                    byrow=TRUE,
                                    nrow=9))
    expect_equal(res[, 1:5], a[, 1:ncol(a)])  # 'a[, ...]' removes all attributes from 'a'
    expect_equal(res[, 6:9], b[, 1:ncol(b)])  # 'b[, ...]' removes all attributes from 'b'
    expect_true(is.fsets(res))
})



test_that('cbind of two fsets and NULL', {
    x <- 0:10 * 10
    y <- 0:10 * 10
    a <- fcut(x, breaks=c(0, 25, 50, 75, 100), merge=1:2)    #x1, x2, x3, x1|2, x2|3
    b <- fcut(y, breaks=c(0, 30, 70, 80, 100), merge=c(1,3)) #y1, y2, y3, y1|2|3

    expect_silent(res <- cbind(a, b, NULL))

    expectedNames <- c('x=1', 'x=2', 'x=3',
                       'x=1|x=2', 'x=2|x=3',
                       'y=1', 'y=2', 'y=3',
                       'y=1|y=2|y=3')

    expect_true(is.matrix(res))
    expect_equal(ncol(res), 9)
    expect_equal(nrow(res), 11)
    expect_equal(colnames(res), expectedNames)
    expect_true(inherits(res, 'fsets'))

    expectedVars <- c(rep('x', 5), rep('y', 4))

    expect_equal(vars(res), expectedVars)
    expect_equal(specs(res), matrix(c(0,0,0,1,0, 0,0,0,0,
                                      0,0,0,1,1, 0,0,0,0,
                                      0,0,0,0,1, 0,0,0,0,
                                      0,0,0,0,0, 0,0,0,0,
                                      0,0,0,0,0, 0,0,0,0,

                                      0,0,0,0,0, 0,0,0,1,
                                      0,0,0,0,0, 0,0,0,1,
                                      0,0,0,0,0, 0,0,0,1,
                                      0,0,0,0,0, 0,0,0,0),
                                    byrow=TRUE,
                                    nrow=9))
    expect_equal(res[, 1:5], a[, 1:ncol(a)])  # 'a[, ...]' removes all attributes from 'a'
    expect_equal(res[, 6:9], b[, 1:ncol(b)])  # 'b[, ...]' removes all attributes from 'b'
    expect_true(is.fsets(res))
})


test_that('cbind of the same vars has to produce warning', {
    set.seed(3335)

    m1 <- matrix(runif(12), ncol=3)
    m2 <- matrix(runif(12), 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[3:5], specs=s)

    expect_warning(cbind(f1, f2))
})