SCM

SCM Repository

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

Annotation of /pkg/randtoolbox/R/runifInterface.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3975 - (view) (download)

1 : dutangc 3975 #licence to be done
2 :    
3 : savicky 3973 set.generator <- function(name=c("congruRand", "default"), parameters=NULL, seed=NULL, ...,
4 :     only.description=FALSE)
5 : savicky 3954 {
6 : savicky 3966 name <- match.arg(name)
7 :     dots <- list(...)
8 :     if (name == "congruRand") {
9 :     if (is.null(parameters)) {
10 :     parameters <- c(mod=dots$mod, mult=dots$mult, incr=dots$incr)
11 : savicky 3954 }
12 : savicky 3966 if (length(parameters) == 0) {
13 :     parameters <- c(mod=2147483647, mult=16807, incr=0)
14 :     }
15 :     if (!identical(names(parameters), c("mod", "mult", "incr"))) {
16 :     param.names <- paste(names(parameters),collapse=" ")
17 : savicky 3973 stop("parameter list \"", param.names, "\" is not correct for congruRand")
18 : savicky 3966 }
19 : savicky 3954 if (is.null(seed)) {
20 : savicky 3973 seed <- floor(as.double(parameters["mod"]) * runif(1))
21 : savicky 3954 }
22 : savicky 3966 state <- c(seed=seed)
23 :     description <- list(name=name, parameters=parameters, state=state)
24 : savicky 3973 if (only.description) {
25 :     return(description)
26 :     } else {
27 :     put.state(description)
28 :     }
29 : savicky 3966 } else if (name == "default") {
30 : savicky 3954 RNGkind("default")
31 :     if (!is.null(seed)) {
32 :     set.seed(seed)
33 :     }
34 :     } else {
35 : savicky 3966 stop("unsupported generator: ", name)
36 : savicky 3954 }
37 :     invisible(NULL)
38 :     }
39 :    
40 : savicky 3966 put.state <- function(description)
41 : savicky 3954 {
42 : savicky 3966 name <- description$name
43 :     parameters <- description$parameters
44 :     state <- description$state
45 :     if (name == "congruRand") {
46 : savicky 3973 aux <- .C("check_state_congru",
47 :     as.double(parameters["mod"]),
48 :     as.double(parameters["mult"]),
49 :     as.double(parameters["incr"]),
50 :     as.double(state["seed"]),
51 :     err = integer(1),
52 :     PACKAGE="randtoolbox")
53 :     if (aux$err != 0) {
54 :     stop("check congruRand error: ", aux$err)
55 :     }
56 :     .C("set_user_unif_init",
57 : savicky 3954 as.integer(1),
58 :     PACKAGE="randtoolbox")
59 : savicky 3958 RNGkind("user-supplied")
60 : savicky 3973 .C("set_user_unif_rand",
61 :     as.integer(1),
62 :     PACKAGE="randtoolbox")
63 : savicky 3954 .C("put_state_congru",
64 : savicky 3966 as.double(parameters["mod"]),
65 :     as.double(parameters["mult"]),
66 :     as.double(parameters["incr"]),
67 :     as.double(state["seed"]),
68 : savicky 3954 PACKAGE="randtoolbox")
69 :     } else {
70 : savicky 3966 stop("unsupported generator: ", name)
71 : savicky 3954 }
72 :     invisible(NULL)
73 :     }
74 :    
75 :     get.state <- function()
76 :     {
77 :     if (RNGkind(NULL)[1] != "user-supplied") {
78 : savicky 3958 stop("For R base generators, use .Random.seed, not get.state()")
79 : savicky 3954 }
80 :     generator <- .C("current_generator",
81 :     integer(1),
82 :     PACKAGE="randtoolbox")[[1]]
83 :     if (generator == 1) {
84 : savicky 3966 name <- "congruRand"
85 : savicky 3954 aux <- .C("get_state_congru",
86 :     mod=double(1),
87 :     mult=double(1),
88 :     incr=double(1),
89 :     seed=double(1),
90 :     PACKAGE="randtoolbox")
91 : savicky 3966 parameters <- c(mod=aux$mod, mult=aux$mult, incr=aux$incr)
92 :     state <- c(seed=aux$seed)
93 : dutangc 3975 if(parameters[1] == 2^32 && parameters[2] == 1664525 && parameters[3] == 1013904223)
94 :     literature <- "Knuth - Lewis"
95 :     else if(parameters[1] == 2^48 && parameters[2] == 31167285 && parameters[3] == 1)
96 :     literature <- "Lavaux - Jenssens"
97 :     else if(parameters[1] == 2^64 && parameters[2] == 636412233846793005 && parameters[3] == 1)
98 :     literature <- "Haynes"
99 :     else if(parameters[1] == 2^32 && parameters[2] == 69069 && parameters[3] == 0)
100 :     literature <- "Marsiglia"
101 :     else if(parameters[1] == 2^31-1 && parameters[2] == 16807 && parameters[3] == 0)
102 :     literature <- "Park - Miller"
103 :     else
104 :     literature <- "Unknown"
105 : savicky 3954 } else {
106 :     stop("internal error of randtoolbox")
107 :     }
108 : dutangc 3975 list(name=name, authors=literature, parameters=parameters, state=state)
109 : savicky 3954 }
110 :    

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