[Yuima-commits] r50 - in pkg/yuima: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 24 03:30:47 CET 2009
Author: iacus
Date: 2009-12-24 03:30:47 +0100 (Thu, 24 Dec 2009)
New Revision: 50
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/R/subsampling.R
pkg/yuima/man/subsampling.Rd
pkg/yuima/man/yuima-class.Rd
pkg/yuima/man/yuima.data-class.Rd
Log:
added subsampling example
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2009-12-22 06:09:41 UTC (rev 49)
+++ pkg/yuima/DESCRIPTION 2009-12-24 02:30:47 UTC (rev 50)
@@ -1,8 +1,8 @@
Package: yuima
Type: Package
Title: The YUIMA Project package
-Version: 0.0.80
-Date: 2009-12-22
+Version: 0.0.81
+Date: 2009-12-24
Depends: methods, zoo
Author: YUIMA Project Team.
Maintainer: Stefano M. Iacus <stefano.iacus at R-project.org>
Modified: pkg/yuima/R/subsampling.R
===================================================================
--- pkg/yuima/R/subsampling.R 2009-12-22 06:09:41 UTC (rev 49)
+++ pkg/yuima/R/subsampling.R 2009-12-24 02:30:47 UTC (rev 50)
@@ -1,13 +1,76 @@
-## We have splitted the simulate function into blocks to allow for future
-## methods to be added. S.M.I. & A.B.
-## Interface to simulate() changed to match the S3 generic funciton in the
-## package stats
-## added an environment to let R find the proper values defined in the main
-## body of the function, which in turn calls different simulation methods
-## All new simulation methods should look into the yuimaEnv for local variables
-## when they need to "eval" R expressions
-##:: function simulate
-##:: solves SDE and returns result
-subsampling <- function(x,y) return(x)
+##:: function subsampling
+##:: takes any yuima object with data or a yuima.data object and
+##:: performs subsampling according to some method
+# poisson.random.sampling
+# returns sample of data using poisson sampling
+
+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")
+ 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,
+ Terminal = Terminal, delta = delta,
+ grid = grid, random = random, sdelta=sdelta,
+ sgrid=sgrid, interpolation=interpolation))
+)
+
+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"){
+
+ tmpsamp <- NULL
+ if(missing(sampling)){
+ tmpsamp <- setSampling(Initial = Initial, Terminal = Terminal,
+ delta = delta, grid = grid, random = random, sdelta=sdelta,
+ sgrid=sgrid, interpolation=interpolation)
+ } else {
+ tmpsamp <- sampling
+ }
+
+
+ Data <- get.zoo.data(x)
+ tmpgrid <- NULL
+
+# 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){
+ tmptime <- start(Data[[i]])
+ T <- end(Data[[i]])
+ while( sum( tmptime ) < T )
+ tmptime <- c(tmptime, r.gen[[i]](1))
+ tmpgrid[[i]] <- cumsum(tmptime)
+ if(tail(tmpgrid[[i]],1)>T)
+ tmpgrid[[i]] <- tmpgrid[[i]][-length(tmpgrid[[i]])]
+ }
+ }
+
+ otime <- vector(n.data, mode="list")
+
+ 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]])
+ }
+ return(x)
+ } ### end method
+)
+
+
Modified: pkg/yuima/man/subsampling.Rd
===================================================================
--- pkg/yuima/man/subsampling.Rd 2009-12-22 06:09:41 UTC (rev 49)
+++ pkg/yuima/man/subsampling.Rd 2009-12-24 02:30:47 UTC (rev 50)
@@ -1,19 +1,56 @@
\name{subsampling}
\alias{subsampling}
\title{subsampling }
-\description{subsampling }
+\description{subsampling}
\usage{
-subsampling(x,y)
+subsampling(x, sampling=NULL, Initial, Terminal, delta,
+ grid = as.numeric(NULL), random = FALSE, sdelta=as.numeric(NULL),
+ sgrid=as.numeric(NULL), interpolation="none")
}
\arguments{
\item{x}{an \code{\link{yuima-class}} or
\code{\link{yuima.model-class}} object.}
- \item{y}{initial value vector of state variables.}
- }
+ \item{sampling}{a \code{\link{yuima.sampling-class}} object.}
+ \item{Initial}{Initial time of the grid.}
+ \item{Terminal}{Terminal time of the grid.}
+ \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.}
+}
\value{
- \item{yuima}{a \code{yuima-class} object.}
+ \item{yuima}{a \code{yuima.data-class} object.}
}
+\examples{
+## Set a model
+diff.coef.1 <- function(t, x1=0, x2) x2*(1+t)
+diff.coef.2 <- function(t, x1, x2=0) x1*sqrt(1+t^2)
+cor.rho <- function(t, x1=0, x2=0) sqrt((1+cos(x1*x2))/2)
+diff.coef.matrix <- matrix(c("diff.coef.1(t,x1,x2)",
+"diff.coef.2(t,x1,x2)*cor.rho(t,x1,x2)", "",
+"diff.coef.2(t,x1,x2)*sqrt(1-cor.rho(t,x1,x2)^2)"),2,2)
+cor.mod <- setModel(drift=c("",""), diffusion=diff.coef.matrix,
+solve.variable=c("x1", "x2"), xinit=c(3,2))
+set.seed(111)
+
+## We first simulate the two dimensional diffusion model
+yuima.samp <- setSampling(Terminal=1, n=1200)
+yuima <- setYuima(model=cor.mod, sampling=yuima.samp)
+yuima.sim <- simulate(yuima)
+
+plot(yuima.sim, plot.type="single")
+
+## random sampling with exponential times
+
+newsamp <- setSampling(
+ random=list(rdist=c( function(x) rexp(x, rate=10),
+ 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")
+}
\author{The YUIMA Project Team}
-\note{This is curently an empty function. To be implemented soon.
-}
\keyword{ts}
Modified: pkg/yuima/man/yuima-class.Rd
===================================================================
--- pkg/yuima/man/yuima-class.Rd 2009-12-22 06:09:41 UTC (rev 49)
+++ pkg/yuima/man/yuima-class.Rd 2009-12-24 02:30:47 UTC (rev 50)
@@ -10,6 +10,7 @@
\alias{initialize,yuima-method}
\alias{simulate,yuima-method}
\alias{poisson.random.sampling,yuima-method}
+\alias{subsampling,yuima-method}
\alias{ql,yuima-method}
\alias{rql,yuima-method}
\alias{ml.ql,yuima-method}
Modified: pkg/yuima/man/yuima.data-class.Rd
===================================================================
--- pkg/yuima/man/yuima.data-class.Rd 2009-12-22 06:09:41 UTC (rev 49)
+++ pkg/yuima/man/yuima.data-class.Rd 2009-12-24 02:30:47 UTC (rev 50)
@@ -13,6 +13,7 @@
\alias{initialize,yuima.data-method}
%\alias{setSampling,yuima.data-method}
\alias{poisson.random.sampling,yuima.data-method}
+\alias{subsampling,yuima.data-method}
\title{Class "yuima.data" for the data slot of a "yuima" class object}
\description{
More information about the Yuima-commits
mailing list