beerda/lfl
Linguistic Fuzzy Logic

Package index
Search the beerda/lfl package
Vignettes
Functions
333
Source code
87
Man pages
54
Home
/
GitHub
/
beerda/lfl
/
tests/testthat/test-composeNA.R

tests/testthat/test-composeNA.R
In beerda/lfl: Linguistic Fuzzy Logic 

test_that('basic lukas dragonfly', {
    R <- matrix(c(1, 0.9, 1, 0, 0, 0, NA, 0, 0, NA,
                  1, 0.2, 0.1, 1, 0, 0, NA, 0, 0, 0,
                  1, 0, 0.5, 0.9, 0, 0, 0.6, 0, 0, 0,
                  1, 0, 0, 0.9, 0, 0, 0.6, 0, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
                  0, 0, 0, 0, 1, 0.8, NA, 1, 0.8, 0.8,
                  0, 0, NA, 0.5, 1, 0.7, 0.7, 0, 1, 0.8,
                  0, 0, NA, 0, 1, 0.7, NA, 0, 0, 1), byrow=TRUE, nrow=8)

    S <- matrix(c(1, 1, 1, 1, 0, 0, 0, 0,
                  1, 0, 0, 0, 0, 0, 0, 0,
                  1, NA, 0.5, 0, 0, 0, 0, 0,
                  0, 1, 1, 0.7, 0, 0.7, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 1,
                  0, 0, 0, 0, 0.7, 0.5, 1, 1,
                  NA, 0, 0.5, NA, 0.5, 0.5, NA, NA,
                  0, 0, 0, 0, 1, 1, 0, 0,
                  0, 0, 0, 0, 0.5, 1, 0.9, 0,
                  NA, 0, 0.5, 0, 0.7, 0.5, 0.5, 0.5), byrow=TRUE, nrow=10)

    RS <- matrix(c(1, 1, 1, 1, NA, NA, NA, NA,
                   1, 1, 1, 1, NA, 0.7, NA, NA,
                   1, 1, 1, 1, 0.1, 0.6, NA, NA,
                   1, 1, 1, 1, 0.1, 0.6, NA, NA,
                   NA, 0, 0.5, NA, 1, 1, 1, 1,
                   NA, 0, 0.3, NA, 1, 1, 1, 1,
                   NA, 0.5, 0.5, 0.2, 1, 1, 1, 1,
                   NA, NA, 0.5, NA, 1, 1, 1, 1), byrow=TRUE, nrow=8)

    expect_that(compose(R, S, alg=dragonfly(algebra('lukas')), type='basic'),
                equals(RS))
})


test_that('basic E lukas dragonfly', {
    R <- matrix(c(1, 0.9, 1, 0, 0, 0, NA, 0, 0, NA,
                  1, 0.2, 0.1, 1, 0, 0, NA, 0, 0, 0,
                  1, 0, 0.5, 0.9, 0, 0, 0.6, 0, 0, 0,
                  1, 0, 0, 0.9, 0, 0, 0.6, 0, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
                  0, 0, 0, 0, 1, 0.8, NA, 1, 0.8, 0.8,
                  0, 0, NA, 0.5, 1, 0.7, 0.7, 0, 1, 0.8,
                  0, 0, NA, 0, 1, 0.7, NA, 0, 0, 1), byrow=TRUE, nrow=8)

    S <- matrix(c(1, 1, 1, 1, 0, 0, 0, 0,
                  1, 0, 0, 0, 0, 0, 0, 0,
                  1, NA, 0.5, 0, 0, 0, 0, 0,
                  0, 1, 1, 0.7, 0, 0.7, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 1,
                  0, 0, 0, 0, 0.7, 0.5, 1, 1,
                  NA, 0, 0.5, NA, 0.5, 0.5, NA, NA,
                  0, 0, 0, 0, 1, 1, 0, 0,
                  0, 0, 0, 0, 0.5, 1, 0.9, 0,
                  NA, 0, 0.5, 0, 0.7, 0.5, 0.5, 0.5), byrow=TRUE, nrow=10)

    E <- matrix(c(0, 0, 0, 0, 1, 1, 1, 1,
                  0, 1, 1, 1, 1, 1, 1, 1,
                  0, 0, 0, 1, 1, 1, 1, 1,
                  1, 0, 0, 0, 1, 0, 1, 1,
                  1, 1, 1, 1, 0, 0, 0, 0,
                  1, 1, 1, 1, 0, 0, 0, 0,
                  0, 1, 0, 0, 0, 0, 0.8, 0.8,
                  1, 1, 1, 1, 0, 0, 1, 1,
                  1, 1, 1, 1, 0, 0, 0, 1,
                  0, 1, 0, 1, 0, 0, 0, 0.2), byrow=TRUE, nrow=10)

    RS <- matrix(c(1, 0.1, 0.1, 0, 0, 0, 0, 0,
                   0, 0.8, 0.8, 0.8, 0, 0, 0, 0,
                   0.1, 0.4, 1, 0.5, 0, 0, 0, 0,
                   0.1, 0.4, 1, 1, 0, 0, 0, 0,
                   0, 0, 0, 0, 1, 1, 0.2, 0.2,
                   0, 0, 0, 0, 1, 1, 0, 0,
                   0, 0, 0, 0, 0.5, NA_real_, 0.5, 0,
                   0, 0, 0, 0, NA_real_, NA_real_, NA_real_, 0.8), byrow=TRUE, nrow=8)

    expect_that(suppressWarnings(compose(R, S, E, alg=dragonfly(algebra('lukas')), type='basic')),
                equals(RS))
})


