---
title: "Model plots"
subtitle: "`r params$subtitle`"
date: today
format:
  dashboard:
    orientation: rows
    theme: cosmo
    embed-resources: true
params:
  model_path: NULL
  validations_path: NULL
  selection: NULL
  sample_group: NULL
  validation_group: NULL
  graph_params: NULL
  subtitle: ""
---

```{=html}
<style>
.navbar { background-color: #6c757d ; }
.navbar, .navbar * { color: #fff ; }
.navbar .nav-link.active, .navbar .nav-item.active > .nav-link { background-color: #495057 !important; color: #fff !important; border-color: transparent !important; }
.tab-content .card { border: none ; box-shadow: none ; }
.tab-content .card .bslib-full-screen-enter { display: none !important; }
</style>
```

```{r setup}
#| include: false
knitr::opts_chunk$set(out.height = "100%", out.width = "100%", echo = FALSE)
knitr::opts_knit$set(progress = FALSE)
library(plotly)
full_model <- readRDS(params$model_path)
selection <- params$selection

n_comps <- full_model$method$ncomp
components <- seq_len(n_comps)
opt_comp <- full_model$final_ncomp
final_model <- full_model$final_model

wavelengths <- as.double(colnames(final_model$model$weights))
n_observations <- final_model$model$n_observations
xaxis_label <- switch(
  full_model$preprocess$device,
  proxiscout  = "Wavenumber (cm<sup>-1</sup>)",
  proximate   = "Wavelength (nm)",
  ""
)
xaxis_spectral <- list(title = xaxis_label, titlefont = list(color = "#7f7f7f"))
if (full_model$preprocess$device == "proxiscout") {
  xaxis_spectral$autorange <- "reversed"
}
cal_stats <- final_model$calibration_statistics_all
observation_names <- paste("Observation", cal_stats$Sample_index)
Y <- cal_stats$Target
colrs <- scales::hue_pal()(n_comps)

# Map group indices to positions in cal_stats$Sample_index
sample_group <- params$sample_group
group_factor <- rep(NA_character_, n_observations)
for (g in names(sample_group)) {
  idx <- which(cal_stats$Sample_index %in% sample_group[[g]])
  group_factor[idx] <- g
}
group_factor <- factor(group_factor, levels = names(sample_group))
has_group <- !all(is.na(group_factor))

if (has_group) {
  # Assign "Other" to unassigned samples
  other_label <- if ("Other" %in% levels(group_factor)) "Other (ungrouped)" else "Other"
  levels(group_factor) <- c(levels(group_factor), other_label)
  group_factor[is.na(group_factor)] <- other_label
  group_factor <- droplevels(group_factor)
  group_colors <- setNames(
    scales::hue_pal()(length(levels(group_factor))),
    levels(group_factor)
  )
} else {
  group_colors <- NULL
}
# Obtain the name of the spectrum that was used if the model was built with a
# formula, otherwise use `spc`
if (is.null(full_model$formula)) {
  spc_name <- "spc"
} else {
  spc_name <- tail(all.vars(full_model$formula), n = 1)
}

steps <- list()
for (i in components) {
  step <- list(
    args = list("visible", rep(FALSE, n_comps)),
    method = "restyle",
    label = paste("Component", i),
    value = as.character(i)
  )
  step$args[[2]][i] <- TRUE
  steps[[i]] <- step
}
sliders <- list(list(
  currentvalue = list(
    prefix = "",
    font = list(color = "black", xanchor = "left")
  ),
  active = opt_comp - 1,
  steps = steps,
  pad = list(t = 50, r = 50, b = 0, l = 50)
))


# Group sliders
if (has_group) {
  n_groups <- length(levels(group_factor))
  # Traces: n_comps segments, then n_comps * n_groups markers
  n_traces <- n_comps + n_comps * n_groups
  grp_steps <- list()
  for (i in components) {
    vis <- rep(FALSE, n_traces)
    vis[i] <- TRUE
    marker_start <- n_comps + (i - 1) * n_groups + 1
    vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
    grp_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", i),
      value = as.character(i)
    )
  }
  group_sliders <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = opt_comp - 1,
    steps = grp_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
}

given_params <- params$graph_params
if (length(given_params) > 0) {
  all_layout_params <- names(schema(FALSE)$layout$layoutAttributes)
  all_plotly_params <- names(schema(FALSE)$traces$scatter$attributes)
  dropped_params <- c(
    intersect(all_layout_params, all_plotly_params),
    "p", "sliders", "x", "x0", "dx", "y", "y0", "dy", "visible", "type", "name",
    "hovertext", "text", "mode"
  )
  all_layout_params <- all_layout_params[!all_layout_params %in% dropped_params]
  all_plotly_params <- all_plotly_params[!all_plotly_params %in% dropped_params]
  layout_params <- given_params[names(given_params) %in% all_layout_params]
  plotly_params <- given_params[names(given_params) %in% all_plotly_params]
} else {
  layout_params <- list()
  plotly_params <- list()
}

validations <- if (!is.null(params$validations_path)) readRDS(params$validations_path) else NULL
val_refs <- validations$reference

# Index (within validations$validation) of the entry matching the optimal
# number of components, used as the initially visible trace/slider position.
# Falls back to the last (highest ncomp) entry if the optimal ncomp was not
# included.
val_opt_idx <- 1L
if (!is.null(validations) && length(validations$validation) > 0) {
  val_ncomp <- as.numeric(gsub("ncomp_", "", names(validations$validation)))
  matched_idx <- which(val_ncomp == opt_comp)
  if (length(matched_idx) == 1) {
    val_opt_idx <- matched_idx
  } else {
    val_opt_idx <- length(validations$validation)
  }
}

# Map validation group indices to positions within the validation set
validation_group <- params$validation_group
val_group_factor <- NULL
has_val_group <- FALSE
val_group_colors <- NULL
if (!is.null(val_refs)) {
  n_val_obs <- nrow(val_refs)
  val_group_factor <- rep(NA_character_, n_val_obs)
  for (g in names(validation_group)) {
    idx <- which(seq_len(n_val_obs) %in% validation_group[[g]])
    val_group_factor[idx] <- g
  }
  val_group_factor <- factor(val_group_factor, levels = names(validation_group))
  has_val_group <- !all(is.na(val_group_factor))

  if (has_val_group) {
    other_label <- if ("Other" %in% levels(val_group_factor)) "Other (ungrouped)" else "Other"
    levels(val_group_factor) <- c(levels(val_group_factor), other_label)
    val_group_factor[is.na(val_group_factor)] <- other_label
    val_group_factor <- droplevels(val_group_factor)
    val_group_colors <- setNames(
      scales::hue_pal()(length(levels(val_group_factor))),
      levels(val_group_factor)
    )
  }
}

plotly_build2 <- function(...) {
  p <- plotly_build(...)
  p$x[c("attrs", "visdat", "cur_data")] <- NULL
  p
}

# Has the full model any cross-validation?
has_val <- full_model$control$validation_type != "none"

# Get header selection
header_selection <- 1:4 %in% floor(selection)

# Get plot selections
selection <- 10 * selection
spectral_selection <- 11:19 %in% selection
if (10 %in% selection) spectral_selection <- rep(TRUE, length(spectral_selection))
cv_selection <- 21:27 %in% selection & has_val
if (20 %in% selection & has_val) cv_selection <- rep(TRUE, length(cv_selection))
regression_selection <- 31:37 %in% selection
if (30 %in% selection) regression_selection <- rep(TRUE, length(regression_selection))

# Are there any validations to plot at all?
has_any_validation <- !is.null(validations) && !is.null(val_refs) && length(validations$validation) > 0
# Does every validation entry carry the fields needed for the leverage/residual plot?
has_mahal_q <- has_any_validation && all(vapply(
  validations$validation,
  FUN = function(v) all(c("mahalanobis", "q_residual") %in% colnames(v$val_results)),
  FUN.VALUE = logical(1)
))

val_selection <- 41:42 %in% selection & has_any_validation
if (40 %in% selection & has_any_validation) val_selection <- rep(TRUE, length(val_selection))

# Check computability of certain plots/headers
header_selection[2] <- header_selection[2] && has_val
spectral_selection[1] <- spectral_selection[1] && !is.null(full_model$input_data$data[[spc_name]])
spectral_selection[2] <- spectral_selection[2] && !is.null(full_model$preprocessed_X)
cv_selection[2:7] <- cv_selection[2:7] & any(full_model$control$validation_type == c("kfold", "loo"))
header_selection[4] <- header_selection[4] && has_any_validation
val_selection[1] <- val_selection[1] & has_any_validation
val_selection[2] <- val_selection[2] & has_mahal_q
```


