PERL homework #2v2

############################################# MODUL
#!/usr/bin/perl
package graflib;

# objekt grafu
sub new {
  my $class = shift;
  my $object = {
    a => shift, # parametr a
    b => shift, # parametr b
    c => shift, # parametr c
    node_list => {}, # seznam uzlu
    link_types => {}, # seznam typu hran
  };
  bless $object, $class;
  return $object;
}

# zadavani typu hran do seznamu typu hran
sub link_type {
  my($self, $type, $reciprocal) = @_;
  $self->{link_types}{$type}{weight} = 0;
  $self->{link_types}{$type}{reciprocal} = $reciprocal;
}

# dodani vah do seznamu typu hran
sub link_weight {
  my($self, $type, $weight) = @_;
  $self->{link_types}{$type}{weight} = $weight;
}

# pridani konkretnich hran
sub add_link {
  my($self, $from, $to, $type) = @_;
  my $weight = $self->{link_types}{$type}{weight};
  # pridani vystupni hrany
  push @{$self->{node_list}{$from}{out}{$to}}, $weight;
  if ($self->{link_types}{$type}{reciprocal}) {
    push @{$self->{node_list}{$to}{out}{$from}}, $weight;
  }
  # pridani vstupni hrany
  push @{$self->{node_list}{$to}{in}{$from}}, $weight;
  if ($self->{link_types}{$type}{reciprocal}) {
    push @{$self->{node_list}{$from}{in}{$to}}, $weight;
  }
}

# pridani konkretnich uzlu
sub add_node {
  my($self, $name, $type) = @_;
  $self->{node_list}{$name}{type} = $type;
  $self->{node_list}{$name}{level} = 0;
  $self->{node_list}{$name}{initial} = 0;
}

# dodani hodnoty uzlu
sub set_value {
  my($self, $name, $level) = @_;
  $self->{node_list}{$name}{level} = $level;
  if ($level > 0) {$self->{node_list}{$name}{initial} = $level;}
}

# sireni signalu do hran dle vzorce Xi * 1 / outdegree(i)^b
# !!! vzorec nesedi s referencnimi hodnotami, nutno vynasobit sqrt(pocet vystupnich hran) !!!
sub signal_wave {
  my($self, $node) = @_;
  my $xi = $$node->{level};
  my $out_links = 0;
  # pocet vystupnich hran
  for my $nodes (keys %{$$node->{out}}) {
    $out_links += scalar @{$$node->{out}{$nodes}};
  }
  # aplikace vzorce
  if ($xi != 0 && $out_links != 0) {
    ($xi * 1 / $out_links ** $self->{b})* sqrt($out_links); # zminena nekonzistence zadani
  }
  else {$xi;}
}

# pruchod hranou
sub throught_link {
  my($self, $signal, $weight) = @_;
  $signal * $weight;
}

# vypocet nove hodnoty dle vzorce a*X(i) + b*Input(i) + c*Output(i)
sub new_value {
  my($self, $node) = @_;
  my $node = \$self->{node_list}{$node};
  my $xi = $$node->{level};
  my $nodes;
  my $weight;
  # vypocet prichazejicich signalu
  my $input = 0;
  for $nodes (keys %{$$node->{in}}) {
    my $signal = $self->{node_list}{$nodes}{signal};
    for my $weight (@{$$$node{in}{$nodes}}) {
      $input += $self->throught_link($signal, $weight);
    }
  }
  # vypocet poslanych signalu
  my $output = 0;
  for $nodes (keys %{$$node->{out}}) {
    for $weight (@{$$$node{out}{$nodes}}) {
      $output += $$node->{signal};
    }
  }
  # aplikace vzorce
  return $self->{a} * $xi + $self->{b} * $input + $self->{c} * $output;
}

# smazani uzlu
sub delete_node {
  my($self, $node) = @_;
  delete $self->{node_list}{$node};
  for my $nodes (keys %{$self->{node_list}}){
    delete $self->{node_list}{$nodes}{in}{$node};
    delete $self->{node_list}{$nodes}{out}{$node};
  }
}
1;

############################################################### Main program
#!/usr/bin/perl
use graflib;
use strict;
use encoding 'UTF-8';

my $a; # parametr a
my $b; # parametr b
my $c; # parametr c
my $i; # pocet iteraci
my $t; # redukcni konstanta
my $k; # zpusob kalibrace

