use of ifelse with Matrix

Question

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), you have a matrix of 6 rows and 2 columns, same thing when compiling the second entry (dFTbi), but when I compile the function completes (gr2) I receive the first column of the matrix (df1bi+df2bi+df3bi+df4bi) as a vector. I need to get back the matrix df1bi+df2bi+df3bi+df4bi with the entries it has NaN, corresponding to y==0 replaced by the corresponding values in the matrix dFTbi. Does anyone have any suggestions? Follow the full 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)

Answer 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))

In it I draw two matrices, one x and the other y. The matrix x has values NA, which I wish 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

Answer 2

I thought to solve 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 matrix gr2 with these dimensions. All entries in this matrix are NA.

Then I replaced the lines of gr2 equivalent to positions of y equal to zero in the matrix (df1bi+df2bi+df3bi+df4bi). Finally, I replaced the gr2 equivalent to positions of y non-zero in the matrix dFTbi.