[Yuima-commits] r263 - in pkg/yuima: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 27 11:22:18 CET 2013
Author: iacus
Date: 2013-11-27 11:22:17 +0100 (Wed, 27 Nov 2013)
New Revision: 263
Added:
pkg/yuima/man/carma.info-class.Rd
pkg/yuima/man/yuima.carma-class.Rd
Modified:
pkg/yuima/NAMESPACE
pkg/yuima/R/AllClasses.R
pkg/yuima/R/setCarma.R
pkg/yuima/R/toLatex.R
pkg/yuima/R/yuima.R
pkg/yuima/R/yuima.model.R
pkg/yuima/man/setCarma.Rd
pkg/yuima/man/simulate.Rd
pkg/yuima/man/toLatex.Rd
Log:
update to support carma
Modified: pkg/yuima/NAMESPACE
===================================================================
--- pkg/yuima/NAMESPACE 2013-11-22 02:03:34 UTC (rev 262)
+++ pkg/yuima/NAMESPACE 2013-11-27 10:22:17 UTC (rev 263)
@@ -18,7 +18,9 @@
"yuima.sampling",
"yuima.characteristic",
"yuima.model",
- "model.parameter"
+ "model.parameter",
+ "yuima.carma",
+ "carma.info"
)
exportMethods(
@@ -119,6 +121,7 @@
S3method(toLatex, yuima)
S3method(toLatex, yuima.model)
+S3method(toLatex, yuima.carma)
useDynLib(yuima)
Modified: pkg/yuima/R/AllClasses.R
===================================================================
--- pkg/yuima/R/AllClasses.R 2013-11-22 02:03:34 UTC (rev 262)
+++ pkg/yuima/R/AllClasses.R 2013-11-27 10:22:17 UTC (rev 263)
@@ -36,6 +36,27 @@
)
)
+# Class 'carma.info'
+setClass("carma.info",
+ representation(p="numeric",
+ q="numeric",
+ loc.par="character",
+ scale.par="character",
+ ar.par="character",
+ ma.par="character",
+ lin.par="character",
+ Carma.var="character",
+ Latent.var="character",
+ XinExpr="logical")
+ )
+
+# Class 'yuima.carma'
+
+setClass("yuima.carma",
+ representation(info="carma.info"),
+ contains="yuima.model")
+
+
# Class 'yuima.data'
# we want yuimaS4 to use any class of data as input
Modified: pkg/yuima/R/setCarma.R
===================================================================
--- pkg/yuima/R/setCarma.R 2013-11-22 02:03:34 UTC (rev 262)
+++ pkg/yuima/R/setCarma.R 2013-11-27 10:22:17 UTC (rev 263)
@@ -1,18 +1,80 @@
-# Carma_Model<-setClass("Carma_Model",
-# slots = c(Cogarch_Model_Log="logical",
-# Under_Lev="yuima.model"),
-# prototype=list(Cogarch_Model_Log = FALSE,
-# Under_Lev=NULL),
-# contains= "yuima")
-#ma.par, ar.par, lin.par=NULL is.null
-#state Variable consistente con Yuima.????
-# Inserire Solve Variable???
-# ... che mi serve per passare gli stessi parametri di setModel
-# per i ... guardare qmle
-# call<-matchcall()
-# mydots guardare
-setCarma<-function(p,q,loc.par=NULL,ar.par="beta",ma.par="alpha",lin.par=NULL,Carma.var="v",Latent.var="x", ...){
-# We use the same parametrization as in Brockwell[2000]
+setMethod("initialize", "carma.info",
+ function(.Object,
+ p=numeric(),
+ q=numeric(),
+ loc.par=character(),
+ scale.par=character(),
+ ar.par=character(),
+ ma.par=character(),
+ lin.par=character(),
+ Carma.var=character(),
+ Latent.var=character(),
+ XinExpr=logical()){
+ .Object at p <- p
+ .Object at q <- q
+ .Object at loc.par <- loc.par
+ .Object at scale.par <- scale.par
+ .Object at ar.par <- ar.par
+ .Object at ma.par <- ma.par
+ .Object at lin.par <- lin.par
+ .Object at Carma.var <- Carma.var
+ .Object at Latent.var <- Latent.var
+ .Object at XinExpr <- XinExpr
+ return(.Object)
+ })
+
+setMethod("initialize", "yuima.carma",
+ function(.Object,
+ info = new(carma.info),
+ drift = expression() ,
+ diffusion = list() ,
+ hurst = 0.5,
+ jump.coeff = expression(),
+ measure=list(),
+ measure.type=character(),
+ parameter = new("model.parameter"),
+ state.variable = "x",
+ jump.variable = "z",
+ time.variable = "t",
+ noise.number = numeric(),
+ equation.number = numeric(),
+ dimension = numeric(),
+ solve.variable = character(),
+ xinit = expression(),
+ J.flag = logical()){
+ .Object at info <- info
+ .Object at drift <- drift
+ .Object at diffusion <- diffusion
+ .Object at hurst <- hurst
+ .Object at jump.coeff <- jump.coeff
+ .Object at measure <- measure
+ .Object at measure.type <- measure.type
+ .Object at parameter <- parameter
+ .Object at state.variable <- state.variable
+ .Object at jump.variable <- jump.variable
+ .Object at time.variable <- time.variable
+ .Object at noise.number <- noise.number
+ .Object at equation.number <- equation.number
+ .Object at dimension <- dimension
+ .Object at solve.variable <- solve.variable
+ .Object at xinit <- xinit
+ .Object at J.flag <- J.flag
+ return(.Object)
+ })
+
+
+setCarma<-function(p,
+ q,
+ loc.par=NULL,
+ scale.par=NULL,
+ ar.par="a",
+ ma.par="b",
+ lin.par=NULL,
+ Carma.var="v",
+ Latent.var="x",
+ XinExpr=FALSE,
+ ...){
+# We use the same parametrization as in Brockwell (2000)
# mydots$Carma.var= V
# mydots$Latent.var= X ?????
@@ -25,7 +87,13 @@
# q is the number of the autoregressive coefficient \beta
#Default parameters
+ if (is.null(scale.par)){
+ ma.par1<-ma.par
+ } else{
+ ma.par1<-paste(scale.par,ma.par,sep="*")
+ }
+
call <- match.call()
quadratic_variation<-FALSE
@@ -40,6 +108,7 @@
# jump.variable <- "z"
# time.variable <- "t"
# mydots$xinit<- NULL
+
if (is.null(mydots$hurst)){
mydots$hurst<-0.5
}
@@ -51,24 +120,27 @@
if(is.null(mydots$jump.variable)){
mydots$jump.variable<-"z"
}
-
-# if(is.null(mydots$Carma.var)){
-# Carma.var<-"V"
+
+# if(is.null(mydots$xinit)){
+# if(is.null(mydots$XinExpr)){
+# mydots$xinit<-as.character(0*c(1:p))
+# }else{
+# if(mydots$XinExpr==TRUE){
+# Int.Var<-paste(Latent.var,"0",sep="")
+# mydots$xinit<-paste(Int.Var,c(0:(p-1)),sep="")
+# }
+# }
# } else{
-# Carma.var<-mydots$Carma.var
+# dummy<-as.character(mydots$xinit)
+# mydots$xinit<-dummy[-1]
# }
-# if(is.null(mydots$Latent.var)){
-# Latent.var<-"X"
-# } else{
-# Latent.var<-mydots$Latent.var
-# }
if(is.null(mydots$xinit)){
- if(is.null(mydots$XinExpr)){
+ if(XinExpr==FALSE){
mydots$xinit<-as.character(0*c(1:p))
}else{
- if(mydots$XinExpr==TRUE){
+ if(XinExpr==TRUE){
Int.Var<-paste(Latent.var,"0",sep="")
mydots$xinit<-paste(Int.Var,c(0:(p-1)),sep="")
}
@@ -84,20 +156,21 @@
beta_coeff0<-paste("-",ar.par,sep="")
beta_coeff<-paste(beta_coeff0,p:1,sep="")
- coeff_alpha<-c(paste(ma.par,0:q,sep=""),as.character(matrix(0,1,p-q-1)))
+ coeff_alpha<-c(paste(ma.par1,0:q,sep=""),as.character(matrix(0,1,p-q-1)))
fin_alp<-length(coeff_alpha)
- # We built the drift condition
Y_coeff<-paste(Latent.var,0:(p-1),sep="")
fin_Y<-length(Y_coeff)
V1<-paste(coeff_alpha,Y_coeff,sep="*")
V2<-paste(V1,collapse="+")
-# alpha0<-paste(ma.par,0,sep="")
+# alpha0<-paste(ma.par1,0,sep="")
+
if(is.null(loc.par)){
- V<-paste("(",V2,")",collapse="")
+ Vt<-V2
+ V<-paste0("(",V2,")",collapse="")
} else {
Vt<-paste(loc.par,V2,sep="+")
- V<-paste("(",Vt,")",collapse="")
+ V<-paste0("(",Vt,")",collapse="")
}
drift_last_cond<-paste(paste(beta_coeff,Y_coeff,sep="*"),collapse="")
# Drift condition for the dV_{t}
@@ -119,28 +192,41 @@
if (is.null(lin.par)){
diffusion_Carma<-matrix(c(coeff_alpha[fin_alp],as.character(matrix(0,(p-1),1)),"1"),(p+1),1)
# Latent.var<-Y_coeff
- Model_Carma1<-setModel(drift=drift_Carma,
+ Model_Carma<-setModel(drift=drift_Carma,
diffusion=diffusion_Carma,
hurst=mydots$hurst,
state.variable=c(Carma.var,Y_coeff),
solve.variable=c(Carma.var,Y_coeff),
- xinit=c(V,mydots$xinit))
- if(length(Model_Carma1)==0){
+ xinit=c(Vt,mydots$xinit))
+ #25/11
+#
+# carma.info<-new("carma.info",
+# p=p,
+# q=q,
+# loc.par="character",
+# scale.par="character",
+# ar.par=ar.par,
+# ma.par=ma.par,
+# Carma.var=Carma.var,
+# Latent.var=Latent.var,
+# XinExpr=XinExpr)
+ if(length(Model_Carma)==0){
stop("Yuima model was not built")
} else {
- return(Model_Carma1)
+ # return(Model_Carma1)
}
} else{
if(ma.par==lin.par){
first_term<-paste(coeff_alpha[fin_alp],V,sep="*")
diffusion_Carma<-matrix(c(first_term,as.character(matrix(0,(p-1),1)),V),(p+1),1)
- Model_Carma1<-setModel(drift=drift_Carma,
+
+ Model_Carma<-setModel(drift=drift_Carma,
diffusion=diffusion_Carma,
hurst=mydots$hurst,
state.variable=c(Carma.var,Y_coeff),
solve.variable=c(Carma.var,Y_coeff),
- xinit=c(V,mydots$xinit))
- return(Model_Carma1)
+ xinit=c(Vt,mydots$xinit))
+# return(Model_Carma1)
}else{
# coeff_gamma<-c(paste(lin.par,1:p,sep=""),as.character(matrix(0,1,p-q)))
coeff_gamma<-c(paste(lin.par,1:p,sep=""))
@@ -152,14 +238,21 @@
first_term<-paste(coeff_alpha[fin_alp],Gamma,sep="*")
diffusion_Carma<-matrix(c(first_term,as.character(matrix(0,(p-1),1)),Gamma),(p+1),1)
- Model_Carma1<-setModel(drift=drift_Carma,
+# Model_Carma1<-setModel(drift=drift_Carma,
+# diffusion=diffusion_Carma,
+# hurst=mydots$hurst,
+# state.variable=c(Carma.var,Y_coeff),
+# solve.variable=c(Carma.var,Y_coeff),
+# xinit=c(V,mydots$xinit))
+
+ Model_Carma<-setModel(drift=drift_Carma,
diffusion=diffusion_Carma,
hurst=mydots$hurst,
state.variable=c(Carma.var,Y_coeff),
solve.variable=c(Carma.var,Y_coeff),
- xinit=c(V,mydots$xinit))
+ xinit=c(Vt,mydots$xinit))
- return(Model_Carma1)
+# return(Model_Carma1)
}
}
@@ -196,6 +289,18 @@
# jump_Carma<-matrix(c(coeff_alpha[fin_alp],as.character(matrix(0,(q-1),1)),"1"),(q+1),1)
jump_Carma<-c(coeff_alpha[fin_alp],as.character(matrix(0,(p-1),1)),"1")
+# Model_Carma<-setModel(drift=drift_Carma,
+# diffusion = NULL,
+# hurst=mydots$hurst,
+# jump.coeff=jump_Carma,
+# measure=eval(mydots$measure),
+# measure.type=mydots$measure.type,
+# jump.variable=mydots$jump.variable,
+# time.variable=mydots$time.variable,
+# state.variable=c(Carma.var,Y_coeff),
+# solve.variable=c(Carma.var,Y_coeff),
+# xinit=c(V,mydots$xinit))
+#
Model_Carma<-setModel(drift=drift_Carma,
diffusion = NULL,
hurst=mydots$hurst,
@@ -206,8 +311,8 @@
time.variable=mydots$time.variable,
state.variable=c(Carma.var,Y_coeff),
solve.variable=c(Carma.var,Y_coeff),
- xinit=c(V,mydots$xinit))
- return(Model_Carma)
+ xinit=c(Vt,mydots$xinit))
+ # return(Model_Carma)
} else {
if (quadratic_variation==FALSE ){
# Selecting Quadratic_Variation==FALSE and specifying the Heteroskedatic.param in the model,
@@ -258,8 +363,8 @@
time.variable=mydots$time.variable,
state.variable=c(Carma.var,Y_coeff),
solve.variable=c(Carma.var,Y_coeff),
- c(V,mydots$xinit))
- return(Model_Carma)
+ xinit=c(Vt,mydots$xinit))
+ # return(Model_Carma)
if(quadratic_variation==TRUE){
#
stop("Work in Progress: Implementation of CARMA model for CoGarch.
@@ -287,5 +392,44 @@
}
}
- }
+ }
+ # 25/11
+ if(is.null(loc.par)){loc.par<-character()}
+ if(is.null(scale.par)){scale.par<-character()}
+ if(is.null(lin.par)){lin.par<-character()}
+
+
+ carmainfo<-new("carma.info",
+ p=p,
+ q=q,
+ loc.par=loc.par,
+ scale.par=scale.par,
+ ar.par=ar.par,
+ ma.par=ma.par,
+ lin.par=lin.par,
+ Carma.var=Carma.var,
+ Latent.var=Latent.var,
+ XinExpr=XinExpr)
+
+ Model_Carma1<-new("yuima.carma",
+ info=carmainfo,
+ drift=Model_Carma at drift,
+ diffusion =Model_Carma at diffusion,
+ hurst=Model_Carma at hurst,
+ jump.coeff=Model_Carma at jump.coeff,
+ measure=Model_Carma at measure,
+ measure.type=Model_Carma at measure.type,
+ parameter=Model_Carma at parameter,
+ state.variable=Model_Carma at state.variable,
+ jump.variable=Model_Carma at jump.variable,
+ time.variable=Model_Carma at time.variable,
+ noise.number = Model_Carma at noise.number,
+ equation.number = Model_Carma at equation.number,
+ dimension = Model_Carma at dimension,
+ solve.variable=Model_Carma at solve.variable,
+ xinit=Model_Carma at xinit,
+ J.flag = Model_Carma at J.flag
+ )
+
+ return(Model_Carma1)
}
Modified: pkg/yuima/R/toLatex.R
===================================================================
--- pkg/yuima/R/toLatex.R 2013-11-22 02:03:34 UTC (rev 262)
+++ pkg/yuima/R/toLatex.R 2013-11-27 10:22:17 UTC (rev 263)
@@ -4,8 +4,170 @@
mod <- NULL
if (class(object) == "yuima.model")
mod <- object
+ if (class(object) == "yuima.carma")
+ mod <- object
if (class(object) == "yuima")
mod <- object at model
+ if(class(mod) =="yuima.carma" && length(mod at info@lin.par)==0 )
+ { yuima.warn("")
+ n.eq <- mod at equation.number
+ info <- mod at info
+ noise.var<-"W"
+ # We construc the system that describes the CARMA(p,q) process
+
+ if (!length(mod at jump.variable)==0){noise.var <- mod at jump.variable}
+ dr <- paste("\\left\\{\\begin{array}{l} \n")
+ main.con <- info at ma.par
+ if(length(info at loc.par)==0 && !length(info at scale.par)==0){
+ main.con<-paste(info at scale.par,"* \\ ", info at ma.par)
+ }
+
+ if(!length(info at loc.par)==0 && length(info at scale.par)==0){
+ main.con<-paste(info at scale.par,"* \\ ", info at ma.par)
+ }
+
+ if(!length(info at loc.par)==0 && !length(info at scale.par)==0){
+ main.con<-paste(info at loc.par,"+ \\ ",info at scale.par,"* \\ ", info at ma.par)
+ }
+
+ dr <- paste(dr, info at Carma.var,
+ "\\left(", sprintf("%s", mod at time.variable),"\\right) = ",main.con, "'" ,
+ info at Latent.var,"\\left(", sprintf("%s", mod at time.variable),"\\right) \\\\ \n")
+
+
+
+ dr <- paste(dr, sprintf("d%s", info at Latent.var),
+ "\\left(", sprintf("%s", mod at time.variable),"\\right)",
+ "=","A",info at Latent.var,
+ "\\left(", sprintf("%s", mod at time.variable),"\\right)",
+ sprintf("d%s", mod at time.variable),
+ "+ e",sprintf("d%s", noise.var),"\\left(",
+ mod at time.variable, "\\right) \\\\ \n")
+ dr<- paste(dr, "\\end{array}\\right.")
+ body <- paste("%%% Copy and paste the following output in your LaTeX file")
+ body <- c(body, paste("$$"))
+ body <- c(body, dr)
+ body <- c(body, paste("$$"))
+ # Vector Latent Variable.
+
+ body <- c(body, paste("$$"))
+ latent.lab0<-paste(info at Latent.var,0:(info at p-1),sep="_")
+ if(length(latent.lab0)==1){latent.lab<-latent.lab0}
+ if(length(latent.lab0)==2){
+ latent.lab0[1]<-paste(latent.lab0[1],"(",mod at time.variable,")",",\\ ",sep="")
+ latent.lab0[2]<-paste(latent.lab0[2],"(",mod at time.variable,")",sep="")
+ latent.lab<-latent.lab0
+ }
+ if(length(latent.lab0)>2){
+ latent.lab<-paste(latent.lab0[1],"(",mod at time.variable,")",
+ ",\\ ","\\ldots \\ ",
+ ",\\ ",tail(latent.lab0,n=1),
+ "(",mod at time.variable,")")
+ }
+ latent.lab<-paste(latent.lab,collapse="")
+ X<-paste(info at Latent.var,"(",mod at time.variable,")",
+ "=\\left[",latent.lab,
+ "\\right]'")
+ body <- c(body, X)
+ body <- c(body, paste("$$"))
+ # Vector Moving Average Coefficient.
+ body <- c(body, paste("$$"))
+
+ #b.nozeros <-c(0:info at q)
+
+ ma.lab0<-paste(paste(info at ma.par,0:(info at q),sep="_"),collapse=", \\ ")
+
+
+ if(length(ma.lab0)==1){ma.lab1<-ma.lab0}
+ if(length(ma.lab0)==2){
+ ma.lab0[1]<-paste(ma.lab0[1],",\\ ",sep="")
+ # ma.lab0[2]<-paste(ma.lab0[2],"(",mod at time.variable,")",sep="")
+ ma.lab1<-ma.lab0
+ }
+ if(length(ma.lab0)>2){
+ ma.lab1<-paste(ma.lab0[1],
+ ",\\ ","\\ldots",
+ " \\ , \\ ",tail(ma.lab0,n=1))
+ }
+
+
+ numb.zero<-(info at p-(info at q+1))
+ if (numb.zero==0){ma.lab <- ma.lab1}
+ if (numb.zero>0&&numb.zero<=2){
+ zeros<- 0*c(1:numb.zero)
+ zero.el <- paste(zeros, collapse=", \\ ")
+ ma.lab <- paste(ma.lab1," ,\\ ", zero.el)
+ }
+ if (numb.zero>2 ){
+ ma.lab <- paste(ma.lab1," ,\\ 0, \\ \\ldots \\ , \\ 0")
+ }
+ Vector.ma <- paste(info at ma.par,"=","\\left[",ma.lab,"\\right]'")
+ body <- c(body, Vector.ma)
+ body <- c(body, paste("$$"))
+
+ # e vector
+ body <- c(body, paste("$$"))
+
+ noise.coef<-mod at diffusion
+ vect.e0 <- substr(tail(noise.coef,n=1), 13, nchar(tail(noise.coef,n=1)) -2)
+ if (!length(mod at jump.variable)==0){
+ noise.coef <- mod at jump.coeff
+ vect.e0 <- substr(tail(noise.coef,n=1), 2, nchar(tail(noise.coef,n=1)) -1)
+ }
+
+ if (info at p==1){vect.e <- vect.e0}
+ if (info at p==2){vect.e <- paste("0, \\ ",vect.e0)}
+ if (info at p==3){vect.e <- paste("0, \\ 0, \\ ",vect.e0)}
+ if (info at p>3){vect.e <- paste("0, \\ \\ldots \\ , \\ 0, \\ ",vect.e0)}
+
+ coeff.e<- paste("e","=","\\left[", vect.e , "\\right]'")
+
+ body <- c(body, coeff.e)
+ body <- c(body, paste("$$"))
+ # Matrix A
+ body <- c(body, paste("$$"))
+
+ if(info at p==1){
+ cent.col<-"c"
+ last.A<-paste(paste(paste("",info at ar.par,sep=" -"),info at p:1,sep="_"),collapse=" &")
+ }
+
+ if(info at p==2){
+ cent.col<-"cc"
+ Up.A <-" 0 & 1 \\\\ \n"
+ last.A<-paste(paste(paste("",info at ar.par,sep=" -"),info at p:1,sep="_"),collapse=" &")
+ }
+
+ if(info at p==3){
+ cent.col<-"ccc"
+ Up.A <-" 0 & 1 & 0 \\\\ \n 0 & 0 & 1 \\\\ \n"
+ last.A<-paste(paste(paste("",info at ar.par,sep=" -"),info at p:1,sep="_"),collapse=" &")
+
+ }
+
+ if(info at p>3){
+ cent.col<-"cccc"
+ Up.A <-" 0 & 1 & \\ldots & 0 \\\\ \n \\vdots & \\vdots & \\ddots & \\vdots \\\\ \n 0 & 0 & \\ldots & 1 \\\\ \n"
+ dummy.ar<-paste(paste("",info at ar.par,sep=" -"),info at p:1,sep="_")
+ last.A <- paste(dummy.ar[1]," & ", dummy.ar[2]," & \\ldots &", tail(dummy.ar,n=1) )
+
+ }
+ matrix.A <-paste(Up.A ,last.A," \\\\ \n",sep="")
+
+ array.start<-paste0("\\begin{array}{",cent.col,"}\n",collapse="")
+ MATR.A<-paste("A ","=","\\left[",array.start, matrix.A, "\\end{array}\\right]'" )
+ body <- c(body, MATR.A)
+ body <- c(body, paste("$$"))
+ body <- structure(body, class = "Latex")
+
+ return(body)
+ mysymb <- c("*", "alpha", "beta", "gamma", "delta", "rho",
+ "theta","sigma","mu", "sqrt")
+ # myrepl <- c(" \\cdot ", "\\alpha ", "\\beta ", "\\gamma ",
+ # "\\delta ", "\\rho ", "\\theta ", "\\sqrt ")
+ myrepl <- c(" \\cdot ", "\\alpha ", "\\beta ", "\\gamma ",
+ "\\delta ", "\\rho ", "\\theta ","\\sigma","\\mu", "\\sqrt ")
+ } else{
n.eq <- mod at equation.number
dr <- paste("\\left(\\begin{array}{c}\n")
for (i in 1:n.eq) {
@@ -56,7 +218,7 @@
}
}
body <- paste("%%% Copy and paste the following output in your LaTeX file")
- body <- body <- c(body, paste("$$"))
+ body <- c(body, paste("$$"))
body <- c(body, paste(st))
body <- c(body, paste(" = "))
body <- c(body, paste(dr))
@@ -80,6 +242,7 @@
bodyaus <- paste(bodyaus, paste(paste(mod at solve.variable[i],"(0)",sep=""),substr(mod at xinit[i], 2, nchar(mod at xinit[i]) -
1),sep="="), "\\\\ \n")
}
+
bodyaus <- paste(bodyaus, "\\end{array}\\right)")
for (i in 1:ns) {
bodyaus <- gsub(mysymb[i], myrepl[i], bodyaus, fixed = "TRUE")
@@ -91,8 +254,11 @@
# mod at xinit)))
body <- c(body, paste("$$"))
structure(body, class = "Latex")
+ }
}
toLatex.yuima.model <- toLatex.yuima
+
+toLatex.yuima.carma <- toLatex.yuima
\ No newline at end of file
Modified: pkg/yuima/R/yuima.R
===================================================================
--- pkg/yuima/R/yuima.R 2013-11-22 02:03:34 UTC (rev 262)
+++ pkg/yuima/R/yuima.R 2013-11-27 10:22:17 UTC (rev 263)
@@ -1,72 +1,231 @@
-yuima.stop <- function(x)
-stop(sprintf("\nYUIMA: %s\n", x))
-
-yuima.warn <- function(x)
- warning(sprintf("\nYUIMA: %s\n", x))
-
-## Constructor and Initializer of class 'yuima'
-
-# we convert objects to "zoo" internally
-# we should change it later to more flexible classes
-
-setMethod("initialize", "yuima",
- function(.Object, data=NULL, model=NULL, sampling=NULL, characteristic=NULL, functional=NULL){
- eqn <- NULL
-
- if(!is.null(data)){
- .Object at data <- data
- eqn <- dim(data)
- }
-
- if(!is.null(model)){
- if(!is.null(eqn)){
- if(eqn!=model at equation.number){
- yuima.warn("Model's equation number missmatch.")
- return(NULL)
- }
- }else{
- eqn <- model at equation.number
- }
- .Object at model <- model
- }
-
- if(!is.null(sampling)){
- if(!is.null(eqn)){
- if(eqn!=length(sampling at Terminal)){
- if(length(sampling at Terminal)==1){
- sampling at Terminal <- rep(sampling at Terminal, eqn)
- sampling at n <- rep(sampling at n, eqn)
- }else{
- yuima.warn("Sampling's equation number missmatch.")
- return(NULL)
- }
- }
- }else{
- eqn <- length(sampling at Terminal)
- }
- .Object at sampling <- sampling
- }
-
- if(!is.null(characteristic)){
- if(!is.null(eqn)){
- if(eqn!=characteristic at equation.number){
- yuima.warn("Characteristic's equation number missmatch.")
- return(NULL)
- }
- }
- .Object at characteristic <- characteristic
- }else if(!is.null(eqn)){
- characteristic <- new("yuima.characteristic", equation.number=eqn, time.scale=1)
- .Object at characteristic <- characteristic
- }
-
- if(!is.null(functional)) .Object at functional <- functional
-
- return(.Object)
- })
-
-# setter
-setYuima <-
- function(data=NULL, model=NULL, sampling=NULL, characteristic=NULL, functional=NULL){
- return(new("yuima", data=data, model=model, sampling=sampling, characteristic=characteristic,functional=functional))
- }
+yuima.stop <- function(x)
+stop(sprintf("\nYUIMA: %s\n", x))
+
+yuima.warn <- function(x)
+ warning(sprintf("\nYUIMA: %s\n", x))
+
+# 22/11/2013
+# We introduce a new utility yuima.simplify that allows us to simplify
+# the expressions in the drift, diffusion and jump terms.
+
+# yuima.Simplify modified from the original code Simplify.R
+# by Andrew Clausen <clausen at econ.upenn.edu> in 2007.
+# http://economics.sas.upenn.edu/~clausen/computing/Simplify.R
+
+# This isn't a serious attempt at simplification code. It just does some
+# obvious things like 0 + x => x. It was written to support Deriv.R.
+
+yuima.Simplify<- function(expr)
+ as.expression(Simplify_(expr[[1]]))
+
+
+Simplify_ <- function(expr)
+{
+ if (is.symbol(expr)) {
+ expr
+ } else if (is.language(expr) && is.symbol(expr[[1]])) {
+ # is there a rule in the table?
+ sym.name <- as.character(expr[[1]])
+ if (class(try(Simplify.rule <-
+ get(sym.name, envir=simplifications,
+ inherits=FALSE), silent=TRUE))
+ != "try-error")
+ return(Simplify.rule(expr))
+ }
+ expr
+}
+
+Simplify.function <- function(f, x=names(formals(f)), env=parent.frame())
+{
+ stopifnot(is.function(f))
+ as.function(c(as.list(formals(f)),
+ Simplify_(body(f))),
+ envir=env)
+}
+
+`Simplify.+` <- function(expr)
+{
+ if (length(expr) == 2)
+ {
+ if (is.numeric(expr[[2]]))
+ return(+expr[[2]])
+ return(expr)
+ }
+
+ a <- Simplify_(expr[[2]])
+ b <- Simplify_(expr[[3]])
+
+ if (is.numeric(a) && all(a == 0)) {
+ b
+ } else if (is.numeric(b) && all(b == 0)) {
+ a
+ } else if (is.numeric(a) && is.numeric(b)) {
+ a + b
+ } else {
+ expr[[2]] <- a
+ expr[[3]] <- b
+ expr
+ }
+}
+
+`Simplify.-` <- function(expr)
+{
+ if (length(expr) == 2)
+ {
+ if (is.numeric(expr[[2]]))
+ return(-expr[[2]])
+ return(expr)
+ }
+
+ a <- Simplify_(expr[[2]])
+ b <- Simplify_(expr[[3]])
+
+ if (is.numeric(a) && all(a == 0)) {
+ -b
+ } else if (is.numeric(b) && all(b == 0)) {
+ a
+ } else if (is.numeric(a) && is.numeric(b)) {
+ a - b
+ } else {
+ expr[[2]] <- a
+ expr[[3]] <- b
+ expr
+ }
+}
+
+`Simplify.(` <- function(expr)
+ expr[[2]]
+
+`Simplify.*` <- function(expr)
+{
+ a <- Simplify_(expr[[2]])
+ b <- Simplify_(expr[[3]])
+
+ if (is.numeric(a) && all(a == 0)) {
+ 0
+ } else if (is.numeric(b) && all(b == 0)) {
+ 0
+ } else if (is.numeric(a) && all(a == 1)) {
+ b
+ } else if (is.numeric(b) && all(b == 1)) {
+ a
+ } else if (is.numeric(a) && is.numeric(b)) {
+ a * b
+ } else {
+ expr[[2]] <- a
+ expr[[3]] <- b
+ expr
+ }
+}
+
+`Simplify.^` <- function(expr)
+{
+ a <- Simplify_(expr[[2]])
+ b <- Simplify_(expr[[3]])
+
+ if (is.numeric(a) && all(a == 0)) {
+ 0
+ } else if (is.numeric(b) && all(b == 0)) {
+ 1
+ } else if (is.numeric(a) && all(a == 1)) {
+ 1
+ } else if (is.numeric(b) && all(b == 1)) {
+ a
+ } else if (is.numeric(a) && is.numeric(b)) {
+ a ^ b
+ } else {
+ expr[[2]] <- a
+ expr[[3]] <- b
+ expr
+ }
+}
+
+`Simplify.c` <- function(expr)
+{
+ args <- expr[-1]
+ args.simplified <- lapply(args, Simplify_)
+ if (all(lapply(args.simplified, is.numeric))) {
+ as.numeric(args.simplified)
+ } else {
+ for (i in 1:length(args))
+ expr[[i + 1]] <- args.simplified[[i]]
+ expr
+ }
+}
+
+assign("simplifications", new.env(), envir=globalenv())
+
+assign("+", `Simplify.+`, envir=simplifications)
+assign("-", `Simplify.-`, envir=simplifications)
+assign("*", `Simplify.*`, envir=simplifications)
+assign("(", `Simplify.(`, envir=simplifications)
+assign("c", `Simplify.c`, envir=simplifications)
+assign("^", `Simplify.^`, envir=simplifications)
+
+
+## Constructor and Initializer of class 'yuima'
+
+# we convert objects to "zoo" internally
+# we should change it later to more flexible classes
+
+setMethod("initialize", "yuima",
+ function(.Object, data=NULL, model=NULL, sampling=NULL, characteristic=NULL, functional=NULL){
+ eqn <- NULL
+
+ if(!is.null(data)){
+ .Object at data <- data
+ eqn <- dim(data)
+ }
+
+ if(!is.null(model)){
+ if(!is.null(eqn)){
+ if(eqn!=model at equation.number){
+ yuima.warn("Model's equation number missmatch.")
+ return(NULL)
+ }
+ }else{
+ eqn <- model at equation.number
+ }
+ .Object at model <- model
+ }
+
+ if(!is.null(sampling)){
+ if(!is.null(eqn)){
+ if(eqn!=length(sampling at Terminal)){
+ if(length(sampling at Terminal)==1){
+ sampling at Terminal <- rep(sampling at Terminal, eqn)
+ sampling at n <- rep(sampling at n, eqn)
+ }else{
+ yuima.warn("Sampling's equation number missmatch.")
+ return(NULL)
+ }
+ }
+ }else{
+ eqn <- length(sampling at Terminal)
+ }
+ .Object at sampling <- sampling
+ }
+
+ if(!is.null(characteristic)){
+ if(!is.null(eqn)){
+ if(eqn!=characteristic at equation.number){
+ yuima.warn("Characteristic's equation number missmatch.")
+ return(NULL)
+ }
+ }
+ .Object at characteristic <- characteristic
+ }else if(!is.null(eqn)){
+ characteristic <- new("yuima.characteristic", equation.number=eqn, time.scale=1)
+ .Object at characteristic <- characteristic
+ }
+
+ if(!is.null(functional)) .Object at functional <- functional
+
+ return(.Object)
+ })
+
+# setter
+setYuima <-
+ function(data=NULL, model=NULL, sampling=NULL, characteristic=NULL, functional=NULL){
+ return(new("yuima", data=data, model=model, sampling=sampling, characteristic=characteristic,functional=functional))
+ }
Modified: pkg/yuima/R/yuima.model.R
===================================================================
--- pkg/yuima/R/yuima.model.R 2013-11-22 02:03:34 UTC (rev 262)
+++ pkg/yuima/R/yuima.model.R 2013-11-27 10:22:17 UTC (rev 263)
@@ -1,12 +1,31 @@
+# setMethod("initialize", "model.parameter",
+# function(.Object,
+# all,
+# common,
+# diffusion,
+# drift,
+# jump,
+# measure,
+# xinit){
+# .Object at all <- all
+# .Object at common <- common
+# .Object at diffusion <- diffusion
+# .Object at drift <- drift
+# .Object at jump <- jump
+# .Object at measure <- measure
+# .Object at xinit <- xinit
+# return(.Object)
+# })
+
setMethod("initialize", "model.parameter",
function(.Object,
- all,
- common,
- diffusion,
- drift,
- jump,
- measure,
- xinit){
+ all = character(),
+ common = character(),
+ diffusion = character(),
+ drift = character(),
+ jump = character(),
+ measure = character(),
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 263
More information about the Yuima-commits
mailing list