This is a massive update that merges all changes from PsN_2_2_0_patches_serial. It...

[PsN.git] / lib / model_subs.pm

# TODO: All: 2004-09-06 Fix absolute paths for data and output files. (under both
# windows and unix)

# {{{ Include

start include statements
use Digest::MD5 'md5_hex';
use Cwd;
use File::Copy 'cp';
use Config;
use OSspecific;
use Storable;
use Data::Dumper;
use POSIX qw(ceil floor);
use model::shrinkage_module;
end include statements

# }}} include statements

# {{{ description, synopsis and see_also

# No method, just documentation
start description

=head1 Description

PsN::model is a Perl module for parsing and manipulating NONMEM model
files.

The model class is built around the NONMEM model file. This is an
ordinary ASCII text file that, except for the data, holds all
information needed for fitting a non-linear mixed effect model using
NONMEM. Typically, a model file contains specifications for a
pharmacokinetic and/or a pharmacodynamic model, initial estimates of
model parameters, boundaries for model parameters as well as details
about the data location and format.

=cut

end description

start synopsis

=head1 Synopsis

C<< use model; >>

C<< my $model_object = model -> new ( filename => 'pheno.mod' ); >>

=begin html

<pre>

=end html

$model_object -> initial_values ( parameter_type    => 'theta',
                                  parameter_numbers => [[1,3]],
                                  new_values        => [[1.2,34]] );

=begin html

</pre>

=end html

=cut

end synopsis

start see_also

=head1 See also

=begin html

<a HREF="data.html">data</a>, <a HREF="output.html">output</a>

=end html

=begin man

data, output

=end man

=cut

end see_also

=head1 Methods

=cut

# }}}

# {{{ new

=head2 new

Usage:

=for html <pre>

    $model = model -> new( filename => 'run1.mod' )

=for html </pre>

This is the simplest and most common way to create a model
object and it requires a file on disk.

=for html <pre>

    $model = model -> new( filename => 'run1.mod',
                           target   => 'mem' )

=for html </pre>

If the target parameter is set to anything other than I<mem>
the output object (with file name given by the model
attribute I<outputfile>) and the data objects (identified by
the data file names in the $DATA NONMEM model file section)
will be initialized but will contain no information from
their files. If information from them are requiered later
on, they are read and parsed and the appropriate attributes
of the data and output objects are set.

=cut

start new
    {

        if ( defined $parm{'problems'} ) {
            $this -> {'problems'} = $parm{'problems'};
        } else {
            ($this -> {'directory'}, $this -> {'filename'}) =
                OSspecific::absolute_path( $this -> {'directory'}, $this -> {'filename'} );
            $this -> _read_problems;
            $this -> {'synced'} = 1;
        }

        if ( defined $parm{'active_problems'} ) {
            $this -> {'active_problems'} = $parm{'active_problems'};
        } elsif ( defined $this -> {'problems'} ) {
            my @active = ();
            for ( @{$this -> {'problems'}} ) {
                push( @active, 1 );
            }
            $this -> {'active_problems'} = \@active;
        }

        if ( defined $this -> {'extra_data_files'} ){
          for( my $i; $i < scalar @{$this -> {'extra_data_files'}}; $i++ ){
            my ( $dir, $file ) = OSspecific::absolute_path( $this -> {'directory'}, $this -> {'extra_data_files'} -> [$i]);
            $this -> {'extra_data_files'} -> [$i] = $dir . $file;
          }
        }
        
        my $subroutine_files = $this -> subroutine_files;
        if( defined $subroutine_files and scalar @{$subroutine_files} > 0 ){
          push( @{$this -> {'extra_files'}}, @{$subroutine_files} );
        }

        if ( defined $this -> {'extra_files'} ){
          for( my $i; $i < scalar @{$this -> {'extra_files'}}; $i++ ){
            my ( $dir, $file ) = OSspecific::absolute_path( $this -> {'directory'}, $this -> {'extra_files'} -> [$i]);
            $this -> {'extra_files'} -> [$i] = $dir . $file;
          }
        }
        
        # Read datafiles, if any.
        unless( defined $this -> {'datas'} and not $this -> {'quick_reload'} ){
            my @idcolumns = @{$this -> idcolumns};
            my @datafiles = @{$this -> datafiles('absolute_path' => 1)};
#           my @datafiles = @{$this -> datafiles('absolute_path' => 0)};
            for ( my $i = 0; $i <= $#datafiles; $i++ ) {
              my $datafile = $datafiles[$i];
              my $idcolumn = $idcolumns[$i];
              my ( $cont_column, $wrap_column ) = $this -> {'problems'} -> [$i] -> cont_wrap_columns;
              my $ignoresign = defined $this -> ignoresigns ? $this -> ignoresigns -> [$i] : undef;
              my @model_header = @{$this -> {'problems'} -> [$i] -> header};
              if ( defined $idcolumn ) {
                push ( @{$this -> {'datas'}}, data ->
                       new( idcolumn             => $idcolumn,
                            filename             => $datafile,
                            cont_column          => $cont_column,
                            wrap_column          => $wrap_column,
                            #model_header         => \@model_header,
                            ignoresign           => $ignoresign,
                            directory            => $this -> {'directory'},
                            ignore_missing_files => $this -> {'ignore_missing_files'} ||
                            $this -> {'ignore_missing_data'},
                            target               => $this -> {'target'}) );
              } else {
                'debug' -> die( message => "New model to be created from ".$this -> full_name().
                                ". Data file is ".$datafile.
                                ". No id column definition found in the model file." );
              }
            }
        }

        # Read outputfile, if any.
        if( ! defined $this -> {'outputs'} ) {
          unless( defined $this -> {'outputfile'} ){
            if( $this -> filename() =~ /\.mod$/ ) {
              ($this -> {'outputfile'} = $this -> {'filename'}) =~ s/\.mod$/.lst/;
            } else {
              $this -> outputfile( $this -> filename().'.lst' );
            }
          }
          push ( @{$this -> {'outputs'}}, output ->
                 new( filename             => $this -> {'outputfile'},
                      directory            => $this -> {'directory'},
                      ignore_missing_files =>
                      $this -> {'ignore_missing_files'} || $this -> {'ignore_missing_output_files'},
                      target               => $this -> {'target'},
                      model_id             => $this -> {'model_id'} ) );
        }

        # Adding mirror_plots module here, since it can add
        # $PROBLEMS. Also it needs to know wheter an lst file exists
        # or not.

        if( $this -> {'mirror_plots'} > 0 ){
          my $mirror_plot_module = model::mirror_plot_module -> new( base_model => $this, 
                                                                     nr_of_mirrors => $this -> {'mirror_plots'},
                                                                     cwres => $this -> {'cwres'},
                                                                     mirror_from_lst => $this -> {'mirror_from_lst'});
          push( @{$this -> {'mirror_plot_modules'}}, $mirror_plot_module );
        }

        if( $this -> {'iofv'} > 0 ){
          my $iofv_module = model::iofv_module -> new( base_model => $this,
                                                       nm_version => $this -> {'nm_version'});
          push( @{$this -> {'iofv_modules'}}, $iofv_module );
        }

      }
end new

# }}} new

# {{{ register_in_database

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

      # md5sum
      my $md5sum = md5_hex(OSspecific::slurp_file($self-> full_name ));

      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 model_id FROM ".$PsN::config -> {'_'} -> {'project'}.
                                   ".model ".
                                   "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 model file" );
        if ( scalar @{$select_arr} > 1 ) {
          'debug' -> warn( level   => 1,
                         message => "Found more than one matching entry in database".
                         ", using the first" );
        }
        $self -> {'model_id'} = $select_arr->[0][0];
      } 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;
        $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
                               ".model (filename,date,directory,md5sum) ".
                               "VALUES ('$file_str', '$date_time', '$dir_str','".
                               $md5sum."' )");
        $sth -> execute;
        $self -> {'model_id'} = $sth->{'mysql_insertid'};
      }
      $sth -> finish if ( defined $sth );
      $dbh -> disconnect;
    }
    $model_id = $self -> {'model_id'} # return the model_id;
  }
end register_in_database

# }}} register_in_database

# {{{ shrinkage_stats

start shrinkage_stats

if ( $#problem_numbers > 0 and ref $enabled eq 'ARRAY' ){
  if ( $#problem_numbers != ( scalar @{$enabled} - 1 ) ) {
    'debug' -> die( message => "The number of problem_numbers ".($#problem_numbers+1).
                    "and enabled/disabled shrinkage_stats ".scalar @{$enabled}.
                    " do not match" );
  }
}
unless( $#problem_numbers > 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}
my @en_arr;
if( ref \$enabled eq 'SCALAR' ) {
  for ( @problem_numbers ) {
    push( @en_arr, $enabled );
  }
} elsif ( not ref $enabled eq 'ARRAY' ) {
  debug -> die( message => 'enabled must be a scalar or a reference to an array, '.
                'not a reference to a '.ref($enabled).'.' );
}

my @problems = @{$self -> {'problems'}};
my $j = 0;
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    if ( defined $en_arr[ $j ] ) {
      if( $en_arr[ $j ] ) {
        $problems[ $i-1 ] -> shrinkage_module -> enable;
      } else {
        $problems[ $i-1 ] -> shrinkage_module -> disable;
      }
#       my $eta_file = $self -> filename.'_'.$i.'.etas';
#       my $eps_file = $self -> filename.'_'.$i.'.wres';
#       $problems[ $i-1 ] -> {'eta_shrinkage_table'} = $eta_file;
#       $problems[ $i-1 ] -> {'wres_shrinkage_table'} = $eps_file;
    } else {
      push( @indicators, $problems[ $i-1 ] -> shrinkage_module -> status );
    }
  } else {
    'debug' -> die( message => "Problem number $i does not exist!" );
  }
  $j++;
}       

end shrinkage_stats

# }}} shrinkage_stats

# {{{ wres_shrinkage

=head2 wres_shrinkage

Usage:

=for html <pre>

my $wres_shrink = $model_object -> wres_shrinkage();

=for html </pre>

Description:

Calculates wres shrinkage, a table file with wres is necessary. The
return value is reference of and array with one an array per problem
in it.

=cut

start wres_shrinkage

my @problems = @{$self -> {'problems'}};
foreach my $problem ( @problems ) {
  push( @wres_shrinkage, $problem -> wres_shrinkage );
}

end wres_shrinkage

# }}} wres_shrinkage

# {{{ eta_shrinkage

=head2 eta_shrinkage

Usage:

=for html <pre>

my $eta_shrink = $model_object -> eta_shrinkage();

=for html </pre>

Description:

Calculates eta shrinkage, a table file with eta is necessary. The
return value is reference of and array with one an array per problem
in it.

=cut

start eta_shrinkage

my @problems = @{$self -> {'problems'}};
foreach my $problem ( @problems ) {
  push( @eta_shrinkage, $problem -> eta_shrinkage );
}

end eta_shrinkage

# }}} eta_shrinkage

# {{{ nonparametric_code

start nonparametric_code

if ( $#problem_numbers > 0 and $#enabled > 0 ){
  if ( $#problem_numbers != $#enabled ) {
    'debug' -> die( message => "The number of problem_numbers ".($#problem_numbers+1).
                    "and enabled/disabled nonparametric_code ".($#enabled+1).
                    "do not match" );
  }
}
unless( $#problem_numbers > 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}
my @problems = @{$self -> {'problems'}};
my $j = 0;
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    if ( defined $enabled[ $j ] ) {
      $problems[ $i-1 ] -> nonparametric_code( $enabled[ $j ] );
    } else {
      push( @indicators, $problems[ $i-1 ] -> nonparametric_code );
    }
  } else {
    'debug' -> die( message => "Problem number $i does not exist!" );
  }
  $j++;
}       

end nonparametric_code

# }}} nonparametric_code

# {{{ add_nonparametric_code

start add_nonparametric_code

$self -> set_records( type           => 'nonparametric',
                       record_strings => [ 'MARGINALS UNCONDITIONAL' ] );
$self -> set_option( record_name => 'estimation',
                      option_name => 'POSTHOC' );
my ( $msfo_ref, $junk ) = $self ->
    _get_option_val_pos( name            => 'MSFO',
                         record_name     => 'estimation' );
my @nomegas = @{$self -> nomegas};

for( my $i = 0; $i <= $#nomegas; $i++ ) { # loop the problems
  my $marg_str = 'ID';
  for( my $j = 0; $j <= $nomegas[$i]; $j++ ) {
    $marg_str = $marg_str.' COM('.($j+1).')=MG'.($j+1);
  }
  $marg_str = $marg_str.' FILE='.$self->filename.'.marginals'.
      ' NOAPPEND ONEHEADER NOPRINT';
  $self -> add_records( problem_numbers => [($i+1)],
                         type            => 'table',
                         record_strings  => [ $marg_str ] );
  $self -> remove_option( record_name => 'abbreviated',
                           option_name => 'COMRES' );
  $self -> add_option( record_name  => 'abbreviated',
                       option_name  => 'COMRES',
                       option_value => ($nomegas[$i]+1),
                       add_record   => 1 );  #Add $ABB if not existing

  $self -> add_marginals_code( problem_numbers => [($i+1)],
                               nomegas         => [ $nomegas[$i] ] );
}

if( not defined $msfo_ref ) {
  for( my $i = 0; $i < $self -> nproblems; $i++ ) {
    $self -> add_option( record_name =>  'estimation',
                          option_name =>  'MSFO',
                          option_value => $self -> filename.'.msfo'.($i+1) );
  }
} else {
  for( my $i = 0; $i < scalar @{$msfo_ref}; $i++ ) {
    if( not defined $msfo_ref->[$i] or not defined $msfo_ref->[$i][0] ) {
      $self -> add_option( record_name =>  'estimation',
                            option_name =>  'MSFO',
                            option_value => $self -> filename.'.msfo'.($i+1) );
    }
  }
}

end add_nonparametric_code

# }}} add_nonparametric_code

# {{{ flush_data

=head2 flush_data

Usage:

=for html <pre>

$model_object -> flush_data();

=for html </pre>

Description:

flush data calls the same method on each data object (usually one)
which causes it to write data to disk and remove its data from memory.

=cut

start flush_data
      {
        if ( defined $self -> {'datas'} ) {
          foreach my $data ( @{$self -> {'datas'}} ) {
            $data -> flush;
          }
        }
      }
end flush_data

# }}} flush_data

# {{{ full_name

=head2 full_name

Usage:

C<< my $file_name = $model_object -> full_name(); >>

Description:

full_name will return the name of the modelfile and its directory in a
string. For example: "/users/guest/project/model.mod".

=cut

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

# }}}

# {{{ sync_output

This function is unused and should probably be removed.

# start __sync_output
      {
        unless( defined $self -> {'outputfile'} ){
          'debug' -> die( message => "No output file is set, cannot synchronize output" );
        }
        @{$self -> {'outputs'}} = ();
        push ( @{$self -> {'outputs'}}, output ->
                 new( filename             => $self -> {'outputfile'},
                      ignore_missing_files => $self -> {'ignore_missing_files'},
                      target               => $self -> {'target'},
                      model_id             => $self -> {'model_id'} ) );
      }
# end __sync_output

# }}} sync_output

# {{{ add_marginals_code

start add_marginals_code

# add_marginals_code takes two arguments.
#
# - problem_numbers is an array holding the numbers of the problems in
# which code should be added.
#
# - nomegas which is an array holding the number of (diagonal-element)
# omegas of each problem given by problem_numbers.
#
# For each omega in each problem, verbatim code is added to make the
# marginals available for printing (e.g. to a table file). COM(1) will
# hold the nonparametric density, COM(2) the marginal cumulative value
# for the first eta, COM(2) the marginal cumulative density for the
# second eta and so on.

unless( $#problem_numbers >= 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}

my @problems = @{$self -> {'problems'}};
my $j = 0;
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    $problems[$i-1] -> add_marginals_code( nomegas => $nomegas[ $j ]  );
  } else {
    'debug' -> die( message => "Problem number $i does not exist.");
  } 
  $j++;
}

