tests/testthat/test-graph.R

# Tests for type = "network" (k-partite graph visualization)
# Backward-compatible aliases: "graph" and "singleton" both map to "network"

library(panelView)

## Helper: run panelview() suppressing the plot device output
pv <- function(...) {
    pdf(NULL)
    on.exit(dev.off())
    panelview(...)
}

## Helper: get singleton values for a given FE dimension
get_singletons <- function(result, fe_name) {
    s <- result$singletons
    if (nrow(s) == 0) return(character(0))
    s[[fe_name]][s$singleton_fe == fe_name]
}

# -----------------------------------------------------------------------
# 2.1 Basic Functionality — Balanced Panel
# -----------------------------------------------------------------------

test_that("network type works with balanced panel", {
    skip_if_not_installed("igraph")
    data(turnout, package = "panelView")
    result <- pv(turnout, ~1, index = c("abb", "year"), type = "network")

    expect_true(is.list(result))
    expect_equal(result$n_components, 1)
    expect_length(get_singletons(result, "abb"), 0)
    expect_length(get_singletons(result, "year"), 0)
    expect_true(inherits(result$graph, "igraph"))
    expect_true(inherits(result$plot, "gg") || inherits(result$plot, "ggplot"))
    expect_equal(igraph::vcount(result$graph), 47 + 24)
    expect_equal(igraph::ecount(result$graph), 47 * 24)
})

# -----------------------------------------------------------------------
# 2.1b Backward-compatible alias: "graph"
# -----------------------------------------------------------------------

test_that("graph alias works", {
    skip_if_not_installed("igraph")
    data(turnout, package = "panelView")
    result <- pv(turnout, ~1, index = c("abb", "year"), type = "graph")

    expect_true(is.list(result))
    expect_true(inherits(result$graph, "igraph"))
    expect_equal(igraph::vcount(result$graph), 47 + 24)
})

# -----------------------------------------------------------------------
# 2.2 Unbalanced Panel with Singletons
# -----------------------------------------------------------------------

test_that("network type identifies singletons", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        unit = c("A", "A", "A", "B", "B", "C"),
        time = c(1, 2, 3, 1, 2, 4)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    expect_equal(igraph::vcount(result$graph), 7)
    expect_equal(igraph::ecount(result$graph), 6)
    expect_true("C" %in% get_singletons(result, "unit"))
    expect_true(3 %in% get_singletons(result, "time"))
    expect_true(4 %in% get_singletons(result, "time"))
    expect_equal(result$n_components, 2)
})

# -----------------------------------------------------------------------
# 2.3 Disconnected Components
# -----------------------------------------------------------------------

test_that("network type detects disconnected components", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        unit = c("A", "A", "B", "B", "C", "C", "D", "D"),
        time = c(1, 2, 1, 2, 3, 4, 3, 4)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    expect_equal(result$n_components, 2)
    expect_length(get_singletons(result, "unit"), 0)
    expect_length(get_singletons(result, "time"), 0)
    expect_equal(igraph::ecount(result$graph), 8)
})

# -----------------------------------------------------------------------
# 2.4 Type Alias: "singleton"
# -----------------------------------------------------------------------

test_that("singleton alias works", {
    skip_if_not_installed("igraph")
    df <- data.frame(unit = c("A", "A", "B"), time = c(1, 2, 1))
    result <- pv(df, ~1, index = c("unit", "time"), type = "singleton")

    expect_true(inherits(result$graph, "igraph"))
    expect_true(is.list(result))
})

# -----------------------------------------------------------------------
# 2.5 Layout Algorithms
# -----------------------------------------------------------------------

test_that("all layout algorithms work", {
    skip_if_not_installed("igraph")
    data(turnout, package = "panelView")
    for (lay in c("fr", "bipartite", "circle")) {
        result <- pv(turnout, ~1, index = c("abb", "year"),
                     type = "network", layout = lay)
        expect_true(inherits(result$graph, "igraph"),
                    info = paste("layout =", lay))
        expect_true(inherits(result$plot, "gg") || inherits(result$plot, "ggplot"),
                    info = paste("layout =", lay))
    }
})

