---
title: "Earth Model Report"
format:
  html:
    toc: true
    theme: flatly
    embed-resources: true
    mainfont: "Roboto Condensed"
    include-in-header:
      text: |
        <style>
        @import url('https://fonts.googleapis.com/css2?family=Roboto+Condensed:wght@400;700&display=swap');
        body { font-family: 'Roboto Condensed', sans-serif; }
        </style>
  pdf:
    toc: true
    mainfont: "Roboto Condensed"
    sansfont: "Roboto Condensed"
    include-in-header:
      text: |
        \usepackage{unicode-math}
        \setmathfont{Latin Modern Math}
        \setmathfont{Roboto Condensed}[range=up/{num,latin,Latin}]
        \setmathfont{Roboto Condensed}[range=it/{latin,Latin}]
        \usepackage{pdflscape}
        \usepackage{longtable}
        \usepackage{booktabs}
  docx:
    toc: true
    reference-doc: reference.docx
params:
  result_file: ""
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
library(earthUI)
library(ggplot2)

# Load Roboto Condensed for plots (skip download if already registered)
if (requireNamespace("sysfonts", quietly = TRUE) &&
    requireNamespace("showtext", quietly = TRUE)) {
  if (!"Roboto Condensed" %in% sysfonts::font_families()) {
    sysfonts::font_add_google("Roboto Condensed", "Roboto Condensed")
  }
  showtext::showtext_auto()
  theme_set(theme_minimal(base_family = "Roboto Condensed"))
} else {
  theme_set(theme_minimal(base_family = "sans"))
}

result <- readRDS(params$result_file)
summary_info <- format_summary(result)
multi <- isTRUE(summary_info$multi)
targets <- result$target
gf <- list_g_functions(result)
```

## Dataset Description

| Property | Value |
|----------|-------|
| Observations | `r summary_info$n_obs` |
| Target variable(s) | `r paste(targets, collapse = ", ")` |
| Predictors used | `r paste(result$predictors, collapse = ", ")` |
| Categorical predictors | `r if (length(result$categoricals) > 0) paste(result$categoricals, collapse = ", ") else "None"` |

## Model Specification

| Parameter | Value |
|-----------|-------|
| Degree | `r result$degree` |
| Cross-validation | `r if (result$cv_enabled) "Yes (10-fold)" else "No"` |
| Number of terms | `r summary_info$n_terms` |
| Predictors in model | `r summary_info$n_predictors` |
`r if (multi) paste0("| Response variables | ", length(targets), " |")`

```{r interaction-matrix, results='asis', eval=result$degree >= 2 && !is.null(result$allowed_matrix)}
mat <- result$allowed_matrix
preds <- rownames(mat)
n <- length(preds)

# Build display matrix (Yes/No, diagonal = -)
display <- matrix("", n, n, dimnames = list(preds, preds))
for (i in seq_len(n)) {
  for (j in seq_len(n)) {
    display[i, j] <- if (i == j) "" else if (mat[i, j]) "\u2713" else "\u2014"
  }
}

fmt <- if (!is.null(knitr::pandoc_to())) knitr::pandoc_to() else "html"

# Truncate long predictor names for compact display
max_len <- if (n > 8) 12 else if (n > 5) 16 else 30
short <- ifelse(nchar(preds) > max_len,
                paste0(substr(preds, 1, max_len - 1), "\u2026"), preds)
colnames(display) <- short
rownames(display) <- short

