SCM

SCM Repository

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

Diff of /pkg/randtoolbox/R/quasiRNG.R

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

revision 6135, Thu Nov 29 11:07:56 2018 UTC revision 6136, Tue Apr 30 12:56:05 2019 UTC
# Line 5  Line 5 
5  # @author Christophe Dutang  # @author Christophe Dutang
6  # @author Diethelm Wuertz  # @author Diethelm Wuertz
7  #  #
 # Copyright (C) 2017, Christophe Dutang,  
8  # Copyright (C) 2009, Diethelm Wuertz, ETH Zurich.  # Copyright (C) 2009, Diethelm Wuertz, ETH Zurich.
9    # Copyright (C) 2019, Christophe Dutang,
10    # Christophe Dutang, see http://dutangc.free.fr
11  # All rights reserved.  # All rights reserved.
12  #  #
13  # The new BSD License is applied to this software.  # The new BSD License is applied to this software.
14  # Copyright (c) 2009 Christophe Dutang, Diethelm Wuertz.  # Copyright (c) 2019 Christophe Dutang, Diethelm Wuertz.
15  # All rights reserved.  # All rights reserved.
16  #  #
17  #      Redistribution and use in source and binary forms, with or without  #      Redistribution and use in source and binary forms, with or without
# Line 54  Line 55 
55                    normal=FALSE, mexp = 19937)                    normal=FALSE, mexp = 19937)
56  {  {
57    ## Check arguments    ## Check arguments
58    if(n < 0 || is.array(n) || !is.numeric(n))    if(is.array(n) || !is.numeric(n))
59      stop("invalid argument 'n'")      stop("invalid argument 'n'")
60    if(length(dim) >1)    if(length(dim) >1)
61      stop("invalid argument 'dim'")      stop("invalid argument 'dim'")
# Line 89  Line 90 
90    
91    ## Compute    ## Compute
92    nb <- ifelse(length(n)>1, length(n), n)    nb <- ifelse(length(n)>1, length(n), n)
93      if(nb < 0) stop("invalid argumet 'n'")
94      if(nb == 0) return(numeric(0))
95    startpt <- .getrandtoolboxEnv(".torus.seed")$offset    startpt <- .getrandtoolboxEnv(".torus.seed")$offset
96    print(startpt)  
97    #implemented in src/randtoolbox.c    #implemented in src/randtoolbox.c
98    res <- .Call(CF_doTorus, nb, dim, prime, startpt, mixed, usetime, mexp)    res <- .Call(CF_doTorus, nb, dim, prime, startpt, mixed, usetime, mexp)
99    
# Line 123  Line 126 
126  {  {
127    # A function based on Diethelm Wuertz's code    # A function based on Diethelm Wuertz's code
128    
129    if(n < 0 || is.array(n) || !is.numeric(n))    if(is.array(n) || !is.numeric(n))
130      stop("invalid argument 'n'")      stop("invalid argument 'n'")
131    if(length(dim) >1)    if(length(dim) >1)
132      stop("invalid argument 'dim'")      stop("invalid argument 'dim'")
# Line 157  Line 160 
160      stop("Halton algorithm not initialized.")      stop("Halton algorithm not initialized.")
161    
162    nb <- ifelse(length(n)>1, length(n), n)    nb <- ifelse(length(n)>1, length(n), n)
163      if(nb < 0) stop("invalid argumet 'n'")
164      if(nb == 0) return(numeric(0))
165    rngEnv <- .getrandtoolboxEnv(".halton.seed")    rngEnv <- .getrandtoolboxEnv(".halton.seed")
166    
167    if(method == "Fortran")    if(method == "Fortran")
# Line 215  Line 220 
220                     mixed = FALSE, method="Fortran", mexp = 19937)                     mixed = FALSE, method="Fortran", mexp = 19937)
221  {  {
222    # A function implemented by Diethelm Wuertz    # A function implemented by Diethelm Wuertz
223    if(n <0 || is.array(n) || !is.numeric(n))    if(is.array(n) || !is.numeric(n))
224      stop("invalid argument 'n'")      stop("invalid argument 'n'")
225    if(length(dim) >1)    if(length(dim) >1)
226      stop("invalid argument 'dim'")      stop("invalid argument 'dim'")
# Line 226  Line 231 
231    method <- match.arg(method, c("C", "Fortran"))    method <- match.arg(method, c("C", "Fortran"))
232    
233    nb <- ifelse(length(n)>1, length(n), n)    nb <- ifelse(length(n)>1, length(n), n)
234      if(nb < 0) stop("invalid argumet 'n'")
235      if(nb == 0) return(numeric(0))
236    if(method == "Fortran")    if(method == "Fortran")
237    {    {
238    
# Line 279  Line 285 
285      authorizedParam <- c(607, 1279, 2281, 4253, 11213, 19937, 44497, 86243, 132049, 216091)      authorizedParam <- c(607, 1279, 2281, 4253, 11213, 19937, 44497, 86243, 132049, 216091)
286      if( !(mexp %in% authorizedParam) )      if( !(mexp %in% authorizedParam) )
287        stop("'mexp' must be in {607, 1279, 2281, 4253, 11213, 19937, 44497, 86243, 132049, 216091}. ")        stop("'mexp' must be in {607, 1279, 2281, 4253, 11213, 19937, 44497, 86243, 132049, 216091}. ")
288        warning("not yet implemented")
289        return(NULL)
290      result <- .Call(CF_doSobol, nb, dim, 0, FALSE, FALSE, mexp)      result <- .Call(CF_doSobol, nb, dim, 0, FALSE, FALSE, mexp)
291      stop("not yet implemented")  
292    }    }
293    
294    

Legend:
Removed from v.6135  
changed lines
  Added in v.6136

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