SCM

SCM Repository

[rmetrics] Diff of /pkg/randtoolbox/R/runifInterface.R
ViewVC logotype

Diff of /pkg/randtoolbox/R/runifInterface.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3965, Fri Mar 13 10:04:32 2009 UTC revision 3966, Fri Mar 13 10:13:50 2009 UTC
# Line 1  Line 1 
1  set.generator <- function(generator=c("congruRand", "default"), params=NULL, seed=NULL)  set.generator <- function(name=c("congruRand", "default"), parameters=NULL, seed=NULL, ...)
2  {  {
3          generator <- match.arg(generator)          name <- match.arg(name)
4          if (generator == "congruRand") {          dots <- list(...)
5                  if (is.null(params)) {          if (name == "congruRand") {
6                          params <- list(generator="congruRand", mod=2147483647, mult=16807, incr=0)                  if (is.null(parameters)) {
7                  } else if (is.null(params$generator)) {                          parameters <- c(mod=dots$mod, mult=dots$mult, incr=dots$incr)
8                          params <- c(list(generator="congruRand"), params)                  }
9                  } else {                  if (length(parameters) == 0) {
10                          params$generator <- "congruRand"                          parameters <- c(mod=2147483647, mult=16807, incr=0)
11                    }
12                    if (!identical(names(parameters), c("mod", "mult", "incr"))) {
13                            param.names <- paste(names(parameters),collapse=" ")
14                            stop("parameters \"", param.names, "\" are not correct for congruRand")
15                  }                  }
16                  if (is.null(seed)) {                  if (is.null(seed)) {
                         if (!is.null(params$seed)) {  
                                 seed <- params$seed  
                         } else {  
17                                  seed <- floor(2^32 * runif(1))                                  seed <- floor(2^32 * runif(1))
18                          }                          }
19                  }                  state <- c(seed=seed)
20                  params$seed <- seed                  description <- list(name=name, parameters=parameters, state=state)
21                  put.state(params)                  put.state(description)
22          } else if (generator == "default") {          } else if (name == "default") {
23                  RNGkind("default")                  RNGkind("default")
24                  if (!is.null(seed)) {                  if (!is.null(seed)) {
25                          set.seed(seed)                          set.seed(seed)
26                  }                  }
27          } else {          } else {
28                  stop("unsupported generator: ", generator)                  stop("unsupported generator: ", name)
29          }          }
30          invisible(NULL)          invisible(NULL)
31  }  }
32    
33  put.state <- function(state)  put.state <- function(description)
34  {  {
35          if (state$generator == "congruRand") {          name <- description$name
36            parameters <- description$parameters
37            state <- description$state
38            if (name == "congruRand") {
39                  .C("set_generator",                  .C("set_generator",
40                          as.integer(1),                          as.integer(1),
41                          PACKAGE="randtoolbox")                          PACKAGE="randtoolbox")
42                  RNGkind("user-supplied")                  RNGkind("user-supplied")
43                  .C("put_state_congru",                  .C("put_state_congru",
44                          as.double(state$mod),                          as.double(parameters["mod"]),
45                          as.double(state$mult),                          as.double(parameters["mult"]),
46                          as.double(state$incr),                          as.double(parameters["incr"]),
47                          as.double(state$seed),                          as.double(state["seed"]),
48                          PACKAGE="randtoolbox")                          PACKAGE="randtoolbox")
49          } else {          } else {
50                  stop("unsupported generator: ", state$generator)                  stop("unsupported generator: ", name)
51          }          }
52          invisible(NULL)          invisible(NULL)
53  }  }
# Line 57  Line 61 
61                  integer(1),                  integer(1),
62                  PACKAGE="randtoolbox")[[1]]                  PACKAGE="randtoolbox")[[1]]
63          if (generator == 1) {          if (generator == 1) {
64                    name <- "congruRand"
65                  aux <- .C("get_state_congru",                  aux <- .C("get_state_congru",
66                          mod=double(1),                          mod=double(1),
67                          mult=double(1),                          mult=double(1),
68                          incr=double(1),                          incr=double(1),
69                          seed=double(1),                          seed=double(1),
70                          PACKAGE="randtoolbox")                          PACKAGE="randtoolbox")
71                  state <- c(list(generator="congruRand"),aux)                  parameters <- c(mod=aux$mod, mult=aux$mult, incr=aux$incr)
72                    state <- c(seed=aux$seed)
73          } else {          } else {
74                  stop("internal error of randtoolbox")                  stop("internal error of randtoolbox")
75          }          }
76          state          list(name=name, parameters=parameters, state=state)
77  }  }
78    

Legend:
Removed from v.3965  
changed lines
  Added in v.3966

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge