#' @title
#' Generate R altered sequence data sets.
#'
#' @description
#' R \code{stslist} state sequence objects are generated by applying the chosen timing error model to the provided state sequence object.
#'
#' @details
#' This function is handy for testing how outcome of a sequence analysis may vary with timing errors in the reported sequences.
#'
#' Use the vector form of \code{J} to specify the probability distribution of the timing error. See function \code{\link{MCpj}} to generate a probability vector that complies with expected mean timing errors.
#'
#' @param seqdata A state sequence \code{stslist} object as generated by \code{\link[TraMineR]{seqdef}}.
#' @param J Integer or vector of positive numbers. If an integer, maximal timing error (number of unit periods around first state of new spell. Default is \code{J=1}. If a vector, weights of the timing errors \code{k = -K, -(K-1), ..., K-1, K}, where \code{2K + 1} is the length of \code{J}. The vector length must be odd.
#' @param R Integer. Number of random replicated sequence data. Default is \code{R=10}. The weights are internally normalized to sum to 1.
#' @param jfixed Logical. Should same error j be applied to all transitions in a sequence? Default is \code{FALSE}.
#' @param kchanges Integer, string, or \code{NULL}. If integer, number of transitions whose time can potentially be altered in each sequence. If \code{"rand"}, the number of potential changes is randomly selected for each sequence. If \code{NULL} (default), all transitions can potentially be altered.
#' @param silent Logical. Should waiting and timing messages be hidden?
#' @param unique Logical. Should only unique sequences be replicated? Default is \code{FALSE}. If \code{TRUE} weights will reflect the multiple occurrences of each original unique sequence.
#' @param model String. Time alteration model. One of \code{"keep.dss"} (default), \code{"indep"} (suppress spells erased by move of transition), and \code{"relative"} (keep time until next transitions unchanged).
#' @param include.obs logical. Should the observed sequence data be added as last element.
#'
#' @return List of R altered \code{stslist} objects plus observed sequence object as last element when \code{include.obs=TRUE}.
#'
#' @seealso \code{\link{MCpj}}
#'
#' @references
#' Ritschard, G. and Liao, T.F. (2026). Assessing the Impact of Timing Errors in Sequence Analysis. \emph{International Journal of Social Research Methodology}. Forthcoming
#'
#'
#' @author Gilbert Ritschard
#'
#' @export
#'
## @exportS3Method print distMC
## @exportS3Method summary distMC
#'
#' @import TraMineR
#' @importFrom WeightedCluster wcAggregateCases
#'
#'
#' @examples
#' ## mini test data, 6 sequences of length 4, 4 unique sequences
#' exdata <- read.table(text="
#'                 a a b b
#'                 a a b b
#'                 b b a a
#'                 a c c b
#'                 b b a c
#'                 b b a c
#'                 ")
#' weights=rep(1, nrow(exdata))
#' s.exdata <- seqdef(exdata, weights = weights, id=paste("id",1:nrow(exdata), sep=""))
#'
#' ## 3 altered sequence datasets
#' (altseq.list <- MCseqReplicate(s.exdata, J=1, R=3))
#'
#' ## list of dissimilarity matrices
#' suppressMessages(dist.list <- lapply(altseq.list, seqdist, method="LCS", full.matrix=FALSE))
#' dist.list
#'
#' ## Can also be obtained with MCdisslist, which offers option use.udiss;
#' ## use.udiss=TRUE is faster when number of unique merged replicated
#' ## sequences is less than n*sqrt(R).
#' suppressMessages(dist.list <- MCdisslist(altseq.list, method="LCS", use.udiss=TRUE))
#'
#' ## Replication based on expected left and right non-zero errors of 1.1
#' ##  and assuming a 0.5 probability of no error
#' Pj <- MCpj(Emean=1.1, pzero=.5)
#' (altseq2.list <- MCseqReplicate(s.exdata, J=Pj, R=3))


