Removed/changed some print statements

[PsN.git] / lib / output_subs.pm

# {{{ include

start include statements
# A Perl module for parsing NONMEM output files
    use Digest::MD5 'md5_hex';
    use OSspecific;
    use Storable;
    use Config;
    use ext::Math::SigFigs;
    use Data::Dumper;
end include statements

# }}} include statements

# {{{ description

# No method, just documentation
start description
    # The PsN output class is built to ease the (often trivial,
    # but still time consuming) task of gathering and structuring the
    # information contained in NONMEM output files. The major parts of a
    # NONMEM output file are parsed and in the L</methods> section
    # you can find a listing of the routines that are available.
end description

# }}} description

# {{{ synopsis

start synopsis
    #   use output;
    #   
    #   my $out_obj = output -> new ( filename => 'run1.lst' );
    #   
    #   my @thetas = @{$out_obj -> thetas};
    #   my @omegas = @{$out_obj -> omegas};
    #   my @ofvs   = @{$out_obj -> ofvs};
end synopsis

# }}} synopsis

# {{{ see_also

start see_also
    # =begin html
    #
    # <a HREF="data.html">data</a>, <a HREF="model.html">model</a>
    # <a HREF="tool/modelfit.html">tool::modelfit</a>,
    # <a HREF="tool.html">tool</a>
    #
    # =end html
    #
    # =begin man
    #
    # data, model, tool::modelfit, tool
    #
    # =end man
end see_also

# }}} see_also

# {{{ new

start new
      {
        # Usage:
        # 
        #   $outputObject -> new( filename => 'run1.lst' );
        #
        # The basic usage above creates a output object with the data
        # in file.out parsed into memory.
        #
        #   $outputObject -> new( filename => 'run1.lst',
        #                         target   => 'disk' );
        #
        # If I<target> is set to 'disk', the data in "run1.lst" will
        # be left on disk in an effort to preserve memory. The file
        # will be read if needed.

        if ( defined $this -> {'filename'} and $this -> {'filename'} ne '' ) {
          ( $this -> {'directory'}, $this -> {'filename'} ) =
              OSspecific::absolute_path( $this -> {'directory'},$this->{'filename'} );
          if( -e $this -> full_name ){ 
            if($this -> {'target'} eq 'mem'){
              $this -> _read_problems;
            }
          } else {
            debug -> die( message => "The NONMEM output file ".
                          $this -> full_name." does not exist" )
              unless $this -> {'ignore_missing_files'};
          }
        } else {
          debug -> die( message => "No filename specified or filename equals empty string!" );
        }
        if( defined $this -> problems() ) {
          my $mes = $this -> parsing_error_message();
          foreach my $prob ( @{$this -> problems()} ) {
            $mes .= $prob -> parsing_error_message();
            $this -> parsed_successfully($this -> parsed_successfully() *
                                         $prob -> parsed_successfully());
          }
          $this -> parsing_error_message( $mes );
        }
        if( defined $this -> parsing_error_message() and
            $this -> parsing_error_message() ne '' ) {
          print $this -> full_name,":\n",$this -> parsing_error_message();
        }
        if( defined $this -> problems() ) {
          my $mes = $this -> parsing_error_message();
          foreach my $prob ( @{$this -> problems()} ) {
            $mes .= $prob -> parsing_error_message();
            $this -> parsed_successfully($this -> parsed_successfully() *
                                         $prob -> parsed_successfully());
          }
          $this -> parsing_error_message( $mes );
        }
        if( defined $this -> parsing_error_message() and
            $this -> parsing_error_message() ne '' ) {
          print $this -> full_name,":\n",$this -> parsing_error_message();
        }
      }
end new

# }}} new

# {{{ register_in_database

