[Yuima-commits] r169 - pkg/yuima/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 3 12:19:42 CEST 2011
Author: kamatani
Date: 2011-08-03 12:19:42 +0200 (Wed, 03 Aug 2011)
New Revision: 169
Modified:
pkg/yuima/R/asymptotic_term_second.R
pkg/yuima/R/asymptotic_term_third_function.R
Log:
Replace wrong file
Modified: pkg/yuima/R/asymptotic_term_second.R
===================================================================
--- pkg/yuima/R/asymptotic_term_second.R 2011-08-03 10:13:35 UTC (rev 168)
+++ pkg/yuima/R/asymptotic_term_second.R 2011-08-03 10:19:42 UTC (rev 169)
@@ -190,15 +190,19 @@
assign(pars[1],0)
+ de.F <- list()
+
for(k in 1:k.size){
- tmp <- parse(text=deparse(D(tmp.F[k],pars[1])))
+ de.F[[k]] <- parse(text=deparse(D(tmp.F[k],pars[1])))
+ }
- for(t in 1:division){
- for(d in 1:d.size){
- assign(state[d],X.t0[t,d])
- }
+ for(t in 1:division){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[t,d])
+ }
- result[k,t] <- eval(tmp)
+ for(k in 1:k.size){
+ result[k,t] <- eval(de.F[[k]])
}
}
@@ -453,67 +457,23 @@
###############################################################################
- #a:l*t/0, b:l*j*t/j*r*t, c:1/l*r*t, d:l*j1*j2*t/j1*r*t&j2*r*t,
- #e:1/l*j*r*t&j*r*t, f:l*j1*t/j1*j2*r*t&j2*r*t
+ #a:l, b:l*j*r*t/j*r*t, c:l*r*t
-
#l
- ft1_1 <- function(a,env){
+ ft1_1 <- function(a1,env){
k.size <- env$k.size
- block <- env$block
- result <- a[[1]][,block]
+ result <- a1
return(result)
}
- #l*k
-
- ft1_2 <- function(b,env){
-
- d.size <- env$d.size
- k.size <- env$k.size
- block <- env$block
-
- result <- matrix(0,k.size,k.size)
-
- for(j in 1:d.size){
- tmp <- I_1(b[[2]][j,,],env)
-
- for(l in 1:k.size){
- result[l,] <- result[l,] + b[[1]][l,j,block] * tmp[,block]
- }
- }
-
- return(result)
- }
-
-
- #l*k
-
- ft1_3 <- function(c,env){
-
- k.size <- env$k.size
- block <- env$block
-
- result <- matrix(0,k.size,k.size)
-
- for(l in 1:k.size){
- tmp <- I_1(c[[2]][l,,],env)
-
- result[l,] <- c[[1]] * tmp[,block]
- }
-
- return(result)
- }
-
-
#first:l*k*k, second:l
- ft1_4 <- function(d,env){
+ ft1_2 <- function(b1,env){
d.size <- env$d.size
k.size <- env$k.size
@@ -522,42 +482,12 @@
first <- array(0,dim=c(k.size,k.size,k.size))
second <- real(k.size)
- for(j1 in 1:d.size){
- for(j2 in 1:d.size){
- tmp <- I_12(d[[2]][[1]][j1,,],d[[2]][[2]][j2,,],env)
-
- for(l in 1:k.size){
- first[l,,] <- first[l,,] +
- d[[1]][l,j1,j2,block] * tmp$first[,,block]
-
- second[l] <- second[l] +
- d[[1]][l,j1,j2,block] * tmp$second[block]
- }
- }
- }
-
- return(list(first=first,second=second))
- }
-
-
- #first:l*k*k, second:l
-
- ft1_5 <- function(e,env){
-
- d.size <- env$d.size
- k.size <- env$k.size
- block <- env$block
-
- first <- array(0,dim=c(k.size,k.size,k.size))
- second <- real(k.size)
-
for(l in 1:k.size){
for(j in 1:d.size){
- tmp <- I_12(e[[2]][[1]][l,j,,],e[[2]][[2]][j,,],env)
+ tmp <- I_12(b1[[1]][l,j,,],b1[[2]][j,,],env)
- first[l,,] <- first[l,,] + e[[1]] * tmp$first[,,block]
-
- second[l] <- second[l] + e[[1]] * tmp$second[block]
+ first[l,,] <- first[l,,] + tmp$first[,,block]
+ second <- second + tmp$second[block]
}
}
@@ -565,32 +495,22 @@
}
- #first:l*k*k, second:l
+ #l*k
- ft1_6 <- function(f,env){
+ ft1_3 <- function(c1,env){
- d.size <- env$d.size
k.size <- env$k.size
block <- env$block
- first <- array(0,dim=c(k.size,k.size,k.size))
- second <- real(k.size)
+ result <- matrix(0,k.size,k.size)
- for(j1 in 1:d.size){
- for(j2 in 1:d.size){
- tmp <- I_12(f[[2]][[1]][j1,j2,,],f[[2]][[2]][j1,,],env)
+ for(l in 1:k.size){
+ tmp <- I_1(c1[l,,],env)
- for(l in 1:k.size){
- first[l,,] <- first[l,,] +
- f[[1]][l,j2,block] * tmp$first[,,block]
-
- second[l] <- second[l] +
- f[[1]][l,j2,block] * tmp$second[block]
- }
- }
+ result[l,] <- tmp[,block]
}
- return(list(first=first,second=second))
+ return(result)
}
@@ -603,68 +523,51 @@
temp$second <- matrix(0,k.size,k.size)
temp$third <- real(k.size)
- calc.range <- c(1:30)
- for(i in 1:7){
- tmp <- get_F_tilde1[[i]][[1]]
- n1 <- length(tmp)
- n2 <- sum(tmp == 0)
+ calc.range <- c(1:3)
- if(n1 == n2){
- calc.range <- calc.range[calc.range != i]
- }
+ tmp1 <- get_F_tilde1$result1
+
+ n1 <- length(tmp1)
+ n2 <- sum(tmp1 == 0)
+
+ if(n1 == n2){
+ calc.range <- calc.range[calc.range != 1]
}
- for(i in 8:21){
- tmp1 <- get_F_tilde1[[i]][[1]]
- n1 <- length(tmp1)
- n2 <- sum(tmp1 == 0)
+ tmp2 <- get_F_tilde1$result2[[1]]
- tmp2 <- get_F_tilde1[[i]][[2]]
- n3 <- length(tmp2)
- n4 <- sum(tmp2 == 0)
+ n3 <- length(tmp2)
+ n4 <- sum(tmp2 == 0)
- n <- (n1 - n2 != 0) * (n3 - n4 != 0)
+ tmp3 <- get_F_tilde1$result2[[2]]
- if(n == 0){
- calc.range <- calc.range[calc.range != i]
- }
- }
+ n5 <- length(tmp3)
+ n6 <- sum(tmp3 == 0)
- for(i in 22:30){
- tmp1 <- get_F_tilde1[[i]][[1]]
- n1 <- length(tmp1)
- n2 <- sum(tmp1 == 0)
+ n <- (n3 - n4 != 0) * (n5 - n6 != 0)
- tmp2 <- get_F_tilde1[[i]][[2]][[1]]
- n3 <- length(tmp2)
- n4 <- sum(tmp2 == 0)
+ if(n == 0){
+ calc.range <- calc.range[calc.range != 2]
+ }
- tmp3 <- get_F_tilde1[[i]][[2]][[2]]
- n5 <- length(tmp3)
- n6 <- sum(tmp3 == 0)
+ tmp3 <- get_F_tilde1$result3
- n <- (n1 - n2 != 0) * (n3 - n4 != 0) * (n5 - n6 != 0)
+ n7 <- length(tmp3)
+ n8 <- sum(tmp3 == 0)
- if(n == 0){
- calc.range <- calc.range[calc.range != i]
- }
+ if(n7 == n8){
+ calc.range <- calc.range[calc.range != 3]
}
for(i in calc.range){
- tmp <- switch(i,"a","a","a","a","a","a","a","b","b","c",
- "b","c","b","c","b","c","b","b","b","b",
- "b","d","e","d","e","f","e","d","f","d")
+ tmp <- switch(i,"a","b","c")
-
result <- switch(tmp,"a"=ft1_1(get_F_tilde1[[i]],env),
"b"=ft1_2(get_F_tilde1[[i]],env),
- "c"=ft1_3(get_F_tilde1[[i]],env),
- "d"=ft1_4(get_F_tilde1[[i]],env),
- "e"=ft1_5(get_F_tilde1[[i]],env),
- "f"=ft1_6(get_F_tilde1[[i]],env))
+ "c"=ft1_3(get_F_tilde1[[i]],env))
nlist <- length(result)
@@ -726,18 +629,19 @@
#h:d*block
- #first:numeric(1), second:r.size*block, third:r.size*block
+ #first:numeric(1), second:k.size*block
Di_bar <- function(h,env){
block <- env$block
first <- real(1)
- second <- matrix(0,r.size,block)
- third <- matrix(0,r.size,block)
tmp4 <- matrix(0,r.size,block)
+ tmp6 <- matrix(0,r.size,block)
+ tmp5 <- matrix(0,r.size,block)
+
for(i in 1:d.size){
tmp1 <- h[i,] * get_Y_D[i,]
first <- first + I0(tmp1,env)[block]
@@ -745,16 +649,19 @@
for(j in 1:d.size){
tmp2 <- h[i,] * tmpY[i,j,]
tmp3 <- I0(tmp2,env)
- second <- second + tmp3[block] * get_Y_e_V[j,,]
+ tmp4 <- tmp4 + tmp3[block] * get_Y_e_V[j,,]
for(r in 1:r.size){
- tmp4[r,] <- tmp3 * get_Y_e_V[j,r,]
+ tmp5[r,] <- tmp3 * get_Y_e_V[j,r,]
}
- third <- third + tmp4
+ tmp6 <- tmp6 + tmp5
}
}
- return(list(first=first,second=second,third=third))
+ tmp7 <- tmp4 - tmp6
+ second <- I_1(tmp7,env)
+
+ return(list(first=first,second=second))
}
@@ -762,19 +669,18 @@
tmp1 <- Di_bar(h,env)
- for(r in 1:r.size){
- tmp2 <- I_1(tmp1$second[r,],env)
- tmp3 <- I_1(tmp1$third[r,],env)
- result <- tmp1$first + I_1_x(x,tmp2,env) -
- I_1_x(x,tmp3,env)
- }
+ tmp2 <- tmp1$second
+ result <- tmp1$first + I_1_x(x,tmp2,env)
+
return(result)
}
get.P2 <- function(z){
+ block <- env$block
+
if(k.size==1){
First <- Di_bar_x(di.rho,z)
Second <- rep(de.rho %*% Diff[block,] * delta ,length(z))
@@ -782,7 +688,10 @@
First <- Di_bar_x(di.rho,z)
Second <- de.rho %*% Diff[block,] * delta
}
+
tmp <- First + Second
+
+ return(tmp)
}
@@ -835,7 +744,7 @@
get.d1.term<- function(){
## get g(z)*pi1(z)
-
+
gz_pi1 <- function(z){
tmp <- G(z) * get.pi1(z)
return( tmp )
@@ -857,20 +766,20 @@
return( tmp )
}
- my.x <- matrix(0,k.size,30^k.size)
+ my.x <- matrix(0,k.size,20^k.size)
dt <- 1
for(k in 1:k.size){
max <- 7 * sqrt(lambda[k])
min <- -7 * sqrt(lambda[k])
- tmp.x <- seq(min,max,length=30)
+ tmp.x <- seq(min,max,length=20)
dt <- dt * (tmp.x[2] - tmp.x[1])
- my.x[k,] <- rep(tmp.x,each=30^(k.size-k),times=30^(k-1))
+ my.x[k,] <- rep(tmp.x,each=20^(k.size-k),times=20^(k-1))
}
tmp <- 0
- for(i in 1:30^k.size){
+ for(i in 1:20^k.size){
tmp <- tmp + gz_pi1(my.x[,i])
}
@@ -887,11 +796,15 @@
# d(rho)/di
get.di.rho <- function(){
+
+ assign(pars[1],0)
di.rho <- numeric(d.size)
tmp <- matrix(0,d.size,block+1)
+
for(i in 1:d.size){
di.rho[i] <- deriv(rho,state[i])
}
+
for(t in 1:(block+1)){
for(i in 1:d.size){
assign(state[i],X.t0[t,i])
@@ -906,8 +819,11 @@
# d(rho)/de
get.de.rho <- function(){
+
+ assign(pars[1],0)
tmp <- matrix(0,1,block+1)
de.rho <- deriv(rho,pars[1])
+
for(t in 1:(block+1)){
for(i in 1:d.size){
assign(state[i],X.t0[t,i])
@@ -923,8 +839,8 @@
get.H0 <- function(){
assign(pars[1],0)
-
tmp <- matrix(0,1,division-1)
+
for(t in 1:(division-1)){
for(i in 1:d.size){
assign(state[i],X.t0[t,i])
@@ -943,7 +859,7 @@
## initialization part
division <- nrow(X.t0)
-# delta <- T/(division - 1)
+ delta <- T/(division - 1)
# make expressions of derivation of V0
dx.drift <- Derivation.vector(V0,state,d.size,d.size)
@@ -1111,7 +1027,7 @@
get_e_t <- e_t(tmpY, get_Y_e_V, get_Y_D, get_Y_x1_x2_V0, get_Y_x_e_V0, get_Y_e_e_V0, env)
get_U_t <- U_t(tmpY, get_Y_D, get_Y_x1_x2_V0, get_Y_x_e_V0, env)
get_U_hat_t <- U_hat_t(tmpY, get_Y_e_V, get_Y_D, get_Y_x1_x2_V0, get_Y_x_e_V, env)
- get_E0_t <- E0_t(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_x_e_V, get_Y_e_e_V, get_e_t, get_U_t, get_U_hat_t, env)
+ get_E0_t <- E0_t(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_e_e_V, get_e_t, get_U_t, get_U_hat_t, env)
get_e_f0 <- e_f0(X.t0,f,env)
get_e_f <- e_f(X.t0,f,env)
@@ -1128,14 +1044,14 @@
get_W_hat_t <- W_hat_t (tmpY, get_Y_e_V, get_x1_x2_f0, get_x_e_f, env)
get_F_tilde1_1 <- F_tilde1_1(tmpY, get_Y_e_V, get_x1_x2_f0, get_e_e_f, get_F_t, get_W_t, get_W_hat_t, env)
- get_F_tilde1_2 <- F_tilde1_2(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_e_e_V, get_e_t, get_x_f0, get_x1_x2_f0, get_e_e_f, get_U_t, get_U_hat_t, env)
+ get_F_tilde1_2 <- F_tilde1_2(get_E0_t,get_x_f0,env)
get_x_F <- x_F(X.t0,F,env)
get_x1_x2_F <- x1_x2_F(X.t0,F,env)
get_x_e_F <- x_e_F(X.t0,F,env)
get_e_e_F <- e_e_F(X.t0,F,env)
- get_F_tilde1_3 <- F_tilde1_3(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_e_e_V, get_e_t, get_U_t, get_U_hat_t, get_x_F, env)
+ get_F_tilde1_3 <- F_tilde1_3(get_E0_t,get_x_F,env)
get_F_tilde1_4 <- F_tilde1_4(tmpY, get_Y_e_V, get_Y_D, get_x_F, get_x1_x2_F, get_x_e_F, get_e_e_F, env)
get_F_tilde1 <- F_tilde1(get_F_tilde1_1, get_F_tilde1_2, get_F_tilde1_3, get_F_tilde1_4)
Modified: pkg/yuima/R/asymptotic_term_third_function.R
===================================================================
--- pkg/yuima/R/asymptotic_term_third_function.R 2011-08-03 10:13:35 UTC (rev 168)
+++ pkg/yuima/R/asymptotic_term_third_function.R 2011-08-03 10:19:42 UTC (rev 169)
@@ -2137,13 +2137,13 @@
}
}
- result <- first + second
+ result <- first - second
return(result)
}
- E0_t <- function(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_x_e_V, get_Y_e_e_V, get_e_t, get_U_t, get_U_hat_t, env){
+ E0_t <- function(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_e_e_V, get_e_t, get_U_t, get_U_hat_t, env){
d.size <- env$d.size
r.size <- env$r.size
@@ -2241,15 +2241,19 @@
assign(pars[1],0)
+ de.f0 <- list()
+
for(k in 1:k.size){
- tmp <- parse(text=deparse(D(tmp.f[[1]][k],pars[1])))
+ de.f0[[k]] <- parse(text=deparse(D(tmp.f[[1]][k],pars[1])))
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,t] <- eval(tmp)
+ for(k in 1:k.size){
+ result[k,t] <- eval(de.f0[[k]])
}
}
@@ -2273,16 +2277,24 @@
assign(pars[1],0)
+ de.f <- list()
+
for(k in 1:k.size){
+ de.f[[k]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(tmp.f[[r+1]][k],pars[1])))
+ de.f[[k]][r] <- parse(text=deparse(D(tmp.f[[r+1]][k],pars[1])))
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(r in 1:r.size){
+ result[k,r,t] <- eval(de.f[[k]][[r]])
}
}
}
@@ -2307,16 +2319,24 @@
assign(pars[1],0)
+ dx.f0 <- list()
+
for(k in 1:k.size){
+ dx.f0[[k]] <- list()
+
for(i in 1:d.size){
- tmp <- parse(text=deparse(D(tmp.f[[1]][k],state[i])))
+ dx.f0[[k]][i] <- parse(text=deparse(D(tmp.f[[1]][k],state[i])))
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i in 1:d.size){
+ result[k,i,t] <- eval(dx.f0[[k]][[i]])
}
}
}
@@ -2341,17 +2361,29 @@
assign(pars[1],0)
+ dxdx.f0 <- list()
+
for(k in 1:k.size){
+ dxdx.f0[[k]] <- list()
+
for(i1 in 1:d.size){
+ dxdx.f0[[k]][[i1]] <- list()
+
for(i2 in 1:d.size){
- tmp <- parse(text=deparse(D(D(tmp.f[[1]][k],state[i2]),state[i1])))
+ dxdx.f0[[k]][[i1]][i2] <- parse(text=deparse(D(D(tmp.f[[1]][k],state[i2]),state[i1])))
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i1,i2,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i1 in 1:d.size){
+ for(i2 in 1:d.size){
+ result[k,i1,i2,t] <- eval(dxdx.f0[[k]][[i1]][[i2]])
}
}
}
@@ -2377,18 +2409,34 @@
assign(pars[1],0)
+ dxdx.f <- list()
+
for(k in 1:k.size){
+ dxdx.f[[k]] <- list()
+
for(i1 in 1:d.size){
+ dxdx.f[[k]][[i1]] <- list()
+
for(i2 in 1:d.size){
+ dxdx.f[[k]][[i1]][[i2]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(tmp.f[[r+1]][k],state[i2]),state[i1])))
+ dxdx.f[[k]][[i1]][[i2]][r] <- parse(text=deparse(D(D(tmp.f[[r+1]][k],state[i2]),state[i1])))
+ }
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i1,i2,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i1 in 1:d.size){
+ for(i2 in 1:d.size){
+ for(r in 1:r.size){
+ result[k,i1,i2,r,t] <- eval(dxdx.f[[k]][[i1]][[i2]][[r]])
}
}
}
@@ -2415,16 +2463,24 @@
assign(pars[1],0)
+ dxde.f0 <- list()
+
for(k in 1:k.size){
+ dxde.f0[[k]] <- list()
+
for(i in 1:d.size){
- tmp <- parse(text=deparse(D(D(tmp.f[[1]][k],pars[1]),state[i])))
+ dxde.f0[[k]][i] <- parse(text=deparse(D(D(tmp.f[[1]][k],pars[1]),state[i])))
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i in 1:d.size){
+ result[k,i,t] <- eval(dxde.f0[[k]][[i]])
}
}
}
@@ -2449,17 +2505,29 @@
assign(pars[1],0)
+ dxde.f <- list()
+
for(k in 1:k.size){
+ dxde.f[[k]] <- list()
+
for(i in 1:d.size){
+ dxde.f[[k]][[i]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(tmp.f[[r+1]][k],pars[1]),state[i])))
+ dxde.f[[k]][[i]][r] <- parse(text=deparse(D(D(tmp.f[[r+1]][k],pars[1]),state[i])))
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i in 1:d.size){
+ for(r in 1:r.size){
+ result[k,i,r,t] <- eval(dxde.f[[k]][[i]][[r]])
}
}
}
@@ -2485,15 +2553,19 @@
assign(pars[1],0)
+ dede.f0 <- list()
+
for(k in 1:k.size){
- tmp <- parse(text=deparse(D(D(tmp.f[[1]][k],pars[1]),pars[1])))
+ dede.f0[[k]] <- parse(text=deparse(D(D(tmp.f[[1]][k],pars[1]),pars[1])))
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,t] <- eval(tmp)
+ for(k in 1:k.size){
+ result[k,t] <- eval(dede.f0[[k]])
}
}
@@ -2517,16 +2589,24 @@
assign(pars[1],0)
+ dede.f <- list()
+
for(k in 1:k.size){
+ dede.f[[k]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(tmp.f[[r+1]][k],pars[1]),pars[1])))
+ dede.f[[k]][r] <- parse(text=deparse(D(D(tmp.f[[r+1]][k],pars[1]),pars[1])))
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(r in 1:r.size){
+ result[k,r,t] <- eval(dede.f[[k]][[r]])
}
}
}
@@ -2551,18 +2631,34 @@
assign(pars[1],0)
+ dxdxdx.f0 <- list()
+
for(k in 1:k.size){
+ dxdxdx.f0[[k]] <- list()
+
for(i1 in 1:d.size){
+ dxdxdx.f0[[k]][[i1]] <- list()
+
for(i2 in 1:d.size){
+ dxdxdx.f0[[k]][[i1]][[i2]] <- list()
+
for(i3 in 1:d.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[1]][k],state[i3]),state[i2]),state[i1])))
+ dxdxdx.f0[[k]][[i1]][[i2]][i3] <- parse(text=deparse(D(D(D(tmp.f[[1]][k],state[i3]),state[i2]),state[i1])))
+ }
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i1,i2,i3,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i1 in 1:d.size){
+ for(i2 in 1:d.size){
+ for(i3 in 1:d.size){
+ result[k,i1,i2,i3,t] <- eval(dxdxdx.f0[[k]][[i1]][[i2]][[i3]])
}
}
}
@@ -2589,19 +2685,39 @@
assign(pars[1],0)
+ dxdxdx.f <- list()
+
for(k in 1:k.size){
+ dxdxdx.f[[k]] <- list()
+
for(i1 in 1:d.size){
+ dxdxdx.f[[k]][[i1]] <- list()
+
for(i2 in 1:d.size){
+ dxdxdx.f[[k]][[i1]][[i2]] <- list()
+
for(i3 in 1:d.size){
+ dxdxdx.f[[k]][[i1]][[i2]][[i3]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],state[i3]),state[i2]),state[i1])))
+ dxdxdx.f[[k]][[i1]][[i2]][[i3]][r] <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],state[i3]),state[i2]),state[i1])))
+ }
+ }
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i1,i2,i3,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i1 in 1:d.size){
+ for(i2 in 1:d.size){
+ for(i3 in 1:d.size){
+ for(r in 1:r.size){
+ result[k,i1,i2,i3,r,t] <- eval(dxdxdx.f[[k]][[i1]][[i2]][[i3]][[r]])
}
}
}
@@ -2629,17 +2745,29 @@
assign(pars[1],0)
+ dxdxde.f0 <- list()
+
for(k in 1:k.size){
+ dxdxde.f0[[k]] <- list()
+
for(i1 in 1:d.size){
+ dxdxde.f0[[k]][[i1]] <- list()
+
for(i2 in 1:d.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[1]][k],pars[1]),state[i2]),state[i1])))
+ dxdxde.f0[[k]][[i1]][i2] <- parse(text=deparse(D(D(D(tmp.f[[1]][k],pars[1]),state[i2]),state[i1])))
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i1,i2,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i1 in 1:d.size){
+ for(i2 in 1:d.size){
+ result[k,i1,i2,t] <- eval(dxdxde.f0[[k]][[i1]][[i2]])
}
}
}
@@ -2665,18 +2793,34 @@
assign(pars[1],0)
+ dxdxde.f <- list()
+
for(k in 1:k.size){
+ dxdxde.f[[k]] <- list()
+
for(i1 in 1:d.size){
+ dxdxde.f[[k]][[i1]] <- list()
+
for(i2 in 1:d.size){
+ dxdxde.f[[k]][[i1]][[i2]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],pars[1]),state[i2]),state[i1])))
+ dxdxde.f[[k]][[i1]][[i2]][r] <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],pars[1]),state[i2]),state[i1])))
+ }
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i1,i2,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i1 in 1:d.size){
+ for(i2 in 1:d.size){
+ for(r in 1:r.size){
+ result[k,i1,i2,r,t] <- eval(dxdxde.f[[k]][[i1]][[i2]][[r]])
}
}
}
@@ -2703,16 +2847,24 @@
assign(pars[1],0)
+ dxdede.f0 <- list()
+
for(k in 1:k.size){
+ dxdede.f0[[k]] <- list()
+
for(i in 1:d.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[1]][k],pars[1]),pars[1]),state[i])))
+ dxdede.f0[[k]][i] <- parse(text=deparse(D(D(D(tmp.f[[1]][k],pars[1]),pars[1]),state[i])))
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i in 1:d.size){
+ result[k,i,t] <- eval(dxdede.f0[[k]][[i]])
}
}
}
@@ -2737,17 +2889,29 @@
assign(pars[1],0)
+ dxdede.f <- list()
+
for(k in 1:k.size){
+ dxdede.f[[k]] <- list()
+
for(i in 1:d.size){
+ dxdede.f[[k]][[i]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],pars[1]),pars[1]),state[i])))
+ dxdede.f[[k]][[i]][r] <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],pars[1]),pars[1]),state[i])))
+ }
+ }
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,i,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(i in 1:d.size){
+ for(r in 1:r.size){
+ result[k,i,r,t] <- eval(dxdede.f[[k]][[i]][[r]])
}
}
}
@@ -2773,15 +2937,19 @@
assign(pars[1],0)
+ dedede.f0 <- list()
+
for(k in 1:k.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[1]][k],pars[1]),pars[1]),pars[1])))
+ dedede.f0[[k]] <- parse(text=deparse(D(D(D(tmp.f[[1]][k],pars[1]),pars[1]),pars[1])))
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- result[k,t] <- eval(tmp)
+ for(k in 1:k.size){
+ result[k,t] <- eval(dedede.f0[[k]])
}
}
@@ -2803,18 +2971,24 @@
result <- array(0,dim=c(k.size,r.size,block))
+ dedede.f <- list()
+
for(k in 1:k.size){
+ dedede.f[[k]] <- list()
+
for(r in 1:r.size){
- tmp <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],pars[1]),pars[1]),pars[1])))
+ dedede.f[[k]][r] <- parse(text=deparse(D(D(D(tmp.f[[r+1]][k],pars[1]),pars[1]),pars[1])))
+ }
+ }
- assign(pars[1],0)
+ for(t in 1:block){
+ for(d in 1:d.size){
+ assign(state[d],X.t0[my.range[t],d])
+ }
- for(t in 1:block){
- for(d in 1:d.size){
- assign(state[d],X.t0[my.range[t],d])
- }
-
- result[k,r,t] <- eval(tmp)
+ for(k in 1:k.size){
+ for(r in 1:r.size){
+ result[k,r,t] <- eval(dedede.f[[k]][[r]])
}
}
}
@@ -2987,9 +3161,7 @@
}
- #first:l*t, second.coef:l*j1*j2*t, second:j1*r*t&j2*r*t,
- #third.coef:l*j1*t, third:j1*r*t,fourth.coef:-2, fourth:l*r*t,
- #fifth.coef:2, fifth:l*j1*r*t&j1*r*t, sixth:l*r*t
+ #first:l, second:l*j2*r*t&j2*r*t, third:l*r*t
F_tilde1_1 <- function(tmpY, get_Y_e_V, get_x1_x2_f0, get_e_e_f, get_F_t, get_W_t, get_W_hat_t, env){
@@ -2998,63 +3170,74 @@
k.size <- env$k.size
block <- env$block
- first <- get_F_t
+ first <- get_F_t[block]
- second.coef <- array(0,dim=c(k.size,d.size,d.size,block)) #l, j1, j2, t
+ second <- list()
+ second[[1]] <- array(0,dim=c(k.size,d.size,r.size,block))
+ second[[2]] <- get_Y_e_V
for(l in 1:k.size){
for(j1 in 1:d.size){
for(j2 in 1:d.size){
+
+ tmp2 <- real(block)
+ tmp3 <- real(1)
+
for(i1 in 1:d.size){
for(i2 in 1:d.size){
tmp1 <- get_x1_x2_f0[l,i1,i2,] *
tmpY[i1,j1,] * tmpY[i2,j2,]
- second.coef[l,j1,j2,] <- second.coef[l,j1,j2,] +
- 2 * I0(tmp1,env)
+ tmp2 <- tmp2 + tmp1
}
}
+
+ tmp3 <- tmp3 + 2 * I0(tmp2,env)[block]
+
+ for(r in 1:r.size){
+ second[[1]][l,j2,r,] <- second[[1]][l,j2,r,] +
+ tmp3 * get_Y_e_V[j1,r,]
+ }
}
}
}
- second <- list()
- second[[1]] <- get_Y_e_V
- second[[2]] <- get_Y_e_V
-
third.coef <- array(0,dim=c(k.size,d.size,block)) #l, j1, t
+ third <- array(0,dim=c(k.size,r.size,block))
for(l in 1:k.size){
- for(j1 in 1:d.size){
- third.coef[l,j1,] <- 2 * I0(get_W_t[l,j1,],env)
- }
- }
+ for(j1 in 1:d.size){
- third <- get_Y_e_V
+ third.coef[l,j1,] <- 2 * I0(get_W_t[l,j1,],env)
- fourth.coef <- - 2
+ for(r in 1:r.size){
+ third[l,r,] <- third[l,r,] +
+ third.coef[l,j1,block] * get_Y_e_V[j1,r,]
+ }
+ }
+ }
+
fourth <- array(0,dim=c(k.size,r.size,block))
for(l in 1:k.size){
for(j1 in 1:d.size){
for(r in 1:r.size){
- fourth[l,r,] <- fourth[l,r,] +
- third.coef[l,j1,]/2 * get_Y_e_V[j1,r,]
+ fourth[l,r,] <- fourth[l,r,] -
+ third.coef[l,j1,] * get_Y_e_V[j1,r,]
}
}
}
- fifth.coef <- 2
fifth <- list()
- fifth[[1]] <- get_W_hat_t
+ fifth[[1]] <- 2 * get_W_hat_t
fifth[[2]] <- get_Y_e_V
sixth <- get_e_e_f
- return(list(first=first,second.coef=second.coef,second=second,
- third.coef=third.coef,third=third,
- fourth.coef=fourth.coef,fourth=fourth,
- fifth.coef=fifth.coef,fifth=fifth,sixth=sixth))
+ second[[1]] <- second[[1]] + fifth[[1]]
+ third <- third + fourth + sixth
+
+ return(list(first=first,second=second,third=third))
}
@@ -3226,190 +3409,152 @@
}
- #first:l*t, second.coef:l*j1*j2*t, second:j1*r*t&j2*r*t, third.coef:-1,
- #third:l*j2*r*t&j2*r*t, fourth.coef:l*j1*t, fourth:j1*r*t, fifth.coef:-1,
- #fifth:l*r*t, sixth.coef:l*j*t,sixth:j*r*t, seventh:l*r*t,
- #eighth.coef:l*j*t, eighth:j*j1*r*t&j1*r*t, ninth.coef:-1,
- #ninth:l*j1*r*t&j1*r*t, tenth.coef:l*j*t, tenth:j*r*t,
- #eleventh.coef:-1, eleventh:l*r*t
+ #first:l, second:l*j2*r*t&j2*r*t, third:l*r*t
- F_tilde1_2 <- function(tmpY, get_Y_e_V, get_Y_x1_x2_V0, get_Y_e_e_V, get_e_t, get_x_f0, get_x1_x2_f0, get_e_e_f, get_U_t, get_U_hat_t, env){
+ F_tilde1_2 <- function(get_E0_t,get_x_f0,env){
d.size <- env$d.size
r.size <- env$r.size
k.size <- env$k.size
block <- env$block
- first <- matrix(0,k.size,block)
+ result1 <- get_E0_t$first
+ first <- real(k.size)
+
for(l in 1:k.size){
for(i in 1:d.size){
- tmp1 <- get_x_f0[l,i,] * get_e_t[i,]
- first[l,] <- first[l,] + I0(tmp1,env)
+ tmp1 <- get_x_f0[l,i,] * result1[i,]
+ first[l] <- first[l] + I0(tmp1,env)[block]
}
}
- second.coef <- array(0,dim=c(k.size,d.size,d.size,block)) #l, j1, j2,t
+ result2.coef <- get_E0_t$second.coef
+ result2 <- get_E0_t$second[[1]]
second <- list()
- second[[1]] <- get_Y_e_V
- second[[2]] <- get_Y_e_V
+ second[[1]] <- array(0,dim=c(k.size,d.size,r.size,block)) #l,j2,r,t
+ second[[2]] <- result2
- third.coef <- - 1
-
third <- list()
third[[1]] <- array(0,dim=c(k.size,d.size,r.size,block))
- third[[2]] <- get_Y_e_V
+ third[[2]] <- result2
for(l in 1:k.size){
- for(j1 in 1:d.size){
- for(j2 in 1:d.size){
- for(i1 in 1:d.size){
- for(i2 in 1:d.size){
- for(j in 1:d.size){
+ for(j2 in 1:d.size){
+ for(j1 in 1:d.size){
- tmp2 <- get_Y_x1_x2_V0[i1,i2,j,] *
- tmpY[i1,j1,] * tmpY[i2,j2,]
+ tmp3 <- real(block)
- tmp3 <- I0(tmp2,env)
+ for(i in 1:d.size){
+ tmp2 <- get_x_f0[l,i,] * result2.coef[i,j1,j2,]
- for(i in 1:d.size){
+ tmp3 <- tmp3 + tmp2
+ }
- tmp4 <- 2 * get_x_f0[l,i,] *
- tmpY[i,j,] * tmp3
+ tmp4 <- I0(tmp3,env)
- tmp5 <- I0(tmp4,env)
- second.coef[l,j1,j2,] <- second.coef[l,j1,j2,] + tmp5
+ for(r in 1:r.size){
+ second[[1]][l,j2,r,] <- second[[1]][l,j2,r,] +
+ tmp4[block] * result2[j1,r,]
- for(t in 1:block){
- third[[1]][l,j2,,t] <- third[[1]][l,j2,,t] +
- tmp5[t] * get_Y_e_V[j1,,t]
- }
- }
- }
- }
+ third[[1]][l,j2,r,] <- third[[1]][l,j2,r,] -
+ tmp4 * result2[j1,r,]
}
}
}
}
- fourth.coef <- array(0,dim=c(k.size,d.size,block))
- fourth <- get_Y_e_V
+ result4.coef <- get_E0_t$third.coef
- fifth.coef <- - 1
+ fourth <- array(0,dim=c(k.size,r.size,block))
+
fifth <- array(0,dim=c(k.size,r.size,block))
- I0_U <- array(0,dim=c(d.size,d.size,block))
-
- for(j1 in 1:d.size){
- for(j in 1:d.size){
- I0_U[j1,j,] <- I0(get_U_t[j1,j,],env)
- }
- }
-
for(l in 1:k.size){
for(j1 in 1:d.size){
- for(i in 1:d.size){
- for(j in 1:d.size){
- tmp6 <- I0_U[j1,j,]
- tmp7 <- 2 * get_x_f0[l,i,] *
- tmpY[i,j,] * tmp6
+ tmp6 <- real(block)
- fourth.coef[l,j1,] <- fourth.coef[l,j1,] + I0(tmp7,env)
- }
- }
+ for(i in 1:d.size){
+ tmp5 <- get_x_f0[l,i,] * result4.coef[i,j1,]
- for(t in 1:block){
- fifth[l,,t] <- fifth[l,,t] + fourth.coef[l,j1,t] * get_Y_e_V[j1,,t]
+ tmp6 <- tmp6 + tmp5
}
- }
- }
- sixth.coef <- array(0,dim=c(k.size,d.size,block))
- sixth <- array(0,dim=c(d.size,r.size,block))
+ tmp7 <- I0(tmp6,env)
- for(l in 1:k.size){
- for(j in 1:d.size){
- tmp8 <- real(block)
+ for(r in 1:r.size){
+ fourth[l,r,] <- fourth[l,r,] + tmp7[block] * result2[j1,r,]
- for(i in 1:d.size){
- tmp9 <- 2 * get_x_f0[l,i,] *
- tmpY[i,j,]
-
- tmp8 <- tmp8 + tmp9
+ fifth[l,r,] <- fifth[l,r,] - tmp7 * result2[j1,r,]
}
-
- sixth.coef[l,j,] <- sixth.coef[l,j,] - I0(tmp8,env)
}
}
- for(j in 1:d.size){
- for(j1 in 1:d.size){
- for(t in 1:block){
- sixth[j,,t] <- sixth[j,,t] + I0_U[j1,j,t] * get_Y_e_V[j1,,t]
- }
- }
- }
+ result6.coef <- get_E0_t$fourth.coef
+ result6 <- get_E0_t$fourth
- seventh <- array(0,dim=c(k.size,r.size,block))
+ result8 <- get_E0_t$fifth[[1]]
- for(l in 1:k.size){
- for(j in 1:d.size){
- for(j1 in 1:d.size){
- for(t in 1:block){
- seventh[l,,t] <- seventh[l,,t] - sixth.coef[l,j,t] *
- I0_U[j1,j,t] * get_Y_e_V[j1,,t]
- }
- }
- }
- }
+ result10 <- get_E0_t$sixth
- eighth.coef <- - sixth.coef
+ sixth <- array(0,dim=c(k.size,r.size,block))
+
+ seventh <- array(0,dim=c(k.size,r.size,block))
+
eighth <- list()
- eighth[[1]] <- get_U_hat_t
- eighth[[2]] <- get_Y_e_V
+ eighth[[1]] <- array(0,dim=c(k.size,d.size,r.size,block))
+ eighth[[2]] <- result2
- ninth.coef <- - 1
ninth <- list()
ninth[[1]] <- array(0,dim=c(k.size,d.size,r.size,block))
- ninth[[2]] <- get_Y_e_V
+ ninth[[2]] <- result2
- for(l in 1:k.size){
- for(j1 in 1:d.size){
- for(j in 1:d.size){
- for(t in 1:block){
- ninth[[1]][l,j1,,t] <- ninth[[1]][l,j1,,t] - sixth.coef[l,j,t] *
- get_U_hat_t[j1,j,,t]
- }
- }
- }
- }
+ tenth <- array(0,dim=c(k.size,r.size,block))
- tenth.coef <- - sixth.coef/2
- tenth <- get_Y_e_e_V
-
- eleventh.coef <- - 1
eleventh <- array(0,dim=c(k.size,r.size,block))
for(l in 1:k.size){
for(j in 1:d.size){
- for(t in 1:block){
- eleventh[l,,t] <- eleventh[l,,t] + tenth.coef[l,j,t] *
- get_Y_e_e_V[j,,t]
+ tmp9 <- real(block)
+
+ for(i in 1:d.size){
+ tmp8 <- get_x_f0[l,i,] * result6.coef[i,j,]
+
+ tmp9 <- tmp9 + tmp8
}
+
+ tmp10 <- I0(tmp9,env)
+
+ for(r in 1:r.size){
+ sixth[l,r,] <- sixth[l,r,] + tmp10[block] * result6[j,r,]
+
+ seventh[l,r,] <- seventh[l,r,] - tmp10 * result6[j,r,]
+
+ for(j1 in 1:d.size){
+ eighth[[1]][l,j1,r,] <- eighth[[1]][l,j1,r,] -
+ tmp10[block] * result8[j1,j,r,]
+
+ ninth[[1]][l,j1,r,] <- ninth[[1]][l,j1,r,] +
+ tmp10 * result8[j1,j,r,]
+ }
+
+ tenth[l,r,] <- tenth[l,r,] -
+ tmp10[block]/2 * result10[j,r,]
+
+ eleventh[l,r,] <- eleventh[l,r,] +
+ tmp10/2 * result10[j,r,]
+ }
}
}
- return(list(first=first,second.coef=second.coef,second=second,
- third.coef=third.coef,third=third,
- fourth.coef=fourth.coef,fourth=fourth,
- fifth.coef=fifth.coef,fifth=fifth,
- sixth.coef=sixth.coef,sixth=sixth,seventh=seventh,
- eighth.coef=eighth.coef,eighth=eighth,
- ninth.coef=ninth.coef,ninth=ninth,
- tenth.coef=tenth.coef,tenth=tenth,
- eleventh.coef=eleventh.coef,eleventh=eleventh))
+ second[[1]] <- second[[1]] + third[[1]] + eighth[[1]] +
+ ninth[[1]]
+
+ third <- fourth + fifth + sixth + seventh + tenth + eleventh
+
+ return(list(first=first,second=second,third=third))
}
@@ -3436,16 +3581,24 @@
assign(pars[1],0)
+ dx.F <- list()
+
for(l in 1:k.size){
+ dx.F[[l]] <- list()
+
for(i in 1:d.size){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 169
More information about the Yuima-commits
mailing list