R/latex_exporter.R

In fcaR: Formal Concept Analysis

#' @title Export Layout to TikZ (LaTeX)
#' @description Generates TikZ code for the concept lattice.
#'
#' @param plot_data Data frame with node info.
#' @param edges_df Data frame with edge info.
#' @param width Numeric. Target width in cm (default: 12).
#' @param height Numeric. Target height in cm (default: 12).
#' @param standalone Logical. If TRUE, wraps code in a documentclass to be compiled directly.
#' @param caption Character. Optional caption for the figure.
#' @param ... Additional arguments (currently unused).
#'
#' @return An object of class 'tikz_code'.
#' @importFrom stats na.omit
export_to_tikz <- function(
  plot_data,
  edges_df,
  width = 12,
  height = 12,
  standalone = FALSE,
  caption = NULL,
  ...
) {
  # 1. Auto-escalado inteligente
  # Calculamos el rango actual de las coordenadas abstractas
  rx <- range(plot_data$x)
  ry <- range(plot_data$y)

  dx <- diff(rx)
  if (dx == 0) {
    dx <- 1
  }
  dy <- diff(ry)
  if (dy == 0) {
    dy <- 1
  }

  # Calculamos factores para ajustar al tamaño deseado en cm
  # Dejamos un margen (0.8) para que los nodos no se corten
  sx <- (width * 0.8) / dx
  sy <- (height * 0.8) / dy

  # Aplicamos transformación
  plot_data$tx <- (plot_data$x - min(plot_data$x)) * sx
  plot_data$ty <- (plot_data$y - min(plot_data$y)) * sy

  # 2. Gestión de Colores (Hex -> LaTeX)
  used_colors <- unique(na.omit(plot_data$fill_color))
  hex_colors <- used_colors[grep("^#", used_colors)]

  color_defs <- c()
  color_map <- list()
  for (hex in hex_colors) {
    safe_name <- paste0("col", substr(hex, 2, 7))
    color_defs <- c(
      color_defs,
      sprintf("\\definecolor{%s}{HTML}{%s}", safe_name, substr(hex, 2, 7))
    )
    color_map[[hex]] <- safe_name
  }

  get_col <- function(c) {
    if (is.na(c) || c == "white") {
      return("white")
    }
    if (c == "black") {
      return("black")
    }
    if (c == "gray50") {
      return("gray!50")
    }
    if (!is.null(color_map[[c]])) {
      return(color_map[[c]])
    }
    return("gray")
  }

  # 3. Construcción del Código
  code <- c()

  if (standalone) {
    code <- c(code, "\\documentclass[tikz, border=10pt]{standalone}")
    code <- c(code, "\\usetikzlibrary{shapes, positioning, backgrounds}")
    code <- c(code, "\\begin{document}")
  }

  code <- c(code, "%%% Concept Lattice generated by fcaR %%%")
  if (length(color_defs) > 0) {
    code <- c(code, color_defs)
  }

  code <- c(code, "\\begin{tikzpicture}[")
  code <- c(
    code,
    "  node_style/.style={circle, draw=gray!80, line width=0.5pt, inner sep=2.5pt},"
  )
  code <- c(code, "  edge_style/.style={draw=gray!60, line width=0.8pt}")
  code <- c(code, "]")

  # Dibujar Aristas (Fondo)
  for (i in seq_len(nrow(edges_df))) {
    u <- plot_data[plot_data$id == edges_df$from[i], ]
    v <- plot_data[plot_data$id == edges_df$to[i], ]
    if (nrow(u) == 1 && nrow(v) == 1) {
      code <- c(
        code,
        sprintf(
          "  \\draw[edge_style] (%.2f, %.2f) -- (%.2f, %.2f);",
          u$tx,
          u$ty,
          v$tx,
          v$ty
        )
      )
    }
  }

  # Dibujar Nodos
  for (i in seq_len(nrow(plot_data))) {
    row <- plot_data[i, ]
    fill <- get_col(row$fill_color)

    # Etiquetas inteligentes
    lbl_opts <- ""
    if (!is.na(row$label_top)) {
      # Arriba: Atributos
      clean_lbl <- gsub("\n", "\\\\\\\\", row$label_top)
      lbl_opts <- paste0(
        lbl_opts,
        sprintf(
          ", label={[align=center, font=\\sffamily\\tiny, yshift=2pt]90:{%s}}",
          clean_lbl
        )
      )
    }
    if (!is.na(row$label_bottom)) {
      # Abajo: Objetos (Azul e Itálica)
      clean_lbl <- gsub("\n", "\\\\\\\\", row$label_bottom)
      lbl_opts <- paste0(
        lbl_opts,
        sprintf(
          ", label={[align=center, font=\\itshape\\tiny, text=blue!80!black, yshift=-2pt]270:{%s}}",
          clean_lbl
        )
      )
    }

    code <- c(
      code,
      sprintf(
        "  \\node[node_style, fill=%s%s] at (%.2f, %.2f) {};",
        fill,
        lbl_opts,
        row$tx,
        row$ty
      )
    )
  }

  code <- c(code, "\\end{tikzpicture}")

  if (!is.null(caption) && !standalone) {
    code <- c(code, sprintf("\\caption{%s}", caption))
  }

  if (standalone) {
    code <- c(code, "\\end{document}")
  }

  structure(paste(code, collapse = "\n"), class = "tikz_code")
}

#' @title Print TikZ Code
#' @description Prints the TikZ code to the console.
#'
#' @param x An object of class \code{tikz_code}.
#' @param ... Additional arguments (currently unused).
#'
#' @export
#' @method print tikz_code
print.tikz_code <- function(x, ...) {
  cat(x)
  invisible(x)
}

#' @title Save TikZ Code to File
#' @description Exports the generated TikZ code to a .tex file.
#'
#' @param x An object of class 'tikz_code'.
#' @param file Character. Path to the output file.
#' @param ... Additional arguments.
#'
#' @export
save_tikz <- function(x, file, ...) {
  UseMethod("save_tikz")
}

#' @export
#' @method save_tikz tikz_code
save_tikz.tikz_code <- function(x, file, ...) {
  # writeLines maneja la codificación y saltos de línea correctamente
  writeLines(as.character(x), con = file)

  # Mensaje amigable para el usuario (opcional)
  message(sprintf("TikZ code successfully saved to '%s'", file))

  # Devolvemos invisiblemente x para permitir seguir usando pipes si fuera necesario
  invisible(x)
}