tests/testthat/test_scudoClassifyUtilities.R

In Matteo-Ciciani/scudo: Signature-based Clustering for Diagnostic Purposes

context("Test scudoClassifyUtilities")
library(rScudo)

test_that(".computeTestNetwork works", {
    expData <- data.frame(a = 1:10, b = 2:11, c = 10:1, d = 11:2,
                          e = c(1:4, 10:5), f = c(7:10, 6:1))
    rownames(expData) <- letters[1:10]
    g <- factor(c(1,1,1,2,2,2))
    sr <- scudoTrain(expData, g, 4, 4, alpha = 0.5, foldChange = FALSE,
        featureSel = FALSE)
    dm <- distMatrix(sr)
    net <- scudoNetwork(sr, 0.2)

    res <- .computeTestNetwork(dm, 0.2, g[-1])

    expect_identical(names(igraph::V(net)), names(igraph::V(res)))
    expect_identical(attr(igraph::E(net), "vname"),
                     attr(igraph::E(res), "vname"))
    expect_identical(as.character(igraph::V(net)$group[-1]),
                     igraph::V(res)$group[-1])
    expect_equal(igraph::E(net)$distance, igraph::E(res)$distance)
})

test_that(".networksFromDistMatrix works", {
    expData <- data.frame(a = 1:10, b = 2:11, c = 10:1, d = 11:2,
                          e = c(1:4, 10:5), f = c(7:10, 6:1),
                          g = c(8:4, 1:3, 10, 9), h = c(6:10, 5:1),
                          i = c(5:1, 6:10))
    rownames(expData) <- letters[1:10]
    g <- factor(c(1,1,1,2,2,2,1,1,1))
    sr <- scudoTrain(expData, g, 4, 4, alpha = 0.5, foldChange = FALSE,
        featureSel = FALSE)
    dm <- distMatrix(sr)

    sr1 <- scudoNetwork(scudoTrain(expData[, c(6, 1:5)], g[c(6, 1:5)], 4, 4,
        alpha = 0.5, foldChange = FALSE, featureSel = FALSE), 0.2)
    sr2 <- scudoNetwork(scudoTrain(expData[, c(7, 1:5)], g[c(7, 1:5)], 4, 4,
        alpha = 0.5, foldChange = FALSE, featureSel = FALSE), 0.2)
    sr3 <- scudoNetwork(scudoTrain(expData[, c(8, 1:5)], g[c(8, 1:5)], 4, 4,
        alpha = 0.5, foldChange = FALSE, featureSel = FALSE), 0.2)
    sr4 <- scudoNetwork(scudoTrain(expData[, c(9, 1:5)], g[c(9, 1:5)], 4, 4,
        alpha = 0.5, foldChange = FALSE, featureSel = FALSE), 0.2)

    nets <- .networksFromDistMatrix(dm, 0.2, g[1:5])

    expect_identical(names(igraph::V(nets[[1]])), names(igraph::V(sr1)))
    expect_identical(attr(igraph::E(nets[[1]]), "vname"),
                     attr(igraph::E(sr1), "vname"))
    expect_identical(as.character(igraph::V(nets[[1]])$group[-1]),
                     as.character(igraph::V(sr1)$group[-1]))
    expect_equal(igraph::E(nets[[1]])$distance, igraph::E(sr1)$distance)

    expect_identical(names(igraph::V(nets[[2]])), names(igraph::V(sr2)))
    expect_identical(attr(igraph::E(nets[[2]]), "vname"),
                     attr(igraph::E(sr2), "vname"))
    expect_identical(as.character(igraph::V(nets[[2]])$group[-1]),
                     as.character(igraph::V(sr2)$group[-1]))
    expect_equal(igraph::E(nets[[2]])$distance, igraph::E(sr2)$distance)

    expect_identical(names(igraph::V(nets[[3]])), names(igraph::V(sr3)))
    expect_identical(attr(igraph::E(nets[[3]]), "vname"),
                     attr(igraph::E(sr3), "vname"))
    expect_identical(as.character(igraph::V(nets[[3]])$group[-1]),
                     as.character(igraph::V(sr3)$group[-1]))
    expect_equal(igraph::E(nets[[3]])$distance, igraph::E(sr3)$distance)

    expect_identical(names(igraph::V(nets[[4]])), names(igraph::V(sr4)))
    expect_identical(attr(igraph::E(nets[[4]]), "vname"),
                     attr(igraph::E(sr4), "vname"))
    expect_identical(as.character(igraph::V(nets[[4]])$group[-1]),
                     as.character(igraph::V(sr4)$group[-1]))
    expect_equal(igraph::E(nets[[4]])$distance, igraph::E(sr4)$distance)
})

