# ==============================================================================
# svySE: exportacion de resultados
# svySE: result export
# Archivo / File: R/exportar.R
# ==============================================================================


#' Export svySE results to '.xlsx' files
#'
#' Exporta uno o varios resultados generados por `svySE_calc()` y
#' `svySE_simple()` a archivos `.xlsx`.
#'
#' Exports one or more results generated by `svySE_calc()` and
#' `svySE_simple()` to `.xlsx` files.
#'
#' @param x Objeto generado por `svySE_calc()` o `svySE_simple()`, o una lista
#'   nombrada que contenga varios objetos de estas clases.
#'   Object generated by `svySE_calc()` or `svySE_simple()`, or a named list
#'   containing multiple objects of these classes.
#' @param select Vector de texto opcional con los nombres de los elementos de
#'   `x` que se desean exportar. Solo se utiliza cuando `x` es una lista de
#'   resultados. Si es `NULL`, se exportan todos.
#'   Optional character vector containing the names of the elements in `x` to
#'   export. It is only used when `x` is a list of results. If `NULL`, all
#'   results are exported.
#' @param file_err Ruta del archivo `.xlsx` para exportar las tablas de errores
#'   muestrales. Si es `NULL`, no se exportan.
#'   Path to the `.xlsx` file used to export sampling error tables. If `NULL`,
#'   they are not exported.
#' @param file_tab Ruta del archivo `.xlsx` para exportar las tablas simples.
#'   Si es `NULL`, no se exportan.
#'   Path to the `.xlsx` file used to export simple tables. If `NULL`, they are
#'   not exported.
#' @param cols_err Columnas de error a exportar.
#'   Sampling error columns to export.
#' @param cols_tab Columnas de tabla simple a exportar.
#'   Simple table columns to export.
#' @param start_row Fila inicial de escritura.
#'   Starting row for writing.
#' @param overwrite Sobrescribir archivos existentes.
#'   Whether existing files should be overwritten.
#' @param keep_na Mantener `NA` en el archivo exportado.
#'   Whether `NA` values should be preserved in the exported file.
#'
#' @details
#' Debe especificarse al menos uno de `file_err` o `file_tab`.
#'
#' Cuando `x` es una lista, sus elementos deben tener nombres unicos. Los
#' objetos de clase `"svySE_result"` se exportan a `file_err`, mientras que los
#' objetos de clase `"svySE_simple_result"` se exportan a `file_tab`.
#'
#' At least one of `file_err` or `file_tab` must be provided.
#'
#' When `x` is a list, its elements must have unique names. Objects of class
#' `"svySE_result"` are exported to `file_err`, while objects of class
#' `"svySE_simple_result"` are exported to `file_tab`.
#'
#' @return Invisiblemente una lista con las rutas de los archivos exportados y
#'   los resultados seleccionados.
#'   Invisibly returns a list containing the exported file paths and selected
#'   result names.
#'
#' @export
svySE_xlsx <- function(
    x,
    select = NULL,
    file_err = NULL,
    file_tab = NULL,
    cols_err = svySE_cols_err("full"),
    cols_tab = svySE_cols_tab("full"),
    start_row = 10,
    overwrite = TRUE,
    keep_na = FALSE
) {
  
  # ---------------------------------------------------------------------------
  # Dependencia
  # Dependency
  # ---------------------------------------------------------------------------
  
  if (!requireNamespace("openxlsx", quietly = TRUE)) {
    svySE_abort(
      title = "Paquete requerido no instalado / Required package not installed.",
      details = "El paquete `openxlsx` es requerido para exportar archivos `.xlsx`.",
      hint = "Instala el paquete con: install.packages(\"openxlsx\")"
    )
  }
  
  # ---------------------------------------------------------------------------
  # Normalizar entrada
  # Normalize input
  # ---------------------------------------------------------------------------
  
  valid_result <- function(obj) {
    inherits(obj, "svySE_result") ||
      inherits(obj, "svySE_simple_result")
  }
  
  is_single_result <- valid_result(x)
  
  if (is_single_result) {
    results <- list(Result = x)
    use_prefix <- FALSE
  } else {
    
    if (!is.list(x) || length(x) == 0) {
      svySE_abort(
        title = "Objeto invalido / Invalid object.",
        details = paste(
          "`x` debe ser generado por `svySE_calc()` o `svySE_simple()`,",
          "o ser una lista nombrada de estos resultados."
        )
      )
    }
    
    if (is.null(names(x)) || any(is.na(names(x))) || any(trimws(names(x)) == "")) {
      svySE_abort(
        title = "Lista sin nombres validos / List without valid names.",
        details = paste(
          "Cuando `x` contiene varios resultados, todos sus elementos deben",
          "tener nombres no vacios."
        ),
        hint = paste0(
          "Ejemplo: x = list(Vivienda = res_viv, Salud = res_salud, ",
          "Educacion = res_simple)."
        )
      )
    }
    
    if (anyDuplicated(names(x)) > 0) {
      svySE_abort(
        title = "Nombres duplicados / Duplicate names.",
        details = "Los nombres de los resultados incluidos en `x` deben ser unicos.",
        vars = list(duplicated_names = unique(names(x)[duplicated(names(x))]))
      )
    }
    
    invalid <- !vapply(x, valid_result, logical(1))
    
    if (any(invalid)) {
      svySE_abort(
        title = "Resultados incompatibles / Incompatible results.",
        details = paste(
          "Todos los elementos de `x` deben ser objetos generados por",
          "`svySE_calc()` o `svySE_simple()`."
        ),
        vars = list(invalid_elements = names(x)[invalid])
      )
    }
    
    results <- x
    use_prefix <- TRUE
  }
  
  # ---------------------------------------------------------------------------
  # Seleccion
  # Selection
  # ---------------------------------------------------------------------------
  
  if (!is.null(select)) {
    svySE_chk_chr(select, "select")
    
    missing_select <- setdiff(select, names(results))
    
    if (length(missing_select) > 0) {
      svySE_abort(
        title = "Resultados no encontrados / Results not found.",
        details = "Algunos nombres indicados en `select` no existen dentro de `x`.",
        vars = list(
          missing = missing_select,
          available = names(results)
        )
      )
    }
    
    results <- results[select]
  }
  
  if (length(results) == 0) {
    svySE_abort(
      title = "No hay resultados para exportar / No results to export."
    )
  }
  
  error_mask <- vapply(
    results,
    inherits,
    logical(1),
    what = "svySE_result"
  )
  
  simple_mask <- vapply(
    results,
    inherits,
    logical(1),
    what = "svySE_simple_result"
  )
  
  error_results <- results[error_mask]
  simple_results <- results[simple_mask]
  
  # ---------------------------------------------------------------------------
  # Validaciones de archivos
  # Output validations
  # ---------------------------------------------------------------------------
  
  if (is.null(file_err) && is.null(file_tab)) {
    svySE_abort(
      title = "No se especifico archivo de salida / No output file specified.",
      details = paste(
        "Debe proporcionarse al menos uno de `file_err` o `file_tab`.",
        "At least one of `file_err` or `file_tab` must be provided."
      ),
      hint = paste(
        "Ejemplo / Example:",
        "svySE_xlsx(x = res, file_err = \"errors.xlsx\", file_tab = NULL)"
      )
    )
  }
  
  if (!is.null(file_err)) {
    svySE_chk_chr(file_err, "file_err")
    
    if (length(file_err) != 1) {
      svySE_abort(
        title = "Archivo de errores invalido / Invalid error output file.",
        details = "`file_err` debe contener una sola ruta / `file_err` must contain one path.",
        vars = list(file_err = file_err)
      )
    }
    
    if (length(error_results) == 0) {
      svySE_abort(
        title = "No hay errores muestrales para exportar / No sampling errors to export.",
        details = paste(
          "`file_err` fue especificado, pero los resultados seleccionados no",
          "contienen objetos generados por `svySE_calc()`."
        ),
        hint = "Incluye al menos un objeto de clase `svySE_result` o usa `file_err = NULL`."
      )
    }
    
    svySE_chk_cols(cols_err, svySE_cols_err_all(), "cols_err")
  }
  
  if (!is.null(file_tab)) {
    svySE_chk_chr(file_tab, "file_tab")
    
    if (length(file_tab) != 1) {
      svySE_abort(
        title = "Archivo de tabla simple invalido / Invalid simple table output file.",
        details = "`file_tab` debe contener una sola ruta / `file_tab` must contain one path.",
        vars = list(file_tab = file_tab)
      )
    }
    
    if (length(simple_results) == 0) {
      svySE_abort(
        title = "No hay tablas simples para exportar / No simple tables to export.",
        details = paste(
          "`file_tab` fue especificado, pero los resultados seleccionados no",
          "contienen objetos generados por `svySE_simple()`."
        ),
        hint = "Incluye al menos un objeto de clase `svySE_simple_result` o usa `file_tab = NULL`."
      )
    }
    
    svySE_chk_cols(cols_tab, svySE_cols_tab_all(), "cols_tab")
  }
  
  if (!is.null(file_err) && !is.null(file_tab)) {
    same_path <- identical(
      normalizePath(file_err, winslash = "/", mustWork = FALSE),
      normalizePath(file_tab, winslash = "/", mustWork = FALSE)
    )
    
    if (same_path) {
      svySE_abort(
        title = "Rutas de salida duplicadas / Duplicate output paths.",
        details = "`file_err` y `file_tab` deben apuntar a archivos diferentes.",
        vars = list(file_err = file_err, file_tab = file_tab),
        hint = "Usa nombres distintos para ambos archivos de salida."
      )
    }
  }
  
  if (
    !is.numeric(start_row) ||
    length(start_row) != 1 ||
    is.na(start_row) ||
    !is.finite(start_row) ||
    start_row < 4 ||
    start_row %% 1 != 0
  ) {
    svySE_abort(
      title = "Fila inicial invalida / Invalid starting row.",
      details = "`start_row` debe ser un numero entero mayor o igual a 4.",
      vars = list(start_row = start_row)
    )
  }
  
  svySE_chk_bool(overwrite, "overwrite")
  svySE_chk_bool(keep_na, "keep_na")
  
  # ---------------------------------------------------------------------------
  # Exportar errores muestrales
  # Export sampling errors
  # ---------------------------------------------------------------------------
  
  if (!is.null(file_err)) {
    
    wb_err <- openxlsx::createWorkbook()
    used_sheets <- character(0)
    
    for (result_name in names(error_results)) {
      
      obj <- error_results[[result_name]]
      
      for (ind in obj$meta$indicators) {
        
        base_name <- if (use_prefix) {
          paste(result_name, ind, "Error", sep = "_")
        } else {
          paste(ind, "Error", sep = "_")
        }
        
        sheet <- svySE_unique_sheet_name(
          x = base_name,
          used = used_sheets
        )
        
        used_sheets <- c(used_sheets, sheet)
        
        openxlsx::addWorksheet(wb_err, sheet)
        
        svySE_write_err_sheet(
          wb = wb_err,
          sheet = sheet,
          result_ind = obj$results[[ind]]$error,
          group_vars = obj$meta$group_vars,
          group_labels = obj$meta$group_labels,
          cols = cols_err,
          start_row = start_row,
          keep_na = keep_na
        )
      }
    }
    
    openxlsx::saveWorkbook(
      wb = wb_err,
      file = file_err,
      overwrite = overwrite
    )
  }
  
  # ---------------------------------------------------------------------------
  # Exportar tablas simples
  # Export simple tables
  # ---------------------------------------------------------------------------
  
  if (!is.null(file_tab)) {
    
    wb_tab <- openxlsx::createWorkbook()
    used_sheets <- character(0)
    
    for (result_name in names(simple_results)) {
      
      obj <- simple_results[[result_name]]
      
      for (ind in obj$meta$indicators) {
        
        base_name <- if (use_prefix) {
          paste(result_name, ind, "Simple", sep = "_")
        } else {
          paste(ind, "Simple", sep = "_")
        }
        
        sheet <- svySE_unique_sheet_name(
          x = base_name,
          used = used_sheets
        )
        
        used_sheets <- c(used_sheets, sheet)
        
        openxlsx::addWorksheet(wb_tab, sheet)
        
        svySE_write_tab_sheet(
          wb = wb_tab,
          sheet = sheet,
          result_ind = obj$results[[ind]]$simple,
          group_vars = obj$meta$group_vars,
          group_labels = obj$meta$group_labels,
          cols = cols_tab,
          start_row = start_row,
          keep_na = keep_na
        )
      }
    }
    
    openxlsx::saveWorkbook(
      wb = wb_tab,
      file = file_tab,
      overwrite = overwrite
    )
  }
  
  invisible(
    list(
      file_err = file_err,
      file_tab = file_tab,
      selected = names(results),
      error_results = names(error_results),
      simple_results = names(simple_results)
    )
  )
}


