distfreereg <-
  function(test_mean = NULL,
           covariance = NULL,
           Y = NULL,
           X = NULL,
           theta_init = NULL,
           data = NULL,
           method = NULL,
           method_args = NULL,
           stat = c("KS", "CvM"),
           B = 1e4,
           ordering = "simplex",
           group = TRUE,
           control = NULL,
           override = NULL,
           verbose = TRUE
  ){
    output <- list()
    
    cl <- match.call()
    output[["call"]] <- cl
    
    vargs <-
      validate_args_distfreereg(test_mean = test_mean,
                                ordering = ordering,
                                group = group,
                                stat = stat,
                                B = B,
                                control = control,
                                override = override,
                                verbose = verbose,
                                method = method,
                                method_args = method_args,
                                theta_init = theta_init,
                                Y = Y,
                                X = X,
                                data = data,
                                covariance = covariance)
    Y <- vargs[["Y"]]
    X <- vargs[["X"]]
    n <- vargs[["n"]]
    control <- vargs[["control"]]
    override <- vargs[["override"]]
    B <- vargs[["B"]]
    return_on_error <- control[["return_on_error"]]
    
    if(isModel(test_mean)){
      validate_weights(test_mean)
      test_mean <- refit_model(m = test_mean, verbose = verbose)
    }

    # Note that for consistency, the output value of test_mean is defined here
    # before possibly changing test_mean from a formula to a model.
    output[["test_mean"]] <- test_mean
    
    if(is(test_mean, "formula")){
      test_mean <- fit_model(test_mean, data, method, method_args)
      validate_weights(test_mean)
      output[["model"]] <- test_mean
    }
    
    if(isModel(test_mean)){
      data <- get_data(test_mean)
    }
    
    if(is.null(X) && isModel(test_mean)){
      X <- get_X(test_mean)
    }
    
    if(is.null(Y)){
      Y <- get_Y(test_mean)
    }
    
    output[["data"]] <- list(data = data, Y = Y, X = X)
    
    covariance <- get_cov(m = test_mean, covariance = covariance, verbose = verbose)
    
    if(is.null(covariance[["Q"]])){
      if(isTRUE(verbose)) message("Calculating the inverse square root of the covariance matrix...")
      covariance <- fill_covariance_list(need = "Q", covariance_list = covariance,
                                         matsqrt_tol = control[["matsqrt_tol"]],
                                         solve_tol = control[["solve_tol"]])
    } else{
      if(isTRUE(verbose)) message("Using supplied inverse square root of the covariance matrix...")
    }
    
    output[["covariance"]] <- covariance
    Q <- covariance[["Q"]]
    
    if(is(test_mean, "function")){
      ftheta <- f2ftheta(test_mean, X, n)
    } else {
      ftheta <- NULL
    }
    
    if(is.null(override[["theta_hat"]])){
      if(isTRUE(verbose)) message("Estimating parameters...")
      theta_hat <- get_theta_hat(test_mean = test_mean, ftheta = ftheta, Y = Y,
                                 Q = Q, control = control, override = override,
                                 verbose = verbose)
      if(is.function(test_mean)){
        output[["optimization_output"]] <- theta_hat
        theta_hat <- theta_hat[[control[["theta_hat_name"]]]]
      }
    } else {
      if(isTRUE(verbose)) message("Using supplied parameter estimates...")
      theta_hat <- override[["theta_hat"]]
    }
    if(!is.null(theta_hat) && is.null(names(theta_hat)))
      names(theta_hat) <- paste0("theta", seq_along(theta_hat))
    output[["theta_hat"]] <- theta_hat
    
    if(is.null(override[["fitted_values"]])){
      if(isTRUE(verbose)) message("Calculating fitted values...")
      fitted_values <- get_fitted_values(test_mean = test_mean,
                                         ftheta = ftheta,
                                         theta_hat = theta_hat)
    } else {
      if(isTRUE(verbose)) message("Using supplied fitted values...")
      fitted_values <- override[["fitted_values"]]
    }
    output[["fitted_values"]] <- fitted_values
    
    if(is.null(override[["J"]])){
      if(isTRUE(verbose)) message("Calculating Jacobian...")
      J <- get_jacobian(test_mean = test_mean, override = override,
                        verbose = verbose, ftheta = ftheta,
                        theta_hat = theta_hat, control = control)
      if(is(test_mean, "nls")){
        covariance <- fill_covariance_list(need = "SqrtSigma",
                                           covariance_list = covariance,
                                           matsqrt_tol = control[["matsqrt_tol"]],
                                           solve_tol = control[["solve_tol"]])
        J_tilde <- J
        J <- covprod(covariance[["SqrtSigma"]], J)
      } else {
        J_tilde <- covprod(Q, J)
      }
    } else {
      if(isTRUE(verbose)) message("Using supplied Jacobian...")
      J <- override[["J"]]
      J_tilde <- covprod(Q, J)
    }
    output[["J"]] <- J
    p <- ncol(J)
    
    
    if(isTRUE(verbose)) message("Calculating mu...")
    output[["mu"]] <- mu <- tryReturn(
      calc_mu(J = J_tilde, solve_tol = control[["solve_tol"]], orth_tol = control[["orth_tol"]]),
      output = output, return_on_error = return_on_error)
    
    if(is.null(override[["res_order"]])){
      if(is(test_mean, "formula") || isModel(test_mean)){# should probably not include "formula" part here
        X_for_ordering <- define_data_for_res_order(test_mean = test_mean,
                                                    data = data,
                                                    ordering = ordering)
      } else {
        X_for_ordering <- X
      }
      output[["res_order"]] <- res_order <- tryReturn(
        determine_order(X = X_for_ordering, ordering = ordering, n = n,
                        verbose = verbose),
        output = output,
        return_on_error = return_on_error)
    } else {
      if(isTRUE(verbose)) message("Using supplied observation ordering...")
      output[["res_order"]] <- res_order <- override[["res_order"]]
    }
    
    # Verify that res_order is an ordering.
    tryReturn(
      if(!isOrdering(x = res_order, len = n)) stop("res_order not an ordering"),
      return_on_error = return_on_error, output = output
    )
    
    
    # Define r
    if(is.null(override[["r"]])){
      if(isTRUE(verbose)) message("Calculating transformation anchors...")
      output[["r"]] <- r <- tryReturn(
        define_r(n = n, p = p, res_order = order(res_order), gs_tol = control[["qr_tol"]]),
        output = output, return_on_error = return_on_error)
    } else {
      if(isTRUE(verbose)) message("Using supplied transformation anchors...")
      output[["r"]] <- r <- as.matrix(override[["r"]])
      stopifnot(all(dim(mu) == dim(r)))
    }
    
    # Validate r
    rtr <- crossprod(r)
    tryReturn(
      if(!isTRUE(all.equal(rtr, diag(nrow(rtr)), check.attributes = FALSE,
                           tolerance = control[["orth_tol"]])))
        stop("Columns of r are not orthogonal"),
      output = output, return_on_error = return_on_error
    )
    r <- r[order(res_order), , drop = FALSE]
    
    if(isTRUE(verbose)) message("Calculating r_tilde...")
    output[["r_tilde"]] <- r_tilde <- tryReturn(
      define_r_tilde(r = r, mu = mu, k2_tol = control[["trans_tol"]]),
      output = output, return_on_error = return_on_error)
    
    if(isTRUE(verbose)) message("Calculating residuals...")
    output[["residuals"]][["raw"]] <- raw_residuals <- tryReturn(
      calc_resid(Y = Y, fitted_values = fitted_values),
      output = output, return_on_error = return_on_error)
    
    tryReturn(
      validate_numeric(raw_residuals, min_len = 1, func = warning,
                       message = "Raw residuals failed validation: "),
      output = output, return_on_error = return_on_error)
    
    output[["residuals"]][["sphered"]] <- sphered_residuals <- tryReturn(
      calc_sphered_resid(raw_residuals = raw_residuals, Q = Q),
      output = output, return_on_error = return_on_error)
    
    tryReturn(
      validate_numeric(sphered_residuals, min_len = 1, func = warning,
                       message = "Sphered residuals failed validation: "),
      output = output, return_on_error = return_on_error)
    
    output[["residuals"]][["transformed"]] <- transformed_residuals <- tryReturn(
      calc_k2_resid(x = sphered_residuals, r_tilde = r_tilde, mu = mu,
                    k2_tol = control[["trans_tol"]]),
      output = output, return_on_error = return_on_error)
    
    tryReturn(
      validate_numeric(transformed_residuals, min_len = 1, func = warning,
                       message = "Transformed residuals failed validation: "),
      output = output, return_on_error = return_on_error)
    
    
    if(isTRUE(group)){
      if(length(unique(res_order)) == n) {
        if(isTRUE(verbose)) message("All covariate observations are unique; no grouping done...")
        grouping_matrix <- NULL
      } else {
        if(isTRUE(verbose)) message("Determining grouping...")
        # control[["data"]] should NOT have response in it here if "ordering" is
        # "natural".
        X_for_gm <- if(is.null(control[["data"]])) as.data.frame(X) else control[["data"]]
        output[["grouping_matrix"]] <- grouping_matrix <- tryReturn(
          define_grouping_matrix(X = X_for_gm, res_order = res_order),
          output = output, return_on_error = return_on_error)
      }
    } else {
      grouping_matrix <- NULL
    }
    
    if(isTRUE(verbose)) message("Calculating empirical partial sum process...")
    output[["epsp"]] <- epsp <- tryReturn(
      calc_epsp(transformed_residuals = transformed_residuals,
                res_order = order(res_order), grouping_matrix = grouping_matrix),
      output = output, return_on_error = return_on_error)
    
    tryReturn(
      validate_numeric(epsp, min_len = 1, func = warning,
                       message = "Partial sum process failed validation: "),
      output = output, return_on_error = return_on_error)
    
    if(isTRUE(verbose)) message("Calculating observed statistic(s)...")
    observed_stats <- tryReturn(
      as.list(calc_stats(epsp = epsp, stat = stat)),
      output = output, return_on_error = return_on_error)
    names(observed_stats) <- stat
    output[["observed_stats"]] <- observed_stats
    
    if(is.null(override[["theoretical_stats"]])){
      if(isTRUE(verbose)) message("Running Monte Carlo simulation...")
      theoretical_stats <- mcsim(B = B, r = r, grouping_matrix = grouping_matrix,
                           stat = stat, verbose = verbose)
    } else {
      if(isTRUE(verbose)) message("Using supplied Monte Carlo simulation results...")
      theoretical_stats <- override[["theoretical_stats"]]
    }
    output[["theoretical_stats"]] <- theoretical_stats
    
    # Now redefine "p" to hold p values (not dimension of parameter space).
    p <- tryReturn(
      calc_p(observed_stats = observed_stats, theoretical_stats = theoretical_stats),
      output = output, return_on_error = return_on_error)
    output[["p"]] <- list()
    output[["p"]][["value"]] <- p
    output[["p"]][["mcse"]] <- tryReturn(
      calc_mcse_binom(p = p, B = B),
      output = output, return_on_error = return_on_error)
    
    
    class(output) <- "distfreereg"
    return(output)
  }
