R/tsqca_config_chart.R

Defines functions config_chart_multi_solutions config_chart_from_paths add_metrics_rows extract_solution_metrics_for_chart extract_path_metrics_for_chart build_single_chart extract_paths_from_solution extract_solution_list get_config_labels generate_config_chart generate_cross_threshold_chart generate_threshold_level_chart generate_term_level_chart config_matrix_to_md build_config_matrix extract_conditions_from_paths parse_path_conditions identify_epi generate_solution_note get_condition_status parse_solution_terms

Documented in add_metrics_rows build_config_matrix build_single_chart config_chart_from_paths config_chart_multi_solutions config_matrix_to_md extract_conditions_from_paths extract_path_metrics_for_chart extract_paths_from_solution extract_solution_list extract_solution_metrics_for_chart generate_config_chart generate_cross_threshold_chart generate_solution_note generate_term_level_chart generate_threshold_level_chart get_condition_status get_config_labels identify_epi parse_path_conditions parse_solution_terms

###############################################
# Configuration Chart Generator for TSQCA
###############################################

#' Parse solution expression into individual terms
#'
#' Splits a solution expression (ORed terms) into individual prime implicants.
#'
#' @param expr Character. Solution expression (e.g., "X3 + X1*X2").
#'
#' @return Character vector of terms (e.g., c("X3", "X1*X2")), or NULL if
#'   no valid expression.
#'
#' @keywords internal
parse_solution_terms <- function(expr) {
  if (is.na(expr) || expr == "No solution" || expr == "" || is.null(expr)) {
    return(NULL)
  }
  # Split by + (OR operator), allowing spaces
  terms <- strsplit(expr, "\\s*\\+\\s*")[[1]]
  # Trim whitespace
  terms <- trimws(terms)
  # Remove empty strings
  terms <- terms[terms != ""]
  if (length(terms) == 0) return(NULL)
  return(terms)
}


#' Determine condition status in a term
#'
#' Checks whether a condition is present, absent (negated), or don't care
#' in a given term.
#'
#' @param term Character. Single term (e.g., "X1*X2", "~X3").
#' @param condition Character. Condition name (e.g., "X1").
#'
#' @return Character. One of "present", "absent", or "dontcare".
#'
#' @details Uses word boundary matching to avoid false positives when
#'   condition names are substrings of each other (e.g., X1 vs X10).
#'
#' @keywords internal
get_condition_status <- function(term, condition) {
  # Remove spaces from term for consistent matching
  term <- gsub("\\s+", "", term)
  
  # Escape special regex characters in condition name
  cond_escaped <- gsub("([\\[\\]\\(\\)\\{\\}\\^\\$\\.\\|\\?\\+\\\\])", 
                       "\\\\\\1", condition)
  
  # Negated condition check (~X1 or similar)
  negated_pattern <- paste0("~", cond_escaped, "(?![A-Za-z0-9_]|$)")
  # Also check for ~X1 at end of string
  negated_pattern_end <- paste0("~", cond_escaped, "$")
  if (grepl(negated_pattern, term, perl = TRUE) || 
      grepl(negated_pattern_end, term, perl = TRUE)) {
    return("absent")
  }
  
  # Positive condition check (X1 but not ~X1)
  # Pattern: X1 not preceded by ~ or alphanumeric, not followed by alphanumeric
  positive_pattern <- paste0("(?<![~A-Za-z0-9_])", cond_escaped, "(?![A-Za-z0-9_])")
  # Also check for condition at start of string
  positive_pattern_start <- paste0("^", cond_escaped, "(?![A-Za-z0-9_]|$)")
  positive_pattern_end <- paste0("(?<![~A-Za-z0-9_])", cond_escaped, "$")
  
  if (grepl(positive_pattern, term, perl = TRUE) ||
      grepl(positive_pattern_start, term, perl = TRUE) ||
      grepl(positive_pattern_end, term, perl = TRUE)) {
    return("present")
  }
  
  return("dontcare")
}


#' Symbol sets for configuration charts
#' @keywords internal
SYMBOL_SETS <- list(
  unicode = list(
    present = "\u25CF",     # ● (BLACK CIRCLE)
    absent  = "\u2297",     # ⊗ (CIRCLED TIMES)
    note_en = "\u25CF = presence, \u2297 = absence, blank = don't care",
    note_ja = "\u25CF = \u5b58\u5728, \u2297 = \u4e0d\u5728, \u7a7a\u6b04 = \u7121\u95a2\u4fc2"
  ),

  ascii = list(
    present = "O",
    absent  = "X",
    note_en = "O = presence, X = absence, blank = don't care",
    note_ja = "O = \u5b58\u5728, X = \u4e0d\u5728, \u7a7a\u6b04 = \u7121\u95a2\u4fc2"
  ),
  latex = list(
    present = "$\\bullet$",
    absent  = "$\\otimes$",
    note_en = "$\\bullet$ = presence, $\\otimes$ = absence, blank = don't care",
    note_ja = "$\\bullet$ = \u5b58\u5728, $\\otimes$ = \u4e0d\u5728, \u7a7a\u6b04 = \u7121\u95a2\u4fc2"
  )
)