MCseqReplicate <- function(seqdata, J=1, R=20, silent=FALSE, unique=FALSE, model="keep.dss", jfixed=FALSE, kchanges=NULL, include.obs=FALSE){

  if (model=="keep.dss"){
    ch.meth <- 1
  }else if (model=="indep"){
    ch.meth <- 2
  }else if (model=="relative"){
    ch.meth <- 3
  }else {
    stop("Unkown model value")
  }

  if (is.character(kchanges) ){
    if (kchanges=="rand"){
      kchanges <- -1
    }else
      stop("Invalid kchanges value!")
  }

  if(length(J) == 1) {
    JJ <- 2*J + 1
    Jprob <- J
  } else {
    JJ <- length(J)
    if (! JJ %% 2)
      stop("Length of J must be odd!")
    if (any(J<0))
      stop("Negative values in J")

    Jprob <- J/sum(J)
    J <- (JJ - 1)/2
  }

  if(!inherits(seqdata,"stslist"))
    stop("argument seqdata must be a stslist object!")


  ## extract unique sequences (we do not need weights here)

  if(unique) {
    aggCases <- wcAggregateCases(seqdata, weights=attr(seqdata,"weights"))
    ## u.seqdata is set of unique sequences
    u.seqdata <- seqdata[aggCases[["aggIndex"]],]
    weights <- aggCases[["aggWeights"]]
    sdx <- aggCases[["disaggIndex"]]
    names(sdx) <- rownames(seqdata)
  } else {
    aggCases <- NULL
    u.seqdata <- seqdata
    weights <- attr(seqdata,"weights")
    sdx <- 1:nrow(seqdata)
  }
  ## Transform into numeric to avoid issues with unwanted character in state labels
  #DataU <- seqasnum.one(u.seqdata) ## returns numeric for missing
  DataU <- seqnum(u.seqdata) ## returns a stslist
  #print(DataU)
  L <- ncol(DataU)  ## sequence length if all sequences are of equal length
  NU <- nrow(DataU)

  sDataU <- DataU ## DataU is stslist
  sdss <- seqdss(sDataU)
  sdur <- seqdur(sDataU)

  res <- MClistrepset(dss=sdss, sdur=sdur, Jprob=Jprob, R=R, ch.meth=ch.meth, jfixed=jfixed, kchanges=kchanges)


  nrs <- nrow(res)/R

  reslist <- list()
  alph <- alphabet(u.seqdata)
  cnames <- colnames(u.seqdata)
  labels <- attr(u.seqdata,"labels")
  for (i in 1:R){
    reslist[[i]] <- res[((i-1)*nrs + 1):(i*nrs),]
    attr(reslist[[i]],"weights") <- weights
    alphabet(reslist[[i]]) <- alph
    attr(reslist[[i]],"labels") <- labels
    colnames(reslist[[i]]) <- cnames
    #print(attr(reslist[[i]],"alphabet"))
  }
  if (include.obs){
    reslist[[R+1]] <- u.seqdata
    attr(reslist[[R+1]],"weights") <- weights
    colnames(reslist[[i]]) <- cnames
  }

  attr(reslist,"unique") <- unique
  attr(reslist,"obs") <- include.obs

  #invisible(reslist)
  reslist
}


## stslist of all replicated sequences
MClistrepset <-function(dss,sdur,
                        Jprob,R=10,ch.meth,
                        jfixed, kchanges){
  mdss <- as.matrix(dss)
  ncs <- ncol(mdss)
  nrs <- nrow(mdss)
  #setlist <- list()
  setsps <- NULL
  for (i in 1:R){
    if (ch.meth==1){
      dur <- t(apply(sdur,1,ch.dur,Jprob=Jprob, jfixed = jfixed, k=kchanges))
    }else if (ch.meth==2){
      dur <- t(apply(sdur,1,ch.dur.indep,Jprob=Jprob, jfixed = jfixed, k=kchanges))
    }else if (ch.meth==3){
      dur <- t(apply(sdur,1,ch.dur.relat,Jprob=Jprob, jfixed = jfixed, k=kchanges))
    }

    if (nrow(dur)==1) dur <- t(dur)
    wdurlist <- apply(dur,1, function(x){which(x>0)}, simplify=FALSE)
    set <- matrix(nrow=nrs,ncol=ncs)
    for (j in 1:nrs){
      set[j,1:length(wdurlist[[j]])] <- paste0(mdss[j,wdurlist[[j]]],"/",dur[j,wdurlist[[j]]])
    }
    rownames(set) <- paste0("R",i,"-",rownames(dss))
    setsps <- rbind(setsps,set)
  }
  setsts <- seqformat(setsps, from="SPS", to="STS", SPS.in=list(xfix="", sdsep="/"), stsep="-")
  rownames(setsts) <- rownames(setsps)
  seqset <- suppressMessages(
      seqdef(setsts, alphabet=alphabet(dss))
      )
  seqset
}

