bin/scm

   1 #!/usr/local/bin/perl
   2
   3 use FindBin qw($Bin);
   4 use lib "$Bin/../lib";
   5
   6 # Don't edit the line below, it must look exactly like this.
   7 # Everything above this line will be replaced #
   8
   9 use PsN;
  10 use file;
  11 use model;
  12 use tool::scm;
  13 use tool::scm::config_file;
  14 use debug;
  15 use strict;
  16 use Getopt::Long;
  17 use Cwd;
  18 use common_options;
  19 use ui;
  20
  21 my $cmd_line = $0 . " " . join( " ", @ARGV );
  22
  23 my %options;
  24
  25 my %required_options = ( "config_file:s" => '');
  26
  27 my %optional_options = ( "fix" => '',
  28                          "search_direction:s" => 'forward|backward|both',
  29                          "gof:s" => '',
  30                          "global_init:s" => '',
  31                          "logfile:s" => '',
  32                          "model:s" => '',
  33                          "backwards_dir:s" => '',
  34                          "p_value:s" => '',
  35                          "p_forward:s" => '',
  36                          "p_backward:s" => '',
  37                          "do_not_drop:s" => '');
  38
  39 my $res = GetOptions( \%options,
  40                       @common_options::get_opt_strings,
  41                       keys(%required_options),
  42                       keys(%optional_options)
  43                       );
  44 exit unless $res;
  45
  46 common_options::set_globals( \%options, 'scm' );
  47 common_options::get_defaults( \%options, 'scm' );
  48 common_options::sanity_checks( \%options, 'scm' );
  49
  50 my %help_text;
  51 $help_text{Pre_help_message} = <<'EOF';
  52   <h3 class="heading1">scm</h3>
  53
  54   Perl script for stepwise covariate model building from NONMEM models.
  55
  56   <h3 class="heading1">Usage:</h3>
  57 EOF
  58
  59     $help_text{Description} = <<'EOF';
  60 <style type="text/css">
  61 <!--
  62 .style5 {font-family: "Courier New", Courier, monospace; font-weight: bold; font-size: 14px; }
  63 -->
  64 </style>
  65   <h3 class="heading1">Description:</h3>
  66
  67     The Stepwise Covariate Model (SCM) building tool of PsN implements
  68     Forward Selection and Backward Elimination of covariates to a
  69     model. In short, one model for each relevant parameter-covariate
  70     relationship is prepared and tested in a univariate manner. In the
  71     first step the model that gives the best fit of the data according
  72     to some criteria is retained and taken forward to the next
  73     step. In the following steps all remaining parameter-covariate
  74     combinations are tested until no more covariates meet the criteria
  75     for being included into the model. The Forward Selection can be
  76     followed by Backward Elimination, which proceeds as the Forward
  77     Selection but reversely, using stricter criteria for model
  78     improvement.
  79
  80     <br><br>
  81
  82     The Stepwise Covariate Model building procedure is run by the PsN
  83     tool <span class="style5">scm</span>. The options to <span
  84     class="style5">scm</span> can (and should) be rather complex to
  85     describe all features of a covariate model building procedure. To
  86     make it easier for the user, a configuration file should be
  87     written for each scm run. The options can be specified in this
  88     file instead of the command line.
  89
  90
  91     <!--/>Read more on our homepage: www.sf.net/psn.<-->
  92
  93 EOF
  94
  95     $help_text{Examples} = <<'EOF';
  96   <h3 class="heading1">Examples:</h3>
  97
  98     Execute an SCM using parameters set in the config file
  99     'phenobarbital.scm'.
 100
 101        <p class="style2">$ scm -config_file=phenobarbital.scm</p>
 102
 103     Execute an SCM using parameters set in the config file
 104     'phenobarbital.scm'. But override the retries and the seed
 105     parameter.
 106
 107        <p class="style2">$ scm -config_file=phenobarbital.scm -retries=5 -seed=12345 phenobarbital.mod</p>
 108 EOF
 109
 110     $help_text{Options} = <<'EOF';
 111   <h3 class="heading1">Options:</h3>
 112
 113     The options are given here in their long form. Any option may be
 114     abbreviated to any nonconflicting prefix. The -threads option may
 115     be abbreviated to <span class="style2">-thr</span> but <span class="style2">-debug</span> may not be abbreviated to <span class="style2">-d</span>
 116     because it conflicts with <span class="style2">-debug_packages</span> and <span class="style2">-debug_subroutines</span>.
 117
 118     The following options are valid:
 119 EOF
 120
 121     $help_text{-h} = <<'EOF';
 122     <p class="style2">-h | -?</p>
 123
 124     With -h or -? scm will print a list of options and exit.
 125 EOF
 126
 127     $help_text{-help} = <<'EOF';
 128     <p class="style2">-help</p>
 129
 130     With -help scm will print this, longer, help message.
 131 EOF
 132
 133     $help_text{-config_file} = <<'EOF';
 134     <p class="style2">-config_file</p>
 135
 136     A path and file name to an scm configuration file.
 137 EOF
 138
 139     $help_text{-fix} = <<'EOF';
 140     <p class="style2">-fix</p>
 141 EOF
 142
 143     $help_text{-search_direction} = <<'EOF';
 144     <p class="style2">-search_direction</p>
 145
 146     Which search task to perform: backward, forward or both is allowed.
 147 EOF
 148
 149     $help_text{-gof} = << 'EOF';
 150     <p class="style2">-gof</p>
 151 EOF
 152
 153     $help_text{-global_init} = << 'EOF';
 154     <p class="style2">-global_init</p>
 155 EOF
 156
 157     $help_text{-logfile} = << 'EOF';
 158     <p class="style2">-logfile</p>
 159
 160     The name of the logfile.
 161 EOF
 162
 163     $help_text{-model} = << 'EOF';
 164     <p class="style2">-model</p>
 165
 166     The name of the basic model file, without any parameter-covariate
 167     relations included.
 168 EOF
 169
 170     $help_text{-p_value} = << 'EOF';
 171     <p class="style2">-p_value</p>
 172
 173     Use this option to set the p_value for both forward and backward
 174     steps.
 175 EOF
 176
 177     $help_text{-p_forward} = << 'EOF';
 178     <p class="style2">-p_forward</p>
 179
 180     Using the p_forward option, you can specify the p-value to use for
 181     the forward selection.
 182 EOF
 183
 184     $help_text{-p_backward} = << 'EOF';
 185     <p class="style2">-p_backward</p>
 186
 187     Using the p_backward option, you can specify the p-value to use
 188     for the backward deletion.
 189 EOF
 190
 191     $help_text{-do_not_drop} = << 'EOF';
 192     <p class="style2">-do_not_drop</p>
 193
 194     Since the number of columns are restricted to 20 for NONMEM it is
 195     necessary to minimize the number of undropped columns. The scm
 196     utility uses the '=DROP' syntax of NONMEM to exclude the covariate
 197     columns that are not used. If some covariates are used in the PK
 198     or PRED code in the basic model you must list them using the
 199     do_not_drop option to prevent them from being dropped.
 200 EOF
 201
 202     $help_text{Post_help_message} = <<'EOF';
 203     Also see 'execute.pl -help' for a description of common options.
 204 EOF
 205
 206 common_options::online_help( 'scm', \%options, \%help_text, \%required_options, \%optional_options);
 207
 208 if ( $options{'config_file'} eq '' ){
 209   print "Please specify a config file \n";
 210   exit;
 211 }
 212
 213 my $config_file;
 214 if( -e $options{'config_file'} ){
 215   my $file = file -> new( name => $options{'config_file'}, path => '.' );
 216   $config_file = 'tool::scm::config_file' -> new ( file => $file );
 217
 218   foreach my $option ( keys %{$config_file -> valid_scalar_options} ){
 219     if( $options{$option} ) {
 220       $config_file -> $option($options{$option});
 221     }
 222   }
 223
 224   foreach my $option ( keys %{$config_file -> valid_code_options} ){
 225     if( $options{$option} ){
 226       $config_file -> $option(eval($options{$option}));
 227     }
 228   }
 229
 230   foreach my $option ( keys %{$config_file -> valid_array_options} ){
 231     if( $options{$option} ){
 232       my @arr = split( /,/ , $options{$option});
 233       $config_file -> $option(\@arr);
 234     }
 235   }
 236
 237 } else {
 238   print "Error: config file $options{'config_file'} is missing.\n" ;
 239   exit;
 240 }
 241
 242 # Moved here as a quick fix. Consider automating option handling from
 243 # the config file diagram.
 244 common_options::get_defaults( \%options, 'scm' );
 245
 246 my $eval_string = common_options::model_parameters(\%options);
 247
 248 if( defined $config_file and $config_file -> extra_data_files ){
 249   foreach my $extra_data_file ( keys %{$config_file -> extra_data_files} ){
 250     push( @{$options{'extra_data_files'}}, $extra_data_file );
 251     push( @{$options{'extra_data_headers'}}, $config_file -> extra_data_files -> {$extra_data_file} );
 252   }
 253 }
 254
 255 if( defined $config_file -> gof ) {
 256   use lib getcwd();
 257   my $tmp = $config_file -> gof;
 258   require $tmp.".pm";
 259 #  $tmp =~ s/\.pm//;
 260   $tmp = $tmp.'::test';
 261   $config_file -> gof( \&$tmp );
 262 }
 263
 264 my $models_array = [ model -> new ( eval $eval_string,
 265                                     filename           => $config_file -> model,
 266                                     target             => 'disk' ) ] ;
 267
 268 my $direction = $config_file -> search_direction;
 269
 270 my $scm;
 271
 272 if( $direction eq 'forward' or $direction eq 'both' ){
 273   print ui -> print( category => 'scm',
 274                      message => "Starting scm forward search" );
 275
 276   my $orig_ofv;
 277   my $orig_p_value;
 278   if( -e $options{'config_file'} ){
 279
 280     if( defined $config_file -> ofv_forward ){
 281       $orig_ofv = $config_file -> ofv_change;
 282       $config_file -> ofv_change($config_file -> ofv_forward);
 283     }
 284
 285     if( defined $config_file -> p_forward ){
 286       $orig_p_value = $config_file -> p_value;
 287       $config_file -> p_value( $config_file -> p_forward );
 288     }
 289
 290   }
 291
 292   $config_file -> search_direction( 'forward' );
 293
 294   $scm = tool::scm ->
 295       new ( eval( $common_options::parameters ),
 296             models      => $models_array,
 297             config_file => $config_file );
 298   open(CMD, ">", $scm -> directory . "/command.txt");
 299   print CMD $cmd_line, "\n";
 300   close(CMD);
 301
 302   $scm -> run;
 303
 304   #$scm -> print_results;
 305
 306   if( -e $options{'config_file'} ){
 307     if( defined $orig_ofv ){
 308       $config_file -> ofv_change( $orig_ofv );
 309     }
 310
 311     if( defined $orig_p_value ){
 312       $config_file -> p_value( $orig_p_value );
 313     }
 314
 315     if( defined $scm -> base_criteria_values ){
 316       $config_file -> base_criteria_values( @{$scm -> base_criteria_values}[0] );
 317     }
 318
 319     if( defined $scm -> included_relations ){
 320       $config_file -> included_relations( @{$scm -> included_relations}[0] );
 321     }
 322   }
 323 }
 324
 325 if( $direction eq 'backward' or $direction eq 'both' ){
 326
 327   if( -e $options{'config_file'} ){
 328     if( defined $config_file -> ofv_backward ){
 329       $config_file -> ofv_change( $config_file -> ofv_backward );
 330     }
 331
 332     if( defined $config_file -> p_backward ){
 333       $config_file -> p_value( $config_file -> p_backward );
 334     }
 335
 336   }
 337
 338   $config_file -> search_direction( 'backward' );
 339
 340   my $scm_back = tool::scm ->
 341       new ( eval( $common_options::parameters ),
 342 #           included_relations => $scm -> included_relations,
 343             directory   => ( defined $options{'backwards_dir'} and
 344                              $options{'backwards_dir'} ne '' ) ? $options{'backwards_dir'} : $config_file -> directory,
 345             models      => $models_array,
 346             config_file => $config_file );
 347
 348   ui -> print( category => 'scm',
 349                message => "Starting scm backward search" );
 350
 351   open(CMD, ">", $scm_back -> directory . "/command.txt");
 352   print CMD $cmd_line, "\n";
 353   close(CMD);
 354
 355   $scm_back -> run;
 356
 357   #$scm_back -> print_results;
 358 }
 359
 360 ui -> print( category => 'scm',
 361              message => "Done" );