---
title: "Survey Research Report"
date: "`r format(Sys.Date(), '%B %d, %Y')`"
format:
  html:
    toc: true
    toc-depth: 3
    toc-location: left
    embed-resources: true
    theme: cosmo
    code-fold: true
    grid:
      sidebar-width: 280px
      body-width: 900px
      margin-width: 160px
params:
  instrument_path:     ""
  data_path:           ""
  include_codebook:    true
  include_quality:     true
  include_reliability: true
  include_analysis:    true
  include_missing:     true
  include_descriptives: true
  include_models:      true
  instrument_hash:     ""
execute:
  echo:    false
  warning: false
  message: false
---

```{r setup}
library(surveyframe)
library(knitr)

`%||%` <- function(x, y) if (is.null(x)) y else x

instrument <- readRDS(params$instrument_path)
has_data   <- nzchar(params$data_path) && file.exists(params$data_path)
responses  <- if (has_data) readRDS(params$data_path) else NULL
```

```{=html}
<style>
/* Brand look shared with render_results() and the static survey: system font,
   navy headings, teal accent. */
body { font-family: system-ui, -apple-system, "Segoe UI", Roboto, sans-serif;
       color: #1a1a2e; }
h1, h2, h3, h4, h5, #title-block-header .title { color: #1a1a2e; }
a { color: #16B3B1; }
#TOC .active, .sidebar-item .active { color: #16B3B1; }

/* Academic (APA) tables: horizontal rules only, no shading, no vertical lines.
   Each table is its own horizontal-scroll container so wide tables stay within
   the content column. Overrides the theme's default table styling. */
table { display: block; overflow-x: auto; max-width: 100%;
        border-collapse: collapse; margin: 14px 0; }
th, td { padding: 7px 14px; vertical-align: top;
         border: none !important; background: none !important; }
thead th { border-top: 2px solid #1a1a2e !important;
           border-bottom: 1px solid #1a1a2e !important; font-weight: 700; }
tbody tr { background: none !important; }
tbody tr:last-child td { border-bottom: 2px solid #1a1a2e !important; }
.cell-output-display, .cell-output { overflow-x: auto; max-width: 100%; }

/* Shared footer */
.sf-foot { text-align: center; font-size: 12px; color: #94a3b8;
           margin-top: 48px; padding-top: 16px; border-top: 1px solid #eee; }
.sf-foot a { color: #16B3B1; font-weight: 600; text-decoration: none; }
</style>
```

---

