test_logistic2.R
In drda: Dose-Response Data Analysis

test_that("Constructor (decreasing)", {
  x <- ltd$D$x
  y <- ltd$D$y

  m <- length(unique(x))
  n <- length(y)

  w <- rep(1, n)

  max_iter <- 10000

  stats <- ltd$stats_1

  start <- c(1, 1)

  lower_bound <- c(0.5, 1)
  upper_bound <- c(2, 5)

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_false(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(1, -1, NA_real_, NA_real_))
  expect_null(object$lower_bound)
  expect_null(object$upper_bound)

  object <- logistic2_new(x, y, w, start, max_iter, lower_bound, upper_bound)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_true(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(1, -1, log(start[1]), start[2]))
  expect_equal(object$lower_bound, c(log(lower_bound[1]), lower_bound[2]))
  expect_equal(object$upper_bound, c(log(upper_bound[1]), upper_bound[2]))

  w <- ltd$D$w
  stats <- ltd$stats_2

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_false(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(1, -1, NA_real_, NA_real_))
  expect_null(object$lower_bound)
  expect_null(object$upper_bound)

  object <- logistic2_new(x, y, w, start, max_iter, lower_bound, upper_bound)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_true(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(1, -1, log(start[1]), start[2]))
  expect_equal(object$lower_bound, c(log(lower_bound[1]), lower_bound[2]))
  expect_equal(object$upper_bound, c(log(upper_bound[1]), upper_bound[2]))
})

test_that("Constructor (increasing)", {
  x <- ltd$D$x
  y <- rev(ltd$D$y)

  m <- length(unique(x))
  n <- length(y)

  w <- rep(1, n)

  max_iter <- 10000

  stats <- ltd$stats_1_i

  start <- c(1, 1)

  lower_bound <- c(0.5, 1)
  upper_bound <- c(2, 5)

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_false(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(0, 1, NA_real_, NA_real_))
  expect_null(object$lower_bound)
  expect_null(object$upper_bound)

  object <- logistic2_new(x, y, w, start, max_iter, lower_bound, upper_bound)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_true(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(0, 1, log(start[1]), start[2]))
  expect_equal(object$lower_bound, c(log(lower_bound[1]), lower_bound[2]))
  expect_equal(object$upper_bound, c(log(upper_bound[1]), upper_bound[2]))

  w <- ltd$D$w
  stats <- ltd$stats_2_i

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_false(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(0, 1, NA_real_, NA_real_))
  expect_null(object$lower_bound)
  expect_null(object$upper_bound)

  object <- logistic2_new(x, y, w, start, max_iter, lower_bound, upper_bound)

  expect_true(inherits(object, "logistic2"))
  expect_equal(object$x, x)
  expect_equal(object$y, y)
  expect_equal(object$w, w)
  expect_equal(object$n, n)
  expect_equal(object$m, m)
  expect_equal(object$stats, stats)
  expect_true(object$constrained)
  expect_equal(object$max_iter, max_iter)
  expect_equal(object$start, c(0, 1, log(start[1]), start[2]))
  expect_equal(object$lower_bound, c(log(lower_bound[1]), lower_bound[2]))
  expect_equal(object$upper_bound, c(log(upper_bound[1]), upper_bound[2]))
})

test_that("Constructor: errors", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w
  max_iter <- 10000

  expect_error(
    logistic2_new(x, y, w, 1, max_iter, NULL, NULL),
    "'start' must be of length 2"
  )

  expect_error(
    logistic2_new(x, y, w, c(1, 1, 1), max_iter, NULL, NULL),
    "'start' must be of length 2"
  )

  expect_error(
    logistic2_new(x, y, w, c(0, 1), max_iter, NULL, NULL),
    "parameter 'eta' cannot be negative nor zero"
  )

  expect_error(
    logistic2_new(x, y, w, c(-1, 1), max_iter, NULL, NULL),
    "parameter 'eta' cannot be negative nor zero"
  )

  expect_error(
    logistic2_new(x, y, w, NULL, max_iter, -Inf, Inf),
    "'lower_bound' must be of length 2"
  )

  expect_error(
    logistic2_new(x, y, w, NULL, max_iter, -Inf, rep(Inf, 2)),
    "'lower_bound' must be of length 2"
  )

  expect_error(
    logistic2_new(x, y, w, NULL, max_iter, rep(-Inf, 2), Inf),
    "'upper_bound' must be of length 2"
  )

  expect_error(
    logistic2_new(x, y, w, NULL, max_iter, rep(-Inf, 2), c(0, Inf)),
    "'upper_bound[1]' cannot be negative nor zero",
    fixed = TRUE
  )

  expect_error(
    logistic2_new(x, y, w, NULL, max_iter, rep(-Inf, 2), c(-1, Inf)),
    "'upper_bound[1]' cannot be negative nor zero",
    fixed = TRUE
  )
})