# ==============================================================================
# Escritura de hoja de errores
# Error sheet writing
# ==============================================================================

#' @keywords internal
svySE_write_err_sheet <- function(
    wb,
    sheet,
    result_ind,
    group_vars,
    group_labels,
    cols,
    start_row,
    keep_na = FALSE
) {
  
  col_now <- 1
  divisions <- names(result_ind)
  
  for (i in seq_along(divisions)) {
    
    div <- divisions[i]
    is_total <- i == 1
    
    tab <- result_ind[[div]]
    
    if (is_total) {
      tab_out <- tab[, c(group_vars, cols), drop = FALSE]
    } else {
      tab_out <- tab[, cols, drop = FALSE]
    }
    
    svySE_head_err(
      wb = wb,
      sheet = sheet,
      col_start = col_now,
      row_data = start_row,
      group_labels = group_labels,
      only_values = !is_total,
      division_name = div,
      cols = cols
    )
    
    openxlsx::writeData(
      wb = wb,
      sheet = sheet,
      x = tab_out,
      startRow = start_row,
      startCol = col_now,
      colNames = FALSE,
      keepNA = keep_na
    )
    
    width <- if (is_total) {
      length(group_vars) + length(cols)
    } else {
      length(cols)
    }
    
    col_now <- col_now + width
  }
  
  svySE_style_sheet(
    wb = wb,
    sheet = sheet,
    max_col = col_now - 1,
    start_row = start_row
  )
  
  invisible(TRUE)
}


