[Yuima-commits] r77 - in pkg/yuima: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 21 00:01:57 CEST 2010
Author: iacus
Date: 2010-06-21 00:01:56 +0200 (Mon, 21 Jun 2010)
New Revision: 77
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/R/simulate.R
pkg/yuima/R/yuima.sampling.R
pkg/yuima/man/setSampling.Rd
pkg/yuima/man/simulate.Rd
Log:
fixed sampling
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2010-06-09 22:54:49 UTC (rev 76)
+++ pkg/yuima/DESCRIPTION 2010-06-20 22:01:56 UTC (rev 77)
@@ -1,8 +1,8 @@
Package: yuima
Type: Package
Title: The YUIMA Project package
-Version: 0.0.86
-Date: 2010-06-07
+Version: 0.0.87
+Date: 2010-06-20
Depends: methods, zoo, stats4
Suggets: adapt
Author: YUIMA Project Team.
Modified: pkg/yuima/R/simulate.R
===================================================================
--- pkg/yuima/R/simulate.R 2010-06-09 22:54:49 UTC (rev 76)
+++ pkg/yuima/R/simulate.R 2010-06-20 22:01:56 UTC (rev 77)
@@ -14,10 +14,11 @@
setGeneric("simulate",
function(object, nsim, seed, xinit, true.parameter, space.discretized=FALSE,
increment.W=NULL, increment.L=NULL, methodfGn="Cholesky",
- sampling=sampling, subsampling=subsampling,
- Initial = 0, Terminal = 1, n = 100, delta = 0.1,
- grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none")
+ sampling=sampling, subsampling=subsampling, ...
+# Initial = 0, Terminal = 1, n = 100, delta,
+# grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
+# sgrid=as.numeric(NULL), interpolation="none"
+ )
standardGeneric("simulate")
)
@@ -27,15 +28,17 @@
space.discretized=FALSE, increment.W=NULL, increment.L=NULL,
methodfGn="Cholesky",
sampling, subsampling,
- Initial = 0, Terminal = 1, n = 100, delta = 0.1,
- grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none"){
+#Initial = 0, Terminal = 1, n = 100, delta,
+# grid, random = FALSE, sdelta=as.numeric(NULL),
+# sgrid=as.numeric(NULL), interpolation="none"
+ ...){
tmpsamp <- NULL
if(missing(sampling)){
- tmpsamp <- setSampling(Initial = Initial, Terminal = Terminal, n = n,
- delta = delta, grid = grid, random = random, sdelta=sdelta,
- sgrid=sgrid, interpolation=interpolation)
+ tmpsamp <- setSampling(...)
+# tmpsamp <- setSampling(Initial = Initial, Terminal = Terminal, n = n,
+# delta = delta, grid = grid, random = random, sdelta=sdelta,
+# sgrid=sgrid, interpolation=interpolation)
} else {
tmpsamp <- sampling
}
@@ -53,7 +56,7 @@
space.discretized=FALSE, increment.W=NULL, increment.L=NULL,
methodfGn="Cholesky",
sampling, subsampling,
- Initial = 0, Terminal = 1, n = 100, delta = 0.1,
+ Initial = 0, Terminal = 1, n = 100, delta,
grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
sgrid=as.numeric(NULL), interpolation="none"){
@@ -96,7 +99,7 @@
if(length(xinit)==1){
xinit <- rep(xinit, d.size)
}else{
- cat("\nDimension of xinit variables missmuch.\n")
+ cat("\nDimension of xinit variables missmatch.\n")
return(NULL)
}
}
@@ -208,7 +211,7 @@
yuima at data <- euler(xinit, yuima, dW, yuimaEnv)
for(i in 1:length(yuima at data@zoo.data))
- time(yuima at data@zoo.data[[i]]) <- yuima at sampling@grid
+ time(yuima at data@zoo.data[[i]]) <- yuima at sampling@grid[[1]] ## to be fixed
if(missing(subsampling))
return(yuima)
Modified: pkg/yuima/R/yuima.sampling.R
===================================================================
--- pkg/yuima/R/yuima.sampling.R 2010-06-09 22:54:49 UTC (rev 76)
+++ pkg/yuima/R/yuima.sampling.R 2010-06-20 22:01:56 UTC (rev 77)
@@ -3,6 +3,9 @@
# if grid is specified, the following are derived from it
# grid -> n, delta, Initial, Terminal, regular, random
+# grid is ALWAYS a list, possibly of dimension 1
+# if it is not a list, we transform it to a list
+
# if grid is 1-dim, no problem, but we can have more grids.
# in this case it is better to have a listI replace grid
# with alist
@@ -12,89 +15,198 @@
# we convert objects to "zoo" internally
-# to be fixed: the grdi should always be prepared unless it is random sampling
+# to be fixed: the grid should always be prepared unless it is random sampling
+# which.delta: check is grid is regular. If regular returns the delta, otherwise NA
+
+which.delta <- function(x) ifelse(length(unique(diff(x)))==1, diff(x)[1], NA)
+
setMethod("initialize", "yuima.sampling",
- function(.Object, Initial, Terminal, n, delta, grid, random,
- regular, sdelta, sgrid, oindex, interpolation){
+function(.Object, Initial, Terminal, n, delta, grid, random,
+regular, sdelta, sgrid, oindex, interpolation){
.Object at sdelta <- as.numeric(NULL)
.Object at sgrid <- as.numeric(NULL)
.Object at oindex <- as.numeric(NULL)
.Object at interpolation <- interpolation
-# grid given
- if(length(grid)>0){
- testInitial<-(min(grid)==Initial)
- testTerminal<-(max(grid)==Terminal)
- testn<-(abs(n-diff(range(grid))/mean(diff(grid))+1)<10^(-10))
- testdelta<-(abs(delta-mean(diff(grid)))<10^(-10))
- testregular<-all(abs(diff(diff(grid)))<10^(-10))
-
- if(!testInitial){
- cat("\n Start time has been set with the grid \n")
- }
- if(!testTerminal){
- cat("\n Terminal time has been set with the grid \n")
- }
- if(!testn){
- cat("\n Division has been set with the grid \n")
- }
- if(!testdelta){
- cat("\n delta has been set with the grid \n")
- }
- if(testregular){
- .Object at n <- diff(range(grid))/mean(diff(grid))+1
- .Object at delta <- mean(diff(grid))
- .Object at regular <- TRUE
- }else{
- .Object at n <- length(grid)-1
- .Object at delta <- as.numeric(NULL)
- .Object at regular <- FALSE
- }
- .Object at grid <- grid
- .Object at Initial <- min(grid)
- .Object at Terminal <- max(grid)
- .Object at random <- random
- }else{
-# There is no grid
- eqn <- length(Terminal)
- if(length(Terminal)==length(n)){
- .Object at Initial <- Initial
- .Object at Terminal <- Terminal
- .Object at n <- n
- .Object at delta <- (Terminal-Initial)/n
- .Object at grid <- seq(Initial,Terminal,by=.Object at delta)
- .Object at random <- FALSE
- .Object at regular <- regular
- }else if(length(Terminal)==1){
- .Object at Initial <- Initial
- .Object at Terminal <- rep(Terminal, length(n))
- .Object at n <- n
- .Object at delta <- (Terminal-Initial)/n
- .Object at grid <- seq(Initial,Terminal,by=.Object at delta)
- .Object at random <- FALSE
- .Object at regular <- regular
- }else if(length(n)==1){
- .Object at Initial <- Initial
- .Object at Terminal <- Terminal
- .Object at n <- rep(n, length(Terminal))
- .Object at delta <- (Terminal-Initial)/n
- .Object at grid <- seq(Initial,Terminal,by=.Object at delta)
- .Object at random <- FALSE
- .Object at regular <- regular
- }else{
- cat("\nDimension missmatch.\n")
- return(NULL)
- }}
- return(.Object)
+
+# grid given
+ if(!is.null(grid)){
+ if(!is.list(grid)){
+ cat("\nYUIMA: attempting to coerce 'grid' to a list, unexpected results may occur!\n")
+ grid <- list(grid)
+ }
+ grid <- lapply(grid, sort) # we make sure grids are ordered
+ .Object at grid <- grid
+ .Object at Initial <- sapply(grid, min)
+ .Object at Terminal <- sapply(grid, max)
+ .Object at n <- sapply(grid, function(x) length(x))
+ .Object at random <- FALSE
+ .Object at delta <- sapply(grid, which.delta)
+ .Object at regular <- !any(is.na( .Object at delta ) )
+ return(.Object)
+ }
+# grid is missing, but random sampling
+ if(!is.logical(random)){
+ cat("\nrandom\n")
+ .Object at regular <- FALSE
+ .Object at Terminal <- numeric(0)
+ .Object at Initial <- Initial
+ .Object at n <- numeric(0)
+ .Object at delta <- numeric(0)
+ .Object at random <- random
+ return(.Object)
+ }
+
+
+
+# grid is missing, but non random sampling
+
+ nTerm <- 0
+ if(!missing(Terminal)) nTerm <- length(Terminal)
+ nInit <- 0
+ if(!missing(Initial)) nInit <- length(Initial)
+ nObs <- 0
+ if(!missing(n)) nObs <- length(n)
+ nDelta <- 0
+ if(!any(is.na(delta))) nDelta <- length(delta)
+
+ grid <- list()
+
+# Initial + delta + n (+ Terminal: ignored) => Terminal
+ if(nInit>0 & nDelta>0 & nObs>0){
+ dims <- c(nInit, nDelta, nObs)
+ ndim <- dims[ which.max(dims) ]
+ Initial <- rep(Initial, ndim)[1:ndim]
+ delta <- rep(delta, ndim)[1:ndim]
+ n <- rep(n, ndim)[1:ndim]
+ Terminal <- Initial + n*delta
+ cat("\nYUIMA: 'Terminal' (re)defined\n")
+ for(i in 1:ndim)
+ grid[[i]] <- seq(Initial[i], Terminal[i], by=delta[i])
+
+ .Object at Terminal <- Terminal
+ .Object at Initial <- Initial
+ .Object at n <- n
+ .Object at delta <- delta
+ .Object at grid <- grid
+ .Object at random <- FALSE
+ .Object at regular <- TRUE
+
+ return(.Object)
+ }
+
+
+# Initial + Terminal + n (+ delta: ignored) => delta
+ if(nInit>0 & nTerm>0 & nObs>0){
+ dims <- c(nInit, nTerm, nObs)
+ ndim <- dims[ which.max(dims) ]
+ Initial <- rep(Initial, ndim)[1:ndim]
+ Terminal <- rep(Terminal, ndim)[1:ndim]
+ if( any(Terminal < Initial))
+ stop("\nYUIMA: 'Terminal' < 'Initial'\n")
+ n <- rep(n, ndim)[1:ndim]
+ delta <- (Terminal-Initial)/n
+ cat("\nYUIMA: 'delta' (re)defined\n")
+ for(i in 1:ndim)
+ grid[[i]] <- seq(Initial[i], Terminal[i], by=delta[i])
+ }
+
+ .Object at Terminal <- Terminal
+ .Object at Initial <- Initial
+ .Object at n <- n
+ .Object at delta <- delta
+ .Object at grid <- grid
+ .Object at random <- FALSE
+ .Object at regular <- TRUE
+
+ return(.Object)
})
-setSampling <- function(Initial=0, Terminal=1, n=100, delta=0.1,
- grid=as.numeric(NULL), random=FALSE, sdelta=as.numeric(NULL),
+setSampling <- function(Initial=0, Terminal=1, n=100, delta,
+ grid, random=FALSE, sdelta=as.numeric(NULL),
sgrid=as.numeric(NULL), interpolation="pt" ){
+ if(missing(delta))
+ delta <- NA
+ if(missing(grid))
+ grid <- NULL
return(new("yuima.sampling", Initial=Initial, Terminal=Terminal,
n=n, delta=delta, grid=grid, random=random,
regular=TRUE, sdelta=sdelta, sgrid=sgrid,
interpolation=interpolation))
}
+#setMethod("initialize", "yuima.sampling",
+#function(.Object, Initial, Terminal, n, delta, grid, random,
+#regular, sdelta, sgrid, oindex, interpolation){
+# .Object at sdelta <- as.numeric(NULL)
+# .Object at sgrid <- as.numeric(NULL)
+# .Object at oindex <- as.numeric(NULL)
+# .Object at interpolation <- interpolation
+## grid given
+# if(length(grid)>0){
+# testInitial<-(min(grid)==Initial)
+# testTerminal<-(max(grid)==Terminal)
+# testn<-(abs(n-diff(range(grid))/mean(diff(grid))+1)<10^(-10))
+# testdelta<-(abs(delta-mean(diff(grid)))<10^(-10))
+# testregular<-all(abs(diff(diff(grid)))<10^(-10))
+#
+# if(!testInitial){
+# cat("\n Start time has been set with the grid \n")
+# }
+# if(!testTerminal){
+# cat("\n Terminal time has been set with the grid \n")
+# }
+# if(!testn){
+# cat("\n Division has been set with the grid \n")
+# }
+# if(!testdelta){
+# cat("\n delta has been set with the grid \n")
+# }
+# if(testregular){
+# .Object at n <- diff(range(grid))/mean(diff(grid))+1
+# .Object at delta <- mean(diff(grid))
+# .Object at regular <- TRUE
+# }else{
+# .Object at n <- length(grid)-1
+# .Object at delta <- as.numeric(NULL)
+# .Object at regular <- FALSE
+# }
+# .Object at grid <- grid
+# .Object at Initial <- min(grid)
+# .Object at Terminal <- max(grid)
+# .Object at random <- random
+# }else{
+## There is no grid
+# eqn <- length(Terminal)
+# if(length(Terminal)==length(n)){
+# .Object at Initial <- Initial
+# .Object at Terminal <- Terminal
+# .Object at n <- n
+# .Object at delta <- (Terminal-Initial)/n
+# .Object at grid <- seq(Initial,Terminal,by=.Object at delta)
+# .Object at random <- FALSE
+# .Object at regular <- regular
+# }else if(length(Terminal)==1){
+# .Object at Initial <- Initial
+# .Object at Terminal <- rep(Terminal, length(n))
+# .Object at n <- n
+# .Object at delta <- (Terminal-Initial)/n
+# .Object at grid <- seq(Initial,Terminal,by=.Object at delta)
+# .Object at random <- FALSE
+# .Object at regular <- regular
+# }else if(length(n)==1){
+# .Object at Initial <- Initial
+# .Object at Terminal <- Terminal
+# .Object at n <- rep(n, length(Terminal))
+# .Object at delta <- (Terminal-Initial)/n
+# .Object at grid <- seq(Initial,Terminal,by=.Object at delta)
+# .Object at random <- FALSE
+# .Object at regular <- regular
+# }else{
+# cat("\nDimension missmatch.\n")
+# return(NULL)
+# }}
+# return(.Object)
+#})
+#
\ No newline at end of file
Modified: pkg/yuima/man/setSampling.Rd
===================================================================
--- pkg/yuima/man/setSampling.Rd 2010-06-09 22:54:49 UTC (rev 76)
+++ pkg/yuima/man/setSampling.Rd 2010-06-20 22:01:56 UTC (rev 77)
@@ -8,8 +8,8 @@
\code{setSampling} is a constructor for \code{\link{yuima.sampling-class}}.
}
\usage{
- setSampling(Initial = 0, Terminal = 1, n = 100, delta = 0.1,
- grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
+ setSampling(Initial = 0, Terminal = 1, n = 100, delta,
+ grid, random = FALSE, sdelta=as.numeric(NULL),
sgrid=as.numeric(NULL), interpolation="pt" )
}
\arguments{
@@ -64,8 +64,19 @@
scaling constant or a scaling function.
If the \code{grid} of times is deterministic, then \code{random} is \code{FALSE}.
-If not given, the slot \code{grid} is always filled after the call to the
-function \code{\link{simulate}}.
+If not specified and \code{random=FALSE}, the slot \code{grid} is filled
+automatically by the function. It is eventually modified or created
+after the call to the function \code{\link{simulate}}.
+
+If \code{delta} is not specified, it is calculated as \code{(Terminal-Initial)/n)}.
+If \code{delta} is specified, the \code{Terminal} is adjusted to be equal to
+\code{Initial+n*delta}.
+
+The vectors \code{delta}, \code{n}, \code{Initial} and \code{Terminal} may
+have different lengths, but then they are extended to the maximal length to
+keep consistency. See examples.
+
+If \code{grid} is specified, it takes precedence over all other arguments.
}
\value{
An object of type \code{\link{yuima.sampling-class}}.
@@ -74,5 +85,15 @@
\examples{
samp <- setSampling(Terminal=1, n=1000)
str(samp)
+
+samp <- setSampling(Terminal=1, n=1000, delta=0.3)
+str(samp)
+
+
+samp <- setSampling(Terminal=1, n=1000, delta=c(0.1,0.3))
+str(samp)
+
+samp <- setSampling(Terminal=1:3, n=1000)
+str(samp)
}
\keyword{ts}
Modified: pkg/yuima/man/simulate.Rd
===================================================================
--- pkg/yuima/man/simulate.Rd 2010-06-09 22:54:49 UTC (rev 76)
+++ pkg/yuima/man/simulate.Rd 2010-06-20 22:01:56 UTC (rev 77)
@@ -5,10 +5,7 @@
\usage{
simulate(object, nsim, seed, xinit, true.parameter, space.discretized = FALSE,
increment.W = NULL, increment.L = NULL, methodfGn = "Cholesky",
- sampling, subsampling,
- Initial = 0, Terminal = 1, n = 100, delta = 0.1,
- grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none")
+ sampling, subsampling, ...)
}
\arguments{
\item{object}{an \code{\link{yuima-class}} or
@@ -24,16 +21,7 @@
\item{seed}{Not used yet. Included only to match the standard genenirc in
package \code{stats}.}
\item{methodfGn}{simulation methods for fractional Gaussian noise.}
- \item{Initial}{Initial time of the grid.}
- \item{Terminal}{Terminal time of the grid.}
- \item{n}{number of time intervals.}
- \item{delta}{mesh size in case of regular time grid.}
- \item{grid}{a grid of times for the simulation, possibly empty.}
- \item{random}{specify if it is random sampling. See Details.}
- \item{sdelta}{mesh size in case of regular space grid.}
- \item{sgrid}{a grid in space for the simulation, possibly empty.}
- \item{interpolation}{a rule of interpolation in case of subsampling.
- By default, no interpolation. See Details.}
+ \item{...}{passed to \code{\link{setSampling}} to create a sampling}
\item{sampling}{a \code{\link{yuima.sampling-class}} object.}
\item{subsampling}{a \code{\link{yuima.sampling-class}} object.}
}
More information about the Yuima-commits
mailing list