Statistics
| Branch: | Revision:

psnr-tools / QoE.pl @ eb5ce4e7

History | View | Annotate | Download (4.12 KB)

1 040c8361 Csaba Kiraly
#!/usr/bin/perl
2 ad2a1304 Csaba Kiraly
 ###########################################
3
 #  Copyright (c) 2009 Csaba Kiraly        #
4
 #                                         #
5
 #  This is free software; see gpl-3.0.txt #
6
 ###########################################
7 040c8361 Csaba Kiraly
8
use strict;
9
use Statistics::Descriptive;
10 304e363b Csaba Kiraly
use POSIX qw(ceil floor);
11 62310d7d Csaba Kiraly
use Switch;
12 040c8361 Csaba Kiraly
13 62310d7d Csaba Kiraly
my $gl_inputfolder;
14 040c8361 Csaba Kiraly
15 b83cfd98 Csaba Kiraly
($ENV{'PSNR_TOOLS'}) or (print "\$PSNR_TOOLS not defined\n" and die);
16 e7f1eb59 Csaba Kiraly
my $PSNR_TOOLS=$ENV{'PSNR_TOOLS'};
17 36907371 Csaba Kiraly
($ENV{'PSNR_TMPPREFIX'}) or (print "\$PSNR_TMPPREFIX not defined\n" and die);
18
my $PSNR_TMPPREFIX=$ENV{'PSNR_TMPPREFIX'};
19 040c8361 Csaba Kiraly
20 304e363b Csaba Kiraly
#a value of 'src' for the peer creates an empty lost file
21 040c8361 Csaba Kiraly
sub peer_chunks_lost ($) {
22
  my ($peer)=@_;
23 304e363b Csaba Kiraly
24
  my @losts;
25
  if ($peer=='src') {
26
    @losts=`echo -n > lost.txt`;
27
  } else {
28 62310d7d Csaba Kiraly
    @losts=`$PSNR_TOOLS/chunks_lost.sh $peer $gl_inputfolder| tee lost.txt`;
29 304e363b Csaba Kiraly
  }
30 040c8361 Csaba Kiraly
  chomp @losts;
31
  return @losts;
32
}
33
34 304e363b Csaba Kiraly
sub peer_qoe ($$) {
35
  my ($peer,$chunksize)=@_;
36 040c8361 Csaba Kiraly
37
  my @losts = peer_chunks_lost($peer);
38
39
  my %qoe;
40
  #$qoe{ 'chunkloss' } = peer_chunkloss($peer,@losts);
41
42 304e363b Csaba Kiraly
  my $q;
43 eb5ce4e7 Luca Abeni
  $q=`$PSNR_TOOLS/psnr.sh calc $chunksize lost.txt`;
44 040c8361 Csaba Kiraly
45
  $q =~ m/psnr: ([\d\.]+)/;
46
  $qoe{ 'psnr' } = $1;
47
48 fb92c9bb Csaba Kiraly
  $q =~ m/ssim: ([\d\.]+)/;
49
  $qoe{ 'ssim' } = $1;
50
51 040c8361 Csaba Kiraly
  $q =~ m/bytes: ([\d\.]+)/;
52
  $qoe{ 'bytes' } = $1;
53
54
  $q =~ m/chunks: ([\d\.]+)/;
55
  $qoe{ 'chunks' } = $1;
56
57
  $q =~ m/chunkslost: ([\d\.]+)/;
58
  $qoe{ 'chunkslost' } = $1;
59
60
  $qoe{ 'chunkloss' } = $qoe{ 'chunkslost' } / $qoe{ 'chunks' } ;
61
62 fb92c9bb Csaba Kiraly
  return \%qoe;
63 040c8361 Csaba Kiraly
}
64
65
#sub num_chunks() {
66
#  return 1000;
67
#}
68
#
69
#sub peer_chunkloss ($@) {
70
#  my ($peer,@losts)=@_;
71
#  return (scalar @losts) / num_chunks();
72
#}
73
74
sub peers_of_class ($) {
75
  my ($peerclass)=@_;
76
77 62310d7d Csaba Kiraly
  my @peers=`$PSNR_TOOLS/peers_of_class.sh $peerclass $gl_inputfolder`;
78 040c8361 Csaba Kiraly
  chomp @peers;
79
  return @peers;
80
}
81
82 fb92c9bb Csaba Kiraly
sub print_stat($\%$) {
83
  my ($name,$qoes,$metric)=@_;
84 040c8361 Csaba Kiraly
85
  my $stat = Statistics::Descriptive::Full->new();
86 fb92c9bb Csaba Kiraly
  foreach my $peer (keys(%$qoes)) {
87
    $stat->add_data($qoes->{$peer}{$metric});
88
  }
89
90 040c8361 Csaba Kiraly
  print "$name: ";
91
  print " mean=".$stat->mean(); 
92
  print " var=".$stat->variance();
93
  print " count=".$stat->count();
94
  print "\n";
95
96 a1d16991 Csaba Kiraly
  return $stat->mean();
97 040c8361 Csaba Kiraly
}
98
99 fb92c9bb Csaba Kiraly
sub print_stats(\%){
100
  my ($qoes)=@_;
101
  my %avgqoe;
102
  $avgqoe{'psnr'} = print_stat("  psnr(uncompressed->received)",%$qoes ,'psnr');
103
  $avgqoe{'ssim'} = print_stat("  ssim",%$qoes,'ssim');
104
  $avgqoe{'chunkloss'} = print_stat("  chunkloss",%$qoes,'chunkloss');
105
  print "\n";
106
107
  return \%avgqoe;
108
}
109 040c8361 Csaba Kiraly
110 62310d7d Csaba Kiraly
sub qoe($$){
111
  my ($chunksize,$every)=@_;
112 304e363b Csaba Kiraly
113 fb92c9bb Csaba Kiraly
  my %allqoes;
114 304e363b Csaba Kiraly
  my @peerclasses=(1,2,3,4);
115 040c8361 Csaba Kiraly
116 304e363b Csaba Kiraly
  foreach my $peerclass (@peerclasses) {
117 040c8361 Csaba Kiraly
118 eb1aebb3 Csaba Kiraly
    print " Peer class = $peerclass\n";
119 040c8361 Csaba Kiraly
120 304e363b Csaba Kiraly
    my @peers=peers_of_class($peerclass);
121 040c8361 Csaba Kiraly
122 fb92c9bb Csaba Kiraly
    my %qoes;
123 05273512 Csaba Kiraly
    my $everycounter=0;
124 304e363b Csaba Kiraly
    foreach my $peer (@peers) {
125 05273512 Csaba Kiraly
      if ($everycounter % $every == 0) {
126 fb92c9bb Csaba Kiraly
        $qoes{$peer} = peer_qoe($peer,$chunksize);
127 05273512 Csaba Kiraly
      }
128
      $everycounter++;
129 304e363b Csaba Kiraly
    }
130 fb92c9bb Csaba Kiraly
    print_stats(%qoes);
131
    @allqoes{keys %qoes} = values %qoes;
132 040c8361 Csaba Kiraly
  }
133
134 eb1aebb3 Csaba Kiraly
  print " All peers\n";
135 fb92c9bb Csaba Kiraly
  my $avgqoe = print_stats(%allqoes);
136 a1d16991 Csaba Kiraly
137 fb92c9bb Csaba Kiraly
  return $avgqoe;
138 040c8361 Csaba Kiraly
}
139
140 6a5fc5e8 Csaba Kiraly
sub init ($$) {
141
  my ($video,$coder)=@_;
142 d80aa2f2 Csaba Kiraly
  my $tmp=`$PSNR_TOOLS/psnr.sh init $video "$coder"`;
143 62310d7d Csaba Kiraly
}
144
145
sub calc ($$) {
146
  my ($inputfolder,$every)=@_;
147
  $gl_inputfolder=$inputfolder;
148 040c8361 Csaba Kiraly
149 eb5ce4e7 Luca Abeni
  my $srcqoe = peer_qoe('src',0);
150 fb92c9bb Csaba Kiraly
  print "psnr(uncompressed->compressed): ".$srcqoe->{'psnr'}."\n";
151
  print "ssim(uncompressed->compressed): ".$srcqoe->{'ssim'}."\n";
152 040c8361 Csaba Kiraly
153 fb92c9bb Csaba Kiraly
  my $chunksize = ceil($srcqoe->{'bytes'}/$srcqoe->{'chunks'}); 
154 62310d7d Csaba Kiraly
155 fb92c9bb Csaba Kiraly
  print "\nQuality with GOP size chunks (avg chunk size = $srcqoe->{'bytes'}/$srcqoe->{'chunks'} bytes )\n";
156 eb5ce4e7 Luca Abeni
  my $avgqoe_gop = qoe(0,$every);
157 62310d7d Csaba Kiraly
  print "\nQuality with $chunksize bytes chunks\n";
158 fb92c9bb Csaba Kiraly
  my $avgqoe_nogop = qoe($chunksize,$every);
159
  print "PSNRresults $srcqoe->{'psnr'} $avgqoe_gop->{'psnr'} $avgqoe_nogop->{'psnr'}".
160
                   " $srcqoe->{'ssim'} $avgqoe_gop->{'ssim'} $avgqoe_nogop->{'ssim'}".
161
  "\n";
162 62310d7d Csaba Kiraly
}
163
164
#--------------------------------------------------
165
166
if ($ARGV[0] eq 'init') {
167 6a5fc5e8 Csaba Kiraly
  ($#ARGV + 1 == 3) or die;
168 62310d7d Csaba Kiraly
  my $video=$ARGV[1];
169 6a5fc5e8 Csaba Kiraly
  my $coder=$ARGV[2];
170
  init($video,$coder);
171 62310d7d Csaba Kiraly
} elsif ($ARGV[0] eq 'calc') {
172
  ($#ARGV + 1 == 3) or die;
173
  my $inputfolder=$ARGV[1];
174
  my $every=$ARGV[2]; #calculate values only for every "everty"th of peers
175
  calc($inputfolder,$every);
176
} else {
177
  print "Usage: ... see source\n";
178
}