start register_in_database
  if ( $PsN::config -> {'_'} -> {'use_database'} ) { 
    my $md5sum;
    if( -e $self -> full_name ){ 
      # md5sum
      $md5sum = md5_hex(OSspecific::slurp_file($self-> full_name ));
    }
    # Backslashes messes up the sql syntax
    my $file_str = $self->{'filename'};
    my $dir_str = $self->{'directory'};
    $file_str =~ s/\\/\//g;
    $dir_str =~ s/\\/\//g;

    my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
                               ";databse=".$PsN::config -> {'_'} -> {'project'},
                             $PsN::config -> {'_'} -> {'user'},
                                $PsN::config -> {'_'} -> {'password'},
                             {'RaiseError' => 1});

    my $sth;
    my $select_arr = [];
    
    if ( not $force ) {
      my $sth = $dbh -> prepare( "SELECT output_id FROM ".$PsN::config -> {'_'} -> {'project'}.
                               ".output ".
                                 "WHERE filename = '$file_str' AND ".
                                 "directory = '$dir_str' AND ".
                                 "md5sum = '".$md5sum."'" );
      $sth -> execute or debug -> die( message => $sth->errstr ) ;

      $select_arr = $sth -> fetchall_arrayref;
    }

    if ( scalar @{$select_arr} > 0 ) {
      debug -> warn( level   => 1,
                     message => "Found an old entry in the database matching the ".
                     "current output file" );
      if ( scalar @{$select_arr} > 1 ) {
        debug -> warn( level   => 1,
                       message => "Found more than one matching entry in database".
                       ", using the first" );
      }
      $self -> {'output_id'} = $select_arr->[0][0];
      # Maybe we should update the table with a new model_id if such is supplied to us?
      $self -> {'model_id'}  = $select_arr->[0][1];
    } else {
      my ( $date_str, $time_str );
      if ( $Config{osname} eq 'MSWin32' ) {
        $date_str = `date /T`;
        $time_str = ' '.`time /T`;
      } else {
        # Assuming UNIX
        $date_str = `date`;
      }
      chomp($date_str);
      chomp($time_str);
      my $date_time = $date_str.$time_str;
      my @mod_str = ('','');
      if ( defined $model_id ) {
        @mod_str = ('model_id, ',"$model_id, ");
      }
      $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
                               ".output ".
                             "( ".$mod_str[0].
                             "filename, date, directory, md5sum ) ".
                             "VALUES (".$mod_str[1].
                             "'$file_str', '$date_time', ".
                             "'$dir_str', '".$md5sum."' )");
      
      $sth -> execute;
      $self -> {'output_id'} = $sth->{'mysql_insertid'};
      $self -> {'model_id'}  = $model_id;
    }
    $sth -> finish;
    $dbh -> disconnect;
    if ( defined $self -> {'output_id'} ) {
      foreach my $problem ( @{$self -> {'problems'}} ) {
        $problem -> register_in_database( output_id => $self -> {'output_id'},
                                          model_id  => $model_id );
      }
    }
  }
end register_in_database

# }}} register_in_database

# {{{ full_name
start full_name
      {
        $full_name = $self -> {'directory'} . $self -> {'filename'};
      }
end full_name

# }}} full_name

# {{{ copy
start copy
      {
        $new_output = Storable::dclone( $self );
      }
end copy
# }}} copy

# {{{ Definitions and help text for all accessors

start comegas
    # Since PsN output objects are read-only, once they are
    # initialized (probably through parsing a NONMEM output file) the
    # methods of the output class are only used to extract
    # information, not to set any.
    #
    # The general structure of the values returned by the methods
    # reflect the level where the attributes belong (problems or sub
    # problems) and of course also the structure of the attribute
    # itself (scalar (ofv), array (thetas) or matrix
    # (raw_cormatrix)). Taking ofv as example, this means that the
    # returned variable will be a (reference to a) two-dimensional
    # array, with the indexes problem and subproblem since ofv is a
    # scalar on the sub problem level.
    #
    # Most methods take two optional arguments, I<problems> and
    # I<subproblems>. These can be used to specify which problem or sub
    # problem that the method should extract the required information
    # from. problems and subproblems should be references to arrays of
    # numbers. Some methods that return information related to model
    # parameters also take I<parameter_numbers> as another optional
    # argument and this can be used to specify a subset of parameters.
    #
    # Example:
    #
    # Return the standard errors for omega 1 and 3 (in all problems
    # and sub problems)
    #
    #   @seomega = @{$output_object -> seomegas( parameter_numbers => [1,3] )};
    #
    #
    # comegas returns the standard deviation for elements on the
    # diagonal and correlation coefficients for off-diagonal elements.
