Added notes_on_cvs
[PsN.git] / lib / output_subs.pm
blobda68c0e9eebb22ac07c4ab6f55163a9286d3162f
1 # {{{ include
3 start include statements
4 # A Perl module for parsing NONMEM output files
5 use Digest::MD5 'md5_hex';
6 use OSspecific;
7 use Storable;
8 use Config;
9 use ext::Math::SigFigs;
10 use Data::Dumper;
11 end include statements
13 # }}} include statements
15 # {{{ description
17 # No method, just documentation
18 start description
19 # The PsN output class is built to ease the (often trivial,
20 # but still time consuming) task of gathering and structuring the
21 # information contained in NONMEM output files. The major parts of a
22 # NONMEM output file are parsed and in the L</methods> section
23 # you can find a listing of the routines that are available.
24 end description
26 # }}} description
28 # {{{ synopsis
30 start synopsis
31 # use output;
33 # my $out_obj = output -> new ( filename => 'run1.lst' );
35 # my @thetas = @{$out_obj -> thetas};
36 # my @omegas = @{$out_obj -> omegas};
37 # my @ofvs = @{$out_obj -> ofvs};
38 end synopsis
40 # }}} synopsis
42 # {{{ see_also
44 start see_also
45 # =begin html
47 # <a HREF="data.html">data</a>, <a HREF="model.html">model</a>
48 # <a HREF="tool/modelfit.html">tool::modelfit</a>,
49 # <a HREF="tool.html">tool</a>
51 # =end html
53 # =begin man
55 # data, model, tool::modelfit, tool
57 # =end man
58 end see_also
60 # }}} see_also
62 # {{{ new
64 start new
66 # Usage:
68 # $outputObject -> new( filename => 'run1.lst' );
70 # The basic usage above creates a output object with the data
71 # in file.out parsed into memory.
73 # $outputObject -> new( filename => 'run1.lst',
74 # target => 'disk' );
76 # If I<target> is set to 'disk', the data in "run1.lst" will
77 # be left on disk in an effort to preserve memory. The file
78 # will be read if needed.
80 debug -> warn( level => 2,
81 message => "Initiating new\tNM::output object from file $parm{'filename'}" );
82 if ( defined $this -> {'filename'} and $this -> {'filename'} ne '' ) {
83 ( $this -> {'directory'}, $this -> {'filename'} ) =
84 OSspecific::absolute_path( $this -> {'directory'},$this->{'filename'} );
85 if( -e $this -> full_name ){
86 if($this -> {'target'} eq 'mem'){
87 $this -> _read_problems;
89 } else {
90 debug -> die( message => "The NONMEM output file ".
91 $this -> full_name." does not exist" )
92 unless $this -> {'ignore_missing_files'};
94 } else {
95 debug -> die( message => "No filename specified or filename equals empty string!" );
96 $this->{'filename'} = 'tempfile';
99 end new
101 # }}} new
103 # {{{ register_in_database
105 start register_in_database
106 if ( $PsN::config -> {'_'} -> {'use_database'} ) {
107 my $md5sum;
108 if( -e $self -> full_name ){
109 # md5sum
110 $md5sum = md5_hex(OSspecific::slurp_file($self-> full_name ));
112 # Backslashes messes up the sql syntax
113 my $file_str = $self->{'filename'};
114 my $dir_str = $self->{'directory'};
115 $file_str =~ s/\\/\//g;
116 $dir_str =~ s/\\/\//g;
118 my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
119 ";databse=".$PsN::config -> {'_'} -> {'project'},
120 $PsN::config -> {'_'} -> {'user'},
121 $PsN::config -> {'_'} -> {'password'},
122 {'RaiseError' => 1});
124 my $sth;
125 my $select_arr = [];
127 if ( not $force ) {
128 my $sth = $dbh -> prepare( "SELECT output_id FROM ".$PsN::config -> {'_'} -> {'project'}.
129 ".output ".
130 "WHERE filename = '$file_str' AND ".
131 "directory = '$dir_str' AND ".
132 "md5sum = '".$md5sum."'" );
133 $sth -> execute or debug -> die( message => $sth->errstr ) ;
135 $select_arr = $sth -> fetchall_arrayref;
138 if ( scalar @{$select_arr} > 0 ) {
139 debug -> warn( level => 1,
140 message => "Found an old entry in the database matching the ".
141 "current output file" );
142 if ( scalar @{$select_arr} > 1 ) {
143 debug -> warn( level => 1,
144 message => "Found more than one matching entry in database".
145 ", using the first" );
147 $self -> {'output_id'} = $select_arr->[0][0];
148 # Maybe we should update the table with a new model_id if such is supplied to us?
149 $self -> {'model_id'} = $select_arr->[0][1];
150 } else {
151 my ( $date_str, $time_str );
152 if ( $Config{osname} eq 'MSWin32' ) {
153 $date_str = `date /T`;
154 $time_str = ' '.`time /T`;
155 } else {
156 # Assuming UNIX
157 $date_str = `date`;
159 chomp($date_str);
160 chomp($time_str);
161 my $date_time = $date_str.$time_str;
162 my @mod_str = ('','');
163 if ( defined $model_id ) {
164 @mod_str = ('model_id, ',"$model_id, ");
166 $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
167 ".output ".
168 "( ".$mod_str[0].
169 "filename, date, directory, md5sum ) ".
170 "VALUES (".$mod_str[1].
171 "'$file_str', '$date_time', ".
172 "'$dir_str', '".$md5sum."' )");
174 $sth -> execute;
175 $self -> {'output_id'} = $sth->{'mysql_insertid'};
176 $self -> {'model_id'} = $model_id;
178 $sth -> finish;
179 $dbh -> disconnect;
180 if ( defined $self -> {'output_id'} ) {
181 foreach my $problem ( @{$self -> {'problems'}} ) {
182 $problem -> register_in_database( output_id => $self -> {'output_id'},
183 model_id => $model_id );
187 end register_in_database
189 # }}} register_in_database
191 # {{{ full_name
192 start full_name
194 $full_name = $self -> {'directory'} . $self -> {'filename'};
196 end full_name
198 # }}} full_name
200 # {{{ copy
201 start copy
203 $new_output = Storable::dclone( $self );
205 end copy
206 # }}} copy
208 # {{{ Definitions and help text for all accessors
210 start comegas
211 # Since PsN output objects are read-only, once they are
212 # initialized (probably through parsing a NONMEM output file) the
213 # methods of the output class are only used to extract
214 # information, not to set any.
216 # The general structure of the values returned by the methods
217 # reflect the level where the attributes belong (problems or sub
218 # problems) and of course also the structure of the attribute
219 # itself (scalar (ofv), array (thetas) or matrix
220 # (raw_cormatrix)). Taking ofv as example, this means that the
221 # returned variable will be a (reference to a) two-dimensional
222 # array, with the indexes problem and subproblem since ofv is a
223 # scalar on the sub problem level.
225 # Most methods take two optional arguments, I<problems> and
226 # I<subproblems>. These can be used to specify which problem or sub
227 # problem that the method should extract the required information
228 # from. problems and subproblems should be references to arrays of
229 # numbers. Some methods that return information related to model
230 # parameters also take I<parameter_numbers> as another optional
231 # argument and this can be used to specify a subset of parameters.
233 # Example:
235 # Return the standard errors for omega 1 and 3 (in all problems
236 # and sub problems)
238 # @seomega = @{$output_object -> seomegas( parameter_numbers => [1,3] )};
241 # comegas returns the standard deviation for elements on the
242 # diagonal and correlation coefficients for off-diagonal elements.
243 end comegas
245 start condition_number
246 # condition_number returns the 2-norm condition number for the correlation matrix, i.e.
247 # the largest eigen value divided by the smallest.
248 # See L</comegas> for details of the method arguments.
250 # Level: Sub problem
251 end condition_number
253 start covariance_step_run
254 # Returns 1 if the covariance step was run, 0 otherwise. See
255 # L</comegas> for details.
257 # Level: Problem
258 end covariance_step_run
260 start covariance_step_successful
261 # Returns 1 if the covariance step was successful, 0
262 # otherwise. See L</comegas> for details on the method arguments.
264 # Level: Sub problem
265 end covariance_step_successful
267 start covariance_step_warnings
268 # Returns 0 if there were no warnings or errors printed during the
269 # covariance step, 1 otherwise. See L</comegas> for details on the
270 # method arguments.
272 # Level: Sub problem
273 end covariance_step_warnings
275 start csigmas
276 # csigmas returns the standard deviation for elements on the
277 # diagonal and correlation coefficients for off-diagonal elements.
278 # See L</comegas> for details on the method arguments.
280 # Level: Sub problem
281 end csigmas
283 start cvseomegas
284 # cvseomegas returns the relative standard error for the omegas, i.e. SE/estimate.
285 # See L</comegas> for details on the method arguments.
287 # Level: Sub problem
288 end cvseomegas
290 start cvsesigmas
291 # cvsesigmas returns the relative standard error for the sigmas, i.e. SE/estimate.
292 # See L</comegas> for details on the method arguments.
294 # Level: Sub problem
295 end cvsesigmas
297 start cvsethetas
298 # cvsethetas returns the relative standard error for the thetas, i.e. SE/estimate.
299 # See L</comegas> for details on the method arguments.
301 # Level: Sub problem
302 end cvsethetas
304 start eigens
305 # eigens returns the eigen values.
306 # See L</comegas> for details of the method arguments.
308 # Level: Sub problem
309 end eigens
311 start etabar
312 # etabar returns the ETABAR estimates.
313 # See L</comegas> for details of the method arguments.
315 # Level: Sub problem
316 end etabar
318 start feval
319 # feval returns the number of function evaluations.
320 # See L</comegas> for details of the method arguments.
322 # Level: Sub problem
323 end feval
325 start finalparam
326 # finalparam returns the final parameter vector as it appears in the monitoring of search section.
327 # See L</comegas> for details of the method arguments.
329 # Level: Sub problem
330 end finalparam
332 start final_gradients
333 # final_gradients returns the final gradient vector as it appears in the monitoring of search section.
334 # See L</comegas> for details of the method arguments.
336 # Level: Sub problem
337 end final_gradients
339 start fixedomegas
340 # fixedomegas returns the a vector of booleans; 1's if
341 # the parameters were fixed during the model fit, 0's
342 # if they were not.
343 # See L</comegas> for details of the method arguments.
345 # Level: Sub problem
346 end fixedomegas
348 start fixedsigmas
349 # fixedsigmas returns the a vector of booleans; 1's if
350 # the parameters were fixed during the model fit, 0's
351 # if they were not.
352 # See L</comegas> for details of the method arguments.
354 # Level: Sub problem
355 end fixedsigmas
357 start fixedthetas
358 # fixedthetas returns the a vector of booleans; 1's if
359 # the parameters were fixed during the model fit, 0's
360 # if they were not.
361 # See L</comegas> for details of the method arguments.
363 # Level: Sub problem
364 end fixedthetas
366 start funcevalpath
367 # funcevalpath returns the number of function evaluations for each printed iteration in the monitoring of search section.
368 # See L</comegas> for details of the method arguments.
370 # Level: Sub problem
371 end funcevalpath
373 start gradient_path
374 # gradient_path returns the gradients for each printed iteration in the monitoring of search section (returns a matrix for each sub problem).
375 # See L</comegas> for details of the method arguments.
377 # Level: Sub problem
378 end gradient_path
380 start have_output
381 # Returns 1 if the output object is initialized, i.e. if the I<problems>
382 # or I<filename> attributes are set. Returns 0 otherwise.
383 end have_output
385 start initgrad
386 # initgrad returns the initial gradient vector in the monitoring of search section.
387 # See L</comegas> for details of the method arguments.
389 # Level: Sub problem
390 end initgrad
392 start initomegas
393 # initomegas returns the initial omega values.
394 # See L</comegas> for details of the method arguments.
396 # Level: Sub problem
397 end initomegas
399 start initsigmas
400 # initsigmas returns the initial sigma values.
401 # See L</comegas> for details of the method arguments.
403 # Level: Sub problem
404 end initsigmas
406 start initthetas
407 # initthetas returns the initial theta values.
408 # See L</comegas> for details of the method arguments.
410 # Level: Sub problem
411 end initthetas
413 start iternum
414 # iternum returns a vector of the iteration numbers in the monitoring of search section.
415 # See L</comegas> for details of the method arguments.
417 # Level: Sub problem
418 end iternum
420 start nind
421 # nind returns the number of individuals.
422 # See L</comegas> for details of the method arguments.
424 # Level: Problem
425 end nind
427 start nobs
428 # nobs returns the number of observations.
429 # See L</comegas> for details of the method arguments.
431 # Level: Problem
432 end nobs
434 start npofv
435 # npofv returns the non-parametric objective function value.
436 # See L</comegas> for details of the method arguments.
438 # Level: Sub problem
439 end npofv
441 start nrecs
442 # nrecs returns the number of records.
443 # See L</comegas> for details of the method arguments.
445 # Level: Problem
446 end nrecs
448 start npomegas
449 # npomegas returns the non-parametric omega estimates.
450 # See L</comegas> for details of the method arguments.
452 # Level: Sub problem
453 end npomegas
455 start npthetas
456 # npthetas returns the non-parametric theta estimates.
457 # See L</comegas> for details of the method arguments.
459 # Level: Sub problem
460 end npthetas
462 start nth
463 # nth returns the number of thetas.
464 # See L</comegas> for details of the method arguments.
466 # Level: Sub problem
467 end nth
469 start ofvpath
470 # ofvpath returns the objective [function] values in the monitoring of search section.
471 # See L</comegas> for details of the method arguments.
473 # Level: Sub problem
474 end ofvpath
476 start ofv
477 # ofv returns the objective function value(s).
478 # See L</comegas> for details of the method arguments.
480 # Level: Sub problem
481 end ofv
483 start omega_block_structure
484 # omega_block_structure returns the block structure for
485 # the omega parameters in a lower triangular matrix form
486 # as in the OMEGA HAS BLOCK FORM section in the NONMEM output file.
487 # See L</comegas> for details of the method arguments.
489 # Level: Sub problem
490 end omega_block_structure
492 start omeganameval
493 # omeganameval returns (at the sub problem level) a hash
494 # with default parameter names , i.e. OM1, OM1_2 etc as keys
495 # and parameter estimates as values.
496 # See L</comegas> for details of the method arguments.
498 # Level: Sub problem
499 end omeganameval
501 start omeganames
502 # omeganames returns the default parameter names, e.g. OM1, OM1_2, OM2, etc
503 # See L</comegas> for details of the method arguments.
505 # Level: Sub problem
506 end omeganames
508 start omegas
509 # omegas returns the omega parameter estimates.
510 # See L</comegas> for details of the method arguments.
512 # Level: Sub problem
513 end omegas
515 start parameter_path
516 # parameter_path returns the (normalized) parameter estimates for each iteration in the monitoring of search section (Matrix returned).
517 # See L</comegas> for details of the method arguments.
519 # Level: Sub problem
520 end parameter_path
522 start pval
523 # pval returns the P VAL (reflects the probability that the etas are not centered around zero).
524 # See L</comegas> for details of the method arguments.
526 # Level: Sub problem
527 end pval
529 start raw_covmatrix
530 # raw_covmatrix returns the (raw) covariance matrix including empty matrix elements marked as '.........'.
531 # See L</comegas> for details of the method arguments.
533 # Level: Sub problem
534 end raw_covmatrix
536 start raw_invcovmatrix
537 # raw_invcovmatrix returns the (raw) inverse covariance matrix including empty matrix elements marked as '.........'.
538 # See L</comegas> for details of the method arguments.
540 # Level: Sub problem
541 end raw_invcovmatrix
543 start raw_cormatrix
544 # raw_cormatrix returns the (raw) correlation matrix including empty matrix elements marked as '.........'.
545 # See L</comegas> for details of the method arguments.
547 # Level: Sub problem
548 end raw_cormatrix
550 start raw_omegas
551 # raw_omegas returns the (raw) omegas.
552 # See L</comegas> for details of the method arguments.
554 # Level: Sub problem
555 end raw_omegas
557 start raw_seomegas
558 # raw_seomegas returns the (raw) omega standard error estimates.
559 # See L</comegas> for details of the method arguments.
561 # Level: Sub problem
562 end raw_seomegas
564 start raw_sesigmas
565 # raw_sesigmas returns the (raw) sigma standard error estimates.
566 # See L</comegas> for details of the method arguments.
568 # Level: Sub problem
569 end raw_sesigmas
571 start raw_sigmas
572 # raw_sigmas returns the (raw) sigmas.
573 # See L</comegas> for details of the method arguments.
575 # Level: Sub problem
576 end raw_sigmas
578 start raw_tmatrix
579 # raw_tmatrix returns the (raw) T-matrix.
580 # See L</comegas> for details of the method arguments.
582 # Level: Sub problem
583 end raw_tmatrix
585 start seomegas
586 # seomegas returns the omega standard error estimates.
587 # See L</comegas> for details of the method arguments.
589 # Level: Sub problem
590 end seomegas
592 start sesigmas
593 # sesigmas returns the sigma standard error estimates.
594 # See L</comegas> for details of the method arguments.
596 # Level: Sub problem
597 end sesigmas
599 start sethetas
600 # sethetas returns the theta standard error estimates.
601 # See L</comegas> for details of the method arguments.
603 # Level: Sub problem
604 end sethetas
606 start significant_digits
607 # significant_digits returns the number of significant digits for the model fit.
608 # See L</comegas> for details of the method arguments.
610 # Level: Sub problem
611 end significant_digits
613 start sigma_block_structure
614 # sigma_block_structure returns the block structure for
615 # the sigma parameters in a lower triangular matrix form
616 # as in the sigma HAS BLOCK FORM section in the NONMEM output file.
617 # See L</csigmas> for details of the method arguments.
619 # Level: Sub problem
620 end sigma_block_structure
622 start sigmanameval
623 # sigmanameval returns (at the sub problem level) a hash
624 # with default parameter names , i.e. SI1, SI1_2 etc as keys
625 # and parameter estimates as values.
626 # See L</comegas> for details of the method arguments.
628 # Level: Sub problem
629 end sigmanameval
631 start sigmanames
632 # sigmanames returns the default parameter names, i.e. SI1, SI1_2, SI2 etc.
633 # See L</comegas> for details of the method arguments.
635 # Level: Sub problem
636 end sigmanames
638 start sigmas
639 # sigmas returns the sigma parameter estimates.
640 # See L</comegas> for details of the method arguments.
642 # Level: Sub problem
643 end sigmas
645 start simulationstep
646 # simulationstep returns a boolean value 1 or 0, reflecting
647 # whether a simulation was performed or not. See L</comegas> for
648 # Details of the method arguments.
650 # Level: Sub Problem
651 end simulationstep
653 start minimization_successful
654 # minimization_successful returns a boolean value 1 or 0,
655 # reflecting whether the minimization was successful or not. See
656 # L</comegas> for details of the method arguments.
658 # Level: Sub Problem
659 end minimization_successful
661 start minimization_message
662 # minimization_message returns the minimization message, i.e
663 # MINIMIZATION SUCCESSFUL...
664 # See L</comegas> for details of the method arguments.
666 # Level: Sub problem
667 end minimization_message
669 start thetanameval
670 # thetanameval returns (at the sub problem level) a hash
671 # with default parameter names , i.e. TH1, TH2 etc as keys
672 # and parameter estimates as values.
673 # See L</comegas> for details of the method arguments.
675 # Level: Sub problem
676 end thetanameval
678 start thetanames
679 # thetanames returns the default theta parameter names, TH1, TH2 etc.
680 # See L</comegas> for details of the method arguments.
682 # Level: Sub problem
683 end thetanames
685 start thetas
686 # thetas returns the theta parameter estimates.
687 # See L</comegas> for details of the method arguments.
689 # Level: Sub problem
690 end thetas
692 # }}} Definitions and help text for all accessors
694 # {{{ have_output
695 start have_output
697 # have_output returns true if the output files exits or if there
698 # is output data in memory.
699 if( -e $self -> full_name || defined @{$self -> {'problems'}}){
700 return 1;
701 } else {
702 return 0;
705 end have_output
706 # }}} have_output
708 # {{{ _read_problems
710 start _read_problems
712 # This is a private method, and should not be used outside
713 # this file.
715 @{$self -> {'lstfile'}} = OSspecific::slurp_file($self-> full_name ) ;
716 $self -> {'lstfile_pos'} = 0;
718 # Old db code. Keep for now
719 # if ( $PsN::config -> {'_'} -> {'use_database'} and
720 # $self -> {'register_in_database'} and
721 # defined $self -> {'output_id'} ) {
722 # my $md5sum = md5_hex(@{$self -> {'lstfile'}});
723 # my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
724 # ";databse=".$PsN::config -> {'_'} -> {'project'},
725 # $PsN::config -> {'_'} -> {'user'},
726 # $PsN::config -> {'_'} -> {'password'},
727 # {'RaiseError' => 1});
728 # my $sth;
729 # my $sth = $dbh -> prepare( "UPDATE ".$PsN::config -> {'_'} -> {'project'}.
730 # ".output SET md5sum='$md5sum' ".
731 # "WHERE output_id = ".$self -> {'output_id'});
732 # $sth -> execute or debug -> die( message => $sth->errstr ) ;
733 # $sth -> finish;
735 # $dbh -> disconnect;
738 my $problem_start;
739 my $success = 0;
740 while ( $_ = @{$self -> {'lstfile'}}[ $self -> {'lstfile_pos'} ++ ] ) {
741 if ( /^ PROBLEM NO\.:\s+\d+\s+$/ or $self -> {'lstfile_pos'} >
742 $#{$self -> {'lstfile'}} ) {
743 if ( defined $problem_start ) {
744 my @problem_lstfile =
745 @{$self -> {'lstfile'} } [$problem_start .. ($self ->
746 {'lstfile_pos'} - 2)];
747 $self -> add_problem ( init_data =>
748 { lstfile => \@problem_lstfile,
749 output_id => $self -> {'output_id'},
750 model_id => $self -> {'model_id'} } );
751 @problem_lstfile = undef;
752 $success = 1;
754 $problem_start = $self -> {'lstfile_pos' };
757 $self -> {'lstfile'} = undef;
758 unless( $success ){
759 if( $self -> {'abort_on_fail'} ){
760 debug -> die( message => 'The listfile "' . $self -> full_name . '" seems malformatted.' );
761 } else {
762 debug -> warn( level => 1,
763 message => 'The listfile "' . $self -> full_name . '" seems malformatted.' );
764 return 0;
766 } else {
767 $self -> {'parsed_successfully'} = 1;
769 $self -> {'parsed'} = 1;
771 end _read_problems
773 # }}} _read_problems
775 # {{{ access_any
777 start access_any
779 # You should not really use access_any but instead the
780 # specific selector for the information you want, such as
781 # L</sigmas>, L</raw_tmatrix> or similar.
784 # TODO: Add sanity checking of parameter values (more than
785 # the automatic). e.g check that parameter_numbers is a two-
786 # dimensional array.
788 if ( $self -> have_output ) {
789 unless ( defined $self -> {'problems'} and
790 scalar @{$self -> {'problems'}} > 0) {
791 $self -> _read_problems;
793 } else {
794 debug -> die( message => "Trying to access output object, that have no data on file(".
795 $self->full_name.") or in memory" );
797 unless( $#problems > 0 ){
798 debug -> warn(level => 2,
799 message => "Problems undefined, using all" );
800 @problems = (1 .. scalar @{$self -> {'problems'}});
802 my @own_problems = @{$self -> {'problems'}};
803 foreach my $i ( @problems ) {
804 if ( defined $own_problems[$i-1] ) {
805 if ( defined( $own_problems[$i-1] -> can( $attribute ) ) ) {
806 debug -> warn(level => 2,
807 message => "method $attribute defined on the problem level" );
808 my $meth_ret = $own_problems[$i-1] -> $attribute;
809 if ( ref ($meth_ret) ) {
810 my @prob_attr = @{$meth_ret};
811 if ( scalar @parameter_numbers > 0 ) {
812 my @tmp_arr = ();
813 foreach my $num ( @parameter_numbers ) {
814 if ( $num > 0 and $num <= scalar @prob_attr ) {
815 push( @tmp_arr, $prob_attr[$num-1] );
816 } else {
817 debug -> die( message => "( $attribute ): no such parameter number $num!".
818 "(".scalar @prob_attr." exists)" );
821 @prob_attr = @tmp_arr;
823 push( @return_value, \@prob_attr );
824 } else {
825 push( @return_value, $meth_ret ) if defined $meth_ret;
827 } else {
828 debug -> warn(level => 2,
829 message => "method $attribute defined on the subproblem level" );
830 my $problem_ret =
831 $own_problems[$i-1] ->
832 access_any( attribute => $attribute,
833 subproblems => \@subproblems,
834 parameter_numbers => \@parameter_numbers );
835 push( @return_value, $problem_ret ) if defined $problem_ret;
837 } else {
838 debug -> die( message => "No such problem ".($i-1) );
841 # Check the return_value to see if we have empty arrays
842 # if ( $#return_value == 0 and ref $return_value[0] and scalar @{$return_value[0]} < 1 ) {
843 # @return_value = ();
846 end access_any
848 # }}} access_any
850 # {{{ high_correlations
851 start high_correlations
853 my $correlation_matrix = $self -> correlation_matrix( problems => \@problems,
854 subproblems => \@subproblems );
855 my @thetanames = @{$self -> thetanames( problems => \@problems,
856 subproblems => \@subproblems )};
857 my @omeganames = @{$self -> omeganames( problems => \@problems,
858 subproblems => \@subproblems )};
859 my @sigmanames = @{$self -> sigmanames( problems => \@problems,
860 subproblems => \@subproblems )};
861 my @estimated_thetas = @{$self -> estimated_thetas( problems => \@problems,
862 subproblems => \@subproblems )};
863 my @estimated_omegas = @{$self -> estimated_omegas( problems => \@problems,
864 subproblems => \@subproblems )};
865 my @estimated_sigmas = @{$self -> estimated_sigmas( problems => \@problems,
866 subproblems => \@subproblems )};
868 for ( my $i = 0; $i < scalar @{$correlation_matrix}; $i++ ) {
869 my ( @prob_corr, @pf_corr );
870 my @names = ( @{$thetanames[$i]}, @{$omeganames[$i]}, @{$sigmanames[$i]} );
871 my @estimated = ( @{$estimated_thetas[$i]}, @{$estimated_omegas[$i]}, @{$estimated_sigmas[$i]} );
872 for ( my $j = 0; $j < scalar @{$correlation_matrix -> [$i]}; $j++ ) {
873 my ( @sp_corr, @spf_corr );;
874 my $idx = 0;
875 for ( my $row = 1; $row <= scalar @names; $row++ ) {
876 for ( my $col = 1; $col <= $row; $col++ ) {
877 if ( ( $estimated[$row-1] and $estimated[$col-1] ) ) {
878 if ( not ( $row == $col ) and
879 $correlation_matrix -> [$i][$j][$idx] > $limit or
880 $correlation_matrix -> [$i][$j][$idx] < -$limit ) {
881 push( @sp_corr, $names[$row-1]."-".$names[$col-1] );
882 push( @spf_corr, $correlation_matrix -> [$i][$j][$idx] );
884 $idx++;
889 # my @names = ( @{$thetanames[$i]}, @{$omeganames[$i]}, @{$sigmanames[$i]} );
890 # my ( @sp_corr, @spf_corr );;
891 # my ( $row, $col ) = ( 1, 1 );
892 # foreach my $element ( @{$correlation_matrix -> [$i][$j]} ) {
893 # if ( $col == $row ) {
894 # $row++;
895 # $col = 1;
896 # } else {
897 # if ( $element > $limit or $element < -$limit ) {
898 # push( @sp_corr, $names[$row-1]."-".$names[$col-1] );
899 # push( @spf_corr, $element );
901 # $col++;
905 push( @prob_corr, \@sp_corr );
906 push( @pf_corr, \@spf_corr );
908 push( @high_correlations, \@prob_corr );
909 push( @found_correlations, \@pf_corr );
912 end high_correlations
913 # }}} high_correlations
915 # {{{ large_standard_errors
916 start large_standard_errors
918 foreach my $param ( 'theta', 'omega', 'sigma' ) {
919 my @names = eval( '@{$self -> '.$param.'names( problems => \@problems,'.
920 'subproblems => \@subproblems )}' );
921 my @cvs = eval( '@{$self -> cvse'.$param.'s( problems => \@problems,'.
922 'subproblems => \@subproblems )}' );
923 for ( my $i = 0; $i <= $#cvs; $i++ ) {
924 if ( $param eq 'theta' ) {
925 $large_standard_errors[$i] = [];
926 $found_cv[$i] = [];
928 for ( my $j = 0; $j < scalar @{$cvs[$i]}; $j++ ) {
929 if ( $param eq 'theta' ) {
930 $large_standard_errors[$i][$j] = [];
931 $found_cv[$i][$j] = [];
933 for ( my $k = 0; $k < scalar @{$cvs[$i][$j]}; $k++ ) {
934 if ( abs($cvs[$i][$j][$k]) > eval('$'.$param.'_cv_limit') ) {
935 push( @{$large_standard_errors[$i][$j]}, $names[$i][$k] );
936 push( @{$found_cv[$i][$j]}, $cvs[$i][$j][$k] );
943 end large_standard_errors
944 # }}} large_standard_errors
946 # {{{ near_bounds
948 start near_bounds
950 sub test_sigdig {
951 my ( $number, $goal, $sigdig, $zerolim ) = @_;
952 $number = &FormatSigFigs($number, $sigdig );
953 my $test;
954 if ( $goal == 0 ) {
955 $test = abs($number) < $zerolim ? 1 : 0;
956 } else {
957 $goal = &FormatSigFigs($goal, $sigdig );
958 $test = $number eq $goal ? 1 : 0;
960 return $test;
963 my @thetanames = @{$self -> thetanames};
964 my @omeganames = @{$self -> omeganames};
965 my @sigmanames = @{$self -> sigmanames};
968 my @indexes;
969 foreach my $param ( 'theta', 'omega', 'sigma' ) {
970 my @estimates = eval( '@{$self -> '.$param.'s}' );
971 my @bounds = eval( '@{$self -> '.$param.'s}' );
972 @indexes = eval( '@{$self -> '.$param.'_indexes}' ) unless ( $param eq 'theta' );
973 for ( my $i = 0; $i <= $#estimates; $i++ ) {
974 if ( $param eq 'theta' ) {
975 $near_bounds[$i] = [];
976 $found_bounds[$i] = [];
977 $found_estimates[$i] = [];
979 for ( my $j = 0; $j < scalar @{$estimates[$i]}; $j++ ) {
980 if ( $param eq 'theta' ) {
981 $near_bounds[$i][$j] = [];
982 $found_bounds[$i][$j] = [];
983 $found_estimates[$i][$j] = [];
985 for ( my $k = 0; $k < scalar @{$estimates[$i][$j]}; $k++ ) {
986 # Unless the parameter is fixed:
987 if ( not eval( '$self -> fixed'.$param.'s->[$i][$k]' ) ) {
988 if ( $param eq 'theta' ) {
989 if ( test_sigdig( $estimates[$i][$j][$k],
990 $self -> lower_theta_bounds -> [$i][$k],
991 $significant_digits, $zero_limit ) ) {
992 push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]") );
993 push( @{$found_bounds[$i][$j]}, $self -> lower_theta_bounds -> [$i][$k] );
994 push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
996 if ( test_sigdig( $estimates[$i][$j][$k],
997 $self -> upper_theta_bounds -> [$i][$k],
998 $significant_digits, $zero_limit ) ) {
999 push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]") );
1000 push( @{$found_bounds[$i][$j]}, $self -> upper_theta_bounds -> [$i][$k] );
1001 push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
1003 } else {
1004 my ( $upper, $lower, $sigdig );
1005 if ( $indexes[$i][$k][0] == $indexes[$i][$k][1] ) { # on diagonal
1006 ( $lower, $upper, $sigdig ) = ( 0, 1000000, $significant_digits );
1007 } else {
1008 ( $lower, $upper, $sigdig ) = ( -1, 1, $off_diagonal_sign_digits );
1010 if ( test_sigdig( $estimates[$i][$j][$k], $lower, $sigdig, $zero_limit ) ) {
1011 push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]" ) );
1012 push( @{$found_bounds[$i][$j]}, $lower );
1013 push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
1015 if ( test_sigdig( $estimates[$i][$j][$k], $upper, $sigdig, $zero_limit ) ) {
1016 push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]" ) );
1017 push( @{$found_bounds[$i][$j]}, $upper );
1018 push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
1027 end near_bounds
1029 # }}} near_bounds
1031 # {{{ problem_structure
1032 start problem_structure
1034 my $flush = 0;
1035 unless( defined $self -> {'problems'} ) {
1036 # Try to read from disk
1037 $self -> _read_problems;
1038 $flush = 1;
1040 if( defined $self -> {'problems'} ) {
1041 for(my $problem = 0; $problem < @{$self -> {'problems'}}; $problem++ ){
1042 $structure[$problem] = scalar @{$self -> {'problems'} -> [$problem] -> {'subproblems'}};
1044 $self -> flush if( $flush );
1047 end problem_structure
1048 # }}}
1050 # {{{ labels
1051 start labels
1052 # labels is this far only a wrap-around for L</thetanames>,
1053 # L</omeganames> and L</sigmanames>
1054 # The functionality of these could be moved here later on.
1056 if ( not defined $parameter_type or
1057 $parameter_type eq '' ) {
1058 my @thetanames = @{$self -> thetanames};
1059 my @omeganames = @{$self -> omeganames};
1060 my @sigmanames = @{$self -> sigmanames};
1061 for ( my $i = 0; $i <= $#thetanames; $i++ ) {
1062 if( defined $thetanames[$i] ){
1063 push( @{$labels[$i]}, @{$thetanames[$i]} );
1065 if( defined $omeganames[$i] ){
1066 push( @{$labels[$i]}, @{$omeganames[$i]} );
1068 if( defined $sigmanames[$i] ){
1069 push( @{$labels[$i]}, @{$sigmanames[$i]} );
1072 } else {
1073 my $accessor = $parameter_type.'names';
1074 @labels = @{$self -> $accessor};
1077 end labels
1078 # }}} labels
1080 # {{{ flush
1081 start flush
1083 # flush is not an accessor method. As its name implies it flushes the
1084 # output objects memory by setting the I<problems> attribute to undef.
1085 # This method can be useful when many output objects are handled and
1086 # the memory is limited.
1088 # Flushes the object to save memory. There is no need to
1089 # synchronize the ouptut object before this since they are read-
1090 # only.
1093 $self -> {'problems'} = undef;
1094 $self -> {'synced'} = 0;
1096 end flush
1097 # }}} flush