From aea146de9ac0caabf54b2d9ca266058729d2948f Mon Sep 17 00:00:00 2001 From: pontus_pih Date: Mon, 19 Mar 2007 15:20:12 +0000 Subject: [PATCH] Merged parsing error handling, some bug fixes and prior functionality from serial_patches branch --- lib/output/problem_subs.pm | 148 +++++++++++++++++++++++++++++++++------------ 1 file changed, 110 insertions(+), 38 deletions(-) diff --git a/lib/output/problem_subs.pm b/lib/output/problem_subs.pm index d6b7614..94d5c57 100644 --- a/lib/output/problem_subs.pm +++ b/lib/output/problem_subs.pm @@ -34,6 +34,8 @@ start new $this -> finished_parsing() ); $this -> _read_tablesstep() if ( $this -> parsed_successfully() and not $this -> finished_parsing() ); + $this -> _read_prior() if ( $this -> parsed_successfully() and not + $this -> finished_parsing() ); $this -> _read_steps_allowed() if ( $this -> parsed_successfully() and not $this -> finished_parsing() ); $this -> _read_subproblems() if ( $this -> parsed_successfully() and not @@ -315,11 +317,13 @@ end _read_arbitrary start _read_block_structures # These structures should always be present if no model specification file input is used # Raise parsing error if not found +# $success is not used, really, with the latest fix { my $errmess = "Error in reading the block structures!"; my $start_pos = $self -> {'lstfile_pos'}; my $success = 1; + my $tbarea = 0; my $obarea = 0; my $sbarea = 0; @@ -334,24 +338,20 @@ start _read_block_structures } if ( /^0LENGTH OF THETA/ ) { - # If we find this we must find other stuff too. Set success = 0 and - # change this if we find the rest. - $success = 0; + # If we find this we must find other stuff too. Set + # success = 0 and change this if we find the rest. Nope, + # this is not true. For example, you can supply only a + # $THETA if you use the LIKELIHOOD option for the + # $ESTIMATION block. + $tbarea = 1; } if ( /^0INITIAL ESTIMATE/ ) { - if ( $success == 0 ) { - # If we end up here, we found "LENGTH OF THETA" but not the rest - debug -> warn( level => 1, - message => $errmess." 1 $!" ); - $self -> parsing_error( message => $errmess." 1 $!" ); - return; - } else { - # We want to find this if we are currently reading omega or sigma block structures - $success = 1 if ( $sbarea or $obarea ); - $start_pos --; - last; - } + # We want to find this if we are currently reading theta, + # omega or sigma block structures + $success = 1 if ( $tbarea or $sbarea or $obarea ); + $start_pos --; + last; } if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) { @@ -366,12 +366,14 @@ start _read_block_structures if(/0OMEGA HAS BLOCK FORM:/) { $self -> {'omega_block_structure_type'} = 'BLOCK'; $obarea = 1; + $tbarea = 0; $success = 1; next; } if(/0SIGMA HAS BLOCK FORM:/) { $self -> {'sigma_block_structure_type'} = 'BLOCK'; $sbarea = 1; + $tbarea = 0; $obarea = 0; $success = 1; next; @@ -506,7 +508,7 @@ start _read_tablesstep my $success = 0; while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) { - if ( /1DOUBLE PRECISION PREDPP/ ) { + if ( /^1\s*$/ ) { # This is ok, the tables step was not used. $start_pos -= 2; $success = 1; @@ -550,6 +552,61 @@ unless ( $success ) { end _read_tablesstep # }}} _read_tablesstep +# {{{ _read_prior + +start _read_prior +{ + my $start_pos = $self -> {'lstfile_pos'}; + my $success = 0; + while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) { +# if ( /1DOUBLE PRECISION PREDPP/ ) { This is not always printed + if ( /^1\s*$/ or + /0SEARCH WITH ESTIMATION STEP WILL NOT PROCEED/ ) { + # This is ok, no user defined prior was used. + $start_pos -= 2; + $success = 1; + last; + } + if( /^ PROBLEM NO\.:\s+\d/ or + /^0MINIMIZATION/ ) { + # This should not happen, raise error + my $errmess = "Found $_ while searching for the (optional) ". + "user defined prior indicator\n"; + debug -> warn( level => 1, + message => $errmess."$!" ); + $self -> parsing_error( message => $errmess."$!" ); + return; + } + + if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) { + #EOF This should not happen, raise error + my $errmess = "Reached end of file while searching for the ". + "(optional) user defined prior indicator\n"; + debug -> warn( level => 1, + message => $errmess."$!" ); + $self -> parsing_error( message => $errmess."$!" ); + return; + } + + if(/^ PRIOR SUBROUTINE USER-SUPPLIED/){ + $self -> {'user_defined_prior'} = 1; + $success = 1; + last; + } + } + + unless ( $success ) { + debug -> warn( level => 2, + message => "rewinding to first position..." ); + } else { + $self -> {'lstfile_pos'} = $start_pos; + } + +} +end _read_prior + +# }}} + # {{{ _read_nonpstep start _read_nonpstep # The nonparametric step is optional @@ -558,7 +615,9 @@ my $success = 0; while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) { if ( /^0COVARIANCE STEP OMITTED/ or - /1DOUBLE PRECISION PREDPP/ ) { + /0TABLES STEP OMITTED/ or + /1DOUBLE PRECISION PREDPP/ or + /0SEARCH WITH ESTIMATION STEP WILL NOT PROCEED/ ) { # This is ok, the nonp step was not used. last; } @@ -610,8 +669,9 @@ while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) { if ( /^0COVARIANCE STEP OMITTED/ or /^0NONPARAMETRIC STEP OMITTED/ or /^0TABLES STEP OMITTED/ or - /^ PROBLEM NO\.:\s+\d/ or - /^0MINIMIZATION/ ) { + /^1/ or + /^0MINIMIZATION/ or + /^ PROBLEM NO\.:\s+\d/ ) { unless( $success ) { # This should not happen, raise error my $errmess = "Found $_ while searching for the simulation/estimation step indicators\n"; @@ -697,8 +757,7 @@ start _read_inits my $thetabounds = 0; my $omegarea = 0; my $sigmarea = 0; - my $success = 1; - + my $success = 0; my $tmp = $start_pos; # Look for a general statement of fixed sigmas and omegas @@ -742,9 +801,10 @@ start _read_inits } if ( /^0INITIAL ESTIMATE OF THETA/ ) { - # If we find this we must find other stuff too. Set success = 0 and - # change this if we find the rest. - $success = 0; + # If we find this we must find other stuff too. Set + # success = 0 and change this if we find the rest. Nope, + # not true. $THETA can be found alone using the LIKE + # option in the $EST record. $thetarea = 1; } @@ -754,18 +814,10 @@ start _read_inits if ( /^0ESTIMATION STEP OMITTED/ or /^0SIMULATION STEP OMITTED/ ) { - if ( $success == 0 ) { - # If we end up here, we found "0INITIAL ESTIMATE OF THETA" but not the rest - debug -> warn( level => 1, - message => $errmess."$!" ); - $self -> parsing_error( message => $errmess."$!" ); - return; - } else { - # We want to find this if we are currently reading the omega or sigma inits - $success = 1 if ( $sigmarea or $omegarea); - $start_pos --; - last; - } + # We want to find this if we are currently reading the omega or sigma inits + $success = 1 if ( $thetarea or $sigmarea or $omegarea); + $start_pos --; + last; } if ( ($start_pos + 1) == scalar @{$self -> {'lstfile'}} ) { @@ -776,7 +828,6 @@ start _read_inits $self -> parsing_error( message => $errmess."$!" ); return; } - if ( $thetarea and /^\s*-?\d*\.\d*/ ) { if( $thetabounds ){ my @T = split(' ',$_); @@ -838,6 +889,16 @@ start _read_inits $start_pos--; last; } + + # After ten rows of omegas NONMEM starts wrapping + # lines. We then need to skip the first part of the + # wrapped lines. This nice little formula calculates + # how many lines to skip. + + my $skip_lines = ($om_row - $om_row % 10)/10; + + $start_pos += $skip_lines if( $om_row > 10 ); + my @init_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]); if( not $init_row[$#init_row] =~ /[0-9]{1}\.[0-9]{4}E[+-][0-9]{2}/ ) { my $errmess = "Error parsing omega initial estimates, found non-number:\n". @@ -856,7 +917,6 @@ start _read_inits push( @{$self -> {'estimated_omegas'}}, $all_omegas_fixed ? 0 : 1 ); push(@{$self -> {'lower_omega_bounds'}},0); push(@{$self -> {'upper_omega_bounds'}},1000000); - $start_pos++ if( $om_row >= 10 ); $om_row++; } } @@ -892,6 +952,7 @@ start _read_inits $start_pos += $si_bl{$block}{'dimension'}; } } else { + my $sm_row = 1; while( ($start_pos + 1) < scalar @{$self -> {'lstfile'}} ) { if( $self -> {'lstfile'}[ $start_pos ] =~ /^0SIMULATION STEP OMITTED/ or $self -> {'lstfile'}[ $start_pos ] =~ /^0ESTIMATION STEP OMITTED/ or @@ -899,6 +960,16 @@ start _read_inits $start_pos--; last; } + + # After ten rows of sigmas NONMEM starts wrapping + # lines. We then need to skip the first part of the + # wrapped lines. This nice little formula calculates + # how many lines to skip. + + my $skip_lines = ($sm_row - $sm_row % 10)/10; + + $start_pos += $skip_lines if( $sm_row > 10 ); + my @init_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]); if( not $init_row[$#init_row] =~ /[0-9]{1}\.[0-9]{4}E[+-][0-9]{2}/ ) { my $errmess = "Error parsing sigma initial estimates, found non-number\n". @@ -917,6 +988,7 @@ start _read_inits push( @{$self -> {'estimated_sigmas'}}, $all_sigmas_fixed ? 0 : 1 ); push(@{$self -> {'lower_sigma_bounds'}},0); push(@{$self -> {'upper_sigma_bounds'}},1000000); + $sm_row++; } } } -- 2.11.4.GIT