[Yuima-commits] r686 - in pkg/yuima: . R src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Dec 4 13:50:21 CET 2018


Author: kyuta
Date: 2018-12-04 13:50:20 +0100 (Tue, 04 Dec 2018)
New Revision: 686

Modified:
   pkg/yuima/DESCRIPTION
   pkg/yuima/NEWS
   pkg/yuima/R/cce.R
   pkg/yuima/R/hyavar.R
   pkg/yuima/R/llag.R
   pkg/yuima/R/sim.euler.R
   pkg/yuima/src/euler.c
Log:
update all

Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/DESCRIPTION	2018-12-04 12:50:20 UTC (rev 686)
@@ -1,15 +1,15 @@
-Package: yuima
-Type: Package
-Title: The YUIMA Project Package for SDEs
-Version: 1.8.8
-Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature, mvtnorm
-Imports: Rcpp (>= 0.12.1), boot (>= 1.3-2)
-Author: YUIMA Project Team
-Maintainer: Stefano M. Iacus <stefano.iacus at unimi.it>
-Description: Simulation and Inference for SDEs and Other Stochastic Processes.
-License: GPL-2
-URL: http://www.yuima-project.com
-LinkingTo: Rcpp, RcppArmadillo
-
-
-
+Package: yuima
+Type: Package
+Title: The YUIMA Project Package for SDEs
+Version: 1.8.9
+Depends: R(>= 2.10.0), methods, zoo, stats4, utils, expm, cubature, mvtnorm
+Imports: Rcpp (>= 0.12.1), boot (>= 1.3-2)
+Author: YUIMA Project Team
+Maintainer: Stefano M. Iacus <stefano.iacus at unimi.it>
+Description: Simulation and Inference for SDEs and Other Stochastic Processes.
+License: GPL-2
+URL: http://www.yuima-project.com
+LinkingTo: Rcpp, RcppArmadillo
+
+
+