if (fmt == "latex") {
  cat("\n\\newpage\n\\begin{landscape}\n")
  cat("\\subsection{Allowed Interactions}\n\n")
  cat("\\footnotesize\n")
  print(knitr::kable(display, format = "latex", booktabs = TRUE))
  cat("\n\\normalsize\n")
  cat("\\end{landscape}\n\\newpage\n")
} else if (fmt == "docx") {
  # Start landscape section
  cat('\n\n```{=openxml}\n')
  cat('<w:p><w:pPr><w:sectPr><w:pgSz w:w="12240" w:h="15840"/>')
  cat('<w:pgMar w:top="1440" w:right="1440" w:bottom="1440" w:left="1440"/>')
  cat('</w:sectPr></w:pPr></w:p>\n')
  cat('```\n\n')
  cat("## Allowed Interactions\n\n")
  print(knitr::kable(display, format = "pipe"))
  cat('\n\n```{=openxml}\n')
  cat('<w:p><w:pPr><w:sectPr><w:pgSz w:w="15840" w:h="12240" w:orient="landscape"/>')
  cat('<w:pgMar w:top="1440" w:right="1440" w:bottom="1440" w:left="1440"/>')
  cat('</w:sectPr></w:pPr></w:p>\n')
  cat('```\n\n')
} else {
  # HTML: full-width with rotated column headers for large matrices
  cat("\n## Allowed Interactions\n\n")
  cat('<style>\n')
  cat('.eui-matrix-wrap { overflow-x: auto; margin: 1em 0; }\n')
  cat('.eui-matrix { border-collapse: collapse; font-size: 0.8em; }\n')
  cat('.eui-matrix th, .eui-matrix td { border: 1px solid #ddd; padding: 3px 6px; text-align: center; }\n')
  cat('.eui-matrix th.eui-rotate { height: 120px; white-space: nowrap; vertical-align: bottom; }\n')
  cat('.eui-matrix th.eui-rotate > div { transform: rotate(-60deg); width: 1.5em; transform-origin: bottom left; margin-left: 50%; }\n')
  cat('.eui-matrix td:first-child { text-align: left; font-weight: bold; white-space: nowrap; }\n')
  cat('.eui-matrix .eui-check { color: #27ae60; font-weight: bold; }\n')
  cat('.eui-matrix .eui-dash { color: #999; }\n')
  cat('@media print { .eui-matrix-wrap { page-break-before: always; } @page { size: landscape; } }\n')
  cat('</style>\n')
  cat('<div class="eui-matrix-wrap">\n')
  cat('<table class="eui-matrix">\n<thead><tr><th></th>')
  for (j in seq_len(n)) {
    cat(sprintf('<th class="eui-rotate"><div>%s</div></th>', preds[j]))
  }
  cat('</tr></thead>\n<tbody>\n')
  for (i in seq_len(n)) {
    cat(sprintf('<tr><td>%s</td>', preds[i]))
    for (j in seq_len(n)) {
      if (i == j) {
        cat('<td></td>')
      } else if (mat[i, j]) {
        cat('<td class="eui-check">\u2713</td>')
      } else {
        cat('<td class="eui-dash">\u2014</td>')
      }
    }
    cat('</tr>\n')
  }
  cat('</tbody></table>\n</div>\n')
}
```

```{r single-response-results, results='asis', eval=!multi}
cat("\n## Results Summary\n\n")
cat("| Metric | Value |\n|--------|-------|\n")
cat(sprintf("| R² | %.4f |\n", summary_info$r_squared))
cat(sprintf("| GRSq | %.4f |\n", summary_info$grsq))
cat(sprintf("| GCV | %.4f |\n", summary_info$gcv))
cat(sprintf("| RSS | %.2f |\n", summary_info$rss))
if (result$cv_enabled && !is.na(summary_info$cv_rsq)) {
  cat(sprintf("| CV R² | %.4f |\n", summary_info$cv_rsq))
}
```

```{r single-response-equation, results='asis', eval=!multi}
cat("\n## Model Equation\n\n")
eq <- format_model_equation(result)
if (!is.null(knitr::pandoc_to()) && knitr::pandoc_to() == "docx") {
  cat("$$\n", eq$latex_word, "\n$$\n")
} else {
  cat("$$\n", eq$latex_pdf, "\n$$\n")
}
```

## Coefficients & Basis Functions

```{r coefficients}
knitr::kable(summary_info$coefficients, digits = 4)
```

## Variable Importance

```{r importance-plot, fig.width=8, fig.height=5}
plot_variable_importance(result)
```

```{r importance-table}
knitr::kable(format_variable_importance(result), digits = 4)
```

```{r single-response-gfunctions, fig.width=8, fig.height=6, results='asis', eval=!multi}
cat("\n## g-Function Contributions\n\n")
for (i in seq_len(nrow(gf))) {
  label <- gf$label[i]
  if (gf$d[i] >= 2) label <- gsub(" ", " \u00d7 ", label)
  cat(sprintf("\n### %s\n\n", label))
  if (gf$d[i] >= 2) {
    plot_g_persp(result, i)
    cat("\n\n")
    p <- plot_g_contour(result, i)
    print(p)
  } else {
    p <- plot_g_contour(result, i)
    print(p)
  }
  cat("\n\n")
}
```

## Correlation Matrix

```{r correlation-matrix, fig.width=10, fig.height=8}
plot_correlation_matrix(result)
```

```{r single-response-diagnostics, fig.width=8, fig.height=5, results='asis', eval=!multi}
cat("\n## Diagnostics\n\n")
cat("\n### Residuals vs Fitted\n\n")
print(plot_residuals(result))
cat("\n\n### Normal Q-Q Plot\n\n")
print(plot_qq(result))
cat("\n\n### Actual vs Predicted\n\n")
print(plot_actual_vs_predicted(result))
```

```{r multi-response-sections, fig.width=8, fig.height=5, results='asis', eval=multi}
eq <- format_model_equation(result)
render_eq <- function(e) {
  if (!is.null(knitr::pandoc_to()) && knitr::pandoc_to() == "docx") {
    cat("$$\n", e$latex_word, "\n$$\n")
  } else {
    cat("$$\n", e$latex_pdf, "\n$$\n")
  }
}

