test/lib/scripts_test.pm

   1 package scripts_test;
   2
   3 use strict;
   4 use Test::More tests => 42;
   5 use Config;
   6 use ui;
   7
   8 my @tests = ( 'single_valued_columns',
   9               'create_extra_data_model',
  10               'llp',
  11               'bootstrap',
  12               'cdd',
  13               'scm'
  14               );
  15
  16 sub test {
  17   my $self = shift;
  18   my %parms = @_;
  19   my $verbose          = $parms{'verbose'};
  20   my $debug            = $parms{'debug'};
  21   my $debug_package    = $parms{'debug_package'};
  22   my $debug_subroutine = $parms{'debug_subroutine'};
  23   my $directory        = $parms{'directory'};
  24   my $generate_facit   = $parms{'generate_facit'};
  25   my @opt_tests        = defined $parms{'tests'} ? split( /,/, $parms{'tests'} ) : @tests;
  26
  27   foreach my $test( @opt_tests ){
  28     scripts_test -> $test( verbose          => $verbose,
  29                            debug            => $debug,
  30                            debug_package    => $debug_package,
  31                            debug_subroutine => $debug_subroutine,
  32                            generate_facit   => $generate_facit,
  33                            directory        => $directory );
  34   }
  35 }
  36
  37 sub os_format {
  38   my $str = shift;
  39   $str =~ s/\/\//\//g;
  40   if( $Config{osname} eq 'MSWin32' ){
  41     $str =~ s/\//\\/g;
  42     $str = "perl $str";
  43  }
  44   return $str;
  45 }
  46
  47 sub single_valued_columns {
  48   my $self = shift;
  49   my %parms = @_;
  50   my $verbose          = $parms{'verbose'};
  51   my $debug            = $parms{'debug'};
  52   my $debug_package    = $parms{'debug_package'};
  53   my $debug_subroutine = $parms{'debug_subroutine'};
  54   my $directory        = $parms{'directory'};
  55   my $generate_facit   = $parms{'generate_facit'};
  56
  57   my $bin = "$directory/../bin/single_valued_columns";
  58   my $options = "-data=$directory/files/utilities/pheno.dta ".
  59     "-sub=testsub.dta -rem=testrem.dta -do_not=4";
  60
  61   system( &os_format( $bin . " ". $options ) );
  62
  63   my $success;
  64  SKIP: {
  65    if( $generate_facit ){
  66      system("cp $directory/files/utilities/testsub.dta $directory/files/utilities/pheno_single.dta" );
  67      system("cp $directory/files/utilities/testrem.dta $directory/files/utilities/pheno_reduced.dta" );
  68      skip "Generating facit", 1;
  69    }
  70    $success = ok( -e "$directory/files/utilities/testsub.dta", 'single valued column data file existance test' );
  71    skip "Skipping contents test", 1 unless( $success );
  72    open( TESTSUB, "$directory/files/utilities/testsub.dta" );
  73    open( ORIGSUB, "$directory/files/utilities/pheno_single.dta" );
  74    my @test_array = <TESTSUB>;
  75    my @orig_array = <ORIGSUB>;
  76    close( TESTSUB );
  77    close( ORIGSUB );
  78    $success = is_deeply( \@test_array,
  79                          \@orig_array,
  80                          'single valued column data file content test' );
  81    skip "Contents test fail, skipping forward", 1 unless( $success );
  82    $success = ok( -e "$directory/files/utilities/testrem.dta", 'remaining data file existance test' );
  83    skip "Skipping contents test", 1 unless( $success );
  84    open( TESTREM, "$directory/files/utilities/testrem.dta" );
  85    open( ORIGREM, "$directory/files/utilities/pheno_reduced.dta" );
  86    @test_array = <TESTREM>;
  87    @orig_array = <ORIGREM>;
  88    close( TESTREM );
  89    close( ORIGREM );
  90    $success = is_deeply( \@test_array,
  91                          \@orig_array,
  92                          'remaining data file content test' );
  93    skip "Contents test fail, skipping forward", 1 unless( $success );
  94    unlink( "$directory/files/utilities/testsub.dta", "$directory/files/utilities/testrem.dta" );
  95  }
  96 }
  97
  98 sub create_extra_data_model {
  99   my $self = shift;
 100   my %parms = @_;
 101   my $verbose          = $parms{'verbose'};
 102   my $debug            = $parms{'debug'};
 103   my $debug_package    = $parms{'debug_package'};
 104   my $debug_subroutine = $parms{'debug_subroutine'};
 105   my $directory        = $parms{'directory'};
 106   my $generate_facit   = $parms{'generate_facit'};
 107   my $bin = "$directory/../bin/create_extra_data_model";
 108   my $options = "-mod=$directory/files/utilities/pheno.mod ".
 109     "-extra=$directory/files/utilities/pheno_single.dta ".
 110       "-header='ID,APGR' -new=$directory/files/utilities/testnew.mod";
 111   system( &os_format( $bin . " ". $options ) );
 112
 113   my $success;
 114  SKIP: {
 115    if( $generate_facit ){
 116      system("cp $directory/files/utilities/testnew.mod $directory/files/utilities/pheno_extra_data.mod" );
 117      system("cp $directory/reader0.f $directory/files/utilities/reader_orig.f" );
 118      system("cp $directory/get_sub0.f $directory/files/utilities/get_sub_orig.f" );
 119      skip "Generating facit", 1;
 120    }
 121
 122    $success = ok( -e "$directory/files/utilities/testnew.mod", 'model file for extra data existance test' );
 123    skip "Skipping contents test", 1 unless( $success );
 124    open( TESTSUB, "$directory/files/utilities/testnew.mod" );
 125    open( ORIGSUB, "$directory/files/utilities/pheno_extra_data.mod" );
 126    my @test_array = <TESTSUB>;
 127    my @orig_array = <ORIGSUB>;
 128    close( TESTSUB );
 129    close( ORIGSUB );
 130    $success = is_deeply( \@test_array,
 131                         \@orig_array,
 132                         'model file for extra data content test' );
 133    skip "Contents test fail, skipping forward", 1 unless( $success );
 134    $success = ok( -e "$directory/reader0.f", 'reader file existance test' );
 135    skip "Skipping contents test", 1 unless( $success );
 136    open( TESTREM, "$directory/reader0.f" );
 137    open( ORIGREM, "$directory/files/utilities/reader_orig.f" );
 138    @test_array = <TESTREM>;
 139    @orig_array = <ORIGREM>;
 140    close( TESTREM );
 141    close( ORIGREM );
 142    $success = is_deeply( \@test_array,
 143                         \@orig_array,
 144                         'reader file content test' );
 145    skip "Contents test fail, skipping forward", 1 unless( $success );
 146    $success = ok( -e "$directory/get_sub0.f", 'get_sub file existance test' );
 147    skip "Skipping contents test", 1 unless( $success );
 148    open( TESTREM, "$directory/get_sub0.f" );
 149    open( ORIGREM, "$directory/files/utilities/get_sub_orig.f" );
 150    @test_array = <TESTREM>;
 151    @orig_array = <ORIGREM>;
 152    close( TESTREM );
 153    close( ORIGREM );
 154    $success = is_deeply( \@test_array,
 155                         \@orig_array,
 156                         'get_sub file content test' );
 157    skip "Contents test fail, skipping forward", 1 unless( $success );
 158    unlink( "$directory/files/utilities/testnew.mod",
 159            "$directory/reader0.f",
 160            "$directory/get_sub0.f" );
 161  }
 162 }
 163
 164 # Fixa generiska mapp-namn
 165 sub generic_tester {
 166   my $self = shift;
 167   my %parms = @_;
 168   my $options          = $parms{'options'};
 169   my $verbose          = $parms{'verbose'};
 170   my $debug            = $parms{'debug'};
 171   my $debug_package    = $parms{'debug_package'};
 172   my $debug_subroutine = $parms{'debug_subroutine'};
 173   my $directory        = $parms{'directory'};
 174   my $script           = $parms{'script'};
 175   my $sub_test         = $parms{'sub_test'};
 176   my $generate_facit   = $parms{'generate_facit'};
 177
 178   $options = $options." -debug=$debug" if defined $debug;
 179   $options = $options." -debug_package=$debug_package" if defined $debug_package;
 180   $options = $options." -debug_subroutine=$debug_subroutine" if defined $debug_subroutine;
 181
 182   system( &os_format( $directory . "/../bin/$script -directory=$script".'_dir'. $options ) );
 183
 184   my $success;
 185  SKIP: {
 186    if( $generate_facit ){
 187      system("cp $directory/".$script."_dir/".$script."_results.csv $directory/files/utilities/" . $script . "_results.csv.".$sub_test );
 188      system('rm -rf ' . $script .'_dir*');
 189      skip "Generating facit", 1;
 190    }
 191
 192    # Remove any previous (failed) test results.
 193    system('rm -rf ' . $script .'_dir');
 194
 195    $success = ok( -e "$directory/".$script."_dir/".$script."_results.csv", "$script results file existance test" );
 196    skip "Skipping contents test", 1 unless( $success );
 197    open( TESTRES, "$directory/" . $script ."_dir/".$script."_results.csv" );
 198    open( ORIGRES, "$directory/files/utilities/" . $script . "_results.csv.".$sub_test );
 199    my @test_array = <TESTRES>;
 200    my @orig_array = <ORIGRES>;
 201    close( TESTRES );
 202    close( ORIGRES );
 203    $success = is_deeply( \@test_array,
 204                          \@orig_array,
 205                          $script . ' results file content test' );
 206    if( $success ){
 207      system( 'rm -rf '.$script.'_dir*' );
 208    }
 209  }
 210   return $success;
 211 }
 212
 213 sub llp {
 214   my $self = shift;
 215   my $success;
 216
 217   $success = scripts_test -> generic_tester( @_,
 218                                              script => 'llp',
 219                                              sub_test => 'pheno',
 220                                              options => "files/utilities/pheno.mod ".
 221                                                         "-thetas=1 -omegas=1 -sigmas=1 --rse_sigmas=0.3 -max_it=8".
 222                                                         " -significant_digits=3 -silent --seed=22154" );
 223 #  return unless $success;
 224   $success = scripts_test -> generic_tester( @_,
 225                                   script => 'llp',
 226                                   sub_test => 'dofetilide',
 227                                   options => "files/utilities/dofetilide.mod ".
 228                                              "-thetas=1 -rse_theta=0.1 -omegas=1 -rse_omegas=0.3 -max_it=8".
 229                                              " -significant_digits=3 -silent --seed=13443 --threads=6" );
 230 #  return unless $success;
 231   $success = scripts_test -> generic_tester( @_,
 232                                   script => 'llp',
 233                                   sub_test => 'moxonidine',
 234                                   options => "files/utilities/moxonidine.mod ".
 235                                              "-thetas=1 -rse_theta=0.1 -omegas=1 -rse_omegas=0.3 -max_it=8".
 236                                              " -significant_digits=3 -silent --seed=7483723 --threads=6" );
 237 #  return unless $success;
 238   $success = scripts_test -> generic_tester( @_,
 239                                   script => 'llp',
 240                                   sub_test => 'warfarin',
 241                                   options => "files/utilities/warfarin.mod ".
 242                                              "-thetas=1 -rse_theta=0.1 -omegas=4 -rse_omegas=0.3 -max_it=8".
 243                                              " -significant_digits=3 -silent --seed=935829 --threads=6" );
 244   return;
 245 }
 246
 247
 248 sub bootstrap {
 249   my $self = shift;
 250   my $success;
 251
 252   $success = scripts_test -> generic_tester( @_,
 253                                   script => 'bootstrap',
 254                                   sub_test => 'pheno',
 255                                   options => "files/utilities/pheno.mod ".
 256                                              "--seed=494574 -silent" );
 257 #  return unless $success;
 258   $success = scripts_test -> generic_tester( @_,
 259                                   script => 'bootstrap',
 260                                   sub_test => 'dofetilide',
 261                                   options => "files/utilities/dofetilide.mod ".
 262                                              "--seed=2193487 -silent --threads=6" );
 263 #  return unless $success;
 264   $success = scripts_test -> generic_tester( @_,
 265                                   script => 'bootstrap',
 266                                   sub_test => 'moxonidine',
 267                                   options => "files/utilities/moxonidine.mod ".
 268                                              "--seed=89430284 -silent --threads=6 --strat=VISI" );
 269
 270   $success = scripts_test -> generic_tester( @_,
 271                                   script => 'bootstrap',
 272                                   sub_test => 'moxonidine',
 273                                   options => "files/utilities/moxonidine.mod ".
 274                                              "--seed=89430284 -silent --threads=6 --strat=2" );
 275 #  return unless $success;
 276   $success = scripts_test -> generic_tester( @_,
 277                                   script => 'bootstrap',
 278                                   sub_test => 'warfarin',
 279                                   options => "files/utilities/warfarin.mod ".
 280                                              "-seed=153095 -silent --threads=6" );
 281   return;
 282 }
 283
 284
 285 sub cdd {
 286   my $self = shift;
 287   my $success;
 288
 289   $success = scripts_test -> generic_tester( @_,
 290                                   script => 'cdd',
 291                                   sub_test => 'pheno',
 292                                   options => "files/utilities/pheno.mod ".
 293                                              "--case_column=1 --seed=408463 -silent" );
 294 #  return unless $success;
 295   $success = scripts_test -> generic_tester( @_,
 296                                   script => 'cdd',
 297                                   sub_test => 'dofetilide',
 298                                   options => "files/utilities/dofetilide.mod ".
 299                                              "--case_column=2 --seed=87424 -silent --threads=6" );
 300 #  return unless $success;
 301   $success = scripts_test -> generic_tester( @_,
 302                                   script => 'cdd',
 303                                   sub_test => 'moxonidine',
 304                                   options => "files/utilities/moxonidine.mod ".
 305                                              "--case_column=2 --seed=656816 -silent --threads=6" );
 306 #  return unless $success;
 307   $success = scripts_test -> generic_tester( @_,
 308                                   script => 'cdd',
 309                                   sub_test => 'warfarin',
 310                                   options => "files/utilities/warfarin.mod ".
 311                                              "--case_column=2 --seed=3225479 -silent --threads=6" );
 312   return;
 313 }
 314
 315
 316 sub scm {
 317   my $self = shift;
 318   my $success;
 319
 320   $success = scripts_test -> generic_tester( @_,
 321                                   script => 'scm',
 322                                   sub_test => 'pheno',
 323                                   options => "--conf=files/utilities/pheno.scm --seed=12345 -silent" );
 324 #  return unless $success;
 325   $success = scripts_test -> generic_tester( @_,
 326                                   script => 'scm',
 327                                   sub_test => 'dofetilide',
 328                                   options => "--conf=files/utilities/dofetilide.scm --seed=12345 -silent --threads=6" );
 329 #  return unless $success;
 330   $success = scripts_test -> generic_tester( @_,
 331                                   script => 'scm',
 332                                   sub_test => 'moxonidine',
 333                                   options => "--conf=files/utilities/moxonidine.scm --seed=12345 -silent --threads=6" );
 334 #  return unless $success;
 335   $success = scripts_test -> generic_tester( @_,
 336                                   script => 'scm',
 337                                   sub_test => 'warfarin',
 338                                   options => "--conf=files/utilities/warfarin.scm --seed=12345 -silent --threads=6" );
 339   return;
 340 }
 341
 342 1;