#' Generate solution note for multiple solutions
#'
#' Creates a note explaining that multiple equivalent solutions exist
#' and that the displayed configuration is based on M1.
#'
#' @param n_sol Integer. Number of solutions.
#' @param epi_list Character vector. Essential prime implicants (NULL to omit).
#' @param style Character. \code{"simple"} or \code{"detailed"}.
#' @param language Character. \code{"en"} or \code{"ja"}.
#' @param format Character. \code{"markdown"} or \code{"latex"}.
#'
#' @return Character string of the note, or empty string if n_sol <= 1.
#'
#' @examples
#' # Simple note
#' generate_solution_note(2, style = "simple")
#' 
#' # Detailed note with EPIs
#' generate_solution_note(3, epi_list = c("A*B", "C"), style = "detailed")
#' 
#' # Japanese
#' generate_solution_note(2, style = "simple", language = "ja")
#'
#' @export
generate_solution_note <- function(n_sol,
                                    epi_list = NULL,
                                    style = c("simple", "detailed"),
                                    language = c("en", "ja"),
                                    format = c("markdown", "latex")) {
  
  # Return empty string for single solution
  if (is.null(n_sol) || n_sol <= 1) {
    return("")
  }

  
  style <- match.arg(style)
  language <- match.arg(language)
  format <- match.arg(format)
  
  labels <- get_config_labels(language)
  
  # Build note text
  if (language == "ja") {
    # Japanese version
    n_sol_text <- gsub("\\{n\\}", as.character(n_sol), labels$n_equiv_solutions)
    base_note <- paste0(n_sol_text, labels$table_based_on_m1)
    
    if (style == "detailed" && !is.null(epi_list) && length(epi_list) > 0) {
      # Format EPIs with appropriate connector
      if (format == "latex") {
        epi_str <- paste(epi_list, collapse = ", ")
        epi_str <- gsub("\\*", "$\\\\cdot$", epi_str)
      } else {
        epi_str <- paste(epi_list, collapse = ", ")
        epi_str <- gsub("\\*", "\u00B7", epi_str)  # middle dot
      }
      
      if (length(epi_list) == 1) {
        epi_text <- gsub("\\{epi\\}", epi_str, labels$all_share_epi_single)
      } else {
        epi_text <- gsub("\\{epi\\}", epi_str, labels$all_share_epi)
      }
      base_note <- paste0(base_note, epi_text)
    } else if (style == "detailed" && (is.null(epi_list) || length(epi_list) == 0)) {
      base_note <- paste0(base_note, labels$no_epi)
    }
    
  } else {
    # English version
    if (style == "detailed") {
      n_sol_text <- gsub("\\{n\\}", as.character(n_sol), labels$n_equiv_solutions_range)
    } else {
      n_sol_text <- gsub("\\{n\\}", as.character(n_sol), labels$n_equiv_solutions)
    }
    base_note <- paste0(n_sol_text, " ", labels$table_based_on_m1)
    
    if (style == "detailed" && !is.null(epi_list) && length(epi_list) > 0) {
      # Format EPIs with appropriate connector
      if (format == "latex") {
        epi_str <- paste(epi_list, collapse = " and ")
        epi_str <- gsub("\\*", "$\\\\cdot$", epi_str)
      } else {
        epi_str <- paste(epi_list, collapse = " and ")
        epi_str <- gsub("\\*", "\u00B7", epi_str)  # middle dot
      }
      
      if (length(epi_list) == 1) {
        epi_text <- gsub("\\{epi\\}", epi_str, labels$all_share_epi_single)
      } else {
        epi_text <- gsub("\\{epi\\}", epi_str, labels$all_share_epi)
      }
      base_note <- paste0(base_note, " ", epi_text)
    } else if (style == "detailed" && (is.null(epi_list) || length(epi_list) == 0)) {
      base_note <- paste0(base_note, " ", labels$no_epi)
    }
  }
  
  # Format output
  if (format == "latex") {
    note <- paste0("\\footnotesize{\\textit{", labels$note_prefix, "}: ", base_note, "}")
  } else {
    note <- paste0("*", labels$note_prefix, ": ", base_note, "*")
  }
  
  return(note)
}


#' Identify Essential Prime Implicants from multiple solutions
#'
#' Finds terms that appear in ALL solutions (EPIs) versus terms that
#' appear in only some solutions (SPIs).
#'
#' @param solutions List of solution vectors. Each element is a character
#'   vector of terms for one solution.
#'
#' @return List with:
#'   \itemize{
#'     \item \code{epi} — Essential prime implicants (in all solutions)
#'     \item \code{spi} — Selective prime implicants (in some solutions)
#'     \item \code{n_solutions} — Number of solutions
#'   }
#'
#' @examples
#' solutions <- list(
#'   c("A*B", "C", "D"),
#'   c("A*B", "C", "E"),
#'   c("A*B", "C", "F")
#' )
#' result <- identify_epi(solutions)
#' # result$epi = c("A*B", "C")
#' # result$spi = c("D", "E", "F")
#'
#' @export
identify_epi <- function(solutions) {
  
  if (is.null(solutions) || length(solutions) == 0) {
    return(list(epi = character(0), spi = character(0), n_solutions = 0L))
  }
  
  n_solutions <- length(solutions)
  
  if (n_solutions == 1) {
    # Single solution: all terms are "essential" by definition
    return(list(
      epi = solutions[[1]],
      spi = character(0),
      n_solutions = 1L
    ))
  }
  
  # Find intersection of all solutions (EPIs)
  epi <- Reduce(intersect, solutions)
  
  # Find union of all solutions
  all_terms <- Reduce(union, solutions)
  
  # SPIs are terms not in all solutions
spi <- setdiff(all_terms, epi)
  
  list(
    epi = epi,
    spi = spi,
    n_solutions = n_solutions
  )
}