Modified: pkg/yuima/NEWS
===================================================================
--- pkg/yuima/NEWS	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/NEWS	2018-12-04 12:50:20 UTC (rev 686)
@@ -1,53 +1,53 @@
-2012/10/05: add mpv.R, bns.test.R, mpv.Rd, bns.test.Rd
-2012/12/13: add noisy.sampling.R, noisy.sampling.Rd
-            modify bns.test.R, cce.R, llag.R, mpv.R, bns.test.Rd, cce.Rd, llag.Rd, mpv.Rd
-2012/12/19: modify cce.R
-2012/12/19: modify cce.R, noisy.sampling.R
-2012/12/22: modify cce.R
-2013/02/06: modify rng.R
-2013/02/11: modify cce.R
-2013/04/13: modify asymptotic_term_second.R, asymptotic_term_third.R, asymptotic_term_third_function.R, cce.R, llag.R
-2013/04/13: modify qmle.R
-2013/04/14: modify qmle.R
-2013/04/14: modify adaBayes.R
-2013/04/14: modify bns.test.Rd, mpv.Rd
-2013/10/28: add cce_functions.c
-            modify cce.R, llag.R, sim.euler.R, bns.test.Rd, cce.Rd, llag.Rd, mpv.Rd, noisy.sampling.Rd
-2013/10/28: modify llag.R
-2013/10/30: modify cce.R, cce_functions.c
-2013/11/21: modify llag.R
-2013/11/22: modify cce.R, cce_functions.c
-2014/04/28: modified qmle, added carma, modified lasso
-2014/05/04: modified show method, setYuima sets the sampling from the data if sampling is missing
-2014/07/07: modified llag.R, llag.Rd, cce_functions.c; estimated cross-correlation functions are converted to values in [-1,1]
-2014/07/31: fixed setSampling and print methods
-2014/09/08: fixed a bug in cce_functions.c
-2014/09/23: added Compound Poisson simulator
-2014/11/10: fixed a bug in cce_functions.c
-            changed the optimization method of the method "QMLE" of cce
-            modified cce.Rd
-2014/11/11: fixed a bug in cce.R (method "GME")
-            modified the example of cce.Rd
-2015/04/02: fixed a bug in rng.R (function "rstable")
-2015/04/21: added hyavar.R, hyavar.Rd (asymptotic variance estimator for HY)
-            fixed a bug in llag.R
-            modified cce.Rd, cce_functions.c
-2015/05/14: fixed a bug in cce_functions.c
-2015/09/01: fixed a bug in cce_functions.c
-                  add some contents to the examples of cce
-2015/10/10: modified llag.R, cce.Rd, llag.Rd, mpv.Rd, noisy.sampling.Rd, cce_functions.c
-                  added mllag.R, mllag.Rd (multiple lead-lag detector);
-                          spectralcov.R, spectralcov.Rd (spectral covariance estimator)
-2016/01/14: modified rng.R, rng.Rd, adaBayes.Rd, qmle.Rd, setModel.Rd, spectralcov.Rd
-2016/05/26: added rpts and rnts in rng.R and the corresponding c language file
-2016/07/08: fixed some bugs in llag.R and cce_functions.c
-2016/10/04: modified setMultiModel.R, sim.euler.R and yuima.model.R to generate nts and pts process
-2016/12/16: added rGIG, rGH, dGIG and dGH in rng.R and the corresponding c language file YU
-2017/01/25: modified sim.euler.R and added euler.c to implement the Euler-Maruyama scheme by the C code (only the diffusion case)
-2017/02/23: modified sim.euler.R and removed euler.c due to a memory corruption
-                  fix a bug in sim.euler.R
-2017/03/27: added IC.R and qmleLevy.R
-2017/04/12: fix a bug in sim.euler.R
+2012/10/05: add mpv.R, bns.test.R, mpv.Rd, bns.test.Rd
+2012/12/13: add noisy.sampling.R, noisy.sampling.Rd
+            modify bns.test.R, cce.R, llag.R, mpv.R, bns.test.Rd, cce.Rd, llag.Rd, mpv.Rd
+2012/12/19: modify cce.R
+2012/12/19: modify cce.R, noisy.sampling.R
+2012/12/22: modify cce.R
+2013/02/06: modify rng.R
+2013/02/11: modify cce.R
+2013/04/13: modify asymptotic_term_second.R, asymptotic_term_third.R, asymptotic_term_third_function.R, cce.R, llag.R
+2013/04/13: modify qmle.R
+2013/04/14: modify qmle.R
+2013/04/14: modify adaBayes.R
+2013/04/14: modify bns.test.Rd, mpv.Rd
+2013/10/28: add cce_functions.c
+            modify cce.R, llag.R, sim.euler.R, bns.test.Rd, cce.Rd, llag.Rd, mpv.Rd, noisy.sampling.Rd
+2013/10/28: modify llag.R
+2013/10/30: modify cce.R, cce_functions.c
+2013/11/21: modify llag.R
+2013/11/22: modify cce.R, cce_functions.c
+2014/04/28: modified qmle, added carma, modified lasso
+2014/05/04: modified show method, setYuima sets the sampling from the data if sampling is missing
+2014/07/07: modified llag.R, llag.Rd, cce_functions.c; estimated cross-correlation functions are converted to values in [-1,1]
+2014/07/31: fixed setSampling and print methods
+2014/09/08: fixed a bug in cce_functions.c
+2014/09/23: added Compound Poisson simulator
+2014/11/10: fixed a bug in cce_functions.c
+            changed the optimization method of the method "QMLE" of cce
+            modified cce.Rd
+2014/11/11: fixed a bug in cce.R (method "GME")
+            modified the example of cce.Rd
+2015/04/02: fixed a bug in rng.R (function "rstable")
+2015/04/21: added hyavar.R, hyavar.Rd (asymptotic variance estimator for HY)
+            fixed a bug in llag.R
+            modified cce.Rd, cce_functions.c
+2015/05/14: fixed a bug in cce_functions.c
+2015/09/01: fixed a bug in cce_functions.c
+                  add some contents to the examples of cce
+2015/10/10: modified llag.R, cce.Rd, llag.Rd, mpv.Rd, noisy.sampling.Rd, cce_functions.c
+                  added mllag.R, mllag.Rd (multiple lead-lag detector);
+                          spectralcov.R, spectralcov.Rd (spectral covariance estimator)
+2016/01/14: modified rng.R, rng.Rd, adaBayes.Rd, qmle.Rd, setModel.Rd, spectralcov.Rd
+2016/05/26: added rpts and rnts in rng.R and the corresponding c language file
+2016/07/08: fixed some bugs in llag.R and cce_functions.c
+2016/10/04: modified setMultiModel.R, sim.euler.R and yuima.model.R to generate nts and pts process
+2016/12/16: added rGIG, rGH, dGIG and dGH in rng.R and the corresponding c language file YU
+2017/01/25: modified sim.euler.R and added euler.c to implement the Euler-Maruyama scheme by the C code (only the diffusion case)
+2017/02/23: modified sim.euler.R and removed euler.c due to a memory corruption
+                  fix a bug in sim.euler.R
+2017/03/27: added IC.R and qmleLevy.R
+2017/04/12: fix a bug in sim.euler.R
                   (re-)added euler.c 
 2017/04/27: modified qmleLevy.R, qmleLevy.Rd, IC.Rd
 2017/09/09: boot package is imported