# test_that(".visitEdges works", {
#     expData <- data.frame(a = 1:10, b = 2:11, c = 10:1, d = 11:2,
#                           e = c(1:4, 10:5), f = c(7:10, 6:1),
#                           g = c(8:4, 1:3, 10, 9), h = c(6:10, 5:1),
#                           i = c(5:1, 6:10))
#     rownames(expData) <- letters[1:10]
#     g <- factor(c(1,1,1,2,2,2,1,1,1))
# 
#     sr1 <- scudoTrain(expData[, c(9, 1:8)], g, 4, 4, alpha = 0.5, foldChange = FALSE,
#         featureSel = FALSE)
#     net1 <- scudoNetwork(sr1, 0.2)
#     scores1 <- .visitEdges(net1, 1, levels(g), TRUE, 1)
#     res1 <- 1:0
#     names(res1) <- levels(g)
#     expect_equal(scores1, res1)
# 
#     sr2 <- scudoTrain(expData[, c(7, 1:6, 8:9)], g, 4, 4, alpha = 0.5,
#         foldChange = FALSE, featureSel = FALSE)
#     net2 <- scudoNetwork(sr2, 0.2)
#     scores2 <- .visitEdges(net2, 1, levels(g), TRUE, 1)
#     res2 <- c(NaN, NaN)
#     names(res2) <- levels(g)
#     expect_equal(scores2, res2)
# 
#     scores3 <- .visitEdges(net1, 2, levels(g), TRUE, 1)
#     edges <- igraph::get.edge.ids(net1, c("i", "a", "i", "b", "b", "a",
#         "a", "e", "e", "b"), directed = FALSE)
#     w <- 2 - igraph::get.edge.attribute(net1, "distance", edges)
#     res3 <- c(sum(w[1:3]), sum(w[4:5]))/sum(w)
#     names(res3) <- levels(g)
#     expect_equal(scores3, res3)
# 
#     scores4 <- .visitEdges(net1, 2, levels(g), FALSE, 1)
#     res4 <- c(3/5, 2/5)
#     names(res4) <- levels(g)
#     expect_equal(scores4, res4)
# 
#     scores5 <- .visitEdges(net1, 2, levels(g), TRUE, 0.5)
#     edges <- igraph::get.edge.ids(net1, c("i", "a", "i", "b", "b", "a",
#         "a", "e", "e", "b"), directed = FALSE)
#     w <- 2 - igraph::get.edge.attribute(net1, "distance", edges)
#     w <- w * c(1, 1, 0.5, 0.5, 0.5)
#     res5 <- c(sum(w[1:3]), sum(w[4:5]))/sum(w)
#     names(res5) <- levels(g)
#     expect_equal(scores5, res5)
# 
#     sr6 <- scudoTrain(expData[, c(8, 1:7, 9)], g, 4, 4, alpha = 0.5, foldChange = FALSE,
#         featureSel = FALSE)
#     net6 <- scudoNetwork(sr6, 0.2)
#     scores6 <- .visitEdges(net6, 2, levels(g), FALSE, 1)
#     res6 <- c(2, 4) / 6
#     names(res6) <- levels(g)
#     expect_equal(scores6, res6)
# })

test_that(".computeCompleteScores works", {
    expData <- data.frame(a = 1:10, b = 2:11, c = 10:1, d = 11:2,
        e = c(1:4, 10:5), f = c(7:10, 6:1),
        g = c(8:4, 1:3, 10, 9), h = c(6:10, 5:1),
        i = c(5:1, 6:10))
    rownames(expData) <- letters[1:10]
    g <- factor(c(1,1,1,2,2,2,1,1,2))

    dm <- .defaultDist(expData, 4, 4)
    dm2 <- 2 - dm[1:5, 6:9]

    res <- rbind(apply(dm2[1:3, ], 2, sum) / 3, apply(dm2[4:5, ], 2, sum) / 2)
    res <- apply(res, 2, function(x) x/sum(x))
    res <- t(res)
    colnames(res) <- c(1, 2)

    res2 <- .computeCompleteScores(dm, 5, 4, g[1:5])
    expect_equal(res, res2)

})