aboutsummaryrefslogtreecommitdiff
path: root/freqdump.pl
blob: ccdd13470041e38d35f8086987e7ff1179d0d7b6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
#!/usr/bin/perl -w 
 
sub parse_matr {
  my $fn=shift;
  my $l;my @l;my $k2;
 
  open FM,"<$fn" or return;
 
  $l=<FM>;
  my @k1=split ' ',$l;
  $i=0;
 
  while ($l=<FM>) {
    @l=split ' ',$l;
    $k2=shift @l;
    for ($j=0;$j<=$#k1;$j++) {
      $matr{$k2}->{$k1[$j]}=shift @l;
    }
  }
  close FM;
}
 
sub make_couples {
  my $l=shift;
  if (defined $l) {
    for $j (sort keys %{$matr{$l}}) {
      $couples{"$l$j"}=($matr{$l}->{$j})+($matr{$j}->{$l});
    }
  } else {
    for $i (sort keys %matr) {
      for $j (sort keys %{$matr{$i}}) {
if ($i lt $j) {$k="$i$j"else {$k="$j$i"}
$couples{$k}+=$matr{$i}->{$j};
      }
    }
  }
}
 
$MATRFN='/tmp/freq.matr';
parse_matr($MATRFN);
 
@tot=();
 
for $k (reverse sort keys %matr) {
  %couples=();
  make_couples($k);
  @k=keys %couples;
  @k=sort {$couples{$b<=> $couples{$a}} @k;
  for (@k[0..9]) {push @tot,$_;push @tot,$couples{$_}};
}
 
$elems=($#tot+1)/2;
 
$cols=8;
$rows=1+int $elems/$cols;
 
for ($i=0;$i<$rows;$i++) {
  $j=$i;
  while ($j<$elems) {
    print $tot[$j*2],"->",sprintf('%4d',$tot[$j*2+1]),"  ";
    $j+=$rows;
  }
  print "\n";
}