#' Parse a single path/term into conditions
#'
#' @param path Character. A single path like "A*B*~C"
#' @return List with 'present' and 'absent' condition names
#' @keywords internal
parse_path_conditions <- function(path) {
  # Split by * (AND operator)
  terms <- unlist(strsplit(path, "\\*"))
  terms <- trimws(terms)
  
  # Separate present and absent conditions
  absent_terms <- grep("^~", terms, value = TRUE)
  present_terms <- setdiff(terms, absent_terms)
  
  # Remove ~ prefix from absent terms
  absent_conds <- gsub("^~", "", absent_terms)
  
  list(
    present = present_terms,
    absent  = absent_conds
  )
}


#' Extract all unique conditions from paths
#'
#' @param paths Character vector of paths
#' @return Character vector of unique condition names (without ~)
#' @keywords internal
extract_conditions_from_paths <- function(paths) {
  all_conds <- c()
  for (path in paths) {
    parsed <- parse_path_conditions(path)
    all_conds <- c(all_conds, parsed$present, parsed$absent)
  }
  unique(all_conds)
}


#' Build condition-path matrix for configuration chart
#'
#' @param paths Character vector of paths
#' @param conditions Character vector of condition names (optional)
#' @param symbols List with 'present' and 'absent' symbols
#' @return Matrix with conditions as rows, paths as columns
#' @keywords internal
build_config_matrix <- function(paths, conditions = NULL, symbols) {
  
  # Auto-detect conditions if not provided
  if (is.null(conditions)) {
    conditions <- extract_conditions_from_paths(paths)
  }
  
  n_paths <- length(paths)
  n_conds <- length(conditions)
  
  mat <- matrix("", nrow = n_conds, ncol = n_paths)
  rownames(mat) <- conditions
  colnames(mat) <- paste0("M", seq_len(n_paths))
  
  for (j in seq_along(paths)) {
    parsed <- parse_path_conditions(paths[j])
    for (cond in conditions) {
      if (cond %in% parsed$present) {
        mat[cond, j] <- symbols$present
      } else if (cond %in% parsed$absent) {
        mat[cond, j] <- symbols$absent
      }
      # else: leave blank (don't care)
    }
  }
  
  mat
}


#' Convert configuration matrix to Markdown table
#'
#' @param mat Matrix with rownames and colnames
#' @param row_header Character. Header for the row names column
#' @param center_align Logical. Whether to center-align columns
#' @return Character string of Markdown table
#' @keywords internal
config_matrix_to_md <- function(mat, row_header = "Condition", center_align = TRUE) {
  n_cols <- ncol(mat)
  
  # Header row
  header <- paste0("| ", row_header, " | ", 
                   paste(colnames(mat), collapse = " | "), " |")
  
  # Separator row
  if (center_align) {
    sep <- paste0("|", paste(rep(":--:", n_cols + 1), collapse = "|"), "|")
  } else {
    sep <- paste0("|", paste(rep("---", n_cols + 1), collapse = "|"), "|")
  }
  
  # Data rows
  rows <- sapply(seq_len(nrow(mat)), function(i) {
    paste0("| ", rownames(mat)[i], " | ", 
           paste(mat[i, ], collapse = " | "), " |")
  })
  
  paste(c(header, sep, rows), collapse = "\n")
}


#' Generate solution-term level chart (Fiss-style)
#'
#' Creates a configuration chart where each column represents a single
#' prime implicant (configuration), following Fiss (2011) notation.
#'
#' @param sum_df Data frame. Summary data frame from sweep results with
#'   expression column and threshold column(s).
#' @param conditions Character vector. Condition names for row ordering.
#' @param symbols List. Symbol set (present, absent) for the chart.
#' @param language Character. Language for labels ("en" or "ja").
#'
#' @return Character string containing Markdown-formatted table.
#'
#' @keywords internal
generate_term_level_chart <- function(sum_df, conditions, symbols, language = "en") {
  
  labels <- get_config_labels(language)
  
  # Step 1: Extract all terms from all thresholds
  terms_list <- lapply(seq_len(nrow(sum_df)), function(i) {
    expr <- sum_df$expression[i]
    
    # Identify threshold column (otSweep: thrY, ctSweepS: threshold, etc.)
    thr_col <- intersect(c("thrY", "threshold", "thrX"), names(sum_df))[1]
    if (is.na(thr_col) || is.null(thr_col)) {
      thr <- paste0("row", i)
    } else {
      thr <- sum_df[[thr_col]][i]
    }
    
    terms <- parse_solution_terms(expr)
    if (is.null(terms)) return(NULL)
    
    data.frame(
      thr = thr,
      term_num = seq_along(terms),
      term_expr = terms,
      stringsAsFactors = FALSE
    )
  })
  
  terms_df <- do.call(rbind, terms_list)
  
  # No solutions found
  if (is.null(terms_df) || nrow(terms_df) == 0) {
    return(paste0("*", labels$no_solution, "*\n"))
  }
  
  # Step 2: Generate column names (Fiss-style format)
  col_names <- paste0("thrY = ", terms_df$thr, " (C", terms_df$term_num, ")")
  
  # Step 3: Initialize matrix (blank = don't care)
  chart_matrix <- matrix(
    "",
    nrow = length(conditions),
    ncol = nrow(terms_df),
    dimnames = list(conditions, col_names)
  )
  
  # Step 4: Fill in cells
  for (j in seq_len(nrow(terms_df))) {
    term <- terms_df$term_expr[j]
    
    for (cond in conditions) {
      status <- get_condition_status(term, cond)
      
      chart_matrix[cond, j] <- switch(
        status,
        "present"  = symbols$present,
        "absent"   = symbols$absent,
        "dontcare" = ""
      )
    }
  }
  
  # Step 5: Convert to markdown
  table_str <- config_matrix_to_md(chart_matrix, labels$condition)
  
  # Add legend
  legend_note <- if (language == "ja") symbols$note_ja else symbols$note_en
  paste0(table_str, "\n\n*", legend_note, "*\n")
}