# otevreni souboru zadaneho parametrem
open FILE, "<:encoding(UTF-8)", @ARGV[0] or die "$!\n";
while (<FILE>) { # hledani parametru a
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "a") {$a = shift @_;}
}
seek FILE, 0, 0;
while (<FILE>) { # hledani parametru b
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "b") {$b = shift @_;}
}
seek FILE, 0, 0;
while (<FILE>) { # hledani parametru c
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "c") {$c = shift @_;}
}
seek FILE, 0, 0;
# pouziti parametru k vytvoreni objektu
my $graf = graflib->new($a,$b,$c);
while (<FILE>) { # hledani poctu iteraci
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "IterationsNo") {$i = shift @_;}
}
seek FILE, 0, 0;
while (<FILE>) { # hledani redukcni konstanty
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "t") {$t = shift @_;}
}
seek FILE, 0, 0;
while (<FILE>) { # hledani zpusobu kalibrace
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "Calibration") {$k = shift @_;}
}
seek FILE, 0, 0;
while (<FILE>) { # pridani typu hran
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "ltra") {$graf->link_type(@_);}
}
seek FILE, 0, 0;
while (<FILE>) { # pridani vahy vazeb
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "lw") {$graf->link_weight(@_);}
}
seek FILE, 0, 0;
while (<FILE>) { # pridani konkretnich uzlu
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "n") {$graf->add_node(@_);}
}
seek FILE, 0, 0;
while (<FILE>) { # pridani konkretnich hran
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "l") {$graf->add_link(@_);}
}
seek FILE, 0, 0;
while (<FILE>) { # nastaveni pocatecnich hodnot
  @_ = split /\s+/;
  my $keyword = shift @_;
  if ($keyword eq "ia") {$graf->set_value(@_);}
}
# zavreni souboru
close FILE;

# vypsani prvniho radku s nazvy uzlu
print "iter. ";
for my $nodes (sort(keys %{$graf->{node_list}})) {print "$nodes ";}
print "\n";

# iterovani
for (my $j = 0; $j <= $i; $j++){
  my $node;
  my $calibsum;
  my $calibsumall;
  # tisk hodnot uzlu
  print "$j ";
  for my $nodes (sort(keys %{$graf->{node_list}})) {
    printf "%.3f ", $graf->{node_list}{$nodes}{level};
  }
  print "\n";
  # kalibrace 2: zapamatuji si sumu v pocatku aktivovanych uzlu
  for my $nodes (keys %{$graf->{node_list}}) {
    if ($k eq "ConservationOfTotalActivation" && $graf->{node_list}{$nodes}{initial} > 0) {
      $calibsum += $graf->{node_list}{$nodes}{initial};
    }
  }
  # vypocet signalu v uzlech
  for my $nodes (keys %{$graf->{node_list}}) {
    $node = \$graf->{node_list}{$nodes};
    my $signal = $graf->signal_wave($node);
    $graf->{node_list}{$nodes}{signal} = $signal;
  }
  # vypocet nove hodnoty uzlu
  for my $nodes (keys %{$graf->{node_list}}) {
    my $new = $graf->new_value($nodes);
    $graf->{node_list}{$nodes}{level} = $new;
  }
  # kalibrace 1: zmenim v pocatku aktivovane uzly na aktivacni hodnoty a pamatuji pomer
  for my $nodes (keys %{$graf->{node_list}}) {
    if ($k eq "ConservationOfInitialActivation" && $graf->{node_list}{$nodes}{initial} > 0) {
      $calibsum += $graf->{node_list}{$nodes}{level} / $graf->{node_list}{$nodes}{initial};
      $graf->{node_list}{$nodes}{level} = $graf->{node_list}{$nodes}{initial};
    }
  }
  # kalibrace 1: vydelim vsechny uzly neaktivovane v pocatku pomerem v pocatku aktivovanych uzlu
  for my $nodes (keys %{$graf->{node_list}}) {
    if ($k eq "ConservationOfInitialActivation" && $graf->{node_list}{$nodes}{initial} == 0) {
      if ($calibsum != 0) {
        $graf->{node_list}{$nodes}{level} = $graf->{node_list}{$nodes}{level} / $calibsum;
      }
    }
  }
  # kalibrace 2: zapamatuji si sumu vsech uzlu
  for my $nodes (keys %{$graf->{node_list}}) {
    if ($k eq "ConservationOfTotalActivation") {
      $calibsumall += $graf->{node_list}{$nodes}{level};
    }
  }
  # kalibrace 2: vydelim vsechny uzly pomerem sumy vsech uzlu a sumy pocatecnich uzlu
  for my $nodes (keys %{$graf->{node_list}}) {
    if ($k eq "ConservationOfTotalActivation") {
      $graf->{node_list}{$nodes}{level} = $graf->{node_list}{$nodes}{level} / ($calibsumall / $calibsum);
    }
  }
  # redukce uzlu podle konstanty t
  for my $nodes (keys %{$graf->{node_list}}) {
    $graf->delete_node($nodes) unless ($graf->{node_list}{$nodes}{level} >= $t);
  }
}