end add_marginals_code

# }}} add_marginals_code

# {{{ add_records

=head2 add_records

Usage:

=for html <pre>

$model_object -> add_records( type => 'THETA',
                              record_strings => ['(0.1,15,23)'] );

=for html </pre>

Arguments:

=over 3

=item type

string

=item record_strings

array of strings

=item problem_numbers

array of integers

=back

Description:

add_records is used to add NONMEM control file records to the model
object. The "type" argument is mandatory and must be a valid NONMEM
record name, such as "PRED" or "THETA". Otherwise an error will be
output and the program terminated (this is object to change, ideally
we would only report an error and let the caller deal with it). The
"record_strings" argument is a mandatory array of valid NONMEM record
code. Each array corresponds to a line of the record code. There
"problem_numbers" argument is optional and is an array of problems
numbered from 1 for which the record is added, by default the record
is added to all problems.

Notice that the records are appended to those that allready exists,
which makes sence for records that do not exist and for initial
values. For records like "DATA" or "PRED" you probably want to use
"set_records".

=cut

start add_records
      {
        unless( $#problem_numbers >= 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }

        my @problems = @{$self -> {'problems'}};
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
#       if( defined $self -> {'problems'} ){
#           if( defined @{$self -> {'problems'}}[$problem_number - 1] ){
#               my $problem = @{$self -> {'problems'}}[$problem_number - 1];
#               $problem -> add_records( 'type' => $type,
#                                        'record_strings' => \@record_strings );
            $problems[$i-1] -> add_records( 'type' => $type,
                                            'record_strings' => \@record_strings );
          } else {
            'debug' -> die( message => "Problem number $i does not exist.");
          } 
        }
# else {
#           'debug' -> die( message => "Model -> add_records: No Problems in model object.") ;
#       }
      }
end add_records

# }}} add_records

# {{{ set_records

=head2 set_records

Usage:

=for html <pre>

$model_object -> set_records( type => 'THETA',
                              record_strings => ['(0.1,15,23)'] );

=for html </pre>

Arguments:

=over 3

=item type

string

=item record_strings

array of strings

=item problem_numbers

array of integers

=back

Description:

set_records works just like add_records but will replace any existing
records in the model object.

=cut

start set_records
      {
        unless( $#problem_numbers >= 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }

        my @problems = @{$self -> {'problems'}};
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
#       if( defined $self -> {'problems'} ){
#           if( defined @{$self -> {'problems'}}[$problem_number - 1] ){
#               my $problem = @{$self -> {'problems'}}[$problem_number - 1];
#               $problem -> set_records( 'type' => $type,
#                                        'record_strings' => \@record_strings );
            $problems[$i-1] -> set_records( 'type' => $type,
                                            'record_strings' => \@record_strings );
          } else {
            'debug' -> die( message => "Problem number $i does not exist." );
          } 
        }
# else {
#         'debug' -> die( "No Problems in model object.") ;
#       }
      }
end set_records

# }}} set_records

# {{{ remove_records

=head2 remove_records

Usage:

=for html <pre>

$model_object -> remove_records( type => 'THETA' )

=for html </pre>

Arguments:

=over 3

=item type

string

=item problem_numbers

array of integers

=back

Description:

remove_records removes the record given in the "type" argument which
must be a valid NONMEM record name.

=cut

start remove_records
      {
        unless( $#problem_numbers >= 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }

        my @problems = @{$self -> {'problems'}};
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
#       if( defined $self -> {'problems'} ){
#           if( defined @{$self -> {'problems'}}[$problem_number - 1] ){
#               my $problem = @{$self -> {'problems'}}[$problem_number - 1];
#               $problem -> remove_records( 'type' => $type );
            $problems[$i-1] -> remove_records( 'type' => $type );
          } else {
            'debug' -> die( message => "Problem number $i, does not exist" );
          } 
        }
# else {
#         'debug' -> die( message => "No Problems in model object." );
#       }
      }
end remove_records

# }}} remove_records

# {{{ copy

=head2 copy

Usage:

=for html <pre>

$model_object -> copy( filename => 'copy.mod',
                       copy_data => 1,
                       copy_output => 0 )

=for html </pre>

Arguments:

=over 3

=item filename

string

=item copy_data

boolean

=item copy_output

boolean

=item directory

string

=item data_file_names

array of strings

=item target

string with value 'disk' or 'mem'

=item extra_data_file_names

array of strings

=item update_shrinkage_tables

boolean

=back

Description:

copy produces a new modelfile object and a new file on disk whose name
is given by the "filename" argument. To create copies of data file the
copy_data options may be set to 1.  The values of "data_file_names",
unless given, will be the model file name but with '.mod' exchanged
for '_$i.dta', where $i is the problem number.  If data is not copied,
a new data object will be intialized from the same data file as the
previous model and "data_file_names" WILL BE IGNORED. This has the
side effect that the data file can be modified from both the original
model and the copy. The same holds for "extra_data_files". It is
possible to set "copy_output" to 1 as well, which then copies the
output object instead of reading the output file from disk, which is
slower. Since output objects are meant to be read-only, no
output_filename can be specified and the output object copy will
reside in memory only.

The "target" option has no effect.

=cut

start copy
      {
        # PP_TODO fix a nice copying of modelfile data
        # preferably in memory copy. Perhaps flush data ?

        # Check sanity of the length of data file names argument
        if ( scalar @data_file_names > 0 ) {
          'debug' -> die( message => "model -> copy: The number of specified new data file " .
                          "names ". scalar @data_file_names. "must\n match the number".
                          " of data objects connected to the model object".
                          scalar @{$self -> {'datas'}} ) 
              unless ( scalar @data_file_names == scalar @{$self -> {'datas'}} );
        } else {
          my $d_filename;
          ($d_filename = $filename) =~ s/\.mod$//;
          for ( my $i = 1; $i <= scalar @{$self -> {'datas'}}; $i++ ) {
            # Data filename is created in this directory (no directory needed).
            push( @data_file_names, $d_filename."_data_".$i."_copy.dta" );
          }
        }

        # Check sanity of the length of extra_data file names argument
        if ( scalar @extra_data_file_names > 0 ) {
          'debug' -> die( message => "The number of specified new extra_data file ".
                          "names ". scalar @extra_data_file_names, "must\n match the number".
                          " of problems (one extra_data file per prolem)".
                          scalar @{$self -> {'extra_data_files'}} ) 
              unless( scalar @extra_data_file_names == scalar @{$self -> {'extra_data_files'}} );
        } else {
          if ( defined $self -> {'extra_data_files'} ) {
            my $d_filename;
            ($d_filename = $filename) =~ s/\.mod$//;
            for ( my $i = 1; $i <= scalar @{$self -> {'extra_data_files'}}; $i++ ) {
              # Extra_Data filename is created in this directory (no directory needed).
              push( @extra_data_file_names, $d_filename."_extra_data_".$i."_copy.dta" );
            }
          }
        }

        ($directory, $filename) = OSspecific::absolute_path( $directory, $filename );

        # New copy:

        # save references to own data and output objects
        my $datas   = $self -> {'datas'};
#       $Data::Dumper::Maxdepth = 2;
#       die "MC1: ", Dumper $datas -> [0] -> {'individuals'};
        my $outputs = $self -> {'outputs'};
        my %extra_datas;
        my @problems = @{$self -> {'problems'}};
        for ( my $i = 0; $i <= $#problems; $i++ ) {
          if ( defined $problems[$i] -> {'extra_data'} ) {
            $extra_datas{$i} = $problems[$i] -> {'extra_data'};
          }
        }

        my ( @new_datas, @new_extra_datas, @new_outputs );

        $self -> synchronize if not $self -> {'synced'};
        
        # remove ref to data and output object to speed up the
        # cloning
        $self -> {'datas'}   = undef;
        $self -> {'outputs'} = undef;
        for ( my $i = 0; $i <= $#problems; $i++ ) {
          $problems[$i] -> {'extra_data'} = undef;
        }

        # Copy the data objects if so is requested
        if ( defined $datas ) {
          my $i = 0;
          foreach my $data ( @{$datas} ) {
            if ( $copy_data == 1 ) {
              push( @new_datas, $data ->
                    copy( filename => $data_file_names[$i]) );
            } else {
              # This line assumes one data per problem! May be a source of error.
              my ( $cont_column, $wrap_column ) = $self -> problems -> [$i] -> cont_wrap_columns;
              my $ignoresign = defined $self -> ignoresigns ? $self -> ignoresigns -> [$i] : undef;
              my @model_header = @{$self -> problems -> [$i] -> header};
              push @new_datas, data ->
                new( filename             => $data -> filename,
                     directory            => $data -> directory,
                     cont_column          => $cont_column,
                     wrap_column          => $wrap_column,
                     #model_header        => \@model_header,
                     target               => 'disk',
                     ignoresign           => $ignoresign,
                     idcolumn             => $data -> idcolumn );
            }
            $i++;
          }
        }

        # Copy the extra_data objects if so is requested
        for ( my $i = 0; $i <= $#problems; $i++ ) {
          my $extra_data = $extra_datas{$i};
          if ( defined $extra_data ) {
            if ( $copy_data == 1 ) {
              push( @new_extra_datas, $extra_data ->
                    copy( filename => $extra_data_file_names[$i]) );
            } else {
              push( @new_extra_datas, extra_data ->
                    new( filename             => $extra_data -> filename,
                         directory            => $extra_data -> directory,
                         target               => 'disk',
                         idcolumn             => $extra_data -> idcolumn ) );
            }
          }
        }


        # Clone self into new model object and set synced to 0 for
        # the copy
        $new_model = Storable::dclone( $self );
        $new_model -> {'synced'} = 0;

#       $Data::Dumper::Maxdepth = 3;
#       die Dumper $new_datas[0] -> {'individuals'};

        # Restore the data and output objects for self
        $self -> {'datas'} = $datas;
        $self -> {'outputs'} = $outputs;
        for ( my $i = 0; $i <= $#problems; $i++ ) {
          if( defined $extra_datas{$i} ){
            $problems[$i] -> {'extra_data'} = $extra_datas{$i};
          }
        }

        # Set the new file name for the copy
        $new_model -> directory( $directory );
        $new_model -> filename( $filename );
        
        # {{{ update the shrinkage modules

        my @problems = @{$new_model -> problems};
        for( my $i = 1; $i <= scalar @problems; $i++ ) {
          $problems[ $i-1 ] -> shrinkage_module -> model( $new_model );
        }

        # }}} update the shrinkage modules

        # Copy the output object if so is requested (only one output
        # object defined per model object)
        if ( defined $outputs ) {
          foreach my $output ( @{$outputs} ) {
            if ( $copy_output == 1 ) {
              push( @new_outputs, $output -> copy );
            } else {
              my $new_out = $filename;
              if( $new_out =~ /\.mod$/ ) {
                $new_out =~ s/\.mod$/\.lst/;
              } else {
                $new_out = $new_out.'.lst';
              }
              push( @new_outputs, output ->
                    new ( filename => $new_out,
                          directory => $directory,
                          target   => 'disk',
                          ignore_missing_files => 1,
                          model_id => $new_model -> {'model_id'} ) );
            }
          }
        }

        # Add the copied data and output objects to the model copy
        $new_model -> datas( \@new_datas );

        if ( $#new_extra_datas >= 0 ) {
          my @new_problems = @{$new_model -> problems};
          for ( my $i = 0; $i <= $#new_problems; $i++ ) {
            $new_problems[$i] -> {'extra_data'} = $new_extra_datas[$i];
            if ( $copy_data == 1 ){
              $new_problems[$i] -> {'extra_data_file_name'} = $extra_data_file_names[$i];
            }
          }
        }

        $new_model -> {'outputs'} = \@new_outputs;

        $new_model -> _write;

        $new_model -> synchronize if $target eq 'disk';
      }
end copy

# }}} copy

# {{{ covariance

=head2 covariance

Usage:

=for html <pre>

my $indicators = $model_object -> covariance( enabled => [1] );

=for html </pre>

Arguments:

=over 3

=item enabled

array of booleans

=item problem_numbers

array of integers

=back

Description:

covariance will let you turn the covariance step on and off per
problem. The "enabled" argument is an array which must have a length
equal to the number of problems. Each element set to 0 will disable
the covariance step for the corresponding problem. And conversely each
element set to nonzero will enable the covariance step.

covariance will return an array with an element for each problem, the
element will indicate whether the covariance step is turned on or not.

=cut