#' Generate threshold-level summary chart
#'
#' Creates a configuration chart where each column represents one threshold,
#' showing all conditions that appear in any configuration at that threshold.
#'
#' @param sum_df Data frame. Summary data frame from sweep results.
#' @param conditions Character vector. Condition names for row ordering.
#' @param symbols List. Symbol set (present, absent) for the chart.
#' @param language Character. Language for labels ("en" or "ja").
#'
#' @return Character string containing Markdown-formatted table.
#'
#' @keywords internal
generate_threshold_level_chart <- function(sum_df, conditions, symbols, language = "en") {
  
  labels <- get_config_labels(language)
  
  # Identify threshold column
  thr_col <- intersect(c("thrY", "threshold", "thrX"), names(sum_df))[1]
  if (is.na(thr_col) || is.null(thr_col)) {
    thr_col <- "row"
    sum_df[[thr_col]] <- seq_len(nrow(sum_df))
  }
  
  # Get unique thresholds
  thresholds <- unique(sum_df[[thr_col]])
  
  # Build column names
  col_names <- paste0("thrY=", thresholds)
  
  # Initialize matrix
  chart_matrix <- matrix(
    "",
    nrow = length(conditions),
    ncol = length(thresholds),
    dimnames = list(conditions, col_names)
  )
  
  # Fill in cells (aggregate across all terms at each threshold)
  for (j in seq_along(thresholds)) {
    thr <- thresholds[j]
    
    # Get all expressions at this threshold
    exprs <- sum_df$expression[sum_df[[thr_col]] == thr]
    
    # Parse all terms
    all_terms <- character(0)
    for (expr in exprs) {
      terms <- parse_solution_terms(expr)
      if (!is.null(terms)) {
        all_terms <- c(all_terms, terms)
      }
    }
    
    if (length(all_terms) == 0) next
    
    # Check each condition across all terms
    for (cond in conditions) {
      has_present <- FALSE
      has_absent <- FALSE
      
      for (term in all_terms) {
        status <- get_condition_status(term, cond)
        if (status == "present") has_present <- TRUE
        if (status == "absent") has_absent <- TRUE
      }
      
      # If both present and absent appear, show presence (it appears in some config)
      if (has_present) {
        chart_matrix[cond, j] <- symbols$present
      } else if (has_absent) {
        chart_matrix[cond, j] <- symbols$absent
      }
      # else: leave blank (don't care across all configs)
    }
  }
  
  # Convert to markdown
  table_str <- config_matrix_to_md(chart_matrix, labels$condition)
  
  # Add legend
  legend_note <- if (language == "ja") symbols$note_ja else symbols$note_en
  paste0(table_str, "\n\n*", legend_note, "*\n")
}


#' Generate cross-threshold configuration chart from sweep results
#'
#' Creates a configuration chart from threshold sweep results. Supports
#' two levels of aggregation: solution-term level (Fiss-style, default) and
#' threshold-level summary.
#'
#' @param result A result object from any Sweep function (otSweep, ctSweepS,
#'   ctSweepM, or dtSweep).
#' @param conditions Character vector. Condition names for row ordering.
#'   If NULL, automatically extracted from expressions.
#' @param symbol_set Character. One of \code{"unicode"}, \code{"ascii"}, 
#'   or \code{"latex"}. Default is \code{"unicode"}.
#' @param chart_level Character. Chart aggregation level:
#'   \code{"term"} (default) produces solution-term level charts following Fiss (2011)
#'   notation, where each column represents one prime implicant.
#'   \code{"summary"} produces threshold-level summaries where
#'   each column represents one threshold, aggregating all configurations.
#' @param language Character. \code{"en"} for English, \code{"ja"} for Japanese.
#'
#' @return Character string containing Markdown-formatted table.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' data(sample_data)
#' result <- otSweep(
#'   dat = sample_data,
#'   outcome = "Y",
#'   conditions = c("X1", "X2", "X3"),
#'   sweep_range = 6:8,
#'   thrX = c(X1 = 7, X2 = 7, X3 = 7)
#' )
#' 
#' # Solution-term level, Fiss-style (default)
#' chart <- generate_cross_threshold_chart(result, c("X1", "X2", "X3"))
#' cat(chart)
#' 
#' # Threshold-level summary
#' chart <- generate_cross_threshold_chart(result, c("X1", "X2", "X3"),
#'                                          chart_level = "summary")
#' cat(chart)
#' }
generate_cross_threshold_chart <- function(result,
                                            conditions = NULL,
                                            symbol_set = c("unicode", "ascii", "latex"),
                                            chart_level = c("term", "summary"),
                                            language = c("en", "ja")) {
  
  symbol_set <- match.arg(symbol_set)
  chart_level <- match.arg(chart_level)
  language <- match.arg(language)
  symbols <- SYMBOL_SETS[[symbol_set]]
  
  # Get summary data frame
  if (is.data.frame(result)) {
    sum_df <- result
  } else if (is.list(result) && "summary" %in% names(result)) {
    sum_df <- result$summary
  } else {
    stop("'result' must be a data frame or a list with 'summary' element.")
  }
  
  # Auto-detect conditions from expressions if not provided
  if (is.null(conditions)) {
    all_terms <- character(0)
    for (expr in sum_df$expression) {
      terms <- parse_solution_terms(expr)
      if (!is.null(terms)) {
        all_terms <- c(all_terms, terms)
      }
    }
    conditions <- extract_conditions_from_paths(all_terms)
  }
  
  if (length(conditions) == 0) {
    return("*No conditions found.*\n")
  }
  
  # Dispatch to appropriate chart generator
  if (chart_level == "summary") {
    generate_threshold_level_chart(sum_df, conditions, symbols, language)
  } else {
    generate_term_level_chart(sum_df, conditions, symbols, language)
  }
}


