# Internal utility functions for xreg2

# Safe log: replace non-positive values with machine epsilon before taking log
Log <- function(x) {
  x[x <= 0] <- .Machine$double.xmin
  log(x)
}

# Outer product wrapper
Outer <- function(y, x, FUN = "*") outer(y, x, FUN)

# Grouped sum: returns vector of length = number of unique groups
group.sum <- function(x, ina) as.numeric(tapply(x, ina, sum))

# Repeat a row vector n times to form an n x length(m) matrix
rep_row <- function(m, n) matrix(as.numeric(m), nrow = n, ncol = length(m), byrow = TRUE)

# Filter ... args to those accepted by fun
match_formals <- function(fun, ...) {
  passedargs <- list(...)
  passedargs[!names(passedargs) %in% names(formals(fun))] <- NULL
  passedargs
}

# Match rows across two data.frames with the same number of columns
multimatch <- function(df1, df2) {
  if (ncol(df1) != ncol(df2)) stop("Data.frames must have same number of columns.")
  a <- apply(df1, 1, function(x) paste(x, collapse = "_"))
  b <- apply(df2, 1, function(x) paste(x, collapse = "_"))
  return(match(a, b))
}

# Change left-hand side of a formula
change_target <- function(object, newtarget, oldtarget = NULL) UseMethod("change_target")

#' @exportS3Method
change_target.formula <- function(object, newtarget, oldtarget = NULL) {
  if (length(as.list(object)) == 2) {
    retval <- as.formula(paste0(newtarget, "~", as.character(object[2])))
  } else {
    target <- object[[2]]
    if (is.null(oldtarget)) oldtarget <- target
    if (oldtarget != target) return(object)
    retval <- as.formula(paste0(newtarget, "~", as.character(object[3])))
  }
  attr(retval, ".Environment") <- attr(object, ".Environment")
  return(retval)
}

# Prepend or append to the right-hand side of a formula
appendmodel <- function(object, prepend = "", append = "") UseMethod("appendmodel")

#' @exportS3Method
appendmodel.formula <- function(object, prepend = "", append = "") {
  LHS <- ""
  RHS <- as.character(object[length(object)])
  if (length(object) == 3) LHS <- as.character(object[2])
  RHS <- paste(prepend, RHS, append)
  return(formula(paste(LHS, " ~ ", RHS), env = environment(object)))
}

# Safe try: return NULL on error
try0 <- function(expr) tryCatch(expr, error = function(e) NULL)