# -----------------------------------------------------------------------
# 2.6 Invalid Layout
# -----------------------------------------------------------------------

test_that("invalid layout errors", {
    skip_if_not_installed("igraph")
    data(turnout, package = "panelView")
    expect_error(
        pv(turnout, ~1, index = c("abb", "year"),
           type = "network", layout = "invalid"),
        regexp = "'arg' should be one of"
    )
})

# -----------------------------------------------------------------------
# 2.7 show.singletons = FALSE
# -----------------------------------------------------------------------

test_that("show.singletons FALSE works", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        unit = c("A", "A", "B"),
        time = c(1, 2, 1)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network",
                 show.singletons = FALSE)

    expect_true(is.list(result$singletons))
})

# -----------------------------------------------------------------------
# 2.8 highlight.components = FALSE
# -----------------------------------------------------------------------

test_that("highlight.components FALSE works", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        unit = c("A", "A", "C", "C"),
        time = c(1, 2, 3, 4)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network",
                 highlight.components = FALSE)

    expect_equal(result$n_components, 2)
})

# -----------------------------------------------------------------------
# 2.9 show.labels Options
# -----------------------------------------------------------------------

test_that("show.labels options work", {
    skip_if_not_installed("igraph")
    df <- data.frame(unit = c("A", "A", "B"), time = c(1, 2, 1))
    for (opt in c("auto", "all", "singletons", "none")) {
        expect_no_error(
            pv(df, ~1, index = c("unit", "time"), type = "network",
               show.labels = opt),
            message = paste("show.labels =", opt)
        )
    }
})

# -----------------------------------------------------------------------
# 2.10 Custom node.size
# -----------------------------------------------------------------------

test_that("custom node.size works", {
    skip_if_not_installed("igraph")
    df <- data.frame(unit = c("A", "A", "B"), time = c(1, 2, 1))
    result <- pv(df, ~1, index = c("unit", "time"), type = "network",
                 node.size = 5)
    expect_true(is.list(result))
})

# -----------------------------------------------------------------------
# 2.11 Invalid node.size
# -----------------------------------------------------------------------

test_that("invalid node.size errors", {
    skip_if_not_installed("igraph")
    df <- data.frame(unit = c("A", "A", "B"), time = c(1, 2, 1))
    expect_error(
        pv(df, ~1, index = c("unit", "time"), type = "network", node.size = -1),
        regexp = "node.size"
    )
})

# -----------------------------------------------------------------------
# 3.1 Single Unit, Single Time Period
# -----------------------------------------------------------------------

test_that("single unit single time works", {
    skip_if_not_installed("igraph")
    df <- data.frame(unit = "A", time = 1)
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    expect_equal(igraph::vcount(result$graph), 2)
    expect_equal(igraph::ecount(result$graph), 1)
    expect_equal(result$n_components, 1)
    expect_length(get_singletons(result, "unit"), 1)
    expect_length(get_singletons(result, "time"), 1)
})

# -----------------------------------------------------------------------
# 3.2 All Units Are Singletons
# -----------------------------------------------------------------------

test_that("all singletons case works", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        unit = c("A", "B", "C"),
        time = c(1, 2, 3)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    expect_length(get_singletons(result, "unit"), 3)
    expect_length(get_singletons(result, "time"), 3)
    expect_equal(result$n_components, 3)
})

# -----------------------------------------------------------------------
# 3.5 Numeric Unit and Time IDs
# -----------------------------------------------------------------------

test_that("numeric IDs work", {
    skip_if_not_installed("igraph")
    df <- data.frame(unit = c(1, 1, 2, 2), time = c(2001, 2002, 2001, 2002))
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    expect_true(inherits(result$graph, "igraph"))
    expect_equal(igraph::vcount(result$graph), 4) # 2 units + 2 times
    expect_equal(igraph::ecount(result$graph), 4) # 4 observations
})