#' Generate Configuration Chart from QCA Solution
#'
#' Creates a Markdown-formatted configuration chart (Fiss-style table)
#' from QCA minimization results. Supports single solution with multiple
#' paths, and multiple solutions (displayed as separate tables).
#'
#' @param sol A solution object returned by \code{QCA::minimize()}, or
#'   a list containing solution information.
#' @param symbol_set Character. One of \code{"unicode"}, \code{"ascii"}, 
#'   or \code{"latex"}. Default is \code{"unicode"}.
#' @param include_metrics Logical. Whether to include consistency/coverage
#'   metrics in the table. Default is TRUE.
#' @param language Character. \code{"en"} for English, \code{"ja"} for Japanese.
#'   Default is \code{"en"}.
#' @param condition_order Character vector. Optional ordering of conditions
#'   in the table rows. If NULL, conditions are ordered as they appear in paths.
#'
#' @return Character string containing Markdown-formatted table(s).
#'
#' @export
#'
#' @examples
#' \dontrun{
#' # After running QCA::minimize()
#' library(QCA)
#' tt <- truthTable(data, outcome = "Y", conditions = c("A", "B", "C"))
#' sol <- minimize(tt, include = "?", details = TRUE)
#' 
#' # Generate configuration chart
#' chart <- generate_config_chart(sol)
#' cat(chart)
#'
#' # For LaTeX/PDF output (e.g., rticles)
#' chart <- generate_config_chart(sol, symbol_set = "latex")
#'
#' # ASCII for maximum compatibility
#' chart <- generate_config_chart(sol, symbol_set = "ascii")
#'
#' # Japanese labels
#' chart <- generate_config_chart(sol, language = "ja")
#' }
generate_config_chart <- function(sol,
                                   symbol_set = c("unicode", "ascii", "latex"),
                                   include_metrics = TRUE,
                                   language = c("en", "ja"),
                                   condition_order = NULL) {
  
  symbol_set <- match.arg(symbol_set)
  language <- match.arg(language)
  symbols <- SYMBOL_SETS[[symbol_set]]
  
  # Get labels based on language
  labels <- get_config_labels(language)
  
  # Get symbol note
  note <- if (language == "ja") symbols$note_ja else symbols$note_en
  
  # Extract solutions from QCA object
  sol_list <- extract_solution_list(sol)
  n_solutions <- length(sol_list)
  
  if (n_solutions == 0) {
    return(paste0("*", labels$no_solution, "*\n"))
  }
  
  # Single solution vs multiple solutions
  if (n_solutions == 1) {
    # Single solution: all paths in one table
    paths <- extract_paths_from_solution(sol_list[[1]])
    chart <- build_single_chart(
      paths = paths,
      sol = sol,
      symbols = symbols,
      labels = labels,
      include_metrics = include_metrics,
      condition_order = condition_order
    )
  } else {
    # Multiple solutions: separate tables with warning
    warning_msg <- paste0(
      "**", labels$note, ":** ", n_solutions, " ", labels$equiv_solutions, " ",
      labels$separate_tables, "\n\n"
    )
    
    charts <- lapply(seq_along(sol_list), function(i) {
      paths <- extract_paths_from_solution(sol_list[[i]])
      header <- paste0("### ", labels$solution, " M", i, "\n\n")
      table <- build_single_chart(
        paths = paths,
        sol = sol,
        symbols = symbols,
        labels = labels,
        include_metrics = include_metrics,
        condition_order = condition_order,
        solution_index = i
      )
      paste0(header, table)
    })
    
    chart <- paste0(warning_msg, paste(charts, collapse = "\n\n---\n\n"))
  }
  
  # Add symbol legend
  legend <- paste0("\n\n*", note, "*\n")
  
  paste0(chart, legend)
}


#' Get labels for configuration chart based on language
#' @keywords internal
get_config_labels <- function(language) {
  if (language == "ja") {
    list(
      condition = "\u6761\u4ef6",
      consistency = "\u4e00\u8cab\u6027",
      raw_coverage = "\u751f\u30ab\u30d0\u30ec\u30c3\u30b8",
      unique_coverage = "\u56fa\u6709\u30ab\u30d0\u30ec\u30c3\u30b8",
      solution_consistency = "\u89e3\u4e00\u8cab\u6027",
      solution_coverage = "\u89e3\u30ab\u30d0\u30ec\u30c3\u30b8",
      solution = "\u89e3",
      note = "\u6ce8\u610f",
      equiv_solutions = "\u500b\u306e\u7b49\u4fa1\u306a\u89e3\u304c\u5b58\u5728\u3057\u307e\u3059\u3002",
      separate_tables = "\u4ee5\u4e0b\u306b\u5225\u3005\u306e\u8868\u3092\u793a\u3057\u307e\u3059\u3002",
      no_solution = "\u89e3\u304c\u898b\u3064\u304b\u308a\u307e\u305b\u3093\u3067\u3057\u305f",
      # Solution note labels (Japanese)
      note_prefix = "\u6ce8",
      n_equiv_solutions = "\u8ad6\u7406\u7684\u306b\u7b49\u4fa1\u306a{n}\u3064\u306e\u89e3\u304c\u5f97\u3089\u308c\u305f\u3002",
      table_based_on_m1 = "\u672c\u8868\u306fM1\u306b\u57fa\u3065\u304f\u69cb\u6210\u3092\u793a\u3059\u3002",
      all_share_epi = "\u5168\u89e3\u306b\u5171\u901a\u3059\u308bEssential Prime Implicants: {epi}",
      all_share_epi_single = "\u5168\u89e3\u306b\u5171\u901a\u3059\u308bEssential Prime Implicant: {epi}",
      no_epi = "\u5168\u3066\u306e\u9805\u304cSelective Prime Implicants\u3067\u3042\u308b\u3002"
    )
  } else {
    list(
      condition = "Condition",
      consistency = "Consistency",
      raw_coverage = "Raw Cov.",
      unique_coverage = "Uniq. Cov.",
      solution_consistency = "Solution Consistency",
      solution_coverage = "Solution Coverage",
      solution = "Solution",
      note = "Note",
      equiv_solutions = "equivalent solutions exist.",
      separate_tables = "Tables are shown separately below.",
      no_solution = "No solution found",
      # Solution note labels (English)
      note_prefix = "Note",
      n_equiv_solutions = "{n} logically equivalent solutions were identified.",
      n_equiv_solutions_range = "{n} logically equivalent solutions were identified (M1-M{n}).",
      table_based_on_m1 = "This table presents configurations based on M1.",
      all_share_epi = "All solutions share the essential prime implicants: {epi}.",
      all_share_epi_single = "All solutions share the essential prime implicant: {epi}.",
      no_epi = "Solutions differ in all prime implicants (no essential prime implicants)."
    )
  }
}


#' Extract solution list from QCA object
#' @note When dir.exp is specified, the true Intermediate solution is stored in
#'   sol$i.sol, not sol$solution (which contains the Parsimonious solution).
#' @keywords internal
extract_solution_list <- function(sol) {
  if (is.null(sol)) return(list())
  
  # Method 1: Through i.sol structure (true Intermediate when dir.exp specified)
  if (!is.null(sol$i.sol) && length(sol$i.sol) > 0) {
    # Collect solutions from all i.sol entries
    solutions <- list()
    for (isol_name in names(sol$i.sol)) {
      isol_sols <- sol$i.sol[[isol_name]]$solution
      if (!is.null(isol_sols) && length(isol_sols) > 0) {
        for (s in isol_sols) {
          solutions <- c(solutions, list(s))
        }
      }
    }
    if (length(solutions) > 0) return(solutions)
  }
  
  # Method 2: Direct $solution (Parsimonious or when dir.exp not specified)
  if (!is.null(sol$solution) && length(sol$solution) > 0) {
    return(sol$solution)
  }
  
  # Method 3: If passed as simple character vector of paths
  if (is.character(sol)) {
    return(list(sol))
  }
  
  # Method 4: If passed as list of character vectors
  if (is.list(sol) && all(sapply(sol, is.character))) {
    return(sol)
  }
  
  list()
}


#' Extract paths from a single solution
#' @keywords internal
extract_paths_from_solution <- function(solution) {
  if (is.null(solution)) return(character(0))
  
  # If it's a character vector with multiple elements, those are paths
  if (is.character(solution) && length(solution) > 1) {
    return(solution)
  }
  
  # If it's a single string, check for " + " separator
  if (is.character(solution) && length(solution) == 1) {
    if (grepl(" \\+ ", solution)) {
      return(trimws(unlist(strsplit(solution, " \\+ "))))
    }
    return(solution)
  }
  
  character(0)
}


#' Build configuration chart for a single solution
#' @keywords internal
build_single_chart <- function(paths, sol, symbols, labels, 
                                include_metrics, condition_order = NULL,
                                solution_index = 1) {
  
  if (length(paths) == 0) {
    return(paste0("*", labels$no_solution, "*"))
  }
  
  # Determine condition order
  if (is.null(condition_order)) {
    conditions <- extract_conditions_from_paths(paths)
  } else {
    conditions <- condition_order
  }
  
  # Build matrix
  mat <- build_config_matrix(paths, conditions, symbols)
  
  # Convert to markdown
  table_str <- config_matrix_to_md(mat, labels$condition)
  
  # Add metrics if requested and available
  if (include_metrics && !is.null(sol)) {
    # Try to get per-path metrics
    path_metrics <- extract_path_metrics_for_chart(sol, solution_index)
    
    if (!is.null(path_metrics) && nrow(path_metrics) == length(paths)) {
      table_str <- add_metrics_rows(table_str, path_metrics, labels)
    }
    
    # Add solution-level metrics
    sol_metrics <- extract_solution_metrics_for_chart(sol, solution_index)
    
    if (!is.null(sol_metrics)) {
      table_str <- paste0(
        table_str, "\n\n",
        "**", labels$solution_consistency, "**: ", 
        format(round(sol_metrics$inclS, 3), nsmall = 3), "  \n",
        "**", labels$solution_coverage, "**: ", 
        format(round(sol_metrics$covS, 3), nsmall = 3)
      )
    }
  }
  
  table_str
}


