Skip to content

Instantly share code, notes, and snippets.

@reginaldojunior
Created June 20, 2021 16:33
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save reginaldojunior/08d976c5444bd6fa0005aab46e64d76d to your computer and use it in GitHub Desktop.
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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment