#!/usr/bin/perl

# Multilayer Perceptron
# 09/11/2009
# Autor: Hermano Pereira
# www.hermano.com.br

use strict;

# Valores de entrada
my @en = ([0,0],   # Paulo
          [0,1],   # Joao
          [1,0],   # Tiago
          [1,1]);  # Pedro 

my @yd = (1,       # Tecnico
          0,       # Analista
          0,       # Analista
          1);      # Tecnico

my @funcionario = (["Paulo",
                    "Joao"],
                    ["Tiago",
                    "Pedro"]);

my @funcao = ("Analista",
              "Tecnico");

my @s_en; # Entradas sorteadas
my @s_yd; # Saidas sorteadas

my @c_en; # Entradas selecionadas
my $c_yd; # Saida selecionada

my $max = 20000;       # Maximo de iteracoes
my $taxa = 0.5;        # Taxa de aprendizado
my $iter = 0;          # Contador de iteracoes
my $bias = 1;
my $soma_erro = 0.0;   # Somatorio de percentual de erros
my $erro_tole = 0.1;   # Percentual de erro tolerado
my $erro_medio = 0.0;  # Erro medio

# Dados do Perceptron 1
my $p1_w0 = rand(2)-1; # Peso para entrada 0
my $p1_w1 = rand(2)-1; # Peso para entrada 1
my $p1_wb = rand(2)-1; # Peso para bias
my $p1_y;              # Saida de P1
my $p1_grad;           # Gradiente de P1 

# Dados do Perceptron 2
my $p2_w0 = rand(2)-1; # Peso para entrada 0
my $p2_w1 = rand(2)-1; # Peso para entrada 1
my $p2_wb = rand(2)-1; # Peso para bias
my $p2_y;              # Saida de P2
my $p2_grad;           # Gradiente de P2 

# Dados do Perceptron 3
my $p3_w0 = rand(2)-1; # Peso para entrada 0 - saida de P1
my $p3_w1 = rand(2)-1; # Peso para entrada 1 - saida de P2
my $p3_wb = rand(2)-1; # Peso para bias
my $p3_y;              # Saida de P3
my $p3_grad;           # Gradiente de P3

# Executar RNA:

&treinar;
&testar(0,0);
&testar(0,1);
&testar(1,0);
&testar(1,1);

# Esta funcao faz o treinamento da RNA 
sub treinar {
   my $parar = 0;
   my $qt_en = 0;
   while ($iter < $max && !($parar)) { # Criterio de parada
      $iter = $iter + 1;
      &sortear;
      $qt_en = scalar(@s_en);
      for (my $i = 0; $i < $qt_en; $i++) {
         &selecionar;
         &propagar;
         &retropropagar(&calcular_erro);
      }
      $erro_medio = $soma_erro / $iter; 
      if ($erro_medio < $erro_tole) {
         $parar = 1; 
      }
      if ($iter % 100 == 0) {
         &imprimir;
      }
   }
   &imprimir;
}

#  Esta funcao faz o sorteio das entradas
sub sortear {
   @s_en = ();
   @s_yd = ();
   my @ord;
   my @n_ord;
   for (my $i = 0; $i < scalar(@en); $i++) {
      push (@ord,$i);
   }
   for (my $i = scalar(@ord); $i > 0; $i--) {
      my $sorteio = int(rand($i));
      push (@n_ord, $ord[$sorteio]);
      delete $ord[$sorteio];
      @ord = reverse(sort(@ord));
   }
   for (my $i = 0; $i < scalar(@en); $i++) {
      $s_en[$i] = \@{$en[$n_ord[$i]]};
      $s_yd[$i] = $yd[$n_ord[$i]];
   }
}

# Esta funcao seleciona uma entrada
sub selecionar {
   @c_en = ();
   $c_yd = "";
   @c_en = ($s_en[0][0],$s_en[0][1]);
   shift @s_en; 
   $c_yd = shift @s_yd;
}

# Funcao de propagacao
sub propagar {
   # Camada oculta - Perceptron 1
   my $v = ($c_en[0] * $p1_w0) + ($c_en[1] * $p1_w1) + ($p1_wb * $bias);
   my $y = (1 / (1 + exp(-$v)));
   $p1_y = $y;
   # Camada oculta - Perceptron 2
   $v = ($c_en[0] * $p2_w0) + ($c_en[1] * $p2_w1) + ($p2_wb * $bias);
   $y = (1 / (1 + exp(-$v)));
   $p2_y = $y;
   # Camada de saida - Perceptron 3 
   $v = ($p1_y * $p3_w0) + ($p2_y * $p3_w1) + ($p3_wb * $bias);
   $y = (1 / (1 + exp(-$v)));
   $p3_y = $y;
}

