#!/usr/bin/perl

use strict;
use warnings;

sub sigm
    {
    my $x = shift;
    return (1/(1 + exp(-$x)));
    }

sub dxsigm
    {
    my $x = shift;
    return ($x*(1-$x));
    }


my $c_IN = 35;
my $c_HIDDEN =10;
my $c_OUT = 10;
my $c_EPSILON = 0.005;
my $c_NUMTRAIN = 10;

my @actafer;
$actafer[0]=[0,1,1,1,1,1,0,1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,0,1,0
+,1,1,1,1,1,0];
$actafer[1]=[0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,0
+,0,0,0,0,0,0];
$actafer[2]=[0,1,0,0,0,0,1,1,0,0,0,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,0,1,0
+,1,1,0,0,0,1];
$actafer[3]=[1,0,0,0,0,1,0,1,0,0,0,0,0,1,1,0,0,1,0,0,1,1,1,1,0,1,0,1,1
+,0,0,0,1,1,0];
$actafer[4]=[0,0,0,1,1,0,0,0,0,1,0,1,0,0,0,1,0,0,1,0,0,1,1,1,1,1,1,1,0
+,0,0,0,1,0,0];
$actafer[5]=[1,1,1,0,0,1,0,1,0,1,0,0,0,1,1,0,1,0,0,0,1,1,0,1,0,0,0,1,1
+,0,0,1,1,1,0];
$actafer[6]=[0,0,1,1,1,1,0,0,1,0,1,0,0,1,1,0,0,1,0,0,1,1,0,0,1,0,0,1,0
+,0,0,0,1,1,0];
$actafer[7]=[1,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,1,1,1,1,1,0,1,0,0,0,0,1
+,1,0,0,0,0,0];
$actafer[8]=[0,1,1,0,1,1,0,1,0,0,1,0,0,1,1,0,0,1,0,0,1,1,0,0,1,0,0,1,0
+,1,1,0,1,1,0];
$actafer[9]=[0,1,1,0,0,0,0,1,0,0,1,0,0,1,1,0,0,1,0,0,1,1,0,0,1,0,1,0,0
+,1,1,1,1,0,0];

my @desout;
$desout[0]=[1,0,0,0,0,0,0,0,0,0];
$desout[1]=[0,1,0,0,0,0,0,0,0,0];
$desout[2]=[0,0,1,0,0,0,0,0,0,0];
$desout[3]=[0,0,0,1,0,0,0,0,0,0];
$desout[4]=[0,0,0,0,1,0,0,0,0,0];
$desout[5]=[0,0,0,0,0,1,0,0,0,0];
$desout[6]=[0,0,0,0,0,0,1,0,0,0];
$desout[7]=[0,0,0,0,0,0,0,1,0,0];
$desout[8]=[0,0,0,0,0,0,0,0,1,0];
$desout[9]=[0,0,0,0,0,0,0,0,0,1];

my (@inhiddw,@hidoutw,@deltaihw,@deltahow,@x,@y,@z,@ehid,@eout,@ecm,@p
+atr,@matrizin);
my $delta=0.5;
my $alfa=0.1;


sub init
    {
    my ($i,$j);
   # srand48();
    for($i=0;$i<$c_IN;$i++) {
    for($j=0;$j<$c_HIDDEN;$j++) {
    $inhiddw[$i][$j] = -0.5 + rand;#;drand48();
    $deltaihw[$i][$j] = 0;
    }
    }

    for($i=0;$i<$c_HIDDEN;$i++)
       {
       for($j=0;$j<$c_OUT;$j++) {
         $hidoutw[$i][$j] = -0.5 + rand;#;drand48();
         $deltahow[$i][$j] = 0;
         }
       }

  for($i=0;$i<$c_NUMTRAIN;$i++)
   {
   $patr[$i] = 0;
   }

  for($i=0;$i<$c_IN;$i++)     #here was 35
    {
    $matrizin[$i]=0;
    }

    }

