#' @export
"sim" <- function(x,...) UseMethod("sim")

#' Monte Carlo simulation
#'
#' Applies a function repeatedly for a specified number of replications or over
#' a list/data.frame with plot and summary methods for summarizing the Monte
#' Carlo experiment. Can be parallelized via the future package (use the
#' [future::plan()] function).
#' @export
#' @param x function or 'sim' object
#' @param R Number of replications or data.frame with parameters
#' @param f Optional function (i.e., if x is a matrix)
#' @param colnames Optional column names
#' @param seed (optional) Seed (needed with cl=TRUE)
#' @param args (optional) list of named arguments passed to (mc)mapply
#' @param iter If TRUE the iteration number is passed as first argument to
#'   (mc)mapply
#' @param mc.cores Optional number of cores. Will use parallel::mcmapply
#'   instead of future
#' @param progressr.message Optional message for the progressr progress-bar
#' @param estimate.index If return object inherits from `estimate` then only
#'   these column indices are extracted (estimate, se, lower, upper, p-val)
#' @param ... Additional arguments to [future.apply::future_mapply()]
#' @aliases sim sim.default as.sim
#' @seealso [summary.sim()] [plot.sim()] [sim.lvm()]
#' @details To parallelize the calculation use the [future::plan()] function
#'   (e.g., `future::plan(multisession())` to distribute the calculations over
#'   the `R` replications on all available cores). The output is controlled via
#'   the progressr package (e.g., `progressr::handlers(global=TRUE)` to enable
#'   progress information).
#' @examples
#' m <- lvm(y~x+e)
#' distribution(m,~y) <- 0
#' distribution(m,~x) <- dist_uniform(a=-1.1,b=1.1)
#' transform(m,e~x) <- function(x) (1*x^4)*rnorm(length(x),sd=1)
#'
#' onerun <- function(iter=NULL,...,n=2e3,b0=1,idx=2) {
#'     d <- sim(m,n,p=c("y~x"=b0))
#'     l <- lm(y~x,d)
#'     res <- c(coef(summary(l))[idx,1:2],
#'              confint(l)[idx,],
#'              coef(estimate(l), mat=TRUE)[idx,2:4])
#'     names(res) <- c("Estimate","Model.se","Model.lo","Model.hi",
#'                     "Sandwich.se","Sandwich.lo","Sandwich.hi")
#'     res
#' }
#' val <- sim(onerun,R=10,b0=1)
#' val
#'
#' val <- sim(val,R=40,b0=1) ## append results
#' summary(val,estimate=c(1,1),confint=c(3,4,6,7),true=c(1,1))
#'
#' summary(val,estimate=c(1,1),se=c(2,5),names=c("Model","Sandwich"))
#' summary(val,estimate=c(1,1),se=c(2,5),true=c(1,1),
#'         names=c("Model","Sandwich"),confint=TRUE)
#'
#' if (interactive()) {
#'     plot(val,estimate=1,c(2,5),true=1,
#'          names=c("Model","Sandwich"),polygon=FALSE)
#'     plot(val,estimate=c(1,1),se=c(2,5),main=NULL,
#'          true=c(1,1),names=c("Model","Sandwich"),
#'          line.lwd=1,col=c("gray20","gray60"),
#'          rug=FALSE)
#'     plot(val,estimate=c(1,1),se=c(2,5),true=c(1,1),
#'          names=c("Model","Sandwich"))
#' }
#'
#' f <- function(a=1, b=1) {
#'   rep(a*b, 5)
#' }
#' R <- Expand(a=1:3, b=1:3)
#' sim(f, R)
#' sim(function(a,b) f(a,b), 3, args=c(a=5,b=5))
#' sim(function(iter=1,a=5,b=5) iter*f(a,b), iter=TRUE, R=5)
#'
#' ## Returning estimate objects with extra per-iteration information
#' onerun2 <- function(...) {
#'   x <- rnorm(50)
#'   y <- 0.5*x + rnorm(50)
#'   e <- estimate(lm(y ~ x))
#'   c(e, converged = 1, niter = sample(5:20, 1), drop.ic = TRUE)
#'   # works identically with summary.estimate objects
#'   # c(summary(e), converged = 1, niter = sample(5:20, 1), drop.ic = TRUE)
#' }
#' val2 <- sim(onerun2, R = 10)
#' val2
#' # extra columns are stored but excluded from default summary statistics
#' idx <- c("(Intercept)", "x", "niter")
#' summary(val2, estimate=idx, true=c(0,0.5,NA))
sim.default <- function(x = NULL, R = 100, f = NULL,
                        colnames = NULL,
                        seed = NULL, args = list(),
                        iter = FALSE, mc.cores,
                        progressr.message = NULL,
                        estimate.index = 1:2,
                        ...) {
  stm <- proc.time()
  oldtm <- rep(0, 5)
  if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) {
    runif(1)
  }
  if (is.null(seed)) {
    RNGstate <- get(".Random.seed", envir = .GlobalEnv)
  } else {
    R.seed <- get(".Random.seed", envir = .GlobalEnv)
    set.seed(seed)
    RNGstate <- structure(seed, kind = as.list(RNGkind()))
    on.exit(assign(".Random.seed", R.seed, envir = .GlobalEnv))
  }
  olddata <- NULL
  dots <- list(...)
  mycall <- match.call(expand.dots = FALSE)
  if (inherits(x, c("data.frame", "matrix"))) olddata <- x
  if (inherits(x, "sim")) {
    oldtm <- attr(x, "time")
    oldcall <- attr(x, "call")
    x <- attr(x, "f")
    if (!is.null(f)) x <- f
    ex <- oldcall[["..."]]
    for (nn in setdiff(names(ex), names(dots))) {
      dots[[nn]] <- ex[[nn]]
      val <- list(ex[[nn]])
      names(val) <- nn
      mycall[["..."]] <- c(mycall[["..."]], list(val))
    }
  } else {
    if (!is.null(f)) x <- f
    if (!is.function(x)) stop("Expected a function or 'sim' object.")
  }
  if (is.null(x)) stop("Must give new function argument 'f'.")
  # `par.index`: list for storing position of estimate, se, confint when
  # the returned simulation object is an `estimate` object
  par.index <- list()
  seed_sequence <- NULL
  res <- val <- NULL
  on.exit({
    if (is.null(colnames) && !is.null(val)) {
      if (is.matrix(val[[1]])) {
        colnames <- base::colnames(val[[1]])
      } else {
        colnames <- names(val[[1]])
      }
    }
    base::colnames(res) <- colnames
    if (!is.null(olddata)) res <- rbind(olddata, res)
    attr(res, "call") <- mycall
    attr(res, "f") <- x
    cls <- ifelse(is.data.frame(res), "data.frame", "matrix")
    class(res) <- c("sim", cls)
    attr(res, "time") <- proc.time() - stm + oldtm
    attr(res, "par.index") <- par.index
    attr(res, "seeds") <- seed_sequence
    return(res)
  })
  if (inherits(R, c("matrix", "data.frame")) || length(R) > 1) {
    if (is.list(R)) {
      parval <- R
      ## list of parameters for each iteration
    } else if (inherits(R, c("matrix", "data.frame"))) {
      parval <- as.data.frame(R)
      names(parval) <- colnames(R)
      R <- NROW(parval)
    }
  } else {
    parval <- as.data.frame(1:R)
    names(parval) <- NULL
  }
  estimate.index <- sort(estimate.index)
  if (!all(estimate.index %in% 1:5)) {
    stop("wrong estimate.index")
  }
  repl <- NROW(parval)
  pb <- progressr::progressor(steps = repl)
  robx <- function(iter__, ...) {
    rng_seed <- if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE))
                  get(".Random.seed", envir = .GlobalEnv)
                else NULL
    if (!is.null(progressr.message)) {
      pb(message = progressr.message(...))
    } else {
      pb()
    }
    res <- tryCatch(x(...), error = function(e) NA)
    is_estimate <- inherits(res, c("estimate", "summary.estimate", "targeted"))
    extra <- NULL

    if (is_estimate) {
      extra <- attributes(res)$extra # defaults to NULL if attribute doesn't
      # exist // only extract extra attribute for estimate-type objects
      idx <- intersect(seq_len(5L), estimate.index) # parameters to keep
      cmat <- lava::parameter(res)[, idx, drop = FALSE]
      res <- as.vector(cmat)
      cn <- colnames(cmat)
      nam <- c()
      for (i in seq_along(idx)) {
        newn <- rownames(cmat)
        if (idx[i] > 1L) newn <- paste(newn, cn[i], sep=".")
        nam <- c(nam, newn)
      }
      names(res) <- nam
    }
    if (!is.null(extra)) { # append extra par. not part of the estimate object
      res <- c(res, extra)
    }
    return(structure(res,
                     "estimate" = is_estimate,
                     "n.extra" = length(extra),
                     ".rng_seed" = rng_seed))
  }
  if (iter || !is.data.frame(parval)) {
    formals(robx)[[1]] <- NULL
  }

  if (is.data.frame(parval)) {
    pp <- c(
      as.list(parval), dots,
      list(FUN = robx, SIMPLIFY = FALSE, MoreArgs = as.list(args))
    )
  } else { ## parameters as a list
    for (i in seq_along(parval)) {
      parval[i] <- c(parval[i], dots, args)
    }
    pp <- c(
      list(parval),
      list(FUN = robx, SIMPLIFY = FALSE)
    )
  }
  if (is.null(pp$future.seed)) {
    pp$future.seed <- TRUE
  }
  if (!missing(mc.cores)) {
    pp$future.seed <- NULL
    pp$mc.cores <- mc.cores
  }

  if (!missing(mc.cores)) {
    if (is.null(mc.cores)) {
      val <- do.call(mapply, pp)
    } else {
      val <- do.call(parallel::mcmapply, pp)
    }
  } else {
    val <- do.call(future.apply::future_mapply, pp)
  }
  seed_sequence <- lapply(val, attr, ".rng_seed")
  n.extra <- attr(val[[1]], "n.extra")
  val <- lapply(val, function(v) {
    attr(v, ".rng_seed") <- NULL
    attr(v, "n.extra") <- NULL
    v
  })
  res <- do.call(rbind, val)
  if (is.null(res)) {
    res <- matrix(NA, ncol=length(val[[1]]), nrow=repl)
  }
  if (attr(val[[1]], "estimate")) {
    ncol_est <- ncol(res) - n.extra
    if (ncol_est %% length(estimate.index) != 0L) {
      warning("unexpected number of columns")
    }
    idx <- seq_len(ncol_est)
    np <- ncol_est / length(estimate.index)
    if (1 %in% estimate.index) {
      par.index[["estimate"]] <- seq_len(np)
      idx <- setdiff(idx, par.index[["estimate"]])
    }
    if (2 %in% estimate.index) {
      par.index[["se"]] <- idx[seq_len(np)]
      idx <- setdiff(idx, par.index[["se"]])
    }
    if (3 %in% estimate.index) {
      par.index[["lower"]] <- idx[seq_len(np)]
      idx <- setdiff(idx, par.index[["lower"]])
    }
    if (4 %in% estimate.index) {
      par.index[["upper"]] <- idx[seq_len(np)]
      idx <- setdiff(idx, par.index[["upper"]])
    }
    if (5 %in% estimate.index) {
      par.index[["pval"]] <- idx[seq_len(np)]
      idx <- setdiff(idx, par.index[["pval"]])
    }
    if (n.extra > 0L) {
      par.index[["extra"]] <- seq.int(ncol_est + 1L, ncol(res))
    }
  }
  res
}

