Fixed $PRIOR support and bugfix in shrinkage results handling
[PsN.git] / bin / mc_cdd
blob6e0803332927902905c7d886d86d8c51f9fe3b24
1 #!/usr/local/bin/perl
3 use FindBin qw($Bin);
4 use lib "$Bin/../lib";
6 # Don't edit the line below, it must look exactly like this.
7 # Everything above this line will be replaced #
9 use PsN;
10 use model;
11 use tool::mc;
12 use strict;
13 use debug;
14 use Getopt::Long;
15 use common_options;
17 my $cmd_line = $0 . " " . join( " ", @ARGV );
19 ## Configure the command line parsing
20 Getopt::Long::config("auto_abbrev");
22 my %options;
23 ## Declare the options
25 my %required_options = ( 'case_column:s' => 'column_name|column_number',
26 'samples:i' => '100',
27 'alternative_model:s' => 'alt.mod' );
28 my %optional_options = ( "bins:i" => '',
29 "selection_method:s" => '\'random\'|\'consecutive\'' );
31 my $res = GetOptions( \%options,
32 @common_options::get_opt_strings,
33 keys(%required_options),
34 keys(%optional_options) );
35 exit unless $res;
37 my %help_text;
39 $help_text{Pre_help_message} = <<'EOF';
40 mc_cdd
42 Perl script for Monte-carlo Simulation of Case-Deletion Diagnostics of NONMEM runs.
44 Usage:
45 EOF
47 $help_text{Description} = <<'EOF';
48 Description:
50 The Case Deletion Diagnostics tool is run from the command line
51 with a few mandatory arguments. MC_CDD is run as a diagnostic after
52 a model is regarded finished or at least mature enough to run
53 validation tool on. You need to specify the NONMEM modelfile
54 with a model that have successful termination. You also have to
55 specify the number or name of the datafile column on which to
56 select for deletion. You do so with the case_column option.
57 EOF
59 $help_text{Examples} = <<'EOF';
60 Example:
62 mc_cdd -model=run89.mod -case_column=10
64 This will perform a Case Deletion Diagnostic on the model
65 specified in run89.mod based on the factors in column ten. If,
66 for example, column ten holds the ids of the seven centers
67 included in the study, this command will create seven copies of
68 the dataset, each with individuals included in one specific
69 center deleted. Say that the centers are numbered 1 to 7. Then
70 dataset 1 will have individuals from center 1 excluded, dataset
71 2 individuals from center 2 and so on.
72 EOF
74 $help_text{Options} = <<'EOF';
75 Options:
77 The options are given here in their long form. Any option may be
78 abbreviated to any nonconflicting prefix. The -threads option
79 may be abbreviated to -t(or even -thr) but -debug may not be
80 abbreviated to -d because it conflicts with -debug_packages and
81 -debug_subroutines.
83 The following options are valid:
84 EOF
86 $help_text{-h} = <<'EOF';
87 -h | -?
89 With -h or -? mc_cdd will print a list of options and exit.
90 EOF
92 $help_text{-help} = <<'EOF';
93 -help
95 With -help mc_cdd will print this, longer, help message.
96 EOF
98 $help_text{-bins} = <<'EOF';
99 -bins=$number
101 Sets the number of databins, or mc_cdd datasets, to use. If the
102 number of unique values, or factors, in the based_on column is
103 higher than the number of bins then one or more factors will be
104 deleted in each mc_cdd dataset. Specifying $number as higher than
105 the number of factors will have no effect. The bin number is
106 then set to the number of factors.
107 Default value = Number of unique values in the based_on column.
110 $help_text{-selection_method} = <<'EOF';
111 -selection_method='random' or 'consecutive'
113 Specifies whether the factors selected for exclusion should be
114 drawn randomly or consecutively from the datafile.
115 Default value = 'consecutive'
118 $help_text{-case_column} = <<'EOF';
119 -case_column=column_name|column_number
122 $help_text{Post_help_message} = <<'EOF';
123 Also see 'execute -help' for a description of common options.
126 common_options::online_help( 'mc_cdd', \%options, \%help_text, \%required_options, \%optional_options);
128 ## Check that we do have a model file
129 if ( scalar(@ARGV) < 1 ) {
130 print "A model file must be specified. Use 'mc_cdd -h' for help.\n";
131 exit;
134 if( scalar(@ARGV) > 1 ){
135 print "MC_CDD can only handle one modelfile. Use 'mc_cdd -h' for help.\n";die;
136 exit;
139 unless ( defined $options{'case_column'} ){
140 print "case_column must be given\n" ;
141 exit;
144 unless ( defined $options{'alternative_model'} ){
145 print "alternative_model must be given\n" ;
146 exit;
149 unless ( defined $options{'samples'} ){
150 print "samples must be given\n" ;
151 exit;
154 ui -> category( 'mc_cdd' );
155 ui -> silent(1) if( $options{'silent'} );
157 debug -> level( $options{'debug'} );
158 debug -> package( $options{'debug_package'} );
159 debug -> subroutine( $options{'debug_subroutine'} );
160 debug -> warn_with_trace( $options{'warn_with_trace'} );
162 my $eval_string = common_options::model_parameters(\%options);
164 my $model = model -> new ( eval( $eval_string ),
165 filename => $ARGV[0],
166 ignore_missing_output_files => 1 );
168 my $alternative_model = model ->
169 new ( eval( $eval_string ),
170 filename => $options{'alternative_model'},
171 ignore_missing_output_files => 1 );
173 ## Create new Mc_Cdd object:
174 my $mc_cdd = tool::mc ->
175 new ( eval( $common_options::parameters ),
176 models => [ $model ],
177 alternative_models => [ $alternative_model ],
178 samples => $options{'samples'},
179 subtools => ['cdd'],
180 subtool_arguments => {
181 bins => $options{'bins'},
182 selection_method => $options{'selection_method'},
183 case_columns => $options{'case_column'} } );
185 open(CMD, ">", $mc_cdd -> directory . "/command.txt");
186 print CMD $cmd_line, "\n";
187 close(CMD);
189 $mc_cdd -> run;
190 $mc_cdd -> print_results;