tests/testthat/test-internal.R

In seededlda: Seeded Sequential LDA for Topic Modeling

require(quanteda)

test_that("tfm is working", {

    dict <- dictionary(list(A = c("a", "aa*", "abc"),
                            B = c("b*", "bb*", "bcd"),
                            AB = c("aa", "bb")))
    txt <- c("a aa aa aaa abc", "b b bb bcd bcd")
    dfmt <- dfm(tokens(txt))

    tfm1 <- seededlda:::tfm(dfmt, dict)
    expect_s4_class(tfm1, "dgCMatrix")
    expect_equal(tfm1["A",], c("a" = 1, "aa" = 2, "aaa" = 1, "abc" = 1,
                               "b" = 0, "bb" = 0, "bcd" = 0))
    expect_equal(tfm1["B",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                               "b" = 2, "bb" = 1, "bcd" = 2))
    expect_equal(tfm1["AB",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
                                "b" = 0, "bb" = 1, "bcd" = 0))
    expect_equal(tfm1["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                                   "b" = 0, "bb" = 0, "bcd" = 0))

    tfm2 <- seededlda:::tfm(dfmt, dict, residual = FALSE)
    expect_s4_class(tfm2, "dgCMatrix")
    expect_equal(rownames(tfm2), c("A", "B", "AB"))

    tfm3 <- seededlda:::tfm(dfmt, dict, min_termfreq = 2)
    expect_s4_class(tfm3, "dgCMatrix")
    expect_equal(tfm3["A",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
                               "b" = 0, "bb" = 0, "bcd" = 0))
    expect_equal(tfm3["B",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                               "b" = 2, "bb" = 0, "bcd" = 2))
    expect_equal(tfm3["AB",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
                                "b" = 0, "bb" = 0, "bcd" = 0))
    expect_equal(tfm3["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                                   "b" = 0, "bb" = 0, "bcd" = 0))

    tfm4 <- seededlda:::tfm(dfmt, dict, weight = 0.02)
    expect_s4_class(tfm4, "dgCMatrix")
    expect_equal(tfm4["A",], c("a" = 2, "aa" = 4, "aaa" = 2, "abc" = 2,
                               "b" = 0, "bb" = 0, "bcd" = 0))
    expect_equal(tfm4["B",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                               "b" = 4, "bb" = 2, "bcd" = 4))
    expect_equal(tfm4["AB",], c("a" = 0, "aa" = 4, "aaa" = 0, "abc" = 0,
                                "b" = 0, "bb" = 2, "bcd" = 0))
    expect_equal(tfm4["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                                   "b" = 0, "bb" = 0, "bcd" = 0))

    tfm5 <- seededlda:::tfm(dfmt, dict, weight = c(0.01, 0.01, 0.02))
    expect_s4_class(tfm4, "dgCMatrix")
    expect_equal(tfm5["A",], c("a" = 1, "aa" = 2, "aaa" = 1, "abc" = 1,
                               "b" = 0, "bb" = 0, "bcd" = 0))
    expect_equal(tfm5["B",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                               "b" = 2, "bb" = 1, "bcd" = 2))
    expect_equal(tfm5["AB",], c("a" = 0, "aa" = 4, "aaa" = 0, "abc" = 0,
                                "b" = 0, "bb" = 2, "bcd" = 0))
    expect_equal(tfm5["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
                                   "b" = 0, "bb" = 0, "bcd" = 0))

    tfm11 <- seededlda:::tfm(dfmt, dict, min_termfreq = 2, residual = 4)
    expect_s4_class(tfm11, "dgCMatrix")
    expect_equal(rownames(tfm11),
                 c("A", "B", "AB", "other1", "other2", "other3", "other4"))

    options(seededlda_residual_name = "topic")
    tfm12 <- seededlda:::tfm(dfmt, dict, min_termfreq = 2, residual = 4)
    expect_s4_class(tfm12, "dgCMatrix")
    expect_equal(rownames(tfm12),
                 c("A", "B", "AB", "topic1", "topic2", "topic3", "topic4"))
    options(seededlda_residual_name = "other") # reset

})

test_that("tfm is working without matches", {

    dict <- dictionary(list(A = c("a", "aa*", "abc"),
                            B = c("b*", "bb*", "bcd"),
                            AB = c("aa", "bb")))
    txt <- c("a aa aa aaa abc", "b b bb bcd bcd")
    dfmt <- dfm(tokens(txt))

    tfm1 <- seededlda:::tfm(dfmt, dict, residual = 0)
    expect_equal(rowSums(tfm1), c("A" = 5, "B" = 5, "AB" = 3))

    txt2 <- c("a aaa abc", "b b bcd bcd")
    dfmt2 <- dfm(tokens(txt2))

    tfm2 <- seededlda:::tfm(dfmt2, dict, residual = 1)
    expect_equal(rowSums(tfm2), c("A" = 3, "B" = 4, "AB" = 0, "other" = 0))

    # no match
    tfm11 <- seededlda:::tfm(dfmt, dictionary(list(X = "x", Y = "y")),
                             residual = 1)
    expect_equal(rowSums(tfm11), c("X" = 0, "Y" = 0, "other" = 0))

    tfm12 <- seededlda:::tfm(dfmt, dictionary(list(X = character(), Y = character())),
                             residual = 1)
    expect_equal(rowSums(tfm12), c("X" = 0, "Y" = 0, "other" = 0))
})


test_that("tfm works with ngrams", {

    txt <- c("UN is the United Nations.",
             "ICC is the International Criminal Court.")
    toks <- tokens(txt, concatenator = " ")
    dict <- dictionary(list("un" = c("united nations", "un"),
                            "icc" = c("international criminal court", "icc")))
    toks1 <- tokens_compound(toks, dict)
    dfmt1 <- dfm(toks1)
    expect_equal(rowSums(seededlda:::tfm(dfmt1, dict)),
                 c("un" = 2, "icc" = 2, "other" = 0))

    skip_if_not_installed("quanteda", "4.2.0")
    toks2 <- tokens_compound(toks, dict, concatenator = "+")
    dfmt2 <- dfm(toks2)
    expect_equal(rowSums(seededlda:::tfm(dfmt2, dict)),
                 c("un" = 1, "icc" = 1, "other" = 0))
})

test_that("tfm works with dfm with x in docvars (#87)", {

	dict <- dictionary(list("A" = "a", "B" = "b"))
	dat <- data.frame(text = c("a b c", "A B C"),
					  x = c(1, 2))
	corp <- corpus(dat)
	toks <- tokens(corp)
	dfmt <- dfm(toks)

	expect_equal(
		as.matrix(seededlda:::tfm(dfmt, dict, residual = 1)),
		matrix(c(2, 0, 0, 0, 2, 0, 0, 0 ,0), nrow = 3,
			   dimnames = list(c("A", "B", "other"), c("a", "b", "c")))
	)

})


test_that("levels is working", {

	dict <- dictionary(list(A = list(
		A2 = c("aa", "aab"),
		c("a", "a*", "abc")
	),
	B = c("b*", "bb*", "bcd"),
	AB = c("aa", "bb")))
	txt <- c("a aa aa aaa abc", "b b bb bcd bcd")
	dfmt <- dfm(tokens(txt))

	tfm1 <- seededlda:::tfm(dfmt, dict)
	expect_s4_class(tfm1, "dgCMatrix")
	expect_equal(tfm1["A",], c("a" = 1, "aa" = 2, "aaa" = 1, "abc" = 1,
							   "b" = 0, "bb" = 0, "bcd" = 0))
	expect_equal(tfm1["B",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
							   "b" = 2, "bb" = 1, "bcd" = 2))
	expect_equal(tfm1["AB",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
								"b" = 0, "bb" = 1, "bcd" = 0))
	expect_equal(tfm1["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
								   "b" = 0, "bb" = 0, "bcd" = 0))

	tfm2 <- seededlda:::tfm(dfmt, dict, levels = 1:2)
	expect_s4_class(tfm2, "dgCMatrix")
	expect_equal(tfm2["A.A2",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
								  "b" = 0, "bb" = 0, "bcd" = 0))
	expect_equal(tfm2["A",], c("a" = 1, "aa" = 2, "aaa" = 1, "abc" = 1,
							   "b" = 0, "bb" = 0, "bcd" = 0))
	expect_equal(tfm2["B",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
							   "b" = 2, "bb" = 1, "bcd" = 2))
	expect_equal(tfm2["AB",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
								"b" = 0, "bb" = 1, "bcd" = 0))
	expect_equal(tfm2["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
								   "b" = 0, "bb" = 0, "bcd" = 0))

	tfm3 <- seededlda:::tfm(dfmt, dict, levels = 2)
	expect_s4_class(tfm3, "dgCMatrix")
	expect_equal(tfm3["A2",], c("a" = 0, "aa" = 2, "aaa" = 0, "abc" = 0,
								"b" = 0, "bb" = 0, "bcd" = 0))
	expect_equal(tfm3["other",], c("a" = 0, "aa" = 0, "aaa" = 0, "abc" = 0,
								   "b" = 0, "bb" = 0, "bcd" = 0))
})