#' Extract per-path metrics for configuration chart
#' @keywords internal
extract_path_metrics_for_chart <- function(sol, solution_index = 1) {
  if (is.null(sol)) return(NULL)
  
  # Try various paths to get incl.cov data frame
  
  # Path 1: sol$IC$incl.cov (single solution without dir.exp)
  if (!is.null(sol$IC$incl.cov)) {
    return(sol$IC$incl.cov)
  }
  
  # Path 2: Through i.sol
  if (!is.null(sol$i.sol) && length(sol$i.sol) >= solution_index) {
    isol <- sol$i.sol[[solution_index]]
    if (!is.null(isol$IC$incl.cov)) {
      return(isol$IC$incl.cov)
    }
  }
  
  # Path 3: Through IC$individual
  if (!is.null(sol$IC$individual)) {
    indiv <- sol$IC$individual
    if (length(indiv) >= solution_index) {
      if (!is.null(indiv[[solution_index]]$incl.cov)) {
        return(indiv[[solution_index]]$incl.cov)
      }
    }
  }
  
  NULL
}


#' Extract solution-level metrics for configuration chart
#' @keywords internal
extract_solution_metrics_for_chart <- function(sol, solution_index = 1) {
  if (is.null(sol)) return(NULL)
  
  # Path 1: sol$IC$sol.incl.cov
  if (!is.null(sol$IC$sol.incl.cov)) {
    return(list(
      inclS = sol$IC$sol.incl.cov$inclS,
      covS  = sol$IC$sol.incl.cov$covS
    ))
  }
  
  # Path 2: Through i.sol
  if (!is.null(sol$i.sol) && length(sol$i.sol) >= solution_index) {
    isol <- sol$i.sol[[solution_index]]
    if (!is.null(isol$IC$sol.incl.cov)) {
      return(list(
        inclS = isol$IC$sol.incl.cov$inclS,
        covS  = isol$IC$sol.incl.cov$covS
      ))
    }
  }
  
  # Path 3: Through IC$overall
  if (!is.null(sol$IC$overall$sol.incl.cov)) {
    return(list(
      inclS = sol$IC$overall$sol.incl.cov$inclS,
      covS  = sol$IC$overall$sol.incl.cov$covS
    ))
  }
  
  NULL
}


#' Add metrics rows to markdown table
#' @keywords internal
add_metrics_rows <- function(table_str, metrics, labels) {
  
  n_paths <- nrow(metrics)
  
  # Add consistency row
  if ("inclS" %in% names(metrics)) {
    vals <- format(round(metrics$inclS, 3), nsmall = 3)
    row <- paste0("| **", labels$consistency, "** | ", 
                  paste(vals, collapse = " | "), " |")
    table_str <- paste0(table_str, "\n", row)
  }
  
  # Add raw coverage row
  if ("covS" %in% names(metrics)) {
    vals <- format(round(metrics$covS, 3), nsmall = 3)
    row <- paste0("| **", labels$raw_coverage, "** | ", 
                  paste(vals, collapse = " | "), " |")
    table_str <- paste0(table_str, "\n", row)
  }
  
  # Add unique coverage row
  if ("covU" %in% names(metrics)) {
    vals <- format(round(metrics$covU, 3), nsmall = 3)
    row <- paste0("| **", labels$unique_coverage, "** | ", 
                  paste(vals, collapse = " | "), " |")
    table_str <- paste0(table_str, "\n", row)
  }
  
  table_str
}


#' Generate configuration chart from paths (simple interface)
#'
#' A simpler interface for generating configuration charts when you have
#' paths directly (without a full QCA solution object).
#'
#' @param paths Character vector. Paths in QCA notation (e.g., "A*B*~C").
#' @param symbol_set Character. One of \code{"unicode"}, \code{"ascii"}, 
#'   or \code{"latex"}.
#' @param language Character. \code{"en"} for English, \code{"ja"} for Japanese.
#' @param condition_order Character vector. Optional ordering of conditions.
#' @param n_sol Integer. Number of equivalent solutions. If > 1, a note is added
#'   explaining that multiple solutions exist and M1 is shown. Default is 1.
#' @param solution_note Logical. Whether to add solution note when n_sol > 1.
#'   Default is TRUE.
#' @param solution_note_style Character. \code{"simple"} or \code{"detailed"}.
#'   Default is \code{"simple"}.
#' @param epi_list Character vector. Essential prime implicants for detailed notes.
#'   Only used when \code{solution_note_style = "detailed"}.
#'
#' @return Character string containing Markdown-formatted table.
#'
#' @export
#'
#' @examples
#' # Simple usage with paths
#' paths <- c("A*B", "A*C*~D", "B*E")
#' chart <- config_chart_from_paths(paths)
#' cat(chart)
#'
#' # With ASCII symbols
#' chart <- config_chart_from_paths(paths, symbol_set = "ascii")
#' cat(chart)
#'
#' # With multiple solution note
#' chart <- config_chart_from_paths(paths, n_sol = 2)
#' cat(chart)
#'
#' # With detailed note including EPIs
#' chart <- config_chart_from_paths(
#'   paths, n_sol = 2,
#'   solution_note_style = "detailed",
#'   epi_list = c("A*B")
#' )
#' cat(chart)
config_chart_from_paths <- function(paths,
                                     symbol_set = c("unicode", "ascii", "latex"),
                                     language = c("en", "ja"),
                                     condition_order = NULL,
                                     n_sol = 1L,
                                     solution_note = TRUE,
                                     solution_note_style = c("simple", "detailed"),
                                     epi_list = NULL) {
  
  symbol_set <- match.arg(symbol_set)
  language <- match.arg(language)
  solution_note_style <- match.arg(solution_note_style)
  symbols <- SYMBOL_SETS[[symbol_set]]
  labels <- get_config_labels(language)
  
  # Get symbol note
  legend_note <- if (language == "ja") symbols$note_ja else symbols$note_en
  
  # Determine format for solution note
  format_type <- if (symbol_set == "latex") "latex" else "markdown"
  
  # Determine conditions
  if (is.null(condition_order)) {
    conditions <- extract_conditions_from_paths(paths)
  } else {
    conditions <- condition_order
  }
  
  # Build matrix and table
  mat <- build_config_matrix(paths, conditions, symbols)
  table_str <- config_matrix_to_md(mat, labels$condition)
  
  # Add legend
  result <- paste0(table_str, "\n\n*", legend_note, "*")
  
  # Add solution note if multiple solutions exist
  if (solution_note && !is.null(n_sol) && n_sol > 1) {
    sol_note <- generate_solution_note(
      n_sol = n_sol,
      epi_list = epi_list,
      style = solution_note_style,
      language = language,
      format = format_type
    )
    result <- paste0(result, "\n\n", sol_note)
  }
  
  paste0(result, "\n")
}


