#check inputs for mismatch between formula and features/models
#' @keywords internal
check_inputs_formula <-
  function(parts_list,
           list_of_deep_models,
           feature_names,
           categorical_features,
           outcome_var) {
    features_ls <- lapply(parts_list, function(x) {
      if (!as.character(x[[1]]) %in% names(list_of_deep_models)) {
        stop(
          paste0(
            "Model formula contains model ",
            x[[1]],
            ", but ",
            x[[1]],
            " is not supplied in 'list_of_deep_models'."
          ),
          call. = FALSE
        )
      }
      return(as.character(x[-1]))
    })
    features <- unlist(features_ls)
    all_symbols <- c(features)
    missing_features <-
      all_symbols[which(!all_symbols %in% feature_names)]
    if (length(missing_features)) {
      stop(
        paste0(
          "Feature(s) ",
          paste(missing_features, collapse = ", "),
          " in formula, but not present in data. Make sure the features align with colnames(data)."
        ),
        call. = FALSE
      )
    }
    if (any(!categorical_features %in% feature_names)) {
      missing_features <-
        categorical_features[which(!categorical_features %in% feature_names)]
      stop(
        paste0(
          paste(missing_features, collapse = ", "),
          " provided in categorical_features, but not present in data. Make sure the features align with colnames(data)."
        ),
        call. = FALSE
      )
    }
    cat_not_in_formula <-
      categorical_features[which(!categorical_features %in% all_symbols)]
    if (length(cat_not_in_formula)) {
      warning(
        paste0(
          "Feature(s) ",
          paste(cat_not_in_formula, collapse = ", "),
          " stated as categorical, but not present in model formula."
        ),
        call. = FALSE
      )
    }
    highest_term_idx <- which.max(lapply(features_ls, length))
    highest_term_features <- features_ls[[highest_term_idx]]
    if (any(unlist(lapply(features_ls[-highest_term_idx], function(terms) {
      any(!terms %in% highest_term_features)
    })))) {
      warning(
        "Features in lower order effects do not appear in higher order effects. We recommend fitting a residual term that includes all lower order terms.",
        call. = FALSE
      )
    }
  }
#check inputs for proper object specification and if specified effects were fitted
#' @keywords internal
check_inputs_plot <- function(object,
                              effect,
                              interaction = 0,
                              reference_level = NULL) {
  if (inherits(object, "onam_prediction") |
      inherits(object, "onam")) {
    names <- colnames(object$feature_effects)
  } else {
    stop(
      "Visualization functions can only be called on objects of type 'onam'
         or 'onam_prediction'.",
      call. = FALSE
    )
  }
  if (!effect %in% names) {
    if (interaction == 1) {
      return(interaction)
    } else {
      stop(paste0(effect,
                  " is not present in the fitted model effects."),
           call. = FALSE)
    }
  }
  if (!is.null(reference_level) && (interaction == 0))
  {
    if (!effect %in% object$categorical_features)
    {
      warning(
        paste0(
          "Reference level given, but ",
          effect,
          " is not modeled as categorical."
        ),
        call. = FALSE
      )
    }
    else if (!  reference_level %in%
             unique(object$data[, effect]))
    {
      stop(paste0(reference_level,
                  " is not a level of feature ",
                  effect, "."),
           call. = FALSE)
    }
  }
}
#check inputs of model fitting call
#' @keywords internal
check_inputs_onam <- function(inputs) {
  if (!inherits(inputs$formula, "formula")) {
    stop("Parameter `formula` must be a formula object of the kind `y~x`.",
         call. = FALSE)
  }
  if (!is.list(inputs$list_of_deep_models) |
      is.null(names(inputs$list_of_deep_models)) |
      any(unlist(lapply(inputs$list_of_deep_models, function(x) {
        !inherits(x, "function")
      })))) {
    stop("Parameter `list_of_deep_models` must be a named list of DNN architectures.",
         call. = FALSE)
  }
  if ((!is.data.frame(inputs$data)) && (!is.matrix(inputs$data))) {
    stop("Parameter `data` must be either of class `matrix` or of class `data.frame`",
         call. = FALSE)
  }
  if (!inputs$target %in% c("continuous", "binary")) {
    stop("Parameter `target` must be either `continuous` or `binary`.",
         call. = FALSE)
  }
  if (!(inputs$n_ensemble %% 1 == 0) | inputs$n_ensemble < 0) {
    stop("Parameter `n_ensemble` must be a positive integer.",
         call. = FALSE)
  }
  if (!(inputs$epochs %% 1 == 0) | inputs$epochs < 0) {
    stop("Parameter `epochs` must be a positive integer.",
         call. = FALSE)
  }
  if (is.na(as.logical(inputs$progresstext)))
    stop("Parameter `progresstext` must be `TRUE` or `FALSE`.",
         call. = FALSE)
}
check_y_features <- function(data, y, model_info, target) {
  if (model_info$all_feature_indic & target == "continuous") {
    data_no_outcome <-
      data[, !(colnames(data) %in% as.character(model_info$outcome))]
    f_y_cors <- apply(data_no_outcome, 2, function(x) {
      if (!is.numeric(x)) {
        0
      } else {
        stats::cor(x, y)
      }
    })
    cor_orders <- order(f_y_cors, decreasing = TRUE)
    if (f_y_cors[cor_orders[1]] > 0.99) {
      warning(
        paste0(
          "Model formula includes term of type `deep_model(.)`. Data contains column ",
          colnames(data_no_outcome)[cor_orders[1]],
          ", which has a correlation of ",
          round(f_y_cors[cor_orders[1]], 4),
          " with the outcome. If using a term like `deep_model(.)` and supplying a `model` to generate the response, make sure that the original outcome is not contained in `data`."
        ),
        call. = FALSE
      )
    }
  }
}
#' @importFrom reticulate py_available
require_keras <- function() {
  try(reticulate::use_condaenv("r-keras", required = TRUE),
      silent = TRUE)
  if (!reticulate::py_available(initialize = TRUE))
  {
    message(
      "No Python Environemt available. Use ",
      "keras3::install_keras(method = \"conda\", conda = \"auto\") ",
      "to install recommended environment. If `install_keras` does not work",
      "(esp. on windows machines), use ",
      "install_conda_env()."
    )
    return(FALSE)
  }
  if (!reticulate::py_module_available("tensorflow"))
  {
    message(
      "Tensorflow not available. Use install_keras(method = \"conda\", conda = \"auto\")."
    )
    return(FALSE)
  }
  TRUE
}
#' @keywords internal
skip_if_no_conda_env <- function(envname = "r-keras") {
  testthat::skip_on_cran()

  conda_bin <- tryCatch(
    reticulate::conda_binary(),
    error = function(e)
      NULL
  )

  if (is.null(conda_bin)) {
    testthat::skip("Conda is not available")
  }

  envs <- tryCatch(
    reticulate::conda_list(conda = conda_bin)$name,
    error = function(e)
      character()
  )

  if (!envname %in% envs) {
    testthat::skip(paste0("Conda environment '", envname, "' is not available"))
  }

  reticulate::use_condaenv(envname, required = TRUE)

  reticulate::py_available(initialize = TRUE)

  invisible(TRUE)
}
