tests/testthat/test-lcut.R

m <- matrix(1:10/10, ncol=2, byrow=TRUE)
colnames(m) <- c('a', 'b')
d <- as.data.frame(m)
#       a    b
# [1,]  0.1  0.2
# [2,]  0.3  0.4
# [3,]  0.5  0.6
# [4,]  0.7  0.8
# [5,]  0.9  1.0




test_that('lcut on vector', {
    testedHedges <- c("ex", "si", "ve", "-", "ml", "ro", "qr", "vr", "ty")
    testedAtomic <- c("sm", "me", "bi")

    smHedgeNames <- c("ex", "si", "ve", "", "ml", "ro", "qr", "vr")
    meHedgeNames <- c("ty", "", "ml", "ro", "qr", "vr")
    biHedgeNames <- smHedgeNames

    res <- lcut(d$a,
                context=ctx3(0, 0.5, 1),
                atomic=testedAtomic,
                hedges=testedHedges,
                name='a')

    expectedAttrs <- c(paste(smHedgeNames, 'sm', 'a', sep='.'),
                       paste(meHedgeNames, 'me', 'a', sep='.'),
                       paste(biHedgeNames, 'bi', 'a', sep='.'))
    expectedAttrs <- sub('^\\.', '', expectedAttrs)

    expect_true(is.fsets(res))
    expect_equal(ncol(res), 22)
    expect_equal(nrow(res), 5)
    expect_equal(colnames(res), expectedAttrs)
    expect_equal(vars(res), rep('a', 22))

    s <- matrix(c(0,1,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #ExSm
                  0,0,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #SiSm
                  0,0,0,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VeSm
                  0,0,0,0,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #Sm
                  0,0,0,0,0,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #MlSm
                  0,0,0,0,0,0,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #RoSm
                  0,0,0,0,0,0,0,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #QrSm
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrSm

                  0,0,0,0,0,0,0,0, 0,1,1,1,1,1, 0,0,0,0,0,0,0,0,  #TyMe
                  0,0,0,0,0,0,0,0, 0,0,1,1,1,1, 0,0,0,0,0,0,0,0,  #Me
                  0,0,0,0,0,0,0,0, 0,0,0,1,1,1, 0,0,0,0,0,0,0,0,  #MlMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,1,1, 0,0,0,0,0,0,0,0,  #RoMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,0,0,0,0,  #QrMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrMe

                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,1,1,1,1,1,1,1,  #ExBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,1,1,1,1,1,1,  #SiBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,1,1,1,1,  #VeBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1,1,1,1,  #Bi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,1,1,1,  #MlBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,1,1,  #RoBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,1,  #QrBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0), #VrBi
                nrow=22,
                ncol=22,
                byrow=TRUE)
    expect_equal(specs(res), s)
})



test_that('lcut on vector (some hedges disabled)', {
    testedHedges <- c("ex", "ve", "ml", "vr", "ty")
    testedAtomic <- c("me", "bi")

    meHedgeNames <- c("ty", "ml", "vr")
    biHedgeNames <- c("ex", "ve", "ml", "vr")

    expectedAttrs <- c(paste(meHedgeNames, 'me', 'a', sep='.'),
                       paste(biHedgeNames, 'bi', 'a', sep='.'))

    res <- lcut(d$a,
                 context=ctx3(0, 0.5, 1),
                 atomic=testedAtomic,
                 hedges=testedHedges,
                 name='a')

    expect_true(is.fsets(res))
    expect_equal(ncol(res), 7)
    expect_equal(nrow(res), 5)
    expect_equal(colnames(res), expectedAttrs)
    expect_equal(vars(res), rep('a', 7))

    s <- matrix(c(0,1,1, 0,0,0,0,  #TyMe
                  0,0,1, 0,0,0,0,  #MlMe
                  0,0,0, 0,0,0,0,  #VrMe

                  0,0,0, 0,1,1,1,  #ExBi
                  0,0,0, 0,0,1,1,  #VeBi
                  0,0,0, 0,0,0,1,  #MlBi
                  0,0,0, 0,0,0,0), #VrBi
                nrow=7,
                ncol=7,
                byrow=TRUE)

    expect_equal(specs(res), s)
    expect_true(is.fsets(res))
})


test_that('lcut on matrix', {
    testedHedges <- c("ex", "si", "ve", "-", "ml", "ro", "qr", "vr", "ty")
    testedAtomic <- c("sm", "me", "bi")

    smHedgeNames <- c("ex", "si", "ve", "", "ml", "ro", "qr", "vr")
    meHedgeNames <- c("ty", "", "ml", "ro", "qr", "vr")
    biHedgeNames <- smHedgeNames

    expectedAttrs <- c(paste(smHedgeNames, 'sm', 'a', sep='.'),
                       paste(meHedgeNames, 'me', 'a', sep='.'),
                       paste(biHedgeNames, 'bi', 'a', sep='.'),
                       paste(smHedgeNames, 'sm', 'b', sep='.'),
                       paste(meHedgeNames, 'me', 'b', sep='.'),
                       paste(biHedgeNames, 'bi', 'b', sep='.'))
    expectedAttrs <- sub('^\\.', '', expectedAttrs)

    res <- lcut(as.matrix(m),
                context=ctx3(0, 0.5, 1),
                hedges=testedHedges)

    expect_true(is.fsets(res))
    expect_equal(ncol(res), 44)
    expect_equal(nrow(res), 5)
    expect_equal(colnames(res), expectedAttrs)
    expect_equal(vars(res), c(rep('a', 22), rep('b', 22)))

    s <- matrix(c(0,1,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #ExSm
                  0,0,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #SiSm
                  0,0,0,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VeSm
                  0,0,0,0,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #Sm
                  0,0,0,0,0,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #MlSm
                  0,0,0,0,0,0,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #RoSm
                  0,0,0,0,0,0,0,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #QrSm
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrSm

                  0,0,0,0,0,0,0,0, 0,1,1,1,1,1, 0,0,0,0,0,0,0,0,  #TyMe
                  0,0,0,0,0,0,0,0, 0,0,1,1,1,1, 0,0,0,0,0,0,0,0,  #Me
                  0,0,0,0,0,0,0,0, 0,0,0,1,1,1, 0,0,0,0,0,0,0,0,  #MlMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,1,1, 0,0,0,0,0,0,0,0,  #RoMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,0,0,0,0,  #QrMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrMe

                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,1,1,1,1,1,1,1,  #ExBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,1,1,1,1,1,1,  #SiBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,1,1,1,1,  #VeBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1,1,1,1,  #Bi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,1,1,1,  #MlBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,1,1,  #RoBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,1,  #QrBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0), #VrBi
                byrow=TRUE,
                nrow=22,
                ncol=22)
    sfill <- matrix(0, nrow=22, ncol=22)
    s <- cbind(rbind(s, sfill), rbind(sfill, s))

    expect_equal(specs(res), s)
})


test_that('lcut on data frame', {
    testedHedges <- c("ex", "si", "ve", "-", "ml", "ro", "qr", "vr", "ty")
    testedAtomic <- c("sm", "me", "bi")

    smHedgeNames <- c("ex", "si", "ve", "", "ml", "ro", "qr", "vr")
    meHedgeNames <- c("ty", "", "ml", "ro", "qr", "vr")
    biHedgeNames <- smHedgeNames

    expectedAttrs <- c(paste(smHedgeNames, 'sm', 'a', sep='.'),
                       paste(meHedgeNames, 'me', 'a', sep='.'),
                       paste(biHedgeNames, 'bi', 'a', sep='.'),
                       paste(smHedgeNames, 'sm', 'b', sep='.'),
                       paste(meHedgeNames, 'me', 'b', sep='.'),
                       paste(biHedgeNames, 'bi', 'b', sep='.'))
    expectedAttrs <- sub('^\\.', '', expectedAttrs)

    res <- lcut(as.data.frame(m),
                context=ctx3(0, 0.5, 1),
                hedges=testedHedges)

    expect_true(is.fsets(res))
    expect_equal(ncol(res), 44)
    expect_equal(nrow(res), 5)
    expect_equal(colnames(res), expectedAttrs)
    expect_equal(vars(res), c(rep('a', 22), rep('b', 22)))

    s <- matrix(c(0,1,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #ExSm
                  0,0,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #SiSm
                  0,0,0,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VeSm
                  0,0,0,0,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #Sm
                  0,0,0,0,0,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #MlSm
                  0,0,0,0,0,0,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #RoSm
                  0,0,0,0,0,0,0,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #QrSm
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrSm

                  0,0,0,0,0,0,0,0, 0,1,1,1,1,1, 0,0,0,0,0,0,0,0,  #TyMe
                  0,0,0,0,0,0,0,0, 0,0,1,1,1,1, 0,0,0,0,0,0,0,0,  #Me
                  0,0,0,0,0,0,0,0, 0,0,0,1,1,1, 0,0,0,0,0,0,0,0,  #MlMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,1,1, 0,0,0,0,0,0,0,0,  #RoMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,0,0,0,0,  #QrMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrMe

                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,1,1,1,1,1,1,1,  #ExBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,1,1,1,1,1,1,  #SiBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,1,1,1,1,  #VeBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1,1,1,1,  #Bi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,1,1,1,  #MlBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,1,1,  #RoBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,1,  #QrBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0), #VrBi
                byrow=TRUE,
                nrow=22,
                ncol=22)
    sfill <- matrix(0, nrow=22, ncol=22)
    s <- cbind(rbind(s, sfill), rbind(sfill, s))

    expect_equal(specs(res), s)
})


test_that('lcut on single row data frame', {
    testedHedges <- c("ex", "si", "ve", "-", "ml", "ro", "qr", "vr", "ty")
    testedAtomic <- c("sm", "me", "bi")

    smHedgeNames <- c("ex", "si", "ve", "", "ml", "ro", "qr", "vr")
    meHedgeNames <- c("ty", "", "ml", "ro", "qr", "vr")
    biHedgeNames <- smHedgeNames

    expectedAttrs <- c(paste(smHedgeNames, 'sm', 'a', sep='.'),
                       paste(meHedgeNames, 'me', 'a', sep='.'),
                       paste(biHedgeNames, 'bi', 'a', sep='.'),
                       paste(smHedgeNames, 'sm', 'b', sep='.'),
                       paste(meHedgeNames, 'me', 'b', sep='.'),
                       paste(biHedgeNames, 'bi', 'b', sep='.'))
    expectedAttrs <- sub('^\\.', '', expectedAttrs)

    res <- lcut(m[1, , drop=FALSE],
                context=ctx3(0, 0.5, 1),
                hedges=testedHedges)

    expect_true(is.fsets(res))
    expect_equal(ncol(res), 44)
    expect_equal(nrow(res), 1)
    expect_equal(colnames(res), expectedAttrs)
    expect_equal(vars(res), c(rep('a', 22), rep('b', 22)))

    s <- matrix(c(0,1,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #ExSm
                  0,0,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #SiSm
                  0,0,0,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VeSm
                  0,0,0,0,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #Sm
                  0,0,0,0,0,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #MlSm
                  0,0,0,0,0,0,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #RoSm
                  0,0,0,0,0,0,0,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #QrSm
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrSm

                  0,0,0,0,0,0,0,0, 0,1,1,1,1,1, 0,0,0,0,0,0,0,0,  #TyMe
                  0,0,0,0,0,0,0,0, 0,0,1,1,1,1, 0,0,0,0,0,0,0,0,  #Me
                  0,0,0,0,0,0,0,0, 0,0,0,1,1,1, 0,0,0,0,0,0,0,0,  #MlMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,1,1, 0,0,0,0,0,0,0,0,  #RoMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,0,0,0,0,  #QrMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrMe

                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,1,1,1,1,1,1,1,  #ExBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,1,1,1,1,1,1,  #SiBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,1,1,1,1,  #VeBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1,1,1,1,  #Bi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,1,1,1,  #MlBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,1,1,  #RoBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,1,  #QrBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0), #VrBi
                byrow=TRUE,
                nrow=22,
                ncol=22)
    sfill <- matrix(0, nrow=22, ncol=22)
    s <- cbind(rbind(s, sfill), rbind(sfill, s))

    expect_equal(specs(res), s)
})


test_that('lcut on empty row data frame', {
    testedHedges <- c("ex", "si", "ve", "-", "ml", "ro", "qr", "vr", "ty")
    testedAtomic <- c("sm", "me", "bi")

    smHedgeNames <- c("ex", "si", "ve", "", "ml", "ro", "qr", "vr")
    meHedgeNames <- c("ty", "", "ml", "ro", "qr", "vr")
    biHedgeNames <- smHedgeNames

    expectedAttrs <- c(paste(smHedgeNames, 'sm', 'a', sep='.'),
                       paste(meHedgeNames, 'me', 'a', sep='.'),
                       paste(biHedgeNames, 'bi', 'a', sep='.'),
                       paste(smHedgeNames, 'sm', 'b', sep='.'),
                       paste(meHedgeNames, 'me', 'b', sep='.'),
                       paste(biHedgeNames, 'bi', 'b', sep='.'))
    expectedAttrs <- sub('^\\.', '', expectedAttrs)

    res <- lcut(m[FALSE, , drop=FALSE],
                context=ctx3(0, 0.5, 1),
                hedges=testedHedges)

    expect_true(is.fsets(res))
    expect_equal(ncol(res), 44)
    expect_equal(nrow(res), 0)
    expect_equal(colnames(res), expectedAttrs)
    expect_equal(vars(res), c(rep('a', 22), rep('b', 22)))

    s <- matrix(c(0,1,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #ExSm
                  0,0,1,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #SiSm
                  0,0,0,1,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VeSm
                  0,0,0,0,1,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #Sm
                  0,0,0,0,0,1,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #MlSm
                  0,0,0,0,0,0,1,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #RoSm
                  0,0,0,0,0,0,0,1, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #QrSm
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrSm

                  0,0,0,0,0,0,0,0, 0,1,1,1,1,1, 0,0,0,0,0,0,0,0,  #TyMe
                  0,0,0,0,0,0,0,0, 0,0,1,1,1,1, 0,0,0,0,0,0,0,0,  #Me
                  0,0,0,0,0,0,0,0, 0,0,0,1,1,1, 0,0,0,0,0,0,0,0,  #MlMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,1,1, 0,0,0,0,0,0,0,0,  #RoMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,0,0,0,0,  #QrMe
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0,  #VrMe

                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,1,1,1,1,1,1,1,  #ExBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,1,1,1,1,1,1,  #SiBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,1,1,1,1,  #VeBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1,1,1,1,  #Bi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,1,1,1,  #MlBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,1,1,  #RoBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,1,  #QrBi
                  0,0,0,0,0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0,0,0,0), #VrBi
                byrow=TRUE,
                nrow=22,
                ncol=22)
    sfill <- matrix(0, nrow=22, ncol=22)
    s <- cbind(rbind(s, sfill), rbind(sfill, s))

    expect_equal(specs(res), s)
})


test_that('lcut empty data.frame', {
    testedHedges <- c("ex", "-", "ml", "ro", "qr", "vr")
    hedgeNames   <- c("ex", "", "ml", "ro", "qr", "vr")

    smHedgeNames <- hedgeNames
    biHedgeNames <- hedgeNames

    attrs <- c(paste(smHedgeNames, 'sm', sep='.'),
               paste(biHedgeNames, 'bi', sep='.'))

    d <- d[FALSE, , drop=FALSE]
    res <- lcut(d,
                atomic=c('sm', 'bi'),
                context=ctx3(0, 0.5, 1),
                hedges=testedHedges)

    expectedAttrs <- c(paste(attrs, '.a', sep=''),
                       paste(attrs, '.b', sep=''))
    expectedAttrs <- sub('^\\.', '', expectedAttrs)

    expect_true(is.matrix(res))
    expect_equal(ncol(res), 24)
    expect_equal(nrow(res), 0)
    expect_equal(sort(colnames(res)), sort(expectedAttrs))
    expect_true(inherits(res, 'fsets'))
    expect_equivalent(vars(res), c(rep('a', 12), rep('b', 12)))
    #expect_equal(sort(names(vars(res))), sort(expectedAttrs))
    #expect_equal(sort(colnames(specs(res))), sort(expectedAttrs))
    #expect_equal(sort(rownames(specs(res))), sort(expectedAttrs))

    s <- matrix(c(0,1,1,1,1,1, 0,0,0,0,0,0,  #ExSm
                  0,0,1,1,1,1, 0,0,0,0,0,0,  #Sm
                  0,0,0,1,1,1, 0,0,0,0,0,0,  #MlSm
                  0,0,0,0,1,1, 0,0,0,0,0,0,  #RoSm
                  0,0,0,0,0,1, 0,0,0,0,0,0,  #QrSm
                  0,0,0,0,0,0, 0,0,0,0,0,0,  #VrSm

                  0,0,0,0,0,0, 0,1,1,1,1,1,  #ExBi
                  0,0,0,0,0,0, 0,0,1,1,1,1,  #Bi
                  0,0,0,0,0,0, 0,0,0,1,1,1,  #MlBi
                  0,0,0,0,0,0, 0,0,0,0,1,1,  #RoBi
                  0,0,0,0,0,0, 0,0,0,0,0,1,  #QrBi
                  0,0,0,0,0,0, 0,0,0,0,0,0), #VrBi
                byrow=TRUE,
                nrow=12,
                ncol=12)
    sfill <- matrix(0, nrow=12, ncol=12)
    s <- cbind(rbind(s, sfill), rbind(sfill, s))

    mapper <- seq_along(expectedAttrs)
    names(mapper) <- expectedAttrs
    #s <- s[colnames(res), colnames(res)]
    s <- s[mapper[colnames(res)], mapper[colnames(res)]]

    expect_equal(specs(res), s)
    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.