end comegas

start condition_number
    # condition_number returns the 2-norm condition number for the correlation matrix, i.e.
    # the largest eigen value divided by the smallest.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end condition_number

start covariance_step_run
    # Returns 1 if the covariance step was run, 0 otherwise. See
    # L</comegas> for details.
    #
    # Level:  Problem
end covariance_step_run

start covariance_step_successful
    # Returns 1 if the covariance step was successful, 0
    # otherwise. See L</comegas> for details on the method arguments.
    #
    # Level:  Sub problem
end covariance_step_successful

start covariance_step_warnings
    # Returns 0 if there were no warnings or errors printed during the
    # covariance step, 1 otherwise. See L</comegas> for details on the
    # method arguments.
    #
    # Level:  Sub problem
end covariance_step_warnings

start csigmas
    # csigmas returns the standard deviation for elements on the
    # diagonal and correlation coefficients for off-diagonal elements.
    # See L</comegas> for details on the method arguments.
    #
    # Level:  Sub problem
end csigmas

start cvseomegas
    # cvseomegas returns the relative standard error for the omegas, i.e. SE/estimate.
    # See L</comegas> for details on the method arguments.
    #
    # Level:  Sub problem
end cvseomegas

start cvsesigmas
    # cvsesigmas returns the relative standard error for the sigmas, i.e. SE/estimate.
    # See L</comegas> for details on the method arguments.
    #
    # Level:  Sub problem
end cvsesigmas

start cvsethetas
    # cvsethetas returns the relative standard error for the thetas, i.e. SE/estimate.
    # See L</comegas> for details on the method arguments.
    #
    # Level:  Sub problem
end cvsethetas

start eigens
    # eigens returns the eigen values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end eigens

start etabar
    # etabar returns the ETABAR estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end etabar

start feval
    # feval returns the number of function evaluations.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end feval

start finalparam
    # finalparam returns the final parameter vector as it appears in the monitoring of search section.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end finalparam

start final_gradients
    # final_gradients returns the final gradient vector as it appears in the monitoring of search section.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end final_gradients

start fixedomegas
    # fixedomegas returns the a vector of booleans; 1's if
    # the parameters were fixed during the model fit, 0's
    # if they were not.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end fixedomegas

start fixedsigmas
    # fixedsigmas returns the a vector of booleans; 1's if
    # the parameters were fixed during the model fit, 0's
    # if they were not.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end fixedsigmas

start fixedthetas
    # fixedthetas returns the a vector of booleans; 1's if
    # the parameters were fixed during the model fit, 0's
    # if they were not.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end fixedthetas

start funcevalpath
    # funcevalpath returns the number of function evaluations for each printed iteration in the monitoring of search section.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end funcevalpath

start gradient_path
    # gradient_path returns the gradients for each printed iteration in the monitoring of search section (returns a matrix for each sub problem).
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end gradient_path

start have_output
    # Returns 1 if the output object is initialized, i.e. if the I<problems>
    # or I<filename> attributes are set. Returns 0 otherwise.
end have_output

start initgrad
    # initgrad returns the initial gradient vector in the monitoring of search section.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end initgrad

start initomegas
    # initomegas returns the initial omega values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end initomegas

start initsigmas
    # initsigmas returns the initial sigma values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end initsigmas

start initthetas
    # initthetas returns the initial theta values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end initthetas

start iternum
    # iternum returns a vector of the iteration numbers in the monitoring of search section.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end iternum

start nind
    # nind returns the number of individuals.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Problem
end nind

start nobs
    # nobs returns the number of observations.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Problem
end nobs

start npofv
    # npofv returns the non-parametric objective function value.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end npofv

start nrecs
    # nrecs returns the number of records.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Problem
end nrecs

start npomegas
    # npomegas returns the non-parametric omega estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end npomegas

start npthetas
    # npthetas returns the non-parametric theta estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end npthetas

start nth
    # nth returns the number of thetas.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end nth