```{r}
#| output: asis
if (header_selection[1]) cat("# Spectral plots\n\n## Column {.tabset}\n\n")
```


```{r}
#| output: asis
if (spectral_selection[1]) cat("### Raw Spectra\n\n")
```

```{r}
#| eval: !expr spectral_selection[1]
raw_spectra <- full_model$input_data$data[[spc_name]][cal_stats$Sample_index, ]

to_plot <- data.frame(
  wavelengths = as.double(colnames(raw_spectra)),
  spec = as.vector(t(raw_spectra)),
  name = rep(paste("Spectrum", cal_stats$Sample_index), each = ncol(raw_spectra)),
  grp = rep(group_factor, each = ncol(raw_spectra))
)

to_plot$name <- factor(to_plot$name, levels = paste("Spectrum", cal_stats$Sample_index))

if (has_group) {
  fig <- plot_ly(type = "scatter", mode = "lines")
  shown_groups <- character(0)
  for (s in levels(to_plot$name)) {
    sub <- to_plot[to_plot$name == s, ]
    g <- as.character(sub$grp[1])
    show <- !(g %in% shown_groups)
    fig <- do.call(
      "add_trace",
      c(
        plotly_params["marker" != names(plotly_params)],
        list(
          p = fig,
          x = sub$wavelengths,
          y = sub$spec,
          type = "scatter",
          mode = "lines",
          name = g,
          legendgroup = g,
          showlegend = show,
          line = list(width = 1, color = group_colors[[g]]),
          hovertext = s,
          hoverinfo = "x+y+text"
        )
      )
    )
    shown_groups <- c(shown_groups, g)
  }
} else {
  to_plot <- to_plot |> group_by(name)
  fig <- do.call(
    "plot_ly",
    c(
      plotly_params["marker" != names(plotly_params)],
      list(
        data = to_plot,
        type = "scatter",
        mode = "lines",
        x = ~wavelengths,
        y = ~spec,
        split = ~name,
        name = ~name,
        line = list(width = 1, simplify = TRUE)
      )
    )
  )
}

fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = xaxis_spectral,
      yaxis = list(title = "Raw Spectrum", titlefont = list(color = "#7f7f7f"))
    )
  )
)

plotly_build2(fig)
```

```{r}
#| output: asis
if (spectral_selection[2]) cat("### Preprocessed Spectra\n\n")
```

```{r}
#| eval: !expr spectral_selection[2]
# Reduce resolution of preprocessed spectrum for decreased file size
prepro_spc <- full_model$preprocessed_X
recipe <- full_model$preprocess$preprocessing_order

to_plot <- data.frame(
  wavelengths = as.double(colnames(prepro_spc)),
  spec = as.vector(t(prepro_spc)),
  name = rep(paste("Spectrum", cal_stats$Sample_index), each = ncol(prepro_spc)),
  grp = rep(group_factor, each = ncol(prepro_spc))
)

to_plot$name <- factor(to_plot$name, levels = paste("Spectrum", cal_stats$Sample_index))

fig <- plot_ly(type = "scatter", mode = "lines")

if (has_group) {
  shown_groups <- character(0)
  for (s in levels(to_plot$name)) {
    sub <- to_plot[to_plot$name == s, ]
    g <- as.character(sub$grp[1])
    show <- !(g %in% shown_groups)
    fig <- do.call(
      "add_trace",
      c(
        plotly_params["marker" != names(plotly_params)],
        list(
          p = fig,
          x = sub$wavelengths,
          y = sub$spec,
          type = "scatter",
          mode = "lines",
          name = g,
          legendgroup = g,
          showlegend = show,
          line = list(width = 1, color = group_colors[[g]]),
          hovertext = s,
          hoverinfo = "x+y+text"
        )
      )
    )
    shown_groups <- c(shown_groups, g)
  }
} else {
  fig <- do.call(
    "add_lines",
    c(
      plotly_params["marker" != names(plotly_params)],
      list(
        p = fig,
        data = to_plot,
        x = ~wavelengths,
        y = ~spec,
        split = ~name,
        name = ~name,
        line = list(width = 1, simplify = TRUE)
      )
    )
  )
}

fig <- do.call(
  "add_text",
  list(
    p = fig,
    x = unname(quantile(to_plot$wavelengths, probs = 0.03)),
    y = max(to_plot$spec),
    text = recipe,
    textposition = "bottom right",
    showlegend = FALSE,
    hoverinfo = "text",
    fillcolor = "red"
  )
)

fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = xaxis_spectral,
      yaxis = list(
        title = "Preprocessed Spectrum",
        titlefont = list(color = "#7f7f7f")
      )
    )
  )
)
plotly_build2(fig)
```


```{r}
#| output: asis
if (spectral_selection[3]) cat("### Weights\n\n")
```

```{r}
#| eval: !expr spectral_selection[3]
to_plot <- data.frame(
  wavelengths = wavelengths,
  weights = as.vector(t(final_model$model$weights)),
  name = rep(
    paste("Component", components),
    each = ncol(final_model$model$weights)
  )
)

to_plot$name <- factor(to_plot$name, levels = paste("Component", components))

fig <- do.call(
  "plot_ly",
  c(
    plotly_params["marker" != names(plotly_params)],
    list(
      data = to_plot,
      type = "scatter",
      mode = "lines",
      x = ~wavelengths,
      y = ~weights,
      split = ~name,
      name = ~name,
      line = list(width = 1, simplify = TRUE)
    )
  )
)
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = xaxis_spectral,
      yaxis = list(title = "Weight", titlefont = list(color = "#7f7f7f"))
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (spectral_selection[4]) cat("### Loadings\n\n")
```

```{r}
#| eval: !expr spectral_selection[4]
to_plot <- data.frame(
  wavelengths = wavelengths,
  loadings = as.vector(t(final_model$model$x_loadings)),
  name = rep(
    paste("Component", components),
    each = ncol(final_model$model$x_loadings)
  )
)

to_plot$name <- factor(to_plot$name, levels = paste("Component", components))

fig <- do.call(
  "plot_ly",
  c(
    plotly_params["marker" != names(plotly_params)],
    list(
      data = to_plot,
      type = "scatter",
      mode = "lines",
      x = ~wavelengths,
      y = ~loadings,
      split = ~name,
      name = ~name,
      line = list(width = 1, simplify = TRUE)
    )
  )
)
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = xaxis_spectral,
      yaxis = list(title = "Loading", titlefont = list(color = "#7f7f7f"))
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (spectral_selection[5]) cat("### Coefficients\n\n")
```

