- list(
- # p: dimension K-1, need to be completed
- "p" = c(v[1:(K-1)], 1-sum(v[1:(K-1)])),
- "β" = matrix(v[K:(K+d*K-1)], ncol=K),
- "b" = v[(K+d*K):(K+(d+1)*K-1)])
- },
+ list(
+ # p: dimension K-1, need to be completed
+ "p" = c(v[1:(K-1)], 1-sum(v[1:(K-1)])),
+ "β" = matrix(v[K:(K+d*K-1)], ncol=K),
+ "b" = v[(K+d*K):(K+(d+1)*K-1)])
+ },
- β <- θ$β
- λ <- sqrt(colSums(β^2))
- b <- θ$b
-
- # Tensorial products β^2 = β2 and β^3 = β3 must be computed from current β1
- β2 <- apply(β, 2, function(col) col %o% col)
- β3 <- apply(β, 2, function(col) col %o% col %o% col)
-
- c(
- β %*% (p * .G(li,1,λ,b)),
- β2 %*% (p * .G(li,2,λ,b)),
- β3 %*% (p * .G(li,3,λ,b)))
+ β <- θ$β
+ λ <- sqrt(colSums(β^2))
+ b <- θ$b
+
+ # Tensorial products β^2 = β2 and β^3 = β3 must be computed from current β1
+ β2 <- apply(β, 2, function(col) col %o% col)
+ β3 <- apply(β, 2, function(col) col %o% col %o% col)
+
+ c(
+ β %*% (p * .G(li,1,λ,b)),
+ β2 %*% (p * .G(li,2,λ,b)),
+ β3 %*% (p * .G(li,3,λ,b)))
sweep(as.matrix(β [,km1]), 2, G1[km1], '*') - G1[K] * β [,K],
sweep(as.matrix(β2[,km1]), 2, G2[km1], '*') - G2[K] * β2[,K],
sweep(as.matrix(β3[,km1]), 2, G3[km1], '*') - G3[K] * β3[,K] ))
sweep(as.matrix(β [,km1]), 2, G1[km1], '*') - G1[K] * β [,K],
sweep(as.matrix(β2[,km1]), 2, G2[km1], '*') - G2[K] * β2[,K],
sweep(as.matrix(β3[,km1]), 2, G3[km1], '*') - G3[K] * β3[,K] ))
- for (i in 1:d)
- {
- # i determines the derivated matrix dβ[2,3]
-
- dβ_left <- sweep(β, 2, p * G3 * β[i,], '*')
- dβ_right <- matrix(0, nrow=d, ncol=K)
- block <- i
- dβ_right[block,] <- dβ_right[block,] + 1
- dβ <- dβ_left + sweep(dβ_right, 2, p * G1, '*')
-
- dβ2_left <- sweep(β2, 2, p * G4 * β[i,], '*')
- dβ2_right <- do.call( rbind, lapply(1:d, function(j) {
- sweep(dβ_right, 2, β[j,], '*')
- }) )
- block <- ((i-1)*d+1):(i*d)
- dβ2_right[block,] <- dβ2_right[block,] + β
- dβ2 <- dβ2_left + sweep(dβ2_right, 2, p * G2, '*')
-
- dβ3_left <- sweep(β3, 2, p * G5 * β[i,], '*')
- dβ3_right <- do.call( rbind, lapply(1:d, function(j) {
- sweep(dβ2_right, 2, β[j,], '*')
- }) )
- block <- ((i-1)*d*d+1):(i*d*d)
- dβ3_right[block,] <- dβ3_right[block,] + β2
- dβ3 <- dβ3_left + sweep(dβ3_right, 2, p * G3, '*')
-
- res <- cbind(res, rbind(dβ, dβ2, dβ3))
- }
+ for (i in 1:d)
+ {
+ # i determines the derivated matrix dβ[2,3]
+
+ dβ_left <- sweep(β, 2, p * G3 * β[i,], '*')
+ dβ_right <- matrix(0, nrow=d, ncol=K)
+ block <- i
+ dβ_right[block,] <- dβ_right[block,] + 1
+ dβ <- dβ_left + sweep(dβ_right, 2, p * G1, '*')
+
+ dβ2_left <- sweep(β2, 2, p * G4 * β[i,], '*')
+ dβ2_right <- do.call( rbind, lapply(1:d, function(j) {
+ sweep(dβ_right, 2, β[j,], '*')
+ }) )
+ block <- ((i-1)*d+1):(i*d)
+ dβ2_right[block,] <- dβ2_right[block,] + β
+ dβ2 <- dβ2_left + sweep(dβ2_right, 2, p * G2, '*')
+
+ dβ3_left <- sweep(β3, 2, p * G5 * β[i,], '*')
+ dβ3_right <- do.call( rbind, lapply(1:d, function(j) {
+ sweep(dβ2_right, 2, β[j,], '*')
+ }) )
+ block <- ((i-1)*d*d+1):(i*d*d)
+ dβ3_right[block,] <- dβ3_right[block,] + β2
+ dβ3 <- dβ3_left + sweep(dβ3_right, 2, p * G3, '*')
+
+ res <- cbind(res, rbind(dβ, dβ2, dβ3))
+ }
- res <- cbind(res, rbind(
- sweep(β, 2, p * G2, '*'),
- sweep(β2, 2, p * G3, '*'),
- sweep(β3, 2, p * G4, '*') ))
+ res <- cbind(res, rbind(
+ sweep(β, 2, p * G2, '*'),
+ sweep(β2, 2, p * G3, '*'),
+ sweep(β3, 2, p * G4, '*') ))
- "probit"=list(
- # 'probit' derivatives list;
- # NOTE: exact values for the integral E[g^(k)(λz+b)] could be computed
- function(x) exp(-x^2/2)/(sqrt(2*pi)), #g'
- function(x) exp(-x^2/2)/(sqrt(2*pi)) * -x, #g''
- function(x) exp(-x^2/2)/(sqrt(2*pi)) * ( x^2 - 1), #g^(3)
- function(x) exp(-x^2/2)/(sqrt(2*pi)) * (-x^3 + 3*x), #g^(4)
- function(x) exp(-x^2/2)/(sqrt(2*pi)) * ( x^4 - 6*x^2 + 3) #g^(5)
- ),
- "logit"=list(
- # Sigmoid derivatives list, obtained with http://www.derivative-calculator.net/
- # @seealso http://www.ece.uc.edu/~aminai/papers/minai_sigmoids_NN93.pdf
- function(x) {e=exp(x); .zin(e /(e+1)^2)}, #g'
- function(x) {e=exp(x); .zin(e*(-e + 1) /(e+1)^3)}, #g''
- function(x) {e=exp(x); .zin(e*( e^2 - 4*e + 1) /(e+1)^4)}, #g^(3)
- function(x) {e=exp(x); .zin(e*(-e^3 + 11*e^2 - 11*e + 1) /(e+1)^5)}, #g^(4)
- function(x) {e=exp(x); .zin(e*( e^4 - 26*e^3 + 66*e^2 - 26*e + 1)/(e+1)^6)} #g^(5)
- )
+ "probit"=list(
+ # 'probit' derivatives list;
+ # NOTE: exact values for the integral E[g^(k)(λz+b)] could be computed
+ function(x) exp(-x^2/2)/(sqrt(2*pi)), #g'
+ function(x) exp(-x^2/2)/(sqrt(2*pi)) * -x, #g''
+ function(x) exp(-x^2/2)/(sqrt(2*pi)) * ( x^2 - 1), #g^(3)
+ function(x) exp(-x^2/2)/(sqrt(2*pi)) * (-x^3 + 3*x), #g^(4)
+ function(x) exp(-x^2/2)/(sqrt(2*pi)) * ( x^4 - 6*x^2 + 3) #g^(5)
+ ),
+ "logit"=list(
+ # Sigmoid derivatives list, obtained with http://www.derivative-calculator.net/
+ # @seealso http://www.ece.uc.edu/~aminai/papers/minai_sigmoids_NN93.pdf
+ function(x) {e=exp(x); .zin(e /(e+1)^2)}, #g'
+ function(x) {e=exp(x); .zin(e*(-e + 1) /(e+1)^3)}, #g''
+ function(x) {e=exp(x); .zin(e*( e^2 - 4*e + 1) /(e+1)^4)}, #g^(3)
+ function(x) {e=exp(x); .zin(e*(-e^3 + 11*e^2 - 11*e + 1) /(e+1)^5)}, #g^(4)
+ function(x) {e=exp(x); .zin(e*( e^4 - 26*e^3 + 66*e^2 - 26*e + 1)/(e+1)^6)} #g^(5)
+ )