# Funcao que calculo erro da RNA
sub calcular_erro {
   my $erro = $c_yd - $p3_y;
   $soma_erro += (($erro ** 2) / 2);
   return $erro;
}

# Funcao que atraves da retropropagacao
# reajusta os pesos de acordo com os erros
sub retropropagar {
   my $erro = shift;

   # Perceptron 3   
   my $y = $p3_y * (1 - $p3_y);
   $p3_grad = $erro * $y;

   # Perceptron 2
   my $tgrad = 0;
   $tgrad = $p3_grad * $p3_w1;
   $y = $p2_y * (1 - $p2_y);
   $p2_grad = $y * $tgrad;

   # Perceptron 1
   $tgrad = $p3_grad * $p3_w0;
   $y = $p1_y * (1 - $p1_y);
   $p1_grad = $y * $tgrad;

   # Ajustando pesos Perceptron 1
   my $delta;
   $delta = $taxa * $p1_grad * $c_en[0];
   $p1_w0 += $delta;
   $delta = $taxa * $p1_grad * $c_en[1];
   $p1_w1 += $delta;
   $delta = $taxa * $p1_grad * $bias;
   $p1_wb += $delta;

   # Ajustando pesos Perceptron 2
   $delta = $taxa * $p2_grad * $c_en[0];
   $p2_w0 += $delta;
   $delta = $taxa * $p2_grad * $c_en[1];
   $p2_w1 += $delta;
   $delta = $taxa * $p2_grad * $bias;
   $p2_wb += $delta;

   # Ajustando pesos Perceptron 3
   $delta = $taxa * $p3_grad * $p1_y;
   $p3_w0 += $delta;
   $delta = $taxa * $p3_grad * $p2_y;
   $p3_w1 += $delta;
   $delta = $taxa * $p3_grad * $bias;
   $p3_wb += $delta;

}

# Imprimir o que esta ocorrendo com a RNA
sub imprimir {
   system("clear");
   print "+-----------------------------------------------------------------------+\n";
   print "Iteracoes : $iter\n";
   print "Erro medio: $erro_medio\n";
   print "+-----------------------------------------------------------------------+\n";
   print "  Camada de Entrada:\n";
   print "    Entrada 1      = ".$c_en[0]."\n";
   print "    Entrada 2      = ".$c_en[1]."\n";
   print "    Bias           = 1\n";
   print "    Saida desejada = ".$c_yd."\n";
   print "  Camada Oculta:\n";
   print "    Perceptron (1)\n";
   print "                 - peso w0 = ".$p1_w0."\n";
   print "                 - peso w1 = ".$p1_w1."\n";
   print "                 - peso wb = ".$p1_wb."\n";
   print "                         y = ".$p1_y."\n";
   print "    Perceptron (2)\n";
   print "                 - peso w0 = ".$p2_w0."\n";
   print "                 - peso w1 = ".$p2_w1."\n";
   print "                 - peso wb = ".$p2_wb."\n";
   print "                         y = ".$p2_y."\n";
   print "  Camada de Saida:\n";
   print "    Perceptron (3)\n";
   print "                 - peso w0 = ".$p3_w0."\n";
   print "                 - peso w1 = ".$p3_w1."\n";
   print "                 - peso wb = ".$p3_wb."\n";
   print "                         y = ".$p3_y."\n";
   print "                 resultado = ".int($p3_y+0.5)."\n";
   print "+-----------------------------------------------------------------------+\n";
   <STDIN>;
}

# Testar a RNA depois de treinada!
sub testar {
   $c_en[0] = shift;
   $c_en[1] = shift;
   &propagar;
   print "+-----------------------------------------------------------------------+\n";
   print " Qual a funcao de ".$funcionario[$c_en[0]][$c_en[1]]."?\n";
   print "\n";
   print "    Camada de Entrada: ".$c_en[0].",".$c_en[1]." \n";
   print "    Camada Oculta    :\n";
   print "                       Perceptron 1 = ".$p1_y."\n";
   print "                       Perceptron 2 = ".$p2_y."\n";
   print "    Camada de Saida  : ".int($p3_y+0.5)."\n";
   print "                       Perceptron 3 = ".$p3_y."\n";
   print "\n";
   print " Resposta: ".$funcionario[$c_en[0]][$c_en[1]]." = ".$funcao[int($p3_y+0.5)].".\n";
   print "+-----------------------------------------------------------------------+\n";
   <STDIN>; 
}