functionalized version 2, implemented version 1 using functions in version 2
[PsN.git] / bin / sumo
blobba53a156446410c05872fa5b3eca2f1e6c34ae39
1 #!/usr/bin/perl
3 use FindBin qw($Bin);
4 use lib "$Bin/../lib";
6 # Don't edit the line below, it must look exactly like this.
7 # Everything above this line will be replaced #
9 use PsN;
10 use output;
11 use debug;
12 use strict;
13 use Getopt::Long;
15 my %options;
17 $options{'precision'} = 4;
19 my @opts = ( "h|?",
20 "help",
21 "debug:0",
22 "debug_package:s",
23 "debug_subroutine:s",
24 "compact_format:1",
25 "csv",
26 "precision:4",
27 "confidence_interval",
28 "c_level:95" );
31 my $res = GetOptions( \%options, @opts );
33 exit unless $res;
35 if ( scalar( @ARGV ) < 1 and !($options{'h'} or $options{'help'}) ){
36 print "At least one list file must be specified. Use 'sumo.pl -h' for help.\n";
37 exit;
41 if($options{'h'} or $options{'help'}) {
42 print <<'ENDHELP';
44 sumo.pl
46 Perl script for summarizing output data.
48 Usage:
50 sumo.pl [ -h | -? ] [ -help ]
51 [ -debug='integer' ]
52 [ -debug_package='string' ]
53 [ -debug_subroutine='string' ]
54 outputfile(s)
56 ENDHELP
58 if( $options{'help'} and !$options{'h'} ){
60 print <<'ENDHELP';
62 Description:
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.
68 Examples:
70 Get summary from an output file:
72 $ sumo.pl output.lst
74 Options:
76 The following options are valid:
78 -h | -?
80 Print a list of options.
83 -help
85 Print this, longer, help message.
88 -debug='integer'
90 Default value is: 0
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.
99 -debug_package='string'
101 Default value is: empty string
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.
108 -debug_subroutine='string'
110 Default value is: empty string
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.
116 ENDHELP
118 exit;
121 debug -> level( $options{'debug'} );
122 debug -> package( $options{'debug_package'} );
123 debug -> subroutine( $options{'debug_subroutine'} );
125 my $form = '%.' . $options{'precision'} . 'g';
127 foreach my $outfile ( @ARGV ) {
129 my $outobj = output -> new ('filename'=> $outfile);
131 unless( $outobj -> parsed_successfully ){
132 print "Unable to read outputfile, parser error message:\n";
133 print $outobj -> parsing_error_message();
136 my @output_matrix;
137 my @output_matrix_sizes;
139 my %c_levels = ( '90' => 1.6449,
140 '95' => 1.96,
141 '99' => 2.5758,
142 '99.9' => 3.2905 );
144 if( $options{'confidence_interval'} ) {
145 if( not defined $c_levels{$options{'c_level'}} ) {
146 die "Sorry, confidence intervals for level ".$options{'c_level'}.
147 " can not be output. Valid levels are: ".join(',', keys %c_levels).
148 "\n";
152 #use Data::Dumper;
153 #print Dumper( $outobj );
155 print "$outfile\n\n";
157 for( my $problems = 0; $problems <= $#{$outobj -> problems}; $problems++){
158 my $row_counter = 0;
159 for( my $sub_problems = 0; $sub_problems <= $#{$outobj -> problems -> [$problems] -> subproblems}; $sub_problems++){
161 my ( %nam, %est, %cest, %ses );
162 my @thetas = defined $outobj -> thetas -> [$problems][$sub_problems] ? @{$outobj -> thetas -> [$problems][$sub_problems]} : ();
163 my @thnam = defined $outobj -> thetanames -> [$problems] ? @{$outobj -> thetanames -> [$problems]} : ();
164 my @sethet = defined $outobj -> sethetas -> [$problems][$sub_problems] ? @{$outobj -> sethetas -> [$problems][$sub_problems]} : ();
165 $nam{'theta'} = \@thnam;
166 $est{'theta'} = \@thetas;
167 $ses{'theta'} = \@sethet;
170 my @omegas = defined $outobj -> omegas -> [$problems][$sub_problems] ? @{$outobj -> omegas -> [$problems][$sub_problems]} : ();
171 my @comegas = defined $outobj -> comegas -> [$problems][$sub_problems] ? @{$outobj -> comegas -> [$problems][$sub_problems]} : ();
172 my @omnam = defined $outobj -> omeganames -> [$problems] ? @{$outobj -> omeganames -> [$problems]} : ();
173 my @seomeg = defined $outobj -> seomegas -> [$problems][$sub_problems] ? @{$outobj -> seomegas -> [$problems][$sub_problems]} : ();
174 $nam{'omega'} = \@omnam;
175 $est{'omega'} = \@omegas;
176 $cest{'omega'} = \@comegas;
177 $ses{'omega'} = \@seomeg;
179 my @sigmas = defined $outobj -> sigmas -> [$problems][$sub_problems] ? @{$outobj -> sigmas -> [$problems][$sub_problems]} : ();
180 my @csigmas = defined $outobj -> csigmas -> [$problems][$sub_problems] ? @{$outobj -> csigmas -> [$problems][$sub_problems]} : ();
181 my @signam = defined $outobj -> sigmanames -> [$problems] ? @{$outobj -> sigmanames -> [$problems]} : ();
182 my @sesigm = defined $outobj -> sesigmas -> [$problems][$sub_problems] ? @{$outobj -> sesigmas -> [$problems][$sub_problems]} : ();
183 $nam{'sigma'} = \@signam;
184 $est{'sigma'} = \@sigmas;
185 $cest{'sigma'} = \@csigmas;
186 $ses{'sigma'} = \@sesigm;
188 my $ofv = $outobj -> ofv -> [$problems][$sub_problems];
189 my $termess= $outobj -> minimization_message -> [$problems][$sub_problems];
191 if( $termess ){
192 print join( "",@{$termess} ), "\n";
195 if ( defined $ofv ) {
196 print "Objective function value: ",$ofv,"\n\n";
197 } else {
198 print "Objective function value: UNDEFINED\n\n";
201 my @cvsethet;
202 my @cvseomeg;
203 my @cvsesigm;
205 if(@sethet) {
207 if( defined $outobj -> cvsethetas -> [$problems][$sub_problems] ) {
208 @cvsethet = @{$outobj -> cvsethetas -> [$problems][$sub_problems]};
210 if( defined $outobj -> cvseomegas -> [$problems][$sub_problems] ) {
211 @cvseomeg = @{$outobj -> cvseomegas -> [$problems][$sub_problems]};
213 if( defined $outobj -> cvsesigmas -> [$problems][$sub_problems] ) {
214 @cvsesigm = @{$outobj -> cvsesigmas -> [$problems][$sub_problems]};
219 push( @{$output_matrix[$row_counter]}, "","THETA","","","OMEGA","","","SIGMA", "" );
220 for( my $i = 0; $i <= $#{$output_matrix[$row_counter]}; $i++ ){
221 if( $output_matrix_sizes[$i] < length( $output_matrix[$row_counter][$i] ) ){
222 $output_matrix_sizes[$i] = length( $output_matrix[$row_counter][$i] );
225 $row_counter++;
227 #printf "%-4s %-29s %-29s %-18s\n"," ","THETA","OMEGA","SIGMA";
229 my $max_par = $#thetas;
230 $max_par = $#omegas if ( $#omegas > $max_par );
231 $max_par = $#sigmas if ( $#sigmas > $max_par );
233 for ( my $i = 0; $i <= $max_par; $i++ ) {
234 my ( @row, %cis );
235 if( $options{'confidence_interval'} ) {
236 foreach my $param ( 'theta', 'omega', 'sigma' ) {
237 if ( defined $est{$param}[$i] ) {
238 my $diff = $c_levels{$options{'c_level'}}*$ses{$param}[$i];
239 my ( $lo, $up );
240 if( defined $diff ) {
241 $lo = $est{$param}[$i]-$diff;
242 $up = $est{$param}[$i]+$diff;
244 my $cis = sprintf( "($form - $form)", $lo, $up );
245 push( @row, $nam{$param}[$i],
246 sprintf( $form, $est{$param}[$i] ),
247 $cis );
248 } else {
249 push( @row, '','','' );
252 } else {
253 if ( defined $thnam[$i] ) {
254 push( @row, $thnam[$i], defined $thetas[$i] ? sprintf( $form, $thetas[$i] ) : '........',
255 $cvsethet[$i] ? sprintf( "($form)", $cvsethet[$i] ) : '(........)' );
256 } else {
257 push( @row, '','','' );
259 if ( defined $omnam[$i] ) {
260 push( @row, $omnam[$i], defined $comegas[$i] ? sprintf( $form, $comegas[$i] ) : '........' ,
261 $cvseomeg[$i] ? sprintf( "($form)", $cvseomeg[$i] ) : '(........)' );
262 } else {
263 push( @row, '','','');
265 if ( defined $signam[$i] ) {
266 push( @row, $signam[$i], defined $sigmas[$i] ? sprintf( $form, $sigmas[$i] ) : '........',
267 $cvsesigm[$i] ? sprintf( "($form)", $cvsesigm[$i] ) : '(........)' );
268 } else {
269 push( @row, '','','');
273 push(@{$output_matrix[$row_counter]}, @row);
274 for( my $i = 0; $i <= $#{$output_matrix[$row_counter]}; $i++ ){
275 if( $output_matrix_sizes[$i] < length( $output_matrix[$row_counter][$i] ) ){
276 $output_matrix_sizes[$i] = length( $output_matrix[$row_counter][$i] );
279 $row_counter++;
285 #for( my $j = 0; $j <= $#output_matrix; $j++ ){
286 # for( my $i = 0; $i <= $#{$output_matrix[$j]}; $i++ ){
287 # if( $output_matrix_sizes[$i] < length( $output_matrix[$j][$i] ) ){
288 # $output_matrix_sizes[$i] = length( $output_matrix[$j][$i] );
290 # }
293 foreach my $row ( @output_matrix ){
294 for( my $i = 0; $i <= $#{$row}; $i++ ){
295 my $spaces = $output_matrix_sizes[$i] - length($row -> [$i]);
296 if( $options{'csv'} ){
297 print $row -> [$i], ",";
298 } else {
299 print " " x $spaces, $row -> [$i], " ";
302 print "\n";
307 # my $pl = 1;
308 # my @plist;
309 # while($pl) {
310 # my $f = "";
311 # $pl = 0;
313 # if(@thnam){
314 # push(@plist,shift @thnam);
315 # $pl = 1;
316 # $f.="%-4s ";
317 # } else {
318 # push(@plist," ");
319 # $f.="%-4s ";
322 # if(@thetas){
323 # push(@plist,shift @thetas);
324 # $pl = 1;
325 # $f.="%-10.4g ";
326 # } else {
327 # push(@plist," ");
328 # $f.="%-10s ";
331 # if(@cvsethet){
332 # push(@plist,"(".(sprintf "%.3g",shift @cvsethet).")");
333 # $pl = 1;
334 # $f.="%-12s ";
335 # } else {
336 # push @plist," " and $f.="%-12s ";
339 # if ( defined $omegas[0] ) {
340 # if(@omnam){
341 # # push(@om_str,shift @omnam);
342 # # $pl = 1;
343 # # $f .="%-5s ";
344 # # } else {
345 # # push(@om_str," ");
346 # # $f .="%-5s ";
347 # # }
350 # # my ( $omega, @om_str );
351 # # if(@omegas){
352 # # $omega = shift( @omegas );
353 # # unless( defined $omega and not $compact_format){
354 # # push( @om_str, "NaN" );
355 # # $f .= "%-10s ";
356 # # } elsif ( $omega != 0 or not $compact_format ) {
357 # # push(@om_str,$omega);
358 # # $pl = 1;
359 # # $f.="%-10.4g ";
360 # # }
361 # # } else {
362 # # push(@plist," ");
363 # # $f.="%-10s ";
364 # # }
366 # # if(@cvseomeg){
367 # # my $cvseomega = shift( @cvseomeg );
368 # # if ( $omega != 0 ) {
369 # # push(@plist,"(".(sprintf "%.3g",$cvseomega).")");
370 # # $pl = 1;
371 # # $f.="%-8s ";
372 # # }
373 # # } else {
374 # # push(@plist," ");
375 # # $f.="%-8s ";
376 # # }
378 # if(@signam){
379 # push(@plist,shift @signam);
380 # $pl = 1;
381 # $f .="%-4s ";
382 # } else {
383 # push(@plist," ");
384 # $f .="%-4s ";
387 # if(@sigmas){
388 # push(@plist,shift @sigmas);
389 # $pl = 1;
390 # $f.="%-10.4g ";
391 # } else {
392 # push(@plist," ");
393 # $f.="%-10s";
396 # if(@cvsesigm) {
397 # push(@plist,"(".(sprintf "%.3g",shift @cvsesigm).")");
398 # $pl = 1;
399 # $f.="%-8s ";
400 # } else {
401 # push(@plist," ");
402 # $f.="%-8s ";
405 # $f .="\n";
407 # if($pl) {
408 # printf $f,@plist;
410 # undef @plist;