#########################################################################/**
# @RdocDefault insert
#
# @title "Insert values to a vector at certain positions"
#
# \description{
#  @get "title".
# }
#
# @synopsis
#
# \arguments{
#   \item{x}{The @vector of data values.}
#   \item{ats}{The indices of \code{x} where the values should be inserted.}
#   \item{values}{A @list or a @vector of the values to be inserted.
#      Should be of same length as \code{ats}, unless if a single value
#      when it is automatically extended without a warning.}
#   \item{useNames}{If @FALSE, the names attribute is dropped/ignored,
#      otherwise not.  Only applied if argument \code{x} is named.}
#   \item{...}{Not used.}
# }
#
# @examples "../incl/insert.Rex"
#
# \seealso{
#   @see "base::append" takes argument \code{after} (a scalar).  For example,
#   \code{append(x, y, after=after) == insert(x, values=y, ats=after+1)}.
#   Contrary to \code{append()}, \code{insert()} accepts a vector of insert indices.
# }
#
# @author
#
# @keyword "manip"
#*/#########################################################################t
setMethodS3("insert", "default", function(x, ats, values=NA, useNames=TRUE, ...) {
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Local functions
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # For debug only!
##   printFromTo <- function(from, to, x) {
##     fromto <- matrix(c(from, to), ncol=2)
##     colnames(fromto) <- c("from", "to")
##     idx <- apply(fromto, MARGIN=1, FUN=function(i) seqToHumanReadable(i[1]:i[2]))
##     xidx <- apply(fromto, MARGIN=1, FUN=function(i) paste(x[i[1]:i[2]], collapse=","))
##     print(data.frame(from=from, to=to, idx=idx, x.=xidx))
##   }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Validate arguments
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  if (!is.vector(x))
    throw("Argument 'x' is not a vector: ", class(x))

  len <- length(x)
  if (any(ats < 1 | ats > len+1))
    throw("Argument 'ats' contains indices out of range: ", paste(ats, collapse=", "))

  if (any(duplicated(ats)))
    throw("Argument 'ats' contains duplicated indices: ", paste(ats, collapse=", "))

  if (!is.vector(values))
    throw("Argument 'values' is not a vector: ", class(values))

  # Argument 'useNames':
  useNames <- as.logical(useNames)

  # Deal with the names attribute too?
  if (useNames) {
    names <- names(x)
    useNames <- (!is.null(names))
  }

  if (!is.list(values)) {
    if (length(ats) == 1) {
      values <- list(values)
    } else {
      values <- as.list(values)
    }
  }

  if (length(ats) != length(values)) {
    if (length(values) == 1) {
      values <- rep(values, length.out=length(ats))
    } else {
      throw("Argument 'ats' and argument 'values' has different lengths: ",
                                       length(ats), " != ", length(values))
    }
  }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Setup
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Sort the 'ats' indicies
  o <- order(ats)
  ats <- ats[o]
  values <- values[o]

  nvalues <- unlist(lapply(values, FUN=length))

  # Allocate the result vector
  n2 <- length(x) + sum(nvalues)
  x2 <- vector(mode=mode(x), length=n2)
  storage.mode(x2) <- storage.mode(x)
  if (useNames)
    names2 <- character(n2)

  # 'ats' positions in the result vector
  n <- length(ats)
  ats2 <- ats + c(0, cumsum(nvalues[-n]))

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Assign inserted values
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  for (kk in 1:length(ats2)) {
    idx2 <- ats2[kk] + 0:(nvalues[kk]-1)
    valuesKK <- values[[kk]]
    x2[idx2] <- valuesKK
    if (useNames) {
      valueNames <- names(valuesKK)
      if (is.null(valueNames))
        valueNames <- character(length(valuesKK))
      names2[idx2] <- valueNames
    }
  }

  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  # Assign original values
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  froms <- c(1, ats)
  tos <- c(ats-1, length(x))
  froms2 <- c(1, ats2+nvalues)

  if (ats[1] == 1) {
    froms <- froms[-1]
    tos <- tos[-1]
    froms2 <- froms2[-1]
  }

  if (ats[n] > length(x)) {
    froms <- froms[-length(froms)]
    tos <- tos[-length(tos)]
    froms2 <- froms2[-length(froms2)]
  }

  ns <- tos-froms+1
  tos2 <- froms2 + ns - 1

  for (kk in seq_along(froms2)) {
    from <- froms[kk]
    to <- tos[kk]
    from2 <- froms2[kk]
    to2 <- tos2[kk]
    idx <- from:to
    idx2 <- from2:to2
    x2[idx2] <- x[idx]
    if (useNames)
      names2[idx2] <- names[idx]
  }

  if (useNames)
    names(x2) <- names2

  x2
})
