context("test-liblex")

library(foreach)
library(RhpcBLASctl)
registerDoSEQ()

# =============================================================================
# Setup helper
# =============================================================================

.setup_liblex_data <- function() {
  skip_if_not_installed("prospectr")
  
  data("NIRsoil", package = "prospectr")
  
  # Preprocess spectra
  sg_det <- prospectr::savitzkyGolay(
    prospectr::detrend(NIRsoil$spc, wav = as.numeric(colnames(NIRsoil$spc))),
    m = 1, p = 1, w = 7
  )
  NIRsoil$spc_pr <- sg_det
  
  # Split data
  train_idx <- NIRsoil$train == 1
  test_idx <- NIRsoil$train == 0
  
  list(
    train_x = NIRsoil$spc_pr[train_idx, ],
    train_y = NIRsoil$Ciso[train_idx],
    test_x = NIRsoil$spc_pr[test_idx, ],
    test_y = NIRsoil$Ciso[test_idx]
  )
}

local_liblex_setup <- function(env = parent.frame()) {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  library(prospectr)
  data("NIRsoil", package = "prospectr")
  
  NIRsoil$spc_pr <- savitzkyGolay(
    detrend(NIRsoil$spc, wav = as.numeric(colnames(NIRsoil$spc))),
    m = 1, p = 1, w = 7
  )
  
  env$train_x <- NIRsoil$spc_pr[NIRsoil$train == 1, ]
  env$train_y <- NIRsoil$Ciso[NIRsoil$train == 1]
  env$test_x  <- NIRsoil$spc_pr[NIRsoil$train == 0, ]
  env$test_y  <- NIRsoil$Ciso[NIRsoil$train == 0]
}

check_liblex_predictions <- function(model, test_x, test_y, r2_min = 0.82, rmse_max = 0.6) {
  y_hat <- predict(model, test_x, verbose = FALSE)
  r2 <- cor(y_hat$predictions$pred, test_y, use = "complete.obs")^2
  rmse <- sqrt(mean((y_hat$predictions$pred - test_y)^2, na.rm = TRUE))
  
  expect_true(r2 > r2_min, info = paste("R2 too low:", round(r2, 3)))
  expect_true(rmse < rmse_max, info = paste("RMSE too high:", round(rmse, 3)))
}


# =============================================================================
# Input validation tests - Xr
# =============================================================================

test_that("liblex requires Xr to have column names", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  train_x <- d$train_x
  colnames(train_x) <- NULL
  
  expect_error(
    liblex(
      Xr = train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30)
    ),
    "Xr.*must have column names"
  )
})


test_that("liblex requires Xr to be numeric", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  train_x <- d$train_x
  train_x[1, 1] <- "not_numeric"
  
  expect_error(
    liblex(
      Xr = train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30)
    ),
    "Xr.*must be numeric"
  )
})


# =============================================================================
# Input validation tests - Yr
# =============================================================================

test_that("liblex requires Yr to be numeric", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = as.character(d$train_y),
      neighbors = neighbors_k(30)
    ),
    "Yr.*must be.*numeric"
  )
})


test_that("liblex requires Yr length to match Xr rows", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y[1:10],
      neighbors = neighbors_k(30)
    ),
    "'Yr' must have the same number of observations as 'Xr'"
  )
})


test_that("liblex rejects multi-column Yr", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = cbind(d$train_y, d$train_y),
      neighbors = neighbors_k(30)
    ),
    "'Yr' must be a numeric vector or single-column matrix"
  )
})


# =============================================================================
# Input validation tests - neighbors
# =============================================================================

test_that("liblex requires neighbors argument", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y
    ),
    "neighbors.*required"
  )
})

test_that("liblex with neighbors_diss works", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  result <- liblex(
    Xr = d$train_x,
    Yr = d$train_y,
    neighbors = neighbors_diss(
      threshold = seq(0.05, 0.3, length.out = 3),
      k_min = 20,
      k_max = 40
    ),
    diss_method = diss_correlation(ws = 27, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 8, method = "mpls"),
    control = liblex_control(tune = TRUE),
    verbose = FALSE
  )
  
  expect_s3_class(result, "liblex")
  expect_true("diss_threshold" %in% names(result$results))
})


test_that("liblex with neighbors_diss predictions work", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  lib <- liblex(
    Xr = d$train_x,
    Yr = d$train_y,
    neighbors = neighbors_diss(
      threshold = c(0.1, 0.2, 0.3),
      k_min = 20,
      k_max = 40
    ),
    diss_method = diss_correlation(ws = 27, scale = TRUE),
    fit_method = fit_pls(ncomp = 6),
    control = liblex_control(tune = FALSE),
    verbose = FALSE
  )
  
  preds <- predict(lib, d$test_x, verbose = FALSE)
  
  expect_true(is.data.frame(preds$predictions))
  expect_equal(nrow(preds$predictions), nrow(d$test_x))
})