# -----------------------------------------------------------------------
# 3.6 Factor Unit IDs
# -----------------------------------------------------------------------

test_that("factor IDs work", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        unit = factor(c("X", "X", "Y", "Y")),
        time = c(1, 2, 1, 2)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    expect_true(inherits(result$graph, "igraph"))
})

# -----------------------------------------------------------------------
# 3.7 Formula with Variables (Not ~1)
# -----------------------------------------------------------------------

test_that("formula with variables works for network", {
    skip_if_not_installed("igraph")
    data(turnout, package = "panelView")
    result <- pv(turnout, turnout ~ policy_edr,
                 index = c("abb", "year"), type = "network")

    expect_true(inherits(result$graph, "igraph"))
    ## Same structure as ~1 — outcome and treatment ignored for network type
    expect_equal(igraph::vcount(result$graph), 47 + 24)
})

# -----------------------------------------------------------------------
# 4.1–4.4 Regression: Existing Types Unaffected
# -----------------------------------------------------------------------

test_that("existing treat type unaffected", {
    data(turnout, package = "panelView")
    expect_no_error(
        pv(turnout, turnout ~ policy_edr, index = c("abb", "year"),
           type = "treat")
    )
})

test_that("existing missing type unaffected", {
    data(turnout, package = "panelView")
    expect_no_error(
        pv(turnout, turnout ~ 1, index = c("abb", "year"),
           type = "missing")
    )
})

test_that("existing outcome type unaffected", {
    data(turnout, package = "panelView")
    expect_no_error(
        pv(turnout, turnout ~ policy_edr, index = c("abb", "year"),
           type = "outcome")
    )
})

test_that("existing bivariate type unaffected", {
    data(turnout, package = "panelView")
    expect_no_error(
        pv(turnout, turnout ~ policy_edr, index = c("abb", "year"),
           type = "bivariate")
    )
})

# -----------------------------------------------------------------------
# 5.1 Graph Structure Invariants (k = 2)
# -----------------------------------------------------------------------

test_that("graph structure invariants hold", {
    skip_if_not_installed("igraph")

    panels <- list(
        data.frame(unit = c("A", "A", "B", "B"),
                   time = c(1, 2, 1, 2)),
        data.frame(unit = c("A", "A", "A", "B", "B", "C"),
                   time = c(1, 2, 3, 1, 2, 4)),
        data.frame(unit = c("X", "Y", "Z"),
                   time = c(10, 20, 30))
    )

    for (i in seq_along(panels)) {
        df <- panels[[i]]
        result <- pv(df, ~1, index = c("unit", "time"), type = "network")
        g <- result$graph

        n_units <- length(unique(df$unit))
        n_times <- length(unique(df$time))

        expect_equal(igraph::vcount(g), n_units + n_times,
                     info = paste("panel", i, "vcount"))
        expect_equal(igraph::ecount(g), nrow(df),
                     info = paste("panel", i, "ecount"))
    }
})

# -----------------------------------------------------------------------
# 5.2 Singleton Identification Is Correct
# -----------------------------------------------------------------------

test_that("singleton identification is correct", {
    skip_if_not_installed("igraph")

    df <- data.frame(
        unit = c("A", "A", "A", "B", "B", "C", "D"),
        time = c(1, 2, 3, 1, 2, 4, 5)
    )
    result <- pv(df, ~1, index = c("unit", "time"), type = "network")

    ## Compute expected singletons from the data
    unit_counts <- table(df$unit)
    time_counts <- table(df$time)

    expected_unit_singletons <- names(unit_counts[unit_counts == 1])
    expected_time_singletons <- as.numeric(names(time_counts[time_counts == 1]))

    ## C and D appear once each
    expect_true(setequal(get_singletons(result, "unit"), expected_unit_singletons))
    ## Times 3, 4, 5 appear once each
    expect_true(setequal(get_singletons(result, "time"), expected_time_singletons))
})

