[Yuima-commits] r638 - in pkg/yuima: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 3 14:20:50 CEST 2018
Author: lorenzo
Date: 2018-04-03 14:20:50 +0200 (Tue, 03 Apr 2018)
New Revision: 638
Added:
pkg/yuima/man/get.counting.data.Rd
Removed:
pkg/yuima/man/get.counting.data.RD
Modified:
pkg/yuima/R/DiagnosticCogarch.R
pkg/yuima/R/cogarchNoise.R
Log:
Fixed bugs in DiagnosticCogarch
Modified: pkg/yuima/R/DiagnosticCogarch.R
===================================================================
--- pkg/yuima/R/DiagnosticCogarch.R 2018-02-02 15:40:45 UTC (rev 637)
+++ pkg/yuima/R/DiagnosticCogarch.R 2018-04-03 12:20:50 UTC (rev 638)
@@ -135,9 +135,12 @@
if(all(Im(gamma.eig)==0)){
gamm.eig<-as.numeric(gamma.eig)
}
- if(is.numeric(lambda.eig) && all(is.numeric(gamma.eig)<0) && all(is.numeric(lambda.eig)<0)){
- if(cumsum(sort(lambda.eig[c(1:(info at p-1))]))>=cumsum(sort(gamma.eig[c(1:(info at p-1))]))){
+ if( all(Re(gamma.eig)<0) && all(Re(lambda.eig)<0)){
+ NewLamb <- sort(Re(lambda.eig),decreasing = T)
+ NewGam <- sort(Re(gamma.eig),decreasing = T)
+ if(cumsum(NewLamb[c(1:(info at p-1))])>=cumsum(NewGam[c(1:(info at p-1))])){
massage <- "\n The Variance process is strictly positive. \n"
+ res.pos<-TRUE
}
}
}
Modified: pkg/yuima/R/cogarchNoise.R
===================================================================
--- pkg/yuima/R/cogarchNoise.R 2018-02-02 15:40:45 UTC (rev 637)
+++ pkg/yuima/R/cogarchNoise.R 2018-04-03 12:20:50 UTC (rev 638)
@@ -81,7 +81,7 @@
Process_Y <- ExpY0
# Process_Y1 <- ExpY0
# Process_Y <- as.matrix(50.33)
- var_V<-cost + sum(acoeff*Process_Y)
+ var_V<-cost + sum(a*Process_Y)
# delta <- 1/freq
deltatot <- c(0,freq)
for(t in c(2:(length(Data)))){
Deleted: pkg/yuima/man/get.counting.data.RD
===================================================================
--- pkg/yuima/man/get.counting.data.RD 2018-02-02 15:40:45 UTC (rev 637)
+++ pkg/yuima/man/get.counting.data.RD 2018-04-03 12:20:50 UTC (rev 638)
@@ -1,154 +0,0 @@
-\name{get.counting.data}
-\alias{get.counting.data}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{
-Extract arrival times from an object of class \code{yuima.Ppr}
-}
-\description{This function extracts arrival times from an object of class \code{\link{yuima.Ppr}}.}
-\usage{
-get.counting.data(yuimaPPR,type="zoo")
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
- \item{yuimaPPR}{An object of class \code{\link{yuima.Ppr}}.}
- \item{type}{By default \code{type="zoo"} the function returns an object of class \code{zoo}. Other values are \code{yuima.Ppr} and \code{matrix}.}
-}
-%\details{
-%% ~~ If necessary, more details than the description above ~~
-%}
-\value{By default the function returns an object of class zoo. The arrival times can be extracted by applying the method \code{index} to the output}
-%\references{
-%% ~put references to the literature/web site here ~
-%}
-%\author{
-%% ~~who you are~~
-%}
-%\note{
-%% ~~further notes~~
-%}
-
-%% ~Make other sections like Warning with \section{Warning }{....} ~
-
-%\seealso{
-%% ~~objects to See Also as \code{\link{help}}, ~~~
-%}
-\examples{
-\dontrun{
-##################
-# Hawkes Process #
-##################
-
-# Values of parameters.
-mu <- 2
-alpha <- 4
-beta <-5
-
-# Law definition
-
-my.rHawkes <- function(n){
- res <- t(t(rep(1,n)))
- return(res)
-}
-
-Law.Hawkes <- setLaw(rng = my.rHawkes)
-
-# Point Process Definition
-
-gFun <- "mu"
-Kernel <- "alpha*exp(-beta*(t-s))"
-
-modHawkes <- setModel(drift = c("0"), diffusion = matrix("0",1,1),
- jump.coeff = matrix(c("1"),1,1), measure = list(df = Law.Hawkes),
- measure.type = "code", solve.variable = c("N"),
- xinit=c("0"))
-
-prvHawkes <- setPpr(yuima = modHawkes, counting.var="N", gFun=gFun,
- Kernel = as.matrix(Kernel), lambda.var = "lambda",
- var.dx = "N", lower.var="0", upper.var = "t")
-
-true.par <- list(mu=mu, alpha=alpha, beta=beta)
-
-set.seed(1)
-
-Term<-70
-n<-7000
-
-# Simulation trajectory
-
-time.Hawkes <-system.time(
- simHawkes <- simulate(object = prvHawkes, true.parameter = true.par,
- sampling = setSampling(Terminal =Term, n=n))
-)
-
-# Arrival times of the Counting process.
-
-DataHawkes <- get.counting.data(simHawkes)
-TimeArr <- index(DataHawkes)
-
-##################################
-# Point Process Regression Model #
-##################################
-
-# Values of parameters.
-mu <- 2
-alpha <- 4
-beta <-5
-
-# Law definition
-my.rKern <- function(n,t){
- res0 <- t(t(rgamma(n, 0.1*t)))
- res1 <- t(t(rep(1,n)))
- res <- cbind(res0,res1)
- return(res)
-}
-
-Law.PprKern <- setLaw(rng = my.rKern)
-
-# Point Process definition
-modKern <- setModel(drift = c("0.4*(0.1-X)","0"),
- diffusion = c("0","0"),
- jump.coeff = matrix(c("1","0","0","1"),2,2),
- measure = list(df = Law.PprKern),
- measure.type = c("code","code"),
- solve.variable = c("X","N"),
- xinit=c("0.25","0"))
-
-gFun <- "exp(mu*log(1+X))"
-#
-Kernel <- "alpha*exp(-beta*(t-s))"
-
-prvKern <- setPpr(yuima = modKern,
- counting.var="N", gFun=gFun,
- Kernel = as.matrix(Kernel),
- lambda.var = "lambda", var.dx = "N",
- lower.var="0", upper.var = "t")
-
-# Simulation
-
-Term<-100
-seed<-1
-n<-10000
-
-true.parKern <- list(mu=mu, alpha=alpha, beta=beta)
-
-
-set.seed(seed)
-# set.seed(1)
-
-time.simKern <-system.time(
- simprvKern <- simulate(object = prvKern, true.parameter = true.parKern,
- sampling = setSampling(Terminal =Term, n=n))
-)
-
-
-plot(simprvKern,main ="Counting Process with covariates" ,cex.main=0.9)
-
-# Arrival Times
-CountVar <- get.counting.data(simprvKern)
-TimeArr <- index(CountVar)
-
-
-}
-}
-% Add one or more standard keywords, see file 'KEYWORDS' in the
-% R documentation directory.
Added: pkg/yuima/man/get.counting.data.Rd
===================================================================
--- pkg/yuima/man/get.counting.data.Rd (rev 0)
+++ pkg/yuima/man/get.counting.data.Rd 2018-04-03 12:20:50 UTC (rev 638)
@@ -0,0 +1,153 @@
+\name{get.counting.data}
+\alias{get.counting.data}
+\alias{NoisePPR}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+Extract arrival times from an object of class \code{yuima.Ppr}
+}
+\description{This function extracts arrival times from an object of class \code{\link{yuima.Ppr}}.}
+\usage{
+get.counting.data(yuimaPPR,type="zoo")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{yuimaPPR}{An object of class \code{\link{yuima.Ppr}}.}
+ \item{type}{By default \code{type="zoo"} the function returns an object of class \code{zoo}. Other values are \code{yuima.Ppr} and \code{matrix}.}
+}
+%\details{
+%% ~~ If necessary, more details than the description above ~~
+%}
+\value{By default the function returns an object of class zoo. The arrival times can be extracted by applying the method \code{index} to the output}
+%\references{
+%% ~put references to the literature/web site here ~
+%}
+%\author{
+%% ~~who you are~~
+%}
+%\note{
+%% ~~further notes~~
+%}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+%\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+%}
+\examples{
+\dontrun{
+##################
+# Hawkes Process #
+##################
+
+# Values of parameters.
+mu <- 2
+alpha <- 4
+beta <-5
+
+# Law definition
+
+my.rHawkes <- function(n){
+ res <- t(t(rep(1,n)))
+ return(res)
+}
+
+Law.Hawkes <- setLaw(rng = my.rHawkes)
+
+# Point Process Definition
+
+gFun <- "mu"
+Kernel <- "alpha*exp(-beta*(t-s))"
+
+modHawkes <- setModel(drift = c("0"), diffusion = matrix("0",1,1),
+ jump.coeff = matrix(c("1"),1,1), measure = list(df = Law.Hawkes),
+ measure.type = "code", solve.variable = c("N"),
+ xinit=c("0"))
+
+prvHawkes <- setPpr(yuima = modHawkes, counting.var="N", gFun=gFun,
+ Kernel = as.matrix(Kernel), lambda.var = "lambda",
+ var.dx = "N", lower.var="0", upper.var = "t")
+
+true.par <- list(mu=mu, alpha=alpha, beta=beta)
+
+set.seed(1)
+
+Term<-70
+n<-7000
+
+# Simulation trajectory
+
+time.Hawkes <-system.time(
+ simHawkes <- simulate(object = prvHawkes, true.parameter = true.par,
+ sampling = setSampling(Terminal =Term, n=n))
+)
+
+# Arrival times of the Counting process.
+
+DataHawkes <- get.counting.data(simHawkes)
+TimeArr <- index(DataHawkes)
+
+##################################
+# Point Process Regression Model #
+##################################
+
+# Values of parameters.
+mu <- 2
+alpha <- 4
+beta <-5
+
+# Law definition
+my.rKern <- function(n,t){
+ res0 <- t(t(rgamma(n, 0.1*t)))
+ res1 <- t(t(rep(1,n)))
+ res <- cbind(res0,res1)
+ return(res)
+}
+
+Law.PprKern <- setLaw(rng = my.rKern)
+
+# Point Process definition
+modKern <- setModel(drift = c("0.4*(0.1-X)","0"),
+ diffusion = c("0","0"),
+ jump.coeff = matrix(c("1","0","0","1"),2,2),
+ measure = list(df = Law.PprKern),
+ measure.type = c("code","code"),
+ solve.variable = c("X","N"),
+ xinit=c("0.25","0"))
+
+gFun <- "exp(mu*log(1+X))"
+#
+Kernel <- "alpha*exp(-beta*(t-s))"
+
+prvKern <- setPpr(yuima = modKern,
+ counting.var="N", gFun=gFun,
+ Kernel = as.matrix(Kernel),
+ lambda.var = "lambda", var.dx = "N",
+ lower.var="0", upper.var = "t")
+
+# Simulation
+
+Term<-100
+seed<-1
+n<-10000
+
+true.parKern <- list(mu=mu, alpha=alpha, beta=beta)
+
+
+set.seed(seed)
+# set.seed(1)
+
+time.simKern <-system.time(
+ simprvKern <- simulate(object = prvKern, true.parameter = true.parKern,
+ sampling = setSampling(Terminal =Term, n=n))
+)
+
+
+plot(simprvKern,main ="Counting Process with covariates" ,cex.main=0.9)
+
+# Arrival Times
+CountVar <- get.counting.data(simprvKern)
+TimeArr <- index(CountVar)
+
+
+}
+}
More information about the Yuima-commits
mailing list