test_that("caugi_layout works with simple DAG", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) layout <- caugi_layout(cg) expect_s3_class(layout, "data.frame") expect_equal(nrow(layout), 4L) expect_named(layout, c("name", "x", "y")) expect_equal(layout$name, c("A", "B", "C", "D")) expect_type(layout$x, "double") expect_type(layout$y, "double") }) test_that("caugi_layout works with single node", { cg <- caugi(A, class = "DAG") layout <- caugi_layout(cg) expect_s3_class(layout, "data.frame") expect_equal(nrow(layout), 1L) expect_equal(layout$name, "A") }) test_that("plot.caugi runs without error", { cg <- caugi( A %-->% B + C, B %-->% D, class = "DAG" ) # Open a null graphics device to avoid opening windows during tests pdf(NULL) on.exit(dev.off()) expect_s7_class(plot(cg), caugi_plot) }) test_that("plot.caugi accepts node_style arguments", { cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot( cg, node_style = list(fill = "lightgreen", padding = 0.8) ), caugi_plot ) }) test_that("plot.caugi accepts local node_style arguments", { cg <- caugi(A %-->% B + C) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot( cg, node_style = list( by_node = list( A = list(fill = "lightblue", col = "darkblue", lwd = 2), B = list(fill = "red") ) ) ), caugi_plot ) }) test_that("plot.caugi accepts edge_style arguments", { cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot( cg, edge_style = list(col = "blue", arrow_size = 4) ), caugi_plot ) }) test_that("plot.caugi accepts local edge_style arguments", { cg <- caugi(A %-->% B + C) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot( cg, edge_style = list( by_edge = list( A = list( # Node-wide settings for A col = "red", lwd = 5 ) ) ) ), caugi_plot ) expect_s7_class( plot( cg, edge_style = list( by_edge = list( A = list( # Node-wide settings for A col = "red", lwd = 5, B = list( # Specific edge overwrite A -> B col = "blue", lwd = 4 ) ) ) ) ), caugi_plot ) expect_s7_class( plot( cg, edge_style = list( by_edge = list( # Node-wide settings for A A = list( col = "red", lwd = 5 ), # Specific edge overwrite also works for BA B = list( A = list( col = "blue", lwd = 4 ) ) ) ) ), caugi_plot ) expect_s7_class( plot( cg, edge_style = list( by_edge = list( # Node-wide settings for B, A -> C uses global settings B = list( col = "red", lwd = 5 ) ) ) ), caugi_plot ) }) test_that("plot.caugi works with single node", { cg <- caugi(A, class = "DAG") pdf(NULL) on.exit(dev.off()) expect_s7_class(plot(cg), caugi_plot) }) test_that("plot.caugi builds graph if needed", { cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off()) expect_s7_class(plot(cg), caugi_plot) }) test_that("plot.caugi applies margins and title padding", { cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off()) p <- plot(cg, main = "Title") graph <- grid::getGrob(p@grob, "caugi.graph") layout <- graph$vp[[1]]$layout margin_widths <- grid::convertWidth( layout$widths[c(1, 3)], "mm", valueOnly = TRUE ) expect_true(all(margin_widths > 0)) expect_equal(margin_widths[1], margin_widths[2]) top_bottom_margins <- grid::convertHeight( layout$heights[c(1, 5)], "mm", valueOnly = TRUE ) expect_true(all(top_bottom_margins > 0)) expect_equal(top_bottom_margins[1], top_bottom_margins[2]) expect_gt( grid::convertHeight(layout$heights[[2]], "mm", valueOnly = TRUE), 0 ) expect_gt( grid::convertHeight(layout$heights[[3]], "mm", valueOnly = TRUE), 0 ) }) test_that("plot.caugi omits title spacing when main is NULL", { cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off()) p <- plot(cg) graph <- grid::getGrob(p@grob, "caugi.graph") layout <- graph$vp[[1]]$layout expect_equal( grid::convertHeight(layout$heights[[2]], "mm", valueOnly = TRUE), 0 ) expect_equal( grid::convertHeight(layout$heights[[3]], "mm", valueOnly = TRUE), 0 ) }) test_that("caugi_layout works with fruchterman-reingold method", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) layout <- caugi_layout(cg, method = "fruchterman-reingold") expect_s3_class(layout, "data.frame") expect_equal(nrow(layout), 4L) expect_named(layout, c("name", "x", "y")) expect_equal(layout$name, c("A", "B", "C", "D")) expect_type(layout$x, "double") expect_type(layout$y, "double") expect_true(all(is.finite(layout$x))) expect_true(all(is.finite(layout$y))) }) test_that("fruchterman-reingold layout works with mixed edge types", { cg <- caugi( A %-->% B, B %---% C, C %<->% D ) layout <- caugi_layout(cg, method = "fruchterman-reingold") expect_s3_class(layout, "data.frame") expect_equal(nrow(layout), 4L) expect_true(all(is.finite(layout$x))) expect_true(all(is.finite(layout$y))) }) test_that("sugiyama layout rejects mixed edge types", { cg <- caugi( A %-->% B, B %---% C ) expect_error(caugi_layout(cg, method = "sugiyama")) }) test_that("plot.caugi works with fruchterman-reingold layout", { cg <- caugi( A %-->% B + C, B %-->% D, class = "DAG" ) pdf(NULL) on.exit(dev.off()) expect_s7_class(plot(cg, layout = "fruchterman-reingold"), caugi_plot) }) test_that("auto method selects sugiyama for directed-only graphs", { cg <- caugi( A %-->% B %-->% C, class = "DAG" ) layout_auto <- caugi_layout(cg, method = "auto") layout_sug <- caugi_layout(cg, method = "sugiyama") # Auto should produce same result as sugiyama for directed-only graphs expect_equal(layout_auto, layout_sug) }) test_that("auto method selects fruchterman-reingold for mixed edge graphs", { cg <- caugi( A %-->% B, B %---% C ) # Auto should work (selecting fruchterman-reingold internally) layout_auto <- caugi_layout(cg, method = "auto") expect_s3_class(layout_auto, "data.frame") expect_equal(nrow(layout_auto), 3L) # Sugiyama should fail expect_error(caugi_layout(cg, method = "sugiyama")) }) test_that("plot with auto layout works", { # Test with directed-only cg_dir <- caugi(A %-->% B %-->% C, class = "DAG") pdf(NULL) on.exit(dev.off()) expect_s7_class(plot(cg_dir, layout = "auto"), caugi_plot) # Test with mixed edges cg_mixed <- caugi(A %-->% B, B %---% C) expect_s7_class(plot(cg_mixed, layout = "auto"), caugi_plot) }) test_that("auto is the default method", { cg <- caugi(A %-->% B, class = "DAG") # Default should work without specifying method layout_default <- caugi_layout(cg) expect_s3_class(layout_default, "data.frame") pdf(NULL) on.exit(dev.off()) # Default should work for plot too expect_s7_class(plot(cg), caugi_plot) }) test_that("kamada-kawai layout works with simple DAG", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) layout <- caugi_layout(cg, method = "kamada-kawai") expect_s3_class(layout, "data.frame") expect_equal(nrow(layout), 4L) expect_named(layout, c("name", "x", "y")) expect_equal(layout$name, c("A", "B", "C", "D")) expect_type(layout$x, "double") expect_type(layout$y, "double") expect_true(all(is.finite(layout$x))) expect_true(all(is.finite(layout$y))) }) test_that("kamada-kawai layout is deterministic", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) layout1 <- caugi_layout(cg, method = "kamada-kawai") layout2 <- caugi_layout(cg, method = "kamada-kawai") layout3 <- caugi_layout(cg, method = "kamada-kawai") # All three should be identical expect_identical(layout1, layout2) expect_identical(layout2, layout3) }) test_that("caugi_options can be queried", { opts <- caugi_options() expect_type(opts, "list") expect_true("plot" %in% names(opts)) expect_type(opts$plot, "list") }) test_that("caugi_options can set and get plot spacing", { old_opts <- caugi_options() on.exit(caugi_options(old_opts)) # Set new spacing caugi_options(plot = list(spacing = grid::unit(2, "lines"))) # Verify it was set opts <- caugi_options() expect_s3_class(opts$plot$spacing, "unit") expect_equal(as.numeric(opts$plot$spacing), 2) }) test_that("caugi_options can set node_style defaults", { old_opts <- caugi_options() on.exit(caugi_options(old_opts)) # Set node style caugi_options( plot = list( node_style = list(fill = "lightblue", padding = 3) ) ) opts <- caugi_options() expect_equal(opts$plot$node_style$fill, "lightblue") expect_equal(opts$plot$node_style$padding, 3) }) test_that("caugi_options can set edge_style defaults", { old_opts <- caugi_options() on.exit(caugi_options(old_opts)) # Set edge style caugi_options( plot = list( edge_style = list(arrow_size = 5, fill = "darkgray") ) ) opts <- caugi_options() expect_equal(opts$plot$edge_style$arrow_size, 5) expect_equal(opts$plot$edge_style$fill, "darkgray") }) test_that("plot respects global node_style options", { old_opts <- caugi_options() on.exit(caugi_options(old_opts)) # Set global node style caugi_options( plot = list( node_style = list(fill = "lightblue") ) ) cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off(), add = TRUE) p <- plot(cg) expect_s7_class(p, caugi_plot) # Verify grob was created (basic check that options didn't break plotting) expect_true(!is.null(p@grob)) }) test_that("plot arguments override global options", { old_opts <- caugi_options() on.exit(caugi_options(old_opts)) # Set global node style caugi_options( plot = list( node_style = list(fill = "lightblue") ) ) cg <- caugi(A %-->% B) pdf(NULL) on.exit(dev.off(), add = TRUE) # Override with argument p <- plot(cg, node_style = list(fill = "pink")) expect_s7_class(p, caugi_plot) }) test_that("plot.caugi renders o-> edges with circles", { cg <- caugi(A %o->% B, class = "UNKNOWN") pdf(NULL) on.exit(dev.off()) # Test that plot completes without error and renders circles expect_s7_class(plot(cg), caugi_plot) }) test_that("plot.caugi renders o-o edges with circles on both ends", { cg <- caugi(A %o-o% B, class = "UNKNOWN") pdf(NULL) on.exit(dev.off()) # Test that plot completes without error and renders circles expect_s7_class(plot(cg), caugi_plot) }) test_that("plot.caugi accepts circle_size for partial edges", { cg <- caugi(A %o->% B, B %o-o% C, class = "UNKNOWN") pdf(NULL) on.exit(dev.off()) # Test that custom circle_size is accepted p <- plot( cg, edge_style = list( partial = list(circle_size = 2.5) ) ) expect_s7_class(p, caugi_plot) }) test_that("plot.caugi with mixed edge types including partial", { cg <- caugi( A %-->% B, B %o->% C, C %o-o% D, class = "UNKNOWN" ) pdf(NULL) on.exit(dev.off()) # Test that mixed edge types render correctly expect_s7_class(plot(cg), caugi_plot) }) test_that("caugi_layout handles disconnected components", { # Single isolated node cg1 <- caugi( A %-->% B + C, D ) layout1 <- caugi_layout(cg1, method = "fruchterman-reingold") expect_s3_class(layout1, "data.frame") expect_equal(nrow(layout1), 4L) expect_true(all(is.finite(layout1$x))) expect_true(all(is.finite(layout1$y))) # Multiple disconnected components cg2 <- caugi( A %-->% B, C %-->% D, E ) layout2 <- caugi_layout(cg2, method = "kamada-kawai") expect_s3_class(layout2, "data.frame") expect_equal(nrow(layout2), 5L) expect_true(all(is.finite(layout2$x))) expect_true(all(is.finite(layout2$y))) # Sugiyama with disconnected components layout3 <- caugi_layout(cg1, method = "sugiyama") expect_s3_class(layout3, "data.frame") expect_equal(nrow(layout3), 4L) expect_true(all(is.finite(layout3$x))) expect_true(all(is.finite(layout3$y))) }) test_that("plot.caugi renders disconnected components", { cg <- caugi( A %-->% B + C, D, E %-->% F ) pdf(NULL) on.exit(dev.off()) # Should work with all layout methods expect_s7_class(plot(cg, layout = "fruchterman-reingold"), caugi_plot) expect_s7_class(plot(cg, layout = "kamada-kawai"), caugi_plot) expect_s7_class(plot(cg, layout = "sugiyama"), caugi_plot) expect_s7_class(plot(cg, layout = "auto"), caugi_plot) }) test_that("plot.caugi asp parameter works", { cg <- caugi(A %-->% B + C, B %-->% D, class = "DAG") pdf(NULL) on.exit(dev.off()) # asp = NULL should work (automatic aspect ratio) expect_s7_class(plot(cg, asp = NULL), caugi_plot) # asp = NA should work (automatic aspect ratio) expect_s7_class(plot(cg, asp = NA), caugi_plot) # asp = 1 should work (equal aspect ratio) expect_s7_class(plot(cg, asp = 1), caugi_plot) # asp = 2 should work (y-axis twice as tall) expect_s7_class(plot(cg, asp = 2), caugi_plot) # asp = 0.5 should work (x-axis twice as wide) expect_s7_class(plot(cg, asp = 0.5), caugi_plot) }) # ────────────────────────────────────────────────────────────────────────────── # ─────────────────────────── Tiered plotting ────────────────────────────────── # ────────────────────────────────────────────────────────────────────────────── test_that("plot with tiers as data.frame works", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) tiers_df <- data.frame( name = c("A", "B", "C", "D"), tier = c(1, 2, 2, 3) ) pdf(NULL) on.exit(dev.off()) expect_s7_class(plot(cg, tiers = tiers_df), caugi_plot) }) test_that("plot with tiers orientation='columns' works", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) tiers_list <- list( tier1 = "A", tier2 = c("B", "C"), tier3 = "D" ) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot(cg, tiers = tiers_list, orientation = "columns"), caugi_plot ) }) test_that("plot with tier_style and label_style works", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) tiers_list <- list( tier1 = "A", tier2 = c("B", "C"), tier3 = "D" ) tier_style <- list( global = list( labels = c("Input", "Middle", "Output"), label_style = list(col = "red", fontsize = 12) ), by_tier = list( tier1 = list( label_style = list(col = "blue", fontsize = 14) ) ) ) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot( cg, tiers = tiers_list, tier_style = tier_style ), caugi_plot ) }) test_that("plot with tiers orientation='rows' and labels works", { cg <- caugi( A %-->% B + C, B %-->% D, C %-->% D, class = "DAG" ) tiers_list <- list( tier1 = "A", tier2 = c("B", "C"), tier3 = "D" ) tier_style <- list( global = list( labels = c("Input", "Middle", "Output") ) ) pdf(NULL) on.exit(dev.off()) expect_s7_class( plot( cg, tiers = tiers_list, orientation = "rows", tier_style = tier_style ), caugi_plot ) }) test_that("plot nodes without labels uses nullGrob", { cg <- caugi( A %-->% B, class = "DAG" ) pdf(NULL) on.exit(dev.off()) # Plot without node labels p <- plot(cg, node_style = list(label = FALSE)) expect_s7_class(p, caugi_plot) }) test_that("plot renders o-> edge circles at tail", { cg <- caugi(A %o->% B, class = "UNKNOWN") pdf(NULL) on.exit(dev.off()) # Test with custom circle size p <- plot(cg, edge_style = list(partial = list(circle_size = 3))) expect_s7_class(p, caugi_plot) }) test_that("plot renders o-o edge circles at both ends", { cg <- caugi(A %o-o% B, class = "UNKNOWN") pdf(NULL) on.exit(dev.off()) # Test that circles render at both ends p <- plot(cg) expect_s7_class(p, caugi_plot) # Test with custom circle size p2 <- plot(cg, edge_style = list(partial = list(circle_size = 2))) expect_s7_class(p2, caugi_plot) }) test_that("plot handles self-loop edges for circle rendering", { # Create a graph with a self-loop (zero-length edge case) cg <- caugi( A %o->% A, class = "UNKNOWN", simple = FALSE ) pdf(NULL) on.exit(dev.off()) # This should trigger the zero-length edge path expect_s7_class(plot(cg), caugi_plot) }) test_that("plot-grobs internal branches are covered", { # n_tiers == 0 branch coords0 <- data.frame(name = character(), x = numeric(), y = numeric()) tier_style <- list( global = list( boxes = TRUE, labels = character(0), padding = grid::unit(1, "mm"), fill = "grey95", col = "grey70", lwd = 1, lty = 1, alpha = 1, label_style = list(col = "black", fontsize = 9) ), by_tier = list() ) tiers0 <- caugi:::make_tiers( circle_grobs = grid::gList(), coords = coords0, tiers = list(), tier_style = tier_style, orientation = "rows" ) expect_true(length(tiers0$grobs) >= 1L) # Recycled labels + empty tier skip branch coords <- data.frame(name = c("A", "B"), x = c(0.2, 0.8), y = c(0.5, 0.5)) circles <- grid::gList( grid::circleGrob( x = grid::unit(0.2, "npc"), y = grid::unit(0.5, "npc"), r = grid::unit(1, "mm") ), grid::circleGrob( x = grid::unit(0.8, "npc"), y = grid::unit(0.5, "npc"), r = grid::unit(1, "mm") ) ) tier_style$global$labels <- c("Tier") tiers_gap <- c(A = 0L, B = 2L) tiers_gap_out <- caugi:::make_tiers( circle_grobs = circles, coords = coords, tiers = tiers_gap, tier_style = tier_style, orientation = "rows" ) expect_true(length(tiers_gap_out$grobs) >= 1L) # make_nodes() branch where labels are omitted -> nullGrob labels node_style <- list( global = list(fill = "white", col = "black", lwd = 1, size = 1), by_node = list() ) label_style <- list(col = "black", fontsize = 10) nodes_out <- caugi:::make_nodes( coords = data.frame(name = "A", x = 0.5, y = 0.5), labels = character(0), node_style = node_style, label_style = label_style ) expect_s3_class(nodes_out$label_grobs[[1]], "null") # Zero-length edge branches (including o-> and o-o circles). pdf(NULL) on.exit(dev.off(), add = TRUE) grid::grid.newpage() grid::pushViewport(grid::viewport(xscale = c(0, 1), yscale = c(0, 1))) eg_o_to <- caugi:::make_edge_grob( x0 = 0.5, y0 = 0.5, x1 = 0.5, y1 = 0.5, r_from = grid::unit(1, "mm"), r_to = grid::unit(1, "mm"), edge_type = "o->", circle_size = 2 ) c1 <- caugi:::makeContent.caugi_edge_grob(eg_o_to) expect_equal(length(c1$children), 2L) eg_o_o <- caugi:::make_edge_grob( x0 = 0.5, y0 = 0.5, x1 = 0.5, y1 = 0.5, r_from = grid::unit(1, "mm"), r_to = grid::unit(1, "mm"), edge_type = "o-o", circle_size = 2 ) c2 <- caugi:::makeContent.caugi_edge_grob(eg_o_o) expect_equal(length(c2$children), 3L) }) test_that("plotting empty graph gives clear error", { cg_empty <- caugi(class = "DAG") expect_error( plot(cg_empty), "Cannot plot an empty graph \\(0 nodes\\)\\." ) }) test_that("plot layout validation branch is covered", { cg <- caugi( from = LETTERS[1:7], edge = rep("-->", 7), to = LETTERS[2:8], class = "DAG" ) bad_layout <- data.frame( name = rep("A", 8), x = seq(0, 1, length.out = 8), y = seq(0, 1, length.out = 8) ) expect_error( plot(cg, layout = bad_layout), "and 2 more" ) })