start ofvpath
    # ofvpath returns the objective [function] values in the monitoring of search section.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end ofvpath

start ofv
    # ofv returns the objective function value(s).
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end ofv

start omega_block_structure
    # omega_block_structure returns the block structure for
    # the omega parameters in a lower triangular matrix form
    # as in the OMEGA HAS BLOCK FORM section in the NONMEM output file.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end omega_block_structure

start omeganameval
    # omeganameval returns (at the sub problem level) a hash
    # with default parameter names , i.e. OM1, OM1_2 etc as keys
    # and parameter estimates as values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end omeganameval

start omeganames
    # omeganames returns the default parameter names, e.g. OM1, OM1_2, OM2, etc
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end omeganames

start omegas
    # omegas returns the omega parameter estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end omegas

start parameter_path
    # parameter_path returns the (normalized) parameter estimates for each iteration in the monitoring of search section (Matrix returned).
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end parameter_path

start pval
    # pval returns the P VAL (reflects the probability that the etas are not centered around zero).
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end pval

start raw_covmatrix
    # raw_covmatrix returns the (raw) covariance matrix including empty matrix elements marked as '.........'.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_covmatrix

start raw_invcovmatrix
    # raw_invcovmatrix returns the (raw) inverse covariance matrix including empty matrix elements marked as '.........'.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_invcovmatrix

start raw_cormatrix
    # raw_cormatrix returns the (raw) correlation matrix including empty matrix elements marked as '.........'.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_cormatrix

start raw_omegas
    # raw_omegas returns the (raw) omegas.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_omegas

start raw_seomegas
    # raw_seomegas returns the (raw) omega standard error estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_seomegas

start raw_sesigmas
    # raw_sesigmas returns the (raw) sigma standard error estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_sesigmas

start raw_sigmas
    # raw_sigmas returns the (raw) sigmas.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_sigmas

start raw_tmatrix
    # raw_tmatrix returns the (raw) T-matrix.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end raw_tmatrix

start seomegas
    # seomegas returns the omega standard error estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end seomegas

start sesigmas
    # sesigmas returns the sigma standard error estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end sesigmas

start sethetas
    # sethetas returns the theta standard error estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end sethetas

start significant_digits
    # significant_digits returns the number of significant digits for the model fit.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end significant_digits

start sigma_block_structure
    # sigma_block_structure returns the block structure for
    # the sigma parameters in a lower triangular matrix form
    # as in the sigma HAS BLOCK FORM section in the NONMEM output file.
    # See L</csigmas> for details of the method arguments.
    #
    # Level:  Sub problem
end sigma_block_structure

start sigmanameval
    # sigmanameval returns (at the sub problem level) a hash
    # with default parameter names , i.e. SI1, SI1_2 etc as keys
    # and parameter estimates as values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end sigmanameval

start sigmanames
    # sigmanames returns the default parameter names, i.e. SI1, SI1_2, SI2 etc.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end sigmanames

start sigmas
    # sigmas returns the sigma parameter estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end sigmas

start simulationstep
    # simulationstep returns a boolean value 1 or 0, reflecting
    # whether a simulation was performed or not.  See L</comegas> for
    # Details of the method arguments.
    #
    # Level:  Sub Problem
end simulationstep

start minimization_successful
    # minimization_successful returns a boolean value 1 or 0,
    # reflecting whether the minimization was successful or not.  See
    # L</comegas> for details of the method arguments.
    #
    # Level:  Sub Problem
end minimization_successful

start minimization_message
    # minimization_message returns the minimization message, i.e
    #   MINIMIZATION SUCCESSFUL... 
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end minimization_message

start thetanameval
    # thetanameval returns (at the sub problem level) a hash
    # with default parameter names , i.e. TH1, TH2 etc as keys
    # and parameter estimates as values.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end thetanameval

start thetanames
    # thetanames returns the default theta parameter names, TH1, TH2 etc.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end thetanames

start thetas
    # thetas returns the theta parameter estimates.
    # See L</comegas> for details of the method arguments.
    #
    # Level:  Sub problem
end thetas

# }}} Definitions and help text for all accessors