start covariance
      {
        if ( $#problem_numbers > 0 ){
          if ( $#problem_numbers != $#enabled ) {
            'debug' -> die( message => "The number of problem_numbers ".($#problem_numbers+1).
                          "and enabled/disabled covariance records ".($#enabled+1).
                          "do not match" );
          }
        }
        unless( $#problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        my @problems = @{$self -> {'problems'}};
        my $j = 0;
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
            if ( defined $enabled[ $j ] ) {
              $problems[ $i-1 ] -> covariance( enabled => $enabled[ $j ] );
            } else {
              push( @indicators, $problems[ $i-1 ] -> covariance );
            }
          } else {
            'debug' -> die( message => "Problem number $i does not exist!" );
          }
          $j++;
        }       
      }
end covariance

# }}} covariance

# {{{ datas

=head2 datas

Usage:

=for html <pre>

$model_object -> datas( [$data_obj] );

my $data_objects = $model_object -> data;

=for html </pre>

Arguments:

The argument is an unnamed array of data objects.

Description:

If data is used without argument the data objects connected to the
model object is returned. If an argument is given it must be an array
of length equal to the number of problems with data objects. Those
objects will replace any existing data objects and their filenames
will be put in the model files records.

=cut

start datas
      {
        my $nprobs = scalar @{$self -> {'problems'}};
        if ( defined $parm ) {
          if ( ref($parm) eq 'ARRAY' ) {
            my @new_datas = @{$parm};
            # Check that new_headers and problems match
            'debug' -> die( message => "The number of problems $nprobs and".
                            " new data ". ($#new_datas+1) ." don't match in ".
                            $self -> full_name ) unless ( $#new_datas + 1 == $nprobs );
            if ( defined $self -> {'problems'} ) {
              for( my $i = 0; $i < $nprobs; $i++ ) {
                $self -> _option_name( position   => 0,
                                       record     => 'data',
                                       problem_number => $i+1,
                                       new_name   => $new_datas[$i] -> filename);
              }
            } else {
              'debug' -> die( message => "No problems defined in ".
                              $self -> full_name );
            }
          } else {
            'debug' -> die( message => "Supplied new value is not an array" );
          }
        }
      }
end datas

# }}}

# {{{ datafile

# TODO 2006-03-22
# I have removed this because it was only used in the bootstrap. I
# fixed the bootstrap to use datafiles instead. Also the bootstrap
# methods who used this was very old and should probably be removed as
# well.

# start datafile
      {
        # datafile either retrieves or sets a new name for the datafile in the first problem of the
        # model. This method is only here for compatibility reasons. Don't use it. Use L</datafiles> instead.

        if( defined $new_name ){
          $self -> _option_name( position => 0, 
                                 record   => 'data', 
                                 problem_number  => $problem_number,
                                 new_name => $new_name);
          my ( $cont_column, $wrap_column ) = $self -> problems -> [$problem_number-1] ->
            cont_wrap_columns;
          my $ignoresign = defined $self -> ignoresigns ?
            $self -> ignoresigns -> [$problem_number-1] : undef;
          my @model_header = @{$self -> problems -> [$problem_number-1] -> header};
          $self -> {'datas'} -> [$problem_number-1] = data ->
            new( idcolumn             => $self -> idcolumn( problem_number => $problem_number ),
                 ignoresign           => $ignoresign,
                 filename             => $new_name,
                 cont_column          => $cont_column,
                 wrap_column          => $wrap_column,
                 #model_header         => \@model_header,
                 ignore_missing_files => $self -> {'ignore_missing_files'},
                 target               => $self -> {'target'} );
        } else {
            $name = $self -> _option_name( position => 0, record => 'data', problem_number => $problem_number );
        }
      }
# end datafile

# }}} datafile

# {{{ datafiles

=head2 datafiles

Usage:

=for html <pre>

$model_object -> datafiles( new_names => ['datafile.dta'] );

=for html </pre>

Arguments:

=over 2

=item new_names

array of strings

=item problem_numbers

array of integer

=item absolute_path

boolean

=back

Description:

datafiles changes the names of the data files in a model file. The
"new_names" argument is an array of strings, where each string gives
the file name of a problem data file. The length of "new_names" must
be equal to the "problem_numbers" argument. "problem_numbers" is by
default containing all of the models problems numbers. In the example
above we only have one problem in the model file and therefore only
need to give on new file name.

Unless new_names is given datafiles returns the names of the data
files used by the model file. If the optional "absolute_path" argument
is given, the returned file names will have the path to file as well.

=cut

start datafiles
      {
        # The datafiles method retrieves or sets the names of the
        # datafiles specified in the $DATA record of each problem. The
        # problem_numbers argument can be used to control which
        # problem that is affected. If absolute_path is set to 1, the
        # returned file names are given with absolute paths.

        unless( $#problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        if ( scalar @new_names > 0 ) {
          my $i = 0;
          my @idcolumns = @{$self ->
                              idcolumns( problem_numbers => \@problem_numbers )};
          foreach my $new_name ( @new_names ) {
            if ( $absolute_path ) {
              my $tmp;
              ($tmp, $new_name) = OSspecific::absolute_path('', $new_name );
              $new_name = $tmp . $new_name;
            }

            $self -> _option_name( position       => 0, 
                                   record         => 'data', 
                                   problem_number => $problem_numbers[$i],
                                   new_name       => $new_name);
            my ( $cont_column, $wrap_column ) = $self -> problems ->
              [$problem_numbers[$i]-1] -> cont_wrap_columns;
            my $ignoresign = defined $self -> ignoresigns ? $self -> ignoresigns -> [$i] : undef;
            my @model_header = @{$self -> problems -> [$i] -> header};
            $self -> {'datas'} -> [$problem_numbers[$i]-1] = data ->
              new( idcolumn             => $idcolumns[$i],
                   ignoresign           => $ignoresign,
                   filename             => $new_name,
                   cont_column          => $cont_column,
                   wrap_column          => $wrap_column,
                   #model_header         => \@model_header,
                   ignore_missing_files => $self -> {'ignore_missing_files'},
                   target               => $self -> {'target'} );
            $i++;
          }
        } else {
          foreach my $prob_num ( @problem_numbers ) {
            if ( $absolute_path ) {
              my ($d_dir, $d_name);
              ($d_dir, $d_name) =
                  OSspecific::absolute_path($self -> {'directory'}, $self ->_option_name( position       => 0,
                                                                                          record         => 'data',
                                                                                          problem_number => $prob_num ) );
              push( @names, $d_dir . $d_name );
            } else {
              my $name = $self -> _option_name( position       => 0,
                                                record         => 'data',
                                                problem_number => $prob_num );
              $name =~ s/.*[\/\\]//;
              push( @names, $name );
            }
          }
        }
      }
end datafiles

# }}} datafiles

# {{{ des

# TODO 2006-03-22
# This method is renamed __des in dia but not here. If nothing broke
# until now I think we can safely remove it.

start des
      {
        # Returns the des part specified subproblem.
        # TODO: Even though new_des can be specified, they wont be set
        # in to the object.

        my @prob = @{$self    -> problems};
        my @des  = @{$prob[$problem_number - 1] -> get_record('des') -> code}
        if ( defined $prob[$problem_number - 1] -> get_record('des') );
      }
end des

# }}} des

# {{{ eigen
start eigen
      {
        $self -> {'problems'} -> [0] -> eigen;
      }
end eigen
# }}} eigen

# {{{ error

# TODO 2006-03-22
# This method is renamed __error in dia but not here. If nothing broke
# until now I think we can safely remove it.

start error
      {
        # Usage:
        # 
        # @error = $modelObject -> error;
        # 
        # Returns the error part specified subproblem.
        # TODO: Even though new_error can be specified, they wont be set
        # in to the object.
        my @prob = @{$self    -> problems};
        my @error = @{$prob[0] -> get_record('error') -> code}
          if ( defined $prob[0] -> get_record('error') );
      }
end error

# }}} error

# {{{ extra_data_files

=head2 extra_data_files

Usage:

=for html <pre>

$model_object -> extra_data_files( ['extra_data.dta'] );

my $extra_file_name = $model_object -> extra_data_files;

=for html </pre>

Arguments:

The argument is an unnamed array of strings

Description:

If extra_data_files is used without argument the names of any extra
data files connected to the model object is returned. If an argument
is given it must be an array of length equal to the number of problems
in the model. Then the names of the extra data files will be changed
to those in the array.

=cut

start extra_data_files
      {
        my @file_names;
        # Sets or retrieves extra_data_file_name on problem level
        my $nprobs = scalar @{$self -> {'problems'}};
        if ( defined $parm ) {
          if ( ref($parm) eq 'ARRAY' ) {
            my @new_file_names = @{$parm};
            # Check that new_file_names and problems match
            'debug' -> die( message => "model -> extra_data_files: The number of problems $nprobs and" .
                            " new_file_names " . $#new_file_names+1 . " don't match in ".
                            $self -> full_name ) unless ( $#new_file_names + 1 == $nprobs );
            if ( defined $self -> {'problems'} ) {
              for( my $i = 0; $i < $nprobs; $i++ ) {
                $self -> {'problems'} -> [$i] -> extra_data_file_name( $new_file_names[$i] );
              }
            } else {
              'debug' -> die( message => "No problems defined in " . 
                              $self -> full_name );
            }
          } else {
            'debug' -> die(message => "Supplied new value is not an array.");
          }
        } else {
          if ( defined $self -> {'problems'} ) {
            for( my $i = 0; $i < $nprobs; $i++ ) {
              if( defined $self -> {'problems'} -> [$i] -> extra_data_file_name ) {
                push ( @file_names ,$self -> {'problems'} -> [$i] -> extra_data_file_name );
              }
            }
          }
        }
        return \@file_names;
     }
end extra_data_files

# }}}

# {{{ extra_data_headers

=head2 extra_data_headers

Usage:

=for html <pre>

$model_object -> extra_data_headers( [$data_obj] );

my $data_objects = $model_object -> extra_data_headers;

=for html </pre>

Arguments:

The argument is an unnamed array of arrays of strings.

Description:

If extra_data_files is used without argument the headers of any extra
data files connected to the model object is returned. If an argument
is given it must be an array of length equal to the number of problems
in the model. Then the headers of the extra data files will be changed
to those in the array.

=cut

start extra_data_headers
      {
        my @headers;
        # Sets or retrieves extra_data_header on problem level
        my $nprobs = scalar @{$self -> {'problems'}};
        if ( defined $parm ) {
          if ( ref($parm) eq 'ARRAY' ) {
            my @new_headers = @{$parm};
            # Check that new_headers and problems match
            'debug' -> die( message => "The number of problems $nprobs and".
                            " new_headers " . $#new_headers+1 . " don't match in ".
                            $self -> full_name) unless ( $#new_headers + 1 == $nprobs );
            if ( defined $self -> {'problems'} ) {
              for( my $i = 0; $i < $nprobs; $i++ ) {
                $self -> {'problems'} -> [$i] -> extra_data_header( $new_headers[$i] );
              }
            } else {
              'debug' -> die( message => "No problems defined in " .  $self -> full_name );
            }
          } else {
            'debug' -> die( message => "Supplied new value is not an array" );
          }
        } else {
          if ( defined $self -> {'problems'} ) {
            for( my $i = 0; $i < $nprobs; $i++ ) {
              push ( @headers, $self -> {'problems'} -> [$i] -> extra_data_header );
            }
          }
        }
        return \@headers;
     }
end extra_data_headers

# }}} extra_data_headers

# {{{ factors

=head2 factors

Usage:

=for html <pre>

my $factors = $model_object -> factors;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item unique_in_individual

boolean

=back

Description:

The following text comes from the documentation of
data::factors. model::factors will call data::factors for the given
problem number in the model object. Also it will take try to find
"column_head" in the $INPUT record instead of the data file header.

Either column (number, starting at 1) or column_head must be
specified. The default behaviour is to return a hash with the factors
as keys referencing arrays with the order numbers (not the ID numbers)
of the individuals that contain this factor.

If unique_in_individual is true (1), the returned hash will contain an
element with key 'Non-unique values found' and value 1 if any
individual contain more than one value in the specified column.

Return occurences will calculate the occurence of each factor
value. Several occurences in one individual counts as one
occurence. The elements of the returned hash will have the factors as
keys and the number of occurences as values.

=cut

start factors
      {
        # Calls <I>factors</I> on the data object of a specified
        # problem. See <I>data -> factors</I> for details.
        my $column_number;
        my $extra_data_column;
        if ( defined $column_head ) {
          # Check normal data object first
          my ( $values_ref, $positions_ref ) = $self ->
            _get_option_val_pos ( problem_numbers => [$problem_number], 
                                  name        => $column_head,
                                  record_name => 'input',
                                  global_position => 1 );
          $column_number = $positions_ref -> [0];
          # Next, check extra_data
          my $extra_data_headers = $self -> extra_data_headers;
          if ( defined $extra_data_headers and defined $extra_data_headers -> [0] ) {
            for ( my $i = 1; $i <= scalar @{$extra_data_headers->[0]}; $i++ ) {
              $extra_data_column = $i if ( $column_head eq $extra_data_headers->[0][$i-1] );
            }
          }
          'debug' -> die( message => "Unknown column \"$column_head\"" )
              unless ( defined $column_number or defined $extra_data_column );
        } else {
          $column_number = $column;
        }
        if ( defined $column_number) {
          %factors = %{$self -> {'datas'} -> [$problem_number-1] ->
                         factors( column => $column_number,
                                  unique_in_individual => $unique_in_individual,
                                  return_occurences => $return_occurences )};
        } else {
          %factors = %{$self -> {'problems'} -> [$problem_number-1] -> extra_data
                         -> factors( column => $extra_data_column,
                                     unique_in_individual => $unique_in_individual,
                                     return_occurences => $return_occurences )};
        }
      }
end factors

# }}}

# {{{ fractions

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start fractions
      {
        # Calls <I>fractions</I> on the data object of a specified
        # problem. See <I>data -> fractions</I> for details.
        my $column_number;
        my $extra_data_column;
        if ( defined $column_head ) {
          # Check normal data object first
          my ( $values_ref, $positions_ref ) = $self ->
            _get_option_val_pos ( problem_numbers => [$problem_number], 
                                  name        => $column_head,
                                  record_name => 'input',
                                  global_position => 1 );
          $column_number = $positions_ref -> [0];
          # Next, check extra_data
          my $extra_data_headers = $self -> extra_data_headers;
          if ( defined $extra_data_headers and defined $extra_data_headers -> [0] ) {
            for ( my $i = 1; $i <= scalar @{$extra_data_headers->[0]}; $i++ ) {
              $extra_data_column = $i if ( $column_head eq $extra_data_headers->[0][$i-1] );
            }
          }
          'debug' -> die( "Unknown column \"$column_head\"" )
              unless ( defined $column_number or defined $extra_data_column );
        } else {
          $column_number = $column;
        }
        if ( defined $column_number) {
          %fractions = %{$self -> {'datas'} -> [$problem_number-1] ->
                           fractions( column => $column_number,
                                      unique_in_individual => $unique_in_individual,
                                      ignore_missing       => $ignore_missing )};
        } else {
          %fractions = %{$self -> {'problems'} -> [$problem_number-1] -> extra_data
                           -> fractions( column               => $extra_data_column,
                                         unique_in_individual => $unique_in_individual,
                                         ignore_missing       => $ignore_missing )};
        }
      }
end fractions

# }}}

# {{{ fixed

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start fixed
      {
          # Sets or gets the 'fixed' status of a (number of)
          # parameter(s). 1 correspond to a parameter being fixed and
          # 0 not fixed. The returned parameter is a reference to a
          # two-dimensional array, indexed by problems and parameter
          # numbers.
          # Valid parameter types are 'theta', 'omega' and 'sigma'.

        @fixed = @{ $self -> _init_attr
                      ( parameter_type    => $parameter_type,
                        parameter_numbers => \@parameter_numbers,
                        problem_numbers           => \@problem_numbers,
                        new_values        => \@new_values,
                        attribute         => 'fix')};
      }
end fixed

# }}} fixed

# {{{ have_missing_data

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start have_missing_data
      {
        # Calls <I>have_missing_data</I> on the data object of a specified
        # problem. See <I>data -> have_missing_data</I> for details.
        my $column_number;
        my $extra_data_column;
        if ( defined $column_head ) {
          # Check normal data object first
          my ( $values_ref, $positions_ref ) = $self ->
            _get_option_val_pos ( problem_numbers => [$problem_number], 
                                  name        => $column_head,
                                  record_name => 'input',
                                  global_position => 1  );
          $column_number = $positions_ref -> [0];
          # Next, check extra_data
          my $extra_data_headers = $self -> extra_data_headers;
          if ( defined $extra_data_headers and defined $extra_data_headers -> [0] ) {
            for ( my $i = 1; $i <= scalar @{$extra_data_headers->[0]}; $i++ ) {
              $extra_data_column = $i if ( $column_head eq $extra_data_headers->[0][$i-1] );
            }
          }
          'debug' -> die( message => "Unknown column \"$column_head\"" )
              unless ( defined $column_number or defined $extra_data_column );
        } else {
          $column_number = $column;
        }
        if ( defined $column_number) {
          $return_value = $self -> {'datas'} -> [$problem_number-1] ->
            have_missing_data( column => $column_number );
        } else {
          $return_value = $self -> {'problems'} -> [$problem_number-1] ->
            extra_data -> have_missing_data( column => $extra_data_column );
        }
    }
end have_missing_data

# }}}

# {{{ idcolumn

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start idcolumn
      {
        # Usage:
        #
        #   @idcolumns = @{$modelObject -> idcolumns( problem_numbers => [2,3] );
        #
        # idcolumns returns the idcolumn index in the datafile for the
        # specified problem.

        my $junk_ref;
        ( $junk_ref, $col ) = $self ->
          _get_option_val_pos( name => 'ID', 
                               record_name => 'input', 
                               problem_numbers => [$problem_number] );
        
        if ( $problem_number ne 'all' ) {
          $col = @{$col}[0];
        }
      }
end idcolumn

# }}} idcolumn

# {{{ idcolumns

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start idcolumns
      {
        # Usage:
        #
        #   @column_numbers = @{$modelObject -> idcolumns( problem_numbers => [2] )};
        #
        # idcolumns returns the idcolumn indexes in the datafile for the
        # specified problems.

        my ( $junk_ref, $col_ref ) = $self ->
          _get_option_val_pos( name            => 'ID',
                               record_name     => 'input',
                               problem_numbers => \@problem_numbers );
        # There should only be one instance of $INPUT and hence we collapse
        # the two-dim return from _get_option_pos_val to a one-dim array:

        foreach my $prob ( @{$col_ref} ) {
          foreach my $inst ( @{$prob} ) {
            push( @column_numbers, $inst );
          }
        }
      }
end idcolumns

# }}} idcolumns

# {{{ ignoresigns

=head2 ignoresigns

Usage:

=for html <pre>

$model_object -> ignoresigns( ['#','@'] );

my $ignoresigns = $model_object -> ignoresigns;

=for html </pre>

Arguments:

The argument is an unnamed array of strings

Description:

If ignoresigns is used without argument the string that specifies
which string that is used for comment rows in the data file is
returned. The returned value is an array including the ignore signs
of each problem.  If an argument is given it must be an array of
length equal to the number of problems in the model. Then the names of
the extra data files will be changed to those in the array.

=cut

start ignoresigns
      {
        # Usage:
        #
        #   @ignore_signs = @{$modelObject -> ignoresigns( problem_numbers => [2,4] )};
        #
        # ignoresigns returns the ignore signs in the datafile for the
        # specified problems

        foreach my $prob ( @{$self -> {'problems'}} ) {
          my @datarecs = @{$prob -> datas};
          if ( defined $datarecs[0] ) {
            push( @ignore, $datarecs[0] -> ignoresign );
          } else {
            push( @ignore, '#' );
          }
        }

#       print "IGNORE: @ignore\n";

      }
end ignoresigns

# }}} ignoresigns

# {{{ ignore_lists

start ignore_lists
      {
        # Usage:
        #
        #   @ignore_signs = @{$modelObject -> ignore_lists( problem_numbers => [2,4] )};
        #
        # ignore_lists returns the ignore signs in the datafile for the
        # specified problems

        foreach my $prob ( @{$self -> {'problems'}} ) {
          my @datarecs = @{$prob -> datas};
          if ( defined $datarecs[0] ) {
            push( @ignore, $datarecs[0] -> ignore_list );
          } else {
            push( @ignore, '#' );
          }
        }
 
#       print "IGNORE: @ignore\n";

      }
end ignore_lists

# }}} ignoresigns

# {{{ indexes

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start indexes
      {
        # Usage:
        #
        #   @indexArray = @{$modelObject -> indexes( 'parameter_type' => 'omega' )};
        # 
        # A call to I<indexes> returns the indexes of all parameters
        # specified in I<parameter_numbers> from the subproblems
        # specified in I<problem_numbers>. The method returns a reference to an array that has
        # the same structure as parameter_numbers but for each
        # array of numbers is instead an array of indices. The method
        # uses a method from the model::problem class to format the
        # indices, so here are a few lines from the code comments in
        # model/problem.pm that describes the returned value:
        #
        # <snip>
        # The Indexes method calculates the index for a
        # parameter. Off-diagonal elements will get a index 'i_j', where i
        # is the row number and j is the column number
        # </snip>

        unless( $#problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        my @problems = @{$self -> {'problems'}};
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
            push( @indexes,
                  $problems[ $i-1 ] ->
                  indexes( parameter_type => $parameter_type,
                           parameter_numbers => $parameter_numbers[ $i-1 ] ) );
          } else {
            'debug' -> die( message => "Problem number $i does not exist!" );
          }
        }
      }
end indexes

# }}} indexes

# {{{ initial_values

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start initial_values
      {
          # initial_values either sets or gets the initial values of
          # the parameter specified in "parameter_type" for each
          # problem specified in problem_numbers. For each element
          # in problem_numbers there must be a reference in
          # parameter_numbers to an array that specify the indices
          # of the parameters in the subproblem for which the initial
          # values are set, replaced or retrieved.
          # 
          # The add_if_absent argument tells the method to add an init
          # (theta,omega,sigma) if the parameter number points to a
          # non-existing parameter with parameter number one higher
          # than the highest presently included. Only applicable if
          # new_values are set. Valid parameter types are 'theta',
          # 'omega' and 'sigma'.

        @initial_values = @{ $self -> _init_attr
                                 ( parameter_type    => $parameter_type,
                                   parameter_numbers => \@parameter_numbers,
                                   problem_numbers   => \@problem_numbers,
                                   new_values        => \@new_values,
                                   attribute         => 'init',
                                   add_if_absent     => $add_if_absent )};
      }
end initial_values

# }}} initial_values

# {{{ is_option_set


=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start is_option_set
      {
        # Usage:
        # 
        # if( $modelObject -> is_option_set( record => 'recordName', name => 'optionName' ) ){
        #     print "problem_number 1 has option optionName set in record recordName";
        # }
        #
        # is_option_set checks if an option is set in a given record in given problem.

        my ( @problems, @records, @options );
        my $accessor = $record.'s';
        if ( defined $self -> {'problems'} ) {
            @problems = @{$self -> {'problems'}};
        } else {
          'debug' -> die( message => "No problems defined in model" );
        }
        unless( defined $problems[$problem_number - 1] ){
            'debug' -> warn( level => 2,
                           message => "model -> is_option_set: No problem number $problem_number defined in model" );
            return 0; # No option can be set if no problem exists.
        }
        
        if ( defined $problems[$problem_number - 1] -> $accessor ) {
            @records = @{$problems[$problem_number - 1] -> $accessor};
        } else {
            'debug' -> warn( level => 2,
                           message => "model -> is_option_set: No record $record defined" .
                           " in problem number $problem_number." );
            return 0;
        }

        unless(defined $records[$instance - 1] ){
            'debug' -> warn( level => 2,
                           message => "model -> is_option_set: No record instance number $instance defined in model." );
            return 0;
        }

        if ( defined $records[$instance - 1] -> options ) {
            @options = @{$records[$instance - 1] -> options};
        } else {
          'debug' -> warn( level => 2, 
                           message => "No option defined in record: $record in problem number $problem_number." );
            return 0;
        }
        foreach my $option ( @options ) {
            $found = 1 if ( defined $option and $option -> name eq $name );
            if( $fuzzy_match ){
              if( index( $name, $option -> name ) > -1 ){
                $found = 1;
              }
            }
        }
      }
end is_option_set

# }}} is_option_set

# {{{ is_run


=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start is_run
      {
        # Usage:
        # 
        # is_run returns true if the outputobject owned by the
        # modelobject has valid outpudata either in memory or on disc.
        if( defined $self -> {'outputs'} ){
          if( @{$self -> {'outputs'}}[0] -> have_output ){
            $return_value = 1;
          }
        } else {
          $return_value = 0;
        }
      }
end is_run
# }}} is_run

# {{{ is_simulation


=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start is_simulation
    {
      my $problems = $self -> {'problems'};
      if( defined $problems -> [$problem_number - 1] ) {
        my $problem = $problems -> [$problem_number - 1];
        # If we don't have an ESTIMATION record we are simulating.
        $is_sim = 1 unless( defined $problem -> {'estimations'} and
                         scalar( @{$problem-> {'estimations'}} ) > 0 );

        # If we have a ONLYSIM option in the simulation record.
        $is_sim = 1 if( $self -> is_option_set ( name           => 'ONLYSIM', 
                                                 record         => 'simulation', 
                                                 problem_number => $problem_number ));

        # If max evaluations is zero we are simulating
        $is_sim = 1 if( defined $self -> maxeval(problem_numbers => [$problem_number]) and
                        defined $self -> maxeval(problem_numbers => [$problem_number])->[0][0] and
                        $self -> maxeval(problem_numbers => [$problem_number])->[0][0] == 0 );
        
        # Anything else?

        # If non of the above is true, we are estimating.
      } else {
        'debug' -> warn( level => 1,
                         message => 'Problem nr. $problem_number not defined. Assuming no simulation' );
        $is_sim = 0;
      }
    }
end is_simulation

# }}}

# {{{ lower_bounds

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start lower_bounds
      {
          # lower_bounds either sets or gets the initial values of the
          # parameter specified in the argument parameter_type for
          # each problem specified in problem_numbers. See L</fixed>.
          
        @lower_bounds = @{ $self -> _init_attr
                             ( parameter_type    => $parameter_type,
                               parameter_numbers => \@parameter_numbers,
                               problem_numbers           => \@problem_numbers,
                               new_values        => \@new_values,
                               attribute         => 'lobnd')};
      }
end lower_bounds

# }}} lower_bounds

# {{{ labels

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start labels
      {
        # Usage:
        #
        #   @labels = @{$modobj -> labels( parameter_type => 'theta' )};
        #
        # This basic usage takes one arguments and returns matched names and
        # estimated values of the specified parameter. The parameter_type argument
        # is mandatory. It returns the labels of all parameters of type given by
        # $parameter_type.
        # @labels will be a two-dimensional array:
        # [[label1][label2][label3]...]
        #
        #   $labels -> labels( parameter_type  => 'theta',
        #                      problem_numbers => [2,4] );
        #
        # To get labels of specific problems, the problem_numbers argument can be used.
        # It should be a reference to an array containing the numbers
        # of all problems whos labels should be retrieved.
        #
        #   $modobj -> labels( parameter_type    => 'theta',
        #                      problem_numbers   => [2,4],
        #                      parameter_numbers => [[1,3][4,6]]);
        #
        # The retrieval can be even more specific by using the parameter_numbers
        # argument. It should be a reference to a two-dimensional array, where
        # the inner arrays holds the numbers of the parameters that should be
        # fetched. In the example above, parameters one and three from problem two
        # plus parameters four and six from problem four are retrieved.
        #
        #   $modobj -> labels( parameter_type    => 'theta',
        #                      problem_numbers   => [2,4],
        #                      parameter_numbers => [[1,3][4,6]],
        #                      generic           => 1 );
        #
        # To get generic labels for the parameters - e.g. OM1, OM2_1, OM2 etc -
        # set the generic argument to 1.
        #
        # $modobj -> labels( parameter_type     => 'theta',
        #                     problem_numbers   => [2],
        #                     parameter_numbers => [[1,3]],
        #                     new_values        => [['Volume','Clearance']] );
        #
        # The new_values argument can be used to give parameters new labels. In
        # the above example, parameters one and three in problem two are renamed
        # Volume and Clearance.
        #

        my ( @index, $idx );
        @labels = @{ $self -> _init_attr
                       ( parameter_type    => $parameter_type,
                         parameter_numbers => \@parameter_numbers,
                         problem_numbers           => \@problem_numbers,
                         new_values        => \@new_values,
                         attribute         => 'label' )};

        #       foreach my $prl ( @labels ) {
        #         foreach my $label ( @{$prl} ) {
        #           print "Label: $label\n";
        #         }
        #       }
        
        
        @index = @{$self -> indexes( parameter_type => $parameter_type,
                                     parameter_numbers => \@parameter_numbers,
                                     problem_numbers => \@problem_numbers )};

        for ( my $i = 0; $i <= $#labels; $i++ ) {
          for ( my $j = 0; $j < scalar @{$labels[$i]}; $j++ ) {
            $idx = $index[$i][$j];
            $labels[$i][$j] = uc(substr($parameter_type,0,2)).$idx
              unless ( defined $labels[$i][$j] and not $generic );
          }
        }
      }
end labels

# }}} labels

# {{{ maxeval

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start maxeval
      {
        # Usage:
        #
        #   @maxev = @{$modobj -> maxeval};
        #
        # This basic usage takes no arguments and returns the value of the
        # MAXEVAL option in the $ESTIMATION record of each problem.
        # @maxev will be a two dimensional array:
        # [[maxeval_prob1][maxeval_prob2][maxeval_prob3]...]
        #
        #   $modobj -> maxeval( new_values => [[0],[999]];
        #
        # If the new_values argument of maxeval is given, the values of the
        # MAXEVAL options will be changed. In this example, MAXEVAL will be
        # set to 0 in the first problem and to 999 in the second.
        # The number of elements in new_values must match the number of problems
        # in the model object $modobj.
        #
        #   $modobj -> maxeval( new_values => [[0],[999]],
        #                       problem_numbers    => [2,4] );
        #
        # To set the MAXEVAL of specific problems, the problem_numbers argument can
        # be used. It should be a reference to an array containing the numbers
        # of all problems where the MAXEVAL should be changed or retrieved.
        # If specified, the size of new_values must be the same as the size
        # of problem_numbers.
        #
        


        my ( $val_ref, $junk ) = $self -> 
          _option_val_pos( name            => 'MAX',
                           record_name     => 'estimation',
                           problem_numbers => \@problem_numbers,
                           new_values      => \@new_values,
                           exact_match     => $exact_match );
        @values = @{$val_ref};
      }
end maxeval

# }}} maxeval

# {{{ median

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start median
      {
        # Calls <I>median</I> on the data object of a specified
        # problem. See <I>data -> median</I> for details.
        my $column_number;
        my $extra_data_column;
        if ( defined $column_head ) {
          # Check normal data object first
          my ( $values_ref, $positions_ref ) = $self ->
            _get_option_val_pos ( problem_numbers => [$problem_number], 
                                  name        => $column_head,
                                  record_name => 'input',
                                  global_position => 1  );
          $column_number = $positions_ref -> [0];
          if ( not defined $column_number ) {
            # Next, check extra_data
            my $extra_data_headers = $self -> extra_data_headers;
            if ( defined $extra_data_headers and defined $extra_data_headers -> [0] ) {
              for ( my $i = 1; $i <= scalar @{$extra_data_headers->[0]}; $i++ ) {
                $extra_data_column = $i if ( $column_head eq $extra_data_headers->[0][$i-1] );
              }
            }
          }
          'debug' -> die( message => "Unknown column \"$column_head\"" )
              unless ( defined $column_number or defined $extra_data_column );
        } else {
          $column_number = $column;
        }

        if ( defined $column_number) {
          $median = $self -> {'datas'} -> [$problem_number-1] ->
            median( column => $column_number,
                    unique_in_individual => $unique_in_individual );
        } else {
          $median = $self -> {'problems'} -> [$problem_number-1] -> extra_data ->
            median( column => $extra_data_column,
                    unique_in_individual => $unique_in_individual );
        }
    }
end median

# }}}

# {{{ max

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start max
      {
        # Calls <I>max</I> on the data object of a specified
        # problem. See <I>data -> max</I> for details.
        my $column_number;
        my $extra_data_column;
        if ( defined $column_head ) {
          # Check normal data object first
          my ( $values_ref, $positions_ref ) = $self ->
            _get_option_val_pos ( problem_numbers => [$problem_number], 
                                  name        => $column_head,
                                  record_name => 'input',
                                  global_position => 1  );
          $column_number = $positions_ref -> [0];
          if ( not defined $column_number ) {
            # Next, check extra_data
            my $extra_data_headers = $self -> extra_data_headers;
            if ( defined $extra_data_headers and defined $extra_data_headers -> [0] ) {
              for ( my $i = 1; $i <= scalar @{$extra_data_headers->[0]}; $i++ ) {
                $extra_data_column = $i if ( $column_head eq $extra_data_headers->[0][$i-1] );
              }
            }
          }
          'debug' -> die( message => "Unknown column \"$column_head\"" )
              unless ( defined $column_number or defined $extra_data_column );
        } else {
          $column_number = $column;
        }

        if ( defined $column_number) {
          $max = $self -> {'datas'} -> [$problem_number-1] ->
            max( column => $column_number );
        } else {
          $max = $self -> {'problems'} -> [$problem_number-1] -> extra_data ->
            max( column => $extra_data_column );
        }
      }
end max

# }}}

# {{{ min

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start min
      {
        # Calls <I>min</I> on the data object of a specified
        # problem. See <I>data -> min</I> for details.
        my $column_number;
        my $extra_data_column;
        if ( defined $column_head ) {
          # Check normal data object first
          my ( $values_ref, $positions_ref ) = $self ->
            _get_option_val_pos ( problem_numbers => [$problem_number], 
                                  name        => $column_head,
                                  record_name => 'input',
                                  global_position => 1  );
          $column_number = $positions_ref -> [0];
          if ( not defined $column_number ) {
            # Next, check extra_data
            my $extra_data_headers = $self -> extra_data_headers;
            if ( defined $extra_data_headers and defined $extra_data_headers -> [0] ) {
              for ( my $i = 1; $i <= scalar @{$extra_data_headers->[0]}; $i++ ) {
                $extra_data_column = $i if ( $column_head eq $extra_data_headers->[0][$i-1] );
              }
            }
          }
          'debug' -> die( message => "Unknown column \"$column_head\"" )
              unless ( defined $column_number or defined $extra_data_column );
        } else {
          $column_number = $column;
        }

        if ( defined $column_number) {
          $min = $self -> {'datas'} -> [$problem_number-1] ->
            min( column => $column_number );
        } else {
          $min = $self -> {'problems'} -> [$problem_number-1] -> extra_data ->
            min( column => $extra_data_column );
        }
    }
end min

# }}}

# {{{ name_val

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start name_val
      {
        # Usage:
        #
        #   @name_val = @{$modobj -> name_val( parameter_type => 'theta' )};
        #
        # This basic usage takes one arguments and returns matched names and
        # estimated values of the specified parameter. The parameter_type argument
        # is mandatory.
        # The names are taken from
        # the labels of the parameters (se the labels method for specifications of
        # default labels) and the values are aquired from the output object bound
        # to the model object. If no output exists, the name_val method returns
        # undef.
        # @name_val will be a two-dimensional array of references to hashes using
        # the names from each problem as keys:
        # [[ref to hash1 ][ref to hash2][ref to hash3]...]
        #
        #   $modobj -> name_val( parameter_type => 'theta',
        #                        problem_numbers        => [2,4] );
        #
        # To get matched names and values of specific problems, the problem_numbers argument 
        # can be used. It should be a reference to an array containing the numbers
        # of all problems whos names and values should be retrieved.
        #
        #   $modobj -> name_val( parameter_type    => 'theta',
        #                        problem_numbers           => [2,4],
        #                        parameter_numbers => [[1,3][4,6]]);
        #
        # The retrieval can be even more specific by using the parameter_numbers
        # argument. It should be a reference to a two-dimensional array, where
        # the inner arrays holds the numbers of the parameters that should be
        # fetched. In the example above, parameters one and three from problem two
        # plus parameters four and six from problem four are retrieved.
        #

        unless( $#problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        my @names = @{$self -> labels( parameter_type    => $parameter_type,
                                       parameter_numbers => \@parameter_numbers,
                                       problem_numbers           => \@problem_numbers )};
        my @values;
        if ( defined $self -> outputs -> [0] ) {
          my $accessor  = $parameter_type.'s';
          @values = @{$self -> outputs -> [0] ->
                        $accessor( problems => \@problem_numbers,
                                   parameter_numbers => \@parameter_numbers )};
          #       my @problems = @{$self -> {'problems'}};
          #       foreach my $i ( @problem_numbers ) {
          #         if ( defined $problems[ $i-1 ] ) {
          #           my $pn_ref = $#parameter_numbers >= 0 ? \@{$parameter_numbers[ $i-1 ]} : [];
          #           push( @names_values,
          #                 $problems[ $i-1 ] ->
          #                 name_val( parameter_type => $parameter_type,
          #                           parameter_numbers => $pn_ref ) );
          #         } else {
          #           die "Model -> name_val: Problem number $i does not exist!\n";
          #         }
          #       }
        }
        #       if ( scalar @{$self -> {'outputs'}} > 0 ) {
        #         my $outobj = $self -> {'outputs'} -> [0];
        #       }

        'debug' -> die( message => "The number of problems retrieved from the model" .
                        " do not match the ones retrived from the output" ) unless( $#names == $#values );
        for( my $i = 0; $i <= $#names; $i++ ) {
          'debug' -> die( message => "Problem " . $i+1 .
                          " The number of parameters retrieved from the model (".scalar @{$names[$i]}.
                          ") do not match the ones retrived from the output (".
                          scalar @{$values[$i][0]}.")" )
                          unless( scalar @{$names[$i]} == scalar @{$values[$i][0]} );
          my @prob_nv = ();
          for( my $j = 0; $j < scalar @{$values[$i]}; $j++ ){
            my %nv = ();
            for( my $k = 0; $k < scalar @{$names[$i]}; $k++ ){
              $nv{$names[$i][$k]} = $values[$i][$j][$k];
            }
            push( @prob_nv, \%nv );
          }
          push( @names_values, \@prob_nv );
        }
      }
end name_val

# }}} name_val

# {{{ nproblems

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start nproblems
      {
        # nproblems returns the number of problems in the modelobject.
        
        $number_of_problem = scalar @{$self -> {'problems'}};
      }
end nproblems

# }}} nproblems

# {{{ nthetas

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start nthetas
      {
          # returns the number of thetas in the model for the given
          # problem number.
        $nthetas = $self -> _parameter_count( 'record' => 'theta', 'problem_number' => $problem_number );
      }
end nthetas

# }}} nthetas

# {{{ nomegas

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start nomegas
      {
          # returns the number of omegas in the model for the given
          # problem number.
#       $nomegas = $self -> _parameter_count( 'record' => 'omega', 'problem_number' => $problem_number );
        unless( $#problem_numbers >= 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }

        my @problems = @{$self -> {'problems'}};
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
            push( @nomegas, $problems[ $i-1 ] -> nomegas( with_correlations => $with_correlations ));
          } else {
            'debug' -> die( "Problem number $i does not exist." );
          } 
        }
      }
end nomegas

# }}} nomegas

# {{{ nsigmas

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start nsigmas

# returns the number of sigmas in the model for the given problem number.

#       $nsigmas = $self -> _parameter_count( 'record' => 'sigma', 'problem_number' => $problem_number );
    
unless( $#problem_numbers >= 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}

my @problems = @{$self -> {'problems'}};
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    push( @nsigmas, $problems[ $i-1 ] -> nsigmas( with_correlations => $with_correlations ));
  } else {
    'debug' -> die( "Problem number $i does not exist." );
  } 
}

end nsigmas

# }}} nsigmas

# {{{ outputfile

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start outputfile
      {
        # Usage:
        #
        # This method is a (partially) automatically generated accessor for the
        # outputfile attribute of the model class. Since no named argument is needed
        # for accessors, the two possible ways of calling outputfile are:
        #
        #   $modelObject -> outputfile( 'newfilename.lst' );
        #
        #   $outputfilename = $modelObject -> outputfile;
        #
        # The first alternative sets a new name for the output file, and the second
        # retrieves the value.
        #
        # The extra feature for this accessor, compared to other accessors, is that
        # if a new name is given, the accessor tries to create a new output object
        # based on this.

        if( defined $parm ) {
          $self -> {'outputs'} =
            [ output ->
              new( filename             => $parm,
                   ignore_missing_files => ( $self -> ignore_missing_files() || $self -> ignore_missing_output_files() ),
                   target               => $self -> target(),
                   model_id             => $self -> model_id() ) ];
        }
      }
end outputfile

# }}} outputfile

# {{{ pk

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start pk
      {
        # sets or gets the pk code for a given problem in the
        # model object. The new_pk argument should be an array where
        # each element contains a row of a valid NONMEM $PK block,

        my @prob = @{$self -> problems};
        
        unless( defined $prob[$problem_number - 1] ){
          'debug' -> die( message => "Problem number $problem_number does not exist" );
        }
        
        my $pks = $prob[$problem_number - 1] -> pks;
        if( scalar @new_pk > 0 ) {
          if( defined $pks and scalar @{$pks} > 0 ){
            $prob[$problem_number - 1] -> pks -> [0] -> code(\@new_pk);
          } else {
            'debug' -> die( message => "No \$PK record" );
          }
        } else {
          if ( defined $pks and scalar @{$pks} > 0 ) {
            @pk = @{$prob[$problem_number - 1] -> pks -> [0] -> code};
          }
        }
      }
end pk

# }}} pk

# {{{ pred

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start pred
      {
        # Sets or gets the pred code for a given problem in the model
        # object. See L</pk> for details.
        my @prob = @{$self -> problems};
        
        unless( defined $prob[$problem_number - 1] ){
          'debug' -> die( message => "problem number $problem_number does not exist" );
        }
        
        if( scalar @new_pred > 0 ) {
          if( defined $prob[$problem_number - 1] -> preds ){
            $prob[$problem_number - 1] -> preds -> [0] -> code(\@new_pred);
          } else {
            'debug' -> die( message => "No \$PRED record" );
          }
        } else {
          if ( defined $prob[$problem_number - 1] -> preds ) {
            @pred = @{$prob[$problem_number - 1] -> preds -> [0] -> code};
          } else {
            'debug' -> die( message => "No \$PRED record" );
          }
        }
      }
end pred

# }}} pred

# {{{ print

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start print
      {
        # Prints the formatted model to standard out.
        
        my ( @formatted );
        foreach my $problem ( @{$self -> {'problems'}} ) {
          push( @formatted, $problem -> format_problem );
        }
        for ( @formatted ) {
          print;
        }
      }
end print

# }}} print

# {{{ problem_structure

start problem_structure

my ( $val, $pos ) = $self -> _option_val_pos( record_name => 'simulation',
                                              name        => 'SUBPROBLEMS' );
if( defined $val ) {
  my @vals = @{$val};
  for( my $i = 0; $i <= $#vals; $i++ ) {
    if( defined $vals[$i] ) {
      if( scalar @{$vals[$i]} > 0 ) {
        $subproblems[$i] = $vals[$i][0];
      } else {
        $subproblems[$i] = 1;
      }
    } else {
      $subproblems[$i] = 1;
    }
  }
}

end problem_structure

# }}} problem_structure

# {{{ randomize_inits

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start randomize_inits
      {
        foreach my $prob ( @{$self -> {'problems'}} ) {
          $prob -> set_random_inits ( degree => $degree );
        }
      }
end randomize_inits

# }}}


# {{{ record

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start record
     {
         # If the argument new_data is given, record sets new_data in
         # the model objects member specified with record_name. The
         # format of new_data is an array of strings, where each
         # element corresponds to a line of code as it would have
         # looked like in a valid NONMEM modelfile. If new_data is left
         # undefined, record returns lines of code belonging to the
         # record specified by record_name in a format that is valid in
         # a NONMEM modelfile.
         
         my @problems = @{$self -> {'problems'}};
         my $records;
         
         if ( defined $problems[ $problem_number - 1 ] ) {
             if ( scalar(@new_data) > 0 ){
                 my $rec_class = "model::problem::$record_name";
                 my $record = $rec_class -> new('record_arr' => \@new_data );
             } else {
                 $record_name .= 's';
                 $records = $problems[ $problem_number - 1 ] -> {$record_name};
                 foreach my $record( @{$records} ){
                     push(@data, $record -> _format_record);
                 }
             }
         }
     }
end record

# }}} record

# {{{ remove_inits

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start remove_inits
    {
      # Usage
      # 
      # $model -> remove_inits( type => 'theta',
      #                         indexes => [1,2,5,6] )
      #

      # In all cases the type must be set to theta. Removing Omegas in
      # Sigmas is not allowed, (If need that feature, send us a
      # mail). In the above example the thetas 1, 2, 5 and 6 will be
      # removed from the modelfile. Notice that this alters the theta
      # numbering, so if you later decide that theta number 7 must be
      # removed as well, you must calculate its new position in the
      # file. In this case the new number would be 3. Also notice that
      # numbering starts with 1.
      #
      # $model -> remove_inits( type => 'theta',
      #                         labels => ['V', 'CL'] )
      #

      # If you have specified labels in you modelfiles(a label is
      # string inside a comment on the same row as the theta) you can
      # specify an array with labels, and the corresponding theta, if
      # it exists, will be removed. This is a much better approach
      # since you don't need to know where in order the theta you wish
      # to remove appears. If you specify both labels and indexes, the
      # indexes will be ignored.

      'debug' -> die( message => 'does not have the functionality for removing $OMEGA or $SIGMA options yet' )
          if ( $type eq 'omega' or $type eq 'sigma' );
      my $accessor = $type.'s';
      
      # First pick out a referens to the theta records array.
      my $inits_ref = $self -> problems -> [$problem_number -1] -> $accessor;
      
      # If we have any thetas at all:
      if ( defined $inits_ref ) {
        my @inits = @{$inits_ref};

        # If labels are specified, we translate the labels into
        # indexes.
        if ( scalar @labels > 0 ) {
          @indexes = ();
          my $i = 1;
          # Loop over theta records
          foreach my $init ( @inits ) {
            # Loop over the individual thetas inside
            foreach my $option ( @{$init -> options} ) {
              # Loop over all given labels.
              foreach my $label ( @labels ) {
                # Push the index number if a given label match the
                # theta label
                push( @indexes, $i ) if ( $option -> label eq $label);
              }
              # $i is the count of thetas so far
              $i++;
            }
          }
        }

        # We don't really remove thetas, we do a loop over all thetas
        # and recording which we like to keep. We do that by selecting
        # an index, from @indexes, that shall be removed and loop over
        # the thetas, all thetas that doesn't match the index are
        # stored in @keep_options. When we find a theta that matches,
        # we pick a new index and continue the loop. So by makeing
        # sure that @indexes is sorted, we only need to loop over the
        # thetas once.

        @indexes = sort {$a <=> $b} @indexes;

        my $index = 0;
        my $nr_options = 1;
        my @keep_records;
        
        # Loop over all records
        RECORD_LOOP: foreach my $record ( @inits ){
          my @keep_options = ();
          # Loop over all thetas
          foreach my $option ( @{$record -> options} ) {
            if( $indexes[ $index ] == $nr_options ){
              # If a theta matches an index, we take the next index
              # and forget the theta.
              unless( $index > $#indexes ){
                $index++;
              }
            } else {
              # Otherwise we rember it.
              push(@keep_options,$option);
            }
            $nr_options++;
          }
          if( scalar(@keep_options) > 0 ){
            # If we remember some thetas, we must also remember the
            # record which they are in.
            $record -> options( \@keep_options );
            push( @keep_records, $record );
          }
        }
        
        # Set the all kept thetas back into the modelobject.
        @{$inits_ref} = @keep_records;

      } else {
        'debug' -> die( message => "No init of type $type defined" );
      }
    }
end remove_inits

# }}}

# {{{ restore_inits

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start restore_inits
      {
        # restore_inits brings back initial values previously stored
        # using store_inits. This method pair allows a user to store
        # the currents initial values in a backup, replace them with
        # temporary values and later restore them.

        if ( defined $self -> {'problems'} ) {
          foreach my $problem ( @{$self -> {'problems'}} ){
            $problem -> restore_inits;
          }
        }
      }
end restore_inits

# }}} restore_inits

# {{{ store_inits

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start store_inits
      {
        # store_inits stores initial values that can later be
        # brought back using restore_inits. See L</restore_inits>.

        if ( defined $self -> {'problems'} ) {
          foreach my $problem ( @{$self -> {'problems'}} ){
            $problem -> store_inits;
          }
        }
      }
end store_inits

# }}} store_inits

# {{{ synchronize

start synchronize
      {
          # Synchronize checks the I<synced> object attribute to see
          # if the model is in sync with its corresponding file, given
          # by the objetc attribute I<filename>. If not, it checks if
          # the model contains any defined problems and if it does, it
          # writes the formatted model to disk, overwriting any
          # existing file of name I<filename>. If no problem is
          # defined, synchronize tries to parse the file I<filename>
          # and set the object internals to match it.
        unless( $self -> {'synced'} ){
          if( defined $self -> {'problems'} and
              scalar @{$self -> {'problems'}} > 0 ){
            $self -> _write;
          } else {
            if( -e $self -> full_name ){
              $self -> _read_problems;
            } else {
              return;
            }
          }
        }
        $self -> {'synced'} = 1;
      }
end synchronize

# }}} synchronize

# {{{ flush
start flush
      # synchronizes the object with the file on disk and empties
      # most of the objects attributes to save memory.
      if( defined $self -> {'problems'} and
          ( !$self -> {'synced'} or $force ) ) {
        $self -> _write;
      }
      $self -> {'problems'} = undef;
      $self -> {'synced'} = 0;

end flush
# }}} flush

# {{{ target
start target
      {
        if ( $parm eq 'disk' ) {
          $self -> {'target'} = 'disk';
          $self -> flush;
        } elsif ( $parm eq 'mem' and $self -> {'target'} eq 'disk' ) {
          $self -> {'target'} = 'mem';
          $self -> synchronize;
        }
      }
end target
# }}}

# {{{ msfi_names

=head2 msfi_names

Usage:

=for html <pre>

my $msfi_names_ref = $model_object -> msfi_names;

=for html </pre>

Arguments:

=over 2

=item new_names

array of strings

=item problem_numbers

array of integers

=item ignore_missing_files

boolean

=back

Description:

msfi_names will return the names of all MSFI= statements in the
$ESTIMATION records in all problems.

=cut

start msfi_names
# Usage:
#
#    @msfiNames = @{$modobj -> msfi_names};
#
#    or better:
#
#    $msfiNamesRef = $modobj -> msfi_names;
#    @msfiNames = @{$msfiNamesRef} if (defined $msfiNamesRef);
#
# This basic usage takes no arguments and returns the value of
# the MSFI option in the $ESTIMATION NONMEM record of each
# problem. @msfiNames will be a two-dimensional array:
#
#   [[msfiName_prob1],[msfiName_prob2],[msfiName_prob3]...]
#

my @problems;
if ( defined $self -> problems() ) {
  @problems = @{$self -> problems()};
} else {
  'debug' -> die( message => "No problems defined in model" );
}

if( scalar @new_names > 0 ) {
  my $i = 0;
  foreach my $prob ( @problems ) {
    $prob -> remove_records( type => 'msfi' );
    if( defined $new_names[$i] ) {
      $prob -> add_records( type           => 'msfi',
                            record_strings => [$new_names[$i]] );      
    }
  }
} else {
  foreach my $prob ( @problems ) {
    if ( defined $prob -> msfis() ) {
      my @instances = @{$prob -> msfis()};
      my @prob_names;
      foreach my $instance ( @instances ) {
        my @options;
        if ( defined $instance -> options() ) {
          @options = @{$instance -> options()};
        }
        if ( defined $options[0] ) {
          push( @prob_names, $options[0] -> name );
        } else {
          push( @prob_names, undef );
        }       
      }
      push( @names, \@prob_names );
    } else {
      push( @names, undef );
    }
  }
}

end msfi_names

# }}} msfi_names

# {{{ msfo_names

=head2 msfo_names

Usage:

=for html <pre>

my $msfo_names_ref = $model_object -> msfo_names;

=for html </pre>

Arguments:

=over 2

=item new_names

array of strings

=item problem_numbers

array of integers

=item ignore_missing_files

boolean

=back

Description:

msfo_names will return the names of all MSFO= statements in the
$ESTIMATION records in all problems.

=cut

start msfo_names
# Usage:
#
#    @msfoNames = @{$modobj -> msfo_names};
#
#    or better:
#
#    $msfoNamesRef = $modobj -> msfo_names;
#    @msfoNames = @{$msfoNamesRef} if (defined $msfoNamesRef);
#
# This basic usage takes no arguments and returns the value of
# the MSFO option in the $ESTIMATION NONMEM record of each
# problem. @msfoNames will be an array:
#
#   [msfoName_prob1,msfoName_prob2,msfoName_prob3...]
#
#
# If the I<new_names> argument of msfo_names is given, the
# values of the MSFO options will be changed.
#
# To set the MSFO of specific problems, the I<problem_numbers>
# argument can be used. It should be a reference to an array
# containing the numbers of all problems where the FILE should
# be changed or retrieved. If specified, the size of
# I<new_names> must be the same as the size of
# I<problem_numbers>.

my ( $name_ref, $junk ) = $self -> 
    _option_val_pos( name            => 'MSFO',
                     record_name     => 'estimation',
                     problem_numbers => \@problem_numbers,
                     new_values      => \@new_names );


my ( $nonp_name_ref, $junk ) = $self ->
    _option_val_pos( name            => 'MSFO',
                     record_name     => 'nonparametric',
                     problem_numbers => \@problem_numbers,
                     new_values      => \@new_names );

if( length( @{$name_ref} > 0 ) ){
  push( @names, @{$name_ref} );
}

if( length( @{$nonp_name_ref} ) ){
  push( @names, @{$nonp_name_ref} );
}

end msfo_names

# }}} msfo_names

# {{{ table_names

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start table_names
      {
        # Usage:
        #
        #    @tableNames = @{$modobj -> table_names};
        #
        # This basic usage takes no arguments and returns the value of
        # the FILE option in the $TABLE NONMEM record of each
        # problem. @tableNames will be a two dimensional array:
        #
        #   [[tableName_prob1][tableName_prob2][tableName_prob3]...]
        #
        #
        # If the I<new_names> argument of table_names is given, the
        # values of the FILE options will be changed.
        #
        # To set the FILE of specific problems, the I<problem_numbers>
        # argument can be used. It should be a reference to an array
        # containing the numbers of all problems where the FILE should
        # be changed or retrieved.  If specified, the size of
        # I<new_names> must be the same as the size of
        # I<problem_numbers>.
        #
        # The I<ignore_missing_files> boolean argument can be used to
        # set names of table that does not exist yet (e.g. before a
        # run has been performed).

        my ( $name_ref, $junk ) = $self -> 
          _option_val_pos( name            => 'FILE',
                           record_name     => 'table',
                           problem_numbers => \@problem_numbers,
                           new_values      => \@new_names );
        if ( $#new_names >= 0 ) {
          my @problems = @{$self -> {'problems'}};
          unless( $#problem_numbers > 0 ){
            @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
          }
          foreach my $i ( @problem_numbers ) {
            $problems[$i-1] -> _read_table_files( ignore_missing_files => $ignore_missing_files || $self -> {'ignore_missing_output_files'});
          }
        }
        @names = @{$name_ref};
      }
end table_names

# }}} table_names

# {{{ table_files

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start table_files
      {
        # Usage:
        #
        #    @table_files = @{$modobj -> table_files};
        #
        # This basic usage takes no arguments and returns the table
        # files objects for all problems.  @table_files will be a
        # two dimensional array:
        #
        #   [[table_file_object_prob1][table_file_object_prob2]...]
        #
        #
        # To retrieve the table file objects from specific problems,
        # the I<problem_numbers> argument can be used. It should be
        # a reference to an array containing the numbers of all
        # problems from which the table file objects should be
        # retrieved.

        unless( $#problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        my @problems = @{$self -> {'problems'}};
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
            push( @table_files, $problems[$i-1] -> table_files );
          } else {
            'debug' -> die( message => "Problem number $i does not exist!" );
          }
        }
      }
end table_files

# }}}

# {{{ units

=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start units
      {
          # Sets or gets the units of a (number of) parameter(s). The
          # unit is not a proper NONMEM syntax but is recognized by
          # the PsN model class. A unit (and a label) can be specified
          # as a comments after a parameter definition. e.g.:
          #
          #    $THETA (0,13.2,100) ; MTT; h
          #
          # which will give this theta the label I<MTT> and unit I<h>.
        @units = @{ $self -> _init_attr( parameter_type    => $parameter_type,
                                         parameter_numbers => \@parameter_numbers,
                                         problem_numbers           => \@problem_numbers,
                                         new_values        => \@new_values,
                                         type              => 'unit')};
      }
end units

# }}} units

# {{{ update_inits


=head2 fractions

Usage:

=for html <pre>

my $fractions = $model_object -> fractions;

=for html </pre>

Arguments:

=over 2

=item colunm

number

=item column_head

string

=item problem_number

integer

=item return_occurences

boolean

=item ignore_missing

boolean

=back

Description:

fractions will return the fractions from data::fractions. It will find
"column_head" in the $INPUT record instead of that data header as
data::fractions does.

=cut

start update_inits
      {
        # Usage:
        #
        #   $modobj -> update_inits ( from_output => $outobj );
        #
        # alt
        #
        #   $modobj -> update_inits ( from_output_file => $outfile );
        #
        # This basic usage takes the parameter estimates from the
        # output object I<$outobj> or from the output file I<$outfile>
        # and updates the initial estimates in the model object
        # I<$modobj>. The number of problems and parameters must be
        # the same in the model and output objects. If there exist
        # more than one subproblem per problem in the output object,
        # only the estimates from the first subproblem will be
        # transferred.
        #
        #   $modobj -> update_inits ( from_output               => $outobj,
        #                             ignore_missing_parameters => 1 );
        #
        # If the ignore_missing_parameters argument is set to 1, the number of
        # parameters in the model and output objects do not need to match. The
        # parameters that exist in both objects are used for the update of the
        # model object.
        #
        #   $modobj -> update_inits ( from_output               => $outobj,
        #                             from_model                => $from_modobj );
        #
        # If the from_model argument is given, update_inits tries to match the
        # parameter names (labels) given in $from_modobj and $modobj and
        # and thereafter updating the $modobj object. See L</units> and L</labels>.
        #

        my ( %labels, @own_labels, @from_labels );
        'debug' -> die( message => "No output object defined and" . 
                      " no output object found through the model object specified." )
            unless ( ( defined $from_model and 
                       ( defined $from_model -> outputs and 
                         defined @{$from_model -> outputs}[0] ) ) or
                     defined $from_output or
                     defined $from_output_file );
        if ( defined $from_output ) {
          'debug' -> warn( level   => 2,
                         message => "using output object ".
                         "specified as argument\n" );
        } elsif ( defined $from_output_file ) {
          $from_output = output -> new( filename             => $from_output_file );
        } else {
          $from_output = @{$from_model -> outputs}[0];
        }

        my @params = ();
        if( $update_thetas ){
          push( @params, 'theta' );
        }
        if( $update_omegas ) {
          push( @params, 'omega' );
        }
        if( $update_sigmas ) {
          push( @params, 'sigma' );
        }

        foreach my $param ( @params ) {
          # Get own labels and from labels
          if ( defined $from_model ) {
            @own_labels = @{$self -> labels( parameter_type => $param )};

            @from_labels = @{$from_model -> labels( parameter_type => $param )};
            'debug' -> die( message => "The number of problems are not the same in from-model ".
                            $from_model -> full_name." (".
                            ($#from_labels+1).")".
                            " and the model to be updated ".
                            $self -> full_name." (".
                            ($#own_labels+1).")" ) unless ( $#own_labels == $#from_labels );
          } else {
            @own_labels = @{$self -> labels( parameter_type => $param,
                                             generic        => 1 )};
            @from_labels = @{$from_output -> labels( parameter_type => $param )};
            'debug' -> die( message => "The number of problems are not the same in from-output ".
                            $from_output -> full_name." (".
                            ($#from_labels+1).")".
                            " and the model to be updated ".
                            $self -> full_name." (".
                            ($#own_labels+1).")" ) unless ( $#own_labels == $#from_labels );
          }

          # Loop over the problems:
          my $accessor = $param.'s';
          # Since initial estimates are specified on the problem level and not on
          # the subproblem level we use the estimates from the outputs first subproblem
          my @from_values = @{$from_output -> $accessor ( subproblems => [1] )};
          # {{{ Omega and Sigma update section

          # The functionality that has been commented out because it
          # fails when omegas are zero. This functionality should be
          # moved to output::problem::subproblem (2005-02-09) TODO

#         if ($param eq 'omega' or $param eq 'sigma')
#         {
#           #print "FL: ", Dumper @from_labels; 
#           #print "OL: ", Dumper @own_labels; 
#           print "FV: $param Before " . Dumper(@from_values) . "\n"; 
#           #Fix omegas and sigmas so that the correlation between elements <=1
#           my $raw_accessor = "raw_" . $accessor;
#           my @raw_from_values = @{$from_output -> $raw_accessor(subproblems => [1])};
#           my ($i,$j);
#           for (my $a=0; $a<scalar(@from_values); $a++)
#           {
#             my $prob_values = $from_values[$a];
#             my $raw_prob_values = $raw_from_values[$a];
#             for (my $b=0; $b<scalar(@{$prob_values}); $b++)
#             {
#               my $values = $prob_values->[$b];
#               my $raw_values = $raw_prob_values->[$b];
#               my $counter = 0;
#               #Find out the n*n-matrix size (pq-formula)
#               my $n = int(sqrt(1/4+scalar(@{$raw_values})*2)-1/2);
#               for ($i=0; $i<$n; $i++)
#               {
#                 for ($j=0; $j<$n; $j++)
#                 {
#                   if ( $j<=$i && $raw_values->[$i*($i+1)/2+$j]!=0 )
#                   {
#                     #print "Omega value = " . @other_val[$counter]  . "\n";
#                     $counter++;
#                   }
#                   #Only check the low-triangular off-diagonals of the omega matrix
#                   #omega(i,j)>=sqrt(omega(i,i)*omega(j,j))
#                   if ($j<=$i && $j!=$i &&
#                       ($raw_values->[$i*($i+1)/2+$j]>=sqrt(
#                                                            $raw_values->[$i*($i+1)/2+$i]*$raw_values->[$j*($j+1)/2+$j])))
#                   {
#                     print "Changing raw value at $i, $j: " . $raw_values->[$i*($i+1)/2+$j] ." to ".
#                         (int(10000*sqrt($raw_values->[$i*($i+1)/2+$i]*$raw_values->[$j*($j+1)/2+$j]))/10000) ."\n";
#                     #print "At index ($i,$j)\n" if ($self->{'debug'});
#                     $raw_values->[$i*($i+1)/2+$j]=int(10000*sqrt(
#                                                                  $raw_values->[$i*($i+1)/2+$i]*$raw_values->[$j*($j+1)/2+$j]))/10000;
#                     print "Changing omega value " . $values->[$counter-1] . " to " . $raw_values->[$i*($i+1)/2+$j] ."\n";
#                     $values->[$counter-1] = $raw_values->[$i*($i+1)/2+$j];
#                   }
#                 }
#               }
#             }
#           }
#           #print "FL: ", Dumper @from_labels; 
#           #print "OL: ", Dumper @own_labels; 
#           print "FV: $param After ", Dumper(@from_values), "\n"; 
#           die;
#         }

          # }}}

          for ( my $i = 0; $i <= $#own_labels; $i++ ) {

            if( $from_output -> have_user_defined_prior ){
              $ignore_missing_parameters = 1;
            }
            unless ( $ignore_missing_parameters ) {
              my $from_name = defined $from_model ? $from_model -> filename :
                $from_output -> filename;
              'debug' -> die( message => "Model -> update_inits: The number of ".$param.
                              "s are not the same in from-model (" . $from_name .
                              "): " . scalar @{$from_labels[$i]} . 
                              ", and the model to be updated (" . $self -> {'filename'} .
                              "): " . scalar @{$own_labels[$i]} )
                  unless ( scalar @{$own_labels[$i]} ==
                           scalar @{$from_labels[$i]} );
            }

            for ( my $j = 0; $j < scalar @{$from_labels[$i]}; $j++ ) {
              for ( my $k = 0; $k < scalar @{$own_labels[$i]}; $k++ ) {
                if ( $from_labels[$i][$j] eq $own_labels[$i][$k] ){
                  $labels{$k+1} = $from_values[$i][0][$j];
                }
              }
            }

            my @own_idxs = keys( %labels );
            my @from_vals;
            for(my $i=0; $i <= $#own_idxs; $i++){
              @from_vals[$i] = $labels{ $own_idxs[$i] };
            }

            $self -> initial_values( problem_numbers           => [$i+1],
                                     parameter_type    => $param,
                                     parameter_numbers => [\@own_idxs],
                                     new_values        => [\@from_vals] );
          }
        }
      }
end update_inits

# }}} update_inits

# {{{ upper_bounds

start upper_bounds
      {
        # upper_bounds either sets or gets the initial values of the
        # parameter specified in I<parameter_type> for each
        # subproblem specified in I<problem_numbers>. For each
        # element in I<problem_numbers> there must be an array in
        # I<parameter_numbers> that specify the indices of the
        # parameters in the subproblem for which the upper bounds
        # are set, replaced or retrieved.

        @upper_bounds = @{ $self -> _init_attr
                             ( parameter_type    => $parameter_type,
                               parameter_numbers => \@parameter_numbers,
                               problem_numbers           => \@problem_numbers,
                               new_values        => \@new_values,
                               attribute         => 'upbnd')};
      }
end upper_bounds

# }}} upper_bounds

# {{{ clean_extra_data_code
start clean_extra_data_code
    {

      # This method cleans out old code for extra data. It searches
      # all subroutine statements in all problems for external
      # subroutines named "get_sub" and "reader" which are added by
      # "add_extra_data_code".

      foreach my $problem( @{$self -> {'problems'}} ){
        if ( defined $problem -> subroutines and defined $problem -> subroutines -> [0] -> options) {
          foreach my $option ( @{$problem -> subroutines -> [0] -> options} ){
            if( lc($option -> name) eq 'other'){
              if( lc($option -> value) =~ /get_sub|reader/  ){

                # If we find "get_sub" or "reader" we remove
                # everything between "IMPORTING COVARIATE DATA" and
                # "IMPORTING COVARIATE DATA END" by finding the
                # indexes in the code array and and splicing it out.
                
                my $code;
                if( $problem -> pks ){
                  # If the code is in a pk block:
                  $code = $problem -> pks -> [0] -> code;
                } else {
                  $code = $problem -> preds -> [0] -> code;
                }
                
                my $start_idx;
                my $end_idx;
                for( my $i = 0; $i <= $#{$code}; $i++ ){
                  if( $code -> [$i] eq ";***IMPORTING COVARIATE DATA*******\n" ){
                    $start_idx = $i-1;
                  }
                  if( $code -> [$i] eq ";***IMPORTING COVARIATE DATA END***\n" ){
                    $end_idx = $i+1;
                  }
                }
                @{$code} = ( @{$code}[0..$start_idx] , @{$code}[$end_idx..$#{$code}] );

                if( $problem -> pks ){
                  # Put the cut down code back in the right place:
                  $problem -> pks -> [0] -> code( $code );
                } else {
                  $problem -> preds -> [0] -> code( $code );
                }
                
                last;
              }
            }
          }
        }
      }
    }
end clean_extra_data_code
# }}} clean_extra_data_code

# {{{ add_extra_data_code

start add_extra_data_code
      {
      # This method adds fortran code that will handle wide datasets
      # (that is data sets with more than 20 columns). It adds code to
      # each problems pk or pred.

      my @code_lines;

      # Get the headers of the columns that have been moved to another
      # data file.

#      unless( defined $self -> extra_data_headers ){
#       die "ERROR model::add_extra_data_code: No headers for the extra data file\n";
#      }

      # extra_data_headers is a two dimensional array. One array of
      # headers for each problem in the modelfile.
      for( my $i = 0; $i <= $#{$self -> {'problems'}}; $i++ ){
        if ( defined $self -> {'problems'} -> [$i] -> {'extra_data_header'} ) {
          my $problem_headers = $self -> {'problems'} -> [$i] -> {'extra_data_header'};

          my $length = 0;
          my @headers;
          my $header_string;
          # Loop over the problem specific headers and make a string
          # that will go into the fortran code. Assume that the
          # first column holds the ID, hence the $i=1
          for (my $i = 1; $i <= $#{$problem_headers}; $i++ ) {
            my $header = $problem_headers -> [$i];
            push( @headers, $header );
            # Chopp the string at 40 characters, to be nice to g77 :)
            if ( $length + length($header) > 40 ) {
              $header_string .= "\n\"&  ";
              $length = 0
            }
            if ( $i < $#{$problem_headers} ) {
              $header_string .= 'I' . $header . ', ';
              $length += length( 'I' . $header . ', ' );
            } else {
              $header_string .= 'I' . $header;
              $length += length( 'I' . $header );
            }
          }

          my @code_lines = ('',
                            ';***IMPORTING COVARIATE DATA*******',
                            '"  FIRST',
                            '"  REAL CURID, MID,',
                            '"&  '.$header_string,
                            '"  LOGICAL READ',
                            '"',
                            '"  IF (.NOT.READ) THEN',
                            '"    CALL READER()',
                            '"    CURID = 1',
                            '"    READ = .TRUE.',
                            '"    END IF',
                            '"',
                            '"  IF (NEWIND.LT.2) THEN',
                            '"    CALL GET_SUB (NEWIND,ID,CURID,MID,',
                            '"&  '.$header_string. ')',
                            '"  END IF',
                            '  CID = MID',
                            '  IF (CID.NE.ID) THEN',
                            '    PRINT *, \'ERROR CHECKING FAILED, CID = \', CID ,\' ID = \', ID',
                            '  END IF',
                            '');

          foreach my $header ( @headers ) {
            push( @code_lines, "  $header = I$header" );
          }

          push( @code_lines, (';***IMPORTING COVARIATE DATA END***','','') );

          my $problem = $self -> {'problems'} -> [$i];
          if ( defined $problem -> {'subroutines'} ) {
            $problem -> subroutines -> [0] -> _add_option( option_string => 'OTHER=get_sub' . $i );
            $problem -> subroutines -> [0] -> _add_option( option_string => 'OTHER=reader' . $i );
          } else {
            $problem -> add_records( type => 'subroutines', record_strings => ['OTHER=get_sub', 'OTHER=reader'] );
          }

          if ( defined $problem -> pks ) {
            unshift( @{$problem -> pks -> [0] -> code}, join("\n", @code_lines ));
          } else {
            unshift( @{$problem -> preds -> [0] -> code},join("\n", @code_lines ));
          }
        }
      }
    }
end add_extra_data_code

# }}}

# {{{ drop_dropped

start drop_dropped
      {
        for( my $i = 0; $i < scalar @{$self -> {'problems'}}; $i++ ) {
          $self -> {'datas'}[$i] -> drop_dropped( model_header => $self -> {'problems'}[$i] -> header );
          $self -> {'problems'}[$i] -> drop_dropped( );
          #$self -> {'datas'}[$i] -> model_header( $self -> {'problems'}[$i] -> header );
        }
      }
end drop_dropped

# }}} drop_dropped

# {{{ wrap_data

start wrap_data
      {
        my $default_wrap = 18;

        $self -> drop_dropped(1);

        my ( @wrap_columns, @cont_columns );
        if ( not defined $wrap_column ) {
          for( my $i = 0; $i < scalar @{$self -> {'problems'}}; $i++ ) {
            my $columns = scalar @{$self -> {'problems'}[$i] -> dropped_columns}-1; #skip ID
            my $modulus = $columns%($default_wrap-2); # default_wrap-2 to account for ID and CONT
            my $rows = (($columns-$modulus)/($default_wrap-2))+1;
            if ( $rows == 1 ) {
              push( @wrap_columns, undef );
            } else {
              push( @wrap_columns, (ceil( $columns/$rows )+2) ); #Must use #cols + ID and CONT
            }
          }
        } else {
          for( my $i = 0; $i < scalar @{$self -> {'problems'}}; $i++ ) {
            push( @wrap_columns, $wrap_column );
          }
        }

        for( my $i = 0; $i < scalar @{$self -> {'problems'}}; $i++ ) {
          next if ( not defined $wrap_columns[$i] );
          $wrap_column = $wrap_columns[$i];
          $cont_column = $wrap_columns[$i] if( not defined $cont_column );
          my ( $prim, $sec ) = 
            $self -> {'datas'}[$i] -> wrap( cont_column  => $cont_column,
                                            wrap_column  => $wrap_column,
                                            model_header => $self -> {'problems'}[$i] -> header );
          $self -> {'problems'}[$i] -> primary_columns( $prim );
          $self -> {'problems'}[$i] -> secondary_columns( $sec );
          $self -> {'data_wrapped'}++;
        }
      }
end wrap_data

# }}} wrap_data

# {{{ unwrap_data
start unwrap_data
      {
        for( my $i = 0; $i < scalar @{$self -> {'problems'}}; $i++ ) {
          $self -> {'datas'}[$i] -> unwrap;
          $self -> {'problems'}[$i] -> primary_columns( [] );
          $self -> {'problems'}[$i] -> secondary_columns( [] );
        }
        $self -> {'data_wrapped'} = 0;
      }
end unwrap_data
# }}} unwrap_data

# {{{ write_get_subs

start write_get_subs
    {
      for( my $i = 0; $i <= $#{$self -> {'problems'}}; $i++ ){
        if ( defined $self -> {'problems'} -> [$i] -> {'extra_data_header'} and 
             defined $self -> problems -> [$i] -> extra_data ) {
          my @problem_header = @{$self -> {'problems'} -> [$i] -> {'extra_data_header'}};
          my @headers;
          my $length = 0;
          my $header_string;

          my $rows = $self -> problems -> [$i] -> extra_data -> count_ind;

          # Assume that first column holds the ID. Get rid of it.
          shift( @problem_header );
          for ( my $i = 0; $i <= $#problem_header; $i++ ) {
            my $header = $problem_header[$i];
            push( @headers, $header );
            # Chop the string at 40 characters, to be nice to g77 :)
            if ( $length + length($header) > 40 ) {
              $header_string .= "\n     &  ";
              $length = 0
            }
            if ( $i < $#problem_header ) {
              $header_string .= $header . ', ';
              $length += length( $header . ', ' );
            } else {
              $header_string .= $header;
              $length += length( $header );
            }
          }

          open( FILE, '>', 'get_sub' . $i . '.f' );
          print FILE ("      SUBROUTINE GET_SUB (NEWIND,ID,CURID,MID,\n",
                      "     &  $header_string)\n",
                      "      COMMON /READ/ TID,TCOV\n",
                      "\n",
                      "      REAL ID,CURID,MID,\n",
                      "     &  $header_string\n",
                      "\n",
                      "      INTEGER NEWIND\n",
                      "\n",
                      "      REAL TID($rows), TCOV($rows,",scalar @problem_header,")\n",
                      "      CURID = 1\n",
                      "\n",
                      "C     START AT TOP EVERY TIME\n",
                      "      IF (NEWIND.EQ.1) THEN \n",
                      "12      CONTINUE\n",
                      "        IF (CURID.GT.$rows) THEN \n",
                      "          PRINT *, \"Covariate data not found for\", ID\n",
                      "          MID = -9999\n",
                      "          RETURN\n",
                      "        END IF\n",
                      "\n",
                      "        IF (ID.GT.TID (CURID)) THEN\n",
                      "          CURID = CURID + 1\n",
                      "          GOTO 12\n",
                      "        END IF\n",
                      "      ELSEIF (NEWIND.EQ.0) THEN\n",
                      "        CURID = 1\n",
                      "      END IF\n",
                      "\n" );
          my $length = 0;
          for ( my $i = 1; $i <= $#headers+1; $i++ ) {
            $length += length("TCOV(I,$i),");
            if ( $length > 40 ) {
              print FILE "\n";
              $length = 0;
            }
            print FILE "      ".$headers[$i-1] . "  = TCOV(CURID,$i)\n";
          }

          print FILE ("      MID  = TID(CURID)\n",
                      "      END\n",
                      "\n" );

          close FILE;
        }
      }
      close( FILE );
    }
end write_get_subs

# }}}

# {{{ write_readers

start write_readers
    {
      for( my $i = 0; $i <= $#{$self -> {'problems'}}; $i++ ){
        if ( defined $self -> {'problems'} -> [$i] -> {'extra_data_header'} and 
             defined $self -> {'problems'} -> [$i] -> {'extra_data'} ) {
          my @problem_header = @{$self -> {'problems'} -> [$i] -> {'extra_data_header'}};
          my @headers;
          my $length = 0;

          my $rows = $self -> problems -> [$i] -> extra_data -> count_ind;
          my $filename = $self -> problems -> [$i] -> extra_data -> filename;
          # Assume that first column holds the ID. Get rid of it.
          shift( @problem_header );

          'debug' -> warn( level   => 2,
                           message => "Writing reader".$i.".f to directory".cwd );
          open( FILE, '>', 'reader' . $i . '.f' );
          print FILE ("      SUBROUTINE READER()\n",
                      "\n",
                      "      COMMON /READ/ TID,TCOV\n",
                      "\n",
                      "      REAL TID ($rows), TCOV ($rows, ",scalar @problem_header,")\n",
                      "\n",
                      "      OPEN (UNIT = 77,FILE = '$filename')\n",
                      "      REWIND 77\n",
                      "      DO 11,I = 1,$rows\n",
                      "        READ (77,*) TID(I)," );

          my $length = 0;
          for ( my $i = 1; $i <= $#problem_header+1; $i++ ) {
            $length += length("TCOV(I,$i),");
            if ( $length > 40 ) {
              print FILE "\n     &  ";
              $length = 0;
            }
            if ( $i <= $#problem_header ) {
              print FILE "TCOV(I,$i),";
            } else {
              print FILE "TCOV(I,$i)\n";
            }
          } 

          print FILE ( "11      CONTINUE\n", 
                       "      END\n" );
        }
      }
    }
end write_readers

# }}}

# {{{ _write

start _write
      {
        # 
        # $model -> _write( filename => 'model.mod' );
        #
        # Writes the content of the modelobject to disk. Either to the
        # filename given, or to the string returned by model::full_name.

        my @formatted;

        # An element in the active_problems array is a boolean that
        # corresponds to the element with the same index in the problems
        # array.  If the boolean is true, the problem will be run. All
        # other will be commented out.
        my @active = @{$self -> {'active_problems'}};

        # loop over all problems.
        for ( my $i = 0; $i < scalar @{$self -> {'problems'}}; $i++ ) {
          # Call on the problem object to format it as text. The
          # filename and problem numbers are needed to make some
          # autogenerated files (msfi, tabels etc...) unique to the
          # model and problem
          my @preformatted = @{$self -> {'problems'} -> [$i] ->
                                   _format_problem( filename => $self -> filename,
                                                    problem_number => ($i+1) ) };
          # Check if the problem is NOT active, if so comment it out.
          unless ( $active[$i] ) {
            for ( my $j = 0; $j <= $#preformatted; $j++ ) {
              $preformatted[$j] = '; '.$preformatted[$j];
            }
          }
          # Add extra line to avoid problems with execution of NONMEM
          push(@preformatted,"\n");
          push( @formatted, @preformatted );
        }

        # Open a file and print the formatted problems.
        # TODO Add some errorchecking.
        open( FILE, '>'. $filename );
        for ( @formatted ) {
          chomp;
          print FILE;
          print FILE "\n";
        }
        close( FILE );

        if ( $write_data ) {
          foreach my $data ( @{$self -> {'datas'}} ) {
            $data -> _write;
          }
        }

        if( $self -> {'iofv_modules'} ){
          $self -> {'iofv_modules'} -> [0] -> post_process;
        }

      }
end _write

# }}} _write

# {{{ filename
start filename
      {
        if ( defined $parm and $parm ne $self -> {'filename'} ) {
          $self -> {'filename'} = $parm;
          $self -> {'model_id'} = undef;
#         $self -> _write;
        }
      }
end filename
# }}} filename

# {{{ _get_option_val_pos

start _get_option_val_pos
      {
        # Usage:
        #
        #   ( $values_ref, $positions_ref ) ->
        #               _get_option_val_pos ( name        => 'ID',
        #                                     record_name => 'input' );
        #   my @values = @{$values_ref};
        #   my @positions = @{$positions_ref};
        #
        # This basic usage returns the name of the third option in the first
        # instance of the record specified by I<record_name> for all problems
        #
        # If global_position is set to 1, only one value and position
        # pair is returned per problem. If there are more than one
        # match in the model; the first will be returned for each
        # problem.
        #
        # Private method, should preferably not be used outside model.pm
        
#       my ( @records, @instances );
        my $accessor = $record_name.'s';
        my @problems = @{$self -> {'problems'}};
        unless( $#problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        foreach my $i ( @problem_numbers ) {
          my $rec_ref = $problems[ $i-1 ] -> $accessor;
          if ( defined $problems[ $i-1 ] and defined $rec_ref ) {
            my @records = @{$rec_ref};
            unless( $#instances > 0 ){
              @instances = (1 .. $#records+1);
              
            }
            my @inst_values    = ();
            my @inst_positions = ();
            my $glob_pos = 1;
            my ( $glob_value, $glob_position );
INSTANCES:  foreach my $j ( @instances ) {
              if ( defined $records[ $j-1 ] ) {
                my $k = 1;
                my ( $value, $position );
                foreach my $option ( @{$records[$j-1] -> {'options'}} ) {
                  if ( defined $option and $option -> name eq $name) {
                    if ( $global_position ) {
                      $glob_value = $option -> value;
                      $glob_position = $glob_pos;
                      last INSTANCES;
                    } else {
                      $value = $option -> value;
                      $position = $k;
                    }
                  }
                  $k++;
                  $glob_pos++;
                }
                push( @inst_values, $value );
                push( @inst_positions, $position );
              } else {
                'debug' -> die( message => "Instance $j in problem number $i does not exist!" )
              }
            }
            if ( $global_position ) {
              push( @values, $glob_value );
              push( @positions, $glob_position );
            } else {
              push( @values, \@inst_values );
              push( @positions, \@inst_positions );
            }
          } else {
            'debug' -> die( message => "Problem number $i does not exist!" );
          }
        }
#       if( defined $problem_number ) {
#         if( $problem_number < 1 or $problem_number > scalar @problems ) {
#           die "model -> _get_option_val_pos: No such problem number, ",
#             $problem_number,", in this model!\n";
#         }
#       }
#       my $i;
#       die "modelfile -> _get_option_val_pos: No problem $problem_number exists\n"
#         if( (scalar @problems < 1) and ($problem_number ne 'all') );
#       my $j = 1;
#       foreach my $problem ( @problems ) {
#         @records = @{$problem -> $accessor};
#         @records = ($records[$instance-1]) if ( $instance ne 'all' );
#         die "modelfile -> _get_option_val_pos: No record instance $instance ".
#           "of record $record_name in problem $problem_number exists\n" 
#             if( (scalar @records < 1) and ($instance ne 'all') );
#         foreach my $record ( @records ) {
#           $i = 1;
#           foreach my $option ( @{$record -> {'options'}} ) {
#             if ( defined $option and $option -> name eq $name) {
#               print "Found $name at $i\n" if ( $self -> {'debug'} );
#               push( @values, $option -> value );
#               push( @positions, $i );
#             }
#             $i++;
#           }
#         }
#       }
      }
end _get_option_val_pos

# }}} _get_option_val_pos

# {{{ _init_attr

start _init_attr
      {
        # The I<add_if_absent> argument tells the method to add an init (theta,omega,sigma)
        # if the parameter number points to a non-existing parameter with parameter number
        # one higher than the highest presently included. Only applicatble if
        # I<new_values> are set. Default value = 0;
        
        unless( scalar @problem_numbers > 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        my @problems = @{$self -> {'problems'}};
        if ( $#new_values >= 0 ) {
          'debug' -> die( message => "The number of new value sets " . 
                          ($#new_values+1) . " do not" . 
                          " match the number of problems " . ($#problem_numbers+1) . " specified" )
              unless(($#new_values == $#problem_numbers) );
          if ( $#parameter_numbers > 0 ) {
            'debug' -> die( message => "The number of parameter number sets do not" .
                            " match the number of problems specified" )
                unless(($#parameter_numbers == $#problem_numbers) );
          }
        }

        my $new_val_idx = 0;
        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
            if ( scalar @new_values > 0) {
              # {{{ Update values
              # Use attribute parameter_values to collect diagnostic outputs
              push( @parameter_values,
                    $problems[ $i-1 ] ->
                    _init_attr( parameter_type    => $parameter_type,
                                parameter_numbers => $parameter_numbers[ $new_val_idx ],
                                new_values        => \@{$new_values[ $new_val_idx ]},
                                attribute         => $attribute,
                                add_if_absent     => $add_if_absent ) );
              # }}} Update values
            } else {
              # {{{ Retrieve values
              push( @parameter_values,
                    $problems[ $i-1 ] ->
                    _init_attr( parameter_type    => $parameter_type,
                                parameter_numbers => $parameter_numbers[ $i-1 ],
                                attribute         => $attribute ) );
              # }}} Retrieve values
            }
          } else {
            'debug' -> die( message => "Problem number $i does not exist!" );
          }
          $new_val_idx++;
        }
      }
end _init_attr

# }}} _init_attr

# {{{ _option_name

start _option_name
      {
        # Usage:
        #
        #   $modobj -> _option_name ( record   => $record_name,
        #                             position => 3 );
        #
        # This basic usage returns the name of the third option in the first
        # instance of the record specified by I<record>.
        #

        my ( @problems, @records, @options, $i );
        my $accessor = $record.'s';
        if ( defined $self -> {'problems'} ) {
          @problems = @{$self -> {'problems'}};
        } else {
          'debug' -> die( message => "No problems defined in model" );
        }
        if ( defined $problems[$problem_number - 1] -> $accessor ) {
          @records = @{$problems[$problem_number - 1] -> $accessor};
        } else {
          'debug' -> die( message => "No record $record defined in ".
                          "problem number $problem_number." );
        }
        if ( defined $records[$instance - 1] -> options ) {
          @options = @{$records[$instance - 1] -> options};
        } else {
          'debug' -> die( message => "model -> _option_name: No option defined in record ".
                          "$record in problem number $problem_number." );
        }
        $i = 0;
        foreach my $option ( @options ) {
          if ( $i == $position ) {
            if ( defined $new_name ){
              $option -> name($new_name) if ( defined $option );
            }else{
              $name = $option -> name if ( defined $option );
            }
          }
          $i++;
        }
      }
end _option_name

# }}} _option_name

# {{{ _parameter_count
start _parameter_count
      {
        if( defined $self -> {'problems'} ){
          my $problems = $self -> {'problems'};
          if( defined @{$problems}[$problem_number - 1] ){
            $count = @{$problems}[$problem_number - 1] -> record_count( 'record_name' => $record );
          }
        }
      }
end _parameter_count
# }}} _parameter_count

# {{{ _read_problems

start _read_problems
    {

      # To read problems from a modelfile we need its full name
      # (meaning filename and path). And we need an array for the
      # modelfile lines and an array with indexes telling where
      # problems start in the modelfile array.

      
      my $file = $self -> full_name;
      my ( @modelfile, @problems );
      my ( @problem_start_index );
      
      # Check if the file is missing, and if that is ok.
      # TODO Check accessor what happens if the file is missing.

      return if( not (-e $file) && $self -> {'ignore_missing_files'} );

      # Open the file, slurp it and close it
      open( FILE, "$file" ) ||
          'debug' -> die( message => "Model -> _read_problems: Could not open $file".
                        " for reading" );
      @modelfile = <FILE>;
      close( FILE );

      my @extra_data_files   = defined $self ->{'extra_data_files'} ?
          @{$self -> {'extra_data_files'}} : ();
      my @extra_data_headers = defined $self ->{'extra_data_headers'} ?
          @{$self -> {'extra_data_headers'}} : ();


#       # Find the indexes where the problems start
#       for ( my $i = 0; $i <= $#modelfile; $i++ ) {
#       push( @problem_start_index, $i )if ( $modelfile[$i] =~ /\$PROB/ );
#       }

#       # Loop over the number of problems. Copy the each problems lines
#       # and create a problem object.

#       for( my $i = 0; $i <= $#problem_start_index; $i++ ) {
#       my $start_index = $problem_start_index[$i];
#       my $end_index = defined $problem_start_index[$i+1] ? $problem_start_index[$i+1] - 1: $#modelfile ;
#       # Line copy
#       my @problem_lines = @modelfile[$start_index .. $end_index];

#       # Problem object creation.
#       push( @problems, model::problem -> new ( debug                => $self -> {'debug'},
#                                                ignore_missing_files => $self -> {'ignore_missing_files'},
#                                                prob_arr             => \@problem_lines,
#                                                extra_data_file_name => $extra_data_files[$i],
#                                                extra_data_header    => $extra_data_headers[$i]) );

      my $start_index = 0;
      my $end_index;
      my $first = 1;
      my $prob_num = 0;

      # It may look like the loop takes one step to much, but its a
      # trick that helps parsing the last problem.
      for ( my $i = 0; $i <= @modelfile; $i++ ) {
        if( $i <= $#modelfile ){
          $_ = $modelfile[$i];
        }
        
        # In this if statement we use the lazy evaluation of logical
        # or to make sure we only execute search pattern when we have
        # a line to search. Which is all cases but the very last loop
        # iteration.

        if( $i > $#modelfile or /\$PROB/ ){
          $end_index = $i;
          
          # The if statement here is only necessary in the first loop
          # iteration. When start_index == end_index == 0 we want to
          # skip to the next iteration looking for the actual end of
          # the first problem.
          
          if( $end_index > $start_index and not $first ){
            # extract lines of code:
            my @problem_lines = @modelfile[$start_index .. $end_index-1];           
            # reset the search for problems by moving the problem start
            # forwards:
            $start_index = $i;
            
            my $sh_mod = model::shrinkage_module -> new ( model   => $self,
                                                          temp_problem_number => ($#problems+2));
            my $prob = model::problem ->
                new ( directory                   => $self -> {'directory'},
                      ignore_missing_files        => $self -> {'ignore_missing_files'},
                      ignore_missing_output_files => $self -> {'ignore_missing_output_files'},
                      sde                         => $self -> {'sde'},
                      cwres                       => $self -> {'cwres'},
                      mirror_plots                => $self -> {'mirror_plots'},
                      nm_version                  => $self -> {'nm_version'},
                      prob_arr                    => \@problem_lines,
                      extra_data_file_name        => $extra_data_files[$prob_num],
                      extra_data_header           => $extra_data_headers[$prob_num],
                      shrinkage_module            => $sh_mod );
            push( @problems, $prob );
            if ( $self -> cwres() ) {
              my @eo;
              if ( defined $self -> extra_output() ) {
                @eo = @{$self -> extra_output()};
              }
              if( $prob -> {'cwres_modules'} ){
                push( @eo, @{$prob -> {'cwres_modules'} -> [0] -> cwtab_names()} );
              }
              $self -> extra_output( \@eo );
            }

            $sh_mod -> problem( $problems[$#problems] );
            $prob_num++;
          }
          $first = 0;
        }  
      }
      
      # Set the problems in the modelobject.
      $self -> problems(\@problems);
    }
end _read_problems

# }}} _read_problems

# {{{ set_option

start set_option

unless( $#problem_numbers >= 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}

my @problems = @{$self -> {'problems'}};
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    my $found = $self -> is_option_set( 'problem_number' => $i,
                                        'record'         => $record_name,
                                        'name'           => $option_name,
                                        'fuzzy_match'    => $fuzzy_match );
    $problems[$i-1] -> remove_option( record_name  => $record_name,
                                      option_name  => $option_name,
                                      fuzzy_match  => $fuzzy_match ) if ( $found );
    $problems[$i-1] -> add_option( record_name  => $record_name,
                                   option_name  => $option_name,
                                   option_value => $option_value );
  }
}

end set_option

# }}} set_option

# {{{ add_option

start add_option

unless( $#problem_numbers >= 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}

my @problems = @{$self -> {'problems'}};
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    $problems[$i-1] -> add_option( record_name  => $record_name,
                                   option_name  => $option_name,
                                   option_value => $option_value,
                                   add_record   => $add_record );
  }
}

end add_option

# }}} add_option

# {{{ remove_option

start remove_option

unless( $#problem_numbers >= 0 ){
  @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
}

my @problems = @{$self -> {'problems'}};
foreach my $i ( @problem_numbers ) {
  if ( defined $problems[ $i-1 ] ) {
    $problems[$i-1] -> remove_option( record_name => $record_name,
                                      option_name => $option_name,
                                      fuzzy_match => $fuzzy_match);
  }
}

end remove_option

# }}} remove_option

# {{{ _option_val_pos

start _option_val_pos
      {
        unless( $#problem_numbers >= 0 ){
          @problem_numbers = (1 .. $#{$self -> {'problems'}}+1);
        }
        my @problems = @{$self -> {'problems'}};
        if ( $#new_values >= 0 ) {
          'debug' -> die( message => "Trying to set option $name in record $record_name but the ".
                          "number of new value sets (".
                          ($#new_values+1).
                          "), do not match the number of problems specified (".
                          ($#problem_numbers+1).")" )
              unless(($#new_values == $#problem_numbers) );
          if ( $#instance_numbers > 0 ) {
              'debug' -> die( message => "The number of instance number sets (".
                              ($#instance_numbers+1).
                              "),do not match the number of problems specified (".
                              ($#problem_numbers+1).")" )
                unless(($#instance_numbers == $#problem_numbers) );
          }
        }

        foreach my $i ( @problem_numbers ) {
          if ( defined $problems[ $i-1 ] ) {
            my $rn_ref = $#instance_numbers >= 0 ? \@{$instance_numbers[ $i-1 ]} : [];
            if ( scalar @new_values > 0) {
              # {{{ Update values

              if( not defined $new_values[ $i-1 ] ) {
                debug -> die( message => " The specified new_values was undefined for problem $i" );
              }

              if( not ref( $new_values[ $i-1 ] ) eq 'ARRAY' ) {
                debug -> die( message => " The specified new_values for problem $i is not an array as it should be but a ".
                              ( defined ref( $new_values[ $i-1 ] ) ?
                                ref( $new_values[ $i-1 ] ) : 'undef' ) );
              }
  
              $problems[ $i-1 ] ->
                _option_val_pos( record_name      => $record_name,
                                 instance_numbers => $rn_ref,
                                 new_values       => \@{$new_values[ $i-1 ]},
                                 name             => $name,
                                 exact_match      => $exact_match );

              # }}} Update values
            } else {
              # {{{ Retrieve values
              my ( $val_ref, $pos_ref ) =
                $problems[ $i-1 ] ->
                  _option_val_pos( record_name      => $record_name,
                                   instance_numbers => $rn_ref,
                                   name             => $name,
                                   exact_match      => $exact_match );
              push( @values, $val_ref );
              push( @positions, $pos_ref );
              # }}} Retrieve values
            }
          } else {
            'debug' -> die( message => "Problem number $i does not exist!" );
          }
        }
      }
end _option_val_pos

# }}} _option_val_pos

# {{{ subroutine_files

start subroutine_files
{
  my %fsubs;
  foreach my $subr( 'PRED','CRIT', 'CONTR', 'CCONTR', 'MIX', 'CONPAR', 'OTHER', 'PRIOR' ){
    my ( $model_fsubs, $junk ) = $self -> _option_val_pos( record_name => 'subroutine',
                                                           name => $subr );
    if( @{$model_fsubs} > 0 ){
      foreach my $prob_fsubs ( @{$model_fsubs} ){
        foreach my $fsub( @{$prob_fsubs} ){
          $fsubs{$fsub} = 1;
        }
      }
    }
  }

  # BUG , nonmem6 might not require the file to be named .f And I've
  # seen examples of files named .txt

  @fsubs = keys %fsubs;
  if( @fsubs > 0  ){
    for( my $i = 0; $i <= $#fsubs; $i ++ ){
      unless( $fsubs[$i] =~ /\.f$/ ){
        $fsubs[$i] .= '.f';
      }
    }
  }
}
end subroutine_files

# }}}