# -----------------------------------------------------------------------
# 6.1 k = 3: Three-way Fixed Effects
# -----------------------------------------------------------------------

test_that("k = 3 tripartite graph works", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        worker = c("A", "A", "B", "B"),
        firm   = c(1, 1, 2, 2),
        year   = c(2020, 2021, 2020, 2021)
    )
    result <- pv(df, ~1, index = c("worker", "firm", "year"), type = "network",
                 show.labels = "all")

    g <- result$graph
    ## 2 workers + 2 firms + 2 years = 6 nodes
    expect_equal(igraph::vcount(g), 6)
    ## Each of 4 observations creates 3 edges (w-f, w-y, f-y)
    ## But some are duplicates that get aggregated:
    ## w-f: A-1, A-1, B-2, B-2 → 2 unique edges (weight 2 each)
    ## w-y: A-2020, A-2021, B-2020, B-2021 → 4 unique edges
    ## f-y: 1-2020, 1-2021, 2-2020, 2-2021 → 4 unique edges
    ## Total unique edges = 2 + 4 + 4 = 10
    expect_equal(igraph::ecount(g), 10)
    expect_equal(result$n_components, 1)

    ## Check singletons is a data frame with FE columns
    expect_true(is.data.frame(result$singletons))
    expect_true("worker" %in% names(result$singletons))
    expect_true("firm" %in% names(result$singletons))

    ## Check multi-edges exist (A-1 and B-2 have weight 2)
    expect_true(nrow(result$multi_edges) > 0)
})

# -----------------------------------------------------------------------
# 6.2 k = 3: Disconnected Components
# -----------------------------------------------------------------------

test_that("k = 3 disconnected components", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        worker = c("A", "B"),
        firm   = c(1, 2),
        year   = c(2020, 2021)
    )
    result <- pv(df, ~1, index = c("worker", "firm", "year"), type = "network")

    ## 2 workers + 2 firms + 2 years = 6 nodes
    expect_equal(igraph::vcount(result$graph), 6)
    ## Each observation creates 3 edges, no overlaps: 2 * 3 = 6
    expect_equal(igraph::ecount(result$graph), 6)
    ## Two isolated triangles
    expect_equal(result$n_components, 2)
})

# -----------------------------------------------------------------------
# 6.3 Duplicate Observations (Multi-edges)
# -----------------------------------------------------------------------

test_that("duplicate observations produce weighted edges", {
    skip_if_not_installed("igraph")
    df <- data.frame(
        w = c("A", "A", "B", "B", "B"),
        f = c(1, 1, 1, 2, 2)
    )
    result <- pv(df, ~1, index = c("w", "f"), type = "network",
                 show.labels = "all")

    g <- result$graph
    ## 2 workers + 2 firms = 4 nodes
    expect_equal(igraph::vcount(g), 4)
    ## Unique edges: A-1 (weight 2), B-1 (weight 1), B-2 (weight 2) = 3
    expect_equal(igraph::ecount(g), 3)

    ## Check multi-edges reported
    expect_true(nrow(result$multi_edges) >= 1)
    ## A-1 should have weight 2
    weights <- igraph::E(g)$weight
    expect_true(max(weights) == 2)
})

# -----------------------------------------------------------------------
# 6.4 Network index validation
# -----------------------------------------------------------------------

test_that("network type rejects invalid index", {
    skip_if_not_installed("igraph")
    df <- data.frame(a = 1, b = 2, c = 3)
    expect_error(
        pv(df, ~1, index = c("a", "nonexistent"), type = "network"),
        regexp = "index"
    )
    ## Single index should also fail
    expect_error(
        pv(df, ~1, index = c("a"), type = "network"),
        regexp = "index"
    )
})

Try the panelView package in your browser

Any scripts or data that you put into this service are public.

panelView documentation built on April 10, 2026, 9:11 a.m.