R/tsqca_report.R

Defines functions write_simple_report write_full_report generate_report

Documented in generate_report write_full_report write_simple_report

###############################################
# Report generation for TSQCA
###############################################

#' Generate Markdown Report for QCA Analysis
#'
#' Creates a markdown report from QCA analysis results.
#' Supports two formats: "full" (comprehensive) and "simple" (for manuscripts).
#'
#' @param result A result object from any Sweep function with
#'   \code{return_details = TRUE}.
#' @param output_file Character. Path to output markdown file.
#' @param format Character. Report format: \code{"full"} or \code{"simple"}.
#' @param title Character. Report title.
#' @param dat Optional data frame. Original data for descriptive statistics.
#' @param desc_vars Optional character vector. Variables for descriptive statistics.
#'   If NULL and dat is provided, uses Yvar and Xvars from params.
#' @param include_chart Logical. If TRUE (default), includes configuration charts
#'   (Fiss-style tables) in the report for each threshold.
#' @param chart_symbol_set Character. Symbol set for configuration charts:
#'   \code{"unicode"} (default), \code{"ascii"}, or \code{"latex"}.
#' @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 (sufficient
#'   configuration). This format is recommended for academic publications.
#'   \code{"summary"} produces threshold-level summaries where each
#'   column represents one threshold, aggregating all configurations.
#' @param solution_note Logical. If TRUE (default), adds a note when multiple
#'   equivalent solutions exist explaining that M1 is shown.
#' @param solution_note_style Character. Style of solution note:
#'   \code{"simple"} (default) or \code{"detailed"} (includes EPIs).
#' @param solution_note_lang Character. Language for solution notes:
#'   \code{"en"} (default) or \code{"ja"}.
#' @param include_raw_output Logical. If TRUE (default), includes the raw QCA
#'   package output (print(sol)) for each threshold for verification purposes.
#'
#' @return Invisibly returns the path to the generated report.
#' @export
#'
#' @examples
#' \dontrun{
#' data(sample_data)
#' thrX <- c(X1 = 7, X2 = 7, X3 = 7)
#' 
#' result <- otSweep(
#'   dat = sample_data,
#'   outcome = "Y",
#'   conditions = c("X1", "X2", "X3"),
#'   sweep_range = 6:8,
#'   thrX = thrX,
#'   return_details = TRUE
#' )
#' 
#' # With descriptive statistics and configuration charts
#' generate_report(result, "my_report.md", format = "full", 
#'                 dat = sample_data, include_chart = TRUE)
#' 
#' # Without configuration charts
#' generate_report(result, "my_report.md", format = "simple",
#'                 include_chart = FALSE)
#' 
#' # With Fiss-style term-level charts (default, recommended for publications)
#' generate_report(result, "my_report.md", format = "full")
#' 
#' # With threshold-level summary charts
#' generate_report(result, "my_report.md", format = "full",
#'                 chart_level = "summary")
#' 
#' # With detailed solution notes (including EPIs)
#' generate_report(result, "my_report.md", format = "full",
#'                 solution_note_style = "detailed")
#' }
generate_report <- function(result,
                            output_file = "qca_report.md",
                            format = c("full", "simple"),
                            title = "QCA Analysis Report",
                            dat = NULL,
                            desc_vars = NULL,
                            include_chart = TRUE,
                            chart_symbol_set = c("unicode", "ascii", "latex"),
                            chart_level = c("term", "summary"),
                            solution_note = TRUE,
                            solution_note_style = c("simple", "detailed"),
                            solution_note_lang = c("en", "ja"),
                            include_raw_output = TRUE) {
  
  format <- match.arg(format)
  chart_symbol_set <- match.arg(chart_symbol_set)
  chart_level <- match.arg(chart_level)
  solution_note_style <- match.arg(solution_note_style)
  solution_note_lang <- match.arg(solution_note_lang)
  
  # Validate input
  if (!is.list(result)) {
    stop("'result' must be a list object from a Sweep function.")
  }
  
  if (!"details" %in% names(result)) {
    stop("'result' must contain 'details'. Use return_details = TRUE in Sweep functions.")
  }
  
  # Open file connection
  con <- file(output_file, open = "w", encoding = "UTF-8")
  on.exit(close(con), add = TRUE)
  
  # Write header
  writeLines(paste0("# ", title, "\n"), con)
  writeLines("*(Auto-generated by TSQCA package)*\n", con)
  writeLines(paste0("**Generated**: ", format(Sys.time(), "%Y-%m-%d %H:%M"), "\n"), con)
  writeLines("---\n", con)
  
  # Dispatch to appropriate format
  if (format == "full") {
    write_full_report(result, con, dat, desc_vars, include_chart, chart_symbol_set,
                      chart_level, solution_note, solution_note_style, solution_note_lang,
                      include_raw_output)
  } else {
    write_simple_report(result, con, include_chart, chart_symbol_set,
                        chart_level, solution_note, solution_note_style, solution_note_lang,
                        include_raw_output)
  }
  
  message("Report generated: ", output_file)
  invisible(output_file)
}


