lib/CXGN/Trial/TrialDesign.pm

   1 package CXGN::Trial::TrialDesign;
   2
   3 =head1 NAME
   4
   5 CXGN::Trial::TrialDesign - a module to create a trial design using the R CRAN package Agricolae.
   6
   7 =head1 USAGE
   8
   9  my $trial_design = CXGN::Trial::TrialDesign->new();
  10  $trial_design->set_trial_name("blabla");
  11  $trial_design->set_stock_list( qw | A B C D |);
  12  $trial_design->set_seedlot_hash(\%seedlothash);
  13  $trial_design->set_control_list( qw | E F |);
  14  $trial_design->set_number_of_blocks(3);
  15  $trial_design->set_randomization_method("RCBD");
  16  if ($trial_design->calculate_design()) {  # true if no error
  17     $design = $trial_design->get_design();
  18  }
  19
  20 =head1 DESCRIPTION
  21
  22 This module uses the the R CRAN package "Agricolae" to calculate experimental designs for field layouts.
  23
  24 =head1 AUTHORS
  25
  26  Jeremy D. Edwards (jde22@cornell.edu)
  27  Aimin Yan (ay247@cornell.edu)
  28
  29 =cut
  30
  31 use Moose;
  32 use MooseX::FollowPBP;
  33 use Moose::Util::TypeConstraints;
  34 use Data::Dumper;
  35 use R::YapRI::Base;
  36 use R::YapRI::Data::Matrix;
  37 use POSIX;
  38 use List::Util 'max';
  39
  40 with 'MooseX::Object::Pluggable';
  41
  42 has 'trial_name' => (isa => 'Str', is => 'rw', predicate => 'has_trial_name', clearer => 'clear_trial_name');
  43
  44 has 'stock_list' => (isa => 'ArrayRef[Str]', is => 'rw', predicate => 'has_stock_list', clearer => 'clear_stock_list');
  45
  46 has 'seedlot_hash' => (isa => 'HashRef', is => 'rw', predicate => 'has_seedlot_hash', clearer => 'clear_seedlot_hash');
  47
  48 has 'control_list' => (isa => 'ArrayRef[Str]', is => 'rw', predicate => 'has_control_list', clearer => 'clear_control_list');
  49
  50 has 'control_list_crbd' => (isa => 'ArrayRef[Str]', is => 'rw', predicate => 'has_control_list_crbd', clearer => 'clear_control_list_crbd');
  51
  52 has 'number_of_blocks' => (isa => 'Int', is => 'rw', predicate => 'has_number_of_blocks', clearer => 'clear_number_of_blocks');
  53
  54 has 'block_row_numbers' => (isa => 'Int', is => 'rw', predicate => 'has_block_row_numbers', clearer => 'clear_block_row_numbers');
  55
  56 has 'block_col_numbers' => (isa => 'Int', is => 'rw', predicate => 'has_block_col_numbers', clearer => 'clear_block_col_numbers');
  57
  58 has 'number_of_rows' => (isa => 'Int',is => 'rw',predicate => 'has_number_of_rows',clearer => 'clear_number_of_rows');
  59
  60 has 'number_of_cols' => (isa => 'Int',is => 'rw',predicate => 'has_number_of_cols',clearer => 'clear_number_of_cols');
  61
  62 has 'number_of_reps' => (isa => 'Int', is => 'rw', predicate => 'has_number_of_reps', clearer => 'clear_number_of_reps');
  63
  64 has 'block_size' => (isa => 'Int', is => 'rw', predicate => 'has_block_size', clearer => 'clear_block_size');
  65
  66 has 'greenhouse_num_plants' => (isa => 'ArrayRef[Int]', is => 'rw', predicate => 'has_greenhouse_num_plants', clearer => 'clear_greenhouse_num_plants');
  67
  68 has 'maximum_block_size' => (isa => 'Int', is => 'rw', predicate => 'has_maximum_block_size', clearer => 'clear_maximum_block_size');
  69
  70 has 'plot_name_prefix' => (isa => 'Str', is => 'rw', predicate => 'has_plot_name_prefix', clearer => 'clear_plot_name_prefix');
  71
  72 has 'plot_name_suffix' => (isa => 'Str', is => 'rw', predicate => 'has_plot_name_suffix', clearer => 'clear_plot_name_suffix');
  73
  74 has 'plot_start_number' => (isa => 'Int', is => 'rw', predicate => 'has_plot_start_number', clearer => 'clear_plot_start_number', default => 1);
  75
  76 has 'plot_number_increment' => (isa => 'Int', is => 'rw', predicate => 'has_plot_number_increment', clearer => 'clear_plot_number_increment', default => 1);
  77
  78 has 'randomization_seed' => (isa => 'Int', is => 'rw', predicate => 'has_randomization_seed', clearer => 'clear_randomization_seed');
  79
  80 has 'blank' => ( isa => 'Str', is => 'rw', predicate=> 'has_blank' );
  81
  82 has 'fieldmap_col_number' => (isa => 'Int',is => 'rw',predicate => 'has_fieldmap_col_number',clearer => 'clear_fieldmap_col_number');
  83
  84 has 'fieldmap_row_number' => (isa => 'Int',is => 'rw',predicate => 'has_fieldmap_row_number',clearer => 'clear_fieldmap_row_number');
  85
  86 has 'plot_layout_format' => (isa => 'Str', is => 'rw', predicate => 'has_plot_layout_format', clearer => 'clear_plot_layout_format');
  87
  88 has 'treatments' => (isa => 'ArrayRef', is => 'rw', predicate => 'has_treatments', clearer => 'clear_treatments');
  89
  90 has 'num_plants_per_plot' => (isa => 'Int',is => 'rw',predicate => 'has_num_plants_per_plot',clearer => 'clear_num_plants_per_plot');
  91
  92 has 'num_seed_per_plot' => (isa => 'Int',is => 'rw',predicate => 'has_num_seed_per_plot',clearer => 'clear_num_seed_per_plot');
  93
  94 has 'replicated_stock_no' => (isa => 'Int',is => 'rw',predicate => 'has_replicated_stock_no',clearer => 'clear_replicated_stock_no');
  95
  96 has 'unreplicated_stock_no' => (isa => 'Int',is => 'rw',predicate => 'has_unreplicated_stock_no',clearer => 'clear_unreplicated_stock_no');
  97
  98 has 'num_of_replicated_times' => (isa => 'Int',is => 'rw',predicate => 'has_num_of_replicated_times',clearer => 'clear_num_of_replicated_times');
  99
 100 has 'sub_block_sequence' => (isa => 'Str', is => 'rw', predicate => 'has_sub_block_sequence', clearer => 'clear_sub_block_sequence');
 101
 102 has 'block_sequence' => (isa => 'Str', is => 'rw', predicate => 'has_block_sequence', clearer => 'clear_block_sequence');
 103
 104 has 'col_in_design_number' => (isa => 'Int',is => 'rw',predicate => 'has_col_in_design_number',clearer => 'clear_col_in_design_number');
 105
 106 has 'row_in_design_number' => (isa => 'Int',is => 'rw',predicate => 'has_row_in_design_number',clearer => 'clear_row_in_design_number');
 107
 108 has 'westcott_col' => (isa => 'Int',is => 'rw',predicate => 'has_westcott_col',clearer => 'clear_westcott_col');
 109
 110 has 'westcott_col_between_check' => (isa => 'Int',is => 'rw',predicate => 'has_westcott_col_between_check',clearer => 'clear_westcott_col_between_check');
 111
 112 has 'westcott_check_1' => (isa => 'Str',is => 'rw',predicate => 'has_westcott_check_1',clearer => 'clear_westcott_check_1');
 113
 114 has 'westcott_check_2' => (isa => 'Str',is => 'rw',predicate => 'has_westcott_check_2',clearer => 'clear_westcott_check_2');
 115
 116 subtype 'RandomizationMethodType',
 117   as 'Str',
 118   where { $_ eq "Wichmann-Hill" || $_ eq  "Marsaglia-Multicarry" || $_ eq  "Super-Duper" || $_ eq  "Mersenne-Twister" || $_ eq  "Knuth-
 119 TAOCP" || $_ eq  "Knuth-TAOCP-2002"},
 120   message { "The string, $_, was not a valid randomization method"};
 121
 122 has 'randomization_method' => (isa => 'RandomizationMethodType', is => 'rw', default=> "Mersenne-Twister");
 123
 124 subtype 'DesignType',
 125   as 'Str',
 126   where { $_ eq "CRD" || $_ eq "RCBD" || $_ eq "RRC" || $_ eq "Alpha" || $_ eq "Lattice" || $_ eq "Augmented" || $_ eq "MAD" || $_ eq "genotyping_plate" || $_ eq "greenhouse" || $_ eq "p-rep" || $_ eq "splitplot" || $_ eq "Westcott" || $_ eq "Analysis" },
 127   message { "The string, $_, was not a valid design type" };
 128
 129 has 'design_type' => (isa => 'DesignType', is => 'rw', predicate => 'has_design_type', clearer => 'clear_design_type');
 130
 131 has 'replicated_accession_no' => (isa => 'Int', is => 'rw', predicate => 'has_replicated_accession_no' );
 132
 133 has 'unreplicated_accession_no' => (isa => 'Maybe[Int]', is => 'rw', predicate => 'has_unreplicated_accession_no');
 134
 135 has 'tempfile' => (isa => "Str", is => 'rw', required => 0);
 136
 137 has 'backend' => (isa => "Str", is => 'rw', required => 0);
 138
 139 has 'submit_host' => (isa => "Str", is => 'rw', required => 0);
 140
 141 has 'temp_base' => (isa => "Str", is => 'rw', required => 0);
 142
 143 sub get_design {
 144     my $self = shift;
 145     #print STDERR Dumper $self->{design};
 146      return $self->{design};
 147 }
 148
 149
 150 sub calculate_design {
 151     my $self = shift;
 152
 153     my $design;
 154
 155     if ($self->has_design_type()) {
 156         my $design_type = $self->get_design_type();
 157         if ($design_type eq "p-rep") { $design_type="Prep"; }
 158         print STDERR "DESIGN TYPE = ".$design_type."\n";
 159         $self->load_plugin($design_type);
 160         $design = $self->create_design();
 161     }
 162
 163     if ($design) {
 164         $self->{design} = $design;
 165         return 1;
 166     }
 167     else  {
 168         return 0;
 169     }
 170 }
 171
 172 sub isint{
 173   my $val = shift;
 174   return ($val =~ m/^\d+$/);
 175 }
 176
 177
 178 sub validate_field_colNumber {
 179     my $colNum = shift;
 180     if (isint($colNum)){
 181
 182         return $colNum;
 183     } else {
 184         die "Choose a different row number for field map generation. The product of number of stocks and rep when divided by row number should give an integer\n";
 185         return;
 186     }
 187
 188 }
 189
 190 sub _convert_plot_numbers {
 191   my $self = shift;
 192   my $plot_numbers_ref = shift;
 193   my $rep_numbers_ref = shift;
 194   my $number_of_reps = shift;
 195   my @plot_numbers = @{$plot_numbers_ref};
 196   my @rep_numbers = @{$rep_numbers_ref};
 197   my $total_plot_count = scalar(@plot_numbers);
 198   my $rep_plot_count = $total_plot_count / $number_of_reps;
 199   my $first_plot_number = 1;
 200
 201   my $plot_increment;
 202   if ($rep_plot_count > 999) {
 203     $plot_increment = 10000;
 204     $first_plot_number = 10001;
 205   } elsif ($rep_plot_count > 99) {
 206     $plot_increment = 1000;
 207     $first_plot_number = 1001;
 208   } elsif ($rep_plot_count > 9) {
 209     $plot_increment = 100;
 210     $first_plot_number = 101;
 211   } else {
 212     $plot_increment = 10;
 213     $first_plot_number = 1;
 214   }
 215   my $idx = 0;
 216   for (my $i = 0; $i < $number_of_reps; $i++) {
 217     for (my $j = 0; $j < $rep_plot_count; $j++) {
 218       if ($i == 0) {
 219         $plot_numbers[$idx] = $first_plot_number + $j;
 220         $idx++;
 221       } else {
 222         $plot_numbers[$idx] = $plot_increment + $first_plot_number + $j;
 223         $idx++;
 224       }
 225     }
 226     if ($i > 0) {
 227       $plot_increment += $plot_increment;
 228     }
 229   }
 230   return \@plot_numbers;
 231
 232 #   for (my $i = 0; $i < scalar(@plot_numbers); $i++) {
 233 #     my $plot_number;
 234 #     my $first_plot_number;
 235 #     if($self->has_plot_start_number || $self->has_plot_number_increment){
 236 #         if ($self->has_plot_start_number()){
 237 #           $first_plot_number = $self->get_plot_start_number();
 238 #         } else {
 239 #           $first_plot_number = 1;
 240 #         }
 241 #         if ($self->has_plot_number_increment()){
 242 #           $plot_number = $first_plot_number + ($i * $self->get_plot_number_increment());
 243 #         }
 244 #         else {
 245 #           $plot_number = $first_plot_number + $i;
 246 #         }
 247 #     }
 248 #     else {
 249 #         $plot_number = $plot_numbers[$i];
 250 #     }
 251 #     $plot_numbers[$i] = $plot_number;
 252 #   }
 253 #   return \@plot_numbers;
 254 }
 255
 256 # the function below should be split up and moved to the relevant plugin...
 257 #
 258 sub _build_plot_names {
 259     my $self = shift;
 260     my $design_ref = shift;
 261     my %design = %{$design_ref};
 262     my $prefix = '';
 263     my $suffix = '';
 264     my $trial_name = $self->get_trial_name;
 265
 266     if ($self->has_plot_name_prefix()) {
 267         $prefix = $self->get_plot_name_prefix()."-";
 268     }
 269     if ($self->has_plot_name_suffix()) {
 270         $suffix = $self->get_plot_name_suffix();
 271     }
 272
 273     foreach my $key (keys %design) {
 274         $trial_name ||="";
 275         my $block_number = $design{$key}->{block_number};
 276         my $stock_name = $design{$key}->{stock_name};
 277         my $rep_number = $design{$key}->{rep_number};
 278         $design{$key}->{plot_number} = $key;
 279
 280         if ($self->get_design_type() eq "RCBD") {  # as requested by IITA (Prasad)
 281             my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 282             $design{$key}->{plot_number} = $design{$key}->{plot_num_per_block};
 283             #$design{$key}->{plot_name} = $prefix.$trial_name."_rep_".$rep_number."_".$stock_name."_".$block_number."_".$plot_num_per_block."".$suffix;
 284         $design{$key}->{plot_name} = $prefix.$trial_name."-rep".$rep_number."-".$stock_name."_".$plot_num_per_block."".$suffix;
 285         }
 286         elsif ($self->get_design_type() eq "Augmented") {
 287       my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 288             $design{$key}->{plot_name} = $prefix.$trial_name."-plotno".$key."-block".$block_number."-".$stock_name."_".$plot_num_per_block."".$suffix;
 289         }
 290     elsif ($self->get_design_type() eq "greenhouse") {
 291         $design{$key}->{plot_name} = $prefix.$trial_name."_".$stock_name."_".$key.$suffix;
 292     }
 293         else {
 294       my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 295       $design{$key}->{plot_name} = $prefix.$trial_name."-rep".$rep_number."-".$stock_name."_".$plot_num_per_block."".$suffix;
 296             #$design{$key}->{plot_name} = $prefix.$trial_name."_".$key.$suffix;
 297         }
 298
 299         if($design{$key}->{subplots_names}){
 300             my $nums = $design{$key}->{subplots_names};
 301             my @named_subplots;
 302             foreach (@$nums){
 303                 push @named_subplots, $design{$key}->{plot_name}."_subplot_".$_;
 304             }
 305             $design{$key}->{subplots_names} = \@named_subplots;
 306         }
 307     }
 308
 309     #print STDERR Dumper(\%design);
 310
 311     return \%design;
 312 }
 313
 314 sub _check_controls_and_accessions_lists {
 315     my $self = shift;
 316     my @stock_list = $self->get_stock_list() ? @{$self->get_stock_list()} : ();
 317     my @control_list_crbd = $self->get_control_list_crbd() ? @{$self->get_control_list_crbd()} : ();
 318     my %control_names_lookup = map { $_ => 1 } @control_list_crbd;
 319     foreach my $stock_name_iter (@stock_list) {
 320         if (exists($control_names_lookup{$stock_name_iter})) {
 321             #die "Names in accessions list cannot be used also as controls. Please use separate lists for your controls and your accessions. The following accession is in both lists and is a problem: $stock_name_iter\n";
 322         }
 323     }
 324 }
 325
 326 1;