```{r}
#| eval: !expr spectral_selection[5]
to_plot <- data.frame(
  wavelengths = wavelengths,
  coeff = as.vector(t(final_model$model$coefficients)),
  name = rep(
    paste("Component", components),
    each = ncol(final_model$model$coefficients)
  )
)

to_plot$name <- factor(to_plot$name, levels = paste("Component", components))

fig <- do.call(
  "plot_ly",
  c(
    plotly_params["marker" != names(plotly_params)],
    list(
      data = to_plot,
      type = "scatter",
      mode = "lines",
      x = ~wavelengths,
      y = ~coeff,
      split = ~name,
      name = ~name,
      line = list(width = 1, simplify = TRUE)
    )
  )
)
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = xaxis_spectral,
      yaxis = list(title = "Regression Coefficient", titlefont = list(color = "#7f7f7f"))
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (spectral_selection[6]) cat("### Scores\n\n")
```

```{r}
#| eval: !expr spectral_selection[6]
fig <- plot_ly()
for (i in components) {
  fig <- fig |>
    add_segments(
      x = seq_len(n_observations),
      xend = seq_len(n_observations),
      y = as.vector(final_model$model$scores[, i]),
      yend = 0,
      line = list(dash = "dash", width = 0.3, color = "black"),
      showlegend = FALSE,
      visible = (i == opt_comp)
    )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["marker" != names(plotly_params)],
          list(
            p = fig,
            x = idx,
            y = as.vector(final_model$model$scores[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = seq_len(n_observations),
          y = as.vector(final_model$model$scores[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Observation", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Score", titlefont = list(color = "#7f7f7f")),
      sliders = if (has_group) group_sliders else sliders,
      legend = list(traceorder = "grouped")
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (spectral_selection[7]) cat("### 3D Scores\n\n")
```

```{r}
#| eval: !expr spectral_selection[7]
fig <- plot_ly()
scores <- final_model$model$scores
components_3d <- 2:(n_comps - 1)
if (n_comps > 3) {
  max_comp <- max(2, min(n_comps - 1, opt_comp, na.rm = TRUE))
  max_pos <- which(components_3d == max_comp)
  if (has_group) {
    # Build grouped 3D slider steps
    n_groups <- length(levels(group_factor))
    n_3d_traces <- length(components_3d) * n_groups
    steps_3d <- list()
    for (i in components_3d) {
      pos <- which(components_3d == i)
      vis <- rep(FALSE, n_3d_traces)
      marker_start <- (pos - 1) * n_groups + 1
      vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
      steps_3d[[pos]] <- list(
        args = list(
          list(visible = vis),
          list(scene = list(
            xaxis = list(title = paste("x: Component", i), titlefont = list(color = "#7f7f7f")),
            yaxis = list(title = paste("y: Component", i - 1), titlefont = list(color = "#7f7f7f")),
            zaxis = list(title = paste("z: Component", i + 1), titlefont = list(color = "#7f7f7f"))
          ))
        ),
        method = "update",
        label = paste("Component", i),
        value = as.character(i)
      )
    }
    for (i in components_3d) {
      for (gi in seq_along(levels(group_factor))) {
        g <- levels(group_factor)[gi]
        idx <- which(group_factor == g)
        fig <- add_markers(
          fig,
          x = as.vector(scores[idx, i]),
          y = as.vector(scores[idx, i - 1]),
          z = as.vector(scores[idx, i + 1]),
          visible = (i == max_comp),
          hovertext = observation_names[idx],
          name = g,
          legendgroup = g,
          legendrank = gi,
          showlegend = TRUE,
          marker = list(color = group_colors[[g]]),
          hoverinfo = "x+y+z+text"
        )
      }
    }
  } else {
    steps_3d <- list()
    for (i in components_3d) {
      pos <- which(components_3d == i)
      vis <- rep(FALSE, length(components_3d))
      vis[pos] <- TRUE
      steps_3d[[pos]] <- list(
        args = list(
          list(visible = vis),
          list(scene = list(
            xaxis = list(title = paste("x: Component", i), titlefont = list(color = "#7f7f7f")),
            yaxis = list(title = paste("y: Component", i - 1), titlefont = list(color = "#7f7f7f")),
            zaxis = list(title = paste("z: Component", i + 1), titlefont = list(color = "#7f7f7f"))
          ))
        ),
        method = "update",
        label = paste("Component", i),
        value = as.character(i)
      )
    }
    for (i in components_3d) {
      fig <- add_markers(
        fig,
        x = as.vector(scores[, i]),
        y = as.vector(scores[, i - 1]),
        z = as.vector(scores[, i + 1]),
        visible = (i == max_comp),
        hovertext = observation_names,
        showlegend = FALSE,
        marker = list(color = colrs[i]),
        hoverinfo = "x+y+z+text"
      )
    }
  }
  
  sliders_3d <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = max_pos - 1,
    steps = steps_3d,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
  fig <- fig |> layout(
    scene = list(
      xaxis = list(title = paste("x: Component", max_comp), titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = paste("y: Component", max_comp - 1), titlefont = list(color = "#7f7f7f")),
      zaxis = list(title = paste("z: Component", max_comp + 1), titlefont = list(color = "#7f7f7f"))
    ),
    sliders = sliders_3d
  )
  plotly_build2(fig)
} else if (n_comps == 3) {
  if (has_group) {
    for (g in levels(group_factor)) {
      idx <- which(group_factor == g)
      fig <- add_markers(
        fig,
        x = as.vector(scores[idx, 2]),
        y = as.vector(scores[idx, 1]),
        z = as.vector(scores[idx, 3]),
        hovertext = observation_names[idx],
        name = g,
        legendgroup = g,
        showlegend = TRUE,
        marker = list(color = group_colors[[g]]),
        hoverinfo = "x+y+z+text"
      )
    }
  } else {
    fig <- add_markers(
      fig,
      x = as.vector(scores[, 2]),
      y = as.vector(scores[, 1]),
      z = as.vector(scores[, 3]),
      hovertext = observation_names,
      showlegend = FALSE,
      marker = list(color = "blue"),
      hoverinfo = "x+y+z+text"
    )
  }
  fig <- fig |> layout(
    scene = list(
      xaxis = list(title = paste("x: Component", 2), titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = paste("y: Component", 1), titlefont = list(color = "#7f7f7f")),
      zaxis = list(title = paste("z: Component", 3), titlefont = list(color = "#7f7f7f"))
    )
  )
  plotly_build2(fig)
} else {
  print("Too few components for 3-dimensional plot")
}
```

```{r}
#| output: asis
if (spectral_selection[8]) cat("### Scaled Scores\n\n")
```

```{r}
#| eval: !expr spectral_selection[8]
fig <- plot_ly()
scaled_scores <- final_model$model$scaled_scores
for (i in components) {
  fig <- fig |>
    add_segments(
      x = seq_len(n_observations),
      xend = seq_len(n_observations),
      y = as.vector(scaled_scores[, i]),
      yend = 0,
      line = list(dash = "dash", width = 0.5, color = "black"),
      showlegend = FALSE,
      visible = (i == opt_comp)
    )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = idx,
            y = as.vector(scaled_scores[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = seq_len(n_observations),
          y = as.vector(scaled_scores[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Observation", titlefont = list(color = "#7f7f7f")),
      yaxis = list(
        title = "Scaled Score",
        titlefont = list(color = "#7f7f7f"),
        range = c(floor(min(scaled_scores)), ceiling(max(scaled_scores)))
      ),
      sliders = if (has_group) group_sliders else sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (spectral_selection[9]) cat("### Mahalanobis Distance\n\n")
```

```{r}
#| eval: !expr spectral_selection[9]
fig <- plot_ly()
mahal <- final_model$calibration_statistics_all$Mahalanobis
for (i in components) {
  fig <- fig |>
    add_segments(
      x = seq_len(n_observations),
      xend = seq_len(n_observations),
      y = as.vector(mahal[, i]),
      yend = 0,
      line = list(dash = "dash", width = 0.5, color = "black"),
      showlegend = FALSE,
      visible = (i == opt_comp)
    )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = idx,
            y = as.vector(mahal[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = seq_len(n_observations),
          y = as.vector(mahal[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Observation", titlefont = list(color = "#7f7f7f")),
      yaxis = list(
        title = "Mahalanobis Distance",
        titlefont = list(color = "#7f7f7f"),
        range = c(floor(min(mahal)), ceiling(max(mahal)))
      ),
      sliders = if (has_group) group_sliders else sliders
    )
  )
)
plotly_build2(fig)
```


```{r}
#| output: asis
if (header_selection[2]) cat("# Cross-Validation Results\n\n## Column {.tabset}\n\n")
```

```{r}
#| output: asis
if (cv_selection[1]) cat("### Error Measures\n\n")
```

```{r}
#| eval: !expr cv_selection[1]
errs <- final_model$model_cv$grid
cal_errs <- final_model$model$cal_error
fig <- plot_ly(type = "scatter", mode = "lines+markers") |>
  add_trace(
    x = components,
    y = errs[, "rmse"],
    name = "Root mean squared error",
    text = "Root mean squared error",
    hoverinfo = "x+y+text"
  ) |>
  add_trace(
    x = components,
    y = cal_errs[, "cal_set_error"],
    name = "Standard error of calibration",
    text = "Standard error of calibration",
    hoverinfo = "x+y+text"
  ) |>
  add_trace(
    x = components,
    y = errs[, "largest_residual"],
    name = "Largest residual",
    text = "Largest residual",
    hoverinfo = "x+y+text"
  ) |>
  add_trace(
    x = components,
    y = cal_errs[, "max_residuals"],
    name = "Largest residual of calibration",
    text = "Largest residual of calibration",
    hoverinfo = "x+y+text"
  ) |>
  add_markers(
    x = opt_comp,
    y = unlist(list(
      errs[opt_comp, c("rmse", "largest_residual")],
      cal_errs[opt_comp, c("max_residuals", "cal_set_error")]
    )),
    marker = list(color = "blue"),
    name = "Optimal component",
    text = paste("Optimal component:", opt_comp),
    hoverinfo = "text"
  ) |>
  layout(
    xaxis = list(title = "Component", titlefont = list(color = "#7f7f7f")),
    yaxis = list(title = "Error measures", titlefont = list(color = "#7f7f7f")),
    hovermode = "x"
  )
plotly_build2(fig)
```

```{r}
#| output: asis
if (cv_selection[2]) cat("### CV Response Plot\n\n")
```

```{r}
#| eval: !expr cv_selection[2]
cv_predictions <- final_model$model_cv$pred
errs <- final_model$model_cv$grid
fig <- plot_ly()
line_x_y <- seq(
  from = min(cv_predictions, Y, na.rm = TRUE),
  to = max(cv_predictions, Y, na.rm = TRUE),
  length.out = n_observations
)
for (i in components) {
  fig <- fig |>
    add_lines(
      x = line_x_y,
      y = line_x_y,
      visible = (i == opt_comp),
      line = list(
        dash = "dash",
        width = 1,
        color = "black"
      ),
      showlegend = FALSE,
      hoverinfo = "text",
      type = "scatter",
      mode = "lines",
      text = "identity line"
    )
}
for (i in components) {
  lin_model <- lm(cv_predictions[, i] ~ Y)
  fig <- fig |> add_lines(
    x = line_x_y,
    y = lin_model$coefficients[1] + line_x_y * lin_model$coefficients[2],
    visible = (i == opt_comp),
    line = list(width = 1, color = if (has_group) "#555555" else colrs[i]),
    showlegend = FALSE,
    hoverinfo = "text",
    type = "scatter",
    mode = "lines",
    text = "regression line"
  )
}
for (i in components) {
  fig <- fig |> add_text(
    text = paste("<b>R<sup>2</sup>:", errs[i, "rsq"], "</b>"),
    x = line_x_y[1],
    y = line_x_y[n_observations],
    textposition = "bottom right",
    visible = (i == opt_comp),
    showlegend = FALSE,
    hoverinfo = "text",
    fillcolor = "red"
  )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- fig |> add_markers(
        x = as.vector(Y[idx]),
        y = cv_predictions[idx, i],
        visible = (i == opt_comp),
        hovertext = observation_names[idx],
        name = g,
        legendgroup = g,
        legendrank = gi,
        showlegend = TRUE,
        marker = list(color = group_colors[[g]]),
        hoverinfo = "x+y+text",
        type = "scatter",
        mode = "markers"
      )
    }
  } else {
    fig <- fig |> add_markers(
      x = as.vector(Y),
      y = cv_predictions[, i],
      visible = (i == opt_comp),
      hovertext = observation_names,
      showlegend = FALSE,
      marker = list(color = colrs[i]),
      hoverinfo = "x+y+text",
      type = "scatter",
      mode = "markers"
    )
  }
}

# Build slider
if (has_group) {
  # Traces: n_comps lines + n_comps regression + n_comps text + n_comps*n_groups markers
  n_groups <- length(levels(group_factor))
  n_cv_traces <- 3 * n_comps + n_comps * n_groups
  cv_steps <- list()
  for (i in components) {
    vis <- rep(FALSE, n_cv_traces)
    vis[i] <- TRUE                        # identity line
    vis[n_comps + i] <- TRUE              # regression line
    vis[2 * n_comps + i] <- TRUE          # text
    marker_start <- 3 * n_comps + (i - 1) * n_groups + 1
    vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
    cv_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", i),
      value = as.character(i)
    )
  }
  cv_sliders <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = opt_comp - 1,
    steps = cv_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
} else {
  cv_sliders <- sliders
}

fig <- fig |>
  layout(
    xaxis = list(title = "Reference Value", titlefont = list(color = "#7f7f7f")),
    yaxis = list(title = "CV Predicted Reference", titlefont = list(color = "#7f7f7f")),
    sliders = cv_sliders
  )
plotly_build2(fig)
```

```{r}
#| output: asis
if (cv_selection[3]) cat("### CV Response Plots Overview\n\n")
```

```{r}
#| eval: !expr cv_selection[3]
cv_predictions <- final_model$model_cv$pred
line_x_y <- seq(
  from = min(cv_predictions, na.rm = TRUE),
  to = max(cv_predictions, na.rm = TRUE),
  length.out = n_observations
)
plts <- list()
for (i in components) {
  lin_model <- lm(cv_predictions[, i] ~ Y)
  cvresponse_df <- data.frame(
    ti = line_x_y,
    true = as.vector(Y),
    pred = as.vector(cv_predictions[, i]),
    texts = observation_names,
    lin_line = lin_model$coefficients[1] + lin_model$coefficients[2] * line_x_y
  )
  fig <- plot_ly(cvresponse_df, type = "scatter", mode = "markers") |>
    add_lines(
      x = ~ti,
      y = ~ti,
      line = list(dash = "dash", width = 1, color = "black"),
      name = "",
      showlegend = FALSE,
      hoverinfo = "none"
    ) |>
    add_lines(
      x = ~ti,
      y = ~lin_line,
      line = list(width = 1, color = colrs[i]),
      name = "",
      showlegend = FALSE,
      hoverinfo = "none"
    ) |>
    add_markers(
      x = ~true,
      y = ~pred,
      hovertext = ~texts,
      name = paste("Component", i),
      marker = list(color = colrs[i])
    )
  plts <- append(plts, list(fig))
}
all_plts <- subplot(plts, nrows = max(floor(n_comps / 5), 1))
plotly_build2(all_plts)
```

```{r}
#| output: asis
if (cv_selection[4]) cat("### CV Residuals\n\n")
```

