lib/output/problem_subs.pm

   1 # {{{ include
   2
   3 start include statements
   4     # No brackets!
   5         use Data::Dumper;
   6         my $nrec_exp = '^\s*NO. OF DATA RECS IN DATA SET:\s*(\d*)|^\s*TOT. NO. OF DATA RECS:\s*(\d*)';
   7         my $nobs_exp = ' TOT. NO. OF OBS RECS:\s*(\d*)';
   8         my $nind_exp = ' TOT. NO. OF INDIVIDUALS:\s*(\d*)';
   9         my $subprob_exp = '^ PROBLEM NO\.:\s*\d+\s*SUBPROBLEM NO\.:\s*(\d+)';
  10         use Config;
  11 end include
  12
  13 # }}} include statements
  14
  15 # {{{ new
  16
  17 start new
  18       {
  19         # Read Global data
  20         $this -> _read_nrecs();
  21         $this -> _read_nobs()             if ( $this -> parsed_successfully() and not
  22                                                $this -> finished_parsing() );
  23         $this -> _read_nind()             if ( $this -> parsed_successfully() and not
  24                                                $this -> finished_parsing() );
  25         $this -> _read_msfo_status()      if ( $this -> parsed_successfully() and not
  26                                                $this -> finished_parsing() );
  27         $this -> _read_block_structures() if ( $this -> parsed_successfully() and not
  28                                                $this -> finished_parsing() );
  29         $this -> _read_inits()            if ( $this -> parsed_successfully() and not
  30                                                $this -> finished_parsing() );
  31         $this -> _read_eststep()          if ( $this -> parsed_successfully() and not
  32                                                $this -> finished_parsing() );
  33         $this -> _read_nonpstep()         if ( $this -> parsed_successfully() and not
  34                                                $this -> finished_parsing() );
  35         $this -> _read_covstep()          if ( $this -> parsed_successfully() and not
  36                                                $this -> finished_parsing() );
  37         $this -> _read_tablesstep()       if ( $this -> parsed_successfully() and not
  38                                                $this -> finished_parsing() );
  39         $this -> _read_prior()            if ( $this -> parsed_successfully() and not
  40                                                $this -> finished_parsing() );
  41         $this -> _read_steps_allowed()    if ( $this -> parsed_successfully() and not
  42                                                $this -> finished_parsing() );
  43         $this -> _read_subproblems()      if ( $this -> parsed_successfully() and not
  44                                                $this -> finished_parsing() );
  45         my $mes = $this -> parsing_error_message();
  46         if( defined $this -> subproblems() ) {
  47           foreach my $subp ( @{$this -> subproblems()} ) {
  48             $mes .= $subp -> parsing_error_message();
  49             $this -> parsed_successfully($this -> parsed_successfully() *
  50                                          $subp -> parsed_successfully());
  51           }
  52         }
  53
  54         $this -> parsing_error_message( $mes );
  55
  56         if ( defined $this -> {'subproblems'} and $this -> parsed_successfully() ) {
  57           $this -> _set_labels;
  58         }
  59
  60         delete $this -> {'lstfile'};
  61       }
  62 end new
  63
  64 # }}} new
  65
  66 # {{{ parsing_error
  67 start parsing_error
  68     $self -> parsed_successfully( 0 );
  69 $self -> parsing_error_message( $message );
  70 end parsing_error
  71 # }}} parsing_error
  72
  73 # {{{ register_in_database
  74
  75 start register_in_database
  76     if ( $PsN::config -> {'_'} -> {'use_database'} ) {
  77       my ( $date_str, $time_str );
  78       if ( $Config{osname} eq 'MSWin32' ) {
  79         $date_str = `date /T`;
  80         $time_str = ' '.`time /T`;
  81       } else {
  82         # Assuming UNIX
  83         $date_str = `date`;
  84       }
  85       chomp($date_str);
  86       chomp($time_str);
  87       my $date_time = $date_str.$time_str;
  88       my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
  89                                ";databse=".$PsN::config -> {'_'} -> {'project'},
  90                                $PsN::config -> {'_'} -> {'user'},
  91                                 $PsN::config -> {'_'} -> {'password'},
  92                                {'RaiseError' => 1});
  93       my $sth;
  94       my @mod_str = ('','');
  95       if ( defined $self -> {'model_id'} ) {
  96         @mod_str = ('model_id, ',"$self->{'model_id'}, ");
  97       }
  98       $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
  99                                ".oproblem ".
 100                              "(output_id,".
 101                              $mod_str[0].
 102                              "nrecs,nobs,nind) ".
 103                              "VALUES ( '$output_id' ,".
 104                              $mod_str[1].
 105                              "'$self->{'nrecs'}' ".
 106                              ",'$self->{'nobs'}' ,'$self->{'nind'}' )");
 107       $sth -> execute;
 108       $self -> {'problem_id'} = $sth->{'mysql_insertid'};
 109       $sth -> finish;
 110       $dbh -> disconnect;
 111       if ( defined $self -> {'problem_id'} ) {
 112         foreach my $problem ( @{$self -> {'subproblems'}} ) {
 113           $problem -> register_in_database( output_id  => $output_id,
 114                                             problem_id => $self -> {'problem_id'},
 115                                             model_id   => $model_id );
 116         }
 117       }
 118     }
 119 end register_in_database
 120
 121 # }}} register_in_database
 122
 123 # {{{ _read_subproblems
 124 start _read_subproblems
 125     my $subproblem_start;
 126 while ( $_ = @{$self -> {'lstfile'}}[ $self -> {'lstfile_pos'}++ ] ) {
 127   if( /$subprob_exp/ or $self -> {'lstfile_pos'} > $#{$self -> {'lstfile'}} ){
 128     if( defined $subproblem_start ){
 129       my @subproblem_lstfile =
 130           @{$self -> {'lstfile'}}[$subproblem_start .. $self -> {'lstfile_pos'} - 2];
 131       my $subproblems;
 132       if( $self -> {'lstfile_pos'} > $#{$self -> {'lstfile'}} ) {
 133         $subproblems = $2;
 134       } else {
 135         $subproblems = $2 - 1; # Assuming problems come in order
 136       }
 137       $self -> add_subproblem
 138           ( 'init_data' => {lstfile                    => \@subproblem_lstfile,
 139                             estimation_step_initiated  => $self -> estimation_step_initiated(),
 140                             estimation_step_run        => $self -> estimation_step_run(),
 141                             nonparametric_step_run     => $self -> {'nonparametric_step_run'},
 142                             covariance_step_run        => $self -> {'covariance_step_run'},
 143                             msfi_used                  => $self -> msfi_used(),
 144                             omega_block_structure_type => $self -> {'omega_block_structure_type'},
 145                             sigma_block_structure_type => $self -> {'sigma_block_structure_type'},
 146                             omega_block_structure      => $self -> {'omega_block_structure'},
 147                             sigma_block_structure      => $self -> {'sigma_block_structure'},
 148                             omega_block_sets           => $self -> {'omega_block_sets'},
 149                             sigma_block_sets           => $self -> {'sigma_block_sets'},
 150                             estimated_thetas           => $self -> {'estimated_thetas'},
 151                             estimated_omegas           => $self -> {'estimated_omegas'},
 152                             estimated_sigmas           => $self -> {'estimated_sigmas'},
 153 #                                 lower_theta_bounds         => $self -> {'lower_theta_bounds'},
 154 #                                 upper_theta_bounds         => $self -> {'upper_theta_bounds'},
 155                             tablename                  => @{$self -> {'tablenames'}}[$subproblems],
 156                             tableidcolumn              => @{$self -> {'tableidcolumns'}}[$subproblems],
 157                             model_id                   => $self -> {'model_id'},
 158                             problem_id                 => $self -> {'problem_id'},
 159                             output_id                  => $self -> {'output_id'} });
 160     }
 161     unless ( $self -> {'lstfile_pos'} > $#{$self -> {'lstfile'}} ){
 162       $subproblem_start = $self -> {'lstfile_pos'};
 163     }
 164   }
 165 }
 166
 167 unless( defined $subproblem_start ) { # No subproblems. Try to make one from the whole file.
 168   $self -> add_subproblem
 169       ( 'init_data' => {lstfile                    => $self -> {'lstfile'},
 170                         estimation_step_initiated  => $self -> estimation_step_initiated(),
 171                         estimation_step_run        => $self -> estimation_step_run(),
 172                         nonparametric_step_run     => $self -> {'nonparametric_step_run'},
 173                         covariance_step_run        => $self -> {'covariance_step_run'},
 174                         msfi_used                  => $self -> msfi_used(),
 175                         omega_block_structure_type => $self -> {'omega_block_structure_type'},
 176                         sigma_block_structure_type => $self -> {'sigma_block_structure_type'},
 177                         omega_block_structure      => $self -> {'omega_block_structure'},
 178                         sigma_block_structure      => $self -> {'sigma_block_structure'},
 179                         omega_block_sets           => $self -> {'omega_block_sets'},
 180                         sigma_block_sets           => $self -> {'sigma_block_sets'},
 181                         estimated_thetas           => $self -> {'estimated_thetas'},
 182                         estimated_omegas           => $self -> {'estimated_omegas'},
 183                         estimated_sigmas           => $self -> {'estimated_sigmas'},
 184 #                             lower_theta_bounds         => $self -> {'lower_theta_bounds'},
 185 #                             upper_theta_bounds         => $self -> {'upper_theta_bounds'},
 186                         tablename                  => @{$self -> {'tablenames'}}[0],
 187                         tableidcolumn              => @{$self -> {'tableidcolumns'}}[0],
 188                         model_id                   => $self -> {'model_id'},
 189                         problem_id                 => $self -> {'problem_id'},
 190                         output_id                  => $self -> {'output_id'} } );
 191 }
 192
 193 end _read_subproblems
 194 # }}} _read_subproblems
 195
 196 # {{{ _read_nrecs
 197 start _read_nrecs
 198 # The data recs statement should always be present
 199 # Raise parsing error if not found
 200     my $errmess = "Error in reading the number of data records!\n";
 201 my $start_pos = $self -> {'lstfile_pos'};
 202 my $success  = 0;
 203
 204 while ( $_ = @{$self -> {'lstfile'}}[$start_pos++] ) {
 205   if ( /$nobs_exp/ or ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 206     debug -> warn( level => 1,
 207                    message => $errmess."$!" );
 208     $self -> parsing_error( message => $errmess."$!" );
 209     return;
 210   }
 211   if ( /$nrec_exp/ ) {
 212     $self -> nrecs($1);
 213     $success = 1;
 214     last;
 215   }
 216 }
 217 if ( $success ) {
 218   $self -> {'lstfile_pos'} = $start_pos;
 219 } else {
 220     debug -> warn( level => 1,
 221                    message => $errmess."$!" );
 222     $self -> parsing_error( message => $errmess."$!" );
 223 }
 224 end _read_nrecs
 225 # }}} _read_nrecs
 226
 227 # {{{ _read_nobs
 228 start _read_nobs
 229 # The no of obs recs statement should always be present
 230 # Raise parsing error if not found
 231     my $errmess = "Error in reading the number of observation records!\n";
 232 my $start_pos = $self -> {'lstfile_pos'};
 233 my $success  = 0;
 234
 235 while ( $_ = @{$self -> {'lstfile'}}[$start_pos++] ) {
 236   if ( /$nind_exp/ or ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 237     debug -> warn( level => 1,
 238                    message => $errmess."$!" );
 239     $self -> parsing_error( message => $errmess."$!" );
 240     return;
 241   }
 242   if ( /$nobs_exp/ ) {
 243     $self -> nobs($1);
 244     $success = 1;
 245     last;
 246   }
 247 }
 248 if ( $success ) {
 249   $self -> {'lstfile_pos'} = $start_pos;
 250 } else {
 251   debug -> warn( level => 1,
 252                  message => $errmess."$!" );
 253   $self -> parsing_error( message => $errmess."$!" );
 254 }
 255 end _read_nobs
 256 # }}} _read_nobs
 257
 258 # {{{ _read_nind
 259 start _read_nind
 260 # The no of individuals statement should always be present
 261 # Raise parsing error if not found
 262     my $errmess = "Error in reading the number of individuals!\n";
 263 my $start_pos = $self -> {'lstfile_pos'};
 264 my $success  = 0;
 265
 266 while ( $_ = @{$self -> {'lstfile'}}[$start_pos++] ) {
 267   if ( /^0LENGTH OF THETA/ or
 268        /^0MODEL SPECIFICATION FILE INPUT/ or
 269        ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 270     debug -> warn( level => 1,
 271                    message => $errmess."$!" );
 272     $self -> parsing_error( message => $errmess."$!" );
 273     return;
 274   }
 275   if ( /$nind_exp/ ) {
 276     $self -> nind($1);
 277     $success = 1;
 278     last;
 279   }
 280 }
 281 if ( $success ) {
 282   $self -> {'lstfile_pos'} = $start_pos;
 283 } else {
 284   debug -> warn( level => 1,
 285                  message => $errmess."$!" );
 286   $self -> parsing_error( message => $errmess."$!" );
 287 }
 288 end _read_nind
 289 # }}} _read_nind
 290
 291 # {{{ _read_arbitrary
 292
 293 start _read_arbitrary
 294 {
 295     my $start_pos = $self -> {'lstfile_pos'};
 296     my $success  = 0;
 297
 298     while ( $_ = @{$self -> {'lstfile'}}[$start_pos++] ) {
 299         last if ( /^ PROBLEM.*SUBPROBLEM/ or /^ PROBLEM NO\.:\s+\d/ );
 300         if ( /$regexp/ ) {
 301             $self -> { $member } = $1;
 302             $success = 1;
 303             last;
 304         }
 305     }
 306     if ( $success ) {
 307         $self -> {'lstfile_pos'} = $start_pos;
 308     } else {
 309         debug -> warn( level   => 1,
 310                        message => "rewinding to first position..." );
 311     }
 312 }
 313 end _read_arbitrary
 314
 315 # }}} _read_arbitrary
 316
 317 # {{{ _read_msfo_status
 318 start _read_msfo_status
 319 {
 320   my $start_pos = $self -> {'lstfile_pos'};
 321   while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 322
 323     if( /^0SEARCH WITH ESTIMATION STEP WILL NOT PROCEED BEYOND PREVIOUS TERMINATION POINT/ ){
 324       $self -> msfo_has_terminated(1); # Means that $ESTIMATION
 325                                             # must be removed to enable continuation.
 326       $self -> finished_parsing(1);
 327     }
 328
 329     if( /^0MODEL SPECIFICATION FILE IS EMPTY/ ){
 330       $self -> {'msfo_file_empty'} = 1;
 331       $self -> finished_parsing(1);
 332     }
 333   }
 334 }
 335 end _read_msfo_status
 336 # }}}
 337
 338 # {{{ _read_block_structures
 339
 340 start _read_block_structures
 341 # These structures should always be present if no model specification file input is used
 342 # Raise parsing error if not found
 343 # $success is not used, really, with the latest fix
 344       {
 345         my $errmess = "Error in reading the block structures!";
 346         my $start_pos = $self -> {'lstfile_pos'};
 347         my $success  = 1;
 348
 349         my $tbarea = 0;
 350         my $obarea = 0;
 351         my $sbarea = 0;
 352
 353         my $oblock_set = -1;
 354         my $sblock_set = -1;
 355         while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 356           if ( /^0MODEL SPECIFICATION FILE INPUT/ ) {
 357             # We can't find anything but that's ok
 358             $success = 1;
 359             $start_pos--;
 360             last;
 361           }
 362
 363           if ( /^0LENGTH OF THETA/ ) {
 364             # If we find this we must find other stuff too. Set
 365             # success = 0 and change this if we find the rest. Nope,
 366             # this is not true. For example, you can supply only a
 367             # $THETA if you use the LIKELIHOOD option for the
 368             # $ESTIMATION block.
 369             $tbarea = 1;
 370           }
 371
 372           if ( /^0INITIAL ESTIMATE/ ) {
 373             # We want to find this if we are currently reading theta,
 374             # omega or sigma block structures
 375             $success = 1 if ( $tbarea or $sbarea or $obarea );
 376             $start_pos --;
 377             last;
 378           }
 379
 380           if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 381             #EOF This should not happen, raise error
 382             my $errmess = "Reached end of file while parsing block structures\n";
 383             debug -> warn( level => 1,
 384                            message => $errmess."$!" );
 385             $self -> parsing_error( message => $errmess."$!" );
 386             return;
 387           }
 388
 389           if(/0OMEGA HAS BLOCK FORM:/) {
 390             $self -> {'omega_block_structure_type'} = 'BLOCK';
 391             $obarea = 1;
 392             $tbarea = 0;
 393             $success = 1;
 394             next;
 395           }
 396           if(/0SIGMA HAS BLOCK FORM:/) {
 397             $self -> {'sigma_block_structure_type'} = 'BLOCK';
 398             $sbarea = 1;
 399             $tbarea = 0;
 400             $obarea = 0;
 401             $success = 1;
 402             next;
 403           }
 404           if ( /^0OMEGA HAS SIMPLE DIAGONAL FORM/ ) {
 405             $self -> {'omega_block_structure_type'} = 'DIAGONAL';
 406             $success = 1;
 407             next;
 408           }
 409           if ( /^0SIGMA HAS SIMPLE DIAGONAL FORM/ ) {
 410             $self -> {'sigma_block_structure_type'} = 'DIAGONAL';
 411             $success = 1;
 412             last;
 413           }
 414           if ( $obarea ) {
 415             my @row = split;
 416             # All rows with the last but one element set to 0 indicate the start of a new block
 417             # $#row == 0 indicates the first row of the matrix.
 418             if ( $#row == 0 or $row[$#row-1] == 0 ) {
 419               # If the same number as previous set
 420               if ( $oblock_set == $row[$#row] ) {
 421                 $self -> {'omega_block_sets'}{$oblock_set}{'size'}++;
 422               } else {
 423                 $oblock_set = $row[$#row];
 424                 $self -> {'omega_block_sets'}{$oblock_set}{'size'} = 1;
 425               }
 426               # Always set dimension to 1 when starting a new block
 427               $self -> {'omega_block_sets'}{$oblock_set}{'dimension'} = 1;
 428             } else {
 429               $self -> {'omega_block_sets'}{$oblock_set}{'dimension'}++;
 430             }
 431             push( @{$self -> {'omega_block_structure'}}, \@row );
 432           }
 433           if ( $sbarea ) {
 434             my @row = split;
 435             # All rows with the last but one element set to 0 indicate the start of a new block
 436             if ( $#row == 0 or $row[$#row-1] == 0 ) {
 437               # If the same number as previous set
 438               if ( $sblock_set == $row[$#row] ) {
 439                 $self -> {'sigma_block_sets'}{$sblock_set}{'size'}++;
 440               } else {
 441                 $sblock_set = $row[$#row];
 442                 $self -> {'sigma_block_sets'}{$sblock_set}{'size'} = 1;
 443               }
 444               # Always set dimension to 1 when starting a new block
 445               $self -> {'sigma_block_sets'}{$sblock_set}{'dimension'} = 1;
 446             } else {
 447               $self -> {'sigma_block_sets'}{$sblock_set}{'dimension'}++;
 448             }
 449             push( @{$self -> {'sigma_block_structure'}}, \@row );
 450           }
 451         }
 452
 453         unless( defined $self -> {'omega_block_structure_type'} ){
 454           $self -> {'omega_block_structure_type'} = 'DIAGONAL';
 455         }
 456         unless( defined $self -> {'sigma_block_structure_type'} ){
 457           $self -> {'sigma_block_structure_type'} = 'DIAGONAL';
 458         }
 459
 460         unless ( $success ) {
 461           debug -> warn( level => 1,
 462                          message => $errmess." 2 $!" );
 463           $self -> parsing_error( message => $errmess." 2 $!" );
 464         } else {
 465           $self -> {'lstfile_pos'} = $start_pos;
 466         }
 467       }
 468 end _read_block_structures
 469
 470 # }}} _read_block_structures
 471
 472 # {{{ _read_steps_allowed
 473 start _read_steps_allowed
 474 # These statements are optional. Return to start_pos if not found
 475     my $start_pos = $self -> {'lstfile_pos'};
 476 my $est_allowed  = 1;
 477 my $cov_allowed  = 1;
 478 my $nonp_allowed  = 1;
 479 my $tables_allowed  = 1; # I am not sure that this is actually something which can be marked as not valid
 480
 481 while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 482   if ( /^ PROBLEM.*SUBPROBLEM/ or /^ PROBLEM NO\.:\s+\d/ or
 483        /^0ITERATION NO./ or /^0MINIMIZATION/) {
 484     # This is ok, we should end up here
 485     last;
 486   }
 487
 488   if( /0ESTIMATION STEP NOT ALLOWED/ ) {
 489     $est_allowed = 0;
 490   }
 491
 492   if( /0COVARIANCE STEP NOT ALLOWED/ ) {
 493     $cov_allowed = 0;
 494   }
 495
 496   if( /0NONPARAMETRIC STEP NOT ALLOWED/ ) {
 497     $nonp_allowed = 0;
 498   }
 499
 500   if( /0TABLES STEP NOT ALLOWED/ ) { # As indicated above, this is unsure but this coding should not harm
 501     $tables_allowed = 0;
 502   }
 503
 504   if( /0INPUT MODEL SPECIFICATION FILE GENERATED FROM A NON-TERMINATING ESTIMATION STEP/ ) {
 505     if( @{$self -> {'lstfile'}}[ $start_pos ] =~ / BUT CONTINUING ESTIMATION STEP NOT IMPLEMENTED/ ) {
 506       # If this happens, NONMEM aborts so we are finished reading
 507       $self -> finished_parsing(1);
 508     }
 509   }
 510
 511   if( /0MODEL SPECIFICATION FILE IS EMPTY/ ) {
 512     # If this happens, NONMEM aborts so we are finished reading
 513     $self -> finished_parsing(1);
 514   }
 515 }
 516
 517 unless( ( $self -> estimation_step_initiated()    * $est_allowed ) or
 518         ( $self -> covariance_step_run()    * $cov_allowed ) or
 519         ( $self -> nonparametric_step_run() * $nonp_allowed ) or
 520         ( $self -> tables_step_run() * $tables_allowed ) ) {
 521   # If this happens, NONMEM aborts so we are finished reading
 522   $self -> finished_parsing(1);
 523 }
 524 end _read_steps_allowed
 525 # }}} _read_steps_allowed
 526
 527 # {{{ _read_tablesstep
 528 start _read_tablesstep
 529 # The tables step is optional
 530     my $start_pos = $self -> {'lstfile_pos'};
 531 my $success  = 0;
 532
 533 while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 534   if ( /^1\s*$/ ) {
 535     # This is ok, the tables step was not used.
 536     $start_pos -= 2;
 537     $success = 1;
 538     last;
 539   }
 540   if( /^ PROBLEM NO\.:\s+\d/ or
 541       /^0MINIMIZATION/ ) {
 542     # This should not happen, raise error
 543     my $errmess = "Found $_ while searching for the (optional) ".
 544         "tables step indicator\n";
 545     debug -> warn( level => 1,
 546                    message => $errmess."$!" );
 547     $self -> parsing_error( message => $errmess."$!" );
 548     return;
 549   }
 550
 551   if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 552     #EOF This should not happen, raise error
 553     my $errmess = "Reached end of file while  searching for the ".
 554         "(optional) tables step indicator\n";
 555     debug -> warn( level => 1,
 556                    message => $errmess."$!" );
 557     $self -> parsing_error( message => $errmess."$!" );
 558     return;
 559   }
 560
 561   if(/^0TABLES STEP OMITTED:\s*\b(.*)\b/) {
 562     $self -> {'tables_step_run'} = 0 if $1 eq 'YES';
 563     $self -> {'tables_step_run'} = 1 if $1 eq 'NO';
 564     $success = 1;
 565     last;
 566   }
 567 }
 568
 569 unless ( $success ) {
 570   debug -> warn( level   => 2,
 571                  message => "rewinding to first position..." );
 572 } else {
 573   $self -> {'lstfile_pos'} = $start_pos;
 574 }
 575 end _read_tablesstep
 576 # }}} _read_tablesstep
 577
 578 # {{{ _read_prior
 579
 580 start _read_prior
 581 {
 582   my $start_pos = $self -> {'lstfile_pos'};
 583   my $success  = 0;
 584   while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 585 #    if ( /1DOUBLE PRECISION PREDPP/ ) { This is not always printed
 586     if ( /^1\s*$/ or
 587        /0SEARCH WITH ESTIMATION STEP WILL NOT PROCEED/ ) {
 588       # This is ok, no user defined prior was used.
 589       $start_pos -= 2;
 590       $success = 1;
 591       last;
 592     }
 593     if( /^ PROBLEM NO\.:\s+\d/ or
 594         /^0MINIMIZATION/ ) {
 595       # This should not happen, raise error
 596       my $errmess = "Found $_ while searching for the (optional) ".
 597           "user defined prior indicator\n";
 598       debug -> warn( level => 1,
 599                      message => $errmess."$!" );
 600       $self -> parsing_error( message => $errmess."$!" );
 601       return;
 602     }
 603
 604     if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 605       #EOF This should not happen, raise error
 606       my $errmess = "Reached end of file while  searching for the ".
 607           "(optional) user defined prior indicator\n";
 608       debug -> warn( level => 1,
 609                      message => $errmess."$!" );
 610       $self -> parsing_error( message => $errmess."$!" );
 611       return;
 612     }
 613
 614     if(/^ PRIOR SUBROUTINE USER-SUPPLIED/){
 615       $self -> {'user_defined_prior'} = 1;
 616       $success = 1;
 617       last;
 618     }
 619   }
 620
 621   unless ( $success ) {
 622     debug -> warn( level   => 2,
 623                    message => "rewinding to first position..." );
 624   } else {
 625     $self -> {'lstfile_pos'} = $start_pos;
 626   }
 627
 628 }
 629 end _read_prior
 630
 631 # }}}
 632
 633 # {{{ _read_nonpstep
 634 start _read_nonpstep
 635 # The nonparametric step is optional
 636     my $start_pos = $self -> {'lstfile_pos'};
 637 my $success  = 0;
 638
 639 while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 640   if ( /^0COVARIANCE STEP OMITTED/ or
 641        /0TABLES STEP OMITTED/ or
 642        /1DOUBLE PRECISION PREDPP/ or
 643        /0SEARCH WITH ESTIMATION STEP WILL NOT PROCEED/ or
 644        /^1/ or
 645        /^0MINIMIZATION/ or
 646        /^ PROBLEM NO\.:\s+\d/ ) {
 647     # This is ok, the nonp step was not used.
 648     last;
 649   }
 650
 651 #  if( /^ PROBLEM NO\.:\s+\d/ or
 652 #      /^0MINIMIZATION/ ) {
 653     # This should not happen, raise error
 654 #    my $errmess = "Found $_ while searching for the (optional) ".
 655 #       "nonparametric step indicator\n";
 656 #    debug -> warn( level => 1,
 657 #                  message => $errmess."$!" );
 658 #    $self -> parsing_error( message => $errmess."$!" );
 659 #    return;
 660 #  }
 661
 662   if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 663     #EOF This should not happen, raise error
 664     my $errmess = "Reached end of file while  searching for the ".
 665         "(optional) nonparametric step indicator\n";
 666     debug -> warn( level => 1,
 667                    message => $errmess."$!" );
 668     $self -> parsing_error( message => $errmess."$!" );
 669     return;
 670   }
 671
 672   if(/^0NONPARAMETRIC STEP OMITTED:\s*\b(.*)\b/) {
 673     $self -> {'nonparametric_step_run'} = 0 if $1 eq 'YES';
 674     $self -> {'nonparametric_step_run'} = 1 if $1 eq 'NO';
 675     $success = 1;
 676     last;
 677   }
 678 }
 679
 680 unless ( $success ) {
 681   debug -> warn( level   => 2,
 682                  message => "rewinding to first position..." );
 683 } else {
 684   $self -> {'lstfile_pos'} = $start_pos;
 685 }
 686 end _read_nonpstep
 687 # }}} _read_nonpstep
 688
 689 # {{{ _read_eststep
 690 start _read_eststep
 691 # A combination of simulation and estimation step indications should always be found, raise error otherwise
 692     my $start_pos = $self -> {'lstfile_pos'};
 693 my $success  = 0;
 694
 695 while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 696   if ( /^0COVARIANCE STEP OMITTED/ or
 697        /^0NONPARAMETRIC STEP OMITTED/ or
 698        /^0TABLES STEP OMITTED/ or
 699        /^1/ or
 700        /^0MINIMIZATION/ or
 701        /^ PROBLEM NO\.:\s+\d/ ) {
 702     unless( $success ) {
 703       # This should not happen, raise error
 704       my $errmess = "Found $_ while searching for the simulation/estimation step indicators\n";
 705       debug -> warn( level => 1,
 706                      message => $errmess."$!" );
 707       $self -> parsing_error( message => $errmess."$!" );
 708     }
 709     return;
 710   }
 711
 712   if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 713     #EOF This should not happen, raise error
 714     my $errmess = "Reached end of file while searching for the simulation/estimation step indicators\n";
 715     debug -> warn( level => 1,
 716                    message => $errmess."$!" );
 717     $self -> parsing_error( message => $errmess."$!" );
 718     return;
 719   }
 720
 721   if(/^0ESTIMATION STEP OMITTED:\s*\b(.*)\b/) {
 722     $self -> estimation_step_initiated(1);
 723     $self -> estimation_step_run(0) if $1 eq 'YES';
 724     $self -> estimation_step_run(1) if $1 eq 'NO';
 725     $success = 1;
 726   }
 727   if(/^0SIMULATION STEP OMITTED:\s*\b(.*)\b/) {
 728     $self -> simulation_step_run(0) if $1 eq 'YES';
 729     $self -> simulation_step_run(1) if $1 eq 'NO';
 730     $success = 1;
 731   }
 732 }
 733
 734 unless ( $success ) {
 735   debug -> warn( level   => 2,
 736                  message => "rewinding to first position..." );
 737 } else {
 738   $self -> {'lstfile_pos'} = $start_pos;
 739 }
 740 end _read_eststep
 741 # }}} _read_eststep
 742
 743 # {{{ _read_covstep
 744 start _read_covstep
 745       {
 746         my $start_pos = $self -> {'lstfile_pos'};
 747         my $success  = 0;
 748
 749         while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 750
 751           if(/0COVARIANCE STEP OMITTED:\s*\b(.*)\b/) {
 752             $self -> {'covariance_step_run'} = 0 if $1 eq 'YES';
 753             $self -> {'covariance_step_run'} = 1 if $1 eq 'NO';
 754             $success = 1;
 755             last;
 756           }
 757           if ( /^ PROBLEM.*SUBPROBLEM/ or /^ PROBLEM NO\.:\s+\d/ or
 758                /^0ITERATION NO./ or /^0MINIMIZATION/) {
 759             # This is ok, we should end up here
 760             last;
 761           }
 762         }
 763
 764         unless ( $success ) {
 765           debug -> warn( level   => 2,
 766                          message => "rewinding to first position..." );
 767         } else {
 768           $self -> {'lstfile_pos'} = $start_pos;
 769         }
 770       }
 771 end _read_covstep
 772 # }}} _read_covstep
 773
 774 # {{{ _read_inits
 775
 776 start _read_inits
 777 # The inits should always be present if no model specification file input is used
 778 # Raise parsing error if not found
 779       {
 780         my $errmess = "Error in reading the initial estimates!\n";
 781         my $start_pos = $self -> {'lstfile_pos'};
 782         my ( @thetas, @omegas, @sigmas );
 783         my $thetarea = 0;
 784         my $omegarea = 0;
 785         my $sigmarea = 0;
 786         my $success  = 0;
 787         my $tmp = $start_pos;
 788
 789         # Look for a general statement of fixed sigmas and omegas
 790         my $all_sigmas_fixed = 0;
 791         my $all_omegas_fixed = 0;
 792         while( $_ = @{$self -> {'lstfile'}}[ $tmp++ ] ) {
 793           if ( /^0SIGMA CONSTRAINED TO BE THIS INITIAL ESTIMATE/ ) {
 794             $all_sigmas_fixed = 1;
 795           }
 796           if ( /^0OMEGA CONSTRAINED TO BE THIS INITIAL ESTIMATE/ ) {
 797             $all_omegas_fixed = 1;
 798           }
 799           if ( /^0ESTIMATION STEP OMITTED/ or
 800                /^0SIMULATION STEP OMITTED/ ) {
 801             last;
 802           }
 803           if ( /^ INITIAL ESTIMATE OF OMEGA HAS A NONZERO BLOCK WHICH IS NUMERICALLY NOT POSITIVE DEFINITE/ ) {
 804             $self -> finished_parsing(1);
 805             $self -> pre_run_errors($_);
 806             return;
 807           }
 808           if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 809             #EOF This should not happen, raise error
 810             my $errmess = "Reached end of file while parsing initial estimates\n";
 811             debug -> warn( level => 1,
 812                            message => $errmess."$!" );
 813             $self -> parsing_error( message => $errmess."$!" );
 814             return;
 815           }
 816
 817         }
 818
 819         while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) {
 820
 821           if ( /^0MODEL SPECIFICATION FILE INPUT/ ) {
 822             # We can't find any initial estimates but that's ok
 823             $self -> msfi_used(1);
 824             $success = 1;
 825             $start_pos--;
 826             last;
 827           }
 828
 829           if ( /^0INITIAL ESTIMATE OF THETA/ ) {
 830             # If we find this we must find other stuff too. Set
 831             # success = 0 and change this if we find the rest. Nope,
 832             # not true. $THETA can be found alone using the LIKE
 833             # option in the $EST record.
 834             $thetarea = 1;
 835           }
 836
 837           if ( /^0ESTIMATION STEP OMITTED/ or
 838                /^0SIMULATION STEP OMITTED/ ) {
 839             # We want to find this if we are currently reading the omega or sigma inits
 840             $success = 1 if ( $thetarea or $sigmarea or $omegarea);
 841             $start_pos --;
 842             last;
 843           }
 844
 845           if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) {
 846             #EOF This should not happen, raise error
 847             my $errmess = "Reached end of file while parsing the initial estimates\n";
 848             debug -> warn( level => 1,
 849                            message => $errmess."$!" );
 850             $self -> parsing_error( message => $errmess."$!" );
 851             return;
 852           }
 853           if ( $thetarea and /^\s*-?\d*\.\d*/ ) {
 854             my @T = split(' ',$_);
 855             push(@{$self -> {'initthetas'}},eval($T[1]));
 856             push(@{$self -> {'lower_theta_bounds'}},eval($T[0]));
 857             push(@{$self -> {'upper_theta_bounds'}},eval($T[2]));
 858             if ( $T[0] == $T[1] and $T[0] == $T[2] ) {
 859               push(@{$self -> {'fixedthetas'}},1);
 860               push(@{$self -> {'estimated_thetas'}},0);
 861             } else {
 862               push(@{$self -> {'fixedthetas'}},0);
 863               push(@{$self -> {'estimated_thetas'}},1);
 864             }
 865           }
 866           if ( /^0INITIAL ESTIMATE OF OMEGA:/ ) {
 867             $thetarea = 0;
 868             $omegarea = 1;
 869             $success = 1;
 870             if ( defined $self -> {'omega_block_sets'} and
 871                  scalar keys %{$self -> {'omega_block_sets'}} > 0 ) {
 872               # We currently assume that this part is atomic. No parser checks are made
 873               $start_pos++;
 874               my %om_bl = %{$self -> {'omega_block_sets'}};
 875               my @blocks = sort {$a <=> $b} keys %om_bl;
 876               foreach my $block ( @blocks ) {
 877                 my @fix_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]);
 878                 my $fix = $fix_row[1] eq 'YES' ? 1 : 0;
 879                 if( $all_omegas_fixed ) {
 880                   $fix = 1;
 881                 }
 882                 for ( my $size = 1; $size <= $om_bl{$block}{'size'}; $size++ ) {
 883                   for ( my $row = $start_pos ; $row < $start_pos + $om_bl{$block}{'dimension'}; $row++ ) {
 884                     my @init_row = split(' ', $self -> {'lstfile'}[ $row ]);
 885                     foreach my $init ( @init_row ) {
 886                       push( @{$self -> {'fixedomegas'}}, $fix );
 887                       push( @{$self -> {'estimated_omegas'}}, (not $fix and $size == 1) ? 1 : 0 );
 888                       push(@{$self -> {'initomegas'}}, eval($init) );
 889                       push(@{$self -> {'lower_omega_bounds'}},0);
 890                       push(@{$self -> {'upper_omega_bounds'}},1000000);
 891                     }
 892                   }
 893                 }
 894                 $start_pos += $om_bl{$block}{'dimension'};
 895               }
 896             } else {
 897               my $om_row = 1;
 898               while( ($start_pos + 1) < scalar @{$self -> {'lstfile'}} ) {
 899                 if( $self -> {'lstfile'}[ $start_pos ] =~ /^0INITIAL ESTIMATE OF SIGMA/ or
 900                     $self -> {'lstfile'}[ $start_pos ] =~ /^0SIMULATION STEP OMITTED/ or
 901                     $self -> {'lstfile'}[ $start_pos ] =~ /^0ESTIMATION STEP OMITTED/ or
 902                     $self -> {'lstfile'}[ $start_pos ] =~ /^0OMEGA CONSTRAINED TO BE THIS INITIAL ESTIMATE/ ) {
 903                   $start_pos--;
 904                   last;
 905                 }
 906
 907                 # After ten rows of omegas NONMEM starts wrapping
 908                 # lines. We then need to skip the first part of the
 909                 # wrapped lines. This nice littel formula calculates
 910                 # how many lines to skip.
 911
 912                 my $skip_lines = ($om_row - $om_row % 10)/10;
 913
 914                 $start_pos += $skip_lines if( $om_row > 10 );
 915
 916                 my @init_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]);
 917                 if( not $init_row[$#init_row] =~ /[0-9]{1}\.[0-9]{4}E[+-][0-9]{2}/ ) {
 918                   my $errmess = "Error parsing omega initial estimates, found non-number:\n".
 919                       $self -> {'lstfile'}[ $start_pos-1 ]."\n";
 920                   debug -> warn( level => 1,
 921                                  message => $errmess."$!" );
 922                   $self -> parsing_error( message => $errmess."$!" );
 923                   return;
 924                 }
 925
 926                 my $init = eval($init_row[$#init_row]);
 927                 unless( $init == 0 ) {
 928                   push( @{$self -> {'fixedomegas'}}, $all_omegas_fixed ? 1 : 0 );
 929                   push( @{$self -> {'initomegas'}}, eval($init) );
 930                 }
 931                 push( @{$self -> {'estimated_omegas'}}, $all_omegas_fixed ? 0 : 1 );
 932                 push(@{$self -> {'lower_omega_bounds'}},0);
 933                 push(@{$self -> {'upper_omega_bounds'}},1000000);
 934                 $om_row++;
 935               }
 936             }
 937           }
 938           if ( /^0INITIAL ESTIMATE OF SIGMA:/ ) {
 939             $thetarea = 0;
 940             $omegarea = 0;
 941             $sigmarea = 1;
 942             if ( defined $self -> {'sigma_block_sets'} and
 943                  scalar keys %{$self -> {'sigma_block_sets'}} > 0 ) {
 944               # We currently assume that this part is atomic. No parser checks are made
 945               $start_pos++;
 946               my %si_bl = %{$self -> {'sigma_block_sets'}};
 947               my @blocks = sort {$a <=> $b} keys %si_bl;
 948               foreach my $block ( @blocks ) {
 949                 my @fix_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]);
 950                 my $fix = $fix_row[1] eq 'YES' ? 1 : 0;
 951                 if( $all_sigmas_fixed ) {
 952                   $fix = 1;
 953                 }
 954                 for ( my $size = 1; $size <= $si_bl{$block}{'size'}; $size++ ) {
 955                   for ( my $row = $start_pos ; $row < $start_pos + $si_bl{$block}{'dimension'}; $row++ ) {
 956                     my @init_row = split(' ', $self -> {'lstfile'}[ $row ]);
 957                     foreach my $init ( @init_row ) {
 958                       push( @{$self -> {'fixedsigmas'}}, $fix );
 959                       push( @{$self -> {'estimated_sigmas'}}, (not $fix and $size == 1) ? 1 : 0 );
 960                       push(@{$self -> {'initsigmas'}}, eval($init) );
 961                       push(@{$self -> {'lower_sigma_bounds'}},0);
 962                       push(@{$self -> {'upper_sigma_bounds'}},1000000);
 963                     }
 964                   }
 965                 }
 966                 $start_pos += $si_bl{$block}{'dimension'};
 967               }
 968             } else {
 969               my $sm_row = 1;
 970               while( ($start_pos + 1) < scalar @{$self -> {'lstfile'}} ) {
 971                 if( $self -> {'lstfile'}[ $start_pos ] =~ /^0SIMULATION STEP OMITTED/ or
 972                     $self -> {'lstfile'}[ $start_pos ] =~ /^0ESTIMATION STEP OMITTED/ or
 973                     $self -> {'lstfile'}[ $start_pos ] =~ /^0SIGMA CONSTRAINED TO BE THIS INITIAL ESTIMATE/ ) {
 974                   $start_pos--;
 975                   last;
 976                 }
 977
 978                 # After ten rows of sigmas NONMEM starts wrapping
 979                 # lines. We then need to skip the first part of the
 980                 # wrapped lines. This nice littel formula calculates
 981                 # how many lines to skip.
 982
 983                 my $skip_lines = ($sm_row - $sm_row % 10)/10;
 984
 985                 $start_pos += $skip_lines if( $sm_row > 10 );
 986
 987                 my @init_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]);
 988                 if( not $init_row[$#init_row] =~ /[0-9]{1}\.[0-9]{4}E[+-][0-9]{2}/ ) {
 989                   my $errmess = "Error parsing sigma initial estimates, found non-number\n".
 990                       $self -> {'lstfile'}[ $start_pos-1 ];
 991                   debug -> warn( level => 1,
 992                                  message => $errmess."$!" );
 993                   $self -> parsing_error( message => $errmess."$!" );
 994                   return;
 995                 }
 996
 997                 my $init = eval($init_row[$#init_row]);
 998                 unless( $init == 0 ) {
 999                   push( @{$self -> {'fixedsigmas'}}, $all_sigmas_fixed ? 1 : 0 );
1000                   push( @{$self -> {'initsigmas'}}, eval($init) );
1001                 }
1002                 push( @{$self -> {'estimated_sigmas'}},  $all_sigmas_fixed ? 0 : 1 );
1003                 push(@{$self -> {'lower_sigma_bounds'}},0);
1004                 push(@{$self -> {'upper_sigma_bounds'}},1000000);
1005                 $sm_row++;
1006               }
1007             }
1008           }
1009 #         if ( /^0MINIMIZATION/ ) {
1010 #           last;
1011 #         }
1012         }
1013
1014         unless ( $success ) {
1015           debug -> warn( level   => 2,
1016                          message => "rewinding to first position..." );
1017         } else {
1018 # Keep this code
1019 #         if ( $PsN::config -> {'_'} -> {'use_database'} and
1020 #              $self -> {'register_in_database'} ) {
1021 #           my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
1022 #                              ";databse=".$PsN::config -> {'_'} -> {'project'},
1023 #                                    $PsN::config -> {'_'} -> {'user'},
1024 #                               $PsN::config -> {'_'} -> {'password'},
1025 #                                    {'RaiseError' => 1});
1026 #           my $sth;
1027 #           my @mod_str = ('','');
1028 #           if ( defined $self -> {'model_id'} ) {
1029 #             @mod_str = ('model_id,',"$self->{'model_id'},");
1030 #           }
1031 #           foreach my $param ( 'theta', 'omega', 'sigma' ) {
1032 #             foreach my $par_str ( @{$self -> {'init'.$param.'s'}} ) {
1033 #               $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
1034 #                              ".estimate ".
1035 #                                      "(subproblem_id,problem_id,output_id,".
1036 #                                      $mod_str[0].
1037 #                                      "type,value,init) ".
1038 #                                      "VALUES ( 1 ,".
1039 #                                      "'$self->{'problem_id'}' ,".
1040 #                                      "'$self->{'output_id'}' ,".
1041 #                                      $mod_str[1].
1042 #                                      "'$param','$par_str','1')");
1043 #               $sth -> execute;
1044 #               push( @{$self -> {'estimate_ids'}}, $sth->{'mysql_insertid'} );
1045 #             }
1046 #           }
1047 #           $sth -> finish;
1048
1049 #           $dbh -> disconnect;
1050 #         }
1051
1052           $self -> {'lstfile_pos'} = $start_pos;
1053         }
1054       }
1055 end _read_inits
1056
1057 # }}} _read_inits
1058
1059 # {{{ access_any
1060
1061 start access_any
1062       {
1063         unless( $#subproblems > 0 ){
1064           debug -> warn( level => 2,
1065                            message => "subproblems undefined, using all." );
1066           if( defined $self -> {'subproblems'} ) {
1067             @subproblems = (1 .. scalar @{$self -> {'subproblems'}});
1068           } else {
1069             debug -> warn( level   => 1,
1070                            message => "No subproblems defined in this problem." );
1071             @subproblems = ();
1072           }
1073         }
1074
1075
1076         my @own_subproblems = defined $self -> {'subproblems'} ? @{$self -> {'subproblems'}} : ();
1077         foreach my $i ( @subproblems ) {
1078           if ( defined $own_subproblems[$i-1] ) {
1079             debug -> warn( level   => 2,
1080                            message => "subproblems: $i" );
1081             debug -> warn( level   => 2,
1082                            message => "Attribute: ".$own_subproblems[$i-1] -> $attribute );
1083             my $meth_ret = $own_subproblems[$i-1] -> $attribute;
1084
1085             # Test if the returned value is an array (with hashes we
1086             # can't allow selection based on parameter numbers, since
1087             # a hash is not ordered)
1088             if ( ref ( $meth_ret ) eq 'ARRAY' ) {
1089               #my @subprob_attr = @{$own_subproblems[$i-1] -> $attribute};
1090               my @subprob_attr = @{$meth_ret};
1091               if ( scalar @parameter_numbers > 0 ) {
1092                 my @tmp_arr = ();
1093                 foreach my $num ( @parameter_numbers ) {
1094                   if ( $num > 0 and $num <= scalar @subprob_attr ) {
1095                     push( @tmp_arr, $subprob_attr[$num-1] );
1096                   } else {
1097                     debug -> die( message => "( $attribute ): no such parameter number $num!".
1098                                   "(".scalar @subprob_attr." exists)" );
1099                   }
1100                 }
1101                 @subprob_attr = @tmp_arr;
1102               }
1103               push( @return_value, \@subprob_attr );
1104             } else {
1105 #             push( @return_value, $meth_ret ) if defined $meth_ret;
1106               push( @return_value, $meth_ret );
1107             }
1108           } else {
1109             debug -> die( message => "No such subproblem ".($i-1) );
1110           }
1111         }
1112         # Check the return_value to see if we have empty arrays
1113         if ( $#return_value == 0  and ref ($return_value[0]) eq 'ARRAY' and scalar @{$return_value[0]} < 1 ) {
1114            @return_value = ();
1115         }
1116       }
1117 end access_any
1118
1119 # }}} access_any
1120
1121 # {{{ _set_labels
1122
1123 start _set_labels
1124       {
1125         if ( defined $self -> {'subproblems' } ) {
1126           foreach my $type ( ('theta','omega','sigma') ) {
1127             my $first_sub = @{$self -> {'subproblems'}}[0];
1128             my $accessor = $type eq 'theta' ? $type.'s' : 'raw_'.$type.'s';
1129             if( defined $first_sub -> $accessor ) {
1130               my @param = @{$first_sub -> $accessor};
1131               if ( scalar @param > 0 ) {
1132                 my ( @names, @indexes );
1133                 my ($j,$ndiags);
1134                 foreach $j (1..scalar @param) {
1135                   if ( $type eq 'theta' ) {
1136                     push( @names, "TH$j" );
1137                   } else {
1138                     if ( $first_sub -> _isdiagonal('index' => $j) ) {
1139                       push @names, uc(substr($type,0,2)).++$ndiags;
1140                       if ( $type eq 'omega' ) {
1141                         push ( @{$self -> {'omega_indexes'}}, [$ndiags, $ndiags] );
1142                       } else {
1143                         push ( @{$self -> {'sigma_indexes'}}, [$ndiags, $ndiags] );
1144                       }
1145                       next;
1146                     } elsif ($param[$j-1] !=0) {
1147                       @indexes = $first_sub -> _rowcolind( index => $j);
1148                       push @names,uc(substr($type,0,2)).$indexes[0].'_'.$indexes[1];
1149                       if ( $type eq 'omega' ) {
1150                         push ( @{$self -> {'omega_indexes'}}, [$indexes[0], $indexes[1]] );
1151                       } else {
1152                         push ( @{$self -> {'sigma_indexes'}}, [$indexes[0], $indexes[1]] );
1153                       }
1154                     }
1155                   }
1156                 }
1157                 $self ->{$type.'names'} = \@names;
1158               }
1159             }
1160           }
1161         }
1162       }
1163 end _set_labels
1164
1165 # }}} _set_labels