@@ -57,4 +57,6 @@
             the default value of tol of llag is changed to 1e-7
             modified llag.R, llag.Rd, cce_functions.c 
 2018/04/12: a bug in cce is fixed
-2018/10/30: modified IC.R, IC.Rd
\ No newline at end of file
+2018/10/30: modified IC.R, IC.Rd
+2018/12/4: a bug in euler.c is fixed
+           modified cce.R, hyavar.R, llag.R, sim.euler.R
\ No newline at end of file

Modified: pkg/yuima/R/cce.R
===================================================================
--- pkg/yuima/R/cce.R	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/R/cce.R	2018-12-04 12:50:20 UTC (rev 686)
@@ -104,7 +104,9 @@
                      as.integer(diffinv(ser.lengths[-d.size],xi=0)),
                      min(sapply(ser.times,FUN="tail",n=1)),
                      as.integer(MinL),
-                     result=integer(d.size*MinL))$result,ncol=d.size)
+                     result=integer(d.size*MinL),
+                     PACKAGE = "yuima")$result, # PACKAGE is added (YK, Dec 4, 2018)
+                  ncol=d.size)
     
     result <- vector(d.size, mode="list")
     
@@ -197,7 +199,8 @@
               min(sapply(ser.times,FUN="tail",n=1)),
               as.integer(MinL),
               Samplings=integer(d.size*(MinL+1)),
-              rNum=integer(1))
+              rNum=integer(1),
+              PACKAGE = "yuima") # PACKAGE is added (YK, Dec 4, 2018)
     
     refresh.times <- obj$rtimes[1:obj$rNum]
     idx <- matrix(obj$Samplings,ncol=d.size)
@@ -354,7 +357,8 @@
               w=integer(N.max),
               q=integer(N.max),
               r=integer(N.max),
-              Num=integer(1))
+              Num=integer(1),
+              PACKAGE = "yuima")
   
   Num <- sdata$Num
   
@@ -424,7 +428,8 @@
                     as.integer(n.sparse),
                     as.integer(n.size),
                     as.double(grid),
-                    result=double(frequency*n.sparse))$result,
+                    result=double(frequency*n.sparse),
+                    PACKAGE = "yuima")$result,
                  n.sparse,frequency)
   
   result <- double(frequency)
@@ -678,7 +683,8 @@
         cmat[j,i] <- .C("HayashiYoshida",as.integer(length(ser.times[[i]])),
                         as.integer(length(ser.times[[j]])),as.double(ser.times[[i]]),
                         as.double(ser.times[[j]]),as.double(ser.diffX[[i]]),
-                        as.double(ser.diffX[[j]]),value=double(1))$value
+                        as.double(ser.diffX[[j]]),value=double(1),
+                        PACKAGE = "yuima")$value
       }else{
         cmat[i,j] <- sum(ser.diffX[[i]]^2)
       }
@@ -818,7 +824,8 @@
                               as.double(ser.times[[2]]),
                               as.double(ser.barX[[1]]),
                               as.double(ser.barX[[2]]),
-                              value=double(1))$value
+                              value=double(1),
+                              PACKAGE = "yuima")$value
               
               cmat[i,j] <- cmat[i,j]/(psi.kn^2)
               cmat[j,i] <- cmat[i,j]
@@ -897,7 +904,8 @@
                               as.double(ser.times[[2]]),
                               as.double(ser.barX[[1]]),
                               as.double(ser.barX[[2]]),
-                              value=double(1))$value
+                              value=double(1),
+                              PACKAGE = "yuima")$value
               
               cmat[i,j] <- cmat[i,j]/(psi.kn^2)
               cmat[j,i] <- cmat[i,j]
@@ -984,7 +992,8 @@
                             as.double(ser.times[[j]]),
                             as.double(ser.barX[[i]]),
                             as.double(ser.barX[[j]]),
-                            value=double(1))$value
+                            value=double(1),
+                            PACKAGE = "yuima")$value
             cmat[j,i] <- cmat[i,j]
           }else{
             tmp <- ser.barX[[i]][1:ser.num.barX[i]]
@@ -1060,7 +1069,8 @@
                             as.double(ser.times[[2]]),
                             as.double(ser.barX[[1]]),
                             as.double(ser.barX[[2]]),
-                            value=double(1))$value
+                            value=double(1),
+                            PACKAGE = "yuima")$value
             
             cmat[i,j] <- cmat[i,j]/(psi.kn^2)
             cmat[j,i] <- cmat[i,j]