#' Write full report content
#' @keywords internal
write_full_report <- function(result, con, dat = NULL, desc_vars = NULL,
                              include_chart = TRUE, chart_symbol_set = "unicode",
                              chart_level = "term",
                              solution_note = TRUE, solution_note_style = "simple",
                              solution_note_lang = "en",
                              include_raw_output = TRUE) {
  
  summary_df <- result$summary
  details <- result$details
  params <- result$params
  
  # ============================================
  # 0. Analysis Overview
  # ============================================
  writeLines("## 0. Analysis Overview\n", con)
  writeLines("| Item | Value |", con)
  writeLines("|------|-------|", con)
  writeLines(paste0("| Analysis Date | ", format(Sys.time(), "%Y-%m-%d %H:%M"), " |"), con)
  
  if (!is.null(dat)) {
    writeLines(paste0("| Total N | ", nrow(dat), " |"), con)
  }
  
  if (!is.null(params)) {
    # Support both old (Yvar/Xvars) and new (outcome/conditions) parameter names
    outcome_var <- params$outcome
    if (is.null(outcome_var)) outcome_var <- params$Yvar
    conditions_var <- params$conditions
    if (is.null(conditions_var)) conditions_var <- params$Xvars
    
    if (!is.null(outcome_var)) {
      outcome_display <- outcome_var
      if (isTRUE(params$negate_outcome)) {
        outcome_display <- paste0(outcome_var, " (negated)")
      }
      writeLines(paste0("| Outcome Variable | ", outcome_display, " |"), con)
    }
    if (!is.null(conditions_var)) {
      writeLines(paste0("| Condition Variables | ", paste(conditions_var, collapse = ", "), " |"), con)
    }
    if (!is.null(params$pre_calibrated)) {
      pc_str <- paste(params$pre_calibrated, collapse = ", ")
      writeLines(paste0("| Pre-Calibrated Conditions | ", pc_str, " (passed through, no binarization) |"), con)
    }
    if (!is.null(params$thrX)) {
      thrX_str <- paste(names(params$thrX), params$thrX, sep = "=", collapse = ", ")
      writeLines(paste0("| X Thresholds | ", thrX_str, " |"), con)
    }
    if (!is.null(params$sweep_range)) {
      writeLines(paste0("| Y Sweep Range | ", min(params$sweep_range), "-", max(params$sweep_range), " |"), con)
    }
    if (!is.null(params$thrY)) {
      writeLines(paste0("| Y Threshold | ", params$thrY, " |"), con)
    }
    if (!is.null(params$incl.cut)) {
      writeLines(paste0("| Consistency Cutoff | ", params$incl.cut, " |"), con)
    }
    if (!is.null(params$n.cut)) {
      writeLines(paste0("| Frequency Cutoff (n.cut) | ", params$n.cut, " |"), con)
    }
    if (!is.null(params$include)) {
      writeLines(paste0("| Include | ", params$include, " |"), con)
    }
    if (!is.null(params$dir.exp)) {
      dir_str <- ifelse(all(params$dir.exp == 1), "positive (all)", 
                        paste(params$dir.exp, collapse = ", "))
      writeLines(paste0("| Directional Expectations | ", dir_str, " |"), con)
    }
    # Solution Type (determined from include and dir.exp)
    solution_type <- if (is.null(params$include) || params$include == "") {
      "Complex (Conservative)"
    } else if (!is.null(params$dir.exp)) {
      "Intermediate"
    } else {
      "Parsimonious"
    }
    writeLines(paste0("| **Solution Type** | **", solution_type, "** |"), con)
  }
  writeLines("\n---\n", con)
  
  # ============================================
  # 1. Descriptive Statistics (if dat provided)
  # ============================================
  if (!is.null(dat)) {
    writeLines("## 1. Descriptive Statistics\n", con)
    
    # Determine variables (support both old and new parameter names)
    if (is.null(desc_vars) && !is.null(params)) {
      outcome_var <- params$outcome
      if (is.null(outcome_var)) outcome_var <- params$Yvar
      conditions_var <- params$conditions
      if (is.null(conditions_var)) conditions_var <- params$Xvars
      
      # For negated outcome, use the cleaned variable name
      if (!is.null(outcome_var)) {
        outcome_clean <- sub("^~", "", outcome_var)
        desc_vars <- c(outcome_clean, conditions_var)
      } else {
        desc_vars <- conditions_var
      }
    }
    
    if (!is.null(desc_vars)) {
      desc_df <- data.frame(
        Variable = character(0),
        n = integer(0),
        Mean = numeric(0),
        SD = numeric(0),
        Min = numeric(0),
        Max = numeric(0),
        Skew = numeric(0),
        Kurtosis = numeric(0),
        stringsAsFactors = FALSE
      )
      
      for (var in desc_vars) {
        if (var %in% names(dat)) {
          x <- dat[[var]]
          x <- x[!is.na(x)]
          n <- length(x)
          m <- mean(x)
          s <- sd(x)
          
          # Skewness
          skew <- if (n > 2 && s > 0) {
            sum((x - m)^3) / (n * s^3)
          } else {
            NA
          }
          
          # Kurtosis (excess)
          kurt <- if (n > 3 && s > 0) {
            sum((x - m)^4) / (n * s^4) - 3
          } else {
            NA
          }
          
          desc_df <- rbind(desc_df, data.frame(
            Variable = var,
            n = n,
            Mean = round(m, 3),
            SD = round(s, 3),
            Min = round(min(x), 3),
            Max = round(max(x), 3),
            Skew = round(skew, 3),
            Kurtosis = round(kurt, 3),
            stringsAsFactors = FALSE
          ))
        }
      }
      
      if (nrow(desc_df) > 0) {
        writeLines(df_to_md_table(desc_df), con)
      }
    }
    writeLines("\n---\n", con)
  }
  
  # ============================================
  # 2. Summary Table
  # ============================================
  section_num <- if (!is.null(dat)) 2 else 1
  writeLines(paste0("## ", section_num, ". Summary Table\n"), con)
  writeLines(df_to_md_table(summary_df), con)
  writeLines("\n---\n", con)
  
  # ============================================
  # 3. Detailed Results per Threshold
  # ============================================
  section_num <- section_num + 1
  writeLines(paste0("## ", section_num, ". Detailed Results\n"), con)
  
  # Limit detailed output to avoid extremely long reports
  n_combinations <- length(details)
  MAX_DETAILS <- 27
  
  if (n_combinations > MAX_DETAILS) {
    writeLines(paste0("Due to the large number of threshold combinations (", 
                      n_combinations, "), detailed per-threshold results ",
                      "(necessity analysis, truth tables, per-term metrics) ",
                      "are omitted from this report.\n"), con)
    writeLines("", con)
    writeLines("To access details for specific threshold combinations, use:\n", con)
    writeLines("```r", con)
    writeLines("# List all threshold combinations", con)
    writeLines("names(result$details)", con)
    writeLines("", con)
    writeLines("# Access a specific combination (e.g., first one)", con)
    writeLines("key <- names(result$details)[1]", con)
    writeLines("det <- result$details[[key]]", con)
    writeLines("", con)
    writeLines("# Available components:", con)
    writeLines("det$truth_table$tt   # Truth table", con)
    writeLines("det$solution         # QCA solution object", con)
    writeLines("det$dat_bin          # Binarized data (for necessity analysis with QCA::pofind)", con)
    writeLines("det$thrX_vec         # X thresholds used", con)
    writeLines("det$thrY             # Y threshold used", con)
    writeLines("```\n", con)
  } else {
  
  for (key in names(details)) {
    det <- details[[key]]
    
    # Determine threshold label
    if (!is.null(det$thrY)) {
      writeLines(paste0("### thrY = ", det$thrY, "\n"), con)
    } else if (!is.null(det$threshold)) {
      writeLines(paste0("### Threshold = ", det$threshold, "\n"), con)
    } else if (!is.null(det$combo_id)) {
      writeLines(paste0("### Combination ", det$combo_id, "\n"), con)
    } else {
      writeLines(paste0("### ", key, "\n"), con)
    }
    
    # X thresholds
    if (!is.null(det$thrX_vec)) {
      thrX_str <- paste(names(det$thrX_vec), det$thrX_vec, sep = "=", collapse = ", ")
      writeLines(paste0("**X Thresholds**: ", thrX_str, "\n"), con)
    }
    
    # ---- Necessity Analysis ----
    dat_bin <- det$dat_bin
    if (!is.null(dat_bin) && !is.null(det$thrX_vec)) {
      Xvars <- names(det$thrX_vec)
      nec <- try(QCA::pofind(dat_bin, outcome = "Y", conditions = Xvars), silent = TRUE)
      if (!inherits(nec, "try-error") && !is.null(nec$incl.cov)) {
        writeLines("#### Necessity Analysis\n", con)
        nec_df <- nec$incl.cov
        nec_df <- cbind(Condition = rownames(nec_df), nec_df)
        rownames(nec_df) <- NULL
        writeLines(df_to_md_table(nec_df), con)
        writeLines("\n", con)
      }
    }
    
    # ---- Truth Table ----
    tt <- det$truth_table
    if (!is.null(tt) && !is.null(tt$tt)) {
      writeLines("#### Truth Table (observed configurations)\n", con)
      tt_df <- tt$tt
      tt_observed <- tt_df[tt_df$n > 0, , drop = FALSE]
      if (nrow(tt_observed) > 0) {
        tt_cols <- intersect(c(names(det$thrX_vec), "OUT", "n", "incl", "PRI"), names(tt_observed))
        tt_subset <- tt_observed[, tt_cols, drop = FALSE]
        tt_subset <- cbind(Row = rownames(tt_subset), tt_subset)
        rownames(tt_subset) <- NULL
        writeLines(df_to_md_table(tt_subset), con)
      } else {
        writeLines("*(No observed configurations)*", con)
      }
      writeLines("\n", con)
    }
    
    # ---- Solution ----
    sol <- det$solution
    if (is.null(sol)) {
      writeLines("#### Solution\n", con)
      writeLines("**No solution**\n", con)
    } else {
      n_sol <- get_n_solutions(sol)
      writeLines("#### Solution\n", con)
      writeLines(paste0("**Number of Solutions**: ", n_sol, "\n"), con)
      
      # Get solution list (i.sol first for true Intermediate when dir.exp specified)
      sol_list <- NULL
      if (!is.null(sol$i.sol) && length(sol$i.sol) > 0) {
        all_sols <- list()
        for (model_name in names(sol$i.sol)) {
          model_sols <- sol$i.sol[[model_name]]$solution
          if (!is.null(model_sols) && length(model_sols) > 0) {
            for (s in model_sols) {
              all_sols <- c(all_sols, list(s))
            }
          }
        }
        if (length(all_sols) > 0) {
          sol_list <- all_sols
        }
      }
      # Fallback: sol$solution (Parsimonious or when dir.exp not specified)
      if (is.null(sol_list) || length(sol_list) == 0) {
        if (!is.null(sol$solution) && length(sol$solution) > 0) {
          sol_list <- sol$solution
        }
      }
      
      if (!is.null(sol_list) && length(sol_list) > 0) {
        writeLines("**Full Solutions**:\n", con)
        for (i in seq_along(sol_list)) {
          expr <- paste(sol_list[[i]], collapse = " + ")
          writeLines(paste0("- M", i, ": ", escape_md(expr), " -> Y\n"), con)
        }
        writeLines("\n", con)
        
        # Essential/Selective Prime Implicants (if multiple solutions)
        if (length(sol_list) > 1) {
          sol_terms <- lapply(sol_list, function(x) {
            if (is.character(x)) x else unlist(strsplit(paste(x, collapse = " + "), " \\+ "))
          })
          essential_terms <- Reduce(intersect, sol_terms)
          all_terms <- Reduce(union, sol_terms)
          selective_terms <- setdiff(all_terms, essential_terms)
          
          if (length(essential_terms) > 0) {
            writeLines(paste0("**Essential Prime Implicants**: ", 
                              escape_md(paste(essential_terms, collapse = " + ")), "\n"), con)
          } else {
            writeLines("**Essential Prime Implicants**: (none - solutions are disjoint)\n", con)
          }
          
          if (length(selective_terms) > 0) {
            writeLines(paste0("**Selective Prime Implicants**: ", 
                              escape_md(paste(selective_terms, collapse = " + ")), "\n"), con)
          }
          
          # Unique Terms
          unique_terms_list <- lapply(seq_along(sol_terms), function(i) {
            other_terms <- unique(unlist(sol_terms[-i]))
            setdiff(sol_terms[[i]], other_terms)
          })
          unique_terms_formatted <- sapply(seq_along(unique_terms_list), function(i) {
            if (length(unique_terms_list[[i]]) > 0) {
              paste0("M", i, ": ", escape_md(paste(unique_terms_list[[i]], collapse = " + ")))
            } else {
              NULL
            }
          })
          unique_terms_filtered <- unique_terms_formatted[!sapply(unique_terms_formatted, is.null)]
          if (length(unique_terms_filtered) > 0) {
            writeLines(paste0("**Unique Terms**: ", 
                              paste(unique_terms_filtered, collapse = "; "), "\n"), con)
          }
          writeLines("\n", con)
        }
      }
      
      # ---- Solution Fit ----
      writeLines("#### Solution Fit\n", con)
      # Use sol$IC directly for better compatibility with multiple solutions
      metrics <- extract_all_metrics(sol$IC, sol)
      writeLines("| Metric | Value |", con)
      writeLines("|--------|-------|", con)
      writeLines(paste0("| Consistency (inclS) | ", 
                        ifelse(is.na(metrics$sol_inclS), "N/A", round(metrics$sol_inclS, 3)), " |"), con)
      writeLines(paste0("| PRI | ", 
                        ifelse(is.na(metrics$sol_PRI), "N/A", round(metrics$sol_PRI, 3)), " |"), con)
      writeLines(paste0("| Coverage (covS) | ", 
                        ifelse(is.na(metrics$sol_covS), "N/A", round(metrics$sol_covS, 3)), " |"), con)
      writeLines("\n", con)
      
      # ---- Per-Term Metrics ----
      if (!is.null(metrics$term_df)) {
        writeLines("#### Per-Term Metrics\n", con)
        term_df <- metrics$term_df
        if ("cases" %in% names(term_df)) {
          term_df <- term_df[, !names(term_df) %in% "cases", drop = FALSE]
        }
        term_df <- cbind(Term = rownames(term_df), term_df)
        rownames(term_df) <- NULL
        writeLines(df_to_md_table(term_df), con)
        writeLines("\n", con)
      }
      
      # ---- Configuration Chart ----
      if (include_chart && !is.null(sol_list) && length(sol_list) > 0) {
        writeLines("#### Configuration Chart\n", con)
        
        # Always show M1 with note if multiple solutions exist
        paths <- sol_list[[1]]
        if (!is.character(paths)) {
          paths <- as.character(paths)
        }
        
        if (length(paths) > 0) {
          # Get EPIs if using detailed style
          epi_list <- NULL
          if (solution_note_style == "detailed" && length(sol_list) > 1) {
            epi_info <- identify_epi(sol_list)
            epi_list <- epi_info$epi
          }
          
          chart <- config_chart_from_paths(
            paths, 
            symbol_set = chart_symbol_set,
            language = solution_note_lang,
            n_sol = length(sol_list),
            solution_note = solution_note,
            solution_note_style = solution_note_style,
            epi_list = epi_list
          )
          writeLines(chart, con)
          writeLines("\n", con)
        }
      }
      
      # ---- QCA Package Output (for verification) ----
      if (include_raw_output) {
        writeLines("#### QCA Package Output (for verification)\n", con)
        writeLines("```", con)
        raw_output <- capture.output(print(sol))
        writeLines(raw_output, con)
        writeLines("```\n", con)
      }
    }
    
    # ---- Settings for Reproducibility ----
    writeLines("#### Settings (for reproducibility)\n", con)
    writeLines("```", con)
    if (!is.null(det$thrX_vec)) {
      writeLines(paste0("thrX: ", paste(det$thrX_vec, collapse = ", ")), con)
    }
    if (!is.null(det$thrY)) {
      writeLines(paste0("thrY: ", det$thrY), con)
    }
    if (!is.null(params$incl.cut)) {
      writeLines(paste0("incl.cut: ", params$incl.cut), con)
    }
    if (!is.null(params$dir.exp)) {
      writeLines(paste0("dir.exp: ", paste(params$dir.exp, collapse = ", ")), con)
    }
    writeLines("```\n", con)
    
    writeLines("---\n", con)
  }
  
  }  # End of if (n_combinations <= MAX_DETAILS)
  
  # ============================================
  # 4. Cross-Threshold Comparison
  # ============================================
  section_num <- section_num + 1
  writeLines(paste0("## ", section_num, ". Cross-Threshold Comparison\n"), con)
  
  if (n_combinations > MAX_DETAILS) {
    writeLines("Cross-threshold comparison table is designed for single-dimension sweeps ", con)
    writeLines("(otSweep, ctSweepS) with a smaller number of thresholds.\n", con)
    writeLines("", con)
    writeLines("For multi-dimensional sweeps with many combinations, ", con)
    writeLines("please refer to the Summary Table above to compare results across threshold settings.\n", con)
  } else {
  
  # Build comparison table
  comp_df <- data.frame(
    Threshold = character(0),
    inclS = numeric(0),
    PRI = numeric(0),
    covS = numeric(0),
    n_solutions = integer(0),
    N_Essential = integer(0),
    stringsAsFactors = FALSE
  )
  
  for (key in names(details)) {
    det <- details[[key]]
    sol <- det$solution
    
    # Threshold label
    thr_label <- if (!is.null(det$thrY)) {
      paste0("thrY=", det$thrY)
    } else if (!is.null(det$threshold)) {
      as.character(det$threshold)
    } else {
      key
    }
    
    if (is.null(sol)) {
      comp_df <- rbind(comp_df, data.frame(
        Threshold = thr_label,
        inclS = NA,
        PRI = NA,
        covS = NA,
        n_solutions = 0,
        N_Essential = 0,
        stringsAsFactors = FALSE
      ))
    } else {
      metrics <- extract_all_metrics(sol$IC, sol)
      n_sol <- get_n_solutions(sol)
      
      # Count essential prime implicants (i.sol first for true Intermediate)
      n_essential <- 0
      sol_list <- NULL
      if (!is.null(sol$i.sol) && length(sol$i.sol) > 0) {
        all_sols <- list()
        for (model_name in names(sol$i.sol)) {
          model_sols <- sol$i.sol[[model_name]]$solution
          if (!is.null(model_sols) && length(model_sols) > 0) {
            for (s in model_sols) {
              all_sols <- c(all_sols, list(s))
            }
          }
        }
        if (length(all_sols) > 0) sol_list <- all_sols
      }
      if (is.null(sol_list) || length(sol_list) == 0) {
        sol_list <- sol$solution
      }
      if (!is.null(sol_list) && length(sol_list) > 1) {
        sol_terms <- lapply(sol_list, function(x) {
          if (is.character(x)) x else unlist(strsplit(paste(x, collapse = " + "), " \\+ "))
        })
        essential_terms <- Reduce(intersect, sol_terms)
        n_essential <- length(essential_terms)
      } else if (!is.null(sol_list) && length(sol_list) == 1) {
        n_essential <- length(sol_list[[1]])
      }
      
      comp_df <- rbind(comp_df, data.frame(
        Threshold = thr_label,
        inclS = round(metrics$sol_inclS, 3),
        PRI = round(metrics$sol_PRI, 3),
        covS = round(metrics$sol_covS, 3),
        n_solutions = n_sol,
        N_Essential = n_essential,
        stringsAsFactors = FALSE
      ))
    }
  }
  
  writeLines(df_to_md_table(comp_df), con)
  
  }  # End of if (n_combinations <= MAX_DETAILS) for Section 4
  
  writeLines("\n---\n", con)
  
  # ============================================
  # 5. Cross-Threshold Configuration Chart
  # ============================================
  if (include_chart && n_combinations <= MAX_DETAILS) {
    section_num <- section_num + 1
    writeLines(paste0("## ", section_num, ". Cross-Threshold Configuration Chart\n"), con)
    
    # Get conditions from params
    conditions <- params$conditions
    if (is.null(conditions)) conditions <- params$Xvars
    
    if (!is.null(conditions) && length(conditions) > 0) {
      # Describe chart level
      if (chart_level == "term") {
        writeLines("*Configuration chart at solution-term level (Fiss, 2011 notation).*\n", con)
        writeLines("*Each column represents one prime implicant (configuration).*\n\n", con)
      } else {
        writeLines("*Configuration chart at threshold-level summary.*\n", con)
        writeLines("*Each column aggregates all conditions that appear in any configuration at that threshold.*\n\n", con)
      }
      
      symbols <- SYMBOL_SETS[[chart_symbol_set]]
      chart <- if (chart_level == "term") {
        generate_term_level_chart(summary_df, conditions, symbols, solution_note_lang)
      } else {
        generate_threshold_level_chart(summary_df, conditions, symbols, solution_note_lang)
      }
      
      writeLines(chart, con)
    } else {
      writeLines("*(Could not generate configuration chart - conditions not found)*\n", con)
    }
    
    writeLines("\n---\n", con)
  }
  
  # ============================================
  # 6. Notes
  # ============================================
  section_num <- section_num + 1
  writeLines(paste0("## ", section_num, ". Notes\n"), con)
  writeLines("- **Essential Prime Implicants (EPI)**: Terms that appear in ALL equivalent solutions (M1, M2, M3...).", con)
  writeLines("- **Selective Prime Implicants (SPI)**: Terms that appear in some but not all solutions.", con)
  writeLines("- **Unique Terms**: Terms that appear only in one specific solution.", con)
  writeLines("- **inclS**: Solution consistency (sufficiency).", con)
  writeLines("- **covS**: Solution coverage.", con)
  writeLines("- **PRI**: Proportional Reduction in Inconsistency.", con)
  writeLines("- **covU**: Unique coverage (coverage by this term alone).", con)
  writeLines("- **inclN**: Necessity consistency (>= 0.9 typically indicates necessary condition).", con)
  writeLines("- **RoN**: Relevance of Necessity.", con)
  writeLines("- **covN**: Necessity coverage.", con)
  
  writeLines("\n---\n", con)
  
  # ============================================
  # 7. Verification Recommendation
  # ============================================
  section_num <- section_num + 1
  writeLines(paste0("## ", section_num, ". Verification Recommendation\n"), con)
  writeLines("**For academic publications**, always verify TSQCA results directly with the QCA package:\n", con)
  writeLines("```r", con)
  writeLines("library(QCA)", con)
  writeLines("tt <- truthTable(dat, outcome = \"Y\", conditions = c(...), incl.cut = 0.8)", con)
  writeLines("sol <- minimize(tt, include = \"?\", dir.exp = c(1, 1, ...))", con)
  writeLines("print(sol)  # Compare with TSQCA output above", con)
  writeLines("```\n", con)
  writeLines("Ensure that solution expressions, consistency, and coverage values match before publishing.", con)
  writeLines("\n", con)
  writeLines("*Report generated by TSQCA package (https://github.com/im-research-yt/TSQCA)*", con)
}


