library(distfreereg)

all.equal.distfreereg <- distfreereg:::all.equal.distfreereg
test_dfr_functions <- distfreereg:::test_dfr_functions

n <- 1e2
func <- function(X, theta) theta[1] + theta[2]*X[,1] + theta[3]*X[,2]
set.seed(20250516)
Sig <- rWishart(1, df = n, Sigma = diag(n))[,,1]
X <- matrix(rexp(2*n, rate = 1), nrow = n)
theta <- c(2,5,1)
Y <- distfreereg:::f2ftheta(f = func, X)(theta) +
  as.vector(distfreereg:::rmvnorm(n = n, reps = 1, mean = rep(0,n), SqrtSigma = distfreereg:::matsqrt(Sig)))

df_nls <- as.data.frame(cbind(Y, X, rep(1:10, 10)))
names(df_nls) <- c("z", "x", "y", "g")
wt <- rexp(n) + 1
form_nls <- z ~ d + e*x + f*y

set.seed(20250516)
dfr_form_nls <- distfreereg(test_mean = form_nls, data = df_nls,
                            method_args = list(weights = wt),
                            method = "nls", verbose = FALSE,
                            control = list(return_on_error = FALSE))

dfr_form_nls


set.seed(20250516)
dfr_form_nls_no_weights <- distfreereg(test_mean = form_nls, data = df_nls,
                                       method = "nls",
                                       control = list(return_on_error = FALSE))

newdata_nls <- data.frame(a = rnorm(10), b = rnorm(10))
test_dfr_functions(dfr_form_nls, newdata = newdata_nls)

m_nls <- nls(form_nls, data = df_nls, weights = wt)
m_nls_na_omit <- update(m_nls, na.action = na.omit)

set.seed(20250516)
dfr_nls <- distfreereg(test_mean = m_nls, verbose = FALSE,
                       control = list(return_on_error = FALSE))

dfr_nls

test_dfr_functions(dfr_nls, newdata = newdata_nls)

stopifnot(all.equal(dfr_nls, dfr_form_nls))

set.seed(20250516)
dfr_nls_override <- distfreereg(test_mean = m_nls_na_omit,
                                override = list(J = dfr_nls[["J"]],
                                                fitted_values = dfr_nls[["fitted_values"]]),
                                control = list(return_on_error = FALSE))


cdfr_form_nls <- asymptotics(dfr_form_nls, reps = 5)
cdfr_nls <- asymptotics(dfr_nls, reps = 5)

signif(rejection(cdfr_form_nls, alpha = c(0.1, 0.5))[,2:3], digits = 3)
signif(rejection(cdfr_nls, alpha = c(0.1, 0.5))[,2:3], digits = 3)




# Orderings

set.seed(20250516)
dfr_nls_asis <- update(dfr_nls, ordering = "asis")
set.seed(20250516)
dfr_form_nls_asis <- update(dfr_form_nls, ordering = "asis")
stopifnot(all.equal(dfr_nls_asis, dfr_form_nls_asis))

set.seed(20250516)
dfr_nls_optimal <- update(dfr_nls, ordering = "optimal")
set.seed(20250516)
dfr_form_nls_optimal <- update(dfr_form_nls, ordering = "optimal")
stopifnot(all.equal(dfr_nls_optimal, dfr_form_nls_optimal))

set.seed(20250516)
dfr_nls_natural <- update(dfr_nls, ordering = "natural")
set.seed(20250516)
dfr_form_nls_natural <- update(dfr_form_nls, ordering = "natural")
stopifnot(all.equal(dfr_nls_natural, dfr_form_nls_natural))

set.seed(20250516)
form_nls_g <- z ~ d + e*x + f*y + I(0*is.numeric(g))
m_nls_g <- nls(form_nls_g, data = df_nls, weights = wt)
dfr_nls_g <- update(dfr_nls, ordering = list("g"), test_mean = m_nls_g)
set.seed(20250516)
dfr_form_nls_g <- update(dfr_form_nls, ordering = list("g"), test_mean = form_nls_g)
stopifnot(all.equal(dfr_nls_g, dfr_form_nls_g))

df_nls[dfr_nls_g[["res_order"]],][["g"]]

set.seed(20250516)
dfr_nls_g_grouped <- update(dfr_nls_g, group = TRUE)
set.seed(20250516)
dfr_form_nls_g_grouped <- update(dfr_form_nls_g, group = TRUE)
stopifnot(all.equal(dfr_nls_g_grouped, dfr_form_nls_g_grouped))





### Partial output

dfr_nls_partial <- distfreereg(test_mean = m_nls, verbose = FALSE,
                               control = list(orth_tol = 1e-100))
names(dfr_nls_partial)



### Failures

tryCatch(distfreereg(test_mean = form_nls, data = df_nls,
                     theta_init = 1:3,
                     method_args = list(weights = wt),
                     method = "nls", verbose = FALSE,
                     control = list(return_on_error = FALSE)),
         error = function(e) warning(e)
)

tryCatch(distfreereg(test_mean = form_nls, data = as.matrix(df_nls),
                     method_args = list(weights = wt),
                     method = "nls", verbose = FALSE,
                     control = list(return_on_error = FALSE)),
         error = function(e) warning(e)
)

tryCatch(distfreereg(test_mean = form_nls, data = data.frame(),
                     method_args = list(weights = wt),
                     method = "nls", verbose = FALSE,
                     control = list(return_on_error = FALSE)),
         error = function(e) warning(e)
)

tryCatch(distfreereg(test_mean = form_nls, data = df_nls,
                     method_args = "weights = wt",
                     method = "nls", verbose = FALSE,
                     control = list(return_on_error = FALSE)),
         error = function(e) warning(e)
)

tryCatch(distfreereg(test_mean = form_nls, data = df_nls,
                     method_args = list(weights = wt),
                     method = "nls", verbose = FALSE,
                     control = list(return_on_error = FALSE),
                     override = list(1:3)),
         error = function(e) warning(e)
)

tryCatch(distfreereg(test_mean = form_nls, data = df_nls,
                     method_args = list(weights = wt),
                     method = "nls", verbose = FALSE,
                     control = list(return_on_error = FALSE),
                     override = list(a = 1:3)),
         error = function(e) warning(e)
)

tryCatch(distfreereg(test_mean = m_nls, control = "hello"),
         error = function(e) warning(e)
)