# ==============================================================================
# Escritura de hoja simple
# Simple sheet writing
# ==============================================================================

#' @keywords internal
svySE_write_tab_sheet <- function(
    wb,
    sheet,
    result_ind,
    group_vars,
    group_labels,
    cols,
    start_row,
    keep_na = FALSE
) {
  
  col_now <- 1
  divisions <- names(result_ind)
  
  for (i in seq_along(divisions)) {
    
    div <- divisions[i]
    is_total <- i == 1
    
    tab <- result_ind[[div]]
    
    if (is_total) {
      tab_out <- tab[, c(group_vars, cols), drop = FALSE]
    } else {
      tab_out <- tab[, cols, drop = FALSE]
    }
    
    svySE_head_tab(
      wb = wb,
      sheet = sheet,
      col_start = col_now,
      row_data = start_row,
      group_labels = group_labels,
      only_values = !is_total,
      division_name = div,
      cols = cols
    )
    
    openxlsx::writeData(
      wb = wb,
      sheet = sheet,
      x = tab_out,
      startRow = start_row,
      startCol = col_now,
      colNames = FALSE,
      keepNA = keep_na
    )
    
    width <- if (is_total) {
      length(group_vars) + length(cols)
    } else {
      length(cols)
    }
    
    col_now <- col_now + width
  }
  
  svySE_style_sheet(
    wb = wb,
    sheet = sheet,
    max_col = col_now - 1,
    start_row = start_row
  )
  
  invisible(TRUE)
}