*Generated by [surveyframe](https://github.com/MohammedAliSharafuddin/surveyframe). Reproduce this report by calling `render_report()` with the same instrument and data.*

---

```{r meta}
#| output: asis
m <- instrument$meta
cat(sprintf("**Instrument:** %s\n\n", m$title %||% "Untitled"))
cat(sprintf("**Version:** %s\n\n", m$version %||% ""))
if (!is.null(m$description) && nzchar(m$description))
  cat(sprintf("**Description:** %s\n\n", m$description))
if (!is.null(m$authors) && length(m$authors) > 0)
  cat(sprintf("**Authors:** %s\n\n", paste(m$authors, collapse = ", ")))
cat(sprintf("**Validation status:** %s\n\n",
  if (isTRUE(m$validated)) "Valid" else "Not validated"))
```

---

## Codebook {#sec-codebook .unnumbered}

```{r codebook, eval=params$include_codebook}
#| tbl-cap: "Survey items"
cb <- codebook_report(instrument)
items_d <- cb$items_table
items_d$reverse  <- ifelse(items_d$reverse,  "Yes", "")
items_d$required <- ifelse(items_d$required, "Yes", "")
kable(items_d,
  col.names = c("ID","Label","Type","Choice set","Scale","Reverse","Required"),
  align = c("l","l","l","l","l","c","c"))
```

```{r codebook-choices, eval=params$include_codebook && nrow(cb$choices_table) > 0}
#| tbl-cap: "Choice sets"
kable(cb$choices_table,
  col.names = c("Choice set","Value","Label"), align = c("l","l","l"))
```

```{r codebook-scales, eval=params$include_codebook && nrow(cb$scales_table) > 0}
#| tbl-cap: "Scale definitions"
kable(cb$scales_table,
  col.names = c("ID","Label","Method","Items (n)","Item IDs"),
  align = c("l","l","l","c","l"))
```

---

## Data Quality {#sec-quality .unnumbered}

```{r quality-check, eval=params$include_quality && has_data}
qr <- quality_report(responses, instrument)
```

```{r quality-summary, eval=params$include_quality && has_data}
#| output: asis
cat(sprintf("**Respondents:** %d | **Items:** %d | **Flagged:** %d (%.1f%%)\n\n",
  qr$summary$n_respondents, qr$summary$n_items,
  qr$summary$n_flagged, qr$summary$flag_rate * 100))
```

```{r quality-attention, eval=params$include_quality && has_data && length(qr$attention) > 0}
#| tbl-cap: "Attention check results"
attn_df <- do.call(rbind, lapply(qr$attention, function(a)
  data.frame(Check=a$check_id, Type=a$type,
    Pass_rate=sprintf("%.1f%%", a$pass_rate*100),
    Failures=a$n_fail, Action=a$fail_action,
    stringsAsFactors=FALSE)))
kable(attn_df, align=c("l","l","r","r","l"))
```

```{r quality-missing, eval=params$include_quality && has_data}
#| output: asis
miss_pct <- mean(qr$missing$respondent_miss > qr$missing$flagged_threshold, na.rm=TRUE)*100
cat(sprintf("**Respondent missingness:** %.1f%% exceed the %.0f%% threshold.\n\n",
  miss_pct, qr$missing$flagged_threshold*100))
high_miss <- qr$missing$item_miss_rate[qr$missing$item_miss_rate > 0.10]
if (length(high_miss) > 0) {
  cat("Items with >10% missing:\n\n")
  print(kable(data.frame(Item=names(high_miss),
    Missing=sprintf("%.1f%%", high_miss*100), stringsAsFactors=FALSE),
    align=c("l","r")))
} else { cat("No items exceed 10% missing values.\n\n") }
```

```{r quality-sl, eval=params$include_quality && has_data && length(qr$straightline) > 0}
#| tbl-cap: "Straight-lining by scale"
sl_df <- do.call(rbind, lapply(qr$straightline, function(s)
  data.frame(Scale=s$scale_id, Items=s$n_items,
    Flagged=sprintf("%.1f%%", s$flag_rate*100), stringsAsFactors=FALSE)))
kable(sl_df, align=c("l","c","r"))
```

---

## Missing Data {#sec-missing .unnumbered}

```{r missing-data, eval=params$include_missing && has_data}
#| output: asis
mr <- tryCatch(missing_data_report(responses, instrument), error = function(e) NULL)
if (is.null(mr)) {
  cat("Missing-data diagnostics could not be computed from the supplied data.\n\n")
} else {
  print(kable(mr$item_missing, digits = 2, caption = "Item-wise missingness"))
  print(kable(mr$patterns, digits = 2, caption = "Missing-data patterns"))
  if (!is.null(mr$scale_missing_rules) && nrow(mr$scale_missing_rules) > 0)
    print(kable(mr$scale_missing_rules, digits = 2, caption = "Scale missing rules"))
}
```

---

## Descriptives {#sec-descriptives .unnumbered}

```{r descriptives, eval=params$include_descriptives && has_data}
#| output: asis
dr <- tryCatch(descriptives_report(responses), error = function(e) NULL)
if (is.null(dr)) {
  cat("Descriptive statistics could not be computed from the supplied data.\n\n")
} else {
  print(kable(dr$table, digits = 2, caption = "Descriptive statistics"))
}
```

---

## Response distributions {#sec-distributions .unnumbered}

```{r distributions, eval=params$include_descriptives && has_data, fig.width=7, fig.height=3.2, fig.align='left'}
#| output: asis
THEME <- instrument$render$theme %||% "#16B3B1"
if (!grepl("^#[0-9A-Fa-f]{3,6}$", THEME)) THEME <- "#16B3B1"

choice_by <- function(id) {
  for (c in instrument$choices %||% list()) if (identical(c$id, id)) return(c)
  NULL
}
q_items <- Filter(function(i) !(i$type %in% c("section_break", "text_block")),
                  instrument$items %||% list())

# One bar chart per categorical item, one histogram per numeric item
for (item in q_items) {
  if (!item$id %in% names(responses)) next
  col <- responses[[item$id]]
  t <- item$type
  if (t %in% c("likert", "single_choice", "multiple_choice")) {
    cs <- choice_by(item$choice_set %||% "")
    if (!is.null(cs)) {
      freq <- table(factor(col, levels = as.character(cs$values)))
      names(freq) <- cs$labels
    } else freq <- table(col)
    if (!sum(freq)) next
    cat(sprintf("\n**%s**\n\n", item$label %||% item$id))
    op <- par(mar = c(4, 11, 1, 1)); barplot(freq, horiz = TRUE, las = 1,
      col = THEME, border = NA, xlab = "Frequency", cex.names = .8); par(op)
    cat("\n\n")
  } else if (t %in% c("numeric", "slider", "rating")) {
    num <- suppressWarnings(as.numeric(col)); num <- num[!is.na(num)]
    if (!length(num)) next
    cat(sprintf("\n**%s**\n\n", item$label %||% item$id))
    op <- par(mar = c(4, 4, 1, 1)); hist(num, col = THEME, border = "white",
      main = NULL, xlab = item$label, ylab = "Count", las = 1); par(op)
    cat("\n\n")
  }
}

# One histogram per scale score
for (sc in instrument$scales %||% list()) {
  cols <- intersect(sc$items, names(responses))
  if (!length(cols)) next
  nums <- lapply(responses[cols], function(x) suppressWarnings(as.numeric(x)))
  scores <- rowMeans(do.call(cbind, nums), na.rm = TRUE); scores <- scores[!is.na(scores)]
  if (!length(scores)) next
  cat(sprintf("\n**%s (scale score)**\n\n", sc$label %||% sc$id))
  op <- par(mar = c(4, 4, 1, 1)); hist(scores, col = THEME, border = "white",
    main = NULL, xlab = paste0(sc$label %||% sc$id, " score"), ylab = "Count", las = 1)
  abline(v = mean(scores), col = "#dc2626", lwd = 2, lty = 2); par(op)
  cat("\n\n")
}
```

---

## Reliability {#sec-reliability .unnumbered}

```{r reliability, eval=params$include_reliability && has_data}
#| output: asis
rr <- tryCatch(reliability_report(responses, instrument), error = function(e) NULL)
if (is.null(rr)) {
  cat("Reliability statistics could not be computed from the supplied data.\n\n")
} else if (length(rr) == 0) {
  cat("No scales with two or more matching response columns found.\n\n")
} else {
  rel_df <- do.call(rbind, lapply(rr, function(s)
    data.frame(Scale=paste0(s$label," (",s$scale_id,")"),
      N_items=s$n_items, N=s$n,
      Alpha   = if (!is.null(s$alpha))   sprintf("%.2f", s$alpha)   else "n/a",
      Omega_h = if (!is.null(s$omega_h)) sprintf("%.2f", s$omega_h) else "n/a",
      Omega_t = if (!is.null(s$omega_t)) sprintf("%.2f", s$omega_t) else "n/a",
      stringsAsFactors=FALSE)))
  print(kable(rel_df,
    col.names=c("Scale","Items","N","Alpha","Omega h","Omega total"),
    align=c("l","c","c","r","r","r"),
    caption="Scale reliability statistics"))
}
```

---

## Analysis Plan {#sec-analysis .unnumbered}

```{r analysis, eval=params$include_analysis && length(instrument$analysis_plan) > 0}
#| output: asis
if (!has_data) {
  for (i in seq_along(instrument$analysis_plan)) {
    rq <- instrument$analysis_plan[[i]]
    cat(sprintf("### RQ %d: %s\n\n", i, rq$research_question %||% "(untitled)"))
    cat(sprintf("**Planned test:** %s\n\n", rq$test %||% ""))
    if (length(rq$variables %||% character(0)) > 0)
      cat(sprintf("**Variables:** %s\n\n", paste(rq$variables, collapse = ", ")))
    if (nzchar(rq$interpretation %||% ""))
      cat(sprintf("**Interpretation prompt:** %s\n\n", rq$interpretation))
  }
} else {
  results <- tryCatch(run_analysis_plan(responses, instrument), error=function(e) NULL)
  if (is.null(results)) {
    cat("Analysis plan could not be executed. Check that variable names match response columns.\n\n")
  } else {
    for (i in seq_along(results)) {
      r <- results[[i]]
      cat(sprintf("### RQ %d: %s\n\n", i, r$research_question %||% "(untitled)"))
      if (!is.null(r$error)) {
        cat(sprintf("> **Error:** %s\n\n", r$error))
      } else {
        cat(sprintf("**Result:** %s\n\n", r$apa %||% ""))
        if (!is.null(r$effect_label))
          cat(sprintf("**Effect size:** %s\n\n", r$effect_label))
        if (!is.null(r$table) && is.data.frame(r$table))
          print(kable(r$table, digits = 2))
        if (nzchar(r$interpretation %||% ""))
          cat(sprintf("\n**Interpretation:** %s\n\n", r$interpretation))
        if (length(r$citations) > 0) {
          cat("**References:**\n\n")
          lapply(r$citations, function(cit) cat(sprintf("- %s\n", cit)))
          cat("\n")
        }
      }
    }
  }
}
```

---

## Model Appendix {#sec-models .unnumbered}

```{r models, eval=params$include_models && length(instrument$models %||% list()) > 0}
#| output: asis
for (model in instrument$models) {
  cat(sprintf("### %s\n\n", model$label %||% model$id))
  cat(sprintf("**Type:** %s  \n**Engine:** %s\n\n", model$type %||% "", model$engine %||% ""))
  syntax <- tryCatch(
    switch(model$type,
      cfa = cfa_lavaan_syntax(instrument = instrument, model = model),
      cb_sem = sem_lavaan_syntax(model, instrument = instrument),
      pls_sem = seminr_syntax(model),
      efa = efa_syntax(unlist(lapply(model$measurement$constructs, function(con) con$items))),
      ""
    ),
    error = function(e) paste("Model syntax could not be generated:", conditionMessage(e))
  )
  cat("```r\n")
  cat(syntax)
  cat("\n```\n\n")
  cat("```json\n")
  cat(model_json(model, pretty = TRUE))
  cat("\n```\n\n")
}
```

---

## Reproducibility {#sec-repro .unnumbered}

```{r repro}
#| output: asis
hash_val <- params$instrument_hash
if (is.null(hash_val) || !nzchar(hash_val)) hash_val <- "see .sframe file"
cat(sprintf("**Instrument hash:** `%s`\n\n", hash_val))
cat(sprintf("**Report generated:** %s\n\n", format(Sys.time(), "%Y-%m-%d %H:%M %Z")))
cat("**To reproduce:**\n\n")
cat("```r\nlibrary(surveyframe)\n")
cat("instr     <- read_sframe(\"your_instrument.sframe\")\n")
cat("responses <- read_responses(\"your_responses.csv\", instr)\n")
cat("render_report(instr, data = responses, output_file = \"report.html\")\n```\n\n")
```

```{=html}
<div class="sf-foot">Built with <a href="https://cran.r-project.org/package=surveyframe" target="_blank" rel="noopener">surveyframe</a></div>
```
