5

Reformulando a pergunta, gostaria de implementar a seguinte equação:

Onde D é uma matriz de ordem i x k x l, lambda é uma matriz k x j e pk = {1,2,3,4,5,6}.

Para isso preciso de alguma função que opere com matriz tridimensional ao invés de laços aninhados.


Abaixo complemento postado pelo autor (provavelmente, pois não temos dados suficientes para ter certeza):

library(KRLS)
matriz = matrix(c(rnorm(160)), ncol = 8)
matriz = (matriz - mean(matriz))/sd(matriz)

Separando em particoes

particao_1 = matrix(rep(0, length(matriz[1,])*length(matriz[,1])), ncol = length(matriz[1,]))
particao_2 = matrix(rep(0, length(matriz[1,])*length(matriz[,1])), ncol = length(matriz[1,]))
particao_3 = matrix(rep(0, length(matriz[1,])*length(matriz[,1])), ncol = length(matriz[1,]))

Selecao de forma aleatoria da particao pelo kmeans

inicio = kmeans(matriz, 3)
i= 1;
for(i in 1:length(inicio$cluster)){
    if(inicio$cluster[i] == 1) particao_1[i,] = matriz[i,]

    else if(inicio$cluster[i] == 2) particao_2[i,] = matriz[i,]

    else  particao_3[i,] = matriz[i,]
  i = i +1
}

removendo as linhas zeros

particao_1 = particao_1[!(apply(particao_1, 1, function(y) any(y == 0))),]
particao_2 = particao_2[!(apply(particao_2, 1, function(y) any(y == 0))),]
particao_3 = particao_3[!(apply(particao_3, 1, function(y) any(y == 0))),]

selecao = sample(1:3, 1)
(
  if(selecao == 1) particao.selecionada = particao_1

  else if(selecao == 2) particao.selecionada = particao_2

  else  particao.selecionada = particao_3
)

p = length(particao.selecionada[1,]) #Numero de atributos = p

Calculando Sigma

sigma = c()
q10 = c()
q90 = c()
i = 1; j = 1; k = 1
for(i in 1 : length(matriz[,1])){
  for(k in 1 : length(particao.selecionada[,1])){
    if((matriz[i,] == particao.selecionada[k,])[1]){      
     for(j in 1 : p){
        q10[j] = quantile(dist(matrix(c(matriz[,j], particao.selecionada[,j]), ncol = 2), 
                            method = "euclidean")^2, 0.1)
        q90[j] = quantile(dist(matrix(c(matriz[,j], particao.selecionada[,j]), ncol = 2), 
                            method = "euclidean")^2, 0.9)
        sigma[j] = (q10[j] + q90[j])/2
      }
    }
  }
}

Montando a matriz kernel

matriz.kernel = matrix(rep(0, length(matriz[,1])*length(matriz[,1])), ncol = length(matriz[,1]))
for(i in 1:p){
  matriz.kernel = gausskernel(matriz, sigma[j])
}

Montando a equacao (d)

#--- Montando a equacao d.1 ---#
d.1 = array(rep(0, length(matriz[,1])*length(particao.selecionada[,1])*p),
              dim = c(length(matriz[,1]), length(particao.selecionada[,1]), p))

for(j in 1: length(matriz[,1])){
  for(k in 1: length(particao.selecionada[,1])){
    for(i in 1 : length(matriz[,1])){
      if(i == j){
        eq6.1[i,k, ] = matriz.kernel[i,j]
      }
    }
  }
}

Montando a equacao d.2

d.2.temp = array(rep(0, length(particao.selecionada[,1])*p), 
              dim = c(length(particao.selecionada[,1]), p))
d.2 = c()

for(j in 1: length(matriz[1,])){
  for(k in 1: length(particao.selecionada[,1])){
    for(i in 1 : length(matriz[,1])){
      if((matriz[i,] == particao.selecionada[k,])[1]){
        eq6.2.temp[k,j] = matriz.kernel[k,j]
        eq6.2[j] = 2*sum(eq6.2.temp[,j])/length(particao.selecionada[,1])
      }
    }
  }
}

Montando a equacao d.3

d.3.temp = array(rep(0, length(particao.selecionada[,1])*p), 
                   dim = c(length(particao.selecionada[,1]), p))
d.3 = 0
for(j in 1: length(matriz[1,])){  
  for(i in 1 : length(matriz[,1])){
    if((matriz[i,] == particao.selecionada[k,])[1]){
      for(k in 1: length(particao.selecionada[,1])){
        eq6.3.temp[k,j] = matriz.kernel[k,j]
        eq6.3 = sum(eq6.3.temp)/length(particao.selecionada[,1])^2
      }        
    }
  }
}
rm(d.3.temp)

n = 1
d.12 = array(rep(0, length(matriz[,1])*length(particao.selecionada[,1])*p),
               dim = c(length(matriz[,1]), length(particao.selecionada[,1]), p))
while(n <= 8)
{
  d.12[, , n] = eq6.1[, , n] - eq6.2[n]
  n = n + 1
}
d = d.12 + d.3
rm(d.12)

O lambda que é uma matriz de comprimento k, j onde k = length(particao.selecionada[,1] e p = length(matriz[,1]. Preciso operar com a matriz tridimensional para resolver a equação lambda.

4
  • Qual a mensagem de erro que você está recebendo? 26/05/2015 às 14:52
  • Por favor coloque um exemplo dos dados originais e o resultado esperado. Certamente a resposta não é usar vários loops for aninhados, o R possui ferramentas para trabalhar com matrizes de forma vetorizada. Uma delas é o operador %*% que faz multiplicação de matrizes ao invés de escalar.
    – Molx
    26/05/2015 às 16:43
  • 1
    fora de contexto é muito difícil entender essa fórmula... o que é o que aí? 27/05/2015 às 23:57
  • Pode fazer mD <- d ; dms=dim(mD); pk=1:dms[1]; dl=dms[3]; lp=1:dl e usar o código abaixo para encontrar lambda
    – Robert
    9/06/2015 às 3:39

1 Resposta 1

1

Tente isso!

di=6
dk=5
dl=4
set.seed(234)
dados <- round(rnorm(di*dk*dl,20,5));
mD <- array(dados, c(di, dk, dl));  
mD[di,dk,dl-1] <- 24; #subst 18
pk=1:di
lp=1:dl
mDlp=lapply(lp,function(l)mD[,,l])
Numerador=Reduce('*',lapply(mDlp,function(Dp){
  Dpk=lapply(pk,function(i)Dp[i,])
  Reduce('+', Dpk)
}))^(1/dl)
mDpk=lapply(pk,function(i)mD[i,,])
Denominador=Reduce('+', mDpk)
lambda=Numerador/Denominador

O resultado é:

> lambda
          [,1]      [,2]      [,3]      [,4]
[1,] 1.0307199 0.9820245 1.0139603 0.9743524
[2,] 1.1486329 1.1064813 0.9068155 0.8676724
[3,] 0.9376565 0.9607136 0.9376565 1.1839097
[4,] 0.8895210 0.9997272 0.9655485 1.1646306
[5,] 1.0616960 1.0058172 0.9800271 0.9555264

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 .