```{r}
#| eval: !expr cv_selection[4]
fig <- plot_ly()
cv_residuals <- final_model$calibration_statistics_all$cv_residual
rownames(cv_residuals) <- observation_names
for (i in components) {
  fig <- fig |>
    add_segments(
      x = seq_len(n_observations),
      xend = seq_len(n_observations),
      y = as.vector(cv_residuals[, i]),
      yend = 0,
      line = list(dash = "dash", width = 0.5, color = "black"),
      showlegend = FALSE,
      visible = (i == opt_comp)
    )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = idx,
            y = as.vector(cv_residuals[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = seq_len(n_observations),
          y = as.vector(cv_residuals[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Observation", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Residual", titlefont = list(color = "#7f7f7f")),
      sliders = if (has_group) group_sliders else sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (cv_selection[5]) cat("### Q-Q Plot of CV Residuals\n\n")
```

```{r}
#| eval: !expr cv_selection[5]
std_cv_residual <- scale(final_model$calibration_statistics_all$cv_residual, center = TRUE, scale = TRUE)
fig <- plot_ly()
line_x_y <- seq(
  from = min(std_cv_residual, na.rm = TRUE),
  to = max(std_cv_residual, na.rm = TRUE),
  length.out = n_observations
)
for (i in components) {
  fig <- fig |>
    add_lines(
      x = line_x_y,
      y = line_x_y,
      visible = (i == opt_comp),
      line = list(
        dash = "dash",
        width = 1,
        color = "black"
      ),
      showlegend = FALSE,
      hoverinfo = "none",
      type = "scatter",
      mode = "lines"
    )
}

for (i in components) {
  fig <- do.call(
    "add_markers",
    c(
      plotly_params["line" != names(plotly_params)],
      list(
        p = fig,
        x = qnorm(ppoints(n_observations)),
        y = sort(std_cv_residual[, i]),
        visible = (i == opt_comp),
        hovertext = names(sort(std_cv_residual[, i])),
        showlegend = FALSE,
        hoverinfo = "x+y+text",
        type = "scatter",
        mode = "markers"
      )
    )
  )
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Theoretical Normal Quantile", titlefont = list(color = "#7f7f7f")),
      yaxis = list(
        title = "Sample Quantile",
        titlefont = list(color = "#7f7f7f"),
        range = c(
          floor(min(std_cv_residual)),
          ceiling(max(std_cv_residual))
        )
      ),
      sliders = sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (cv_selection[6]) cat("### CV Q-values\n\n")
```

```{r}
#| eval: !expr cv_selection[6]
fig <- plot_ly()
q_val <- final_model$calibration_statistics_all$Q_value
for (i in components) {
  fig <- fig |>
    add_segments(
      x = seq_len(n_observations),
      xend = seq_len(n_observations),
      y = as.vector(q_val[, i]),
      yend = 0,
      line = list(dash = "dash", width = 0.5, color = "black"),
      showlegend = FALSE,
      visible = (i == opt_comp)
    )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = idx,
            y = as.vector(q_val[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = seq_len(n_observations),
          y = as.vector(q_val[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Observation", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Q-value", titlefont = list(color = "#7f7f7f")),
      sliders = if (has_group) group_sliders else sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (cv_selection[7]) cat("### Distributions\n\n")
```

```{r}
#| eval: !expr cv_selection[7]
distr_list <- list()
fig <- plot_ly()
true_density <- density(Y)
min_x <- min(true_density$x)
min_y <- min(true_density$y)
max_x <- max(true_density$x)
max_y <- max(true_density$y)
for (i in components) {
  i_density <- density(
    final_model$calibration_statistics_all$predicted_y_in_cv[, i],
    bw = true_density$bw,
    from = min(true_density$x),
    to = max(true_density$x)
  )
  distr_list[[i]] <- list(
    visible = FALSE,
    pred = i_density
  )
  min_x <- min(min_x, i_density$x)
  min_y <- min(min_y, i_density$y)
  max_x <- max(max_x, i_density$x)
  max_y <- max(max_y, i_density$y)
}

distr_list[opt_comp][[1]]$visible <- TRUE
for (i in components) {
  fig <- add_lines(
    fig,
    x = true_density$x,
    y = true_density$y,
    visible = distr_list[i][[1]]$visible,
    line = list(color = "black"),
    hoverinfo = "x+y+text",
    type = "scatter",
    mode = "lines",
    name = "Reference density",
    text = "Reference density",
    fill = "tozeroy",
    fillcolor = rgb(0, 0, 0, alpha = 0.2)
  )
}

for (i in components) {
  fig <- add_lines(
    fig,
    x = distr_list[i][[1]]$pred$x,
    y = distr_list[i][[1]]$pred$y,
    visible = distr_list[i][[1]]$visible,
    showlegend = TRUE,
    line = list(color = colrs[i]),
    hoverinfo = "x+y+text",
    type = "scatter",
    mode = "lines",
    name = "Predicted density",
    text = "Predicted density",
    fill = "tozeroy",
    fillcolor = scales::alpha(colrs[i], 0.2)
  )
}
fig <- fig |> layout(
  xaxis = list(
    title = "Reference Values",
    titlefont = list(color = "#7f7f7f"),
    range = c(min_x, max_x)
  ),
  yaxis = list(
    title = "Density",
    titlefont = list(color = "#7f7f7f"),
    range = c(min_y, max_y)
  ),
  sliders = sliders
)
plotly_build2(fig)
```


```{r}
#| output: asis
if (header_selection[3]) cat("# Regression Analysis Plots\n\n## Column {.tabset}\n\n")
```

```{r}
#| output: asis
if (regression_selection[1]) cat("### Response Plot\n\n")
```

```{r}
#| eval: !expr regression_selection[1]
fits <- final_model$model$fitted_y
fig <- plot_ly()
cal_predictions <- final_model$model$fitted_y
line_x_y <- seq(
  from = min(cal_predictions, Y, na.rm = TRUE),
  to = max(cal_predictions, Y, na.rm = TRUE),
  length.out = n_observations
)
for (i in components) {
  fig <- fig |>
    add_lines(
      x = line_x_y,
      y = line_x_y,
      visible = (i == opt_comp),
      line = list(dash = "dash", width = 1, color = "black"),
      showlegend = FALSE,
      hoverinfo = "text",
      type = "scatter",
      mode = "lines",
      text = "identity line"
    )
}
for (i in components) {
  lin_model <- lm(cal_predictions[, i] ~ Y)
  fig <- fig |> add_lines(
    x = line_x_y,
    y = lin_model$coefficients[1] + line_x_y * lin_model$coefficients[2],
    visible = (i == opt_comp),
    line = list(width = 1, color = if (has_group) "#555555" else "blue"),
    showlegend = FALSE,
    hoverinfo = "text",
    type = "scatter",
    mode = "lines",
    text = "regression line"
  )
}

for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = as.vector(Y[idx]),
            y = cal_predictions[idx, i],
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- add_markers(
      fig,
      x = as.vector(Y),
      y = as.vector(fits[, i]),
      visible = (i == opt_comp),
      hovertext = observation_names,
      showlegend = FALSE,
      marker = list(color = colrs[i]),
      hoverinfo = "x+y+text",
      type = "scatter",
      mode = "markers"
    )
  }
}


# Build slider
if (has_group) {
  n_groups <- length(levels(group_factor))
  n_resp_traces <- 2 * n_comps + n_comps * n_groups
  resp_steps <- list()
  for (i in components) {
    vis <- rep(FALSE, n_resp_traces)
    vis[i] <- TRUE                        # identity line
    vis[n_comps + i] <- TRUE              # regression line
    marker_start <- 2 * n_comps + (i - 1) * n_groups + 1
    vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
    resp_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", i),
      value = as.character(i)
    )
  }
  resp_sliders <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = opt_comp - 1,
    steps = resp_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
} else {
  resp_sliders <- sliders
}



fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(
        title = "Reference Value",
        titlefont = list(color = "#7f7f7f")
      ),
      yaxis = list(
        title = "Predicted Reference",
        titlefont = list(color = "#7f7f7f")
      ),
      sliders = resp_sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (regression_selection[2]) cat("### Response Plots Overview\n\n")
```