test_that("liblex requires neighbors_k object", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = 30
    ),
    "neighbors.*must be.*neighbors_k"
  )
})


test_that("liblex requires neighbors values >= 4", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(3)
    ),
    "All values in 'k' must be at least 4"
  )
})


# =============================================================================
# Input validation tests - diss_method
# =============================================================================

test_that("liblex validates diss_method type", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      diss_method = "euclidean"
    ),
    "diss_method.*must be.*diss_\\*"
  )
})


test_that("liblex validates precomputed diss_method matrix is numeric", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  n <- nrow(d$train_x)
  diss_mat <- matrix("a", n, n)
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      diss_method = diss_mat
    ),
    "diss_method.*matrix must be numeric"
  )
})


test_that("liblex validates precomputed diss_method matrix is square", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  n <- nrow(d$train_x)
  diss_mat <- matrix(0, n, n - 5)
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      diss_method = diss_mat
    ),
    "diss_method.*matrix must be square"
  )
})


test_that("liblex validates precomputed diss_method matrix dimensions", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  n <- nrow(d$train_x)
  diss_mat <- matrix(0, n - 10, n - 10)
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      diss_method = diss_mat
    ),
    "diss_method.*dimensions must match"
  )
})


# =============================================================================
# Input validation tests - fit_method
# =============================================================================

test_that("liblex validates fit_method type", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      fit_method = "wapls"
    ),
    "fit_method.*must be.*fit_\\*"
  )
})


# =============================================================================
# Input validation tests - anchor_indices
# =============================================================================

test_that("liblex validates anchor_indices are numeric without NA", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      anchor_indices = c(1, 2, NA)
    ),
    "anchor_indices.*numeric vector without NA"
  )
})


test_that("liblex validates anchor_indices are within bounds", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      anchor_indices = c(1, 2, nrow(d$train_x) + 10)
    ),
    "anchor_indices.*must be between 1 and nrow"
  )
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      anchor_indices = c(0, 1, 2)
    ),
    "anchor_indices.*must be between 1 and nrow"
  )
})


test_that("liblex validates anchor_indices does not exceed 90% of data", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  n <- nrow(d$train_x)
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      anchor_indices = seq_len(n)  # 100% of data
    ),
    "anchor_indices.*exceeds 90%"
  )
})


# =============================================================================
# Input validation tests - gh
# =============================================================================

test_that("liblex validates gh parameter", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      gh = "yes"
    ),
    "gh.*must be TRUE or FALSE"
  )
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      gh = NA
    ),
    "gh.*must be TRUE or FALSE"
  )
})


# =============================================================================
# Input validation tests - control
# =============================================================================

test_that("liblex validates control parameter", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      control = list(mode = "build")
    ),
    "control.*must be created by liblex_control"
  )
})


# =============================================================================
# Input validation tests - verbose
# =============================================================================

test_that("liblex validates verbose parameter", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      verbose = "yes"
    ),
    "'verbose' must be a single TRUE or FALSE value"
  )
})


# =============================================================================
# Input validation tests - group
# =============================================================================

test_that("liblex validates group length", {
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  expect_error(
    liblex(
      Xr = d$train_x,
      Yr = d$train_y,
      neighbors = neighbors_k(30),
      group = factor(rep(1:5, 10)),
      verbose = FALSE
    ),
    "group.*must have length equal to nrow"
  )
})


# =============================================================================
# Basic functionality tests (skip on CRAN)
# =============================================================================

test_that("liblex runs with default parameters", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  
  # Use subset for speed
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
  expect_true("dissimilarity" %in% names(model))
  expect_true("fit_method" %in% names(model))
  expect_true("coefficients" %in% names(model))
  expect_true("optimal_params" %in% names(model))
})


