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