test_that("Function value (decreasing)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d
  theta[2] <- -0.5

  m <- length(x)

  true_value <- c(
    0.99993227585038023, 0.93086157965665318, 0.54983399731247791,
    0.45016600268752209, 0.35434369377420455, 0.26894142136999512,
    0.0044962731609411802, 0.000030431556900565341
  )

  value <- logistic2_fn(x, theta)

  expect_type(value, "double")
  expect_length(value, m)
  expect_equal(value, true_value)

  object <- structure(list(stats = ltd$stats_1), class = "logistic2")

  value <- fn(object, object$stats[, 1], theta)

  expect_type(value, "double")
  expect_length(value, m)
  expect_equal(value, true_value)

  object <- structure(list(stats = ltd$stats_1), class = "logistic2_fit")

  value <- fn(object, object$stats[, 1], c(1, -1, theta[3:4]))

  expect_type(value, "double")
  expect_length(value, m)
  expect_equal(value, true_value)
})

test_that("Function value (increasing)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_i
  theta[2] <- 0.5

  m <- length(x)

  true_value <- c(
    0.000067724149619770208, 0.069138420343346818, 0.45016600268752209,
    0.54983399731247791, 0.64565630622579545, 0.73105857863000488,
    0.99550372683905882, 0.99996956844309943
  )

  value <- logistic2_fn(x, theta)

  expect_type(value, "double")
  expect_length(value, m)
  expect_equal(value, true_value)

  object <- structure(list(stats = ltd$stats_1), class = "logistic2")

  value <- fn(object, object$stats[, 1], theta)

  expect_type(value, "double")
  expect_length(value, m)
  expect_equal(value, true_value)

  object <- structure(list(stats = ltd$stats_1), class = "logistic2_fit")

  value <- fn(object, object$stats[, 1], c(0, 1, theta[3:4]))

  expect_type(value, "double")
  expect_length(value, m)
  expect_equal(value, true_value)
})

test_that("Gradient (1)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d[3:4]

  m <- length(x)

  true_gradient <- matrix(
    c(
      # eta
      0.0065010780536955348, 1.6733157785701111, 0.49503314542371989,
      -0.49503314542371989, -1.3727054427399438, -1.9661193324148185,
      -0.24170706118458253, -0.0031647856053746346,
      # phi
      6.7719563059328487e-06, 0.0064358299175773505, 0.024751657271185994,
      0.024751657271185994, 0.022878424045665730, 0.019661193324148185,
      0.00044760566886033802, 3.0430630820909948e-06
    ),
    nrow = m,
    ncol = 2
  )

  G <- logistic2_gradient(x, theta, -1)

  expect_type(G, "double")
  expect_length(G, m * 2)
  expect_equal(G, true_gradient)
})

test_that("Hessian (1)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d[3:4]

  m <- length(x)

  true_hessian <- array(
    c(
      # (eta, eta)
      -0.62401895939807407, -37.490308940194270, -0.098677921754532571,
      0.098677921754532571, 2.3993184519065446, 9.0857747672948409,
      12.934808958989922, 0.32911767061349057,
      # (eta, phi)
      -0.00058230018631366534, -0.079835196748050610, 0.24258267662413332,
      0.24258267662413332, 0.18879559959154822, 0.10575418556853344,
      -0.019477293235452032, -0.00028602866784590791,
      # (phi, eta)
      -0.00058230018631366534, -0.079835196748050610, 0.24258267662413332,
      0.24258267662413332, 0.18879559959154822, 0.10575418556853344,
      -0.019477293235452032, -0.00028602866784590791,
      # (phi, phi)
      -6.7710390559686857e-07, -0.00055459036893778505, -0.00024669480438633143,
      0.00024669480438633143, 0.00066647734775181793, 0.00090857747672948409,
      0.000044358055414917430, 3.0428778717963255e-07
    ),
    dim = c(m, 2, 2)
  )

  H <- logistic2_hessian(x, theta, -1)

  expect_type(H, "double")
  expect_length(H, m * 2 * 2)
  expect_equal(H, true_hessian)
})