for (ri in seq_along(targets)) {
  tgt <- targets[ri]
  cat(sprintf("\n## Response: %s\n\n", tgt))

  # --- Summary metrics ---
  cat("\n### Summary\n\n")
  cat("| Metric | Value |\n|--------|-------|\n")
  cat(sprintf("| R² | %.4f |\n", summary_info$r_squared[ri]))
  cat(sprintf("| GRSq | %.4f |\n", summary_info$grsq[ri]))
  cat(sprintf("| GCV | %.4f |\n", summary_info$gcv[ri]))
  cat(sprintf("| RSS | %.2f |\n", summary_info$rss[ri]))
  if (result$cv_enabled && !is.na(summary_info$cv_rsq[ri])) {
    cat(sprintf("| CV R² | %.4f |\n", summary_info$cv_rsq[ri]))
  }
  cat("\n")

  # --- Equation ---
  cat("\n### Model Equation\n\n")
  render_eq(eq$equations[[ri]])
  cat("\n")

  # --- g-Function contributions ---
  if (nrow(gf) > 0) {
    cat("\n### g-Function Contributions\n\n")
    for (i in seq_len(nrow(gf))) {
      label <- gf$label[i]
      if (gf$d[i] >= 2) label <- gsub(" ", " \u00d7 ", label)
      cat(sprintf("\n#### %s\n\n", label))
      if (gf$d[i] >= 2) {
        plot_g_persp(result, i, response_idx = ri)
        cat("\n\n")
        p <- plot_g_contour(result, i, response_idx = ri)
        print(p)
      } else {
        p <- plot_g_contour(result, i, response_idx = ri)
        print(p)
      }
      cat("\n\n")
    }
  }

  # --- Diagnostics ---
  cat("\n### Diagnostics\n\n")
  cat("\n#### Residuals vs Fitted\n\n")
  print(plot_residuals(result, response_idx = ri))
  cat("\n\n#### Normal Q-Q Plot\n\n")
  print(plot_qq(result, response_idx = ri))
  cat("\n\n#### Actual vs Predicted\n\n")
  print(plot_actual_vs_predicted(result, response_idx = ri))
  cat("\n\n")
}
```

## ANOVA Decomposition

```{r anova}
knitr::kable(format_anova(result), digits = 4)
```

## Earth Output

```{r earth-output, comment=""}
model <- result$model
cat("== Model ==\n\n")
print(model)
cat("\n\n== Summary ==\n\n")
print(summary(model))
if (!is.null(model$varmod)) {
  cat("\n\n== Variance Model ==\n\n")
  print(model$varmod)
}
```

---

*Report generated by [earthUI](https://github.com/wcraytor/earthUI) on `r Sys.time()`*
