use of ifelse with matrix

Question

use of ifelse with matrix

Navigation

#1 by (2 votes)
#2 by (1 votes)

2

I need to find the gradient of a function, for this, I'm using the final line of the code below, where it reads: gr2 <- ifelse(y>0,df1bi+df2bi+df3bi+df4bi,dFTbi) , note that when compiling the first entry of this code ( df1bi+df2bi+df3bi+df4bi ), there is a I have a list of all the columns in the array and I want to compile the first column of the array ( dFTbi ), but when compiling the complete function ( gr2 ) I get the first column of the array ( df1bi+df2bi+df3bi+df4bi ) as a vector. I need to get back the array df1bi+df2bi+df3bi+df4bi with the entries that have NaN , corresponding to y==0 replaced by corresponding values in array dFTbi . Anyone have any suggestions? Follow the complete code!

n <- 6
beta0=0.5
beta1=1
beta2=2
gamma0=1
gamma1=2
gamma2=3
phi1 <- 3
phi2 <- 1
rho <- 0.2

X <- t(cbind(rbind(runif(n/3,0,1),rep(0,n/3),rep(0,n/3)),rbind(rep(0,n/3),runif(n/3,0,1),rep(0,n/3)),rbind(rep(0,n/3),rep(0,n/3),runif(n/3,0,1))))
mu1 <- exp(X%*%rbind(beta0,beta1,beta2))
W <- t(cbind(rbind(runif(n/3,0,1),rep(0,n/3),rep(0,n/3)),rbind(rep(0,n/3),runif(n/3,0,1),rep(0,n/3)),rbind(rep(0,n/3),rep(0,n/3),runif(n/3,0,1))))
mu2 <- exp(W%*%rbind(gamma0,gamma1,gamma2))
set.seed(333)
y <- sample(seq(0,10,length.out = n),n,replace = TRUE)

dens.normal <- function(x){
  (1/sqrt(2*pi))*exp((-x^2)/2)
}

term0 <- ifelse(y>0,((y*(phi1+1)/(phi1*mu1))^(1/2)-((phi1*mu1)/(y*(phi1+1)))^(1/2)),0)
term1 <- exp((-phi1/4)*(term0)^2)
term2 <- ifelse(y>0,(((phi1+1)/(phi1*mu1*y))^(1/2)+((phi1*mu1)/((phi1+1)*(y^3)))^(1/2)),0)
term3 <- (1/(2*sqrt(2*pi)))*((phi1/2)^(1/2))
term4 <- (((phi2+1))/(mu2*(1-rho^2)))^(1/2)
term5 <- (phi2*mu2-phi2-1)/(sqrt(2)*(phi2+1))
term6 <- rho*((phi1)/(2*(1-rho^2)))^(1/2)
integrand <- ifelse(y>0,term4*term5+term6*term0,0)
term7 <- ifelse(y>0,pnorm(integrand),0)
term8 <- ((phi2/2)^(1/2))*(((phi2+1)/(phi2*mu2))^(1/2)-((phi2*mu2)/(phi2+1))^(1/2))
term9 <- ifelse(y>0,((y*(phi1+1))/(phi1*(mu1)))^(1/2)+((phi1*mu1)/(y*(phi1+1)))^(1/2),0)#Derivada de term0 em relação a beta0
term10 <- ifelse(y>0,((mu1*phi1)/((y^3)*(phi1+1)))^(1/2)-((phi1+1)/(y*phi1*mu1))^(1/2),0)#Derivada de term0 em relação a beta0
FT2 <- pnorm(term8)
p <- ncol(X)-1
j <- 2:ncol(X)
dFTb0 <- matrix(0,ncol = 1,nrow = n) 
dFTbi <- matrix(1,ncol = p,nrow = n)
#f1=log(term1), f2=log(term2), f3=log(term3), f4=log(term7), f5=log(term8)
df1b0 <- ifelse(y>0,(phi1/4)*term0*term9,0)
df2b0 <- ifelse(y>0,(1/2)*(term10/term2),0)
df1bi <- as.vector(df1b0)*matrix(X[,j],ncol = p,nrow = n) 
df2bi <- as.vector(df2b0)*matrix(X[,j],ncol = p,nrow = n) 
df3bi <- matrix(0,ncol = p,nrow = n) 
df4bi <- as.vector(dens.normal(term4*term5+term6*term0)*(term9/term7))*matrix(X[,j],ncol = p,nrow = n) #derivada de log(T2) em relação a beta[i], i>0

gr2 <- ifelse(y>0,df1bi+df2bi+df3bi+df4bi,dFTbi)

r

asked by anonymous 15.11.2016 / 16:47

2 answers

1

The following code can be adapted to get the result you want:

x <- matrix(rep(c(1, NA), 6), ncol = 2)
y <- matrix(1:12, ncol = 2, nrow = 6)
t(sapply(1:6, function(i, x, y) {
  t(ifelse(is.na(x[i,]), y[i,], x[i,]))
}, x, y))

It generates two matrices, one x and the other y. The x array has NA values, which I want to replace with the equivalent values of y .

See the result:

> x <- matrix(rep(c(1, NA), 6), ncol = 2)
> x
     [,1] [,2]
[1,]    1    1
[2,]   NA   NA
[3,]    1    1
[4,]   NA   NA
[5,]    1    1
[6,]   NA   NA
> y <- matrix(1:12, ncol = 2, nrow = 6)
> y
     [,1] [,2]
[1,]    1    7
[2,]    2    8
[3,]    3    9
[4,]    4   10
[5,]    5   11
[6,]    6   12
> t(sapply(1:6, function(i, x, y) {
+   t(ifelse(is.na(x[i,]), y[i,], x[i,]))
+ }, x, y))
     [,1] [,2]
[1,]    1    1
[2,]    2    8
[3,]    1    1
[4,]    4   10
[5,]    1    1
[6,]    6   12

15.11.2016 / 17:02

Error in CRUD command UPDATE - java.sql.SQLException: No value specified for parameter 8 Exercise with even and odd C

score 2 · Accepted Answer

I thought about solving this problem without using ifelse . I have not tested to see if this code is more optimized or not.

Replace the last line of your code with the following three lines:

gr2 <- matrix(NA, nrow=nrow(dFTbi), ncol=ncol(dFTbi))
gr2[y>0, ]    <- (df1bi+df2bi+df3bi+df4bi)[y>0, ]
gr2[!(y>0), ] <- dFTbi[!(y>0), ]

I assumed that dFTbi and (df1bi+df2bi+df3bi+df4bi) have the same number of rows and columns. So, I created the gr2 array with these dimensions. All entries in this array are NA .

Next, I replaced the lines of gr2 equivalent to y positions that were equal to zero in the (df1bi+df2bi+df3bi+df4bi) array. Finally, I replaced the lines of gr2 equivalent to the positions of y that were nonzero in the dFTbi array.