test-dim_match.R
In mcmodule: Modular Monte Carlo Risk Analysis

suppressMessages({
  test_that("mc_keys for keys works", {
    # Create mock module
    test_module <- list(
      node_list = list(
        test_node = list(
          data_name = "test_data",
          keys = c("key1", "key2")
        )
      ),
      data = list(
        test_data = data.frame(
          key1 = c("A", "B"),
          key2 = c(1, 2),
          value = c(10, 20)
        )
      )
    )

    # Test with specified keys
    result <- mc_keys(test_module, "test_node", c("key1", "key2"))
    expect_equal(ncol(result), 3) # scenario_id + 2 keys
    expect_true(all(c("scenario_id", "key1", "key2") %in% names(result)))

    # Test default scenario_id
    expect_true(all(result$scenario_id == "0"))

    # Test with missing keys
    expect_error(
      mc_keys(test_module, "test_node", c("key1", "nonexistent")),
      "Columns nonexistent not found"
    )

    # Test with invalid node name
    expect_error(
      mc_keys(test_module, "nonexistent_node"),
      "not found"
    )
  })

  test_that("mc_keys for agg_keys works", {
    # Create mock module with aggregated node
    mock_agg_module <- list(
      node_list = list(
        agg_node = list(
          agg_keys = c("group"),
          summary = data.frame(
            group = c("X", "Y"),
            count = c(5, 10)
          ),
          keep_variates = FALSE
        )
      )
    )

    result <- mc_keys(mock_agg_module, "agg_node")
    expect_equal(ncol(result), 2) # scenario_id + group
    expect_true(all(c("scenario_id", "group") %in% names(result)))
  })

  test_that("mc_keys with multiple variates per group exist works", {
    # Create mock module
    test_module <- list(
      node_list = list(
        test_node = list(
          data_name = "test_data",
          keys = c("key1", "key2", "key3")
        )
      ),
      data = list(
        test_data = data.frame(
          key1 = c("A", "B", "A", "B", "A", "B"),
          key2 = c(1, 2, 1, 2, 1, 2),
          key3 = c("red", "green", "yellow", "blue", "orange", "black"),
          value = c(10, 20)
        )
      )
    )

    # Test with specified keys
    expect_message(
      mc_keys(test_module, "test_node", c("key1", "key2")),
      "3 variates per group"
    )
  })

  test_that("mc_keys with NA key works", {
    # Create mock module
    test_module <- list(
      node_list = list(
        test_node = list(
          data_name = "test_data",
          keys = c("key1", "key2", "key3")
        )
      ),
      data = list(
        test_data = data.frame(
          key1 = c("A", "B", "A", "B", "A", "B"),
          key2 = c(NA, NA, NA, NA, NA, NA),
          key3 = c("red", "green", "yellow", "blue", "orange", "black"),
          value = c(10, 20)
        )
      )
    )

    # Test with specified keys
    expect_message(
      mc_keys(test_module, "test_node", c("key1", "key2")),
      "3 variates per group"
    )
  })

  test_that("mc_match group matching works", {
    test_module <- list(
      node_list = list(
        node_x = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(1, 2, 3), type = "0", nvariates = 3),
            max = mcdata(c(2, 3, 4), type = "0", nvariates = 3),
            nvariates = 3
          ),
          data_name = "data_x",
          keys = c("category")
        ),
        node_y = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(5, 6, 7), type = "0", nvariates = 3),
            max = mcdata(c(6, 7, 8), type = "0", nvariates = 3),
            nvariates = 3
          ),
          data_name = "data_y",
          keys = c("category")
        )
      ),
      data = list(
        data_x = data.frame(
          category = c("A", "B", "C")
        ),
        data_y = data.frame(
          category = c("B", "C", "A")
        )
      )
    )

    result <- mc_match(test_module, "node_x", "node_y")

    # Test dimensions
    expect_equal(
      dim(result$node_x_match),
      dim(test_module$node_list$node_x$mcnode)
    )
    expect_equal(
      dim(result$node_y_match),
      dim(test_module$node_list$node_y$mcnode)
    )

    # Test that categories are matched correctly
    expect_equal(result$keys_xy$category, test_module$data$data_x$category)

    # Verify expected keys_xy
    expect_equal(result$keys_xy$category, c("A", "B", "C"))
    expect_equal(result$keys_xy$scenario_id, c("0", "0", "0"))
  })

  test_that("mc_match scenario matching works", {
    test_module <- list(
      node_list = list(
        node_x = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(1, 2, 3, 4), type = "0", nvariates = 4),
            max = mcdata(c(2, 3, 4, 5), type = "0", nvariates = 4),
            nvariates = 4
          ),
          data_name = "data_x",
          keys = c("category")
        ),
        node_y = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(5, 6, 7, 8), type = "0", nvariates = 4),
            max = mcdata(c(6, 7, 8, 9), type = "0", nvariates = 4),
            nvariates = 4
          ),
          data_name = "data_y",
          keys = c("category")
        )
      ),
      data = list(
        data_x = data.frame(
          category = c("A", "B", "A", "B"),
          scenario_id = c("0", "0", "1", "1")
        ),
        data_y = data.frame(
          category = c("A", "B", "A", "B"),
          scenario_id = c("0", "0", "2", "2")
        )
      )
    )

    result <- mc_match(test_module, "node_x", "node_y")

    # Check scenario matching logic
    expect_equal(nrow(result$keys_xy), 6)

    # Verify dimensions of matched nodes
    expect_equal(dim(result$node_x_match)[2], dim(result$node_y_match)[2])

    # Verify expected keys_xy
    expect_equal(result$keys_xy$category, c("A", "B", "A", "B", "A", "B"))
    expect_equal(result$keys_xy$scenario_id, c("0", "0", "1", "1", "2", "2"))
  })

  test_that("mc_match null matching works", {
    test_module <- list(
      node_list = list(
        node_x = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(1, 2, 3), type = "0", nvariates = 3),
            max = mcdata(c(2, 3, 4), type = "0", nvariates = 3),
            nvariates = 3
          ),
          data_name = "data_x",
          keys = c("category")
        ),
        node_y = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(5, 6, 7), type = "0", nvariates = 3),
            max = mcdata(c(6, 7, 8), type = "0", nvariates = 3),
            nvariates = 3
          ),
          data_name = "data_y",
          keys = c("category")
        )
      ),
      data = list(
        data_x = data.frame(
          category = c("A", "B", "C"),
          scenario_id = c("0", "0", "0")
        ),
        data_y = data.frame(
          category = c("B", "B", "B"),
          scenario_id = c("0", "1", "2")
        )
      )
    )

    result <- mc_match(test_module, "node_x", "node_y")

    # Verify dimensions of matched nodes
    expect_equal(dim(result$node_x_match)[2], dim(result$node_y_match)[2])

    # Verify expected keys_xy
    expect_equal(result$keys_xy$category, c("A", "B", "C", "B", "B"))
    expect_equal(result$keys_xy$scenario_id, c("0", "0", "0", "1", "2"))
  })

  test_that("wif_match works", {
    # Test data
    x <- data.frame(
      category = c("a", "b", "a", "b"),
      scenario_id = c(0, 0, 1, 1),
      value = 1:4
    )

    y <- data.frame(
      category = c("a", "b", "a", "b"),
      scenario_id = c(0, 0, 2, 2),
      value = 5:8
    )

    # Automatic matching
    result <- wif_match(x, y)
    expect_equal(result$x$scenario_id, result$y$scenario_id)
    expect_equal(result$x$scenario_id, c(0, 0, 1, 1, 2, 2))
    expect_equal(result$x$value, c(1, 2, 3, 4, 1, 2))
    expect_equal(result$y$value, c(5, 6, 5, 6, 7, 8))

    # Match by type
    result_by <- wif_match(x, y, "category")
    expect_equal(result_by$x$scenario_id, result_by$y$scenario_id)

    # Test error on unmatched groups
    y_bad <- data.frame(
      category = c("a", "c", "a", "c"),
      scenario_id = c(0, 0, 2, 2),
      value = 5:8
    )
    expect_error(wif_match(x, y_bad), "Groups not found")
    expect_error(wif_match(x, y_bad, "category"), "Groups not found")
  })

  test_that("mc_match of agg_nodes works", {
    #  Create previous_module
    previous_module <- eval_module(
      exp = c(imports = imports_exp),
      data = imports_data,
      mctable = imports_mctable,
      data_keys = imports_data_keys
    )

    #  Create current_module
    current_data <- data.frame(
      pathogen = c("a", "b", "a", "b"),
      origin = c("nord", "nord", "nord", "nord"),
      scenario_id = c("0", "0", "no_product_imports", "no_product_imports"),
      contaminated = c(0.1, 0.5, 0.1, 0.5),
      imported = c(1, 1, 0.1, 0.1),
      products_n = c(1500, 1500, 0, 0)
    )

    current_data_keys <- list(
      current_data = list(
        cols = names(current_data),
        keys = c("pathogen", "origin", "scenario_id")
      )
    )

    current_mctable <- data.frame(
      mcnode = c("contaminated", "imported", "products_n"),
      description = c(
        "Probability a product is contaminated",
        "Probability a product is imported",
        "Number of products"
      ),
      mc_func = c(NA, NA, NA),
      from_variable = c(NA, NA, NA),
      transformation = c(NA, NA, NA),
      sensi_analysis = c(FALSE, FALSE, FALSE)
    )
    current_exp <- quote({
      imported_contaminated <- contaminated * imported
    })

    current_module <- eval_module(
      exp = c(current = current_exp),
      data = current_data,
      mctable = current_mctable,
      data_keys = current_data_keys
    )

    # Combine modules
    module <- combine_modules(previous_module, current_module)

    # Match output nodes in both modules
    no_detect_a_keys <- mc_keys(mcmodule = module, mc_name = "no_detect_a")
    expect_equal(
      names(no_detect_a_keys),
      c("scenario_id", "pathogen", "origin")
    )
    expect_equal(dim(no_detect_a_keys), c(6, 3))

    imported_contaminated_keys <- mc_keys(
      mcmodule = module,
      mc_name = "imported_contaminated"
    )
    expect_equal(
      names(imported_contaminated_keys),
      c("scenario_id", "pathogen", "origin")
    )
    expect_equal(dim(imported_contaminated_keys), c(4, 3))

    result <- mc_match(module, "no_detect_a", "imported_contaminated")
    expect_equal(result$keys_xy$g_row.y, c(1, NA, NA, 2, NA, NA, 3, 4))

    # Aggregate imported_contaminated
    module <- agg_totals(module, "imported_contaminated")
    imported_contaminated_agg_keys <- mc_keys(
      mcmodule = module,
      mc_name = "imported_contaminated_agg"
    )

    expect_equal(names(imported_contaminated_agg_keys), c("scenario_id"))
    expect_equal(dim(imported_contaminated_agg_keys), c(2, 1))

    result <- mc_match(module, "no_detect_a", "imported_contaminated_agg")
    expect_equal(result$keys_xy$g_row.x, c(1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6))
    expect_equal(result$keys_xy$g_row.y, c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2))

    # Aggregate no_detect_a
    module <- agg_totals(module, "no_detect_a")
    no_detect_a_agg_keys <- mc_keys(
      mcmodule = module,
      mc_name = "no_detect_a_agg"
    )

    expect_equal(names(no_detect_a_agg_keys), c("scenario_id"))
    expect_equal(dim(no_detect_a_agg_keys), c(1, 1))

    result <- mc_match(module, "no_detect_a_agg", "imported_contaminated_agg")
    expect_equal(result$keys_xy$g_row.y, c(1, 2))

    # Match mcnodes already matching
    test_sensi_keys <- mc_keys(mcmodule = module, mc_name = "test_sensi")

    result <- mc_match(module, "no_detect_a", "test_sensi")
    expect_equal(result$keys_xy$g_row.y, c(1, 2, 3, 4, 5, 6))
  })

  test_that("mc_match_data works", {
    # Create test data
    test_data <- data.frame(
      pathogen = c("a", "b"),
      inf_dc_min = c(0.05, 0.3),
      inf_dc_max = c(0.08, 0.4)
    )

    result <- mc_match_data(imports_mcmodule, "no_detect_a", test_data)

    # Check dimensions
    expect_equal(dim(result$test_data_match), c(6, 4))

    # Check new keys column names are included in the result
    expect_true(all(c("pathogen", "origin") %in% names(result$test_data_match)))
    expect_true(all(c("pathogen", "origin") %in% names(result$keys_xy)))

    # Check row number
    expect_equal(result$keys_xy$g_row.y, c(1, 1, 1, 2, 2, 2))
  })

  test_that("mc_match_data works with custom keys_names", {
    # Create test data
    test_data <- data.frame(
      pathogen = c("a", "b", "a", "b"),
      origin = c("nord", "nord", "nord", "nord"),
      scenario_id = c("0", "0", "no_product_imports", "no_product_imports"),
      contaminated = c(0.1, 0.5, 0.1, 0.5),
      imported = c(1, 1, 0.1, 0.1),
      products_n = c(1500, 1500, 0, 0)
    )

    result_default <- mc_match_data(imports_mcmodule, "no_detect_a", test_data)
    result_custom <- mc_match_data(
      imports_mcmodule,
      "no_detect_a",
      test_data,
      keys_names = c("pathogen")
    )

    # Check dimensions
    expect_equal(dim(result_default$test_data_match), c(8, 6))
    expect_equal(dim(result_custom$test_data_match), c(12, 6))

    # Check new keys column names are included in the result
    expect_true(all(c("pathogen", "origin") %in% names(result_default$keys_xy)))
    expect_true(!"origin" %in% names(result_custom$keys_xy))

    # Check row number
    expect_equal(result_default$keys_xy$g_row.y, c(1, NA, NA, 2, NA, NA, 3, 4))
    expect_equal(
      result_custom$keys_xy$g_row.y,
      c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4)
    )
  })

  test_that("mc_match errors when baseline scenario '0' is missing key combinations", {
    bad_module <- list(
      node_list = list(
        node_x = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(1, 2), type = "0", nvariates = 2),
            max = mcdata(c(2, 3), type = "0", nvariates = 2),
            nvariates = 2
          ),
          data_name = "data_x",
          keys = c("category")
        ),
        node_y = list(
          mcnode = mcstoc(
            runif,
            min = mcdata(c(5, 6), type = "0", nvariates = 2),
            max = mcdata(c(6, 7), type = "0", nvariates = 2),
            nvariates = 2
          ),
          data_name = "data_y",
          keys = c("category")
        )
      ),
      data = list(
        # baseline has only A in scenario "0"
        data_x = data.frame(category = c("A", "B"), scenario_id = c("0", "0")),
        # B appears only in scenario "1" (missing from baseline)
        data_y = data.frame(category = c("A", "B"), scenario_id = c("0", "1"))
      )
    )
    expect_error(
      mc_match(bad_module, "node_x", "node_y"),
      "Baseline scenario '0' missing key combinations"
    )
  })
})