From 09e607e99d26ed6d239d3b71b3202e2639877327 Mon Sep 17 00:00:00 2001 From: pontus_pih Date: Mon, 15 May 2006 12:47:56 +0000 Subject: [PATCH] Merging lars changes for PsN course --- diagrams/output.dia | 10 ++-- lib/output/problem/subproblem_subs.pm | 14 +++-- lib/output/problem_subs.pm | 104 ++++++++++++++++++++++------------ lib/tool/cdd_subs.pm | 2 + lib/tool/llp_subs.pm | 51 +++++++++-------- lib/tool/modelfit_subs.pm | 8 ++- lib/tool_subs.pm | 5 +- 7 files changed, 119 insertions(+), 75 deletions(-) diff --git a/diagrams/output.dia b/diagrams/output.dia index 557c2c6..a9dee45 100644 --- a/diagrams/output.dia +++ b/diagrams/output.dia @@ -9821,14 +9821,14 @@ - + - - + + @@ -9877,7 +9877,7 @@ - + @@ -13029,7 +13029,7 @@ - + diff --git a/lib/output/problem/subproblem_subs.pm b/lib/output/problem/subproblem_subs.pm index 0f8ce08..c38f73c 100644 --- a/lib/output/problem/subproblem_subs.pm +++ b/lib/output/problem/subproblem_subs.pm @@ -634,8 +634,10 @@ start _read_covmatrix push( @{$self -> {'correlation_matrix'}}, eval($element) ) unless ( $element eq '.........' ); } - $self -> {'inverse_covariance_matrix'} = Math::MatrixReal -> - new_from_cols( make_square( clear_dots( $self -> {'raw_invcovmatrix'} ) ) ); + if( defined $self -> {'raw_invcovmatrix'} ) { + $self -> {'inverse_covariance_matrix'} = Math::MatrixReal -> + new_from_cols( make_square( clear_dots( $self -> {'raw_invcovmatrix'} ) ) ); + } # foreach my $element ( @{$self -> {'raw_invcovmatrix'}} ) { # push( @{$self -> {'inverse_covariance_matrix'}}, eval($element) ) unless ( $element eq '.........' ); @@ -1464,8 +1466,12 @@ start _read_thomsi my @allests = eval( '@'.$param ); my @estflags = @{$self -> {'estimated_'.$param.'s'}}; my @ests; - die "Something is wrong: All $param"."s: $#allests and estimated thetas: ". - "$#estflags do not match\n" unless +# print "$param\n"; +# print Dumper \@allests; +# print Dumper \@estflags; + + die "Something is wrong: All $param"."s: ".($#allests+1)." and estimated $param"."s: ". + ($#estflags+1)." do not match\n" unless ( $#allests == -1 or $#estflags == $#allests ); my $defs = 0; for( my $i = 0; $i <= $#allests; $i++ ) { diff --git a/lib/output/problem_subs.pm b/lib/output/problem_subs.pm index 1e6f83d..d39b1c7 100644 --- a/lib/output/problem_subs.pm +++ b/lib/output/problem_subs.pm @@ -305,36 +305,32 @@ end _read_covstep start _read_inits { my $start_pos = $self -> {'lstfile_pos'}; - my ( @thetas, @omegas, @sigmas, $fixed ); + my ( @thetas, @omegas, @sigmas ); my $thetarea = 0; - my $omegarea = 0; - my $sigmarea = 0; my $success = 0; my $tmp = $start_pos; - # Look for a general statement of fixed sigmas + # Look for a general statement of fixed sigmas and omegas my $all_sigmas_fixed = 0; + my $all_omegas_fixed = 0; while( $_ = @{$self -> {'lstfile'}}[ $tmp++ ] ) { if ( /^0SIGMA CONSTRAINED TO BE THIS INITIAL ESTIMATE/ ) { $all_sigmas_fixed = 1; } + if ( /^0OMEGA CONSTRAINED TO BE THIS INITIAL ESTIMATE/ ) { + $all_omegas_fixed = 1; + } if ( /^0ESTIMATION STEP OMITTED/ ) { last; } } - + while( $_ = @{$self -> {'lstfile'}}[ $start_pos++ ] ) { last if ( /^ PROBLEM.*SUBPROBLEM/ or /^ PROBLEM NO\.:\s+\d/ ); if ( /^0INITIAL ESTIMATE OF THETA:/ ) { $success = 1; $thetarea = 1; } - if ( /^0INITIAL ESTIMATE OF SIGMA:/ ) { - $sigmarea = 1; - $omegarea = 0; - $thetarea = 0; - $fixed = 0; - } last if ( /^0ESTIMATION STEP OMITTED:/ ); if ( $thetarea and /^\s*-?\d*\.\d*/ ) { my @T = split(' ',$_); @@ -359,6 +355,9 @@ start _read_inits foreach my $block ( @blocks ) { my @fix_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]); my $fix = $fix_row[1] eq 'YES' ? 1 : 0; + if( $all_omegas_fixed ) { + $fix = 1; + } for ( my $size = 1; $size <= $om_bl{$block}{'size'}; $size++ ) { for ( my $row = $start_pos ; $row < $start_pos + $om_bl{$block}{'dimension'}; $row++ ) { my @init_row = split(' ', $self -> {'lstfile'}[ $row ]); @@ -377,42 +376,75 @@ start _read_inits while( not $self -> {'lstfile'}[ $start_pos ] =~ /^0/ ) { my @init_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]); my $init = eval($init_row[$#init_row]); - push( @{$self -> {'fixedomegas'}}, 0 ) unless ( $init == 0 ); - push( @{$self -> {'estimated_omegas'}}, 1 ); - push(@{$self -> {'initomegas'}}, eval($init) ) unless ( $init == 0 ); + unless( $init == 0 ) { + push( @{$self -> {'fixedomegas'}}, $all_omegas_fixed ? 1 : 0 ); + push( @{$self -> {'initomegas'}}, eval($init) ); + } + push( @{$self -> {'estimated_omegas'}}, $all_omegas_fixed ? 0 : 1 ); push(@{$self -> {'lower_omega_bounds'}},0); push(@{$self -> {'upper_omega_bounds'}},1000000); } } } - if ( ($omegarea or $sigmarea) and /^\s+\d+\s+\w+/ ) { - my @T = split(' ',$_); - $fixed = $T[1] eq 'YES' ? 1 : 0; - } - if( $all_sigmas_fixed and $sigmarea ) { - $fixed = 1; + if ( /^0INITIAL ESTIMATE OF SIGMA:/ ) { + $thetarea = 0; + if ( defined $self -> {'sigma_block_sets'} and + scalar keys %{$self -> {'sigma_block_sets'}} > 0 ) { + $start_pos++; + my %si_bl = %{$self -> {'sigma_block_sets'}}; + my @blocks = sort {$a <=> $b} keys %si_bl; + foreach my $block ( @blocks ) { + my @fix_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]); + my $fix = $fix_row[1] eq 'YES' ? 1 : 0; + if( $all_sigmas_fixed ) { + $fix = 1; + } + for ( my $size = 1; $size <= $si_bl{$block}{'size'}; $size++ ) { + for ( my $row = $start_pos ; $row < $start_pos + $si_bl{$block}{'dimension'}; $row++ ) { + my @init_row = split(' ', $self -> {'lstfile'}[ $row ]); + foreach my $init ( @init_row ) { + push( @{$self -> {'fixedsigmas'}}, $fix ); + push( @{$self -> {'estimated_sigmas'}}, (not $fix and $size == 1) ? 1 : 0 ); + push(@{$self -> {'initsigmas'}}, eval($init) ); + push(@{$self -> {'lower_sigma_bounds'}},0); + push(@{$self -> {'upper_sigma_bounds'}},1000000); + } + } + } + $start_pos += $si_bl{$block}{'dimension'}; + } + } else { + while( not $self -> {'lstfile'}[ $start_pos ] =~ /^0/ ) { + my @init_row = split(' ', $self -> {'lstfile'}[ $start_pos++ ]); + my $init = eval($init_row[$#init_row]); + unless( $init == 0 ) { + push( @{$self -> {'fixedsigmas'}}, $all_sigmas_fixed ? 1 : 0 ); + push( @{$self -> {'initsigmas'}}, eval($init) ); + } + push( @{$self -> {'estimated_sigmas'}}, $all_sigmas_fixed ? 0 : 1 ); + push(@{$self -> {'lower_sigma_bounds'}},0); + push(@{$self -> {'upper_sigma_bounds'}},1000000); + } + } } -# if ( $omegarea and /^\s*-?\d*\.\d*/ ) { +# if ( ($omegarea or $sigmarea) and /^\s+\d+\s+\w+/ ) { +# my @T = split(' ',$_); +# $fixed = $T[1] eq 'YES' ? 1 : 0; +# } +# if( $all_sigmas_fixed and $sigmarea ) { +# $fixed = 1; +# } +# if ( $sigmarea and /^\s*-?\d*\.\d*/ ) { # my @T = split(' ',$_); # for my $i (0..(@T-1)) { # $T[$i] = eval($T[$i]); -# push(@{$self -> {'initomegas'}},$T[$i]);# if ( $T[$i] != 0 ); -# push(@{$self -> {'fixedomegas'}},$fixed);# if ( $T[$i] != 0 ); -# push(@{$self -> {'lower_omega_bounds'}},0); -# push(@{$self -> {'upper_omega_bounds'}},1000000); +# push(@{$self -> {'initsigmas'}},$T[$i]);# if ( $T[$i] != 0 ); +# push(@{$self -> {'fixedsigmas'}},$fixed);# if ( $T[$i] != 0 ); +# push(@{$self -> {'estimated_sigmas'}},$fixed==1?0:1);# if ( $T[$i] != 0 ); +# push(@{$self -> {'lower_sigma_bounds'}},0); +# push(@{$self -> {'upper_sigma_bounds'}},1000000); # } # } - if ( $sigmarea and /^\s*-?\d*\.\d*/ ) { - my @T = split(' ',$_); - for my $i (0..(@T-1)) { - $T[$i] = eval($T[$i]); - push(@{$self -> {'initsigmas'}},$T[$i]);# if ( $T[$i] != 0 ); - push(@{$self -> {'fixedsigmas'}},$fixed);# if ( $T[$i] != 0 ); - push(@{$self -> {'estimated_sigmas'}},$fixed==1?0:1);# if ( $T[$i] != 0 ); - push(@{$self -> {'lower_sigma_bounds'}},0); - push(@{$self -> {'upper_sigma_bounds'}},1000000); - } - } if ( /^0MINIMIZATION/ ) { last; } diff --git a/lib/tool/cdd_subs.pm b/lib/tool/cdd_subs.pm index e18e7a1..739acbb 100644 --- a/lib/tool/cdd_subs.pm +++ b/lib/tool/cdd_subs.pm @@ -1098,6 +1098,8 @@ start modelfit_analyze for ( my $i = 0; $i <= $#changes; $i++ ) { my $vec_changes = Math::MatrixReal -> new_from_cols( [$changes[$i]] ); +# print $inverse_covariance_matrix; +# print $vec_changes; $cook_score[$i] = $inverse_covariance_matrix*$vec_changes; $cook_score[$i] = ~$vec_changes*$cook_score[$i]; my $nl = $i == $#changes ? "" : "\r"; diff --git a/lib/tool/llp_subs.pm b/lib/tool/llp_subs.pm index 1331234..2070563 100644 --- a/lib/tool/llp_subs.pm +++ b/lib/tool/llp_subs.pm @@ -236,31 +236,32 @@ start modelfit_setup # {{{ modelfit - # Create a modelfit tool for all the models of this step. - # This is the last setup part before running the step. - my %subargs = (); - if ( defined $self -> {'subtool_arguments'} ) { - %subargs = %{$self -> {'subtool_arguments'}}; + if( defined $self -> {'prepared_models'} and scalar @{$self -> {'prepared_models'}} > 0 ) { + # Create a modelfit tool for all the models of this step. + # This is the last setup part before running the step. + my %subargs = (); + if ( defined $self -> {'subtool_arguments'} ) { + %subargs = %{$self -> {'subtool_arguments'}}; + } + push( @{$self -> {'tools'}}, + tool::modelfit -> + new( reference_object => $self, + models => $self -> {'prepared_models'}, + threads => $mfit_threads, + base_directory => $self -> {'directory'}, + directory => $self -> {'directory'}.'/modelfit_dir'.$model_number, + _raw_results_callback => $self -> _modelfit_raw_results_callback, + subtools => [], + parent_threads => $own_threads, + parent_tool_id => $self -> {'tool_id'}, + raw_results_file => $self -> {'raw_results_file'}[$model_number-1], + logfile => undef, + raw_results => undef, + prepared_models => undef, + raw_results_header => undef, + tools => undef, + %subargs ) ); } - push( @{$self -> {'tools'}}, - tool::modelfit -> - new( reference_object => $self, - models => $self -> {'prepared_models'}, - threads => $mfit_threads, - base_directory => $self -> {'directory'}, - directory => $self -> {'directory'}.'/modelfit_dir'.$model_number, - _raw_results_callback => $self -> _modelfit_raw_results_callback, - subtools => [], - parent_threads => $own_threads, - parent_tool_id => $self -> {'tool_id'}, - raw_results_file => $self -> {'raw_results_file'}[$model_number-1], - logfile => undef, - raw_results => undef, - prepared_models => undef, - raw_results_header => undef, - tools => undef, - %subargs ) ); - # $Data::Dumper::Maxdepth = 3; # die Dumper $self -> {'tools'} if not $first; @@ -808,7 +809,7 @@ start modelfit_analyze } } else { $self -> {'raw_results'}[$model_number-1] = - $self -> {'tools'} -> [0] -> raw_results; + $self -> {'tools'} -> [0] -> raw_results if( defined $self -> {'tools'} -> [0] ); } } end modelfit_analyze diff --git a/lib/tool/modelfit_subs.pm b/lib/tool/modelfit_subs.pm index fadd827..a14f979 100644 --- a/lib/tool/modelfit_subs.pm +++ b/lib/tool/modelfit_subs.pm @@ -1678,10 +1678,12 @@ start run_nonmem } # First pass to get lowest OFV's - my $lowest_OFV = $run_results[0] -> {'ofv'}; + my $lowest_OFV = defined ($run_results[0] -> {'ofv'})? $run_results[0] -> {'ofv'} : 999999999; for(my $i = 1; $i < scalar @run_results; $i++ ){ - $lowest_OFV = $run_results[$i] -> {'ofv'} < $lowest_OFV ? - $run_results[$i] -> {'ofv'} : $lowest_OFV; + if( defined( $run_results[$i] -> {'ofv'} ) ) { + $lowest_OFV = $run_results[$i] -> {'ofv'} < $lowest_OFV ? + $run_results[$i] -> {'ofv'} : $lowest_OFV; + } } my $accepted_OFV_diff = 5; diff --git a/lib/tool_subs.pm b/lib/tool_subs.pm index f3d76f3..718285d 100644 --- a/lib/tool_subs.pm +++ b/lib/tool_subs.pm @@ -782,7 +782,8 @@ start run } } else { - debug -> die( message => "No tool object to run from tool object." ); + debug -> warn( level => 2, + message => "No tool object to run from tool object." ); } $self -> {'results'}[$i-1]{'subtools'}= \@tool_results; @@ -881,7 +882,7 @@ end _prepare_model start analyze { $self -> {'raw_results'}[$model_number-1] = - $self -> {'tools'} -> [0] -> raw_results; + $self -> {'tools'} -> [0] -> raw_results if( defined $self -> {'tools'} -> [0] ); my $sub_analyze = $self -> {'subtools'} -> [0]; if ( defined $sub_analyze ) { $sub_analyze = $sub_analyze.'_analyze'; -- 2.11.4.GIT