test_that('sub lukas dragonfly', {
    R <- matrix(c(1, 0.9, 1, 0, 0, 0, NA, 0, 0, NA,
                  1, 0.2, 0.1, 1, 0, 0, NA, 0, 0, 0,
                  1, 0, 0.5, 0.9, 0, 0, 0.6, 0, 0, 0,
                  1, 0, 0, 0.9, 0, 0, 0.6, 0, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
                  0, 0, 0, 0, 1, 0.8, NA, 1, 0.8, 0.8,
                  0, 0, NA, 0.5, 1, 0.7, 0.7, 0, 1, 0.8,
                  0, 0, NA, 0, 1, 0.7, NA, 0, 0, 1), byrow=TRUE, nrow=8)

    S <- matrix(c(1, 1, 1, 1, 0, 0, 0, 0,
                  1, 0, 0, 0, 0, 0, 0, 0,
                  1, NA, 0.5, 0, 0, 0, 0, 0,
                  0, 1, 1, 0.7, 0, 0.7, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 1,
                  0, 0, 0, 0, 0.7, 0.5, 1, 1,
                  NA, 0, 0.5, NA, 0.5, 0.5, NA, NA,
                  0, 0, 0, 0, 1, 1, 0, 0,
                  0, 0, 0, 0, 0.5, 1, 0.9, 0,
                  NA, 0, 0.5, 0, 0.7, 0.5, 0.5, 0.5), byrow=TRUE, nrow=10)

    RS <- matrix(c(1, NA, 0.1, 0, 0, 0, 0, 0,
                   0, NA, 0.5, 0.7, 0, 0, 0, 0,
                   NA, NA, 0.9, NA, 0, 0, 0, 0,
                   NA, 0.4, 0.9, NA, 0, 0, 0, 0,
                   0, 0, 0, 0, 0.5, 0.5, NA, NA,
                   0, 0, 0, 0, 0.5, 0.5, 0, 0,
                   0, 0, 0, 0, NA, NA, NA, 0,
                   0, 0, 0, 0, NA, NA, NA, NA), byrow=TRUE, nrow=8)

    expect_that(compose(R, S, alg=dragonfly(algebra('lukas')), type='sub'),
                equals(RS))
})


test_that('basic lukas bochvar', {
    R <- matrix(c(1, 0.9, 1, 0, 0, 0, NA, 0, 0, NA,
                  1, 0.2, 0.1, 1, 0, 0, NA, 0, 0, 0,
                  1, 0, 0.5, 0.9, 0, 0, 0.6, 0, 0, 0,
                  1, 0, 0, 0.9, 0, 0, 0.6, 0, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
                  0, 0, 0, 0, 1, 0.8, NA, 1, 0.8, 0.8,
                  0, 0, NA, 0.5, 1, 0.7, 0.7, 0, 1, 0.8,
                  0, 0, NA, 0, 1, 0.7, NA, 0, 0, 1), byrow=TRUE, nrow=8)

    S <- matrix(c(1, 1, 1, 1, 0, 0, 0, 0,
                  1, 0, 0, 0, 0, 0, 0, 0,
                  1, NA, 0.5, 0, 0, 0, 0, 0,
                  0, 1, 1, 0.7, 0, 0.7, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 1,
                  0, 0, 0, 0, 0.7, 0.5, 1, 1,
                  NA, 0, 0.5, NA, 0.5, 0.5, NA, NA,
                  0, 0, 0, 0, 1, 1, 0, 0,
                  0, 0, 0, 0, 0.5, 1, 0.9, 0,
                  NA, 0, 0.5, 0, 0.7, 0.5, 0.5, 0.5), byrow=TRUE, nrow=10)

    RS <- matrix(c(
        NA, NA, NA, NA, NA, NA, NA, NA,
        NA, NA, NA, NA, NA, NA, NA, NA,
        NA, NA, 1, NA, 0.1, 0.6, NA, NA,
        NA, NA, 1, NA, 0.1, 0.6, NA, NA,
        NA, NA, 0.5, NA, 1, 1, NA, NA,
        NA, NA, NA, NA, NA, NA, NA, NA,
        NA, NA, NA, NA, NA, NA, NA, NA,
        NA, NA, NA, NA, NA, NA, NA, NA), byrow=TRUE, nrow=8)

    expect_that(compose(R, S, alg=algebra('lukas'), type='basic'),
                equals(RS))
})