# ==============================================================================
# Encabezados de tabla de errores
# Error table headers
# ==============================================================================

#' @keywords internal
svySE_head_err <- function(
    wb,
    sheet,
    col_start,
    row_data,
    group_labels,
    only_values = FALSE,
    division_name = NULL,
    cols
) {
  
  row_div <- row_data - 3
  row_top <- row_data - 2
  row_low <- row_data - 1
  
  col_met <- if (only_values) {
    col_start
  } else {
    col_start + length(group_labels)
  }
  
  if (!only_values) {
    for (j in seq_along(group_labels)) {
      openxlsx::writeData(
        wb,
        sheet,
        x = data.frame(V1 = group_labels[j]),
        startRow = row_div,
        startCol = col_start + j - 1,
        colNames = FALSE
      )
    }
  }
  
  if (!is.null(division_name)) {
    openxlsx::writeData(
      wb,
      sheet,
      x = data.frame(V1 = division_name),
      startRow = row_div,
      startCol = col_met,
      colNames = FALSE
    )
  }
  
  labels <- svySE_lbl_err(cols)
  sub_labels <- svySE_sublbl_err(cols)
  
  for (j in seq_along(cols)) {
    
    openxlsx::writeData(
      wb,
      sheet,
      x = data.frame(V1 = labels[j]),
      startRow = row_top,
      startCol = col_met + j - 1,
      colNames = FALSE
    )
    
    if (!is.na(sub_labels[j])) {
      openxlsx::writeData(
        wb,
        sheet,
        x = data.frame(V1 = sub_labels[j]),
        startRow = row_low,
        startCol = col_met + j - 1,
        colNames = FALSE
      )
    }
  }
  
  invisible(TRUE)
}


# ==============================================================================
# Encabezados de tabla simple
# Simple table headers
# ==============================================================================