#' @export
cbind.sim <- function(x, ...) {
  res <- cbind(as.data.frame(x), ...)
  as.sim(res)
}

#' @export
rbind.sim <- function(x, ...) {
  res <- rbind(as.data.frame(x), ...)
  as.sim(res)
}

#' @export
as.vector.sim <- function(x, mode="any") {
  as.vector(x[,,drop=TRUE], mode=mode)
}

#' @export
as.matrix.sim <- function(x, ...) {
  if (inherits(x, "data.frame")) {
    return(as.matrix(as.data.frame(x)))
  }
  class(x) <- "matrix"
  attr(x, "call") <- NULL
  attr(x, "f") <- NULL
  attr(x, "time") <- NULL
  x
}

#' @export
"[.sim" <- function(x, i, j, drop = FALSE, keep.index = FALSE) {
  atr <- attributes(x)
  if (!is.null(dim(x))) {
    class(x) <- class(x)[2]
  } else {
    class(x) <- class(x)[-1]
  }
  cname <- colnames(x)
  x <- NextMethod("[", drop=drop)
  atr.keep <- c("call", "time")
  if (keep.index) atr.keep <- c(atr.keep, "par.index")
  if (missing(j)) {
    atr.keep <- c(atr.keep, "f")
  } else {
    if (keep.index) {
      pidx <- atr[["par.index"]]
      if (!is.null(pidx)) {
        if (is.character(j)) {
        j <- which(cname %in% j)
        }
        pidx <- lapply(pidx, function(x) which(j %in% x))
        atr[["par.index"]] <- pidx
      }
    }
  }
  attributes(x)[atr.keep] <- atr[atr.keep]
  if (!drop) class(x) <- c("sim", class(x))
  return(x)
}

