1# These functions are
2# Copyright (C) 1998-2021 T.W. Yee, University of Auckland.
3# All rights reserved.
4
5
6
7
8
9
10
11simulate.vlm <- function (object, nsim = 1, seed = NULL, ...) {
12  if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE))
13    runif(1)
14  if (is.null(seed)) {
15    RNGstate <- get(".Random.seed", envir = .GlobalEnv)
16  } else {
17    R.seed <- get(".Random.seed", envir = .GlobalEnv)
18    set.seed(seed)
19    RNGstate <- structure(seed, kind = as.list(RNGkind()))
20    on.exit(assign(".Random.seed", R.seed, envir = .GlobalEnv))
21  }
22  ftd <- fitted(object)
23  nm <- names(ftd)
24  n <- length(ftd)
25  ntot <- n * nsim
26  Fam <- if (inherits(object, "vlm")) {
27    object@family
28  } else {
29   stop("cannot get at the 'family' slot")
30  }
31  val <-
32    if (length(Fam@simslot) > 0) {
33      Fam@simslot(object, nsim)
34    } else {
35      stop(gettextf("family '%s' not implemented", Fam), domain = NA)
36    }
37  if (!is.list(val)) {
38    dim(val) <- c(n, nsim)
39    val <- as.data.frame(val)
40  } else {
41    class(val) <- "data.frame"
42  }
43  names(val) <- paste("sim", seq_len(nsim), sep = "_")
44  if (!is.null(nm))
45    row.names(val) <- nm
46  attr(val, "seed") <- RNGstate
47  val
48}
49
50
51
52
53
54