test_that("Gradient and Hessian (1)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d[3:4]

  m <- length(x)

  true_gradient <- matrix(
    c(
      # eta
      0.0065010780536955348, 1.6733157785701111, 0.49503314542371989,
      -0.49503314542371989, -1.3727054427399438, -1.9661193324148185,
      -0.24170706118458253, -0.0031647856053746346,
      # phi
      6.7719563059328487e-06, 0.0064358299175773505, 0.024751657271185994,
      0.024751657271185994, 0.022878424045665730, 0.019661193324148185,
      0.00044760566886033802, 3.0430630820909948e-06
    ),
    nrow = m,
    ncol = 2
  )

  true_hessian <- array(
    c(
      # (eta, eta)
      -0.62401895939807407, -37.490308940194270, -0.098677921754532571,
      0.098677921754532571, 2.3993184519065446, 9.0857747672948409,
      12.934808958989922, 0.32911767061349057,
      # (eta, phi)
      -0.00058230018631366534, -0.079835196748050610, 0.24258267662413332,
      0.24258267662413332, 0.18879559959154822, 0.10575418556853344,
      -0.019477293235452032, -0.00028602866784590791,
      # (phi, eta)
      -0.00058230018631366534, -0.079835196748050610, 0.24258267662413332,
      0.24258267662413332, 0.18879559959154822, 0.10575418556853344,
      -0.019477293235452032, -0.00028602866784590791,
      # (phi, phi)
      -6.7710390559686857e-07, -0.00055459036893778505, -0.00024669480438633143,
      0.00024669480438633143, 0.00066647734775181793, 0.00090857747672948409,
      0.000044358055414917430, 3.0428778717963255e-07
    ),
    dim = c(m, 2, 2)
  )

  gh <- logistic2_gradient_hessian(x, theta, -1)

  expect_type(gh, "list")
  expect_type(gh$G, "double")
  expect_type(gh$H, "double")

  expect_length(gh$G, m * 2)
  expect_length(gh$H, m * 2 * 2)

  expect_equal(gh$G, true_gradient)
  expect_equal(gh$H, true_hessian)
})

test_that("Gradient (2)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d[3:4]

  m <- length(x)

  true_gradient <- matrix(
    c(
      # log_eta
      0.00065010780536955348, 0.16733157785701111, 0.049503314542371989,
      -0.049503314542371989, -0.13727054427399438, -0.19661193324148185,
      -0.024170706118458253, -0.00031647856053746346,
      # phi
      6.7719563059328487e-06, 0.0064358299175773505, 0.024751657271185994,
      0.024751657271185994, 0.022878424045665730, 0.019661193324148185,
      0.00044760566886033802, 3.0430630820909948e-06
    ),
    nrow = m,
    ncol = 2
  )

  G <- logistic2_gradient_2(x, theta, -1)

  expect_type(G, "double")
  expect_length(G, m * 2)
  expect_equal(G, true_gradient)
})

test_that("Hessian (2)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d[3:4]

  m <- length(x)

  true_hessian <- array(
    c(
      # (log_eta, log_eta)
      -0.0055900817886111872, -0.20757151154493158, 0.048516535324826663,
      -0.048516535324826663, -0.11327735975492893, -0.10575418556853344,
      0.10517738347144097, 0.0029746981455974422,
      # (log_eta, phi)
      -0.000058230018631366534, -0.0079835196748050610, 0.024258267662413332,
      0.024258267662413332, 0.018879559959154822, 0.010575418556853344,
      -0.0019477293235452032, -0.000028602866784590791,
      # (phi, log_eta)
      -0.000058230018631366534, -0.0079835196748050610, 0.024258267662413332,
      0.024258267662413332, 0.018879559959154822, 0.010575418556853344,
      -0.0019477293235452032, -0.000028602866784590791,
      # (phi, phi)
      -6.7710390559686857e-07, -0.00055459036893778505, -0.00024669480438633143,
      0.00024669480438633143, 0.00066647734775181793, 0.00090857747672948409,
      0.000044358055414917430, 3.0428778717963255e-07
    ),
    dim = c(m, 2, 2)
  )

  H <- logistic2_hessian_2(x, theta, -1)

  expect_type(H, "double")
  expect_length(H, m * 2 * 2)
  expect_equal(H, true_hessian)
})

