lib/model/mirror_plot_module_subs.pm

   1
   2 # {{{ Documentation
   3
   4 The mirror plot module will add an extra problem that simulates from
   5 the original model. We asume here that there is only one problem in
   6 the original model.
   7
   8 The parameters are the number of mirror plots to obtain (which is the
   9 number of simulations we must perform).
  10
  11 The tables will be renamed from *tab1 to *tab1sim
  12
  13 # }}}
  14
  15 start include statements
  16     use Math::Random;
  17 end include statements
  18 # {{{ new
  19
  20 start new
  21 {
  22   my $base_model = $this -> {'base_model'};
  23
  24   my $prob_num;
  25
  26   if( $this -> cwres and not $base_model -> is_run ){
  27     'debug' -> die( message => 'To create mirror plots for cwres tables, you must have run the model with cwres separately' )
  28   }
  29
  30   if( $this -> cwres and not $this -> {'mirror_from_lst'} ){
  31     'debug' -> warn( message => 'MSFO computation method cannot be used with cwres. mirror_from_lst enabled' );
  32     $this -> {'mirror_from_lst'} = 1;
  33   }
  34
  35   my $msfo_names = $base_model -> msfo_names( problem_numbers => [1] );
  36   my $msfi_names = $base_model -> msfi_names( );
  37
  38   if( $base_model -> is_run and $this -> {'mirror_from_lst'} ){
  39
  40     # 1. Update initial estimates from file.
  41
  42     $base_model -> update_inits( from_model => $base_model );
  43
  44     my $table_file_names = $base_model -> table_names( problem_numbers => [1] );
  45
  46     for( my $i; $i < @{$table_file_names -> [0]}; $i++ ){
  47       $table_file_names -> [0] -> [$i] =~ s/(.*)(\d+)(.*)/$1$2sim$3/;
  48     }
  49
  50     $base_model -> table_names( new_names => $table_file_names,
  51                                 problem_numbers => [1] );
  52
  53     $base_model -> remove_records( type => 'covariance' );
  54
  55     $base_model -> remove_option( record_name => 'estimation',
  56                                   option_name => 'MSFO',
  57                                   problem_numbers => [1]);
  58
  59     $prob_num = 1;
  60
  61   } elsif( ( defined $msfo_names -> [0] and -e $msfo_names -> [0][0])
  62            or
  63            ( defined $msfi_names -> [0] and -e $msfi_names -> [0][0]) ){
  64
  65     if( defined $msfo_names -> [0] and -e $msfo_names -> [0][0] ){
  66       print "Have msfo\n";
  67     }
  68
  69     my $have_msfi;
  70
  71     if( defined $msfi_names -> [0] and -e $msfi_names -> [0][0] ){
  72       print "Have msfi\n";
  73       $have_msfi = 1;
  74     }
  75
  76     unless( $have_msfi ){
  77
  78       # If we end up here, we know we have msfo file and we need to
  79       # set the $MSFI record, remove inits and add mirror code like
  80       # above. And remove msfo?
  81
  82       my $msfo_name = $msfo_names -> [0][0];
  83
  84       $base_model -> set_records( type => 'msfi',
  85                                   record_strings => [$msfo_name] );
  86
  87       $base_model -> remove_records( type => 'theta' );
  88       $base_model -> remove_records( type => 'omega' );
  89       $base_model -> remove_records( type => 'sigma' );
  90
  91       my $table_file_names = $base_model -> table_names( problem_numbers => [1] );
  92
  93       for( my $i; $i < @{$table_file_names -> [0]}; $i++ ){
  94         $table_file_names -> [0] -> [$i] =~ s/(.*)(\d+)(.*)/$1$2sim$3/;
  95       }
  96
  97       $base_model -> table_names( new_names => $table_file_names,
  98                                   problem_numbers => [1] );
  99
 100       $base_model -> remove_records( type => 'covariance' );
 101
 102       $base_model -> remove_option( record_name => 'estimation',
 103                                     option_name => 'MSFO',
 104                                     problem_numbers => [1]);
 105
 106     }
 107
 108     $prob_num = 1;
 109
 110   } else {
 111
 112     my $problems = $#{$base_model -> problems};
 113
 114     my $sh_mod = model::shrinkage_module -> new ( model   => $base_model,
 115                                                   temp_problem_number => ($problems+2));
 116
 117     $sh_mod -> disable();
 118
 119     $base_model -> add_problem( init_data => { prob_arr => ['$PROB'],
 120                                                shrinkage_module => $sh_mod });
 121
 122     push( @{$base_model -> {'active_problems'}}, 1 );
 123
 124     push( @{$base_model -> {'datas'}}, $base_model -> datas -> [0] );
 125
 126     # 0. Add $ERROR and PK or PRED code:
 127
 128 #     my $code_block;
 129 #     my $pk = 0;
 130 #     # Find PK or PRED block
 131 #     if( defined $base_model -> pk ){
 132 #       $code_block = $base_model -> pk;
 133 #       $pk = 1;
 134 #     } elsif( defined $base_model -> pred ){
 135 #       $code_block = $base_model -> pred;
 136 #     } else {
 137 #       'debug' -> die( message =>  "Error: No \$PK or \$PRED found..." );
 138 #     }
 139 #     if( $pk ){
 140 #       $base_model -> add_records( type => 'pk',
 141 #                                 problem_numbers => [2],
 142 #                                 record_strings => $code_block );
 143 #     } else {
 144 #       $base_model -> add_records( type => 'pred',
 145 #                                 problem_numbers => [2],
 146 #                                 record_strings => $code_block );
 147 #     }
 148
 149 #     $base_model -> add_records( type => 'subroutine',
 150 #                               problem_numbers => [1],
 151 #                               record_strings => ['LIBRARY'] );
 152
 153 #     if( defined $base_model -> record( record_name => 'error' ) ){
 154 #       my $error_block = $base_model -> record( record_name => 'error' );
 155 #       use Data::Dumper;
 156 #       print Dumper $error_block;
 157 #       $base_model -> add_records( type => 'error',
 158 #                                 problem_numbers => [2],
 159 #                                 record_strings => $error_block -> [0]);
 160 #     }
 161
 162 #    if( defined $base_model -> record( record_name => 'des' ) ){
 163 #      my $des_block = $base_model -> record( record_name => 'des') ;
 164 #      $base_model -> add_records( type => 'des',
 165 #                                 problem_numbers => [2],
 166 #                                 record_strings => $des_block );
 167 #    }
 168
 169     # 1. Add msfo to $estimation
 170
 171     my $estimation = $base_model -> record( record_name => 'estimation' );
 172
 173     $base_model -> add_records( type => 'estimation',
 174                                 problem_numbers => [2],
 175                                 record_strings => $estimation -> [0] );
 176
 177     $base_model -> remove_option( record_name => 'estimation',
 178                                   option_name => 'MSFO',
 179                                   problem_numbers => [2]);
 180
 181     $base_model -> set_option( record_name => 'estimation',
 182                                option_name => 'MSFO',
 183                                option_value => 'msfo',
 184                                problem_numbers => [1] );
 185
 186     # 2. Add $PROBLEM with copy of $INPUT
 187
 188     my $input = $base_model -> record( record_name => 'input' );
 189
 190     $base_model -> set_records( type => 'input',
 191                                 problem_numbers => [2],
 192                                 record_strings => $input -> [0] );
 193
 194     my $data = $base_model -> record( record_name => 'data' );
 195
 196     $base_model -> set_records( type => 'data',
 197                                 problem_numbers => [2],
 198                                 record_strings => $data -> [0] );
 199
 200     $base_model -> set_option( record_name => 'data',
 201                                option_name => 'REWIND',
 202                                problem_numbers => [2] );
 203
 204     # 3. Add $MSFI
 205
 206     $base_model -> set_records( type => 'msfi',
 207                                 problem_numbers => [2],
 208                                 record_strings => ['msfo'] );
 209
 210     my $tables = $base_model -> record( record_name => 'table',
 211                                         problem_number => 1 );
 212
 213     foreach my $table ( @{$tables} ){
 214       $base_model -> add_records( type => 'table',
 215                                   problem_numbers => [2],
 216                                   record_strings => $table );
 217     }
 218
 219     my $table_file_names = $base_model -> table_names( problem_numbers => [2] );
 220
 221     for( my $i; $i < @{$table_file_names -> [0]}; $i++ ){
 222       $table_file_names -> [0] -> [$i] =~ s/(.*)(\d+)(.*)/$1$2sim$3/;
 223     }
 224
 225     my @dummy_array;
 226     $dummy_array[1] = $table_file_names -> [0];
 227
 228     # The call to table_names below is quite horrid. To change the
 229     # table names of the second problem we must provide an array of
 230     # values for the first problem. Fortunately the
 231     # model::record::_option_val method accepts an empty array
 232     # because it shifts values from the array(which will be undef in
 233     # this case) and passes them to model::record::option -> value,
 234     # which then performs a no-op.
 235     #
 236     # Should any of that behaviour change, this brakes.
 237     #
 238     # Phew... glad to get that out of my system!
 239
 240     $base_model -> table_names( new_names => [[],$table_file_names -> [0]],
 241                                 problem_numbers => [1,2] );
 242
 243     $prob_num = 2;
 244
 245   }
 246
 247   # Below is common code for all three cases. The $prob_num variable
 248   # controls where modification is done.
 249
 250   my $seed = random_uniform_integer(1,1,99999999);
 251   my $nr_of_mirrors = $this -> {'nr_of_mirrors'};
 252
 253   if( $nr_of_mirrors < 2 ){
 254     ui->print( category => 'all',
 255                message => 'Number of mirrorplots must be at least two, will run with two.' );
 256     $this -> {'nr_of_mirrors'} = $nr_of_mirrors = 2;
 257   }
 258
 259   $base_model -> set_records( type => 'simulation',
 260                               problem_numbers => [$prob_num],
 261                               record_strings => ["($seed) NSUB=$nr_of_mirrors"] );
 262
 263   $base_model -> set_option( record_name => 'estimation',
 264                              problem_numbers => [$prob_num],
 265                              option_name => 'MAXEVALS',
 266                              option_value => '0',
 267                              fuzzy_match => 1);
 268 }
 269 end new
 270
 271 # }}}