# {{{ have_output
start have_output
      {
        # have_output returns true if the output files exits or if there
        # is output data in memory.
        if( -e $self -> full_name || defined @{$self -> {'problems'}}){
          return 1;
        } else {
          return 0;
        }
      }
end have_output
# }}} have_output

# {{{ _read_problems

start _read_problems
      {
          # This is a private method, and should not be used outside
          # this file.

        @{$self -> {'lstfile'}} = OSspecific::slurp_file($self-> full_name ) ;

        $self -> {'lstfile_pos'} = 0;

# {{{ Old db code. Keep for now
#       if ( $PsN::config -> {'_'} -> {'use_database'} and
#            $self -> {'register_in_database'} and
#            defined $self -> {'output_id'} ) { 
#         my $md5sum = md5_hex(@{$self -> {'lstfile'}});
#         my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
#                              ";databse=".$PsN::config -> {'_'} -> {'project'},
#                                  $PsN::config -> {'_'} -> {'user'},
#                               $PsN::config -> {'_'} -> {'password'},
#                                  {'RaiseError' => 1});
#         my $sth;
#         my $sth = $dbh -> prepare( "UPDATE ".$PsN::config -> {'_'} -> {'project'}.
#                              ".output SET md5sum='$md5sum' ".
#                                    "WHERE output_id = ".$self -> {'output_id'});
#         $sth -> execute or debug -> die( message => $sth->errstr ) ;
#         $sth -> finish;
          
#         $dbh -> disconnect;
#       }
# }}}

        my $problem_start;
        my $success = 0;
        while ( $_ = @{$self -> {'lstfile'}}[ $self -> {'lstfile_pos'} ++ ] ) {
          if ( /^ PROBLEM NO\.:\s+\d+\s+$/ or $self -> {'lstfile_pos'} >
               $#{$self -> {'lstfile'}} ) {
            if ( defined $problem_start ) {
              my $adj = ($self -> {'lstfile_pos'} > $#{$self -> {'lstfile'}}) ? 1 : 2;
              my @problem_lstfile =
                @{$self -> {'lstfile'} } [$problem_start .. ($self ->
                                                           {'lstfile_pos'} - $adj)];
              $self -> add_problem ( init_data =>
                                     { lstfile              => \@problem_lstfile,
                                       output_id            => $self -> {'output_id'},
                                       model_id             => $self -> {'model_id'} } );
              @problem_lstfile = undef;
              $success = 1;
            }
            $problem_start = $self -> {'lstfile_pos' };
          }
        }
        $self -> {'lstfile'} = undef;
        unless( $success ){
          debug -> warn( level => 1,
                         message => 'Could not find a PROBLEM NO statement in "' .
                         $self -> full_name . '"' . "\n" );
          $self -> parsing_error( message => 'Could not find a PROBLEM NO statement in "' .
                                  $self -> full_name . '"' . "\n" );
          return 0;
        } else {
          $self -> {'parsed_successfully'} = 1;
        }
        $self -> {'parsed'} = 1;
      }
end _read_problems

# }}} _read_problems

# {{{ parsing_error
start parsing_error
    $self -> parsed_successfully( 0 );
$self -> parsing_error_message( $message );
end parsing_error
# }}} parsing_error

# {{{ access_any

start access_any
      {
        # You should not really use access_any but instead the
        # specific selector for the information you want, such as
        # L</sigmas>, L</raw_tmatrix> or similar.


        # TODO: Add sanity checking of parameter values (more than
        # the automatic). e.g check that parameter_numbers is a two-
        # dimensional array.

        if ( $self -> have_output ) {
          unless ( defined $self -> {'problems'} and
                   scalar @{$self -> {'problems'}} > 0) {
            $self -> _read_problems;
          }
        } else {
          debug -> die( message => "Trying to access output object, that have no data on file(".
                        $self->full_name.") or in memory" );
        }

        my @own_problems;
        if( defined $self -> {'problems'} ) {
          unless( $#problems > 0 ){
            debug -> warn(level => 2,
                          message => "Problems undefined, using all" );
            @problems = (1 .. scalar @{$self -> {'problems'}});
          }
          @own_problems = @{$self -> {'problems'}};
        } else {
          return \@return_value; #Return the empty array
        }

        foreach my $i ( @problems ) {
          if ( defined $own_problems[$i-1] ) {
            if ( defined( $own_problems[$i-1] -> can( $attribute ) ) ) {
              debug -> warn(level => 2,
                            message => "method $attribute defined on the problem level" );
              my $meth_ret = $own_problems[$i-1] -> $attribute;
              if ( ref ($meth_ret) ) {
                my @prob_attr = @{$meth_ret};
                if ( scalar @parameter_numbers > 0 ) {
                  my @tmp_arr = ();
                  foreach my $num ( @parameter_numbers ) {
                    if ( $num > 0 and $num <= scalar @prob_attr ) {
                      push( @tmp_arr, $prob_attr[$num-1] );
                    } else {
                      debug -> die( message => "( $attribute ): no such parameter number $num!".
                                    "(".scalar @prob_attr." exists)" );
                    }
                  }
                  @prob_attr = @tmp_arr;
                }
                push( @return_value, \@prob_attr );
              } else {
                push( @return_value, $meth_ret ) if defined $meth_ret;
              }
            } else {
              debug -> warn(level => 2,
                            message => "method $attribute defined on the subproblem level" );
              my $problem_ret =
                    $own_problems[$i-1] ->
                    access_any( attribute         => $attribute,
                                subproblems       => \@subproblems,
                                parameter_numbers => \@parameter_numbers );
              push( @return_value, $problem_ret ) if defined $problem_ret;
            }
          } else {
            debug -> die( message => "No such problem ".($i-1) );
          }
        }
        # Check the return_value to see if we have empty arrays
#       if ( $#return_value == 0  and ref $return_value[0] and scalar @{$return_value[0]} < 1 ) {
#          @return_value = ();
#       }
      }
end access_any

# }}} access_any

# {{{ high_correlations
start high_correlations
      {
        my $correlation_matrix = $self -> correlation_matrix( problems    => \@problems,
                                                              subproblems => \@subproblems );
        my @thetanames = @{$self -> thetanames( problems    => \@problems,
                                                subproblems => \@subproblems )};
        my @omeganames = @{$self -> omeganames( problems    => \@problems,
                                                subproblems => \@subproblems )};
        my @sigmanames = @{$self -> sigmanames( problems    => \@problems,
                                                subproblems => \@subproblems )};
        my @estimated_thetas = @{$self -> estimated_thetas( problems    => \@problems,
                                                          subproblems => \@subproblems )};
        my @estimated_omegas = @{$self -> estimated_omegas( problems    => \@problems,
                                                          subproblems => \@subproblems )};
        my @estimated_sigmas = @{$self -> estimated_sigmas( problems    => \@problems,
                                                          subproblems => \@subproblems )};

        for ( my $i = 0; $i < scalar @{$correlation_matrix}; $i++ ) {
          my ( @prob_corr, @pf_corr );
          my @names = ( @{$thetanames[$i]}, @{$omeganames[$i]}, @{$sigmanames[$i]} );
          my @estimated = ( @{$estimated_thetas[$i]}, @{$estimated_omegas[$i]}, @{$estimated_sigmas[$i]} );
          for ( my $j = 0; $j < scalar @{$correlation_matrix -> [$i]}; $j++ ) {
            my ( @sp_corr, @spf_corr );;
            my $idx = 0;
            for ( my $row = 1; $row <= scalar @names; $row++ ) {
              for ( my $col = 1; $col <= $row; $col++ ) {
                if ( ( $estimated[$row-1] and  $estimated[$col-1] ) ) {
                  if ( not ( $row == $col ) and
                       $correlation_matrix -> [$i][$j][$idx] > $limit or
                       $correlation_matrix -> [$i][$j][$idx] < -$limit ) {
                    push( @sp_corr, $names[$row-1]."-".$names[$col-1] );
                    push( @spf_corr, $correlation_matrix -> [$i][$j][$idx] );
                  }
                  $idx++;
                }
              }
            }

#           my @names = ( @{$thetanames[$i]}, @{$omeganames[$i]}, @{$sigmanames[$i]} );
#           my ( @sp_corr, @spf_corr );;
#           my ( $row, $col ) = ( 1, 1 );
#           foreach my $element ( @{$correlation_matrix -> [$i][$j]} ) {
#             if ( $col == $row ) {
#               $row++;
#               $col = 1;
#             } else {
#               if ( $element > $limit or $element < -$limit ) {
#                 push( @sp_corr, $names[$row-1]."-".$names[$col-1] );
#                 push( @spf_corr, $element );
#               }
#               $col++;
#             }
#           }

            push( @prob_corr, \@sp_corr );
            push( @pf_corr, \@spf_corr );
          }
          push( @high_correlations, \@prob_corr );
          push( @found_correlations, \@pf_corr );
        }
      }
end high_correlations
# }}} high_correlations

# {{{ large_standard_errors
start large_standard_errors
      {
        foreach my $param ( 'theta', 'omega', 'sigma' ) {
          my @names = eval( '@{$self -> '.$param.'names( problems    => \@problems,'.
                            'subproblems => \@subproblems )}' );
          my @cvs   = eval( '@{$self -> cvse'.$param.'s( problems    => \@problems,'.
                            'subproblems => \@subproblems )}' );
          for ( my $i = 0; $i <= $#cvs; $i++ ) {
            if ( $param eq 'theta' ) {
              $large_standard_errors[$i] = [];
              $found_cv[$i]              = [];
            }
            next unless( defined $cvs[$i] );
            for ( my $j = 0; $j < scalar @{$cvs[$i]}; $j++ ) {
              if ( $param eq 'theta' ) {
                $large_standard_errors[$i][$j] = [];
                $found_cv[$i][$j]              = [];
              }
              next unless( defined $cvs[$i][$j] );
              for ( my $k = 0; $k < scalar @{$cvs[$i][$j]}; $k++ ) {
                if ( abs($cvs[$i][$j][$k]) > eval('$'.$param.'_cv_limit') ) {
                  push( @{$large_standard_errors[$i][$j]}, $names[$i][$k] );
                  push( @{$found_cv[$i][$j]}, $cvs[$i][$j][$k] );
                }
              }
            }
          }
        }
      }
end large_standard_errors
# }}} large_standard_errors

# {{{ near_bounds

start near_bounds
      {
        sub test_sigdig {
          my ( $number, $goal, $sigdig, $zerolim ) = @_;
          $number = &FormatSigFigs($number, $sigdig );
          my $test;
          if ( $goal == 0 ) {
            $test = abs($number) < $zerolim ? 1 : 0;
          } else {
            $goal = &FormatSigFigs($goal, $sigdig );
            $test = $number eq $goal ? 1 : 0;
          }
          return $test;
        }

        my @thetanames = @{$self -> thetanames};
        my @omeganames = @{$self -> omeganames};
        my @sigmanames = @{$self -> sigmanames};


        my @indexes;
        foreach my $param ( 'theta', 'omega', 'sigma' ) {
          my $setm =  eval( '$self -> '.$param.'s' );
          next unless( defined $setm ); 
          my @estimates  = @{$setm};
          my @bounds = eval( '@{$self -> '.$param.'s}' );
          @indexes = eval( '@{$self -> '.$param.'_indexes}' ) unless ( $param eq 'theta' );
          for ( my $i = 0; $i <= $#estimates; $i++ ) {
            if ( $param eq 'theta' ) {
              $near_bounds[$i] = [];
              $found_bounds[$i] = [];
              $found_estimates[$i] = [];
            }
            next unless( defined $estimates[$i] );
            for ( my $j = 0; $j < scalar @{$estimates[$i]}; $j++ ) {
              if ( $param eq 'theta' ) {
                $near_bounds[$i][$j] = [];
                $found_bounds[$i][$j] = [];
                $found_estimates[$i][$j] = [];
              }
              next unless( defined $estimates[$i][$j] );
              for ( my $k = 0; $k < scalar @{$estimates[$i][$j]}; $k++ ) {
                # Unless the parameter is fixed:
                if ( not eval( '$self -> fixed'.$param.'s->[$i][$k]' ) ) {
                  if ( $param eq 'theta' ) {
                    if ( test_sigdig( $estimates[$i][$j][$k],
                                      $self -> lower_theta_bounds -> [$i][$k],
                                      $significant_digits, $zero_limit ) ) {
                      push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]") );
                      push( @{$found_bounds[$i][$j]}, $self -> lower_theta_bounds -> [$i][$k] );
                      push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
                    }
                    if ( test_sigdig( $estimates[$i][$j][$k],
                                      $self -> upper_theta_bounds -> [$i][$k],
                                      $significant_digits, $zero_limit ) ) {
                      push( @{$near_bounds[$i][$j]},  eval('$'.$param."names[$i][$k]") );
                      push( @{$found_bounds[$i][$j]}, $self -> upper_theta_bounds -> [$i][$k] );
                      push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
                    }
                  } else {
                    my ( $upper, $lower, $sigdig );
                    if ( $indexes[$i][$k][0] == $indexes[$i][$k][1] ) { # on diagonal
                      ( $lower, $upper, $sigdig ) = ( 0, 1000000, $significant_digits );
                    } else {
                      ( $lower, $upper, $sigdig ) = ( -1, 1, $off_diagonal_sign_digits );
                    }
                    if ( test_sigdig( $estimates[$i][$j][$k], $lower, $sigdig, $zero_limit ) ) {
                      push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]" ) );
                      push( @{$found_bounds[$i][$j]}, $lower );
                      push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
                    }
                    if ( test_sigdig( $estimates[$i][$j][$k], $upper, $sigdig, $zero_limit ) ) {
                      push( @{$near_bounds[$i][$j]}, eval('$'.$param."names[$i][$k]" ) );
                      push( @{$found_bounds[$i][$j]}, $upper );
                      push( @{$found_estimates[$i][$j]}, $estimates[$i][$j][$k] );
                    }
                  }
                }
              }
            }
          }
        }
      }
