2

Preciso encontrar o gradiente de uma função, para isso, estou usando a linha final do código abaixo, onde se lê: gr2 <- ifelse(y>0,df1bi+df2bi+df3bi+df4bi,dFTbi), note que ao compilar a primeira entrada deste código (df1bi+df2bi+df3bi+df4bi), tem-se uma matriz de 6 linhas e 2 colunas, mesma coisa ao compilar a segunda entrada (dFTbi), porém quando compilo a função completa (gr2) recebo a primeira coluna da matriz (df1bi+df2bi+df3bi+df4bi) como um vetor. Preciso receber de volta a matriz df1bi+df2bi+df3bi+df4bi com as entradas que possui NaN, correspondentes a y==0 substituidos pelos valores correspondentes na matriz dFTbi. Alguém possui alguma sugestão? Segue o código completo!

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)

2 Respostas 2

2

Eu pensei em resolver este problema sem utilizar ifelse. Não testei para ver se este código é mais otimizado ou não.

Substitua a última linha do teu código pelas três linhas seguintes:

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

Eu assumi que dFTbi e (df1bi+df2bi+df3bi+df4bi) possuem o mesmo número de linhas e colunas. Assim, criei a matriz gr2 com estas dimensões. Todas as entradas desta matriz são NA.

A seguir, substituí as linhas de gr2 equivalentes às posições de y que fossem iguais a zero na matriz (df1bi+df2bi+df3bi+df4bi). Por fim, substituí as linhas de gr2 equivalentes às posições de y que fossem diferentes de zero na matriz dFTbi.

2
  • 1
    Essa solução é melhor, com certeza! Commented 15/11/2016 às 16:08
  • Resolvido, @MarcusNunes, obrigado!
    – fsbmat
    Commented 15/11/2016 às 16:11
2

O código a seguir pode ser adaptado para obter o resultado que você deseja:

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

Nele gero duas matrizes, uma x e outra y. A matriz x possui valores NA, que eu desejo substituir pelos valores equivalentes de y.

Veja o resultado:

> 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
2
  • Então @DanielFalbel, mas preciso substituir os valores da primeira matriz, pelos valores correspondentes da segunda matriz se os valores de y==0, ou seja, a partir da análise de uma terceira variável.
    – fsbmat
    Commented 15/11/2016 às 16:09
  • Se y for uma matriz, basta substituir x por y na condicao do ifelse Commented 15/11/2016 às 16:12

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .