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 4534, Fri Oct 23 08:37:12 2009 UTC revision 4549, Wed Oct 28 09:22:56 2009 UTC
# Line 48  Line 48 
48    
49    
50  set.generator <- function(name=c("congruRand", "WELL", "default"), parameters=NULL, seed=NULL, ...,  set.generator <- function(name=c("congruRand", "WELL", "default"), parameters=NULL, seed=NULL, ...,
51                  only.description=FALSE)                  only.dsc=FALSE)
52  {  {
53          name <- match.arg(name)          name <- match.arg(name)
54          dots <- list(...)          dots <- list(...)
# Line 74  Line 74 
74          } else if (name == "WELL")          } else if (name == "WELL")
75          {          {
76                  if (is.null(parameters))                  if (is.null(parameters))
77                          parameters <- c(order=dots$order, version=dots$version)                  {
78                  if (length(parameters) == 0)                          if (is.null(dots$temp))
79                          parameters <- c(order=19937, version=1)                                  dots$temp <- ""
80                  if (!identical(names(parameters), c("order", "version")))                          if (dots$temp == "temp")
81                                    dots$temp <- "Temp"
82                            parameters <- c(order=dots$order, version=dots$version, temp=dots$temp)
83                    }
84                    if (identical(names(parameters), c("order", "version")))
85                            parameters <- c(parameters, temp="")
86                    if (!identical(names(parameters), c("order", "version", "temp")))
87                  {                  {
88                          param.names <- paste(names(parameters),collapse=" ")                          param.names <- paste(names(parameters),collapse=" ")
89                          stop("parameter list \"", param.names, "\" is not correct for WELL")                          cat("parameters required for WELL: order, version, temp\n")
90                            cat("parameters provided: ", param.names, "\n")
91                            stop("parameter list is not correct for WELL")
92                  }                  }
93                    if (! paste(parameters, collapse="") %in% c("512a", "521a", "521b", "607a", "607b", "800a", "800b", "1024a", "1024b",
94                            "19937a", "19937aTemp", "19937b", "21701a", "23209a", "23209b", "44497a", "44497aTemp"))
95                            stop("unsupported parameters for WELL")
96                  if (is.null(seed))                  if (is.null(seed))
97                          seed <- floor(2^31 * runif(1))                          seed <- floor(2^31 * runif(1))
98                  size <- ceiling(parameters["order"]/32)                  size <- ceiling(as.numeric(parameters["order"])/32)
99                  state <- .C("initMT2002",                  state <- .C("initMT2002",
100                                          as.integer(seed),                                          as.integer(seed),
101                                          as.integer(size),                                          as.integer(size),
# Line 99  Line 110 
110                  return(invisible(NULL))                  return(invisible(NULL))
111          } else          } else
112                  stop("unsupported generator: ", name)                  stop("unsupported generator: ", name)
113          if (only.description)          if (only.dsc)
114                  return(description)                  return(description)
115          put.description(description)          put.description(description)
116          invisible(NULL)          invisible(NULL)
# Line 137  Line 148 
148                  RNGkind("user-supplied")                  RNGkind("user-supplied")
149                  .C("putRngWELL",                  .C("putRngWELL",
150                          as.integer(parameters["order"]),                          as.integer(parameters["order"]),
151                          as.integer(parameters["version"]),                          match(parameters["version"], c("a", "b")),
152                          as.integer(0),                          as.integer(parameters["temp"] == "Temp"),
153                          as.integer(state),                          as.integer(state),
154                          PACKAGE="rngWELL")                          PACKAGE="rngWELL")
155          } else          } else
# Line 185  Line 196 
196                          temp = integer(1),                          temp = integer(1),
197                          state = integer(2000),                          state = integer(2000),
198                          PACKAGE="rngWELL")                          PACKAGE="rngWELL")
199                  parameters <- c(order=tmp$order, version=tmp$version)                  order <- as.character(tmp$order)
200                  size <- ceiling(parameters["order"]/32)                  version <- letters[tmp$version]
201                    temp <- if (tmp$temp == 1) "Temp" else ""
202                    parameters <- c(order=order, version=version, temp=temp)
203                    size <- ceiling(tmp$order/32)
204                  state <- tmp$state[1:size]                  state <- tmp$state[1:size]
205                  literature <- "Panneton - L'Ecuyer - Matsumoto"                  literature <- "Panneton - L'Ecuyer - Matsumoto"
206          } else          } else

Legend:
Removed from v.4534  
changed lines
  Added in v.4549

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