```{r}
#| eval: !expr regression_selection[2]
fits <- final_model$model$fitted_y
line_x_y <- seq(
  from = min(Y, fits),
  to = max(Y, fits),
  length.out = n_observations
)
plts <- list()
for (i in components) {
  all_response_df <- data.frame(
    ti = line_x_y,
    true = as.vector(Y),
    pred = as.vector(fits[, i]),
    texts = observation_names
  )
  fig <- plot_ly(all_response_df, type = "scatter", mode = "markers") |>
    add_lines(
      x = ~ti,
      y = ~ti,
      line = list(dash = "dash", width = 1, color = "black"),
      name = "",
      showlegend = FALSE,
      hoverinfo = "text",
      text = "regression line"
    ) |>
    add_markers(
      x = ~true,
      y = ~pred,
      hovertext = ~texts,
      name = paste("Component", i),
      marker = list(color = colrs[i])
    )
  plts <- append(plts, list(fig))
}
all_plts <- subplot(plts, nrows = max(1, floor(n_comps / 5)))
plotly_build2(all_plts)
```

```{r}
#| output: asis
if (regression_selection[3]) cat("### Residuals\n\n")
```

```{r}
#| eval: !expr regression_selection[3]
fig <- plot_ly()
residual <- cal_stats$residual
for (i in components) {
  fig <- fig |>
    add_segments(
      x = seq_len(n_observations),
      xend = seq_len(n_observations),
      y = as.vector(residual[, i]),
      yend = 0,
      line = list(dash = "dash", width = 1, color = "black"),
      showlegend = FALSE,
      visible = (i == opt_comp)
    )
}
for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = idx,
            y = as.vector(residual[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = seq_len(n_observations),
          y = as.vector(residual[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Observation", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Residual", titlefont = list(color = "#7f7f7f")),
      sliders = if (has_group) group_sliders else sliders
    )
  )
)

plotly_build2(fig)
```

```{r}
#| output: asis
if (regression_selection[4]) cat("### Q-Q Plot of Residuals\n\n")
```

```{r}
#| eval: !expr regression_selection[4]
std_residual <- scale(cal_stats$residual, center = TRUE, scale = TRUE)
fig <- plot_ly()
line_x_y <- seq(
  from = min(std_residual),
  to = max(std_residual),
  length.out = n_observations
)
for (i in components) {
  fig <- fig |>
    add_lines(
      x = line_x_y,
      y = line_x_y,
      visible = (i == opt_comp),
      line = list(
        dash = "dash",
        width = 1,
        color = "black"
      ),
      showlegend = FALSE,
      hoverinfo = "none",
      type = "scatter",
      mode = "lines"
    )
}

for (i in components) {
  fig <- do.call(
    "add_markers",
    c(
      plotly_params["line" != names(plotly_params)],
      list(
        p = fig,
        x = qnorm(ppoints(n_observations)),
        y = sort(std_residual[, i]),
        visible = (i == opt_comp),
        hovertext = paste("Observation", names(sort(std_residual[, i]))),
        showlegend = FALSE,
        hoverinfo = "x+y+text",
        type = "scatter",
        mode = "markers"
      )
    )
  )
}
fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Theoretical Normal Quantile", titlefont = list(color = "#7f7f7f")),
      yaxis = list(
        title = "Sample Quantile",
        titlefont = list(color = "#7f7f7f"),
        range = c(
          floor(min(std_residual)),
          ceiling(max(std_residual))
        )
      ),
      sliders = sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (regression_selection[5]) cat("### Residuals vs Fitted\n\n")
```

```{r}
#| eval: !expr regression_selection[5]
fig <- plot_ly()
residual <- cal_stats$residual
fits <- final_model$calibration_statistics_all$fitted_y
for (i in components) {
  loess_smoother <- loess.smooth(x = fits[, i], y = as.vector(residual[, i]))
  fig <- fig |> add_lines(
    x = loess_smoother$x,
    y = loess_smoother$y,
    hoverinfo = "x+y+text",
    showlegend = FALSE,
    text = "Loess smoother",
    visible = (i == opt_comp),
    type = "scatter",
    mode = "lines",
    line = list(color = "red")
  )
}

for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = fits[idx, i],
            y = as.vector(residual[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = fits[, i],
          y = as.vector(residual[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}

# Build slider
if (has_group) {
  n_groups <- length(levels(group_factor))
  # Traces: n_comps loess lines + n_comps * n_groups markers
  n_rvf_traces <- n_comps + n_comps * n_groups
  rvf_steps <- list()
  for (i in components) {
    vis <- rep(FALSE, n_rvf_traces)
    vis[i] <- TRUE
    marker_start <- n_comps + (i - 1) * n_groups + 1
    vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
    rvf_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", i),
      value = as.character(i)
    )
  }
  rvf_sliders <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = opt_comp - 1,
    steps = rvf_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
} else {
  rvf_sliders <- sliders
}

fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Fitted values", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Residuals", titlefont = list(color = "#7f7f7f")),
      sliders = rvf_sliders
    )
  )
)
plotly_build2(fig)
```


```{r}
#| output: asis
if (regression_selection[6]) cat("### Scale Location Plot\n\n")
```

```{r}
#| eval: !expr regression_selection[6]
fig <- plot_ly()
fits <- final_model$calibration_statistics_all$fitted_y
std_residual <- scale(cal_stats$residual, center = TRUE, scale = TRUE)
for (i in components) {
  loess_smoother <- loess.smooth(x = fits[, i], y = sqrt(abs(std_residual[, i])))
  fig <- fig |> add_lines(
    x = loess_smoother$x,
    y = loess_smoother$y,
    hoverinfo = "x+y+text",
    showlegend = FALSE,
    text = "Loess smoother",
    visible = (i == opt_comp),
    type = "scatter",
    mode = "lines",
    line = list(color = "red")
  )
}

for (i in components) {
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = fits[idx, i],
            y = as.vector(sqrt(abs(std_residual[idx, i]))),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = fits[, i],
          y = as.vector(sqrt(abs(std_residual[, i]))),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}

# Build slider
if (has_group) {
  n_groups <- length(levels(group_factor))
  n_sl_traces <- n_comps + n_comps * n_groups
  sl_steps <- list()
  for (i in components) {
    vis <- rep(FALSE, n_sl_traces)
    vis[i] <- TRUE
    marker_start <- n_comps + (i - 1) * n_groups + 1
    vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
    sl_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", i),
      value = as.character(i)
    )
  }
  sl_sliders <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = opt_comp - 1,
    steps = sl_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
} else {
  sl_sliders <- sliders
}

fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Fitted Values", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Square Root of Standardized Residuals", titlefont = list(color = "#7f7f7f")),
      sliders = sl_sliders
    )
  )
)
plotly_build2(fig)
```

```{r}
#| output: asis
if (regression_selection[7]) cat("### Leverage vs Residuals\n\n")
```

```{r}
#| eval: !expr regression_selection[7]
fig <- plot_ly()
fits <- final_model$calibration_statistics_all$fitted_y
std_residual <- scale(cal_stats$residual, center = TRUE, scale = TRUE)
for (i in components) {
  loess_smoother <- loess.smooth(
    x = hat(x = fits[, i]),
    y = as.vector(std_residual[, i])
  )
  fig <- fig |> add_lines(
    x = loess_smoother$x,
    y = loess_smoother$y,
    hoverinfo = "x+y+text",
    showlegend = FALSE,
    text = "Loess smoother",
    visible = (i == opt_comp),
    type = "scatter",
    mode = "lines",
    line = list(color = "red")
  )
}

for (i in components) {
  leverage_i <- hat(x = fits[, i])
  if (has_group) {
    for (gi in seq_along(levels(group_factor))) {
      g <- levels(group_factor)[gi]
      idx <- which(group_factor == g)
      fig <- do.call(
        "add_markers",
        c(
          plotly_params["line" != names(plotly_params)],
          list(
            p = fig,
            x = leverage_i[idx],
            y = as.vector(std_residual[idx, i]),
            visible = (i == opt_comp),
            hovertext = observation_names[idx],
            name = g,
            legendgroup = g,
            legendrank = gi,
            showlegend = TRUE,
            marker = list(color = group_colors[[g]]),
            hoverinfo = "x+y+text",
            type = "scatter",
            mode = "markers"
          )
        )
      )
    }
  } else {
    fig <- do.call(
      "add_markers",
      c(
        plotly_params["line" != names(plotly_params)],
        list(
          p = fig,
          x = leverage_i,
          y = as.vector(std_residual[, i]),
          visible = (i == opt_comp),
          hovertext = observation_names,
          showlegend = FALSE,
          marker = list(color = colrs[i]),
          hoverinfo = "x+y+text",
          type = "scatter",
          mode = "markers"
        )
      )
    )
  }
}


# Build slider
if (has_group) {
  n_groups <- length(levels(group_factor))
  n_lev_traces <- n_comps + n_comps * n_groups
  lev_steps <- list()
  for (i in components) {
    vis <- rep(FALSE, n_lev_traces)
    vis[i] <- TRUE
    marker_start <- n_comps + (i - 1) * n_groups + 1
    vis[marker_start:(marker_start + n_groups - 1)] <- TRUE
    lev_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", i),
      value = as.character(i)
    )
  }
  lev_sliders <- list(list(
    currentvalue = list(prefix = "", font = list(color = "black", xanchor = "left")),
    active = opt_comp - 1,
    steps = lev_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
} else {
  lev_sliders <- sliders
}

fig <- do.call(
  "layout",
  c(
    layout_params,
    list(
      p = fig,
      xaxis = list(title = "Leverage", titlefont = list(color = "#7f7f7f")),
      yaxis = list(title = "Standardized Residuals", titlefont = list(color = "#7f7f7f")),
      sliders = lev_sliders
    )
  )
)
plotly_build2(fig)
```


```{r}
#| output: asis
if (header_selection[4]) cat("# Validation Plots\n\n## Column {.tabset}\n\n")
```


```{r}
#| output: asis
if (val_selection[1]) cat("### Predicted vs. Reference\n\n")
```

```{r}
#| eval: !expr val_selection[1]
n_vals <- length(validations$validation)
refs <- validations$reference
n_val_groups <- if (has_val_group) length(levels(val_group_factor)) else 1L
n_marker_traces <- if (has_val_group) n_vals * n_val_groups else n_vals
val_ncomp <- as.numeric(gsub("ncomp_", "", names(validations$validation)))
fig <- plot_ly()
for (i in seq_len(n_vals)) {
  preds <- as.matrix(validations$validation[[i]]$val_results[, "y_hat"])
  line_x_y <- seq(
    from = min(preds, refs, na.rm = TRUE),
    to = max(preds, refs, na.rm = TRUE),
    length.out = 100
  )
  fig <- fig |> add_lines(
    x = line_x_y,
    y = line_x_y,
    visible = (i == val_opt_idx),
    line = list(
      dash = "dash",
      width = 1,
      color = "black"
    ),
    showlegend = FALSE,
    hoverinfo = "text",
    type = "scatter",
    mode = "lines",
    text = "identity line"
  )
}
for (i in seq_len(n_vals)) {
  preds <- as.matrix(validations$validation[[i]]$val_results[, "y_hat"])
  line_x_y <- seq(
    from = min(preds, refs, na.rm = TRUE),
    to = max(preds, refs, na.rm = TRUE),
    length.out = 100
  )
  lin_model <- lm(preds ~ refs)
  fig <- fig |> add_lines(
    x = line_x_y,
    y = lin_model$coefficients[1] + line_x_y * lin_model$coefficients[2],
    visible = (i == val_opt_idx),
    line = list(width = 1, color = colrs[i]),
    showlegend = FALSE,
    hoverinfo = "text",
    type = "scatter",
    mode = "lines",
    text = "regression line"
  )
}
for (i in seq_len(n_vals)) {
  preds <- as.vector(as.matrix(validations$validation[[i]]$val_results[, "y_hat"]))
  if (has_val_group) {
    for (gi in seq_along(levels(val_group_factor))) {
      g <- levels(val_group_factor)[gi]
      idx <- which(val_group_factor == g)
      fig <- fig |> add_markers(
        x = as.vector(refs)[idx],
        y = preds[idx],
        visible = (i == val_opt_idx),
        hovertext = paste("Observation", rownames(validations$validation[[i]]$val_results)[idx]),
        name = g,
        legendgroup = g,
        legendrank = gi,
        showlegend = TRUE,
        marker = list(color = val_group_colors[[g]]),
        hoverinfo = "x+y+text",
        type = "scatter",
        mode = "markers"
      )
    }
  } else {
    fig <- fig |> add_markers(
      x = as.vector(refs),
      y = preds,
      visible = (i == val_opt_idx),
      hovertext = paste("Observation", rownames(validations$validation[[i]]$val_results)),
      showlegend = FALSE,
      marker = list(color = colrs[i]),
      hoverinfo = "x+y+text",
      type = "scatter",
      mode = "markers"
    )
  }
}
for (i in seq_len(n_vals)) {
  preds <- as.matrix(validations$validation[[i]]$val_results[, "y_hat"])
  line_x_y <- seq(
    from = min(preds, refs, na.rm = TRUE),
    to = max(preds, refs, na.rm = TRUE),
    length.out = 100
  )
  if (!is.null(validations$model_information$model_grid)) {
    model_info <- paste(
      "Model: <b>R<sup>2</sup> =",
      round(validations$model_information$model_grid[i, "rsq"], digits = 2),
      "; RMSE =",
      round(validations$model_information$model_grid[i, "rmse"], digits = 2),
      "</b>"
    )
  } else {
    model_info <- ""
  }
  fig <- fig |> add_text(text = paste(
    model_info,
    paste(
      "Validation: <b>R<sup>2</sup> =",
      round(validations$validation[[i]]$val_stats["rsq"], digits = 2),
      "; RMSE =",
      round(validations$validation[[i]]$val_stats["rmse"], digits = 2)
    ),
    collapse = "\n"
  ),
  x = line_x_y[1],
  y = line_x_y[length(line_x_y)],
  textposition = "bottom right",
  visible = (i == val_opt_idx),
  showlegend = FALSE,
  hoverinfo = "text",
  fillcolor = "red"
  )
}

fig <- fig |>
  layout(
    xaxis = list(title = "Reference Value", titlefont = list(color = "#7f7f7f")),
    yaxis = list(title = "Predicted Reference", titlefont = list(color = "#7f7f7f"))
  )
if (n_vals > 1) {
  n_traces_total <- n_vals + n_vals + n_marker_traces + n_vals
  val_steps <- list()
  for (i in seq_len(n_vals)) {
    vis <- rep(FALSE, n_traces_total)
    vis[i] <- TRUE
    vis[n_vals + i] <- TRUE
    if (has_val_group) {
      marker_start <- 2 * n_vals + (i - 1) * n_val_groups + 1
      vis[marker_start:(marker_start + n_val_groups - 1)] <- TRUE
    } else {
      vis[2 * n_vals + i] <- TRUE
    }
    vis[2 * n_vals + n_marker_traces + i] <- TRUE
    val_steps[[i]] <- list(
      args = list("visible", vis),
      method = "restyle",
      label = paste("Component", val_ncomp[i]),
      value = as.character(i)
    )
  }
  val_sliders <- list(list(
    currentvalue = list(
      prefix = "",
      font = list(color = "black", xanchor = "left")
    ),
    active = val_opt_idx - 1,
    steps = val_steps,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
  fig <- fig |> layout(sliders = val_sliders)
}
plotly_build2(fig)
```


