6 # Don't edit the line below, it must look exactly like this.
7 # Everything above this line will be replaced #
17 $options{'precision'} = 4;
27 "confidence_interval",
31 my $res = GetOptions( \%options, @opts );
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";
41 if($options{'h'} or $options{'help'}) {
46 Perl script for summarizing output data.
50 sumo.pl [ -h | -? ] [ -help ]
52 [ -debug_package='string' ]
53 [ -debug_subroutine='string' ]
58 if( $options{'help'} and !$options{'h'} ){
64 Sumo is short for SUmmarize Output. And it does exactly that. It
65 gathers some usefull information from NONMEM ouputfiles and prints
70 Get summary from an output file:
76 The following options are valid:
80 Print a list of options.
85 Print this, longer, help message.
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
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
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.
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
();
137 my @output_matrix_sizes;
139 my %c_levels = ( '90' => 1.6449,
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).
153 #print Dumper( $outobj );
155 print "$outfile\n\n";
157 for( my $problems = 0; $problems <= $#{$outobj -> problems}; $problems++){
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];
192 print join( "",@
{$termess} ), "\n";
195 if ( defined $ofv ) {
196 print "Objective function value: ",$ofv,"\n\n";
198 print "Objective function value: UNDEFINED\n\n";
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] );
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++ ) {
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];
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] ),
249 push( @row, '','','' );
253 if ( defined $thnam[$i] ) {
254 push( @row, $thnam[$i], defined $thetas[$i] ?
sprintf( $form, $thetas[$i] ) : '........',
255 $cvsethet[$i] ?
sprintf( "($form)", $cvsethet[$i] ) : '(........)' );
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] ) : '(........)' );
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] ) : '(........)' );
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] );
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] );
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], ",";
299 print " " x
$spaces, $row -> [$i], " ";
314 # push(@plist,shift @thnam);
323 # push(@plist,shift @thetas);
332 # push(@plist,"(".(sprintf "%.3g",shift @cvsethet).")");
336 # push @plist," " and $f.="%-12s ";
339 # if ( defined $omegas[0] ) {
341 # # push(@om_str,shift @omnam);
345 # # push(@om_str," ");
350 # # my ( $omega, @om_str );
352 # # $omega = shift( @omegas );
353 # # unless( defined $omega and not $compact_format){
354 # # push( @om_str, "NaN" );
356 # # } elsif ( $omega != 0 or not $compact_format ) {
357 # # push(@om_str,$omega);
362 # # push(@plist," ");
367 # # my $cvseomega = shift( @cvseomeg );
368 # # if ( $omega != 0 ) {
369 # # push(@plist,"(".(sprintf "%.3g",$cvseomega).")");
374 # # push(@plist," ");
379 # push(@plist,shift @signam);
388 # push(@plist,shift @sigmas);
397 # push(@plist,"(".(sprintf "%.3g",shift @cvsesigm).")");