#' @export
"as.sim" <- function (object, name, ...) {
  if (is.vector(object)) {
    cl <- ifelse(inherits(class(object), "data.frame"), "data.frame", "matrix")
    object <- structure(cbind(object), class=c("sim", cl))
    if (!missing(name)) colnames(object) <- name
    return(object)
  }
  structure(object, class=c("sim", class(object)))
}

Time <- function(sec,print=FALSE,...) {
    h <- sec%/%3600
    m0 <- (sec%%3600)
    m <- m0%/%60
    s <- m0%%60
    res <- c(h=h, m=m, s=s)
    if (print) {
        if (h>0) cat(h, "h ", sep="")
        if (m>0) cat(m, "m ", sep="")
        cat(s, "s", sep="")
        return(invisible(res))
    }
    return(res)
}


#' Generic print method
#'
#' Nicer print method for tabular data. Falls back to standard print method for
#' all other data types.
#' @export
#' @param x object to print
#' @param n number of rows to show from top and bottom of tabular data
#' @param digits precision
#' @param ... additional arguments to print method
Print <- function(x, n=5,
                  digits=max(3, getOption("digits")-3), ...) {
    mat <- !is.null(dim(x))
    if (!mat) {
      if (is.vector(x)) {
          x <- cbind(x)
          colnames(x) <- ""
      } else {
        print(x, ...)
        return(invisible(x))
      }
    }
    if (is.null(rownames(x))) {
        rownames(x) <- seq(nrow(x))
    }
    sep <- rbind("---"=rep('', ncol(x)))
    if (n<1) {
        print(x, quote=FALSE, digits=digits, ...)
    } else {
      if (NROW(x)<=(2*n)) {
        hd <- base::format(x, digits=digits, ...)
        print(hd, quote=FALSE, ...)
      } else {
        hd <- base::format(utils::head(x, n), digits=digits, ...)
        tl <- base::format(utils::tail(x, n), digits=digits, ...)
        print(rbind(base::as.matrix(hd), sep, base::as.matrix(tl)),
              quote=FALSE, ...)
      }
    }
    invisible(x)
}