test_that("liblex runs with diss_pca", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    diss_method = diss_pca(ncomp = ncomp_by_var(0.99)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


test_that("liblex runs with diss_pls", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    diss_method = diss_pls(ncomp = 10),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


test_that("liblex runs with diss_correlation", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    diss_method = diss_correlation(ws = 27, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


test_that("liblex runs with diss_euclidean", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    diss_method = diss_euclidean(center = TRUE, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


test_that("liblex runs with fit_pls", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_pls(ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


test_that("liblex runs with anchor_indices", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  anchor_idx <- sample(seq_along(idx), 30)
  
  expect_message(
    model <- liblex(
      Xr = d$train_x[idx, ],
      Yr = d$train_y[idx],
      neighbors = neighbors_k(c(20, 30)),
      anchor_indices = anchor_idx,
      fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
      verbose = FALSE
    ),
    NA
  )
  
  expect_s3_class(model, "liblex")
  expect_equal(model$anchor_indices, anchor_idx)
})


test_that("liblex runs with gh = FALSE", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    gh = FALSE,
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
  expect_null(model$gh)
})


test_that("liblex runs with gh = TRUE", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    gh = TRUE,
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
  expect_true("gh" %in% names(model))
  expect_true("gh_Xr" %in% names(model$gh))
  expect_true("projection" %in% names(model$gh))
})


test_that("liblex allows missing values in Yr", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  # Introduce some NAs
  train_y <- d$train_y[idx]
  train_y[sample(length(train_y), 5)] <- NA
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = train_y,
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


test_that("liblex with simpls method works", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10, method = "simpls"),
    verbose = FALSE
  )
  
  expect_s3_class(model, "liblex")
})


# =============================================================================
# Output structure tests
# =============================================================================

test_that("liblex output contains expected elements", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expected_elements <- c(
    "dissimilarity", "fit_method", "gh", "results", "best",
    "optimal_params", "residuals", "coefficients", "vips",
    "selectivity_ratios", "scaling", "neighborhood_stats", "anchor_indices"
  )
  
  for (elem in expected_elements) {
    expect_true(elem %in% names(model), info = paste("Missing element:", elem))
  }
  
  # Check coefficients structure
  expect_true("B0" %in% names(model$coefficients))
  expect_true("B" %in% names(model$coefficients))
  
  # Check optimal_params structure
  expect_true("k" %in% names(model$optimal_params))
})


# =============================================================================
# predict.liblex input validation tests
# =============================================================================


test_that("predict.liblex validates probs parameter", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], probs = c(-0.1, 0.5)),
    "probs.*values in \\[0, 1\\]"
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], probs = c(0.5, 1.5)),
    "probs.*values in \\[0, 1\\]"
  )
})


test_that("predict.liblex validates range_prediction_limits", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], range_prediction_limits = "yes"),
    "range_prediction_limits.*must be TRUE or FALSE"
  )
})


test_that("predict.liblex validates residual_cutoff", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], residual_cutoff = -1),
    "residual_cutoff.*positive"
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], residual_cutoff = 0),
    "residual_cutoff.*positive"
  )
})


test_that("predict.liblex validates enforce_indices", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], enforce_indices = c(0, 1)),
    "enforce_indices.*positive integers"
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], enforce_indices = c(1, 1000)),
    "enforce_indices.*exceeding number of models"
  )
})


test_that("predict.liblex validates verbose", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], verbose = "yes"),
    "verbose.*must be TRUE or FALSE"
  )
})


test_that("predict.liblex validates newdata has required variables", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  # Remove some columns from test data
  test_subset <- d$test_x[1:5, 1:10]
  
  expect_error(
    predict(model, newdata = test_subset, verbose = FALSE),
    "Missing predictor variables"
  )
})


test_that("predict.liblex validates adaptive_bandwidth", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], adaptive_bandwidth = "yes"),
    "adaptive_bandwidth.*must be TRUE or FALSE"
  )
})


test_that("predict.liblex validates reliability_weighting", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  expect_error(
    predict(model, newdata = d$test_x[1:5, ], reliability_weighting = "yes"),
    "reliability_weighting.*must be TRUE or FALSE"
  )
})


# =============================================================================
# predict.liblex functionality tests
# =============================================================================

test_that("predict.liblex works", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  preds <- predict(model, newdata = d$test_x[1:10, ], verbose = FALSE)
  
  expect_type(preds, "list")
  expect_true("predictions" %in% names(preds))
  expect_true("neighbors" %in% names(preds))
  expect_true("expert_predictions" %in% names(preds))
  
  # Check predictions structure
  expect_true("pred" %in% names(preds$predictions))
  expect_true("pred_sd" %in% names(preds$predictions))
  expect_equal(nrow(preds$predictions), 10)
})


test_that("predict.liblex works with different weighting functions", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  weighting_methods <- c(
    "gaussian", "tricube", "triweight", "triangular",
    "quartic", "parabolic", "cauchy", "none"
  )
  
  for (w in weighting_methods) {
    preds <- predict(
      model, 
      newdata = d$test_x[1:5, ], 
      weighting = w,
      verbose = FALSE
    )
    expect_equal(nrow(preds$predictions), 5, info = paste("Weighting:", w))
  }
})


test_that("predict.liblex includes GH distance when available", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    gh = TRUE,
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  preds <- predict(model, newdata = d$test_x[1:10, ], verbose = FALSE)
  
  expect_true("gh" %in% names(preds$predictions))
  expect_equal(length(preds$predictions$gh), 10)
})


