Demo: Recommendation and Guess Who Game with fcaR

# Load necessary libraries
suppressMessages(library(fcaR))

cat("========================================================\n")

========================================================

cat("      'GUESS WHO' GAME SIMULATOR WITH fcaR     \n")

      'GUESS WHO' GAME SIMULATOR WITH fcaR     

cat("========================================================\n\n")

========================================================

# 1. Load the Guess Who matrix
data("guesswho")
whoiswho_df <- guesswho

# 2. Dichotomize the context
# To use the simplification logic (closure with reduce = TRUE) 
# on negative answers, we need explicit negative attributes.
I <- whoiswho_df
I_neg <- 1 - I
colnames(I_neg) <- paste0("no-", colnames(I))
I_final <- cbind(I, I_neg)

# Create the dichotomized formal context
fc <- FormalContext$new(I_final)

cat("The dichotomized formal context contains", fc$dim()[1], "characters and", fc$dim()[2], "attributes (positive and negative).\n\n")

The dichotomized formal context contains 24 characters and 38 attributes (positive and negative).

# Rule extraction
cat("Extracting implication rules...\n")

Extracting implication rules...

fc$find_implications()
cat("Found", fc$implications$cardinality(), "implication rules.\n\n")

Found 298 implication rules.

# Let's see some rules with positive support to understand their meaning
cat("Here are some extracted rules with positive support:\n")

Here are some extracted rules with positive support:

positive_rules <- fc$implications[fc$implications$support() > 0]
print(positive_rules[1:5])

Implication set with 5 implications.
Rule 1: {no-Beard, no-BigNose, no-Earrings} -> {no-BrownHair}
Rule 2: {no-Moustache, no-BigNose, no-Earrings} -> {no-BrownHair}
Rule 3: {no-Moustache, no-RosyCheeks, no-BigNose} -> {no-BigMouth}
Rule 4: {no-Glasses, no-RosyCheeks, no-Earrings} -> {Male, no-Female}
Rule 5: {no-Glasses, no-RosyCheeks, no-BigMouth, no-Sad} -> {no-WhiteHair}

cat("\n")

# --- Heuristic Auxiliary Functions ---
atributos_en_lhs <- function(implicaciones) {
  if (implicaciones$cardinality() == 0) return(numeric(0))
  implicaciones_buenas <- implicaciones[implicaciones$support() > 0]
  if (implicaciones_buenas$cardinality() == 0) return(numeric(0))
  
  # Returns the sum of occurrences of each attribute in the LHS
  Matrix::rowSums(implicaciones_buenas$get_LHS_matrix())
}

elige_atributo <- function(importancia, x) {
  # If there is no importance, fall back to anything. 
  # We assume importance is symmetric (pos + neg attributes)
  n_atributos <- length(importancia) / 2
  atr_positivos <- importancia[seq(n_atributos)]
  atr_negativos <- importancia[-seq(n_atributos)]
  
  # Known attributes
  presentes_positivos <- x[seq(n_atributos)]
  presentes_negativos <- x[-seq(n_atributos)]
  
  # Add the importance of asking for the attribute (whether YES or NO)
  impor <- atr_positivos + atr_negativos
  presentes <- presentes_positivos + presentes_negativos
  
  # Avoid asking what we already know
  impor[presentes > 0] <- -1
  
  # Return the name of the best positive attribute
  names(which.max(impor))
}