@@ -1148,7 +1158,8 @@
                             as.double(ser.times[[j]]),
                             as.double(ser.barX[[i]]),
                             as.double(ser.barX[[j]]),
-                            value=double(1))$value
+                            value=double(1),
+                            PACKAGE = "yuima")$value
             cmat[j,i] <- cmat[i,j]
           }else{
             tmp <- ser.barX[[i]][1:ser.num.barX[i]]
@@ -1240,7 +1251,8 @@
                   as.double(sdata$xl),
                   as.double(sdata$ygamma),
                   as.double(sdata$ylambda),
-                  result=double(M))$result
+                  result=double(M),
+                  PACKAGE = "yuima")$result
         
         cmat[i,j] <- (alpha/(1:M))%*%tmp
         
@@ -1269,7 +1281,8 @@
                   as.double(X[1:N]),
                   as.double(X[-1]),
                   as.double(X[1:N]),
-                  result=double(M))$result
+                  result=double(M),
+                  PACKAGE = "yuima")$result
         
         cmat[i,j] <- (alpha/(1:M))%*%tmp
         
@@ -1663,7 +1676,8 @@
         cmat[j,i] <- .C("HayashiYoshida",as.integer(length(ser.times[[i]])),
                         as.integer(length(ser.times[[j]])),as.double(ser.times[[i]]),
                         as.double(ser.times[[j]]),as.double(ser.diffX[[i]]),
-                        as.double(ser.diffX[[j]]),value=double(1))$value
+                        as.double(ser.diffX[[j]]),value=double(1),
+                        PACKAGE = "yuima")$value
       }else{
         cmat[i,j] <- sum(ser.diffX[[i]]^2)
       }
@@ -1787,7 +1801,8 @@
                               as.double(ser.times[[2]]),
                               as.double(ser.barX[[1]]),
                               as.double(ser.barX[[2]]),
-                              value=double(1))$value
+                              value=double(1),
+                              PACKAGE = "yuima")$value
               
               cmat[i,j] <- cmat[i,j]/(psi.kn^2)
               cmat[j,i] <- cmat[i,j]
@@ -1929,7 +1944,8 @@
                               as.double(ser.times[[2]]),
                               as.double(ser.barX[[1]]),
                               as.double(ser.barX[[2]]),
-                              value=double(1))$value
+                              value=double(1),
+                              PACKAGE = "yuima")$value
               
               cmat[i,j] <- cmat[i,j]/(psi.kn^2)
               cmat[j,i] <- cmat[i,j]
@@ -2115,7 +2131,8 @@
                             as.double(ser.times[[j]]),
                             as.double(ser.barX[[i]]),
                             as.double(ser.barX[[j]]),
-                            value=double(1))$value
+                            value=double(1),
+                            PACKAGE = "yuima")$value
             cmat[j,i] <- cmat[i,j]
           }else{
             tmp <- ser.barX[[i]][1:ser.num.barX[i]]
@@ -2225,7 +2242,8 @@
                             as.double(ser.times[[2]]),
                             as.double(ser.barX[[1]]),
                             as.double(ser.barX[[2]]),
-                            value=double(1))$value
+                            value=double(1),
+                            PACKAGE = "yuima")$value
             
             cmat[i,j] <- cmat[i,j]/(psi.kn^2)
             cmat[j,i] <- cmat[i,j]
@@ -2382,7 +2400,8 @@
                             as.double(ser.times[[j]]),
                             as.double(ser.barX[[i]]),
                             as.double(ser.barX[[j]]),
-                            value=double(1))$value
+                            value=double(1),
+                            PACKAGE = "yuima")$value
             cmat[j,i] <- cmat[i,j]
           }else{
             tmp <- ser.barX[[i]][1:ser.num.barX[i]]
@@ -2442,7 +2461,8 @@
                            as.double(ser.times[[d]]),
                            as.integer(frequency),as.integer(n.sparse),
                            as.integer(ser.numX[d]),as.double(grid),
-                           result=double(frequency*n.sparse))$result,
+                           result=double(frequency*n.sparse),
+                           PACKAGE = "yuima")$result,
                         n.sparse,frequency)
     
     sdiff1[d,,] <- diff(subsample[,1:K])
@@ -2563,7 +2583,8 @@
                            as.double(ser.times[[d]]),
                            as.integer(frequency),as.integer(n.sparse),
                            as.integer(ser.numX[d]),as.double(grid),
-                           result=double(frequency*n.sparse))$result,
+                           result=double(frequency*n.sparse),
+                           PACKAGE = "yuima")$result,
                         n.sparse,frequency)
     
     sdata1[d,,] <- subsample[,1:K]

