[Yuima-commits] r237 - in pkg/yuima: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Apr 13 10:31:09 CEST 2013
Author: kyuta
Date: 2013-04-13 10:31:09 +0200 (Sat, 13 Apr 2013)
New Revision: 237
Modified:
pkg/yuima/DESCRIPTION
pkg/yuima/NEWS
pkg/yuima/R/asymptotic_term_second.R
pkg/yuima/R/asymptotic_term_third.R
pkg/yuima/R/asymptotic_term_third_function.R
pkg/yuima/R/cce.R
pkg/yuima/R/llag.R
Log:
replaced "real" by "double" in some files and modified cce.R
Modified: pkg/yuima/DESCRIPTION
===================================================================
--- pkg/yuima/DESCRIPTION 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/DESCRIPTION 2013-04-13 08:31:09 UTC (rev 237)
@@ -1,8 +1,8 @@
Package: yuima
Type: Package
Title: The YUIMA Project package (unstable version)
-Version: 0.1.204
-Date: 2013-02-11
+Version: 0.1.205
+Date: 2013-04-13
Depends: methods, zoo, stats4, utils
Suggests: cubature, mvtnorm
Author: YUIMA Project Team.
Modified: pkg/yuima/NEWS
===================================================================
--- pkg/yuima/NEWS 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/NEWS 2013-04-13 08:31:09 UTC (rev 237)
@@ -6,3 +6,4 @@
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
Modified: pkg/yuima/R/asymptotic_term_second.R
===================================================================
--- pkg/yuima/R/asymptotic_term_second.R 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/R/asymptotic_term_second.R 2013-04-13 08:31:09 UTC (rev 237)
@@ -227,7 +227,7 @@
n <- (n1 - n2 != 0) * (n3 - n4 != 0)
if(n == 0){
- mu1 <- real(k.size)
+ mu1 <- double(k.size)
}else{
mu1 <- apply(get_e_f0,1,sum) * delta + get_e_F[,division]
}
@@ -238,7 +238,7 @@
n <- n5 - n6
if(n == 0){
- mu2 <- real(k.size)
+ mu2 <- double(k.size)
}else{
n7 <- length(get_x_F)
n8 <- sum(get_x_F == 0)
@@ -246,7 +246,7 @@
n <- n7 - n8
if(n == 0){
- mu2_1 <- real(k.size)
+ mu2_1 <- double(k.size)
}else{
mu2_1 <- matrix(get_x_F[,,division],k.size,d.size) %*%
tmpY[,,d.size] %*% matrix(apply(get_Y_e_V0,1,sum),d.size,1) *
@@ -259,9 +259,9 @@
n <- n7 - n8
if(n == 0){
- mu2_2 <- real(k.size)
+ mu2_2 <- double(k.size)
}else{
- mu2_2 <- real(k.size)
+ mu2_2 <- double(k.size)
for(l in 1:k.size){
for(i in 1:d.size){
@@ -485,7 +485,7 @@
block <- env$block
first <- array(0,dim=c(k.size,k.size,k.size))
- second <- real(k.size)
+ second <- double(k.size)
for(l in 1:k.size){
for(j in 1:d.size){
@@ -526,7 +526,7 @@
temp <- list()
temp$first <- array(0,dim=c(k.size,k.size,k.size))
temp$second <- matrix(0,k.size,k.size)
- temp$third <- real(k.size)
+ temp$third <- double(k.size)
calc.range <- c(1:3)
@@ -640,7 +640,7 @@
block <- env$block
- first <- real(1)
+ first <- double(1)
tmp4 <- matrix(0,r.size,block)
tmp6 <- matrix(0,r.size,block)
Modified: pkg/yuima/R/asymptotic_term_third.R
===================================================================
--- pkg/yuima/R/asymptotic_term_third.R 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/R/asymptotic_term_third.R 2013-04-13 08:31:09 UTC (rev 237)
@@ -227,7 +227,7 @@
n <- (n1 - n2 != 0) * (n3 - n4 != 0)
if(n == 0){
- mu1 <- real(k.size)
+ mu1 <- double(k.size)
}else{
mu1 <- apply(get_e_f0,1,sum) * delta + get_e_F[,division]
}
@@ -238,7 +238,7 @@
n <- n5 - n6
if(n == 0){
- mu2 <- real(k.size)
+ mu2 <- double(k.size)
}else{
n7 <- length(get_x_F)
n8 <- sum(get_x_F == 0)
@@ -246,7 +246,7 @@
n <- n7 - n8
if(n == 0){
- mu2_1 <- real(k.size)
+ mu2_1 <- double(k.size)
}else{
mu2_1 <- matrix(get_x_F[,,division],k.size,d.size) %*%
tmpY[,,d.size] %*% matrix(apply(get_Y_e_V0,1,sum),d.size,1) *
@@ -259,9 +259,9 @@
n <- n7 - n8
if(n == 0){
- mu2_2 <- real(k.size)
+ mu2_2 <- double(k.size)
}else{
- mu2_2 <- real(k.size)
+ mu2_2 <- double(k.size)
for(l in 1:k.size){
for(i in 1:d.size){
@@ -483,7 +483,7 @@
block <- env$block
first <- array(0,dim=c(k.size,k.size,k.size))
- second <- real(k.size)
+ second <- double(k.size)
for(l in 1:k.size){
for(j in 1:d.size){
@@ -524,7 +524,7 @@
temp <- list()
temp$first <- array(0,dim=c(k.size,k.size,k.size))
temp$second <- matrix(0,k.size,k.size)
- temp$third <- real(k.size)
+ temp$third <- double(k.size)
calc.range <- c(1:3)
@@ -638,7 +638,7 @@
block <- env$block
- first <- real(1)
+ first <- double(1)
second <- matrix(0,r.size,block)
third <- matrix(0,r.size,block)
@@ -1384,7 +1384,7 @@
first <- sum(tmp1)/2
- tmp2 <- real(k.size)
+ tmp2 <- double(k.size)
for(l in 1:k.size){
Modified: pkg/yuima/R/asymptotic_term_third_function.R
===================================================================
--- pkg/yuima/R/asymptotic_term_third_function.R 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/R/asymptotic_term_third_function.R 2013-04-13 08:31:09 UTC (rev 237)
@@ -214,7 +214,7 @@
if(n == 0){
first <- array(0,dim=c(k.size,k.size,k.size,k.size,block))
second <- array(0,dim=c(k.size,k.size,block))
- third <- real(block)
+ third <- double(block)
return(list(first=first,second=second,third=third))
}
@@ -496,7 +496,7 @@
second <- - second1 - second2 - second3 - second4 - second5 - second6
- third1 <- real(block)
+ third1 <- double(block)
for(t in 1:block){
for(k3 in 1:k.size){
@@ -508,7 +508,7 @@
}
- third2 <- real(block)
+ third2 <- double(block)
for(t in 1:block){
for(k2 in 1:k.size){
@@ -519,7 +519,7 @@
}
}
- third3 <- real(block)
+ third3 <- double(block)
d.size <- env$d.size
@@ -582,7 +582,7 @@
r.size <- env$r.size
block <- env$block
- result <- real(block)
+ result <- double(block)
n1 <- length(b1)
n2 <- sum(b1 == 0)
@@ -618,7 +618,7 @@
tmp <- b1b2(b1,b2,env)
- result <- real(block)
+ result <- double(block)
for(t in 1:block){
result[t] <- tmp %*% Diff[t,] * delta
@@ -634,7 +634,7 @@
block <- env$block
Diff <- env$Diff
- result <- real(block)
+ result <- double(block)
n1 <- length(f)
n2 <- sum(f == 0)
@@ -731,7 +731,7 @@
if(n == 0){
first <- array(0,dim=c(k.size,k.size,block))
- second <- real(block)
+ second <- double(block)
return(list(first=first,second=second))
}
@@ -784,7 +784,7 @@
}
- second <- real(block)
+ second <- double(block)
for(t in 1:block){
for(k1 in 1:k.size){
@@ -832,7 +832,7 @@
if(n == 0){
first <- array(0,dim=c(k.size,k.size,block))
- second <- real(block)
+ second <- double(block)
return(list(first=first,second=second))
}
@@ -1089,7 +1089,7 @@
if(n == 0){
first <- array(0,dim=c(k.size,k.size,k.size,k.size,block))
second <- array(0,dim=c(k.size,k.size,block))
- third <- real(block)
+ third <- double(block)
return(list(first=first,second=second,third=third))
}
@@ -2002,7 +2002,7 @@
for(j1 in 1:d.size){
for(j2 in 1:d.size){
tmp1 <- b1_b2(get_Y_e_V[j1,,],get_Y_e_V[j2,,],env)
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(t in 2:block){
tmp2[t] <- (get_Y_x1_x2_V0[i1,i2,j,] *
@@ -2014,7 +2014,7 @@
}
}
- tmp3 <- real(block)
+ tmp3 <- double(block)
for(t in 2:block){
tmp3[t] <- (get_Y_x1_x2_V0[i1,i2,j,] * get_Y_D[i1,] *
@@ -2024,7 +2024,7 @@
second.tmp[i,j,] <- second.tmp[i,j,] + tmp3
}
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(t in 2:block){
tmp4[t] <- (get_Y_x_e_V0[i1,j,] *
@@ -2034,7 +2034,7 @@
third.tmp[i,j,] <- third.tmp[i,j,] + tmp4
}
- tmp5 <- real(block)
+ tmp5 <- double(block)
for(t in 2:block){
tmp5[t] <- get_Y_e_e_V0[j,] %*% Diff[t,] * delta
@@ -2158,7 +2158,7 @@
for(j2 in 1:d.size){
for(j in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -3023,7 +3023,7 @@
for(j1 in 1:d.size){
for(j2 in 1:d.size){
tmp1 <- b1_b2(get_Y_e_V[j1,,],get_Y_e_V[j2,,],env)
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(t in 2:block){
tmp2[t] <- (get_x1_x2_f0[l,i1,i2,] *
@@ -3035,7 +3035,7 @@
}
}
- tmp3 <- real(block)
+ tmp3 <- double(block)
for(t in 2:block){
tmp3[t] <- (get_x1_x2_f0[l,i1,i2,] * get_Y_D[i1,] *
@@ -3045,7 +3045,7 @@
second[l,] <- second[l,] + tmp3
}
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(t in 2:block){
tmp4[t] <- (get_x_e_f0[l,i1,] *
@@ -3055,7 +3055,7 @@
third[l,] <- third[l,] + 2 * tmp4
}
- tmp5 <- real(block)
+ tmp5 <- double(block)
for(t in 2:block){
tmp5[t] <- get_e_e_f0[l,] %*% Diff[t,] * delta
@@ -3133,7 +3133,7 @@
for(j1 in 1:d.size){
for(j2 in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
tmp3 <- matrix(0,r.size,block)
for(i1 in 1:d.size){
@@ -3180,8 +3180,8 @@
for(j1 in 1:d.size){
for(j2 in 1:d.size){
- tmp2 <- real(block)
- tmp3 <- real(1)
+ tmp2 <- double(block)
+ tmp3 <- double(1)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -3391,7 +3391,7 @@
r.size <- env$r.size
k.size <- env$k.size
- result <- real(d.size)
+ result <- double(d.size)
for(i in 1:d.size){
first.tmp <- list()
@@ -3420,7 +3420,7 @@
result1 <- get_E0_t$first
- first <- real(k.size)
+ first <- double(k.size)
for(l in 1:k.size){
for(i in 1:d.size){
@@ -3444,7 +3444,7 @@
for(j2 in 1:d.size){
for(j1 in 1:d.size){
- tmp3 <- real(block)
+ tmp3 <- double(block)
for(i in 1:d.size){
tmp2 <- get_x_f0[l,i,] * result2.coef[i,j1,j2,]
@@ -3474,7 +3474,7 @@
for(l in 1:k.size){
for(j1 in 1:d.size){
- tmp6 <- real(block)
+ tmp6 <- double(block)
for(i in 1:d.size){
tmp5 <- get_x_f0[l,i,] * result4.coef[i,j1,]
@@ -3517,7 +3517,7 @@
for(l in 1:k.size){
for(j in 1:d.size){
- tmp9 <- real(block)
+ tmp9 <- double(block)
for(i in 1:d.size){
tmp8 <- get_x_f0[l,i,] * result6.coef[i,j,]
@@ -3917,7 +3917,7 @@
result1 <- get_E0_t$first
- first <- real(k.size)
+ first <- double(k.size)
for(l in 1:k.size){
for(i in 1:d.size){
@@ -3937,7 +3937,7 @@
for(j1 in 1:d.size){
for(j2 in 1:d.size){
- tmp3 <- real(1)
+ tmp3 <- double(1)
for(i in 1:d.size){
tmp2 <- get_x_F[l,i,block] * result2.coef[i,j1,j2,block]
@@ -3960,7 +3960,7 @@
for(l in 1:k.size){
for(j1 in 1:d.size){
- tmp5 <- real(1)
+ tmp5 <- double(1)
for(i in 1:d.size){
tmp4 <- get_x_F[l,i,block] * result3.coef[i,j1,block]
@@ -3992,7 +3992,7 @@
for(l in 1:k.size){
for(j in 1:d.size){
- tmp7 <- real(1)
+ tmp7 <- double(1)
for(i in 1:d.size){
tmp6 <- get_x_F[l,i,block] * result4.coef[i,j,block]
@@ -4030,7 +4030,7 @@
k.size <- env$k.size
block <- env$block
- first <- real(k.size)
+ first <- double(k.size)
for(l in 1:k.size){
for(i1 in 1:d.size){
@@ -4041,7 +4041,7 @@
}
}
- second <- real(k.size)
+ second <- double(k.size)
for(l in 1:k.size){
for(i in 1:d.size){
@@ -4057,7 +4057,7 @@
for(l in 1:k.size){
for(j1 in 1:d.size){
- tmp1 <- real(1)
+ tmp1 <- double(1)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -4077,7 +4077,7 @@
for(l in 1:k.size){
for(j in 1:d.size){
- tmp2 <- real(1)
+ tmp2 <- double(1)
for(i in 1:d.size){
tmp2 <- tmp2 + 2 * get_x_e_F[l,i,block] * tmpY[i,j,block]
@@ -4093,13 +4093,13 @@
sixth[[1]] <- array(0,dim=c(k.size,d.size,r.size,block))
sixth[[2]] <- get_Y_e_V
- seventh <- real(k.size)
+ seventh <- double(k.size)
for(l in 1:k.size){
for(j1 in 1:d.size){
for(j2 in 1:d.size){
- tmp3 <- real(1)
+ tmp3 <- double(1)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -4537,7 +4537,7 @@
}
}
- second <- real(block)
+ second <- double(block)
tmp4 <- c2 * tmp1$second
@@ -4757,7 +4757,7 @@
for(j in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i3 in 1:d.size){
for(i4 in 1:d.size){
@@ -4791,7 +4791,7 @@
for(j2 in 1:d.size){
for(j4 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -4925,7 +4925,7 @@
for(j2 in 1:d.size){
for(j4 in 1:d.size){
- tmp18 <- real(block)
+ tmp18 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5070,7 +5070,7 @@
for(j in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i3 in 1:d.size){
@@ -5104,7 +5104,7 @@
for(j2 in 1:d.size){
for(j3 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5223,7 +5223,7 @@
for(j in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5253,7 +5253,7 @@
for(j in 1:d.size){
for(j3 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5289,7 +5289,7 @@
for(j2 in 1:d.size){
for(j3 in 1:d.size){
- tmp7 <- real(block)
+ tmp7 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5332,7 +5332,7 @@
for(j2 in 1:d.size){
for(j3 in 1:d.size){
- tmp10 <- real(block)
+ tmp10 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5395,7 +5395,7 @@
for(j in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5422,7 +5422,7 @@
for(j in 1:d.size){
for(j2 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5457,7 +5457,7 @@
for(j1 in 1:d.size){
for(j2 in 1:d.size){
- tmp7 <- real(block)
+ tmp7 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -5514,7 +5514,7 @@
for(j in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i1 in 1:d.size){
@@ -5540,7 +5540,7 @@
for(j in 1:d.size){
for(j1 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(i1 in 1:d.size){
@@ -5664,7 +5664,7 @@
for(j2 in 1:d.size){
for(j3 in 1:d.size){
- tmp5 <- real(block)
+ tmp5 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -6282,7 +6282,7 @@
for(j2 in 1:d.size){
for(j4 in 1:d.size){
- tmp2 <- real(block)
+ tmp2 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -6311,7 +6311,7 @@
for(i3 in 1:d.size){
for(i4 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(j4 in 1:d.size){
tmp4 <- tmp4 + 2 * get_Y_D[i3,] * tmpY[i4,j4,] *
@@ -6361,7 +6361,7 @@
for(i3 in 1:d.size){
for(i4 in 1:d.size){
- tmp6 <- real(block)
+ tmp6 <- double(block)
for(j4 in 1:d.size){
tmp6 <- tmp6 + 2 * get_Y_D[i3,] * tmpY[i4,j4,] *
@@ -6515,7 +6515,7 @@
for(i3 in 1:d.size){
for(i4 in 1:d.size){
- tmp14 <- real(block)
+ tmp14 <- double(block)
for(j4 in 1:d.size){
@@ -6555,7 +6555,7 @@
for(i3 in 1:d.size){
for(i4 in 1:d.size){
- tmp16 <- real(block)
+ tmp16 <- double(block)
for(j4 in 1:d.size){
@@ -6843,7 +6843,7 @@
break
}
- tmp1 <- real(block)
+ tmp1 <- double(block)
for(i in 1:d.size){
tmp1 <- tmp1 + h.tmp[l,i,] * get_e_t[i,]
@@ -6868,7 +6868,7 @@
for(j2 in 1:d.size){
for(i in 1:d.size){
for(j in 1:d.size){
- tmp3 <- real(block)
+ tmp3 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -6969,7 +6969,7 @@
for(j1 in 1:d.size){
- tmp9 <- real(block)
+ tmp9 <- double(block)
for(i in 1:d.size){
for(j in 1:d.size){
@@ -7850,7 +7850,7 @@
for(j3 in 1:d.size){
for(i3 in 1:d.size){
- tmp4 <- real(block)
+ tmp4 <- double(block)
for(i1 in 1:d.size){
for(i2 in 1:d.size){
@@ -8534,7 +8534,7 @@
block <- env$block
my.range <- env$my.range
- result <- real(block)
+ result <- double(block)
assign(pars[1],0)
@@ -9086,8 +9086,8 @@
first <- sum(tmp1)/2
- tmp2 <- real(k.size)
- tmp3 <- real(k.size) #added
+ tmp2 <- double(k.size)
+ tmp3 <- double(k.size) #added
for(l in 1:k.size){
Modified: pkg/yuima/R/cce.R
===================================================================
--- pkg/yuima/R/cce.R 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/R/cce.R 2013-04-13 08:31:09 UTC (rev 237)
@@ -23,9 +23,6 @@
#ser.times <- vector(d.size, mode="list")
#ser.times <- lapply(data,time)
ser.times <- lapply(lapply(data,"time"),"as.numeric")
- for(d in 1:d.size){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
ser.lengths <- sapply(data,"length")
ser.samplings <- vector(d.size, mode="list")
refresh.times <- c()
@@ -106,9 +103,6 @@
if(d.size>1){
ser.times <- lapply(lapply(data,"time"),"as.numeric")
- for(d in 1:d.size){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
ser.lengths <- sapply(data,"length")
refresh.times <- max(sapply(ser.times,"[",1))
ser.samplings <- vector(d.size,mode="list")
@@ -167,12 +161,9 @@
Bibsynchro <- function(x,y){
-# xtime <- as.numeric(time(x))
-# ytime <- as.numeric(time(y))
-
- xtime <- round(as.numeric(time(x)),digits=15)
- ytime <- round(as.numeric(time(y)),digits=15)
-
+ xtime <- as.numeric(time(x))
+ ytime <- as.numeric(time(y))
+
xlength <- length(xtime)
ylength <- length(ytime)
@@ -297,8 +288,7 @@
RV.sparse <- function(zdata,frequency=1200,utime){
znum <- as.numeric(zdata)
-# ztime <- as.numeric(time(zdata))*utime
- ztime <- round(as.numeric(time(zdata))*utime,digits=15)
+ ztime <- as.numeric(time(zdata))*utime
n.size <- length(zdata)
end <- ztime[n.size]
@@ -333,8 +323,7 @@
#q <- ceiling(sec/mean(diff(as.numeric(time(zdata))*utime)))
#q <- ceiling(sec*(length(zdata)-1)/utime)
-# ztime <- as.numeric(time(zdata))
- ztime <- round(as.numeric(time(zdata)),digits=15)
+ ztime <- as.numeric(time(zdata))
q <- ceiling(sec*(length(zdata)-1)/(utime*(tail(ztime,n=1)-head(ztime,n=1))))
obj <- diff(as.numeric(zdata),lag=q)
n <- length(obj)
@@ -370,7 +359,7 @@
if(missing(utime)) utime <- ifelse(is.numeric(time(data[[1]])),23400,1)
NS <- sapply(data,FUN=NSratio_BNHLS,frequency=frequency,sec=sec,utime=utime)
- coef <- (b.theta+sqrt(b.theta+3*a.theta*c.theta))/a.theta
+ coef <- (b.theta+sqrt(b.theta^2+3*a.theta*c.theta))/a.theta
return(sqrt(coef*NS))
}
@@ -435,9 +424,10 @@
BPV <- function(x,lag=1){
n <- length(x)-1
- obj <- abs(diff(as.numeric(x)))
+ dt <- diff(as.numeric(time(x)))
+ obj <- abs(diff(as.numeric(x)))/sqrt(dt)
- result <- (pi/2)*obj[1:(n-lag)]%*%obj[(1+lag):n]
+ result <- (pi/2)*(obj[1:(n-lag)]*dt[1:(n-lag)])%*%obj[(1+lag):n]
return(result)
@@ -446,17 +436,20 @@
## local univaersal thresholding method
### data: a list of zoos coef: a positive number
-local_univ_threshold <- function(data,coef=3){
+local_univ_threshold <- function(data,coef=5,eps=0.1){
d.size <- length(data)
- result <- vector(d.size,mode="list")
+ result <- vector(d.size,mode="list")
for(d in 1:d.size){
- #x <- data[[d]]
- x <- as.numeric(data[[d]])
- n <- length(x)
+ x <- data[[d]]
+ #x <- as.numeric(data[[d]])
+ n <- length(x)-1
+ dt <- diff(as.numeric(time(x)))
+ obj <- abs(diff(as.numeric(x)))/sqrt(dt)
+ #dx <- diff(as.numeric(x))
#xtime <- time(x)
#xtime <- time(data[[d]])
@@ -469,25 +462,38 @@
#}
#K <- ceiling(sqrt(1/r))
#K <- max(ceiling(sqrt(1/r)),3)
- K <- max(ceiling(sqrt(n)),3)
+ K <- max(ceiling(n^0.5),3)
coef2 <- coef^2
- rho <- double(n)
+ rho <- double(n+1)
+ #tmp <- coef2*sum(dx^2)*n^(eps-1)
+ #tmp <- double(n+1)
+ #tmp[-(1:(K-1))] <- coef2*n^eps*rollmean(dx^2,k=K-1,align="left")
+ #tmp[1:(K-1)] <- tmp[K]
+ #dx[dx^2>tmp[-(n+1)]] <- 0
+
if(K<n){
#rho[1:K] <- coef2*(mad(diff(as.numeric(x)[1:(K+1)]))/0.6745)^2
- rho[1:K] <- coef2*2*log(K)*(mad(diff(x[1:(K+1)]))/0.6745)^2
+ #rho[1:K] <- coef2*2*log(K)*(mad(diff(x[1:(K+1)]))/0.6745)^2
#for(i in (K+1):n){
# rho[i] <- coef2*2*log(length(x))*BPV(x[(i-K):(i-1)])/(K-2)
#}
- rho[-(1:K)] <- coef2*2*log(n)*
- rollapply(x[-n],width=K,FUN=BPV,align="left")/(K-2)
+ #rho[-(1:K)] <- coef2*2*log(n)^(1+eps)*
+ # #rollapply(x[-n],width=K,FUN=BPV,align="left")/(K-2)
+ rho[-(1:(K-1))] <- coef2*n^eps*(pi/2)*
+ rollmean((obj*dt)[-n]*obj[-1],k=K-2,align="left")
+ #rho[-(1:(K-1))] <- coef2*n^eps*rollmean(dx^2,k=K-1,align="left")
+ rho[1:(K-1)] <- rho[K]
}else{
#rho <- coef2*(mad(diff(as.numeric(x)))/0.6745)^2
- rho <- coef2*(mad(diff(x))/0.6745)^2
+ #rho <- coef2*(mad(diff(x))/0.6745)^2
+ #rho <- coef2*2*log(n)^(1+eps)*BPV(x)
+ rho <- coef2*n^(eps-1)*BPV(x)
+ #rho <- coef2*sum(dx^2)*n^(eps-1)
}
- result[[d]] <- rho[-1]
+ result[[d]] <- rho[-(n+1)]
}
@@ -514,9 +520,8 @@
for(i in 1:n.series){
# set data and time index
ser.X[[i]] <- as.numeric(data[[i]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[i]] <- as.numeric(time(data[[i]]))
- ser.times[[i]] <- round(as.numeric(time(data[[i]])),digits=15)
- # set difference of the data
+ ser.times[[i]] <- as.numeric(time(data[[i]]))
+ # set difference of the data
ser.diffX[[i]] <- diff( ser.X[[i]] )
}
@@ -527,7 +532,8 @@
for(j in i:n.series){
I <- rep(1,n.series)
#Checking Starting Point
- repeat{
+ #repeat{
+ while((I[i]<length(ser.times[[i]])) && (I[j]<length(ser.times[[j]]))){
if(ser.times[[i]][I[i]] >= ser.times[[j]][I[j]+1]){
I[j] <- I[j]+1
}else if(ser.times[[i]][I[i]+1] <= ser.times[[j]][I[j]]){
@@ -620,7 +626,7 @@
n.series <- length(data)
#if(missing(theta)&&missing(kn))
- # theta <- selectParam.pavg(data,utime=utime,a.theta=7585/1161216,
+ # theta <- selectParam.pavg(data,a.theta=7585/1161216,
# b.theta=151/20160,c.theta=1/24)
if(missing(theta)) theta <- 0.15
@@ -646,9 +652,6 @@
# set data and time index
ser.X <- lapply(dat,"as.numeric")
ser.times <- lapply(lapply(dat,"time"),"as.numeric")
- for(d in 1:n.series){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
# set difference of the data
ser.diffX <- lapply(ser.X,"diff")
@@ -711,9 +714,6 @@
# set data and time index
ser.X <- lapply(dat,"as.numeric")
ser.times <- lapply(lapply(dat,"time"),"as.numeric")
- for(d in 1:n.series){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
# set difference of the data
ser.diffX <- lapply(ser.X,"diff")
@@ -787,8 +787,7 @@
for(i in 1:n.series){
# set data and time index
ser.X[[i]] <- as.numeric(data[[i]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[i]] <- as.numeric(time(data[[i]]))
- ser.times[[i]] <- round(as.numeric(time(data[[i]])),digits=15)
+ ser.times[[i]] <- as.numeric(time(data[[i]]))
# set difference of the data
ser.diffX[[i]] <- diff( ser.X[[i]] )
@@ -851,10 +850,6 @@
# set data and time index
ser.X <- lapply(dat,"as.numeric")
ser.times <- lapply(lapply(dat,"time"),"as.numeric")
- for(d in 1:n.series){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
-
# set difference of the data
ser.diffX <- lapply(ser.X,"diff")
@@ -912,8 +907,7 @@
for(i in 1:n.series){
# set data and time index
ser.X[[i]] <- as.numeric(data[[i]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[i]] <- as.numeric(time(data[[i]]))
- ser.times[[i]] <- round(as.numeric(time(data[[i]])),digits=15)
+ ser.times[[i]] <- as.numeric(time(data[[i]]))
# set difference of the data
ser.diffX[[i]] <- diff( ser.X[[i]] )
@@ -1184,7 +1178,9 @@
idx <- d.size*(i-1)-(i-1)*i/2+(j-i)
dat <- refresh_sampling(list(data[[i]],data[[j]]))
- dattime <- apply(do.call("rbind",lapply(dat,"time")),2,"max")
+ dattime <- apply(do.call("rbind",
+ lapply(lapply(dat,"time"),"as.numeric")),
+ 2,"max")
dat[[1]] <- zoo(as.numeric(dat[[1]]),dattime)
dat[[2]] <- zoo(as.numeric(dat[[2]]),dattime)
@@ -1198,7 +1194,7 @@
Sigma2 <- covol.init[2,idx]
Omega1 <- ncov.init[1,idx]
Omega2 <- ncov.init[2,idx]
-
+
if(is.na(Sigma1)) Sigma1 <- RV.sparse(dat1,frequency=1200,utime=utime)
if(is.na(Sigma2)) Sigma2 <- RV.sparse(dat2,frequency=1200,utime=utime)
if(is.na(Omega1)) Omega1 <- Omega_BNHLS(dat1,sec=120,utime=utime)
@@ -1228,6 +1224,7 @@
cmat[i,i] <- constrOptim(theta=c(Sigma,Omega),f=ql$n.ql,grad=ql$gr,
method=opt.method,
ui=diag(2),ci=0,...)$par[1]
+
}
}
}
@@ -1301,7 +1298,7 @@
n.series <- length(data)
if(missing(threshold)){
- threshold <- local_univ_threshold(data)
+ threshold <- local_univ_threshold(data,coef=5,eps=0.1)
}else if(is.numeric(threshold)){
threshold <- matrix(threshold,1,n.series)
}
@@ -1318,9 +1315,7 @@
for(i in 1:n.series){
# set data and time index
ser.X[[i]] <- as.numeric(data[[i]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[i]] <- as.numeric(time(data[[i]]))
- ser.times[[i]] <- round(as.numeric(time(data[[i]])),digits=15)
-
+ ser.times[[i]] <- as.numeric(time(data[[i]]))
# set difference of the data with truncation
ser.diffX[[i]] <- diff( ser.X[[i]] )
@@ -1389,7 +1384,7 @@
n.series <- length(data)
#if(missing(theta)&&missing(kn))
- # theta <- selectParam.pavg(data,utime=utime,a.theta=7585/1161216,
+ # theta <- selectParam.pavg(data,a.theta=7585/1161216,
# b.theta=151/20160,c.theta=1/24)
if(missing(theta)) theta <- 0.15
@@ -1415,9 +1410,6 @@
# set data and time index
ser.X <- lapply(dat,"as.numeric")
ser.times <- lapply(lapply(dat,"time"),"as.numeric")
- for(d in 1:n.series){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
# set difference of the data
ser.diffX <- lapply(ser.X,"diff")
@@ -1548,9 +1540,6 @@
# set data and time index
ser.X <- lapply(dat,"as.numeric")
ser.times <- lapply(lapply(dat,"time"),"as.numeric")
- for(d in 1:n.series){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
# set difference of the data
ser.diffX <- lapply(ser.X,"diff")
@@ -1681,9 +1670,7 @@
for(i in 1:n.series){
# set data and time index
ser.X[[i]] <- as.numeric(data[[i]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[i]] <- as.numeric(time(data[[i]]))
- ser.times[[i]] <- round(as.numeric(time(data[[i]])),digits=15)
-
+ ser.times[[i]] <- as.numeric(time(data[[i]]))
# set difference of the data
ser.diffX[[i]] <- diff( ser.X[[i]] )
}
@@ -1811,10 +1798,6 @@
# set data and time index
ser.X <- lapply(dat,"as.numeric")
ser.times <- lapply(lapply(dat,"time"),"as.numeric")
- for(d in 1:n.series){
- ser.times[[d]] <- round(ser.times[[d]],digits=15)
- }
-
# set difference of the data
ser.diffX <- lapply(ser.X,"diff")
@@ -1936,8 +1919,7 @@
for(i in 1:n.series){
# set data and time index
ser.X[[i]] <- as.numeric(data[[i]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[i]] <- as.numeric(time(data[[i]]))
- ser.times[[i]] <- round(as.numeric(time(data[[i]])),digits=15)
+ ser.times[[i]] <- as.numeric(time(data[[i]]))
# set difference of the data
ser.diffX[[i]] <- diff( ser.X[[i]] )
@@ -2051,8 +2033,7 @@
for(d in 1:d.size){
# set data and time index
ser.X[[d]] <- as.numeric(data[[d]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[d]] <- as.numeric(time(data[[d]]))*utime
- ser.times[[d]] <- round(as.numeric(time(data[[d]]))*utime,digits=15)
+ ser.times[[d]] <- as.numeric(time(data[[d]]))*utime
ser.numX[d] <- length(ser.X[[d]])
}
@@ -2147,8 +2128,7 @@
for(d in 1:d.size){
# set data and time index
ser.X[[d]] <- as.numeric(data[[d]]) # we need to transform data into numeric to avoid problem with duplicated indexes below
-# ser.times[[d]] <- as.numeric(time(data[[d]]))*utime
- ser.times[[d]] <- round(as.numeric(time(data[[d]]))*utime,digits=15)
+ ser.times[[d]] <- as.numeric(time(data[[d]]))*utime
ser.numX[d] <- length(ser.X[[d]])
}
Modified: pkg/yuima/R/llag.R
===================================================================
--- pkg/yuima/R/llag.R 2013-03-10 06:09:37 UTC (rev 236)
+++ pkg/yuima/R/llag.R 2013-04-13 08:31:09 UTC (rev 237)
@@ -125,7 +125,7 @@
}
y <- seq(-num2-tmptheta,num1-tmptheta,length=n)
- tmp <- real(n)
+ tmp <- double(n)
for(i.tmp in 2:(n-1)){
tmp[i.tmp] <- lagccep(datp,y[i.tmp])
More information about the Yuima-commits
mailing list