test_that("predict.liblex with range_prediction_limits clips predictions", {
  skip_on_cran()
  skip_if_not_installed("prospectr")
  
  d <- .setup_liblex_data()
  idx <- which(!is.na(d$train_y))[1:80]
  
  model <- liblex(
    Xr = d$train_x[idx, ],
    Yr = d$train_y[idx],
    neighbors = neighbors_k(c(20, 30)),
    fit_method = fit_wapls(min_ncomp = 3, max_ncomp = 10),
    verbose = FALSE
  )
  
  preds <- predict(
    model, 
    newdata = d$test_x[1:10, ], 
    range_prediction_limits = TRUE,
    verbose = FALSE
  )
  
  # Check that below_min and above_max flags exist
  expect_true("below_min" %in% names(preds$predictions))
  expect_true("above_max" %in% names(preds$predictions))
  expect_true("min_yr" %in% names(preds$predictions))
  expect_true("max_yr" %in% names(preds$predictions))
})



































test_that("liblex with mpls, diss_scale=TRUE, fit_scale=FALSE", {
  skip_on_cran()
  local_liblex_setup()
  
  model <- liblex(
    Xr = train_x, Yr = train_y,
    neighbors = neighbors_k(c(30, 40)),
    diss_method = diss_correlation(ws = 31, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 4, max_ncomp = 17, scale = FALSE, method = "mpls"),
    verbose = FALSE,
    control = liblex_control(tune = TRUE)
  )
  
  check_liblex_predictions(model, test_x, test_y)
})

test_that("liblex with simpls, diss_scale=TRUE, fit_scale=FALSE", {
  skip_on_cran()
  local_liblex_setup()
  
  model <- liblex(
    Xr = train_x, Yr = train_y,
    neighbors = neighbors_k(c(30, 40)),
    diss_method = diss_correlation(ws = 31, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 4, max_ncomp = 17, scale = FALSE, method = "simpls"),
    verbose = FALSE,
    control = liblex_control(tune = FALSE)
  )
  
  check_liblex_predictions(model, test_x, test_y)
})

test_that("liblex with pls, diss_scale=TRUE, fit_scale=FALSE", {
  skip_on_cran()
  local_liblex_setup()
  
  model <- liblex(
    Xr = train_x, Yr = train_y,
    neighbors = neighbors_k(c(30, 40)),
    diss_method = diss_correlation(ws = 31, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 4, max_ncomp = 17, scale = FALSE, method = "pls"),
    verbose = FALSE,
    control = liblex_control(tune = TRUE)
  )
  
  check_liblex_predictions(model, test_x, test_y, r2_min = 0.82, rmse_max = 0.65)
})

test_that("liblex with pls, diss_scale=TRUE, fit_scale=TRUE", {
  skip_on_cran()
  local_liblex_setup()
  
  model <- liblex(
    Xr = train_x, Yr = train_y,
    neighbors = neighbors_k(c(30, 40)),
    diss_method = diss_correlation(ws = 31, scale = TRUE),
    fit_method = fit_wapls(min_ncomp = 4, max_ncomp = 17, scale = TRUE, method = "pls"),
    verbose = FALSE,
    control = liblex_control(tune = TRUE)
  )

  check_liblex_predictions(model, test_x, test_y, r2_min = 0.82, rmse_max = 0.75)
})

test_that("liblex with pls, diss_scale=FALSE, fit_scale=FALSE", {
  skip_on_cran()
  local_liblex_setup()
  
  model <- liblex(
    Xr = train_x, Yr = train_y,
    neighbors = neighbors_k(c(30, 40)),
    diss_method = diss_correlation(ws = 31, scale = FALSE),
    fit_method = fit_wapls(min_ncomp = 4, max_ncomp = 17, scale = FALSE, method = "pls"),
    verbose = FALSE,
    control = liblex_control(tune = TRUE)
  )
  check_liblex_predictions(model, test_x, test_y, r2_min = 0.69, rmse_max = 1.3)
})

test_that("liblex with pls, diss_scale=FALSE, fit_scale=TRUE", {
  local_liblex_setup()
  
  model <- liblex(
    Xr = train_x, Yr = train_y,
    neighbors = neighbors_k(c(30, 40)),
    diss_method = diss_correlation(ws = 31, scale = FALSE),
    fit_method = fit_wapls(min_ncomp = 4, max_ncomp = 17, scale = TRUE, method = "pls"),
    verbose = FALSE,
    control = liblex_control(tune = TRUE)
  )
  check_liblex_predictions(model, test_x, test_y)
})