[Yuima-commits] r502 - in pkg/yuima: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Oct 30 03:55:59 CET 2016
Author: lorenzo
Date: 2016-10-30 03:55:58 +0100 (Sun, 30 Oct 2016)
New Revision: 502
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/R/MM.COGARCH.R
pkg/yuima/R/simulate.R
pkg/yuima/R/yuima.data.R
Log:
Modified GMM and Simulate COGARCH
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2016-10-29 21:07:13 UTC (rev 501)
+++ pkg/yuima/DESCRIPTION 2016-10-30 02:55:58 UTC (rev 502)
@@ -1,7 +1,7 @@
Package: yuima
Type: Package
Title: The YUIMA Project Package for SDEs
-Version: 1.3.0
+Version: 1.3.1
Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature, mvtnorm
Imports: Rcpp (>= 0.12.1)
Author: YUIMA Project Team
Modified: pkg/yuima/R/MM.COGARCH.R
===================================================================
--- pkg/yuima/R/MM.COGARCH.R 2016-10-29 21:07:13 UTC (rev 501)
+++ pkg/yuima/R/MM.COGARCH.R 2016-10-30 02:55:58 UTC (rev 502)
@@ -231,7 +231,8 @@
# Data
assign("Data", as.matrix(onezoo(observ)[,1]), envir=env)
- assign("deltaData", n/index(observ at zoo.data[[1]])[n], envir=env)
+ #assign("deltaData", (n-1)/index(observ at zoo.data[[1]])[n], envir=env)
+ assign("deltaData", 1/yuima at sampling@delta, envir=env)
assign("time.obs",length(env$Data),envir=env)
@@ -255,7 +256,7 @@
assign("objFun",objFun, envir=env)
if(aggr.G==TRUE){
- if(floor(n/index(observ at zoo.data[[1]])[n])!=env$deltaData){
+ if(floor(env$deltaData)!=env$deltaData){
yuima.stop("the n/Terminal in sampling information is not an integer. equally.spaced=FALSE is recommended")
}
}
Modified: pkg/yuima/R/simulate.R
===================================================================
--- pkg/yuima/R/simulate.R 2016-10-29 21:07:13 UTC (rev 501)
+++ pkg/yuima/R/simulate.R 2016-10-30 02:55:58 UTC (rev 502)
@@ -489,6 +489,7 @@
Initial, Terminal, n, delta,
grid, random, sdelta,
sgrid, interpolation){
+
yuimaCogarch<-object
model<-yuimaCogarch at model
info<-model at info
@@ -498,28 +499,28 @@
}
if(method=="euler"||(method=="mixed" && model at measure.type=="code")){
- if(length(increment.L)==0){
- aux.Noise<-setModel(drift="0",
- diffusion="0",
- jump.coeff="1",
- measure=info at measure,
- measure.type=info at measure.type)
+ if(length(increment.L)==0){
+ aux.Noise<-setModel(drift="0",
+ diffusion="0",
+ jump.coeff="1",
+ measure=info at measure,
+ measure.type=info at measure.type)
- # aux.samp<-setSampling(Initial = samp at Initial, Terminal = samp at Terminal[1], n = samp at n[1], delta = samp at delta,
- # grid=samp at grid, random = samp at random, sdelta=samp at sdelta,
- # sgrid=samp at sgrid, interpolation=samp at interpolation )
+ # aux.samp<-setSampling(Initial = samp at Initial, Terminal = samp at Terminal[1], n = samp at n[1], delta = samp at delta,
+ # grid=samp at grid, random = samp at random, sdelta=samp at sdelta,
+ # sgrid=samp at sgrid, interpolation=samp at interpolation )
- aux.samp<-setSampling(Initial = samp at Initial,
- Terminal = samp at Terminal[1]+samp at delta,
- n = samp at n[1]+1)
- auxModel<-setYuima(model=aux.Noise, sampling= aux.samp)
+ aux.samp<-setSampling(Initial = samp at Initial,
+ Terminal = samp at Terminal[1],
+ n = samp at n[1])
+ auxModel<-setYuima(model=aux.Noise, sampling= aux.samp)
if(length(model at parameter@measure)==0){
aux.incr2<-aux.simulate(object=auxModel, nsim=nsim, seed=seed,
- space.discretized=space.discretized, increment.W=increment.W,
- increment.L=increment.L,
- hurst=0.5,methodfGn=methodfGn)
+ space.discretized=space.discretized, increment.W=increment.W,
+ increment.L=increment.L,
+ hurst=0.5,methodfGn=methodfGn)
}else{
aux.incr2<-aux.simulate(object=auxModel, nsim=nsim, seed=seed,
true.parameter = true.parameter[model at parameter@measure],
@@ -528,7 +529,7 @@
hurst=0.5,methodfGn=methodfGn)
}
increment<-diff(as.numeric(get.zoo.data(aux.incr2)[[1]]))
- } else{increment<-c(0,increment.L)}
+ } else{increment<-increment.L}
# Using the simulated increment for generating the quadratic variation
# As first step we compute it in a crude way. A more fine approach is based on
# the mpv function.
@@ -552,22 +553,22 @@
}
xinit <- as.expression(xinit) # force xinit to be an expression
if(method=="euler"){
-# result <- aux.simulate(object=yuimaCogarch, nsim=nsim, seed=seed, xinit=xinit,
-# true.parameter = true.parameter,
-# space.discretized = space.discretized,increment.W =incr.W,
-# increment.L=incr.L, method=method,
-# hurst=hurst,methodfGn=methodfGn,
-# sampling=sampling, subsampling=subsampling,
-# Initial=Initial, Terminal=Terminal, n=n, delta=delta,
-# grid=grid, random=random, sdelta=sdelta,
-# sgrid=sgrid, interpolation=interpolation)
+ # result <- aux.simulate(object=yuimaCogarch, nsim=nsim, seed=seed, xinit=xinit,
+ # true.parameter = true.parameter,
+ # space.discretized = space.discretized,increment.W =incr.W,
+ # increment.L=incr.L, method=method,
+ # hurst=hurst,methodfGn=methodfGn,
+ # sampling=sampling, subsampling=subsampling,
+ # Initial=Initial, Terminal=Terminal, n=n, delta=delta,
+ # grid=grid, random=random, sdelta=sdelta,
+ # sgrid=sgrid, interpolation=interpolation)
- Initial <- samp at Initial[1]
+
Terminal <- samp at Terminal[1]
+ Initial <- samp at Initial[1]
n <- samp at n[1]
- #Delta <- Terminal/n
- Delta <- samp at delta
+ Delta <- (Terminal-Initial)/n
name.ar <- paste0(info at ar.par,c(1:info at q))
name.ma <- paste0(info at ma.par,c(1:info at p))
name.loc <- info at loc.par
@@ -582,7 +583,7 @@
evect[info at q,] <- 1
avect[c(1,info at p),1] <- value.ma
Indent<-diag(info at q)
- # Inputs: incr.L
+ # Inputs: incr.L
tavect<-t(avect)
ncolsim <- (info at q+2)
@@ -593,46 +594,40 @@
true.parameter <- vector(par.len, mode="list")
for(i in 1:par.len)
true.parameter[[i]] <- 0
- names(true.parameter) <- model at parameter@all
- }
+ names(true.parameter) <- model at parameter@all
+ }
- yuimaEnv <- new.env()
+ yuimaEnv <- new.env()
- if(par.len>0){
- for(i in 1:par.len){
- pars <- model at parameter@all[i]
- for(j in 1:length(true.parameter)){
- if( is.na(match(pars, names(true.parameter)[j]))!=TRUE){
- assign(model at parameter@all[i], true.parameter[[j]], yuimaEnv)
- }
+ if(par.len>0){
+ for(i in 1:par.len){
+ pars <- model at parameter@all[i]
+ for(j in 1:length(true.parameter)){
+ if( is.na(match(pars, names(true.parameter)[j]))!=TRUE){
+ assign(model at parameter@all[i], true.parameter[[j]], yuimaEnv)
}
- #assign(sdeModel at parameter@all[i], true.parameter[[i]], yuimaEnv)
}
+ #assign(sdeModel at parameter@all[i], true.parameter[[i]], yuimaEnv)
}
+ }
- for(i in c(1:ncolsim)){
- sim[1,i] <- eval(xinit[i], yuimaEnv)
- }
+ for(i in c(1:ncolsim)){
+ sim[1,i] <- eval(xinit[i], yuimaEnv)
+ }
- for(t in c(2:(n+1))){
- #sim[t,3:ncolsim] <- value.a0*expm(AMatrix*Delta)%*%evect*incr.L[2,t-1]+
- # expm(AMatrix*Delta)%*%(Indent+evect%*%tavect*incr.L[2,t-1])%*%sim[t-1,3:ncolsim]
- # sim[t,2]<-value.a0+tavect%*%sim[t,3:ncolsim]
- # sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
- # sim[t,3:ncolsim]<-expm(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+expm(AMatrix)%*%evect*sim[t-1,2]*incr.L[2,t]
- sim[t,2]<-value.a0+tavect%*%sim[t-1,3:ncolsim]
- sim[t,3:ncolsim]<-sim[t-1,3:ncolsim]+(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+evect*sim[t-1,2]*incr.L[2,t]
- sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
- }
- # t<-t+1
- # sim[t,2]<-value.a0+tavect%*%sim[t-1,3:ncolsim]
- # sim[t,3:ncolsim]<-sim[t-1,3:ncolsim]+(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+evect*sim[t-1,2]*incr.L[2,t]
- # sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
- # X <- ts(sim[-(samp at n[1]+1),])
- # X <- sim[-(samp at n[1]+1),]
- X<-zoo(x=sim, order.by=samp at grid[[1]])
- Data <- setData(X)
- result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=samp)
+ for(t in c(2:n)){
+ #sim[t,3:ncolsim] <- value.a0*expm(AMatrix*Delta)%*%evect*incr.L[2,t-1]+
+ # expm(AMatrix*Delta)%*%(Indent+evect%*%tavect*incr.L[2,t-1])%*%sim[t-1,3:ncolsim]
+ # sim[t,2]<-value.a0+tavect%*%sim[t,3:ncolsim]
+ # sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
+ # sim[t,3:ncolsim]<-expm(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+expm(AMatrix)%*%evect*sim[t-1,2]*incr.L[2,t]
+ sim[t,2]<-value.a0+tavect%*%sim[t-1,3:ncolsim]
+ sim[t,3:ncolsim]<-sim[t-1,3:ncolsim]+(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+evect*sim[t-1,2]*incr.L[2,t]
+ sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
+ }
+ X <- ts(sim[-(samp at n[1]+1),])
+ Data <- setData(X,delta = Delta,t0=Initial)
+ result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=yuimaCogarch at sampling)
@@ -645,10 +640,10 @@
}else{
- Initial <- samp at Initial[1]
Terminal <- samp at Terminal[1]
+ Initial <- samp at Initial[1]
n <- samp at n[1]
- Delta <- samp at delta
+ Delta <- (Terminal-Initial)/n
name.ar <- paste0(info at ar.par,c(1:info at q))
name.ma <- paste0(info at ma.par,c(1:info at p))
name.loc <- info at loc.par
@@ -696,30 +691,27 @@
}
if(yuimaCogarch at model@measure.type=="code"){
- for(t in c(2:(n+1))){
+ for(t in c(2:n)){
-# sim[t,2]<-value.a0+tavect%*%sim[t,3:ncolsim]
-# sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
-# sim[t,3:ncolsim]<-expm(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+expm(AMatrix)%*%evect*sim[t-1,2]*incr.L[2,t]
-# sim[t,3:ncolsim]<-sim[t-1,3:ncolsim]+AMatrix*Delta%*%sim[t-1,3:ncolsim]+evect*sim[t-1,2]*incr.L[2,t-1]
+ # sim[t,2]<-value.a0+tavect%*%sim[t,3:ncolsim]
+ # sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
+ # sim[t,3:ncolsim]<-expm(AMatrix*Delta)%*%sim[t-1,3:ncolsim]+expm(AMatrix)%*%evect*sim[t-1,2]*incr.L[2,t]
+ # sim[t,3:ncolsim]<-sim[t-1,3:ncolsim]+AMatrix*Delta%*%sim[t-1,3:ncolsim]+evect*sim[t-1,2]*incr.L[2,t-1]
sim[t,2]<-value.a0+tavect%*%sim[t-1,3:ncolsim]
sim[t,3:ncolsim] <- value.a0*expm(AMatrix*Delta)%*%evect*incr.L[2,t]+
expm(AMatrix*Delta)%*%(Indent+evect%*%tavect*incr.L[2,t])%*%sim[t-1,3:ncolsim]
sim[t,1]<-sim[t-1,1]+sqrt(sim[t,2])*incr.L[1,t]
}
- X<-zoo(x=sim, order.by=samp at grid[[1]])
- Data <- setData(X)
- result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=samp)
-
- # Data <- setData(X,delta = Delta)
- # result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=yuimaCogarch at sampling)
- # return(result)
+ X <- ts(sim[-(samp at n[1]+1),])
+ Data <- setData(X,delta = Delta, t0=Initial)
+ result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=yuimaCogarch at sampling)
+ return(result)
}else{
- lambda <- eval(model at measure$intensity, yuimaEnv)
+ lambda <- eval(model at measure$intensity, yuimaEnv)
- #Simulating jump times
+ #Simulating jump times
#intensity <- lambda*Delta
intensity<-lambda
jump_time<-numeric()
@@ -729,15 +721,15 @@
Time[1] <- jump_time[1]
j <- 1
numb_jum<-numeric()
-# for (i in c(1:n) ){
-# numb_jum[i]<-0
-# while(Time[j]<i){
-# numb_jum[i]<-numb_jum[i]+1
-# jump_time[j+1]<-rexp(1,rate=intensity)
-# Time[j+1]<-Time[j]+jump_time[j+1]
-# j<-j+1
-# }
-# }
+ # for (i in c(1:n) ){
+ # numb_jum[i]<-0
+ # while(Time[j]<i){
+ # numb_jum[i]<-numb_jum[i]+1
+ # jump_time[j+1]<-rexp(1,rate=intensity)
+ # Time[j+1]<-Time[j]+jump_time[j+1]
+ # j<-j+1
+ # }
+ # }
while(Time[j] < (Terminal-Initial)){
jump_time[j+1]<-rexp(1,rate=intensity)
@@ -747,21 +739,21 @@
total_NumbJ <- j
# Counting the number of jumps
-# N<-matrix(1,n,1)
-# N[1,1]<-numb_jum[1]
-# for(i in c(2:n)){
-# N[i,1]=N[i-1,1]+numb_jum[i]
-# }
+ # N<-matrix(1,n,1)
+ # N[1,1]<-numb_jum[1]
+ # for(i in c(2:n)){
+ # N[i,1]=N[i-1,1]+numb_jum[i]
+ # }
# Simulating the driving process
F <- suppressWarnings(parse(text=gsub("^d(.+?)\\(.+?,", "r\\1(total_NumbJ,", model at measure$df$expr, perl=TRUE)))
assign("total_NumbJ",total_NumbJ, envir=yuimaEnv)
dL<-eval(F, envir=yuimaEnv)
#dL<-rnorm(total_NumbJ,mean=0,sd=1)
-# L<-matrix(1,total_NumbJ,1)
-# L[1]<-dL[1]
-# for(j in c(2:total_NumbJ)){
-# L[j]<-L[j-1] + dL[j]
-# }
+ # L<-matrix(1,total_NumbJ,1)
+ # L[1]<-dL[1]
+ # for(j in c(2:total_NumbJ)){
+ # L[j]<-L[j-1] + dL[j]
+ # }
# Computing the processes V and Y at jump
V<-matrix(1,total_NumbJ,1)
Y<-matrix(1,info at q,total_NumbJ)
@@ -775,56 +767,53 @@
Y[,j]<-as.numeric(expm(AMatrix*jump_time[j])%*%Y[,j-1])+(V[j-1,])*evect*dL[j]^2
V[j,]<-value.a0+sum(tavect*Y[,j])
# }
-# # Computing the process G at jump time
-#
-# for(j in c(2:total_NumbJ)){
+ # # Computing the process G at jump time
+ #
+ # for(j in c(2:total_NumbJ)){
G[j]<-G[j-1]+sqrt(V[j-1])*dL[j]
}
- res<-approx(x=c(Initial,(Time+Initial)), y = c(0,G),
- xout=seq(Initial,Terminal, by=Delta),
- method = "constant")
- sim[,1]<-res$y
- i<-1
- for(j in 1:length(Time)){
- while (i*Delta < Time[j] && i <= n){
- sim[i+1,3:ncolsim]<-expm(AMatrix*(Time[j]-i*Delta))%*%Y[,j]
- sim[i+1,2]<-value.a0+as.numeric(tavect%*%sim[i,3:ncolsim])
- i<-i+1
+ res<-approx(x=c(0,Time), y = c(0,G),
+ xout=seq(0,(Terminal-Initial), by=(Terminal-Initial)/n),
+ method = "constant")
+ sim[,1]<-res$y
+ i<-1
+ for(j in 1:length(Time)){
+ while (i*Delta < Time[j] && i <= n){
+ sim[i+1,3:ncolsim]<-expm(AMatrix*(Time[j]-i*Delta))%*%Y[,j]
+ sim[i+1,2]<-value.a0+as.numeric(tavect%*%sim[i,3:ncolsim])
+ i<-i+1
- }
}
+ }
-# # Realizations observed at integer times
-# i<-1
-# while(N[i]==0){
-# i <- i+1
-# }
-# # G_obs<-numeric()
-# # L_obs<-numeric()
-# # V_obs<-numeric()
-# # Y_obs<-matrix(0,info at q,)
-# sim[c(1:(i-1)),1]<-0
-# sim[c(i:n),1]<-G[N[c(i:n)]]
-# # L_obs[c(1:(i-1))]<-0
-# # L_obs[c(i:n)]<-L[N[c(i:n)]]
-# for(j in c(1:(i-1))){
-# sim[j,3:ncolsim]<-as.numeric(Y[,j])
-# sim[j,2]<-value.a0+tavect%*%expm(AMatrix*j)%*%matrix(1,info at q,1)#Starting point for unobservable State Space Process
-# }
-# for(j in c(i:n)){
-# sim[j,3:ncolsim]<-as.numeric(Y[,N[j]])
-# sim[j,2]<-value.a0+as.numeric(tavect%*%expm(AMatrix*(j-Time[N[j]]))%*%Y[,N[j]])
-# }
+ # # Realizations observed at integer times
+ # i<-1
+ # while(N[i]==0){
+ # i <- i+1
+ # }
+ # # G_obs<-numeric()
+ # # L_obs<-numeric()
+ # # V_obs<-numeric()
+ # # Y_obs<-matrix(0,info at q,)
+ # sim[c(1:(i-1)),1]<-0
+ # sim[c(i:n),1]<-G[N[c(i:n)]]
+ # # L_obs[c(1:(i-1))]<-0
+ # # L_obs[c(i:n)]<-L[N[c(i:n)]]
+ # for(j in c(1:(i-1))){
+ # sim[j,3:ncolsim]<-as.numeric(Y[,j])
+ # sim[j,2]<-value.a0+tavect%*%expm(AMatrix*j)%*%matrix(1,info at q,1)#Starting point for unobservable State Space Process
+ # }
+ # for(j in c(i:n)){
+ # sim[j,3:ncolsim]<-as.numeric(Y[,N[j]])
+ # sim[j,2]<-value.a0+as.numeric(tavect%*%expm(AMatrix*(j-Time[N[j]]))%*%Y[,N[j]])
+ # }
}
- X<-zoo(x=sim, order.by=samp at grid[[1]])
- Data <- setData(X)
- result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=samp)
- # X <- ts(sim[-1,])
- # Data <- setData(X,delta = Delta)
- # result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=yuimaCogarch at sampling)
+ X <- ts(sim[-1,])
+ Data <- setData(X,delta = Delta, t0 = Initial)
+ result <- setYuima(data=Data,model=yuimaCogarch at model, sampling=yuimaCogarch at sampling)
}
if(missing(subsampling))
return(result)
Modified: pkg/yuima/R/yuima.data.R
===================================================================
--- pkg/yuima/R/yuima.data.R 2016-10-29 21:07:13 UTC (rev 501)
+++ pkg/yuima/R/yuima.data.R 2016-10-30 02:55:58 UTC (rev 502)
@@ -1,207 +1,209 @@
-##Constructor and Initializer of class 'yuima.data'
-
-# we convert objects to "zoo" internally
-
-
-setMethod("initialize", "yuima.data",
- function(.Object, original.data, delta=NULL, t0=0){
- .Object at original.data <- original.data
- if(is.list(original.data) && is.zoo(original.data[[1]])) {
- .Object at zoo.data <- original.data
- } else {
- .Object at zoo.data <- as.list(as.zoo(.Object at original.data))
- }
- if(!is.null(delta)){
- delta <- rep(delta, length(.Object at zoo.data))
- for(i in 1:length(.Object at zoo.data)){
- n <- length(.Object at zoo.data[[i]])
- t <- t0 + (0:(n-1))*delta[i]
- index(.Object at zoo.data[[i]]) <- t
- }
- }
- return(.Object)
- })
-
-# utils
-onezoo <- function(ydata) {
- dat <- get.zoo.data(ydata)
- dats <- dat[[1]]
- if(length(dat)>1) {
- for(i in 2:(length(dat))) {
- dats <- merge(dats,dat[[i]])
- }
- }
-
- if(!is.null(dim(dats))){
- if(class(ydata)=="yuima")
- colnames(dats) <- colnames(ydata at data@original.data)
- if(class(ydata)=="yuima.data")
- colnames(dats) <- colnames(ydata at original.data)
-
-
- }
-
- return(dats)
-}
-
-# accessors
-setData <-
- function(original.data, delta=NULL, t0=0){
- return(new("yuima.data", original.data=original.data, delta=delta, t0=t0 ))
- }
-
-
-setGeneric("get.zoo.data",
- function(x)
- standardGeneric("get.zoo.data")
- )
-
-setMethod("get.zoo.data", signature(x="yuima.data"),
- function(x){
- return(x at zoo.data)
- })
-
-# following funcs are basic generic funcs
-
-setGeneric("plot",
- function(x,y,...)
- standardGeneric("plot")
- )
-
-
-setMethod("plot",signature(x="yuima.data"),
- function(x,y,main="",xlab="index",ylab=names(x at zoo.data),...){
- plot(onezoo(x),main=main,xlab=xlab,ylab=ylab,...)
- }
- )
-
-#setGeneric("time",
-# function(x,...)
-# standardGeneric("time")
-# )
-
-#setMethod("time", signature(x="yuima.data"),
-# function(x,...){
-# return(time(x at zoo.data))
-# })
-
-
-#setGeneric("end",
-# def = function(x,...) standardGeneric("end")
-# )
-
-#setMethod("end", signature(x="yuima.data"),
-# function(x,...){
-# return(end(x at zoo.data))
-# })
-
-#setGeneric("start",
-# function(x,...)
-# standardGeneric("start")
-# )
-
-#setMethod("start", signature(x="yuima.data"),
-# function(x,...){
-# return(start(x at zoo.data))
-# })
-
-# length is primitive, so no standardGeneric should be defined
-
-
-setMethod("length", signature(x= "yuima.data"),
- function(x){
- # if(is.null(dim(x at zoo.data)))
- # return(length(x at zoo.data))
- # else
- # return(dim(x at zoo.data)[1])
- result <- numeric()
- for(i in 1:(length(x at zoo.data))) result <- c(result,length(x at zoo.data[[i]]))
- return(result)
- }
- )
-
-setMethod("dim", signature(x = "yuima.data"),
- function(x){
- return(length(x at zoo.data))
- }
- )
-
-
-# same methods for 'yuima'. Depend on same methods for 'data'
-setMethod("get.zoo.data", "yuima",
- function(x){
- return(get.zoo.data(x at data))
- })
-setMethod("length", "yuima",
- function(x){
- return(length(x at data))
- })
-setMethod("dim", "yuima",
- function(x){
- return(dim(x at data))
- })
-
-
-setMethod("plot","yuima",
- function(x,y,xlab=x at model@time.variable,ylab=x at model@solve.variable,...){
- if(length(x at model@time.variable)==0) {
- plot(x at data,...)
- } else {
- plot(x at data,xlab=xlab,ylab=ylab,...)
- }
- })
-
-
-##:: yuima.data obj cbind ( implementation 08/18 )
-setGeneric("cbind.yuima",
- function(x, ...)
- standardGeneric("cbind.yuima")
- )
-
-setMethod("cbind.yuima", signature(x="yuima"),
- function(x, ...){
- ##:: init
- y.list <- list(x, ...)
- y.num <- length(y.list)
-
- ##:: bind yuima.data in yuima
- yd.tmp <- y.list[[1]]@data
- for(idx in 2:y.num){
- ##:: error check
- if( class(y.list[[idx]])!="yuima"){
- stop("arg ", idx, " is not yuima-class")
- }
- ##:: bind
- yd.tmp <- cbind.yuima(yd.tmp, y.list[[idx]]@data)
- }
-
- ##:: substitute yuima.data
- x at data <- yd.tmp
-
- ##:: return result
- return(x)
- }
- )
-
-setMethod("cbind.yuima", signature(x="yuima.data"),
- function(x, ...){
- ##:: init
- yd.list <- list(x, ...)
- yd.num <- length(yd.list)
-
- ##:: bind yuima.data (original.data)
- od.tmp <- yd.list[[1]]@original.data
- for(idx in 2:yd.num){
- ##:: error check
- if( class(yd.list[[idx]])!="yuima.data" ){
- stop("arg ", idx, " is not yuima.data-class.")
- }
- ##:: bind
- od.tmp <- cbind(od.tmp, yd.list[[idx]]@original.data)
- }
- ##:: return result
- return(new("yuima.data", original.data=od.tmp))
- }
- )
-
-##:: END ( yuima.data obj cbind )
+##Constructor and Initializer of class 'yuima.data'
+
+# we convert objects to "zoo" internally
+
+
+setMethod("initialize", "yuima.data",
+ function(.Object, original.data, delta=NULL, t0=0){
+ .Object at original.data <- original.data
+ if(is.list(original.data) && is.zoo(original.data[[1]])) {
+ .Object at zoo.data <- original.data
+ } else {
+ .Object at zoo.data <- as.list(as.zoo(.Object at original.data))
+ }
+ if(!is.null(delta)){
+ delta <- rep(delta, length(.Object at zoo.data))
+ for(i in 1:length(.Object at zoo.data)){
+ n <- length(.Object at zoo.data[[i]])
+ t <- t0 + (0:(n-1))*delta[i]
+ # t<-seq(0, n*delta[i], length=n)+t0
+ ## L.M. Using this mod we get the same result on JSS
+ index(.Object at zoo.data[[i]]) <- t
+ }
+ }
+ return(.Object)
+ })
+
+# utils
+onezoo <- function(ydata) {
+ dat <- get.zoo.data(ydata)
+ dats <- dat[[1]]
+ if(length(dat)>1) {
+ for(i in 2:(length(dat))) {
+ dats <- merge(dats,dat[[i]])
+ }
+ }
+
+ if(!is.null(dim(dats))){
+ if(class(ydata)=="yuima")
+ colnames(dats) <- colnames(ydata at data@original.data)
+ if(class(ydata)=="yuima.data")
+ colnames(dats) <- colnames(ydata at original.data)
+
+
+ }
+
+ return(dats)
+}
+
+# accessors
+setData <-
+ function(original.data, delta=NULL, t0=0){
+ return(new("yuima.data", original.data=original.data, delta=delta, t0=t0 ))
+ }
+
+
+setGeneric("get.zoo.data",
+ function(x)
+ standardGeneric("get.zoo.data")
+ )
+
+setMethod("get.zoo.data", signature(x="yuima.data"),
+ function(x){
+ return(x at zoo.data)
+ })
+
+# following funcs are basic generic funcs
+
+setGeneric("plot",
+ function(x,y,...)
+ standardGeneric("plot")
+ )
+
+
+setMethod("plot",signature(x="yuima.data"),
+ function(x,y,main="",xlab="index",ylab=names(x at zoo.data),...){
+ plot(onezoo(x),main=main,xlab=xlab,ylab=ylab,...)
+ }
+ )
+
+#setGeneric("time",
+# function(x,...)
+# standardGeneric("time")
+# )
+
+#setMethod("time", signature(x="yuima.data"),
+# function(x,...){
+# return(time(x at zoo.data))
+# })
+
+
+#setGeneric("end",
+# def = function(x,...) standardGeneric("end")
+# )
+
+#setMethod("end", signature(x="yuima.data"),
+# function(x,...){
+# return(end(x at zoo.data))
+# })
+
+#setGeneric("start",
+# function(x,...)
+# standardGeneric("start")
+# )
+
+#setMethod("start", signature(x="yuima.data"),
+# function(x,...){
+# return(start(x at zoo.data))
+# })
+
+# length is primitive, so no standardGeneric should be defined
+
+
+setMethod("length", signature(x= "yuima.data"),
+ function(x){
+ # if(is.null(dim(x at zoo.data)))
+ # return(length(x at zoo.data))
+ # else
+ # return(dim(x at zoo.data)[1])
+ result <- numeric()
+ for(i in 1:(length(x at zoo.data))) result <- c(result,length(x at zoo.data[[i]]))
+ return(result)
+ }
+ )
+
+setMethod("dim", signature(x = "yuima.data"),
+ function(x){
+ return(length(x at zoo.data))
+ }
+ )
+
+
+# same methods for 'yuima'. Depend on same methods for 'data'
+setMethod("get.zoo.data", "yuima",
+ function(x){
+ return(get.zoo.data(x at data))
+ })
+setMethod("length", "yuima",
+ function(x){
+ return(length(x at data))
+ })
+setMethod("dim", "yuima",
+ function(x){
+ return(dim(x at data))
+ })
+
+
+setMethod("plot","yuima",
+ function(x,y,xlab=x at model@time.variable,ylab=x at model@solve.variable,...){
+ if(length(x at model@time.variable)==0) {
+ plot(x at data,...)
+ } else {
+ plot(x at data,xlab=xlab,ylab=ylab,...)
+ }
+ })
+
+
+##:: yuima.data obj cbind ( implementation 08/18 )
+setGeneric("cbind.yuima",
+ function(x, ...)
+ standardGeneric("cbind.yuima")
+ )
+
+setMethod("cbind.yuima", signature(x="yuima"),
+ function(x, ...){
+ ##:: init
+ y.list <- list(x, ...)
+ y.num <- length(y.list)
+
+ ##:: bind yuima.data in yuima
+ yd.tmp <- y.list[[1]]@data
+ for(idx in 2:y.num){
+ ##:: error check
+ if( class(y.list[[idx]])!="yuima"){
+ stop("arg ", idx, " is not yuima-class")
+ }
+ ##:: bind
+ yd.tmp <- cbind.yuima(yd.tmp, y.list[[idx]]@data)
+ }
+
+ ##:: substitute yuima.data
+ x at data <- yd.tmp
+
+ ##:: return result
+ return(x)
+ }
+ )
+
+setMethod("cbind.yuima", signature(x="yuima.data"),
+ function(x, ...){
+ ##:: init
+ yd.list <- list(x, ...)
+ yd.num <- length(yd.list)
+
+ ##:: bind yuima.data (original.data)
+ od.tmp <- yd.list[[1]]@original.data
+ for(idx in 2:yd.num){
+ ##:: error check
+ if( class(yd.list[[idx]])!="yuima.data" ){
+ stop("arg ", idx, " is not yuima.data-class.")
+ }
+ ##:: bind
+ od.tmp <- cbind(od.tmp, yd.list[[idx]]@original.data)
+ }
+ ##:: return result
+ return(new("yuima.data", original.data=od.tmp))
+ }
+ )
+
+##:: END ( yuima.data obj cbind )
More information about the Yuima-commits
mailing list