t/unit/CXGN/TrialDesign.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6 use Data::Dumper;
   7
   8 BEGIN {use_ok('CXGN::Trial::TrialDesign');}
   9
  10 BEGIN {require_ok('Moose');}
  11 BEGIN {require_ok('MooseX::FollowPBP');}
  12 BEGIN {require_ok('Moose::Util::TypeConstraints');}
  13 BEGIN {require_ok('R::YapRI::Base');}
  14 BEGIN {require_ok('R::YapRI::Data::Matrix');}
  15 BEGIN {require_ok('POSIX');}
  16
  17 my @stock_names = ("A","B","C","D","E","F","G","H","I","J","K","L");
  18 my @control_names = ("C1","C2","C3");
  19 my $number_of_blocks = 4;
  20 my $number_of_reps = 2;
  21 my $block_size = 3;
  22 my $maximum_block_size = 14;
  23 my $plot_name_prefix = "pre_";
  24 my $plot_name_suffix = "_suf";
  25 my $plot_start_number = 101;
  26 my $plot_number_increment = 10;
  27 my $randomization_method = "Super-Duper";
  28 my $randomization_seed = 1;
  29 my $design_type = "CRD";
  30 my %design;
  31 my $fieldmap_row_number = 2;
  32 my $plot_layout_format = "serpentine";
  33
  34 ok(my $trial_design = CXGN::Trial::TrialDesign->new(), "Create TrialDesign object");
  35 $trial_design->set_trial_name("TESTTRIAL");
  36 ok($trial_design->set_stock_list(\@stock_names), "Set stock names for trial design");
  37 is_deeply($trial_design->get_stock_list(),\@stock_names, "Get stock names for trial design");
  38 ok($trial_design->set_plot_name_prefix($plot_name_prefix), "Set plot name prefix for trial design");
  39 is_deeply($trial_design->get_plot_name_prefix(),$plot_name_prefix, "Get plot name prefix for trial design");
  40 ok($trial_design->set_plot_name_suffix($plot_name_suffix), "Set plot name suffix for trial design");
  41 is_deeply($trial_design->get_plot_name_suffix(),$plot_name_suffix, "Get plot name suffix for trial design");
  42 ok($trial_design->set_plot_start_number($plot_start_number), "Set plot start number for trial design");
  43 is_deeply($trial_design->get_plot_start_number(),$plot_start_number, "Get plot start number for trial design");
  44 ok($trial_design->set_plot_number_increment($plot_number_increment), "Set plot number increment for trial design");
  45 is_deeply($trial_design->get_plot_number_increment(),$plot_number_increment, "Get plot number increment for trial design");
  46 ok($trial_design->set_randomization_method($randomization_method), "Set randomization method for trial design");
  47 is_deeply($trial_design->get_randomization_method(),$randomization_method, "Get randomization method for trial design");
  48 ok($trial_design->set_randomization_seed($randomization_seed), "Set randomization seed for trial design");
  49 is_deeply($trial_design->get_randomization_seed(),$randomization_seed, "Get randomization seed for trial design");
  50 ok($trial_design->set_design_type($design_type), "Set design type for trial design");
  51 is_deeply($trial_design->get_design_type(),$design_type, "Get design type for trial design");
  52 ok($trial_design->set_plot_layout_format($plot_layout_format), "Set layout format for trial design");
  53 is_deeply($trial_design->get_plot_layout_format(),$plot_layout_format, "Get layout format for trial design");
  54 ok($trial_design->set_fieldmap_row_number($fieldmap_row_number), "Set row number for trial design");
  55 is_deeply($trial_design->get_fieldmap_row_number(),$fieldmap_row_number, "Get row number for trial design");
  56 $trial_design->set_fieldmap_col_number(2);
  57
  58 # tests for CRD
  59 #
  60 $trial_design->set_number_of_reps(2);
  61 ok($trial_design->set_design_type("CRD"), "Set design type to CRD");
  62 ok($trial_design->calculate_design(), "Calculate CRD trial design");
  63 ok(%design = %{$trial_design->get_design()}, "Get CRD trial design");
  64 ok($design{$plot_start_number}->{block_number} == 1, "Block number for first plot in CRD is 1");
  65 ok($design{$plot_start_number+((scalar(@stock_names)-1)*$plot_number_increment)}->{block_number} == 1, "Block number for last plot in CRD is 1");
  66 ok($design{'101'}->{row_number} == 1, "CRD: First plot row_number is 1");
  67 ok($design{'101'}->{col_number} == 1, "CRD: First plot col_number is 1");
  68
  69 # tests for RCBD
  70 #
  71 ok($trial_design->set_number_of_blocks($number_of_blocks), "Set number of blocks for trial design");
  72 is_deeply($trial_design->get_number_of_blocks(),$number_of_blocks, "Get number of blocks for trial design");
  73 ok($trial_design->set_design_type("RCBD"), "Set design type to RCBD");
  74 ok($trial_design->calculate_design(), "Calculate RCBD trial design");
  75 ok(%design = %{$trial_design->get_design()}, "Get RCBD trial design");
  76 print STDERR "RCDB DESIGN 1:";
  77 foreach my $k (sort keys %design) {
  78     print STDERR $k." ".Dumper($design{$k});
  79 }
  80
  81 is($design{'101'}->{row_number}, 1, "RCBD: First plot row_number is 1");
  82 is($design{'101'}->{col_number}, 1, "RCBD: First plot col_number is 1");
  83 is(scalar(keys %design), scalar(@stock_names) * $number_of_blocks,"Result of RCBD design has a number of plots equal to the number of stocks times the number of blocks");
  84
  85 ok($trial_design->set_plot_numbering_scheme('consecutive'), "Set plot numbering scheme to consecutive");
  86 ok($trial_design->calculate_design(), "recalculate the trial design using consecutive plot numbers.");
  87
  88 print STDERR "CONDSECUTIVE NUMBERS DESIGN: ".Dumper(\%design);
  89 is($design{'101'}->{row_number}, 1, "RCBD: First plot row_number is 1 with consecutive plot numbers");
  90 is($design{'101'}->{col_number}, 1, "RCBD: First plot col_number is 1 with consecutive plot numbers");
  91
  92 $trial_design->set_plot_numbering_scheme('block_based');
  93
  94
  95 print STDERR $stock_names[0] ."($plot_start_number) vs. ".$design{$plot_start_number}->{stock_name}."\n";
  96 #ok($design{$plot_start_number}->{stock_name} eq $stock_names[0],"First plot has correct stock name");
  97 print "stock_number $design{$plot_start_number}->{stock_name}\n";
  98 ok($design{$plot_start_number}->{block_number} == 1, "First plot is in block 1");
  99
 100 print STDERR "PLOT START NUMBER: $plot_start_number, #STOCK ".scalar(@stock_names)." , PLOT # $plot_number_increment\n";
 101
 102 # check next block
 103 #
 104 my $next_block_plot_number = $plot_start_number+((scalar(@stock_names)-1)+ 100); #next block
 105 print STDERR "INDEX = $next_block_plot_number\n";
 106 print STDERR "DESING OF : ".Dumper($design{$next_block_plot_number})."\n";
 107 print STDERR "LENGTH : ".$design{$next_block_plot_number}->{block_number}."\n"; # zero indexed, need to substract 1
 108
 109 my $length = $design{$next_block_plot_number}->{block_number};
 110 is($length, 2, "Block 1 is the right length");
 111 is($design{$next_block_plot_number}->{block_number}, 2, "Block 2 starts after block 1");
 112 #is($design{$plot_start_number+$plot_number_increment}->{stock_name}, $stock_names[1], "Second plot has correct stock name");
 113
 114 # check last block
 115 #
 116 my $last_block_number = $plot_start_number+((scalar(@stock_names)-1) + 100 * ($number_of_blocks-1)) ; # $plot_number_increment);
 117
 118 print STDERR "LAST BLOCK INDEX: $last_block_number\n";
 119 print STDERR "DESIGN OF $last_block_number = ".Dumper($design{$last_block_number});
 120
 121 #tests for constructing plot names from plot start number, increment, prefix and suffix
 122 ok($design{$plot_start_number}->{plot_name} =~ /$plot_name_prefix/, "Plot names contain prefix");
 123 ok($design{$plot_start_number}->{plot_name} =~ /$plot_name_suffix/, "Plot names contain suffix");
 124 ok($trial_design->set_plot_start_number(1), "Change plot start number for trial design to 1");
 125 ok($trial_design->set_plot_number_increment(1), "Change plot number increment for trial design to 1");
 126 ok($trial_design->calculate_design(), "Calculate design with plot start number and increment set to 1");
 127 ok(%design = %{$trial_design->get_design()}, "Get trial design with plot start number and increment set to 1");
 128 #is($design{1}->{stock_name}, $stock_names[0],"First plot has correct stock name when plot number and increment are 1");
 129 #is($design{2}->{stock_name}, $stock_names[1],"Second plot has correct stock name when plot number and increment are 1");
 130 #is($design{3}->{stock_name}, $stock_names[2],"Third plot has correct stock name when plot number and increment are 1");
 131
 132 ###
 133 ok($trial_design->set_plot_start_number(-2), "Change plot start number for trial design to -2");
 134 ok($trial_design->calculate_design(), "Calculate trial design with a negative plot start number");
 135 ok(%design = %{$trial_design->get_design()}, "Get trial design with a negative plot start number");
 136 #ok($design{-2}->{stock_name} eq $stock_names[0],"First plot has correct stock name with a negative plot start number");
 137 #ok($design{-1}->{stock_name} eq $stock_names[1],"Second plot has correct stock name with a negative plot start number");
 138 #ok($design{0}->{stock_name} eq $stock_names[2],"Third plot has correct stock name with a negative plot start number");
 139 #ok($design{1}->{stock_name} eq $stock_names[3],"Fourth plot has correct stock name with a negative plot start number");
 140
 141 # tests for Alpha Lattice design (fail)
 142 #
 143 ok($trial_design->set_design_type("Alpha"), "Set design type to Alpha Lattice");
 144 ok($trial_design->set_block_size($block_size), "Set block size for trial design");
 145 is_deeply($trial_design->get_block_size(),$block_size, "Get block size for trial design");
 146 ok($trial_design->set_number_of_reps($number_of_reps), "Set number of reps for trial design");
 147 is_deeply($trial_design->get_number_of_reps(),$number_of_reps, "Get number of reps for trial design");
 148 ok($trial_design->calculate_design(), "Calculate Alpha Lattice trial design");
 149 ok(%design = %{$trial_design->get_design()}, "Get Alpha trial design");
 150 $trial_design->set_block_size(2);
 151 throws_ok { $trial_design->calculate_design() } '/Block size must be greater than 2/', 'Block size is larger than 2 test for alpha lattice design';
 152 #throws_ok { $trial_design->calculate_design() } '/is not divisible by the block size/', 'Does not allow number of stocks that is not divisible by block size';
 153 #print STDERR "OLD LIST SIZE = ".scalar(@stock_names).", new : ".scalar(@{$trial_design->get_stock_list()})."\n";
 154 is(scalar(@stock_names), scalar(@{$trial_design->get_stock_list()}), "new stock list size test");
 155 $trial_design->set_block_size($block_size);
 156 $trial_design->set_number_of_reps(1);
 157 throws_ok { $trial_design->calculate_design() } '/Number of reps for alpha lattice design must be 2 or greater/', 'Does not allow less than 2 reps for alpha lattice design';
 158 $trial_design->set_number_of_reps($number_of_reps);
 159
 160 # tests for Alpha Lattice design (pass)
 161 #
 162 @stock_names = ("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T");
 163 ok($trial_design->set_stock_list(\@stock_names), "Set stock names for trial design");
 164 is_deeply($trial_design->get_stock_list(),\@stock_names, "Get stock names for trial design");
 165 ok($trial_design->set_design_type("Alpha"), "Set design type to Alpha Lattice");
 166 ok($trial_design->set_block_size(4), "Set block size for trial design");
 167 #is_deeply($trial_design->get_block_size(),$block_size, "Get block size for trial design");
 168 ok($trial_design->set_number_of_reps(4), "Set number of reps for trial design");
 169 #is_deeply($trial_design->get_number_of_reps(),$number_of_reps, "Get number of reps for trial design");
 170 ok($trial_design->set_plot_start_number($plot_start_number), "Set plot start number for trial design");
 171 is_deeply($trial_design->get_plot_start_number(),$plot_start_number, "Get plot start number for trial design");
 172 ok($trial_design->set_plot_number_increment($plot_number_increment), "Set plot number increment for trial design");
 173 is_deeply($trial_design->get_plot_number_increment(),$plot_number_increment, "Get plot number increment for trial design");
 174 ok($trial_design->calculate_design(), "Calculate Alpha Lattice trial design");
 175 ok(%design = %{$trial_design->get_design()}, "Get Alpha trial design");
 176 ok($design{'101'}->{row_number} == 1, "Alpha Lattice: First plot row_number is 1");
 177 ok($design{'101'}->{col_number} == 1, "Alpha Lattice: First plot col_number is 1");
 178 #print STDERR "Alpha Lattice". Dumper \%design;
 179
 180
 181 # tests for Augmented design
 182 #
 183 $trial_design->set_number_of_blocks(5);
 184 ok($trial_design->set_design_type("Augmented"), "Set design type to Augmented");
 185 ok($trial_design->set_control_list(\@control_names), "Set control names for trial design");
 186 is_deeply($trial_design->get_control_list(),\@control_names, "Get control names for trial design");
 187 ok($trial_design->set_maximum_block_size($maximum_block_size), "Set maximum block size for trial design");
 188 is_deeply($trial_design->get_maximum_block_size(),$maximum_block_size, "Get maximum block size for trial design");
 189 ok($trial_design->calculate_design(), "Calculate Augmented trial design");
 190
 191
 192 #tests for MAD design
 193 #$trial_design->set_number_of_rows(10);
 194 #$trial_design->set_block_row_numbers(2);
 195 #$trial_design->set_block_col_numbers(2);
 196 #$trial_design->set_number_of_blocks(5);
 197 #ok($trial_design->set_design_type("MAD"), "Set design type to Augmented");
 198 #ok($trial_design->set_control_list(\@control_names), "Set control names for trial design");
 199 #is_deeply($trial_design->get_control_list(),\@control_names, "Get control names for trial design");
 200 #ok($trial_design->set_maximum_block_size($maximum_block_size), "Set maximum block size for trial design");
 201 #is_deeply($trial_design->get_maximum_block_size(),$maximum_block_size, "Get maximum block size for trial design");
 202 #ok($trial_design->calculate_design(), "Calculate Augmented trial design");
 203
 204 done_testing();