mlp.r

mlp.r

# Primeiro vamos implementar uma função de ativação
funcao.ativacao <- function(v){

  # Função logística
  y <- 1 / (1 + exp(-v))

  return(y)
}

# Vamos também precisar da derivada da função de ativação
der.funcao.ativacao <- function(y){

  # Derivada da logística
  derivada <- y * (1 - y)

  return(derivada)
}

# Vamos criar uma arquitetura para nossa MLP
arquitetura <- function(num.entrada, num.escondida, num.saida,
                        funcao.ativacao, der.funcao.ativacao){

  arq <- list()

  # Parametros da rede    
  arq$num.entrada <- num.entrada
  arq$num.escondida <- num.escondida
  arq$num.saida <- num.saida
  arq$funcao.ativacao <- funcao.ativacao
  arq$der.funcao.ativacao <- der.funcao.ativacao

  # 2 neuronios na camada escondida
  # 
  #       Ent1    Ent2   Bias 
  # 1     w11     w12    w13
  # 2     w21     w22    w23

  # Pesos conectando entrada e escondida
  num.pesos.entrada.escondida <- (num.entrada+1)*num.escondida
  arq$escondida <- matrix(runif(min=-0.5,max=0.5, num.pesos.entrada.escondida),
                                nrow=num.escondida, ncol=num.entrada+1)

  # Pesos conectando escondida e saida
  num.pesos.escondida.saida <- (num.escondida+1)*num.saida
  arq$saida <- matrix(runif(min=-0.5,max=0.5,  num.pesos.escondida.saida),
                            nrow=num.saida, ncol=num.escondida+1)


  return(arq)
}

# Precisamos de um código para a fase de propagação da MLP
mlp.propagacao <- function(arq, exemplo){

  # Entrada -> Cama Escondida
  v.entrada.escondida <- arq$escondida %*% as.numeric(c(exemplo,1))
  y.entrada.escondida <- arq$funcao.ativacao(v.entrada.escondida)

  # Camada Escondida -> Camada de Saida
  v.escondida.saida <- arq$saida %*% c(y.entrada.escondida,1)
  y.escondida.saida <- arq$funcao.ativacao(v.escondida.saida)

  # Resultados
  resultado <- list()
  resultado$v.entrada.escondida <- v.entrada.escondida
  resultado$y.entrada.escondida <- y.entrada.escondida
  resultado$v.escondida.saida <- v.escondida.saida
  resultado$y.escondida.saida <- y.escondida.saida

  return(resultado)
}

# Agora o código para a fase de treinamento da MLP, usando o algoritmo Back-propagation
mlp.retropropagacao <- function(arq, dados, txApredizado, limiar){

  erroQuadratico <- 2 * limiar
  epocas <- 0

  # Treina eqto o erro quadratico for maior que um limiar
  while(erroQuadratico > limiar){
    erroQuadratico <- 0

    # Treino para todos os exemplos (epoca)
    for(i in 1:nrow(dados)){

      # Pego um exemplo de entrada
      x.entrada <- dados[i,1:arq$num.entrada]
      x.saida <- dados[i,ncol(dados)]

      # Pego a saida da rede para o exemplo
      resultado <- mlp.propagacao(arq,x.entrada)
      y <- resultado$y.escondida.saida

      # Calculo do erro para o exemplo
      erro <- x.saida - y

      # Soma erro quadratico
      erroQuadratico <- erroQuadratico + erro * erro

      # Gradiente local no neuronio de saida
      # erro * derivada da funcao de ativacao
      grad.local.saida <- erro * arq$der.funcao.ativacao(y)

      # Gradiente local no neuronio escondido
      # derivada da funcao de ativacao no neuronio escondido * soma dos gradientes
      # locais dos neuronios conectados na proxima camada * pesos conectando a camada
      # escondida com a saida
      pesos.saida <- arq$saida[,1:arq$num.escondida]
      grad.local.escondida <-
        as.numeric(arq$der.funcao.ativacao(resultado$y.entrada.escondida)) *
        (grad.local.saida %*% pesos.saida)

      # Ajuste dos pesos
      # Saida
      arq$saida <- arq$saida + txApredizado * (grad.local.saida %*%
                                     c(resultado$y.entrada.escondida,1))
      # Escondida
      arq$escondida <- arq$escondida + txApredizado * (t(grad.local.escondida) %*%
                                             as.numeric(c(x.entrada,1)))
    } # Fim for(i in 1:nrow(dados))

    erroQuadratico <- erroQuadratico / nrow(dados)
    cat("Erro Quadratico Medio = ", erroQuadratico, "\n")
    epocas <- epocas + 1
    
  } # Fim while(erroQuadratico > limiar)

  retorno <- list()
  retorno$arq <- arq
  retorno$epocas <- epocas

  return(retorno)
}

dataset <- read.table('cmc.data')
# dim(dataset)
# head(dataset)

dados <- dataset[,c(3,5,6)]
dados[,1:2] <- scale(dados[,1:2]) # normalização dos dados (media 0 e desvio 1)
head(dados)

# Vamos escolher aleatoriamente dados para treino e teste.
# O conjunto de dados já está randomizado. 
# Assim, Vamos pegar os primeiros 1000 exemplos para treino e o restante para teste

dados.treino <- dados[1:1000,]
dados.teste <- dados[1001:1473,]

# Vamos treinar nossa rede com 4 neurônios na camada escondida
arq <- arquitetura(3, 4, 1, funcao.ativacao, der.funcao.ativacao)
print(arq)

modelo <- mlp.retropropagacao(arq, dados.treino, 0.3, 1e-6)
print(modelo)

# Fazendo predicoes para cada exemplo de teste
predicoes <- vector()
for(i in 1:nrow(dados.ç)){
  pred <- mlp.propagacao(modelo$arq, dados.teste[i, 1:3])$y.escondida.saida
  predicoes <- c(predicoes, pred)
}

print("[Predições]")
print(predicoes)

# Criando uma matriz para comparação dos resultados
matriz.comparacao <- cbind(dados.teste[,3],predicoes)
colnames(matriz.comparacao) <- c('V','P')
print(matriz.comparacao)

# Matriz de confusão com o arredondamento das predições
mc <- table(matriz.comparacao[,1] ,round(matriz.comparacao[,2]))
print(mc)

# acc <- sum(diag(mc))/sum(mc)
# print(acc)
# sum(mc)
# sum(diag(mc))