# Main function to simulate a game of Guess Who
play_guess_who <- function(target_character, context) {
  
  cat("========================================================\n")
  cat(sprintf(" STARTING GAME: Trying to guess '%s'\n", target_character))
  cat("========================================================\n\n")
  
  imps <- context$implications$clone()
  
  # Game state vector: mark with 1 the attributes we know the answer to.
  x <- rep(0, length(context$attributes))
  names(x) <- context$attributes
  
  questions_asked <- 0
  acabado <- FALSE
  
  while (!acabado) {
    
    importancia <- atributos_en_lhs(imps)
    
    # If we run out of implications but candidates remain, fallback
    if (length(importancia) == 0 || max(importancia) == 0) {
       n_atributos <- length(context$attributes) / 2
       pos_attrs <- context$attributes[seq(n_atributos)]
       desconocidos <- pos_attrs[x[pos_attrs] == 0 & x[paste0("no-", pos_attrs)] == 0]
       atributo_elegido <- desconocidos[1]
    } else {
       atributo_elegido <- elige_atributo(importancia, x)
    }
    
    questions_asked <- questions_asked + 1
    cat(sprintf("[Question %d] Does your character have '%s'?\n", questions_asked, atributo_elegido))
    
    # Check the real answer in the matrix
    has_attr <- context$I[atributo_elegido, target_character] == 1
    
    if (has_attr) {
      cat(sprintf("  -> Answer: YES\n"))
      x[atributo_elegido] <- 1
    } else {
      cat(sprintf("  -> Answer: NO\n"))
      x[paste0("no-", atributo_elegido)] <- 1
    }
    
    # *** SIMPLIFICATION LOGIC ***
    # Compute the closure and REDUCE the set of implications
    S <- fcaR::as_Set(x)
    cierre <- imps$closure(S, reduce = TRUE)
    
    # 1. Update our vector x with ALL deductions the logic made
    vector_previo <- x
    x <- as.numeric(fcaR::as_vector(cierre$closure))
    names(x) <- context$attributes
    
    # 2. Implications are reduced!
    imps <- cierre$implications
    
    # Report deductions to show the power of simplification
    nuevos_deducidos <- names(x)[x == 1 & vector_previo == 0]
    if (length(nuevos_deducidos) > 0) {
      cat(sprintf("  -> [FCA Simplification]: By closure, automatically deduced: %s\n", 
                  paste(nuevos_deducidos, collapse = ", ")))
    }
    cat(sprintf("  -> Remaining rules in the base: %d\n", imps$cardinality()))
    
    # See how many candidates are left
    objetos <- context$extent(cierre$closure)
    candidatos <- context$objects[as.numeric(objetos$get_vector()) == 1]
    
    cat(sprintf("  -> Remaining candidates (%d): %s\n\n", 
                length(candidatos), paste(candidatos, collapse = ", ")))
    
    acabado <- length(candidatos) <= 1 || sum(x) == length(x)
  }
  
  # Final Result
  cat("========================================================\n")
  if (length(candidatos) == 1) {
    cat(sprintf("GAME OVER! The character is '%s'. Guessed in %d questions.\n", candidatos[1], questions_asked))
    if (candidatos[1] == target_character) {
      cat("Result: SUCCESS.\n")
    } else {
      cat("Result: LOGICAL ERROR.\n")
    }
  } else {
    cat("No candidates left or could not distinguish. Something went wrong with the rules.\n")
  }
  cat("========================================================\n\n")
}

# Demo execution
play_guess_who("Anita", fc)

========================================================
 STARTING GAME: Trying to guess 'Anita'
========================================================

[Question 1] Does your character have 'Sad'?
  -> Answer: NO
  -> Remaining rules in the base: 282
  -> Remaining candidates (22): Alex, Alfred, Anita, Anne, Bernard, Bill, Charles, Claire, David, Eric, Frans, Herman, Joe, Maria, Max, Paul, Peter, Philip, Richard, Sam, Susan, Tom

[Question 2] Does your character have 'Earrings'?
  -> Answer: NO
  -> Remaining rules in the base: 231
  -> Remaining candidates (19): Alex, Alfred, Anita, Bernard, Bill, Claire, David, Eric, Frans, Herman, Joe, Max, Paul, Peter, Philip, Richard, Sam, Susan, Tom

[Question 3] Does your character have 'RosyCheeks'?
  -> Answer: YES
  -> [FCA Simplification]: By closure, automatically deduced: no-BlondeHair, no-BrownHair, no-Hat, no-Glasses, no-Moustache, no-BigNose
  -> Remaining rules in the base: 94
  -> Remaining candidates (4): Anita, Bill, Philip, Susan

[Question 4] Does your character have 'RedHair'?
  -> Answer: NO
  -> [FCA Simplification]: By closure, automatically deduced: no-Bald
  -> Remaining rules in the base: 69
  -> Remaining candidates (3): Anita, Philip, Susan

[Question 5] Does your character have 'Beard'?
  -> Answer: NO
  -> [FCA Simplification]: By closure, automatically deduced: Female, WhiteHair, no-Male, no-BlackHair
  -> Remaining rules in the base: 46
  -> Remaining candidates (2): Anita, Susan

[Question 6] Does your character have 'BlueEyes'?
  -> Answer: YES
  -> [FCA Simplification]: By closure, automatically deduced: no-BrownEyes, no-BigMouth
  -> Remaining rules in the base: 26
  -> Remaining candidates (1): Anita

========================================================
GAME OVER! The character is 'Anita'. Guessed in 6 questions.
Result: SUCCESS.
========================================================

play_guess_who("Bernard", fc)

========================================================
 STARTING GAME: Trying to guess 'Bernard'
========================================================

[Question 1] Does your character have 'Sad'?
  -> Answer: NO
  -> Remaining rules in the base: 282
  -> Remaining candidates (22): Alex, Alfred, Anita, Anne, Bernard, Bill, Charles, Claire, David, Eric, Frans, Herman, Joe, Maria, Max, Paul, Peter, Philip, Richard, Sam, Susan, Tom

[Question 2] Does your character have 'Earrings'?
  -> Answer: NO
  -> Remaining rules in the base: 231
  -> Remaining candidates (19): Alex, Alfred, Anita, Bernard, Bill, Claire, David, Eric, Frans, Herman, Joe, Max, Paul, Peter, Philip, Richard, Sam, Susan, Tom

[Question 3] Does your character have 'RosyCheeks'?
  -> Answer: NO
  -> Remaining rules in the base: 196
  -> Remaining candidates (15): Alex, Alfred, Bernard, Claire, David, Eric, Frans, Herman, Joe, Max, Paul, Peter, Richard, Sam, Tom

[Question 4] Does your character have 'Beard'?
  -> Answer: NO
  -> Remaining rules in the base: 161
  -> Remaining candidates (13): Alex, Alfred, Bernard, Claire, Eric, Frans, Herman, Joe, Max, Paul, Peter, Sam, Tom

[Question 5] Does your character have 'BlondeHair'?
  -> Answer: NO
  -> Remaining rules in the base: 153
  -> Remaining candidates (11): Alex, Alfred, Bernard, Claire, Frans, Herman, Max, Paul, Peter, Sam, Tom

[Question 6] Does your character have 'RedHair'?
  -> Answer: NO
  -> [FCA Simplification]: By closure, automatically deduced: Male, no-Female
  -> Remaining rules in the base: 105
  -> Remaining candidates (7): Alex, Bernard, Max, Paul, Peter, Sam, Tom

[Question 7] Does your character have 'Moustache'?
  -> Answer: NO
  -> Remaining rules in the base: 93
  -> Remaining candidates (5): Bernard, Paul, Peter, Sam, Tom

[Question 8] Does your character have 'Bald'?
  -> Answer: NO
  -> [FCA Simplification]: By closure, automatically deduced: no-BlackHair
  -> Remaining rules in the base: 74
  -> Remaining candidates (3): Bernard, Paul, Peter

[Question 9] Does your character have 'BigMouth'?
  -> Answer: NO
  -> [FCA Simplification]: By closure, automatically deduced: BrownEyes, no-BlueEyes
  -> Remaining rules in the base: 53
  -> Remaining candidates (2): Bernard, Paul

[Question 10] Does your character have 'WhiteHair'?
  -> Answer: NO
  -> [FCA Simplification]: By closure, automatically deduced: BrownHair, Hat, BigNose, no-Glasses
  -> Remaining rules in the base: 33
  -> Remaining candidates (1): Bernard

========================================================
GAME OVER! The character is 'Bernard'. Guessed in 10 questions.
Result: SUCCESS.
========================================================

play_guess_who("Richard", fc)

========================================================
 STARTING GAME: Trying to guess 'Richard'
========================================================

[Question 1] Does your character have 'Sad'?
  -> Answer: NO
  -> Remaining rules in the base: 282
  -> Remaining candidates (22): Alex, Alfred, Anita, Anne, Bernard, Bill, Charles, Claire, David, Eric, Frans, Herman, Joe, Maria, Max, Paul, Peter, Philip, Richard, Sam, Susan, Tom

[Question 2] Does your character have 'Earrings'?
  -> Answer: NO
  -> Remaining rules in the base: 231
  -> Remaining candidates (19): Alex, Alfred, Anita, Bernard, Bill, Claire, David, Eric, Frans, Herman, Joe, Max, Paul, Peter, Philip, Richard, Sam, Susan, Tom

[Question 3] Does your character have 'RosyCheeks'?
  -> Answer: NO
  -> Remaining rules in the base: 196
  -> Remaining candidates (15): Alex, Alfred, Bernard, Claire, David, Eric, Frans, Herman, Joe, Max, Paul, Peter, Richard, Sam, Tom

[Question 4] Does your character have 'Beard'?
  -> Answer: YES
  -> [FCA Simplification]: By closure, automatically deduced: Male, BrownEyes, no-Female, no-BlackHair, no-WhiteHair, no-RedHair, no-BlueEyes, no-Hat, no-Glasses, no-BigNose, no-BigMouth
  -> Remaining rules in the base: 51
  -> Remaining candidates (2): David, Richard

[Question 5] Does your character have 'Bald'?
  -> Answer: YES
  -> [FCA Simplification]: By closure, automatically deduced: BrownHair, Moustache, no-BlondeHair
  -> Remaining rules in the base: 37
  -> Remaining candidates (1): Richard

========================================================
GAME OVER! The character is 'Richard'. Guessed in 5 questions.
Result: SUCCESS.
========================================================