sub training
    {

 my ($i,$l,$num)=(0,0,0);
 my ($j,$t,$rep,$p);
 do {
   do {

   #/* select a random training pattern: i = (int)(NUMTRAIN*rnd), wher
+e 0<rnd<1 */
   #i = (int)(NUMTRAIN*(float) rand() / RAND_MAX);
   #$i = int($c_NUMTRAIN * rand()/10);
   $i = int (rand(10));
  } while($patr[$i]);

  for($rep=0;$rep<3;$rep++) {
   $j++;
   #my @array = @{$actafer[$i]};
   &netanswer($i);
   &backprop($i);
  }

  #print "J: $j\n";

  if(!($j%102)) #/*showerr();*/
   {
   printf("\n%ld",$j);
   }
  &error();

  $l = 1;
  for($t=0;$t<$c_NUMTRAIN;$t++) {
  #print "$ecm[$t]:$patr[$t]\n";
   $patr[$t] = $ecm[$t] < $c_EPSILON;
   $l = $l && ($patr[$t]);
  }
 } while(!$l);

printf("\n\n End of training\n");


    }

sub netanswer
    {
    my $in_i = shift;
    my ($i,$j,$totin);

    for($i=0;$i<$c_IN;$i++)
      {

      print "$i $c_IN $in_i\n";

      $x[$i] = $actafer[$in_i][$i];

      if (not defined $x[$i]){die;}

      }

    for($j=0;$j<$c_HIDDEN;$j++) {
      $totin = 0;
      for($i=0;$i<$c_IN;$i++)
      {
      #print "$x[$i] : $inhiddw[$i][$j]\n";
      $totin = $totin + $x[$i]*$inhiddw[$i][$j];
      }
    $y[$j] = &sigm($totin);
    }

 for($j=0;$j<$c_OUT;$j++) {
  $totin = 0;
  for($i=0;$i<$c_HIDDEN;$i++)
     {
     $totin = $totin + $y[$i]*$hidoutw[$i][$j];
     }
  $z[$j] = &sigm($totin);

   }


    }


sub backprop
    {
    my $k =shift;

    my ($i,$j,$temp);
    &betaout($k);
    &betahid();

    for($i=0;$i<$c_HIDDEN;$i++)
    {
    for($j=0;$j<$c_OUT;$j++) {
    $temp = -$delta*$y[$i]*$z[$j]*(1-$z[$j])*$eout[$j];
    $hidoutw[$i][$j] = $hidoutw[$i][$j] + $temp + $alfa*$deltahow[$i][
+$j];
    $deltahow[$i][$j] = $temp;
    }
    }

    for($i=0;$i<$c_IN;$i++)
      {
      for($j=0;$j<$c_HIDDEN;$j++) {
      $temp = -$delta*$x[$i]*$y[$j]*(1-$y[$j])*$ehid[$j];
      $inhiddw[$i][$j] = $inhiddw[$i][$j] + $temp + $alfa*$deltaihw[$i
+][$j];
      $deltaihw[$i][$j] = $temp;
        }
      }
    }

sub betaout
    {
    my $i = shift;
    my $j;
    for($j=0;$j<$c_OUT;$j++)
    {
    $eout[$j] = 0;
    }
    for($j=0;$j<$c_OUT;$j++)
    {
    #print "J: $j $i\n";
    $eout[$j] = $z[$j] - $desout[$i][$j];
    }

    }

sub betahid
    {
    my ($i,$j);
    for($i=0;$i<$c_HIDDEN;$i++)
       {$ehid[$i] = 0;
       }

    for($i=0;$i<$c_HIDDEN;$i++)
      {
      for($j=0;$j<$c_OUT;$j++)
         {
         $ehid[$i] = $ehid[$i] + $hidoutw[$i][$j]*$z[$j]*(1-$z[$j])*$e
+out[$j];
         }
      }
    }

sub error
    {
    my ($i);

    for($i=0;$i<$c_NUMTRAIN;$i++) {
    &netanswer($actafer[$i]);
   # $ecm[$i]=ec(\@{$desout[$i]},\@z,$c_OUT);
    $ecm[$i]=ec($i,$c_OUT);
    }


    }

sub ec
{
 my ($in_i,$SIZE) =@_;
 my ($i,$e) =(0,0);

 for($i=0;$i<$SIZE;$i++)
 {
 #print "I: $in_i $i\n";
 $e = $e + ($desout[$in_i][$i] - $z[$i])*($desout[$in_i][$i] - $z[$i])
+;
 }
 $e = 0.5 * $e;
 return $e;
 }


&main;

sub main
    {
    &init;
    &training;
   # &test;
    }
[download]