end near_bounds

# }}} near_bounds

# {{{ problem_structure
start problem_structure
    {
      my $flush = 0;
      unless( defined $self -> {'problems'} ) {
        # Try to read from disk
        $self -> _read_problems;
        $flush = 1;
      }
      if( defined $self -> {'problems'} ) {
        for(my $problem = 0; $problem < @{$self -> {'problems'}}; $problem++ ){
          if( defined $self -> {'problems'} -> [$problem] -> {'subproblems'} ) {
            $structure[$problem] = scalar @{$self -> {'problems'} -> [$problem] -> {'subproblems'}};
          } else {
            # This is a case when the subproblem(s) could not be read.
            $structure[$problem] = 0;
          }
        }
        $self -> flush if( $flush );
      }
    }
end problem_structure
# }}}

# {{{ labels
start labels
    # labels is this far only a wrap-around for L</thetanames>,
    # L</omeganames> and L</sigmanames>
    # The functionality of these could be moved here later on.
     {
       if ( not defined $parameter_type or
            $parameter_type eq '' ) {
         my @thetanames = @{$self -> thetanames};
         my @omeganames = @{$self -> omeganames};
         my @sigmanames = @{$self -> sigmanames};
         for ( my $i = 0; $i <= $#thetanames; $i++ ) {
           if( defined $thetanames[$i] ){
             push( @{$labels[$i]}, @{$thetanames[$i]} );
           }
           if( defined $omeganames[$i] ){
             push( @{$labels[$i]}, @{$omeganames[$i]} );
           }
           if( defined $sigmanames[$i] ){
             push( @{$labels[$i]}, @{$sigmanames[$i]} );
           }
         }
       } else {
         my $accessor = $parameter_type.'names';
         @labels = @{$self -> $accessor};
       }
     }
end labels
# }}} labels

# {{{ flush
start flush

    # flush is not an accessor method. As its name implies it flushes the
    # output objects memory by setting the I<problems> attribute to undef.
    # This method can be useful when many output objects are handled and
    # the memory is limited.

    # Flushes the object to save memory. There is no need to
    # synchronize the ouptut object before this since they are read-
    # only.

      {
        $self -> {'problems'} = undef;
      }
end flush
# }}} flush