tests/testthat/test-eval_module.R

In mcmodule: Modular Monte Carlo Risk Analysis

suppressMessages({
  test_that("eval_module works", {
    # Test basic functionality
    result <- eval_module(
      exp = c(imports = imports_exp),
      data = imports_data,
      mctable = imports_mctable,
      data_keys = imports_data_keys
    )

    # Check class and structure
    expect_equal(class(result), "mcmodule")
    expect_true(all(
      c("data", "exp", "node_list", "modules") %in% names(result)
    ))

    # Test error handling for missing prev_mcmodule
    test_exp_prev <- quote({
      result <- prev_value * 2
    })
    expect_error(
      eval_module(
        exp = test_exp_prev,
        data = imports_data,
        mctable = imports_mctable,
        data_keys = imports_data_keys
      ),
      "prev_mcmodule.*needed but not provided"
    )

    # Test with multiple expressions
    exp_list <- list(
      imports = imports_exp,
      additional = quote({
        final_result <- no_detect_a * 2
      })
    )

    multi_result <- eval_module(
      exp = exp_list,
      data = imports_data,
      mctable = imports_mctable,
      data_keys = imports_data_keys
    )

    # Verify multiple modules were created
    expect_equal(multi_result$modules, c("imports", "additional"))

    # Check that variables from first module are available in second
    expect_true("no_detect_a" %in% names(multi_result$node_list))
    expect_true("final_result" %in% names(multi_result$node_list))

    # Check that inputs have the right metadata
    expect_equal(multi_result$node_list$test_sensi$keys, c("pathogen"))
    expect_equal(
      multi_result$node_list$test_sensi$input_dataset,
      c("test_sensitivity")
    )

    expect_equal(multi_result$node_list$w_prev$keys, c("pathogen", "origin"))
    expect_equal(
      multi_result$node_list$w_prev$input_dataset,
      c("prevalence_region")
    )

    # Check that outputs have the right metadata
    expect_equal(
      multi_result$node_list$no_detect_a$keys,
      c("pathogen", "origin")
    )
    expect_equal(
      multi_result$node_list$no_detect_a$inputs,
      c("false_neg_a", "no_test_a")
    )

    expect_equal(
      multi_result$node_list$final_result$keys,
      c("pathogen", "origin")
    )
    expect_equal(multi_result$node_list$final_result$inputs, c("no_detect_a"))
  })

  test_that("eval_module gets previous nodes", {
    #  Create previous_module
    previous_module <- eval_module(
      exp = c(imports = imports_exp),
      data = imports_data,
      mctable = imports_mctable,
      data_keys = imports_data_keys
    )

    previous_module <- trial_totals(
      previous_module,
      mc_names = "no_detect_a",
      trials_n = "animals_n",
      subsets_n = "farms_n",
      subsets_p = "h_prev",
      mctable = imports_mctable
    )

    #  Create current_module
    current_data <- data.frame(
      pathogen = c("a", "a", "a", "b", "b", "b", "b"),
      origin = c("east", "south", "nord", "east", "south", "nord", "nord"),
      clean = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE),
      scenario_id = c("0", "0", "0", "0", "0", "0", "clean_transport"),
      survival_p_min = c(0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.1),
      survival_p_max = c(0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.15)
    )

    current_data_keys <- list(
      survival = list(
        cols = c("pathogen", "clean", "survival_p_min", "survival_p_max"),
        keys = c("pathogen", "clean")
      )
    )

    current_mctable <- data.frame(
      mcnode = c("survival_p"),
      description = c("Survival probability"),
      mc_func = c("runif"),
      from_variable = c(NA),
      transformation = c(NA),
      sensi_analysis = c(FALSE)
    )
    current_exp <- quote({
      imported_contaminated <- no_detect_a_set * survival_p
    })

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

    combined_module <- combine_modules(previous_module, current_module)

    combined_module <- at_least_one(
      combined_module,
      c("no_detect_a", "imported_contaminated"),
      name = "total"
    )

    expect_equal(
      combined_module$node_list$no_detect_a$keys,
      c("pathogen", "origin")
    )
    summary1 <- mc_summary(combined_module, "no_detect_a_set")
    expect_equal(summary1$pathogen, c("a", "a", "a", "b", "b", "b"))

    expect_equal(
      combined_module$node_list$survival_p$keys,
      c("pathogen", "clean")
    )
    expect_equal(
      combined_module$node_list$survival_p$input_dataset,
      c("survival")
    )
    summary2 <- mc_summary(combined_module, "survival_p")
    expect_equal(summary2$pathogen, c("a", "a", "a", "b", "b", "b", "b"))

    expect_equal(
      combined_module$node_list$imported_contaminated$keys,
      c("pathogen", "origin", "clean")
    ) # union
    summary3 <- mc_summary(combined_module, "imported_contaminated")
    expect_equal(summary3$scenario_id, c(0, 0, 0, 0, 0, 0, "clean_transport"))

    expect_equal(
      combined_module$node_list$total$keys,
      c("scenario_id", "pathogen", "origin")
    ) # intersection
    expect_message(
      mc_summary(combined_module, "total"),
      "Too many data names. Using existing summary."
    )
  })

  test_that("get_mcmodule_nodes works", {
    # Create test data
    test_node <- list(mcnode = "test_value")
    test_node_list <- list(
      node1 = list(mcnode = "value1"),
      node2 = list(mcnode = "value2")
    )
    class(test_node_list) <- "mcnode_list"

    test_mcmodule <- list(node_list = test_node_list)
    class(test_mcmodule) <- "mcmodule"

    # Test with mcmodule object
    result1 <- get_mcmodule_nodes(test_mcmodule, c("node1"))
    expect_equal(length(result1), 1)
    expect_equal(result1$node1$mcnode, "value1")

    # Test with mcnode_list object
    result2 <- get_mcmodule_nodes(test_node_list, c("node2"))
    expect_equal(length(result2), 1)
    expect_equal(result2$node2$mcnode, "value2")

    # Test with invalid input
    expect_error(get_mcmodule_nodes("invalid"))

    # Test with non-existent nodes
    result3 <- get_mcmodule_nodes(test_mcmodule, c("non_existent"))
    expect_equal(length(result3), 0)

    # Test with no nodes specified
    result4 <- get_mcmodule_nodes(test_mcmodule)
    expect_equal(length(result4), 0)
  })

  test_that("eval_mcmodule dim match works", {
    #  Create pathogen data table
    transmission_data <- data.frame(
      pathogen = c("a", "b"),
      inf_dc_min = c(0.05, 0.3),
      inf_dc_max = c(0.08, 0.4)
    )

    transmission_data_keys <- list(
      transmission_data = list(
        cols = c("pathogen", "inf_dc_min", "inf_dc_max"),
        keys = c("pathogen")
      )
    )

    transmission_mctable <- data.frame(
      mcnode = c("inf_dc"),
      description = c("Probability of infection via direct contact"),
      mc_func = c("runif"),
      from_variable = c(NA),
      transformation = c(NA),
      sensi_analysis = c(FALSE)
    )

    # Test expression
    transmission_exp <- quote({
      infection_risk <- no_detect_a * inf_dc
    })

    # Evaluate module with previous module
    result_module <- eval_module(
      exp = c(transmission = transmission_exp),
      data = transmission_data,
      mctable = transmission_mctable,
      data_keys = transmission_data_keys,
      prev_mcmodule = imports_mcmodule
    )

    # Verify dimensions
    expect_equal(dim(result_module$node_list$no_detect_a$mcnode)[3], 6)
    expect_equal(dim(result_module$node_list$infection_risk$mcnode)[3], 6)

    # Verify keys are correctly combined
    expect_equal(
      result_module$node_list$infection_risk$keys,
      c("pathogen", "origin")
    )

    # Verify input tracking
    expect_equal(
      result_module$node_list$infection_risk$inputs,
      c("no_detect_a", "inf_dc")
    )

    # Verify no null matches in the dimension matching process
    summary <- mc_summary(result_module, "infection_risk")
    expect_equal(nrow(summary), 6)
    expect_true(all(c("pathogen", "origin") %in% names(summary)))
  })

  test_that("eval_mcmodule dim match works with agg keys", {
    #  Create pathogen data table
    transmission_data <- data.frame(
      pathogen = c("a", "b", "c"),
      inf_dc_min = c(0.05, 0.3, 0.5),
      inf_dc_max = c(0.08, 0.4, 0.6)
    )

    transmission_data_keys <- list(
      transmission_data = list(
        cols = c("pathogen", "inf_dc_min", "inf_dc_max"),
        keys = c("pathogen")
      )
    )

    transmission_mctable <- data.frame(
      mcnode = c("inf_dc"),
      description = c("Probability of infection via direct contact"),
      mc_func = c("runif"),
      from_variable = c(NA),
      transformation = c(NA),
      sensi_analysis = c(FALSE)
    )
    # Get previous module
    imports_mcmodule <- agg_totals(
      imports_mcmodule,
      "no_detect_a",
      agg_keys = "pathogen"
    )

    # Test expression
    transmission_exp <- quote({
      infection_risk <- no_detect_a_agg * inf_dc
    })

    # Evaluate module with previous module
    result_module <- eval_module(
      exp = c(transmission = transmission_exp),
      data = transmission_data,
      mctable = transmission_mctable,
      data_keys = transmission_data_keys,
      prev_mcmodule = imports_mcmodule,
      match_keys = c("pathogen", "origin"),
    )

    # Verify dimensions
    expect_equal(dim(imports_mcmodule$node_list$no_detect_a$mcnode)[3], 6)
    expect_equal(dim(result_module$node_list$no_detect_a_agg$mcnode)[3], 2)
    expect_equal(dim(result_module$node_list$infection_risk$mcnode)[3], 3)

    # Verify keys are correctly combined
    expect_equal(result_module$node_list$infection_risk$keys, c("pathogen"))

    # Verify input tracking
    expect_equal(
      result_module$node_list$infection_risk$inputs,
      c("no_detect_a_agg", "inf_dc")
    )

    # Verify no null matches in the dimension matching process
    summary <- mc_summary(result_module, "infection_risk")
    expect_equal(nrow(summary), 3)
    expect_true(all(c("pathogen") %in% names(summary)))
  })

  test_that("eval_mcmodule dim match works with custom match_keys", {
    #  Create test data
    contamination_data <- data.frame(
      pathogen = c("a", "b", "a", "b"),
      origin = c("nord", "nord", "nord", "nord"),
      scenario_id = c("0", "0", "heat_treatment", "heat_treatment"),
      contaminated = c(0.1, 0.5, 0.01, 0.05)
    )

    contamination_data_keys <- list(
      contamination_data = list(
        cols = c("pathogen", "origin", "contaminated"),
        keys = c("pathogen", "origin")
      )
    )

    contamination_mctable <- data.frame(
      mcnode = c("contaminated"),
      description = c("Probability of being contaminated"),
      mc_func = c(NA),
      from_variable = c(NA),
      transformation = c(NA),
      sensi_analysis = c(FALSE)
    )

    # Test expression
    contamination_exp <- quote({
      introduction_risk <- no_detect_a * contaminated
    })

    # Evaluate module with previous module
    result_default <- eval_module(
      exp = c(contamination = contamination_exp),
      data = contamination_data,
      mctable = contamination_mctable,
      data_keys = contamination_data_keys,
      prev_mcmodule = imports_mcmodule
    )

    # Evaluate module with previous module with CUSTOM MATCH KEYS
    result_custom <- eval_module(
      exp = c(contamination = contamination_exp),
      data = contamination_data,
      mctable = contamination_mctable,
      data_keys = contamination_data_keys,
      prev_mcmodule = imports_mcmodule,
      match_keys = c("pathogen")
    )

    # Verify dimensions
    expect_equal(dim(result_default$node_list$introduction_risk$mcnode)[3], 8)
    expect_equal(dim(result_custom$node_list$introduction_risk$mcnode)[3], 12)

    # Verify keys are correctly combined
    expect_equal(
      result_custom$node_list$introduction_risk$keys,
      c("pathogen", "origin")
    )

    # Verify input tracking
    expect_equal(
      result_custom$node_list$introduction_risk$inputs,
      c("no_detect_a", "contaminated")
    )

    # Verify no null matches in the dimension matching process
    summary <- mc_summary(result_custom, "introduction_risk")
    expect_equal(nrow(summary), 12)
    expect_true(all(c("pathogen", "origin") %in% names(summary)))
  })

  test_that("eval_module uses explicit keys and overwrite_keys default", {
    # data_keys provided -> overwrite_keys should default to FALSE -> keys are merged with data_keys
    test_data <- data.frame(
      pathogen = c("a", "b"),
      origin = c("o1", "o2"),
      inf_dc_min = c(0.1, 0.2),
      inf_dc_max = c(0.2, 0.3)
    )
    test_keys <- list(
      transmission = list(cols = names(test_data), keys = c("pathogen"))
    )

    test_mctable <- data.frame(
      mcnode = c("inf_dc"),
      description = c("inf"),
      mc_func = c("runif"),
      from_variable = c(NA),
      transformation = c(NA),
      sensi_analysis = c(FALSE)
    )

    res1 <- eval_module(
      exp = c(
        transmission = quote({
          infection_risk <- inf_dc
        })
      ),
      data = test_data,
      mctable = test_mctable,
      data_keys = test_keys,
      keys = c("pathogen", "origin")
    )

    expect_equal(res1$node_list$inf_dc$keys, c("pathogen", "origin"))
    expect_equal(res1$node_list$infection_risk$keys, c("pathogen", "origin"))

    # data_keys empty -> overwrite_keys should default to TRUE -> provided keys become local data_keys
    res2 <- eval_module(
      exp = c(
        transmission = quote({
          infection_risk <- inf_dc
        })
      ),
      data = test_data,
      mctable = test_mctable,
      data_keys = list(), # empty -> triggers overwrite_keys = TRUE
      keys = c("pathogen", "origin")
    )

    expect_equal(
      sort(res2$node_list$inf_dc$keys),
      sort(c("pathogen", "origin"))
    )
    expect_equal(
      sort(res2$node_list$infection_risk$keys),
      sort(c("pathogen", "origin"))
    )
  })

  test_that("eval_module handles prev_nodes with multiple data_names needing matching", {
    # Mock previous modules with different data_names
    prev_data_x <- data.frame(id = 1:3, value_x = c(0.1, 0.2, 0.3))
    prev_data_y <- data.frame(id = 1:3, value_y = c(0.2, 0.4, 0.5))
    names(prev_data_x) <- c("id", "value_x")
    names(prev_data_y) <- c("id", "value_y")

    prev_node_list <- list(
      prev_value_x = list(
        mcnode = mcdata(prev_data_x$value_x, type = "0", nvariates = 3),
        data_name = "prev_data_x",
        agg_keys = NULL,
        keep_variates = TRUE,
        type = "prev_node",
        keys = "id"
      ),
      prev_value_y = list(
        mcnode = mcdata(prev_data_y$value_y, type = "0", nvariates = 3),
        data_name = c("prev_data_x", "prev_data_y"),
        agg_keys = NULL,
        keep_variates = TRUE,
        type = "prev_node",
        keys = "id"
      )
    )

    class(prev_node_list) <- "mcnode_list"

    prev_mcmodule <- list(
      data = list(
        prev_data_x = prev_data_x,
        prev_data_y = prev_data_y
      ),
      node_list = prev_node_list
    )

    class(prev_mcmodule) <- "mcmodule"

    # Current data
    current_data <- data.frame(id = 1:3, value = c(0.01, 0.02, 0.03))
    current_exp <- quote({
      result <- prev_value_x * prev_value_y * value
    })

    mctable <- data.frame(
      mcnode = "value",
      description = "value node",
      mc_func = NA,
      from_variable = NA,
      transformation = NA,
      sensi_analysis = FALSE
    )

    # Run eval_module with both previous modules
    expect_error(
      eval_module(
        exp = c(current = current_exp),
        data = current_data,
        mctable = mctable,
        prev_mcmodule = prev_mcmodule
      ),
      "summary is needed for mcnodes with multiple data_names"
    )

    # Add Summary
    prev_mcmodule$node_list$prev_value_y$summary <- mc_summary(
      mcnode = prev_mcmodule$node_list$prev_value_y$mcnode,
      data = prev_data_y,
      keys_names = "id"
    )

    expect_message(
      result_mcmodule <- eval_module(
        exp = c(current = current_exp),
        data = current_data,
        mctable = mctable,
        prev_mcmodule = prev_mcmodule
      ),
      "Using summary to match dimensions"
    )

    expect_true("value" %in% names(result_mcmodule$node_list))
    expect_true("result" %in% names(result_mcmodule$node_list))
    expect_equal(
      result_mcmodule$node_list$result$inputs,
      c("prev_value_x", "prev_value_y", "value")
    )
    expect_equal(result_mcmodule$node_list$result$data_name, c("current_data"))
  })
})