test_that('basic lukas sobocinski', {
    R <- matrix(c(1, 0.9, 1, 0, 0, 0, NA, 0, 0, NA,
                  1, 0.2, 0.1, 1, 0, 0, NA, 0, 0, 0,
                  1, 0, 0.5, 0.9, 0, 0, 0.6, 0, 0, 0,
                  1, 0, 0, 0.9, 0, 0, 0.6, 0, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
                  0, 0, 0, 0, 1, 0.8, NA, 1, 0.8, 0.8,
                  0, 0, NA, 0.5, 1, 0.7, 0.7, 0, 1, 0.8,
                  0, 0, NA, 0, 1, 0.7, NA, 0, 0, 1), byrow=TRUE, nrow=8)

    S <- matrix(c(1, 1, 1, 1, 0, 0, 0, 0,
                  1, 0, 0, 0, 0, 0, 0, 0,
                  1, NA, 0.5, 0, 0, 0, 0, 0,
                  0, 1, 1, 0.7, 0, 0.7, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 1,
                  0, 0, 0, 0, 0.7, 0.5, 1, 1,
                  NA, 0, 0.5, NA, 0.5, 0.5, NA, NA,
                  0, 0, 0, 0, 1, 1, 0, 0,
                  0, 0, 0, 0, 0.5, 1, 0.9, 0,
                  NA, 0, 0.5, 0, 0.7, 0.5, 0.5, 0.5), byrow=TRUE, nrow=10)

    RS <- matrix(c(
        1, 1, 1, 1, 0.7, 0.5, 0.5, 0.5,
        1, 1, 1, 1, 0.5, 0.7, 0, 0,
        1, 1, 1, 1, 0.1, 0.6, 0.6, 0.6,
        1, 1, 1, 1, 0.1, 0.6, 0.6, 0.6,
        1, 0, 0.5, 1, 1, 1, 1, 1,
        0.8, 0, 0.5, 0, 1, 1, 1, 1,
        1, 0.5, 0.5, 0.7, 1, 1, 1, 1,
        1, 0, 0.5, 0, 1, 1, 1, 1), byrow=TRUE, nrow=8)

    expect_that(compose(R, S, alg=sobocinski(algebra('lukas')), type='basic'),
                equals(RS))
})


test_that('basic lukas kleene', {
    R <- matrix(c(1, 0.9, 1, 0, 0, 0, NA, 0, 0, NA,
                  1, 0.2, 0.1, 1, 0, 0, NA, 0, 0, 0,
                  1, 0, 0.5, 0.9, 0, 0, 0.6, 0, 0, 0,
                  1, 0, 0, 0.9, 0, 0, 0.6, 0, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 0, 0, 0,
                  0, 0, 0, 0, 1, 0.8, NA, 1, 0.8, 0.8,
                  0, 0, NA, 0.5, 1, 0.7, 0.7, 0, 1, 0.8,
                  0, 0, NA, 0, 1, 0.7, NA, 0, 0, 1), byrow=TRUE, nrow=8)

    S <- matrix(c(1, 1, 1, 1, 0, 0, 0, 0,
                  1, 0, 0, 0, 0, 0, 0, 0,
                  1, NA, 0.5, 0, 0, 0, 0, 0,
                  0, 1, 1, 0.7, 0, 0.7, 0, 0,
                  0, 0, 0, 0, 1, 1, 1, 1,
                  0, 0, 0, 0, 0.7, 0.5, 1, 1,
                  NA, 0, 0.5, NA, 0.5, 0.5, NA, NA,
                  0, 0, 0, 0, 1, 1, 0, 0,
                  0, 0, 0, 0, 0.5, 1, 0.9, 0,
                  NA, 0, 0.5, 0, 0.7, 0.5, 0.5, 0.5), byrow=TRUE, nrow=10)

    RS <- matrix(c(
        1, 1, 1, 1, NA, NA, NA, NA,
        1, 1, 1, 1, NA, NA, NA, NA,
        1, 1, 1, 1, 0.1, 0.6, NA, NA,
        1, 1, 1, 1, 0.1, 0.6, NA, NA,
        NA, 0, 0.5, NA, 1, 1, 1, 1,
        NA, 0, NA, NA, 1, 1, 1, 1,
        NA, NA, NA, NA, 1, 1, 1, 1,
        NA, NA, NA, NA, 1, 1, 1, 1), byrow=TRUE, nrow=8)

    expect_that(compose(R, S, alg=kleene(algebra('lukas')), type='basic'),
                equals(RS))
})
beerda/lfl documentation built on Feb. 15, 2023, 8:15 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close