test_that("Gradient and Hessian (2)", {
  x <- ltd$stats_1[, 1]
  theta <- ltd$theta_2_d[3:4]

  m <- length(x)

  true_gradient <- matrix(
    c(
      # log_eta
      0.00065010780536955348, 0.16733157785701111, 0.049503314542371989,
      -0.049503314542371989, -0.13727054427399438, -0.19661193324148185,
      -0.024170706118458253, -0.00031647856053746346,
      # phi
      6.7719563059328487e-06, 0.0064358299175773505, 0.024751657271185994,
      0.024751657271185994, 0.022878424045665730, 0.019661193324148185,
      0.00044760566886033802, 3.0430630820909948e-06
    ),
    nrow = m,
    ncol = 2
  )

  true_hessian <- array(
    c(
      # (log_eta, log_eta)
      -0.0055900817886111872, -0.20757151154493158, 0.048516535324826663,
      -0.048516535324826663, -0.11327735975492893, -0.10575418556853344,
      0.10517738347144097, 0.0029746981455974422,
      # (log_eta, phi)
      -0.000058230018631366534, -0.0079835196748050610, 0.024258267662413332,
      0.024258267662413332, 0.018879559959154822, 0.010575418556853344,
      -0.0019477293235452032, -0.000028602866784590791,
      # (phi, log_eta)
      -0.000058230018631366534, -0.0079835196748050610, 0.024258267662413332,
      0.024258267662413332, 0.018879559959154822, 0.010575418556853344,
      -0.0019477293235452032, -0.000028602866784590791,
      # (phi, phi)
      -6.7710390559686857e-07, -0.00055459036893778505, -0.00024669480438633143,
      0.00024669480438633143, 0.00066647734775181793, 0.00090857747672948409,
      0.000044358055414917430, 3.0428778717963255e-07
    ),
    dim = c(m, 2, 2)
  )

  gh <- logistic2_gradient_hessian_2(x, theta, -1)

  expect_type(gh, "list")
  expect_type(gh$G, "double")
  expect_type(gh$H, "double")

  expect_length(gh$G, m * 2)
  expect_length(gh$H, m * 2 * 2)

  expect_equal(gh$G, true_gradient)
  expect_equal(gh$H, true_hessian)

  object <- structure(
    list(stats = ltd$stats_1, start = c(1, -1, NA_real_, NA_real_)),
    class = "logistic2"
  )

  gh <- gradient_hessian(object, theta)

  expect_type(gh, "list")
  expect_type(gh$G, "double")
  expect_type(gh$H, "double")

  expect_length(gh$G, m * 2)
  expect_length(gh$H, m * 2 * 2)

  expect_equal(gh$G, true_gradient)
  expect_equal(gh$H, true_hessian)
})

test_that("Value of the RSS", {
  theta <- c(log(ltd$theta_2_d[3]), ltd$theta_2_d[4])

  true_value <- 0.16502893044345798

  object <- structure(
    list(
      stats = ltd$stats_1,
      m = nrow(ltd$stats_1),
      start = c(1, -1, NA_real_, NA_real_)
    ),
    class = "logistic2"
  )

  rss_fn <- rss(object)

  expect_type(rss_fn, "closure")

  value <- rss_fn(theta)

  expect_type(value, "double")
  expect_length(value, 1)
  expect_equal(value, true_value)

  known_param <- c(NA, theta[2])
  rss_fn <- rss_fixed(object, known_param)

  expect_type(rss_fn, "closure")

  value <- rss_fn(theta[1])

  expect_type(value, "double")
  expect_length(value, 1)
  expect_equal(value, true_value)
})

test_that("Gradient and Hessian of the RSS", {
  theta <- c(log(ltd$theta_2_d[3]), ltd$theta_2_d[4])

  true_gradient <- c(0.025653880019264530, -0.0036804593089360313)

  true_hessian <- matrix(
    c(
      # log_eta
      0.097618662721905987, -0.021398439978182300,
      # phi
      -0.021398439978182300, 0.0057166893653613790
    ),
    nrow = 2,
    ncol = 2
  )

  object <- structure(
    list(
      stats = ltd$stats_1,
      m = nrow(ltd$stats_1),
      start = c(1, -1, NA_real_, NA_real_)
    ),
    class = "logistic2"
  )

  rss_gh <- rss_gradient_hessian(object)

  expect_type(rss_gh, "closure")

  gh <- rss_gh(theta)

  expect_type(gh$G, "double")
  expect_type(gh$H, "double")

  expect_length(gh$G, 2)
  expect_length(gh$H, 2 * 2)

  expect_equal(gh$G, true_gradient)
  expect_equal(gh$H, true_hessian)

  known_param <- c(NA, theta[2])
  rss_gh <- rss_gradient_hessian_fixed(object, known_param)

  expect_type(rss_gh, "closure")

  gh <- rss_gh(theta[1])

  expect_type(gh$G, "double")
  expect_type(gh$H, "double")

  expect_length(gh$G, 1)
  expect_length(gh$H, 1)

  expect_equal(gh$G, true_gradient[1])
  expect_equal(gh$H, true_hessian[1, 1, drop = FALSE])
})

test_that("mle_asy", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- rep(1, length(y))

  max_iter <- 10000

  theta <- c(-2.5338955025359479, -3.9372918905117386)

  true_value <- c(-2.5338955025359479, -3.9372918905117386)

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  result <- mle_asy(object, theta)

  expect_type(result, "double")
  expect_length(result, 2)
  expect_equal(result, true_value)
})