#' Generate configuration chart for multiple solutions (simple interface)
#'
#' Generates separate configuration charts for multiple solutions.
#'
#' @param solutions List of character vectors. Each element is a vector of 
#'   paths for one solution.
#' @param symbol_set Character. One of \code{"unicode"}, \code{"ascii"}, 
#'   or \code{"latex"}.
#' @param language Character. \code{"en"} for English, \code{"ja"} for Japanese.
#' @param condition_order Character vector. Optional ordering of conditions.
#' @param show_epi Logical. Whether to identify and display Essential Prime
#'   Implicants (EPIs) in the note. Default is FALSE.
#'
#' @return Character string containing Markdown-formatted tables.
#'
#' @export
#'
#' @examples
#' # Multiple solutions
#' solutions <- list(
#'   c("A*B", "C"),
#'   c("A*B", "D"),
#'   c("A*C")
#' )
#' chart <- config_chart_multi_solutions(solutions)
#' cat(chart)
#'
#' # With EPI identification
#' chart <- config_chart_multi_solutions(solutions, show_epi = TRUE)
#' cat(chart)
config_chart_multi_solutions <- function(solutions,
                                          symbol_set = c("unicode", "ascii", "latex"),
                                          language = c("en", "ja"),
                                          condition_order = NULL,
                                          show_epi = FALSE) {
  
  symbol_set <- match.arg(symbol_set)
  language <- match.arg(language)
  symbols <- SYMBOL_SETS[[symbol_set]]
  labels <- get_config_labels(language)
  
  # Get symbol note
  legend_note <- if (language == "ja") symbols$note_ja else symbols$note_en
  
  n_solutions <- length(solutions)
  
  # Identify EPIs if requested
  epi_info <- NULL
  if (show_epi && n_solutions > 1) {
    epi_info <- identify_epi(solutions)
  }
  
  # Build note message
  if (show_epi && !is.null(epi_info) && length(epi_info$epi) > 0) {
    # Format EPIs
    epi_str <- paste(epi_info$epi, collapse = ", ")
    epi_str <- gsub("\\*", "\u00B7", epi_str)  # middle dot for markdown
    
    if (language == "ja") {
      note_msg <- paste0(
        "**", labels$note, ":** ", n_solutions, " ", labels$equiv_solutions, " ",
        labels$separate_tables, "\n\n",
        "**Essential Prime Implicants (EPI):** ", epi_str, "\n\n"
      )
    } else {
      note_msg <- paste0(
        "**", labels$note, ":** ", n_solutions, " ", labels$equiv_solutions, " ",
        labels$separate_tables, "\n\n",
        "**Essential Prime Implicants (EPI):** ", epi_str, "\n\n"
      )
    }
  } else if (show_epi && !is.null(epi_info) && length(epi_info$epi) == 0) {
    # No EPIs - all terms are SPIs
    if (language == "ja") {
      note_msg <- paste0(
        "**", labels$note, ":** ", n_solutions, " ", labels$equiv_solutions, " ",
        labels$separate_tables, "\n\n",
        "*", labels$no_epi, "*\n\n"
      )
    } else {
      note_msg <- paste0(
        "**", labels$note, ":** ", n_solutions, " ", labels$equiv_solutions, " ",
        labels$separate_tables, "\n\n",
        "*", labels$no_epi, "*\n\n"
      )
    }
  } else {
    # Simple note
    note_msg <- paste0(
      "**", labels$note, ":** ", n_solutions, " ", labels$equiv_solutions, " ",
      labels$separate_tables, "\n\n"
    )
  }
  
  # Generate chart for each solution
  charts <- lapply(seq_along(solutions), function(i) {
    paths <- solutions[[i]]
    
    # Determine conditions
    if (is.null(condition_order)) {
      conditions <- extract_conditions_from_paths(paths)
    } else {
      conditions <- condition_order
    }
    
    header <- paste0("### ", labels$solution, " M", i, "\n\n")
    mat <- build_config_matrix(paths, conditions, symbols)
    table_str <- config_matrix_to_md(mat, labels$condition)
    paste0(header, table_str)
  })
  
  # Combine
  paste0(note_msg, 
         paste(charts, collapse = "\n\n---\n\n"),
         "\n\n*", legend_note, "*\n")
}

Try the TSQCA package in your browser

Any scripts or data that you put into this service are public.

TSQCA documentation built on Feb. 18, 2026, 5:06 p.m.