Modified: pkg/yuima/R/hyavar.R
===================================================================
--- pkg/yuima/R/hyavar.R	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/R/hyavar.R	2018-12-04 12:50:20 UTC (rev 686)
@@ -80,7 +80,8 @@
                    as.double(ser.X[[j]]),
                    as.integer(N.max),
                    as.double(bw[i, j]),
-                   avar = double(4))$avar
+                   avar = double(4),
+                   PACKAGE = "yuima")$avar
         ## avar[1] = var(HYij), avar[2] = cov(HYii, HYij), avar[3] = cov(HYij, HYjj), avar[4] = cov(HYii, HYjj)
         
         avar.cov[i, j] <- avar[1]

Modified: pkg/yuima/R/llag.R
===================================================================
--- pkg/yuima/R/llag.R	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/R/llag.R	2018-12-04 12:50:20 UTC (rev 686)
@@ -167,7 +167,8 @@
                      as.double(2 * d2),
                      as.double(2 * d1 * d2),
                      covar = double(length(G[[num]])),
-                     corr = double(length(G[[num]])))$corr / (vol[i] * vol[j])
+                     corr = double(length(G[[num]])),
+                     PACKAGE = "yuima")$corr / (vol[i] * vol[j])
       
       #avar[[num]][avar[[num]] <= 0] <- NA
       
@@ -703,7 +704,8 @@
                     as.double(ser.diffX[[j]]),
                     as.double(vol[i]),
                     as.double(vol[j]),
-                    value=double(n-2))$value
+                    value=double(n-2),
+                    PACKAGE = "yuima")$value
           
           idx <- which.max(abs(tmp))
           mlag <- -y[idx] # make the first timing of max or min
@@ -749,7 +751,8 @@
                     as.double(ser.diffX[[j]]),
                     as.double(vol[i]),
                     as.double(vol[j]),
-                    value=double(length(grid[[num]])))$value
+                    value=double(length(grid[[num]])),
+                    PACKAGE = "yuima")$value
           
           idx <- which.max(abs(tmp))
           mlag <- -grid[[num]][idx] # make the first timing of max or min
@@ -853,7 +856,8 @@
                     double(length(time2)),
                     as.double(ser.diffX[[i]]),
                     as.double(ser.diffX[[j]]),
-                    value=double(n-2))$value
+                    value=double(n-2),
+                    PACKAGE = "yuima")$value
           
           idx <- which.max(abs(tmp))
           mlag <- -y[idx] # make the first timing of max or min
@@ -897,7 +901,8 @@
                     double(length(time2)),
                     as.double(ser.diffX[[i]]),
                     as.double(ser.diffX[[j]]),
-                    value=double(length(grid[[num]])))$value
+                    value=double(length(grid[[num]])),
+                    PACKAGE = "yuima")$value
           
           idx <- which.max(abs(tmp))
           mlag <- -grid[[num]][idx] # make the first timing of max or min

Modified: pkg/yuima/R/sim.euler.R
===================================================================
--- pkg/yuima/R/sim.euler.R	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/R/sim.euler.R	2018-12-04 12:50:20 UTC (rev 686)
@@ -166,7 +166,8 @@
     
     X_mat <- .Call("euler", dX, Initial, as.integer(r.size), 
                    rep(1, n) * delta, dW, modeltime, modelstate, quote(eval(b, env)), 
-                   quote(eval(vecV, env)), env, new.env())
+                   quote(eval(vecV, env)), env, new.env(),
+                   PACKAGE = "yuima") # PACKAGE is added (YK, Dec 4, 2018)
     #}
     #tsX <- ts(data=t(X_mat), deltat=delta , start=0)
     tsX <- ts(data=t(X_mat), deltat=delta , start = yuima at sampling@Initial) #LM

Modified: pkg/yuima/src/euler.c
===================================================================
--- pkg/yuima/src/euler.c	2018-11-25 08:39:34 UTC (rev 685)
+++ pkg/yuima/src/euler.c	2018-12-04 12:50:20 UTC (rev 686)
@@ -67,8 +67,11 @@
         /*defineVar(install("env"), env, rho);*/
         
         /* evaluate coefficients */
-        PROTECT(b0 = eval(drift, rho));
+        /* PROTECT(b0 = eval(drift, rho));
         PROTECT(sigma0 = eval(diffusion, rho));
+        AS_NUMERIC is added by YK (Dec 4, 2018) */
+        PROTECT(b0 = AS_NUMERIC(eval(drift, rho)));
+        PROTECT(sigma0 = AS_NUMERIC(eval(diffusion, rho)));
         b = REAL(b0);
         sigma = REAL(sigma0);
         



More information about the Yuima-commits mailing list