[Yuima-commits] r51 - in pkg/yuima: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 24 08:38:56 CET 2009
Author: iacus
Date: 2009-12-24 08:38:56 +0100 (Thu, 24 Dec 2009)
New Revision: 51
Modified:
pkg/yuima/R/AllClasses.R
pkg/yuima/R/subsampling.R
pkg/yuima/R/yuima.sampling.R
pkg/yuima/man/setSampling.Rd
pkg/yuima/man/subsampling.Rd
Log:
added deterministic sampling
Modified: pkg/yuima/R/AllClasses.R
===================================================================
--- pkg/yuima/R/AllClasses.R 2009-12-24 02:30:47 UTC (rev 50)
+++ pkg/yuima/R/AllClasses.R 2009-12-24 07:38:56 UTC (rev 51)
@@ -56,12 +56,12 @@
Terminal = "numeric",
n = "numeric",
delta = "numeric",
- grid = "numeric",
+ grid = "ANY",
random = "ANY",
regular = "logical",
sdelta = "numeric",
- sgrid = "numeric",
- oindex = "numeric",
+ sgrid = "ANY",
+ oindex = "ANY",
interpolation = "character"
)
)
Modified: pkg/yuima/R/subsampling.R
===================================================================
--- pkg/yuima/R/subsampling.R 2009-12-24 02:30:47 UTC (rev 50)
+++ pkg/yuima/R/subsampling.R 2009-12-24 07:38:56 UTC (rev 51)
@@ -9,24 +9,27 @@
setGeneric("subsampling",
function(x, sampling=NULL, Initial, Terminal, delta,
grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none")
+ sgrid=as.numeric(NULL), interpolation="pt")
standardGeneric("subsampling")
)
setMethod("subsampling","yuima",
function(x, sampling=NULL, Initial, Terminal, delta,
grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none")
- return(subsampling(x at data, sampling=sampling, Initial = Initial,
+sgrid=as.numeric(NULL), interpolation="pt"){
+ obj <- subsampling(x at data, sampling=sampling, Initial = Initial,
Terminal = Terminal, delta = delta,
grid = grid, random = random, sdelta=sdelta,
- sgrid=sgrid, interpolation=interpolation))
+ sgrid=sgrid, interpolation=interpolation)
+ obj at model <- x at model
+ return(obj)
+}
)
setMethod("subsampling", "yuima.data",
function(x, sampling=sampling, Initial, Terminal, delta,
grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none"){
+ sgrid=as.numeric(NULL), interpolation="pt"){
tmpsamp <- NULL
if(missing(sampling)){
@@ -39,16 +42,25 @@
Data <- get.zoo.data(x)
- tmpgrid <- NULL
+ n.data <- length(Data)
+ tmpgrid <- vector(n.data, mode="list")
+# prepares a grid of times
+
+ if(is.logical(tmpsamp at random)){
+ if(tmpsamp at random)
+ stop("wrong random sampling specification")
+ for(i in 1:n.data){
+ tmpgrid[[i]] <- seq(start(Data[[i]]), end(Data[[i]]), by=tmpsamp at delta[i])
+ }
+ }
+
# random sampling
if(is.list(tmpsamp at random)){
rdist <- c(tmpsamp at random$rdist)
if(is.null(rdist))
stop("provide at least `rdist' argument for random sampling")
n.rdist <- length(rdist)
- n.data <- length(Data)
- tmpgrid <- vector(n.data, mode="list")
r.gen <- rep( rdist, n.data) # eventually reciclying arguments
r.gen <- r.gen[1:n.data]
for(i in 1:n.data){
@@ -60,16 +72,61 @@
if(tail(tmpgrid[[i]],1)>T)
tmpgrid[[i]] <- tmpgrid[[i]][-length(tmpgrid[[i]])]
}
- }
+ }
- otime <- vector(n.data, mode="list")
-
+# prepares original index slot
+ oindex <- vector(n.data, mode="list")
+# checks for interpolation method, if not in the list uses "pt"
+ interpolation <- tmpsamp at interpolation
+ int.methods <- c("previous", "pt", "next", "nt", "none", "exact",
+ "lin", "linear")
+ if(! (interpolation %in% int.methods) )
+ interpolation <- "pt"
+
for(i in 1:n.data){
- otime[[i]] <- time(Data[[i]])
- idx <- as.numeric(sapply(tmpgrid[[i]], function(x) max(which(otime[[i]] <= x))))
- x at zoo.data[[i]] <- zoo(as.numeric(Data[[i]][idx]), order.by=tmpgrid[[i]])
+ oindex[[i]] <- time(Data[[i]])
+ idx <- numeric(0)
+ newData <- NULL
+ lGrid <- length(tmpgrid[[i]])
+ if( interpolation %in% c("previous", "pt")){
+ idx <- as.numeric(sapply(tmpgrid[[i]], function(x) max(which(oindex[[i]] <= x))))
+ newData <- sapply(1:lGrid, function(x) as.numeric(Data[[i]][idx[x]]))
+ oindex[[i]] <- sapply(1:lGrid, function(x) time(Data[[i]])[idx[x]])
+ }
+ if( interpolation %in% c("next", "nt")){
+ idx <- as.numeric(sapply(tmpgrid[[i]], function(x) min(which(oindex[[i]] >= x))))
+ newData <- sapply(1:lGrid, function(x) as.numeric(Data[[i]][idx[x]]))
+ oindex[[i]] <- sapply(1:lGrid, function(x) time(Data[[i]])[idx[x]])
+ }
+ if( interpolation %in% c("none", "exact")){
+ idx <- match(tmpgrid[[i]], oindex[[i]])
+ newData <- sapply(1:lGrid, function(x) as.numeric(Data[[i]][idx[x]]))
+ oindex[[i]] <- sapply(1:lGrid, function(x) time(Data[[i]])[idx[x]])
+ }
+
+ if( interpolation %in% c("lin", "linear")){
+ idx.l <- as.numeric(sapply(tmpgrid[[i]], function(x) max(which(oindex[[i]] <= x))))
+ idx.r <- as.numeric(sapply(tmpgrid[[i]], function(x) min(which(oindex[[i]] >= x))))
+ f.int <- function(u)
+ (as.numeric(Data[[i]][idx.r[u]])+as.numeric(Data[[i]][idx.l[u]]))/2
+ newData <- sapply(1:lGrid, f.int )
+ oindex[[i]] <- sapply(1:lGrid, function(u) time(Data[[i]])[idx.l[u]])
+ }
+ Data[[i]] <- zoo(newData, order.by=tmpgrid[[i]])
+ tmpsamp at Terminal[i] <- end(Data[[i]])
+ tmpsamp at Initial[i] <- start(Data[[i]])
+ tmpsamp at n[i] <- length(Data[[i]])
}
- return(x)
+ tmpsamp at oindex <- oindex
+ tmpsamp at grid <- tmpgrid
+ tmpsamp at regular <- all(sapply(1:n.data, function(x) sum(diff(tmpgrid[[x]]))<1e-3))
+ if(!tmpsamp at regular)
+ tmpsamp at delta <- numeric(0)
+ obj <- NULL
+ tmpsamp at interpolation <- interpolation
+ x at zoo.data <- Data
+ obj <- setYuima(data=x, sampling=tmpsamp)
+ return(obj)
} ### end method
)
Modified: pkg/yuima/R/yuima.sampling.R
===================================================================
--- pkg/yuima/R/yuima.sampling.R 2009-12-24 02:30:47 UTC (rev 50)
+++ pkg/yuima/R/yuima.sampling.R 2009-12-24 07:38:56 UTC (rev 51)
@@ -10,7 +10,7 @@
.Object at sdelta <- as.numeric(NULL)
.Object at sgrid <- as.numeric(NULL)
.Object at oindex <- as.numeric(NULL)
- .Object at interpolation <- "none"
+ .Object at interpolation <- interpolation
if(length(grid)>0){
testInitial<-(min(grid)==Initial)
testTerminal<-(max(grid)==Terminal)
@@ -79,7 +79,7 @@
setSampling <- function(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" ){
+ sgrid=as.numeric(NULL), interpolation="pt" ){
return(new("yuima.sampling", Initial=Initial, Terminal=Terminal,
n=n, delta=delta, grid=grid, random=random,
regular=TRUE, sdelta=sdelta, sgrid=sgrid,
Modified: pkg/yuima/man/setSampling.Rd
===================================================================
--- pkg/yuima/man/setSampling.Rd 2009-12-24 02:30:47 UTC (rev 50)
+++ pkg/yuima/man/setSampling.Rd 2009-12-24 07:38:56 UTC (rev 51)
@@ -10,7 +10,7 @@
\usage{
setSampling(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" )
+ sgrid=as.numeric(NULL), interpolation="pt" )
}
\arguments{
\item{Initial}{Initial time of the grid.}
@@ -22,7 +22,7 @@
\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.}
+ By default, the previous tick interpolation. See Details.}
}
\details{
The function creates an object of type
Modified: pkg/yuima/man/subsampling.Rd
===================================================================
--- pkg/yuima/man/subsampling.Rd 2009-12-24 02:30:47 UTC (rev 50)
+++ pkg/yuima/man/subsampling.Rd 2009-12-24 07:38:56 UTC (rev 51)
@@ -5,7 +5,7 @@
\usage{
subsampling(x, sampling=NULL, Initial, Terminal, delta,
grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
- sgrid=as.numeric(NULL), interpolation="none")
+ sgrid=as.numeric(NULL), interpolation="pt")
}
\arguments{
\item{x}{an \code{\link{yuima-class}} or
@@ -19,11 +19,28 @@
\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.}
+ By default, previous tick interpolation is used. See Details.}
}
\value{
\item{yuima}{a \code{yuima.data-class} object.}
}
+\details{
+When subsampling on some grid of times, it may happen that no data is available
+at the given grid point. In this case it is possible to use several techniques.
+Different options are avaiable specifying the argument, or the slot,
+\code{interpolation}:
+\describe{
+\item{\code{"none"} or \code{"exact"}}{no interpolation. If no data point exists
+at a given grid point, \code{NA} is returned in the subsampled data}
+\item{\code{"pt"} or \code{"previous"}}{the first data on the left of
+the grid point instant is used.}
+\item{\code{"nt"} or \code{"next"}}{the first data on the right of
+the grid point instant is used.}
+\item{\code{"lin"} or \code{"linear"}}{the average of the values of the first
+data on the left and the first data to the right of
+the grid point instant is used.}
+}
+}
\examples{
## Set a model
diff.coef.1 <- function(t, x1=0, x2) x2*(1+t)
@@ -44,13 +61,23 @@
plot(yuima.sim, plot.type="single")
## random sampling with exponential times
-
+## one random sequence per time series
newsamp <- setSampling(
random=list(rdist=c( function(x) rexp(x, rate=10),
- function(x) rexp(x, rate=20))))
+ function(x) rexp(x, rate=20))) )
newdata <- subsampling(yuima.sim, sampling=newsamp)
points(get.zoo.data(newdata)[[1]],col="red")
points(get.zoo.data(newdata)[[2]],col="green")
+
+
+plot(yuima.sim, plot.type="single")
+
+## deterministic subsampling with different
+## frequence for each time series
+newsamp <- setSampling(delta=c(0.1,0.2))
+newdata <- subsampling(yuima.sim, sampling=newsamp)
+points(get.zoo.data(newdata)[[1]],col="red")
+points(get.zoo.data(newdata)[[2]],col="green")
}
\author{The YUIMA Project Team}
\keyword{ts}
More information about the Yuima-commits
mailing list