```{r}
#| output: asis
if (val_selection[2]) cat("### Leverage vs. Spectral Residual\n\n")
```

```{r}
#| eval: !expr val_selection[2]
n_vals <- length(validations$validation)
n_val_groups <- if (has_val_group) length(levels(val_group_factor)) else 1L
val_ncomp <- as.numeric(gsub("ncomp_", "", names(validations$validation)))

ctrl <- validations$control_limits
q_limits <- if (is.null(ctrl$q)) rep(NA_real_, n_vals) else ctrl$q
lev_limits <- if (is.null(ctrl$leverage)) rep(NA_real_, n_vals) else ctrl$leverage
# non-positive limits cannot be a denominator; treat as unavailable (plot raw)
q_limits[!is.finite(q_limits) | q_limits <= 0] <- NA_real_
lev_limits[!is.finite(lev_limits) | lev_limits <= 0] <- NA_real_
conf_pct <- format((if (is.null(ctrl$conf)) 0.95 else ctrl$conf) * 100, trim = TRUE, scientific = FALSE)

# When a limit is available the statistic is plotted relative to it (a dotted
# line at 1); if it is missing (e.g. an older validation object) the raw
# statistic is plotted with no limit line.
rel_lev <- function(i) as.vector(validations$validation[[i]]$val_results[, "mahalanobis"]) / (if (is.finite(lev_limits[i])) lev_limits[i] else 1)
rel_q <- function(i) as.vector(validations$validation[[i]]$val_results[, "q_residual"]) / (if (is.finite(q_limits[i])) q_limits[i] else 1)
x_title <- if (any(is.finite(lev_limits))) paste0("Leverage / ", conf_pct, "% limit") else "Leverage (Mahalanobis)"
y_title <- if (any(is.finite(q_limits))) paste0("Q residual / ", conf_pct, "% limit") else "Spectral residual Q"

# Grey axes at the origin.
origin_shapes <- list(
  list(type = "line", x0 = 0, x1 = 0, y0 = 0, y1 = 1, yref = "paper", line = list(width = 1, color = "grey")),
  list(type = "line", x0 = 0, x1 = 1, xref = "paper", y0 = 0, y1 = 0, line = list(width = 1, color = "grey"))
)

limit_annotations <- function(i) {
  ann <- list()
  if (is.finite(q_limits[i])) {
    ann <- c(ann, list(list(
      x = 0, xref = "paper", xanchor = "left",
      y = 1, yref = "y", yanchor = "bottom",
      text = paste0("Q limit (", conf_pct, "%)"),
      showarrow = FALSE, font = list(color = "firebrick", size = 11)
    )))
  }
  if (is.finite(lev_limits[i])) {
    ann <- c(ann, list(list(
      x = 1, xref = "x", xanchor = "left",
      y = 1, yref = "paper", yanchor = "top",
      text = paste0("Leverage limit (", conf_pct, "%)"),
      showarrow = FALSE, font = list(color = "firebrick", size = 11)
    )))
  }
  ann
}

fig <- plot_ly()
for (i in seq_len(n_vals)) {
  leverage_i <- rel_lev(i)
  q_i <- rel_q(i)
  if (has_val_group) {
    for (gi in seq_along(levels(val_group_factor))) {
      g <- levels(val_group_factor)[gi]
      idx <- which(val_group_factor == g)
      fig <- fig |> add_markers(
        x = leverage_i[idx],
        y = q_i[idx],
        visible = (i == val_opt_idx),
        hovertext = paste("Observation", rownames(validations$validation[[i]]$val_results)[idx]),
        name = g,
        legendgroup = g,
        legendrank = gi,
        showlegend = TRUE,
        marker = list(color = val_group_colors[[g]]),
        hoverinfo = "x+y+text",
        type = "scatter",
        mode = "markers"
      )
    }
  } else {
    fig <- fig |> add_markers(
      x = leverage_i,
      y = q_i,
      visible = (i == val_opt_idx),
      hovertext = paste("Observation", rownames(validations$validation[[i]]$val_results)),
      showlegend = FALSE,
      marker = list(color = colrs[i]),
      hoverinfo = "x+y+text",
      type = "scatter",
      mode = "markers"
    )
  }
}

# Dotted limit lines at 1 (hoverable): one leverage + one Q per component,
# appended after all markers and toggled by the slider like the markers.
for (i in seq_len(n_vals)) {
  x_max <- max(c(rel_lev(i), 1), na.rm = TRUE)
  y_max <- max(c(rel_q(i), 1), na.rm = TRUE)
  fig <- fig |> add_trace(
    x = if (is.finite(lev_limits[i])) rep(1, 20) else rep(NA, 20),
    y = seq(0, y_max, length.out = 20),
    visible = (i == val_opt_idx), showlegend = FALSE,
    text = paste0("Leverage limit (", conf_pct, "%)"),
    hoverinfo = "text", type = "scatter", mode = "lines",
    line = list(width = 1, dash = "dash", color = "firebrick")
  )
  fig <- fig |> add_trace(
    x = seq(0, x_max, length.out = 20),
    y = if (is.finite(q_limits[i])) rep(1, 20) else rep(NA, 20),
    visible = (i == val_opt_idx), showlegend = FALSE,
    text = paste0("Q limit (", conf_pct, "%)"),
    hoverinfo = "text", type = "scatter", mode = "lines",
    line = list(width = 1, dash = "dash", color = "firebrick")
  )
}

fig <- fig |>
  layout(
    xaxis = list(title = x_title, titlefont = list(color = "#7f7f7f")),
    yaxis = list(title = y_title, titlefont = list(color = "#7f7f7f")),
    shapes = origin_shapes,
    annotations = limit_annotations(val_opt_idx)
  )
if (n_vals > 1) {
  n_marker_traces <- if (has_val_group) n_vals * n_val_groups else n_vals
  val_steps2 <- list()
  for (i in seq_len(n_vals)) {
    vis <- rep(FALSE, n_marker_traces + 2 * n_vals)
    if (has_val_group) {
      marker_start <- (i - 1) * n_val_groups + 1
      vis[marker_start:(marker_start + n_val_groups - 1)] <- TRUE
    } else {
      vis[i] <- TRUE
    }
    lim_start <- n_marker_traces + 2 * (i - 1) + 1
    vis[lim_start:(lim_start + 1)] <- TRUE
    val_steps2[[i]] <- list(
      args = list(list(visible = vis), list(annotations = limit_annotations(i))),
      method = "update",
      label = paste("Component", val_ncomp[i]),
      value = as.character(i)
    )
  }
  val_sliders2 <- list(list(
    currentvalue = list(
      prefix = "",
      font = list(color = "black", xanchor = "left")
    ),
    active = val_opt_idx - 1,
    steps = val_steps2,
    pad = list(t = 50, r = 50, b = 0, l = 50)
  ))
  fig <- fig |> layout(sliders = val_sliders2)
}
plotly_build2(fig)
```
