---
title: "Survey Research Report"
date: "`r format(Sys.Date(), '%B %d, %Y')`"
format:
  html:
    toc: true
    toc-depth: 3
    embed-resources: true
    theme: cosmo
    code-fold: true
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
```

---

*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}
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, caption = "Item-wise missingness"))
  print(kable(mr$patterns, caption = "Missing-data patterns"))
  if (!is.null(mr$scale_missing_rules) && nrow(mr$scale_missing_rules) > 0)
    print(kable(mr$scale_missing_rules, caption = "Scale missing rules"))
}
```

---

## Descriptives {#sec-descriptives .unnumbered}

```{r descriptives, eval=params$include_descriptives && has_data}
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, caption = "Descriptive statistics"))
}
```

---

## Reliability {#sec-reliability .unnumbered}

```{r reliability, eval=params$include_reliability && has_data}
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("%.3f", s$alpha)   else "n/a",
      Omega_h = if (!is.null(s$omega_h)) sprintf("%.3f", s$omega_h) else "n/a",
      Omega_t = if (!is.null(s$omega_t)) sprintf("%.3f", 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))
        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")
```