#' @export
print.sim <- function(x, ...) {
    s <- summary(x, minimal=TRUE, ...)
    attr(x, "f") <- attr(x, "call") <- NULL
    Print(x, ...)
    cat("\n")
    if (nrow(x)>1) print(s, extra=FALSE, ...)
    return(invisible(x))
}

#' @export
print.summary.sim <- function(x,
                              group=list(c("^mean$","^sd$","^se$","^se/sd$",
                                           "^coverage","^length"),
                                   c("^min$","^[0-9.]+%$","^max$"),
                                   c("^na$","^missing$"),
                                   c("^true$","^bias$","^rmse$")),
                      lower.case=TRUE,
                      na.print="",
                      digits = max(3, getOption("digits") - 2),
                      quote=FALSE,
                      time=TRUE,
                      extra=TRUE,
                      ...) {
    if (extra) {
        cat(attr(x,"n")," replications",sep="")
        if (time && !is.null(attr(x,"time"))) {
            cat("\t\t\t\t\tTime: ")
            Time(attr(x,"time")["elapsed"],print=TRUE)
        }
        cat("\n\n")
    }

    nn <- rownames(x)
    if (lower.case)  nn <- tolower(nn)
    gg <- lapply(group,
                 function(x) unlist(lapply(x,function(v) grep(v,nn))))
    gg <- c(gg,list(setdiff(seq_along(nn),unlist(gg))))

    x0 <- c()
    ng <- length(gg)
    for (i in seq(ng)) {
        x0 <- rbind(x0, x[gg[[i]],,drop=FALSE],
        { if(i<ng && length(gg[[i+1]])>0) NA})
    }

    print(structure(x0,class="matrix")[,,drop=FALSE],digits=digits,quote=quote,na.print=na.print,...)
    if (extra) cat("\n")
    invisible(x)
}


