bin/sumo

   1 #!/usr/bin/perl
   2
   3 use FindBin qw($Bin);
   4 use lib "$Bin/../lib";
   5
   6 # Don't edit the line below, it must look exactly like this.
   7 # Everything above this line will be replaced #
   8
   9 use PsN;
  10 use output;
  11 use debug;
  12 use strict;
  13 use Getopt::Long;
  14
  15 my %options;
  16
  17 $options{'precision'} = 4;
  18
  19 my $opts = { "h|?"                 => $options{'help'},
  20              "help"                => $options{'long_help'},
  21              "debug:0"             => $options{'debug'},
  22              "debug_package:s"     => $options{'debug_package'},
  23              "debug_subroutine:s"  => $options{'debug_subroutine'},
  24              "compact_format:1"    => $options{'compact_format'},
  25              "csv"                 => $options{'csv'},
  26              "precision:4"         => $options{'precision'},
  27              "confidence_interval" => $options{'confidence_interval'},
  28              "c_level:95"          => $options{'c_level'} };
  29
  30
  31 my $res = GetOptions( \%options, %{$opts} );
  32
  33 exit unless $res;
  34
  35 if ( scalar( @ARGV ) < 1 and !($options{'help'} or $options{'long_help'}) ){
  36   print "At least one list file must be specified. Use 'sumo.pl -h' for help.\n";
  37   exit;
  38 }
  39
  40
  41 if($options{'help'} or $options{'long_help'}) {
  42   print <<'ENDHELP';
  43
  44   sumo.pl
  45
  46   Perl script for summarizing output data.
  47
  48   Usage:
  49
  50   sumo.pl [ -h | -? ] [ -help ]
  51           [ -debug='integer' ]
  52           [ -debug_package='string' ]
  53           [ -debug_subroutine='string' ]
  54           outputfile(s)
  55
  56 ENDHELP
  57
  58   if( $options{'long_help'} and !$options{'help'} ){
  59
  60     print <<'ENDHELP';
  61
  62   Description:
  63
  64     Sumo is short for SUmmarize Output. And it does exactly that. It
  65     gathers some usefull information from NONMEM ouputfiles and prints
  66     a summary to screen.
  67
  68   Examples:
  69
  70     Get summary from an output file:
  71
  72     $ sumo.pl output.lst
  73
  74   Options:
  75
  76     The following options are valid:
  77
  78     -h | -?
  79
  80     Print a list of options.
  81
  82
  83     -help
  84
  85     Print this, longer, help message.
  86
  87
  88         -debug='integer'
  89
  90     Default value is: 0
  91
  92     This is mainly for developers who whish to debug PsN. By default
  93     'integer' is zero but you can try setting it to '1' and you might
  94     get some helpfull warnings. If you run in to problems that require
  95     support, you might be told to crank this number up and send the
  96     output to us.
  97
  98
  99     -debug_package='string'
 100
 101     Default value is: empty string
 102
 103     If use together with '-debug' it is possible to choose which part
 104     of PsN you want to see debug messages from. Again this is mostly
 105     for developers.
 106
 107
 108     -debug_subroutine='string'
 109
 110     Default value is: empty string
 111
 112     With this option it is possible to specify, with even finer
 113     granularity, which part of PsN you want to see debug messages
 114     from. This is definitly only for developers.
 115
 116 ENDHELP
 117   }
 118   exit;
 119 }
 120
 121 debug -> level( $options{'debug'} );
 122 debug -> package( $options{'debug_package'} );
 123 debug -> subroutine( $options{'debug_subroutine'} );
 124
 125 my $form = '%.' . $options{'precision'} . 'g';
 126
 127 foreach my $outfile ( @ARGV ) {
 128
 129     my $outobj = output -> new ('filename'=> $outfile);
 130
 131     my @output_matrix;
 132     my @output_matrix_sizes;
 133
 134     my %c_levels = ( '90'   => 1.6449,
 135                      '95'   => 1.96,
 136                      '99'   => 2.5758,
 137                      '99.9' => 3.2905 );
 138
 139     if( $options{'confidence_interval'} ) {
 140         if( not defined $c_levels{$options{'c_level'}} ) {
 141             die "Sorry, confidence intervals for level ".$options{'c_level'}.
 142                 " can not be output. Valid levels are: ".join(',', keys %c_levels).
 143                 "\n";
 144         }
 145     }
 146
 147 #use Data::Dumper;
 148 #print Dumper( $outobj );
 149
 150     print "$outfile\n\n";
 151
 152     for( my $problems = 0; $problems <= $#{$outobj -> problems}; $problems++){
 153         my $row_counter = 0;
 154         for( my $sub_problems = 0; $sub_problems <= $#{$outobj -> problems -> [$problems] -> subproblems}; $sub_problems++){
 155
 156             my ( %nam, %est, %cest, %ses );
 157             my @thetas = defined $outobj -> thetas -> [$problems][$sub_problems] ? @{$outobj -> thetas -> [$problems][$sub_problems]} : ();
 158             my @thnam  = defined $outobj -> thetanames -> [$problems] ? @{$outobj -> thetanames -> [$problems]} : ();
 159             my @sethet = defined $outobj -> sethetas -> [$problems][$sub_problems] ? @{$outobj -> sethetas -> [$problems][$sub_problems]} : ();
 160             $nam{'theta'} = \@thnam;
 161             $est{'theta'} = \@thetas;
 162             $ses{'theta'} = \@sethet;
 163
 164
 165             my @omegas = defined $outobj -> omegas -> [$problems][$sub_problems] ? @{$outobj -> omegas -> [$problems][$sub_problems]} : ();
 166             my @comegas = defined $outobj -> comegas -> [$problems][$sub_problems] ? @{$outobj -> comegas -> [$problems][$sub_problems]} : ();
 167             my @omnam  = defined $outobj -> omeganames -> [$problems] ? @{$outobj -> omeganames -> [$problems]} : ();
 168             my @seomeg = defined $outobj -> seomegas -> [$problems][$sub_problems] ? @{$outobj -> seomegas -> [$problems][$sub_problems]} : ();
 169             $nam{'omega'} = \@omnam;
 170             $est{'omega'} = \@omegas;
 171             $cest{'omega'} = \@comegas;
 172             $ses{'omega'} = \@seomeg;
 173
 174             my @sigmas = defined $outobj -> sigmas -> [$problems][$sub_problems] ? @{$outobj -> sigmas -> [$problems][$sub_problems]} : ();
 175             my @csigmas = defined $outobj -> csigmas -> [$problems][$sub_problems] ? @{$outobj -> csigmas -> [$problems][$sub_problems]} : ();
 176             my @signam = defined $outobj -> sigmanames -> [$problems] ? @{$outobj -> sigmanames -> [$problems]} : ();
 177             my @sesigm = defined $outobj -> sesigmas -> [$problems][$sub_problems] ? @{$outobj -> sesigmas -> [$problems][$sub_problems]} : ();
 178             $nam{'sigma'} = \@signam;
 179             $est{'sigma'} = \@sigmas;
 180             $cest{'sigma'} = \@csigmas;
 181             $ses{'sigma'} = \@sesigm;
 182
 183             my $ofv    = $outobj -> ofv -> [$problems][$sub_problems];
 184             my $termess= $outobj -> minimization_message -> [$problems][$sub_problems];
 185
 186             if( $termess ){
 187                 print join( "",@{$termess} ), "\n";
 188             }
 189
 190             if ( defined $ofv ) {
 191                 print "Objective function value: ",$ofv,"\n\n";
 192             } else {
 193                 print "Objective function value: UNDEFINED\n\n";
 194             }
 195
 196             my @cvsethet;
 197             my @cvseomeg;
 198             my @cvsesigm;
 199
 200             if(@sethet) {
 201
 202               if( defined $outobj -> cvsethetas -> [$problems][$sub_problems] ) {
 203                 @cvsethet = @{$outobj -> cvsethetas -> [$problems][$sub_problems]};
 204               }
 205               if( defined $outobj -> cvseomegas -> [$problems][$sub_problems] ) {
 206                 @cvseomeg = @{$outobj -> cvseomegas -> [$problems][$sub_problems]};
 207               }
 208               if( defined $outobj -> cvsesigmas -> [$problems][$sub_problems] ) {
 209                 @cvsesigm = @{$outobj -> cvsesigmas -> [$problems][$sub_problems]};
 210               }
 211
 212             }
 213
 214             push( @{$output_matrix[$row_counter]}, "","THETA","","","OMEGA","","","SIGMA", "" );
 215             for( my $i = 0; $i <= $#{$output_matrix[$row_counter]}; $i++ ){
 216                 if( $output_matrix_sizes[$i] < length( $output_matrix[$row_counter][$i] ) ){
 217                     $output_matrix_sizes[$i] = length( $output_matrix[$row_counter][$i] );
 218                 }
 219             }
 220             $row_counter++;
 221
 222 #printf "%-4s %-29s %-29s %-18s\n"," ","THETA","OMEGA","SIGMA";
 223
 224             my $max_par = $#thetas;
 225             $max_par = $#omegas if ( $#omegas > $max_par );
 226             $max_par = $#sigmas if ( $#sigmas > $max_par );
 227
 228             for ( my $i = 0; $i <= $max_par; $i++ ) {
 229                 my ( @row, %cis );
 230                 if( $options{'confidence_interval'} ) {
 231                     foreach my $param ( 'theta', 'omega', 'sigma' ) {
 232                         if ( defined $est{$param}[$i] ) {
 233                             my $diff = $c_levels{$options{'c_level'}}*$ses{$param}[$i];
 234                             my ( $lo, $up );
 235                             if( defined $diff ) {
 236                                 $lo = $est{$param}[$i]-$diff;
 237                                 $up = $est{$param}[$i]+$diff;
 238                             }
 239                             my $cis = sprintf( "($form - $form)", $lo, $up );
 240                             push( @row, $nam{$param}[$i],
 241                                   sprintf( $form, $est{$param}[$i] ),
 242                                   $cis );
 243                         } else {
 244                             push( @row, '','','' );
 245                         }
 246                     }
 247                 } else {
 248                     if ( defined $thnam[$i] ) {
 249                         push( @row, $thnam[$i], defined $thetas[$i] ? sprintf( $form, $thetas[$i] ) : '........',
 250                               $cvsethet[$i] ? sprintf( "($form)", $cvsethet[$i] ) : '(........)' );
 251                     } else {
 252                         push( @row, '','','' );
 253                     }
 254                     if ( defined $omnam[$i] ) {
 255                         push( @row, $omnam[$i], defined $comegas[$i] ? sprintf( $form, $comegas[$i] ) : '........' ,
 256                               $cvseomeg[$i] ? sprintf( "($form)", $cvseomeg[$i] ) : '(........)' );
 257                     } else {
 258                         push( @row, '','','');
 259                     }
 260                     if ( defined $signam[$i] ) {
 261                         push( @row, $signam[$i], defined $sigmas[$i] ? sprintf( $form, $sigmas[$i] ) : '........',
 262                               $cvsesigm[$i] ? sprintf( "($form)", $cvsesigm[$i] ) : '(........)' );
 263                     } else {
 264                         push( @row, '','','');
 265                     }
 266                 }
 267
 268                 push(@{$output_matrix[$row_counter]}, @row);
 269                 for( my $i = 0; $i <= $#{$output_matrix[$row_counter]}; $i++ ){
 270                     if( $output_matrix_sizes[$i] < length( $output_matrix[$row_counter][$i] ) ){
 271                         $output_matrix_sizes[$i] = length( $output_matrix[$row_counter][$i] );
 272                     }
 273                 }
 274                 $row_counter++;
 275
 276             }
 277         }
 278     }
 279
 280 #for( my $j = 0; $j <= $#output_matrix; $j++ ){
 281 #  for( my $i = 0; $i <= $#{$output_matrix[$j]}; $i++ ){
 282 #    if( $output_matrix_sizes[$i] < length( $output_matrix[$j][$i] ) ){
 283 #      $output_matrix_sizes[$i] = length( $output_matrix[$j][$i] );
 284 #    }
 285 #  }
 286 #}
 287
 288     foreach my $row ( @output_matrix ){
 289         for( my $i = 0; $i <= $#{$row}; $i++ ){
 290             my $spaces = $output_matrix_sizes[$i] - length($row -> [$i]);
 291             if( $options{'csv'} ){
 292                 print $row -> [$i], ",";
 293             } else {
 294                 print " " x $spaces, $row -> [$i], "  ";
 295             }
 296         }
 297         print "\n";
 298     }
 299 }
 300
 301
 302 # my $pl = 1;
 303 # my @plist;
 304 # while($pl) {
 305 #   my $f = "";
 306 #   $pl = 0;
 307
 308 #   if(@thnam){
 309 #     push(@plist,shift @thnam);
 310 #     $pl = 1;
 311 #     $f.="%-4s ";
 312 #   } else {
 313 #     push(@plist," ");
 314 #     $f.="%-4s ";
 315 #   }
 316
 317 #   if(@thetas){
 318 #     push(@plist,shift @thetas);
 319 #     $pl = 1;
 320 #     $f.="%-10.4g ";
 321 #   } else {
 322 #     push(@plist," ");
 323 #     $f.="%-10s ";
 324 #   }
 325
 326 #   if(@cvsethet){
 327 #     push(@plist,"(".(sprintf "%.3g",shift @cvsethet).")");
 328 #     $pl = 1;
 329 #     $f.="%-12s ";
 330 #   } else {
 331 #     push @plist," " and $f.="%-12s ";
 332 #   }
 333
 334 #   if ( defined $omegas[0] ) {
 335 #   if(@omnam){
 336 # #     push(@om_str,shift @omnam);
 337 # #     $pl = 1;
 338 # #     $f .="%-5s ";
 339 # #   } else {
 340 # #     push(@om_str," ");
 341 # #     $f .="%-5s ";
 342 # #   }
 343
 344
 345 # #   my ( $omega, @om_str );
 346 # #   if(@omegas){
 347 # #     $omega = shift( @omegas );
 348 # #     unless( defined $omega and not $compact_format){
 349 # #       push( @om_str, "NaN" );
 350 # #       $f .= "%-10s ";
 351 # #     } elsif ( $omega != 0 or not $compact_format ) {
 352 # #       push(@om_str,$omega);
 353 # #       $pl = 1;
 354 # #       $f.="%-10.4g ";
 355 # #     }
 356 # #   } else {
 357 # #     push(@plist," ");
 358 # #     $f.="%-10s ";
 359 # #   }
 360
 361 # #   if(@cvseomeg){
 362 # #     my $cvseomega = shift( @cvseomeg );
 363 # #     if ( $omega != 0 ) {
 364 # #       push(@plist,"(".(sprintf "%.3g",$cvseomega).")");
 365 # #       $pl = 1;
 366 # #       $f.="%-8s ";
 367 # #     }
 368 # #   } else {
 369 # #     push(@plist," ");
 370 # #     $f.="%-8s ";
 371 # #   }
 372
 373 #   if(@signam){
 374 #     push(@plist,shift @signam);
 375 #     $pl = 1;
 376 #     $f .="%-4s ";
 377 #   } else {
 378 #     push(@plist," ");
 379 #     $f .="%-4s ";
 380 #   }
 381
 382 #   if(@sigmas){
 383 #     push(@plist,shift @sigmas);
 384 #     $pl = 1;
 385 #     $f.="%-10.4g ";
 386 #   } else {
 387 #     push(@plist," ");
 388 #     $f.="%-10s";
 389 #   }
 390
 391 #   if(@cvsesigm) {
 392 #     push(@plist,"(".(sprintf "%.3g",shift @cvsesigm).")");
 393 #     $pl = 1;
 394 #     $f.="%-8s ";
 395 #   } else {
 396 #     push(@plist," ");
 397 #     $f.="%-8s ";
 398 #   }
 399
 400 #   $f .="\n";
 401
 402 #   if($pl) {
 403 #     printf $f,@plist;
 404 #   }
 405 #   undef @plist;
 406 # }
 407
 408
 409