test/lib/data_test.pm

   1 #!/usr/bin/perl
   2
   3 package data_test;
   4
   5 #use FindBin qw($Bin);
   6 #use lib "$Bin/../lib";
   7 use data;
   8 use Cwd;
   9 use strict;
  10
  11 sub test {
  12
  13   my $self = shift;
  14   my %parms = @_;
  15   my $verbose   = $parms{'verbose'};
  16   my $directory = $parms{'directory'};
  17
  18   my ($tests_passed, $tests_performed) = (0,0);
  19
  20   my $data = data -> new( filename => 'data_set_1.dta',
  21                           directory => $directory.'/files/data_test_dir',
  22                           idcolumn => 3 );
  23
  24
  25   print "\tdata: testing directory member\t\t\t... " if $verbose;
  26   {
  27     my $correct_value = $directory . 'files/data_test_dir/';
  28     my $real_value = $data -> directory;
  29     if( $correct_value eq $real_value ){
  30       print " OK \n" if $verbose;
  31       $tests_passed ++;
  32     } else {
  33       print "FAILED: \n\t$correct_value not equal $real_value\n" if $verbose;
  34     }
  35     $tests_performed ++;
  36   }
  37
  38
  39   print "\tdata: testing full_name\t\t\t\t... " if $verbose;
  40   {
  41     my $correct_value = $directory . 'files/data_test_dir/data_set_1.dta';
  42     my $real_value = $data -> full_name;
  43     if( $correct_value eq $real_value ){
  44       print " OK \n" if $verbose;
  45       $tests_passed ++;
  46     } else {
  47       print "FAILED: $correct_value not equal $real_value\n" if $verbose;
  48     }
  49     $tests_performed ++;
  50   }
  51
  52   print "\tdata: testing bootstrap:ing of data\t\t... " if $verbose;
  53   {
  54     srand(1);
  55     my ( $new_datas, $incl_ids, $incl_keys )
  56         = $data -> bootstrap( directory => $directory ,
  57                               name_stub => 'files/data_test_dir/bs_pr' ,
  58                               samples   => 5,
  59                               target    => 'mem');
  60     my $failed = 0;
  61     foreach my $data ( @{$new_datas} ){
  62       unless( ref $data eq 'data' ){
  63         print "FAILED: bootstrap doesn't return data objects\n" if $verbose;
  64         $failed = 1;
  65         last;
  66       }
  67     }
  68     $tests_passed ++ unless( $failed );
  69     $tests_performed ++;
  70
  71     last if ( $failed );
  72
  73 # {{{ correct_value
  74     my $correct_value  = [[0,0,3.5,0,17.0,25.0,0,3.0,0,3.0,0,0,3.0,0,20.0,3.2,4.0,11.0,4.0,27.0,0,0,3.5,0,25.0,2.5,17.0,6.0,0,7.5,4.0,0,0,15.0,2.4,2.5,2.4,0,0,0,32.0,0,0,0,5.0,0,1.7,0,2.5,22.8,0,3.2,9.0,0,4.5,17.0,0,0,0,0,0,56.0,4.3,60.0,3.3,0,0,0,40.0,0,30.0,0,0,35.0,0,0,0,25.0,0,4.3,0,0,22.0,0,2.5,4.0,1.5,3.0,4.0,0,2.8,0,4.4,0,30.0,0,3.0,25.0,0,15.0,3.3,70.0,0,56.0,0,0,0,0,56.0,0,0,3.4,24.0,3.3,0,0,2.5,26.0,0,2.5,0,7.0,0,0,0,26.0,0,0,0,10.0,3.3,0,34.0,30.0,0,28.0,40.0,0,2.8,0,0,0,0,9.5,60.0,4.0,0,0,0,0,0,0,12.0,0,20.0,3.4,2.8,0,0,0,0,0,0,3.5,0,0,30.0,22.0,15.0,0,0,0,1.5,0,3.0,40.0,0,0,3.0,3.0,4.0,3.0,2.3,0,0,2.5,0,0,3.0,3.5,2.5,2.8,7.5,5.0,18.0,2.8,1.7,3.0,26.0,10.0,10.0,0,0,0,0,1.9,0,20.0,0,0,12.0,7.5,3.0,0,4.0,7.5,35.0,4.4,0,0,56.0,0,0,0,0,19.0,3.8,20.0,18.6,7.5,24.0,9.5,0,2.5,15.0,15.0,0,2.3,0,0,4.5,4.0,0,0,0,0,3.5,3.5,0,22.0,0,0,7.5,30.0,0,3.0,14.0,0,3.0,0,0,22.8,2.5,0,30.0,2.3,0,4.0,0,0,0,0,0,3.2,0,3.5,0,3.0,0,0,19.0,3.5,0,0,10.0,3.5,3.2,0,25.0,4.0,0,4.0,2.8,0,18.6,2.0,10.0,0,26.0,3.5,0,0,9.0,3.0,7.5,2.8,0,11.0,7.5,24.0,2.5,3.5,17.0,5.0,34.0,0,3.0,0,3.3,3.0,35.0,3.0,22.0,6.0,7.5,27.0,11.0,9.0,3.5,0,4.0,24.0,],[0,24.0,1.7,0,0,0,0,19.0,0,10.0,70.0,0,0,11.0,0,0,0,0,2.5,15.0,2.8,0,0,0,0,0,0,0,3.0,2.5,3.5,14.0,2.8,7.5,3.5,9.0,5.0,0,2.0,24.0,3.0,2.3,4.5,5.0,0,19.0,19.0,3.2,0,24.0,0,3.0,30.0,7.5,18.0,2.8,0,15.0,0,0,2.3,14.0,27.0,11.0,5.0,0,0,0,0,0,0,0,0,56.0,0,2.8,25.0,0,15.0,34.0,0,3.7,2.3,0,24.0,35.0,3.0,30.0,0,3.5,17.5,3.0,0,10.0,0,0,0,0,2.4,0,2.5,2.5,0,3.3,26.0,0,12.0,3.0,0,12.0,0,0,0,0,7.5,2.5,11.0,7.5,17.0,0,3.5,0,3.8,0,0,0,0,32.0,10.0,60.0,3.7,3.0,11.0,32.0,0,15.0,3.3,70.0,2.5,0,0,2.5,40.0,15.0,0,18.6,1.5,3.5,0,6.0,0,0,35.0,0,0,24.0,20.0,0,3.0,0,4.0,9.5,1.7,6.0,0,0,18.0,9.5,18.0,0,4.0,0,2.8,0,30.0,0,0,0,17.0,18.0,0,4.0,4.0,15.0,0,0,0,11.0,0,1.5,24.0,0,0,0,1.5,5.0,18.0,2.3,0,40.0,0,0,26.0,0,4.5,0,0,0,28.0,0,2.5,2.0,0,0,2.0,2.0,0,0,0,0,18.6,70.0,17.5,0,9.0,3.5,0,0,0,3.0,0,4.4,0,25.0,10.0,14.0,0,2.8,35.0,2.0,0,0,30.0,0,3.0,0,0,24.0,0,0,0,1.7,0,0,0,0,2.0,2.0,0,15.0,2.5,0,30.0,0,3.5,0,0,0,12.0,22.0,30.0,0,3.3,2.5,0,3.0,2.5,0,0,2.5,4.0,0,0,2.5,0,0,0,5.0,3.2,0,3.5,0,0,28.0,3.3,0,0,0,0,0,2.8,2.5,18.0,30.0,3.5,2.0,0,5.0,28.0,0,0,0,7.0,15.0,18.6,10.0,24.0,0,4.0,0,0,0,0,0,0,24.0,9.0,4.0,15.0,11.0,0,0,],[0,0,19.0,0,0,10.0,0,0,3.0,3.0,0,0,3.5,5.0,0,0,5.0,18.0,0,2.3,0,3.0,3.5,0,0,0,0,0,0,2.3,0,3.5,7.5,2.8,0,0,7.5,4.0,0,6.0,0,0,7.5,0,0,35.0,3.3,0,10.0,12.0,0,3.0,3.0,0,0,3.2,0,2.5,0,4.0,3.0,34.0,20.0,15.0,0,0,4.0,4.0,0,3.0,2.8,25.0,9.0,14.0,0,3.0,28.0,0,7.5,0,14.0,0,0,10.0,3.4,2.5,0,3.7,7.5,0,0,30.0,30.0,3.0,14.0,0,9.5,0,0,15.0,0,2.5,2.3,0,3.2,0,0,3.0,0,5.0,0,0,27.0,4.0,0,0,2.5,2.8,0,2.5,17.0,2.5,3.0,0,0,0,0,0,20.0,2.0,0,3.0,0,0,0,63.0,0,2.8,0,11.0,70.0,70.0,18.0,0,0,3.0,1.7,3.5,9.0,4.3,0,0,4.0,3.0,0,0,19.0,0,60.0,0,26.0,4.4,0,0,0,0,3.5,0,4.0,27.0,0,0,7.5,0,0,0,0,1.5,0,20.0,4.5,3.0,0,2.0,3.5,3.3,2.8,0,0,0,22.0,4.0,27.0,0,0,12.0,19.0,16.0,7.0,0,0,30.0,27.0,0,0,18.6,0,3.0,3.0,30.0,0,0,0,2.8,3.5,0,3.5,2.4,0,0,3.7,1.7,4.0,0,0,0,24.0,1.5,0,7.5,2.0,0,0,3.7,6.0,0,0,0,0,2.0,0,3.0,0,0,27.0,0,2.5,0,0,0,2.0,25.0,0,0,30.0,5.0,0,0,0,0,30.0,4.5,3.7,3.0,4.0,7.5,3.4,3.2,2.8,3.5,2.0,0,0,0,0,26.0,0,0,0,4.0,1.5,1.7,32.0,3.0,17.5,24.0,2.5,2.8,12.0,3.0,70.0,0,6.7,30.0,11.0,0,0,3.0,15.0,26.0,25.0,56.0,18.0,30.0,3.0,25.0,20.0,0,0,0,9.0,0,0,26.0,22.0,0,60.0,0,7.5,3.5,3.5,6.0,0,60.0,0,0,2.8,0,0,0,9.0,24.0,],[3.0,3.0,0,0,14.0,0,24.0,2.8,0,4.0,24.0,3.5,2.8,0,0,0,26.0,0,3.0,0,25.0,3.3,2.5,4.3,3.0,0,0,3.0,11.0,4.0,6.0,26.0,3.3,0,0,0,0,2.5,2.8,0,0,0,6.7,27.0,0,0,0,2.5,0,0,24.0,7.0,0,0,0,0,0,0,70.0,17.5,9.0,5.0,0,0,0,7.5,3.3,0,17.5,0,25.0,2.0,0,0,0,2.8,0,0,0,0,0,2.8,3.3,0,0,16.0,11.0,0,3.0,0,0,25.0,1.7,3.5,34.0,2.5,7.0,3.5,4.0,9.0,0,0,0,0,18.6,3.7,0,0,0,5.0,0,0,0,3.0,0,2.8,0,2.5,2.0,0,2.0,3.0,0,0,0,0,0,3.2,0,2.5,9.5,10.0,0,6.0,0,12.0,18.0,1.7,2.5,0,0,0,0,0,0,0,0,32.0,3.0,3.3,3.0,0,2.3,4.0,3.0,0,15.0,5.0,0,3.5,0,6.0,0,3.0,0,2.0,1.7,0,0,0,0,11.0,0,30.0,30.0,0,0,3.8,6.0,15.0,0,0,3.4,3.7,22.0,7.5,0,0,0,0,7.5,0,7.5,0,0,3.4,0,0,0,3.5,22.0,16.0,0,0,27.0,35.0,0,2.8,9.0,0,0,0,2.4,18.6,24.0,0,2.5,3.2,2.8,18.0,0,3.5,4.3,0,4.4,2.0,0,3.3,0,3.0,2.8,20.0,0,12.0,0,2.5,3.5,0,0,0,0,2.0,4.0,2.3,40.0,25.0,3.5,9.0,0,7.5,10.0,3.0,24.0,2.0,20.0,0,28.0,18.0,0,0,9.0,3.3,5.0,3.0,0,0,0,3.5,12.0,0,0,1.5,3.4,0,0,26.0,3.0,4.0,6.0,3.3,0,10.0,4.5,18.0,3.0,0,0,0,3.0,0,0,3.0,0,0,2.5,0,0,7.5,20.0,24.0,0,0,3.5,0,0,0,3.5,0,17.5,2.5,3.0,0,5.0,20.0,4.4,0,24.0,2.0,12.0,0,0,0,0,24.0,0,2.4,2.5,0,0,0,0,0,],[1.7,5.0,0,0,0,2.0,0,0,22.8,7.0,14.0,3.0,17.0,0,0,0,26.0,0,1.7,0,0,2.8,3.3,0,26.0,0,1.9,0,7.5,0,0,3.4,2.5,0,0,3.4,0,26.0,3.5,0,0,3.0,0,0,0,2.8,0,7.5,7.5,4.0,22.0,17.5,0,6.0,0,0,0,0,0,35.0,19.0,3.4,0,3.5,0,0,3.2,2.5,3.5,7.5,6.0,3.0,17.5,0,0,2.5,6.0,0,0,0,4.5,2.5,9.5,0,25.0,60.0,35.0,17.0,15.0,0,0,0,6.0,3.0,22.0,0,18.0,7.5,0,3.0,4.5,18.6,1.5,10.0,1.7,4.0,2.4,14.0,0,2.0,4.0,0,0,3.5,28.0,4.0,7.5,3.0,3.0,0,0,7.5,0,0,26.0,0,0,9.0,4.0,0,0,7.5,2.4,70.0,0,0,0,10.0,3.5,0,30.0,3.7,0,0,3.5,9.5,4.0,0,0,7.5,0,9.5,0,0,2.5,0,0,19.0,2.8,70.0,0,6.0,0,2.4,3.5,0,3.0,14.0,20.0,0,3.3,0,0,0,4.0,0,4.0,0,0,1.5,14.0,9.5,0,24.0,9.0,0,2.5,20.0,0,2.0,7.5,0,0,3.0,0,0,25.0,0,6.0,0,3.0,0,0,0,34.0,0,0,24.0,0,0,2.5,9.0,20.0,3.5,0,0,0,0,0,0,0,0,2.8,9.0,0,4.0,0,70.0,11.0,0,0,0,18.0,7.5,0,0,0,27.0,2.8,2.5,0,0,6.0,0,0,3.5,28.0,0,0,2.5,0,17.0,20.0,0,1.5,3.0,0,0,3.0,1.7,0,2.5,0,4.5,2.5,0,0,0,0,3.4,3.4,0,0,0,0,25.0,0,0,3.0,4.4,3.5,0,34.0,27.0,0,4.0,0,0,3.0,2.5,0,0,4.4,6.0,0,15.0,2.5,0,0,26.0,0,0,0,1.7,0,0,0,1.7,4.4,0,20.0,27.0,0,0,0,0,3.0,1.7,4.3,17.5,7.5,0,0,5.0,22.8,2.0,12.0,0,3.0,10.0,5.0,27.0,],];
  75 # }}}
  76
  77     $failed = 0;
  78 #    print "[";
  79   OUTER: for(my $i = 0; $i <= $#{$incl_ids}; $i++ ){
  80       my $ids_inner = $incl_ids -> [$i];
  81 #      print "[";
  82       for(my $j = 0; $j <= $#{$ids_inner};$j++){
  83 #       print $ids_inner -> [$j] , ",";
  84         if( $ids_inner -> [$j] != $correct_value -> [$i] -> [$j] ){
  85           print $ids_inner -> [$j], " ",  $correct_value -> [$i] -> [$j] , "\n";
  86           print "FAILED: bootstrap doesn't include the correct IDs\n" if $verbose;
  87           $failed = 1;
  88           last OUTER;
  89         }
  90       }
  91 #      print "],";
  92     }
  93 #    print "]";
  94
  95     $tests_passed ++ unless( $failed );
  96     $tests_performed ++;
  97
  98     last if ( $failed );
  99
 100     print " OK \n";
 101     #print "\n", @{@{$incl_ids}[0]}, "\n", @{$incl_keys}, "\n";
 102   }
 103
 104 # resample
 105
 106 # case_deletion
 107
 108 # copy
 109
 110 # count_ind
 111
 112 # fractions
 113
 114 # factors
 115
 116 # find_individual
 117
 118 # format_data
 119
 120 # have_missing_data
 121
 122 # merge
 123
 124 # max
 125
 126 # min
 127
 128 # median
 129
 130 # mean
 131
 132 # sd
 133
 134 # range
 135
 136 # recalc_column
 137
 138 # renumber_ascending
 139
 140 # renumber_descending
 141
 142 # subsets
 143
 144 # subset
 145
 146 # _write
 147
 148 # flush
 149
 150 # synchronize
 151
 152 # _fisher_yates_shuffle
 153
 154 # _read_first_individual
 155
 156 # _read_header
 157
 158 # _read_individual
 159
 160   return ( $tests_passed, $tests_performed );
 161
 162 }
 163
 164 1;