#' Write simple report content
#' @keywords internal
write_simple_report <- function(result, con, include_chart = TRUE, 
                                chart_symbol_set = "unicode",
                                chart_level = "term",
                                solution_note = TRUE, solution_note_style = "simple",
                                solution_note_lang = "en",
                                include_raw_output = TRUE) {
  
  summary_df <- result$summary
  details <- result$details
  
  # 1. Summary Table
  writeLines("## Summary\n", con)
  writeLines(df_to_md_table(summary_df), con)
  writeLines("\n", con)
  writeLines("---\n", con)
  
  # 2. Solutions Overview
  writeLines("## Solutions Overview\n", con)
  
  for (key in names(details)) {
    det <- details[[key]]
    sol <- det$solution
    
    if (is.null(sol)) next
    
    # Determine threshold label
    if (!is.null(det$thrY)) {
      label <- paste0("Y >= ", det$thrY)
    } else if (!is.null(det$threshold)) {
      label <- paste0("threshold = ", det$threshold)
    } else {
      label <- key
    }
    
    n_sol <- get_n_solutions(sol)
    
    # Get solution list (i.sol first for true Intermediate when dir.exp specified)
    sol_list <- NULL
    
    # Try i.sol first (contains true Intermediate solution when dir.exp specified)
    if (!is.null(sol$i.sol) && length(sol$i.sol) > 0) {
      all_sols <- list()
      for (model_name in names(sol$i.sol)) {
        model_sols <- sol$i.sol[[model_name]]$solution
        if (!is.null(model_sols) && length(model_sols) > 0) {
          for (s in model_sols) {
            all_sols <- c(all_sols, list(s))
          }
        }
      }
      if (length(all_sols) > 0) {
        sol_list <- all_sols
      }
    }
    
    # Fallback to sol$solution (Parsimonious or when dir.exp not specified)
    if (is.null(sol_list) || length(sol_list) == 0) {
      if (!is.null(sol$solution) && length(sol$solution) > 0) {
        sol_list <- sol$solution
      }
    }
    
    if (!is.null(sol_list) && length(sol_list) > 0) {
      writeLines(paste0("### ", label, "\n"), con)
      
      # Show solution formula
      if (length(sol_list) == 1) {
        expr <- paste(sol_list[[1]], collapse = " + ")
        writeLines(paste0("**Solution**: ", escape_md(expr), " -> Y\n"), con)
      } else {
        writeLines(paste0("**Number of Solutions**: ", length(sol_list), "\n"), con)
        
        # Essential prime implicants
        sol_terms <- lapply(sol_list, function(x) {
          if (is.character(x)) x else unlist(strsplit(paste(x, collapse = " + "), " \\+ "))
        })
        essential_terms <- Reduce(intersect, sol_terms)
        
        if (length(essential_terms) > 0) {
          writeLines(paste0("**Essential (EPI)**: ", escape_md(paste(essential_terms, collapse = " + ")), "\n"), con)
        }
        
        # List all solutions briefly
        for (i in seq_along(sol_list)) {
          expr <- paste(sol_list[[i]], collapse = " + ")
          writeLines(paste0("- M", i, ": ", escape_md(expr), "\n"), con)
        }
      }
      
      # Metrics (brief)
      metrics <- extract_all_metrics(sol$i.sol$C1P1$IC, sol)
      writeLines(paste0("*inclS = ", 
                        ifelse(is.na(metrics$sol_inclS), "N/A", round(metrics$sol_inclS, 3)),
                        ", covS = ",
                        ifelse(is.na(metrics$sol_covS), "N/A", round(metrics$sol_covS, 3)),
                        "*\n"), con)
      
      # ---- Configuration Chart ----
      if (include_chart) {
        writeLines("\n**Configuration Chart:**\n", con)
        
        # Always show M1 with note if multiple solutions exist
        paths <- sol_list[[1]]
        if (!is.character(paths)) {
          paths <- as.character(paths)
        }
        
        if (length(paths) > 0) {
          # Get EPIs if using detailed style
          epi_list <- NULL
          if (solution_note_style == "detailed" && length(sol_list) > 1) {
            epi_info <- identify_epi(sol_list)
            epi_list <- epi_info$epi
          }
          
          chart <- config_chart_from_paths(
            paths, 
            symbol_set = chart_symbol_set,
            language = solution_note_lang,
            n_sol = length(sol_list),
            solution_note = solution_note,
            solution_note_style = solution_note_style,
            epi_list = epi_list
          )
          writeLines(chart, con)
        }
      }
      
      # ---- QCA Package Output (for verification) ----
      if (include_raw_output) {
        writeLines("\n**QCA Package Output (for verification):**\n", con)
        writeLines("```", con)
        raw_output <- capture.output(print(sol))
        writeLines(raw_output, con)
        writeLines("```\n", con)
      }
      
      writeLines("\n", con)
    }
  }
  
  # ============================================
  # Verification Recommendation
  # ============================================
  writeLines("---\n", con)
  writeLines("## Verification Recommendation\n", con)
  writeLines("**For academic publications**, always verify TSQCA results directly with the QCA package:\n", con)
  writeLines("```r", con)
  writeLines("library(QCA)", con)
  writeLines("tt <- truthTable(dat, outcome = \"Y\", conditions = c(...), incl.cut = 0.8)", con)
  writeLines("sol <- minimize(tt, include = \"?\", dir.exp = c(1, 1, ...))", con)
  writeLines("print(sol)  # Compare with TSQCA output above", con)
  writeLines("```\n", con)
  writeLines("Ensure that solution expressions, consistency, and coverage values match before publishing.", con)
  writeLines("\n", con)
  writeLines("*Report generated by TSQCA package (https://github.com/im-research-yt/TSQCA)*", con)
}

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.