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