tests/testthat/test-rules_simplification.R

In fcaR: Formal Concept Analysis

context("Implication Logic and Simplification")

test_that("Simplification logic handles subset redundancies correctly", {
  # Construir manualmente un caso donde A < C (A es subconjunto de C)
  # Regla 1: {a} -> {b, c}
  # Regla 2: {a, d} -> {b}  (Redundante parcial: {a}->{b} ya está cubierto por R1)
  # Resultado esperado tras simplificar R2: {a, d} -> {} -> Eliminada o reducida

  fc <- FormalContext$new(matrix(0, 2, 4))
  fc$attributes <- c("a", "b", "c", "d")

  # Parsear implicaciones manualmente o construirlas
  # Usamos ImplicationSet$new() vacío y añadimos
  imps <- ImplicationSet$new(attributes = fc$attributes)

  # LHS matrices
  lhs_m <- Matrix::sparseMatrix(i = c(1, 1, 4), j = c(1, 2, 2), x = 1, dims = c(4, 2))
  # R1: a(1) en col 1. R2: a(1), d(4) en col 2.
  rownames(lhs_m) <- fc$attributes

  # RHS matrices
  rhs_m <- Matrix::sparseMatrix(i = c(2, 3, 2), j = c(1, 1, 2), x = 1, dims = c(4, 2))
  # R1: b(2), c(3). R2: b(2).
  rownames(rhs_m) <- fc$attributes

  imps_manual <- ImplicationSet$new(attributes = fc$attributes, lhs = lhs_m, rhs = rhs_m)

  expect_equal(imps_manual$cardinality(), 2)

  # Aplicar simplificación
  imps_manual$apply_rules("simplification")

  # La Regla 2 debería haber desaparecido o su RHS vaciarse porque {a, d} implica {b}
  # se deduce de {a} implica {b} (Generalización/Augmentation)

  # Verificamos si se redujo el RHS de la segunda regla
  final_rhs <- imps_manual$get_RHS_matrix()

  # En la columna 2 (correspondiente a la original R2), 'b' (índice 2) debería ser 0
  expect_equal(ncol(final_rhs), 1)
})

test_that("Filtering implications handles edge cases", {
  # Caso: Contexto con atributos pero sin reglas
  imps <- ImplicationSet$new(attributes = letters[1:3])
  expect_equal(imps$filter(lhs = "a"), imps)

  # Caso: Filtrado con atributos que no existen en el set
  lhs_m <- Matrix::sparseMatrix(i = 1, j = 1, x = 1, dims = c(3, 1))
  rhs_m <- Matrix::sparseMatrix(i = 2, j = 1, x = 1, dims = c(3, 1))
  imps <- ImplicationSet$new(attributes = letters[1:3], lhs = lhs_m, rhs = rhs_m)

  # Atributo 'z' no existe
  # filter usa match, que devuelve NA, y luego la lógica interna debe manejarlo
  # Esperamos que devuelva NULL o warning, no error crítico
  expect_error(res <- imps$filter(lhs = "z"))
  # expect_true(is.null(res) || res$cardinality() == 0)
})