test_that("fit", {
  x <- ltd$D$x
  y <- ltd$D$y

  n <- length(y)
  w <- rep(1, n)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = TRUE, phi = TRUE)

  rss_value <- 0.20727384125777396

  theta <- c(
    alpha = 1, delta = -1, eta = exp(-2.5338955025359479),
    phi = -3.9372918905117386
  )

  fitted_values <- rep(
    c(
      0.99951092709497446, 0.88775959713220388, 0.54082751285442484,
      0.46164480559169129, 0.38435118260736283, 0.31248712794063619,
      0.013655180945348409, 0.00026188252852923363
    ),
    k
  )

  residuals <- c(
    -0.14681092709497446, -0.24241092709497446, -0.062510927094974457,
    -0.060259597132203877, -0.10995959713220388, -0.0031595971322038767,
    0.015272487145575160, 0.16397248714557516, 0.083655194408308708,
    0.024355194408308708, 0.073455194408308708, -0.021744805591691292,
    -0.029051182607362831, -0.071151182607362831, -0.034451182607362831,
    -0.17038712794063619, 0.0031448190546515905, 0.12494481905465159,
    0.12243811747147077
  )

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  result <- fit(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  object <- logistic2_new(x, y, w, c(1, 1), max_iter, NULL, NULL)

  result <- fit(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit_constrained: inequalities", {
  x <- ltd$D$x
  y <- ltd$D$y

  n <- length(y)
  w <- rep(1, n)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = TRUE, phi = TRUE)

  rss_value <- 0.20727384125777396

  theta <- c(
    alpha = 1, delta = -1, eta = exp(-2.5338955025359479),
    phi = -3.9372918905117386
  )

  fitted_values <- rep(
    c(
      0.99951092709497446, 0.88775959713220388, 0.54082751285442484,
      0.46164480559169129, 0.38435118260736283, 0.31248712794063619,
      0.013655180945348409, 0.00026188252852923363
    ),
    k
  )

  residuals <- c(
    -0.14681092709497446, -0.24241092709497446, -0.062510927094974457,
    -0.060259597132203877, -0.10995959713220388, -0.0031595971322038767,
    0.015272487145575160, 0.16397248714557516, 0.083655194408308708,
    0.024355194408308708, 0.073455194408308708, -0.021744805591691292,
    -0.029051182607362831, -0.071151182607362831, -0.034451182607362831,
    -0.17038712794063619, 0.0031448190546515905, 0.12494481905465159,
    0.12243811747147077
  )

  object <- logistic2_new(
    x, y, w, NULL, max_iter,
    c(0.01, -5), c(2, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values within the boundaries
  object <- logistic2_new(
    x, y, w, c(1, 0), max_iter,
    c(0.01, -5), c(2, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values outside the boundaries
  object <- logistic2_new(
    x, y, w, c(7, -8), max_iter,
    c(0.01, -5), c(2, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit_constrained: equalities", {
  x <- ltd$D$x
  y <- ltd$D$y

  n <- length(y)
  w <- rep(1, n)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = FALSE, phi = TRUE)

  rss_value <- 0.51514867830805084

  theta <- c(
    alpha = 1, delta = -1, eta = 0.5, phi = -1.8048595456927261
  )

  fitted_values <- rep(
    c(
      1, 0.99999924577188988, 0.89066679334583969, 0.52437322386786472,
      0.12983371911440877, 0.019793109833897495, 5.6327137560357419e-12,
      7.8226812451675656e-23
    ),
    k
  )

  residuals <- c(
    -0.1473, -0.2429, -0.063, -0.17249924577188988, -0.22219924577188988,
    -0.11539924577188988, -0.33456679334583969, -0.18586679334583969,
    0.020926776132135283, -0.038373223867864717, 0.010726776132135283,
    -0.084473223867864717, 0.22546628088559123, 0.18336628088559123,
    0.22006628088559123, 0.12230689016610250, 0.016799999994367286,
    0.13859999999436729, 0.1227
  )

  object <- logistic2_new(
    x, y, w, NULL, max_iter,
    c(0.5, -Inf), c(0.5, Inf)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values with same equalities
  object <- logistic2_new(
    x, y, w, c(0.5, 0), max_iter,
    c(0.5, -Inf), c(0.5, Inf)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values with different equalities
  object <- logistic2_new(
    x, y, w, c(1, 0), max_iter,
    c(0.5, -Inf), c(0.5, Inf)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit_constrained: equalities and inequalities", {
  x <- ltd$D$x
  y <- ltd$D$y

  n <- length(y)
  w <- rep(1, n)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = FALSE, phi = TRUE)

  rss_value <- 0.51514867830805084

  theta <- c(
    alpha = 1, delta = -1, eta = 0.5, phi = -1.8048595456927261
  )

  fitted_values <- rep(
    c(
      1, 0.99999924577188988, 0.89066679334583969, 0.52437322386786472,
      0.12983371911440877, 0.019793109833897495, 5.6327137560357419e-12,
      7.8226812451675656e-23
    ),
    k
  )

  residuals <- c(
    -0.1473, -0.2429, -0.063, -0.17249924577188988, -0.22219924577188988,
    -0.11539924577188988, -0.33456679334583969, -0.18586679334583969,
    0.020926776132135283, -0.038373223867864717, 0.010726776132135283,
    -0.084473223867864717, 0.22546628088559123, 0.18336628088559123,
    0.22006628088559123, 0.12230689016610250, 0.016799999994367286,
    0.13859999999436729, 0.1227
  )

  object <- logistic2_new(
    x, y, w, NULL, max_iter,
    c(0.5, -5), c(0.5, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values within the boundaries
  object <- logistic2_new(
    x, y, w, c(0.5, 0), max_iter,
    c(0.5, -5), c(0.5, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values outside the boundaries
  object <- logistic2_new(
    x, y, w, c(8, -8), max_iter,
    c(0.5, -5), c(0.5, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit (weighted)", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  n <- length(y)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = TRUE, phi = TRUE)

  rss_value <- 0.14802210304519822

  theta <- c(
    alpha = 1, delta = -1, eta = exp(-1.7118497175241647),
    phi = -2.0657104870916123
  )

  fitted_values <- rep(
    c(
      0.99999997903117914, 0.99358716675353491, 0.67045935646748149,
      0.49703433073752424, 0.32431997533986986, 0.18906221049072057,
      0.000082758300470677611, 9.9461424961556887e-09
    ),
    k
  )

  residuals <- c(
    -0.14729997903117914, -0.24289997903117914, -0.062999979031179143,
    -0.16608716675353491, -0.21578716675353491, -0.10898716675353491,
    -0.11435935646748149, 0.034340643532518513, 0.048265669262475756,
    -0.011034330737524244, 0.038065669262475756, -0.057134330737524244,
    0.030980024660130145, -0.011119975339869855, 0.025580024660130145,
    -0.046962210490720567, 0.016717241699529322, 0.13851724169952932,
    0.12269999005385750
  )

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  result <- fit(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  object <- logistic2_new(x, y, w, c(1, 1), max_iter, NULL, NULL)

  result <- fit(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit_constrained (weighted): inequalities", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  n <- length(y)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = TRUE, phi = TRUE)

  rss_value <- 0.14802210304519822

  theta <- c(
    alpha = 1, delta = -1, eta = exp(-1.7118497175241647),
    phi = -2.0657104870916123
  )

  fitted_values <- rep(
    c(
      0.99999997903117914, 0.99358716675353491, 0.67045935646748149,
      0.49703433073752424, 0.32431997533986986, 0.18906221049072057,
      0.000082758300470677611, 9.9461424961556887e-09
    ),
    k
  )

  residuals <- c(
    -0.14729997903117914, -0.24289997903117914, -0.062999979031179143,
    -0.16608716675353491, -0.21578716675353491, -0.10898716675353491,
    -0.11435935646748149, 0.034340643532518513, 0.048265669262475756,
    -0.011034330737524244, 0.038065669262475756, -0.057134330737524244,
    0.030980024660130145, -0.011119975339869855, 0.025580024660130145,
    -0.046962210490720567, 0.016717241699529322, 0.13851724169952932,
    0.12269999005385750
  )

  object <- logistic2_new(
    x, y, w, NULL, max_iter,
    c(0.01, -5), c(2, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values within the boundaries
  object <- logistic2_new(
    x, y, w, c(1, 0), max_iter,
    c(0.01, -5), c(2, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values outside the boundaries
  object <- logistic2_new(
    x, y, w, c(7, -8), max_iter,
    c(0.01, -5), c(2, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 2)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit_constrained (weighted): equalities", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  n <- length(y)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = FALSE, phi = TRUE)

  rss_value <- 0.33123657223639616

  theta <- c(
    alpha = 1, delta = -1, eta = 0.5, phi = -1.6708752737442977
  )

  fitted_values <- rep(
    c(
      1, 0.99999929464390932, 0.89702175505783073, 0.54104799827715088,
      0.13759176925344944, 0.021135530999337022, 6.0229879840594822e-12,
      8.3646919022474704e-23
    ),
    k
  )

  residuals <- c(
    -0.1473, -0.2429, -0.063, -0.17249929464390932, -0.22219929464390932,
    -0.11539929464390932, -0.34092175505783073, -0.19222175505783073,
    0.0042520017228491238, -0.055047998277150876, -0.0059479982771508762,
    -0.10114799827715088, 0.21770823074655056, 0.17560823074655056,
    0.21230823074655056, 0.12096446900066298, 0.016799999993977012,
    0.13859999999397701, 0.1227
  )

  object <- logistic2_new(
    x, y, w, NULL, max_iter,
    c(0.5, -Inf), c(0.5, Inf)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values with same equalities
  object <- logistic2_new(
    x, y, w, c(0.5, 0), max_iter,
    c(0.5, -Inf), c(0.5, Inf)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values with different equalities
  object <- logistic2_new(
    x, y, w, c(1, 0), max_iter,
    c(0.5, -Inf), c(0.5, Inf)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_false(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fit_constrained (weighted): equalities and inequalities", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  n <- length(y)

  k <- as.numeric(table(x))

  max_iter <- 10000

  estimated <- c(alpha = FALSE, delta = FALSE, eta = FALSE, phi = TRUE)

  rss_value <- 0.33123657223639616

  theta <- c(
    alpha = 1, delta = -1, eta = 0.5, phi = -1.6708752737442977
  )

  fitted_values <- rep(
    c(
      1, 0.99999929464390932, 0.89702175505783073, 0.54104799827715088,
      0.13759176925344944, 0.021135530999337022, 6.0229879840594822e-12,
      8.3646919022474704e-23
    ),
    k
  )

  residuals <- c(
    -0.1473, -0.2429, -0.063, -0.17249929464390932, -0.22219929464390932,
    -0.11539929464390932, -0.34092175505783073, -0.19222175505783073,
    0.0042520017228491238, -0.055047998277150876, -0.0059479982771508762,
    -0.10114799827715088, 0.21770823074655056, 0.17560823074655056,
    0.21230823074655056, 0.12096446900066298, 0.016799999993977012,
    0.13859999999397701, 0.1227
  )

  object <- logistic2_new(
    x, y, w, NULL, max_iter,
    c(0.5, -5), c(0.5, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values within the boundaries
  object <- logistic2_new(
    x, y, w, c(0.5, 0), max_iter,
    c(0.5, -5), c(0.5, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)

  # initial values outside the boundaries
  object <- logistic2_new(
    x, y, w, c(8, -8), max_iter,
    c(0.5, -5), c(0.5, 5)
  )

  result <- fit_constrained(object)

  expect_true(inherits(result, "logistic2_fit"))
  expect_true(inherits(result, "logistic"))
  expect_true(result$converged)
  expect_true(result$constrained)
  expect_equal(result$estimated, estimated)
  expect_equal(result$coefficients, theta, tolerance = 1.0e-6)
  expect_equal(result$rss, rss_value)
  expect_equal(result$df.residual, object$n - 1)
  expect_equal(result$fitted.values, fitted_values, tolerance = 1.0e-6)
  expect_equal(result$residuals, residuals, tolerance = 1.0e-6)
  expect_equal(result$weights, w)
})

test_that("fisher_info", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  max_iter <- 10000

  theta <- ltd$theta_2_d
  names(theta) <- c("alpha", "delta", "eta", "phi")

  sigma <- ltd$sigma

  true_value <- matrix(c(
      # eta
      3671.8976437329046, -79.729113965633577, -2000.7114186570950,
      # phi
      -79.729113965633577, 1.9250613126586459, 34.261360313645943,
      # sigma
      -2000.7114186570950, 34.261360313645943, 65475.726403465305
    ),
    nrow = 3,
    ncol = 3
  )

  rownames(true_value) <- colnames(true_value) <- c("eta", "phi", "sigma")

  object <- logistic2_new(x, y, w, NULL, max_iter, NULL, NULL)

  fim <- fisher_info(object, theta, sigma)

  expect_type(fim, "double")
  expect_length(fim, 3 * 3)
  expect_equal(fim, true_value)
})

test_that("drda: 'lower_bound' argument errors", {
  x <- ltd$D$x
  y <- ltd$D$y

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = c("c", "d")
    ),
    "'lower_bound' must be a numeric vector"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = matrix(-Inf, nrow = 2, ncol = 2),
      upper_bound = rep(Inf, 2)
    ),
    "'lower_bound' must be a numeric vector"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = rep(-Inf, 3),
      upper_bound = rep(Inf, 2)
    ),
    "'lower_bound' and 'upper_bound' must have the same length"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = c( 0, -Inf),
      upper_bound = c(-1, Inf)
    ),
    "'lower_bound' cannot be larger than 'upper_bound'"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = c(Inf, -Inf),
      upper_bound = c(Inf, Inf)
    ),
    "'lower_bound' cannot be equal to infinity"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = rep(-Inf, 3),
      upper_bound = rep(Inf, 3)
    ),
    "'lower_bound' must be of length 2"
  )
})

test_that("drda: 'upper_bound' argument errors", {
  x <- ltd$D$x
  y <- ltd$D$y

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      upper_bound = c("c", "d")
    ),
    "'upper_bound' must be a numeric vector"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = rep(-Inf, 2),
      upper_bound = matrix(Inf, nrow = 2, ncol = 2)
    ),
    "'upper_bound' must be a numeric vector"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = c(-Inf, -Inf),
      upper_bound = c(-Inf, Inf)
    ),
    "'upper_bound' cannot be equal to -infinity"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      lower_bound = rep(-Inf, 3),
      upper_bound = rep(Inf, 3)
    ),
    "'lower_bound' must be of length 2"
  )
})

test_that("drda: 'start' argument errors", {
  x <- ltd$D$x
  y <- ltd$D$y

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      start = c("c", "d")
    ),
    "'start' must be a numeric vector"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      start = c(1, Inf)
    ),
    "'start' must be finite"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      start = c(-Inf, 1)
    ),
    "'start' must be finite"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      start = rep(1, 3)
    ),
    "'start' must be of length 2"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      start = c(-1, 1)
    ),
    "parameter 'eta' cannot be negative nor zero"
  )

  expect_error(
    drda(
      y ~ x, mean_function = "logistic2",
      start = c(0, 1)
    ),
    "parameter 'eta' cannot be negative nor zero"
  )
})

test_that("nauc: decreasing", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  result <- drda(y ~ x, weights = w, mean_function = "logistic2")

  expect_equal(nauc(result), 0.42629872039669964)
  expect_equal(nauc(result, xlim = c(-2, 2)), 0.40878964077573577)
  expect_equal(nauc(result, ylim = c(0.3, 0.7)), 0.39671447564542112)
  expect_equal(nauc(result, xlim = c(-15, -10), ylim = c(0.3, 0.7)), 1.0)
  expect_equal(
    nauc(result, xlim = c(1, 5), ylim = c(0.3, 0.7)), 0.032549163262074700
  )
  expect_equal(nauc(result, xlim = c(10, 15), ylim = c(0.3, 0.7)), 0.0)
})

test_that("naac: decreasing", {
  x <- ltd$D$x
  y <- ltd$D$y
  w <- ltd$D$w

  result <- drda(y ~ x, weights = w, mean_function = "logistic2")

  expect_equal(naac(result), 1 - 0.42629872039669964)
  expect_equal(naac(result, xlim = c(-2, 2)), 1 - 0.40878964077573577)
  expect_equal(naac(result, ylim = c(0.3, 0.7)), 1 - 0.39671447564542112)
  expect_equal(naac(result, xlim = c(-15, -10), ylim = c(0.3, 0.7)), 0.0)
  expect_equal(
    naac(result, xlim = c(1, 5), ylim = c(0.3, 0.7)), 1 - 0.032549163262074700
  )
  expect_equal(naac(result, xlim = c(10, 15), ylim = c(0.3, 0.7)), 1.0)
})

test_that("nauc: increasing", {
  x <- ltd$D$x
  y <- rev(ltd$D$y)
  w <- ltd$D$w

  result <- drda(y ~ x, weights = w, mean_function = "logistic2")

  expect_equal(nauc(result), 0.64408118428934661)
  expect_equal(nauc(result, xlim = c(-2, 2)), 0.64801389875761971)
  expect_equal(nauc(result, ylim = c(0.3, 0.7)), 0.83138849342085760)
  expect_equal(nauc(result, xlim = c(-40, -25), ylim = c(0.3, 0.7)), 0.0)
  expect_equal(
    nauc(result, xlim = c(-5, -1), ylim = c(0.3, 0.7)), 0.76263081184979702
  )
  expect_equal(nauc(result, xlim = c(10, 15), ylim = c(0.3, 0.7)), 1.0)
})

test_that("naac: increasing", {
  x <- ltd$D$x
  y <- rev(ltd$D$y)
  w <- ltd$D$w

  result <- drda(y ~ x, weights = w, mean_function = "logistic2")

  expect_equal(naac(result), 1 - 0.64408118428934661)
  expect_equal(naac(result, xlim = c(-2, 2)), 1 - 0.64801389875761971)
  expect_equal(naac(result, ylim = c(0.3, 0.7)), 1 - 0.83138849342085760)
  expect_equal(naac(result, xlim = c(-40, -25), ylim = c(0.3, 0.7)), 1.0)
  expect_equal(
    naac(result, xlim = c(-5, -1), ylim = c(0.3, 0.7)), 1 - 0.76263081184979702
  )
  expect_equal(naac(result, xlim = c(10, 15), ylim = c(0.3, 0.7)), 0.0)
})