#' Summary method for 'sim' objects
#'
#' Summary method for 'sim' objects
#' @export
#' @export summary.sim
#' @param object sim object
#' @param estimate (optional) columns with estimates
#' @param se (optional) columns with standard error estimates
#' @param confint (optional) list of pairs of columns with confidence limits
#' @param true (optional) vector of true parameter values
#' @param fun (optional) summary function
#' @param names (optional) names of estimates
#' @param unique.names if TRUE, unique.names will be applied to column names
#' @param minimal if TRUE, minimal summary will be returned
#' @param level confidence level (0.95)
#' @param quantiles quantiles (0,0.025,0.5,0.975,1)
#' @param df degrees of freedom in t-distribution used for constructing CIs
#'   (default Gaussian approximation)
#' @param ... additional levels to lower-level functions
summary.sim <- function(object,estimate=NULL,se=NULL,
                confint,
                true=NULL,
                fun,names=NULL,unique.names=TRUE,minimal=FALSE,
                level=0.95,
                quantiles=c(0,.025,0.5,.975,1),
                df = Inf,
                ...) {
    if (is.list(estimate)) {
        est <- estimate
        if (is.null(names)) names <- base::names(est)
        estimate <- c()
        nse  <- is.null(se)
        ntrue <- is.null(true)
        elen <- unlist(lapply(est,length))
        est <- lapply(est, function(e) c(e, rep(NA,max(elen)-length(e))))
        for (e in est) {
            estimate <- c(estimate,e[1])
            if (length(e)>1 && nse) se <- c(se,e[2])
            if (length(e)>2 && ntrue) true <- c(true,e[3])
        }
        cl <- match.call()
        cl[c("estimate","se","true","names")] <- list(estimate,se,true,names)
    }
    par.index <- attr(object, "par.index")
    if (is.null(estimate) && length(par.index) > 0) {
      estimate <- par.index[["estimate"]]
    } else {
      if (is.character(estimate)) {
        estimate <- match(estimate, base::colnames(object))
      }
    }
    np <- length(estimate)
    if (is.null(se) && length(par.index) > 0 && !is.null(par.index[["se"]])) {
      # Map each requested estimate column to its SE column (NA if unknown)
      se <- rep(NA_integer_, np)
      pi_est <- par.index[["estimate"]]
      pi_se <- par.index[["se"]]
      for (i in seq_len(np)) {
        j <- match(estimate[i], pi_est)
        if (!is.na(j)) se[i] <- pi_se[j]
      }
    }
    if (missing(confint)) {
      lo <- par.index[["lower"]]
      up <- par.index[["upper"]]
      if (length(par.index) > 0 &&
          (!is.null(lo) || !is.null(up))) {
        pi_est <- par.index[["estimate"]]
        if (is.null(lo)) lo <- rep(-Inf, length(pi_est))
        if (is.null(up)) up <- rep(Inf, length(pi_est))
        confint <- list()
        for (i in seq_len(np)) {
          j <- match(estimate[i], pi_est)
          if (!is.na(j)) {
            confint <- c(confint, list(c(lo[j], up[j])))
          } else {
            confint <- c(confint, list(c(NA_integer_, NA_integer_)))
          }
        }
      } else confint <- !is.null(se)&&!is.null(true)
    }
    if (minimal) {
        fun <- function(x,se,confint,...) {
            res <- c(Mean=mean(x,na.rm=TRUE),
                    SD=sd(x,na.rm=TRUE))
            if (!missing(se) && !is.null(se)) {
                res <- c(res, c(SE=mean(se,na.rm=TRUE)))
                res <- c(res, c("SE/SD"=res[["SE"]]/res[["SD"]]))
            }
            return(res)
        }
    }
    mfun <- function(x,...) {
        res <- c(mean(x,na.rm=TRUE),
                 sd(x,na.rm=TRUE),
                 if (length(quantiles)>0) quantile(x,quantiles,na.rm=TRUE),
                 mean(is.na(x)))
        if (length(quantiles)>0) {
            nq <- paste0(quantiles*100,"%")
            idx <- which(quantiles==1)
            if (length(idx)>0) nq[idx] <- "Max"
            idx <- which(quantiles==0)
            if (length(idx)>0) nq[idx] <- "Min"
        }
        names(res) <- c("Mean","SD",
                        if (length(quantiles)>0) nq,
                        "Missing")
        res
    }
    tm <- attr(object,"time")
    N <- max(length(estimate),length(se),length(true))
    if (!is.null(estimate)) estimate <- rep(estimate,length.out=N)
    if (!is.null(se)) se <- rep(se,length.out=N)
    if (!is.null(true)) {
        if (is.null(estimate)) N <- ncol(object)
        true <- rep(true,length.out=N)
    }

    if (!is.null(estimate) && is.character(estimate)) {
        estimate <- match(estimate,colnames(object))
    }
    if (is.list(confint)) confint <- unlist(confint)
    if (!missing(fun)) {
        if (!is.null(estimate)) m.est <- object[,estimate,drop=FALSE]
        else m.est <- object
        m.se <- NULL
        if (!is.null(se)) m.se <- object[,se,drop=FALSE]
        m.ci <- NULL
        if (!is.null(confint)) m.ci <- object[,confint,drop=FALSE]
        res <- lapply(seq(ncol(m.est)),
                      function(i,...) fun(m.est[,i,drop=TRUE],
                                          se=m.se[,i,drop=TRUE],
                                          confint=m.ci[,1:2+(i-1)*2],...,
                                          INDEX=i),...)
        res <- matrix(unlist(res),nrow=length(res[[1]]),byrow=FALSE)
        if (is.null(dim(res))) {
            res <- rbind(res)
        }
        if (is.null(rownames(res))) {
            rownames(res) <- names(fun(0,m.se,m.ci,INDEX=1,...))
            if (is.null(rownames(res))) rownames(res) <- rep("",nrow(res))
        }
        if (is.null(colnames(res))) {
            colnames(res) <- colnames(m.est)
        }
        return(structure(res,
                    n=NROW(object),
                    time=tm,
                    class=c("summary.sim","matrix")))
    }

    if (!is.null(estimate)) {
        est <- apply(object[,estimate,drop=FALSE],2,mfun)
    } else {
        est <- apply(object,2,mfun)
    }

    if (!is.null(true)) {
        if (length(true)!=ncol(est)) {
            ##stop("'true' should be of same length as 'estimate'.")
            true <- rep(true,length.out=ncol(estimate))
        }
        est <- rbind(est,
                     rbind(True=true),rbind(Bias=est["Mean",]-true),
                     rbind(RMSE=((est["Mean",]-true)^2+(est["SD",])^2)^.5)
                     )
    }
    if (!is.null(se)) {
        if (is.character(se)) {
            se <- match(se,colnames(object))
        }
        if (length(se)!=ncol(est)) stop("'se' should be of same length as 'estimate'.")
        est <- rbind(est, SE=apply(object[,se,drop=FALSE],2,
                                   function(x) val <- c(mean(x,na.rm=TRUE))))
        est <- rbind(est,"SE/SD"=est["SE",]/est["SD",])
    }
    if (!is.null(confint) && (length(confint)>1 || confint)) {
        if (is.character(confint)) {
            confint <- match(confint,colnames(object))
        }
        if (length(confint)==1 && confint) {
            if (is.null(se)) stop("Supply confidence limits or SE")
            confint <- c()
            pos <- ncol(object)
            for (i in seq_along(estimate)) {
              z <- 1-(1-level)/2
              if (is.na(se[i])) {
                CI <- matrix(NA, nrow=NROW(object), ncol=2)
              } else {
                q <- qt(z, df = df)
                CI <- cbind(object[,estimate[i]] - q*object[,se[i]],
                            object[,estimate[i]] + q*object[,se[i]])
              }
              colnames(CI) <- NULL
              object <- cbind(object,CI)
              confint <- c(confint,pos+1:2)
              pos <- pos+2
            }
        }
        if (length(confint)!=2*length(estimate)) stop("'confint' should be of length 2*length(estimate).")
        Coverage <- c()
        Length <- c()
        for (i in seq_along(estimate)) {
            upper <- object[,confint[2*i]][[1]]
            lower <- object[,confint[2*(i-1)+1]][[1]]
            Coverage <- c(
              Coverage,
              mean((lower < true[i]) & (upper > true[i]), na.rm=TRUE)
            )
            Length <- c(
              Length,
              mean(abs(upper - lower), na.rm = TRUE)
            )
        }
        est <- rbind(est,Coverage=Coverage, Length=Length)
    }

    if (!is.null(names)) {
         if (length(names)<ncol(est)) {
            uest <- unique(estimate)
            names <- names[match(estimate,uest)]
        }
        colnames(est) <- names

    }
    if (unique.names && !is.null(colnames(est))) {
        colnames(est) <- make.unique(colnames(est))
    }
    est[is.nan(est)] <- NA

    return(structure(est,
                     n=NROW(object),
                     time=tm,
                     class=c("summary.sim","matrix")))
}