#' @keywords internal
svySE_head_tab <- function(
    wb,
    sheet,
    col_start,
    row_data,
    group_labels,
    only_values = FALSE,
    division_name = NULL,
    cols
) {
  
  row_div <- row_data - 3
  row_top <- row_data - 2
  row_low <- row_data - 1
  
  col_met <- if (only_values) {
    col_start
  } else {
    col_start + length(group_labels)
  }
  
  if (!only_values) {
    for (j in seq_along(group_labels)) {
      openxlsx::writeData(
        wb,
        sheet,
        x = data.frame(V1 = group_labels[j]),
        startRow = row_div,
        startCol = col_start + j - 1,
        colNames = FALSE
      )
    }
  }
  
  if (!is.null(division_name)) {
    openxlsx::writeData(
      wb,
      sheet,
      x = data.frame(V1 = division_name),
      startRow = row_div,
      startCol = col_met,
      colNames = FALSE
    )
  }
  
  labels <- svySE_lbl_tab(cols)
  
  for (j in seq_along(cols)) {
    
    openxlsx::writeData(
      wb,
      sheet,
      x = data.frame(V1 = labels$top[j]),
      startRow = row_top,
      startCol = col_met + j - 1,
      colNames = FALSE
    )
    
    openxlsx::writeData(
      wb,
      sheet,
      x = data.frame(V1 = labels$low[j]),
      startRow = row_low,
      startCol = col_met + j - 1,
      colNames = FALSE
    )
  }
  
  invisible(TRUE)
}


# ==============================================================================
# Etiquetas de columnas
# Column labels
# ==============================================================================

#' @keywords internal
svySE_lbl_err <- function(cols) {
  
  dict <- c(
    est_abs = "Estimacion",
    est_pct = "Estimacion",
    se_abs = "Error estandar",
    se_pct = "Error estandar",
    ci_l_abs = "95% de intervalo de confianza",
    ci_l_pct = "95% de intervalo de confianza",
    ci_u_abs = "95% de intervalo de confianza",
    ci_u_pct = "95% de intervalo de confianza",
    cv = "Coeficiente de variacion",
    deff = "Efecto de diseno",
    n_unw = "Recuento no ponderado"
  )
  
  unname(dict[cols])
}


#' @keywords internal
svySE_sublbl_err <- function(cols) {
  
  dict <- c(
    est_abs = "Abs.",
    est_pct = "%",
    se_abs = "Abs.",
    se_pct = "%",
    ci_l_abs = "Inf. Abs.",
    ci_l_pct = "Inf. %",
    ci_u_abs = "Sup. Abs.",
    ci_u_pct = "Sup. %",
    cv = NA,
    deff = NA,
    n_unw = NA
  )
  
  unname(dict[cols])
}


#' @keywords internal
svySE_lbl_tab <- function(cols) {
  
  top <- c(
    freq_0 = "0",
    pct_0 = "0",
    freq_1 = "1",
    pct_1 = "1",
    freq_total = "TOTAL",
    pct_total = "TOTAL"
  )
  
  low <- c(
    freq_0 = "Abs.",
    pct_0 = "%",
    freq_1 = "Abs.",
    pct_1 = "%",
    freq_total = "Abs.",
    pct_total = "%"
  )
  
  data.frame(
    top = unname(top[cols]),
    low = unname(low[cols]),
    stringsAsFactors = FALSE
  )
}


# ==============================================================================
# Estilos de .xlsx
# .xlsx styles
# ==============================================================================

#' @keywords internal
svySE_style_sheet <- function(
    wb,
    sheet,
    max_col,
    start_row
) {
  
  header_style <- openxlsx::createStyle(
    textDecoration = "bold",
    halign = "center",
    valign = "center",
    border = "TopBottomLeftRight",
    wrapText = TRUE
  )
  
  openxlsx::addStyle(
    wb = wb,
    sheet = sheet,
    style = header_style,
    rows = (start_row - 3):(start_row - 1),
    cols = 1:max_col,
    gridExpand = TRUE,
    stack = TRUE
  )
  
  openxlsx::setColWidths(
    wb = wb,
    sheet = sheet,
    cols = 1:max_col,
    widths = "auto"
  )
  
  openxlsx::freezePane(
    wb = wb,
    sheet = sheet,
    firstActiveRow = start_row,
    firstActiveCol = 1
  )
  
  invisible(TRUE)
}


# ==============================================================================
# Utilidades
# Utilities
# ==============================================================================

#' @keywords internal
svySE_sheet_name <- function(x) {
  
  x <- gsub("[\\[\\]\\:\\*\\?\\/\\\\]", "_", x)
  
  if (nchar(x) > 31) {
    x <- substr(x, 1, 31)
  }
  
  x
}
#' @keywords internal
svySE_unique_sheet_name <- function(
    x,
    used = character(0)
) {
  
  base <- svySE_sheet_name(x)
  
  if (!(base %in% used)) {
    return(base)
  }
  
  i <- 2L
  
  repeat {
    
    suffix <- paste0("_", i)
    max_base <- 31L - nchar(suffix)
    
    candidate <- paste0(
      substr(base, 1L, max_base),
      suffix
    )
    
    if (!(candidate %in% used)) {
      return(candidate)
    }
    
    i <- i + 1L
  }
}
