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
  79 subtype 'PlotNumberingSchemeType',
  80     as 'Str',
  81     where { $_ eq "block_based" || $_ eq "consecutive" },
  82     message { "The string $_ is not a valid plot numbering scheme. Currently allowed are 'block_based' or 'consecutive'"};
  83
  84 has 'plot_numbering_scheme' => (isa => 'Maybe[PlotNumberingSchemeType]', is => 'rw', default => 'block_based'); # so far, either block_based or consecutive
  85
  86
  87 has 'randomization_seed' => (isa => 'Int', is => 'rw', predicate => 'has_randomization_seed', clearer => 'clear_randomization_seed');
  88
  89 has 'blank' => ( isa => 'Str', is => 'rw', predicate=> 'has_blank' );
  90
  91 has 'fieldmap_col_number' => (isa => 'Int',is => 'rw',predicate => 'has_fieldmap_col_number',clearer => 'clear_fieldmap_col_number');
  92
  93 has 'fieldmap_row_number' => (isa => 'Int',is => 'rw',predicate => 'has_fieldmap_row_number',clearer => 'clear_fieldmap_row_number');
  94
  95 has 'plot_layout_format' => (isa => 'Str', is => 'rw', predicate => 'has_plot_layout_format', clearer => 'clear_plot_layout_format');
  96
  97 has 'treatments' => (isa => 'ArrayRef', is => 'rw', predicate => 'has_treatments', clearer => 'clear_treatments');
  98
  99 has 'num_plants_per_plot' => (isa => 'Int',is => 'rw',predicate => 'has_num_plants_per_plot',clearer => 'clear_num_plants_per_plot');
 100
 101 has 'num_seed_per_plot' => (isa => 'Int',is => 'rw',predicate => 'has_num_seed_per_plot',clearer => 'clear_num_seed_per_plot');
 102
 103 has 'replicated_stock_no' => (isa => 'Int',is => 'rw',predicate => 'has_replicated_stock_no',clearer => 'clear_replicated_stock_no');
 104
 105 has 'unreplicated_stock_no' => (isa => 'Int',is => 'rw',predicate => 'has_unreplicated_stock_no',clearer => 'clear_unreplicated_stock_no');
 106
 107 has 'num_of_replicated_times' => (isa => 'Int',is => 'rw',predicate => 'has_num_of_replicated_times',clearer => 'clear_num_of_replicated_times');
 108
 109 has 'sub_block_sequence' => (isa => 'Str', is => 'rw', predicate => 'has_sub_block_sequence', clearer => 'clear_sub_block_sequence');
 110
 111 has 'block_sequence' => (isa => 'Str', is => 'rw', predicate => 'has_block_sequence', clearer => 'clear_block_sequence');
 112
 113 has 'col_in_design_number' => (isa => 'Int',is => 'rw',predicate => 'has_col_in_design_number',clearer => 'clear_col_in_design_number');
 114
 115 has 'row_in_design_number' => (isa => 'Int',is => 'rw',predicate => 'has_row_in_design_number',clearer => 'clear_row_in_design_number');
 116
 117 has 'westcott_col' => (isa => 'Int',is => 'rw',predicate => 'has_westcott_col',clearer => 'clear_westcott_col');
 118
 119 has 'westcott_col_between_check' => (isa => 'Int',is => 'rw',predicate => 'has_westcott_col_between_check',clearer => 'clear_westcott_col_between_check');
 120
 121 has 'westcott_check_1' => (isa => 'Str',is => 'rw',predicate => 'has_westcott_check_1',clearer => 'clear_westcott_check_1');
 122
 123 has 'westcott_check_2' => (isa => 'Str',is => 'rw',predicate => 'has_westcott_check_2',clearer => 'clear_westcott_check_2');
 124
 125 subtype 'RandomizationMethodType',
 126   as 'Str',
 127   where { $_ eq "Wichmann-Hill" || $_ eq  "Marsaglia-Multicarry" || $_ eq  "Super-Duper" || $_ eq  "Mersenne-Twister" || $_ eq  "Knuth-
 128 TAOCP" || $_ eq  "Knuth-TAOCP-2002"},
 129   message { "The string, $_, was not a valid randomization method"};
 130
 131 has 'randomization_method' => (isa => 'RandomizationMethodType', is => 'rw', default=> "Mersenne-Twister");
 132
 133 subtype 'DesignType',
 134   as 'Str',
 135   where { $_ eq "CRD" || $_ eq "RCBD" || $_ eq "RRC" || $_ eq "DRRC" || $_ eq "Alpha" || $_ eq "Lattice" || $_ eq "Augmented" || $_ eq "MAD" || $_ eq "genotyping_plate" || $_ eq "greenhouse" || $_ eq "p-rep" || $_ eq "splitplot" || $_ eq "Westcott" || $_ eq "Analysis" },
 136   message { "The string, $_, was not a valid design type" };
 137
 138 has 'design_type' => (isa => 'DesignType', is => 'rw', predicate => 'has_design_type', clearer => 'clear_design_type');
 139
 140 has 'replicated_accession_no' => (isa => 'Int', is => 'rw', predicate => 'has_replicated_accession_no' );
 141
 142 has 'unreplicated_accession_no' => (isa => 'Maybe[Int]', is => 'rw', predicate => 'has_unreplicated_accession_no');
 143
 144 has 'tempfile' => (isa => "Str", is => 'rw', required => 0);
 145
 146 has 'backend' => (isa => "Str", is => 'rw', required => 0);
 147
 148 has 'submit_host' => (isa => "Str", is => 'rw', required => 0);
 149
 150 has 'temp_base' => (isa => "Str", is => 'rw', required => 0);
 151
 152 sub get_design {
 153     my $self = shift;
 154     #print STDERR Dumper $self->{design};
 155      return $self->{design};
 156 }
 157
 158
 159 sub calculate_design {
 160     my $self = shift;
 161
 162     my $design;
 163
 164     if ($self->has_design_type()) {
 165         my $design_type = $self->get_design_type();
 166         if ($design_type eq "p-rep") { $design_type="Prep"; }
 167         print STDERR "DESIGN TYPE = ".$design_type."\n";
 168         $self->load_plugin($design_type);
 169         $design = $self->create_design();
 170     }
 171
 172     if ($design) {
 173         $self->{design} = $design;
 174         return 1;
 175     }
 176     else  {
 177         return 0;
 178     }
 179 }
 180
 181 sub isint{
 182   my $val = shift;
 183   return ($val =~ m/^\d+$/);
 184 }
 185
 186
 187 sub validate_field_colNumber {
 188     my $colNum = shift;
 189     if (isint($colNum)){
 190
 191         return $colNum;
 192     } else {
 193         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";
 194         return;
 195     }
 196
 197 }
 198
 199 sub _convert_plot_numbers {
 200   my $self = shift;
 201   my $plot_numbers_ref = shift;
 202   my $rep_numbers_ref = shift;
 203   my $number_of_reps = shift;
 204   my @plot_numbers = @{$plot_numbers_ref};
 205   my @rep_numbers = @{$rep_numbers_ref};
 206   my $total_plot_count = scalar(@plot_numbers);
 207   my $rep_plot_count = $total_plot_count / $number_of_reps;
 208   my $first_plot_number = 1;
 209
 210   if ($self->get_plot_numbering_scheme() eq "block_based") {
 211       print STDERR "Block based number selected - Providing plot based numbers.\n";
 212       my $plot_increment;
 213       if ($rep_plot_count > 999) {
 214           $plot_increment = 10000;
 215           $first_plot_number = 10001;
 216       } elsif ($rep_plot_count > 99) {
 217           $plot_increment = 1000;
 218           $first_plot_number = 1001;
 219       } elsif ($rep_plot_count > 9) {
 220           $plot_increment = 100;
 221           $first_plot_number = 101;
 222       } else {
 223           $plot_increment = 10;
 224           $first_plot_number = 1;
 225       }
 226       my $idx = 0;
 227       for (my $i = 0; $i < $number_of_reps; $i++) {
 228           for (my $j = 0; $j < $rep_plot_count; $j++) {
 229               if ($i == 0) {
 230                   $plot_numbers[$idx] = $first_plot_number + $j;
 231                   $idx++;
 232               } else {
 233                   $plot_numbers[$idx] = $plot_increment + $first_plot_number + $j;
 234                   $idx++;
 235               }
 236           }
 237           if ($i > 0) {
 238               $plot_increment += $plot_increment;
 239           }
 240       }
 241   }
 242   else {
 243       print STDERR "consecutive plot numbers selected - generating consecutive numbers...\n";
 244
 245       for (my $i = 0; $i < scalar(@plot_numbers); $i++) {
 246           my $plot_number;
 247           my $first_plot_number;
 248           if($self->has_plot_start_number || $self->has_plot_number_increment){
 249               if ($self->has_plot_start_number()){
 250                   $first_plot_number = $self->get_plot_start_number();
 251               } else {
 252                   $first_plot_number = 1;
 253               }
 254               if ($self->has_plot_number_increment()){
 255                   $plot_number = $first_plot_number + ($i * $self->get_plot_number_increment());
 256               }
 257               else {
 258                   $plot_number = $first_plot_number + $i;
 259               }
 260           }
 261           else {
 262               $plot_number = $plot_numbers[$i];
 263           }
 264           $plot_numbers[$i] = $plot_number;
 265       }
 266   }
 267
 268   print STDERR "PLOT NUMBERS GENERATED: ".Dumper(\@plot_numbers);
 269   return \@plot_numbers;
 270 }
 271
 272 # the function below should be split up and moved to the relevant plugin...
 273 #
 274 sub _build_plot_names {
 275     my $self = shift;
 276     my $design_ref = shift;
 277     my %design = %{$design_ref};
 278     my $prefix = '';
 279     my $suffix = '';
 280     my $trial_name = $self->get_trial_name;
 281
 282     if ($self->has_plot_name_prefix()) {
 283         $prefix = $self->get_plot_name_prefix()."-";
 284     }
 285     if ($self->has_plot_name_suffix()) {
 286         $suffix = $self->get_plot_name_suffix();
 287     }
 288
 289     foreach my $key (keys %design) {
 290         $trial_name ||="";
 291         my $block_number = $design{$key}->{block_number};
 292         my $stock_name = $design{$key}->{stock_name};
 293         my $rep_number = $design{$key}->{rep_number};
 294         $design{$key}->{plot_number} = $key;
 295
 296         if ($self->get_design_type() eq "RCBD") {  # as requested by IITA (Prasad)
 297             my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 298             $design{$key}->{plot_number} = $design{$key}->{plot_num_per_block};
 299             #$design{$key}->{plot_name} = $prefix.$trial_name."_rep_".$rep_number."_".$stock_name."_".$block_number."_".$plot_num_per_block."".$suffix;
 300         $design{$key}->{plot_name} = $prefix.$trial_name."-rep".$rep_number."-".$stock_name."_".$plot_num_per_block."".$suffix;
 301         }
 302         elsif ($self->get_design_type() eq "Augmented") {
 303       my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 304             $design{$key}->{plot_name} = $prefix.$trial_name."-plotno".$key."-block".$block_number."-".$stock_name."_".$plot_num_per_block."".$suffix;
 305         }
 306     elsif ($self->get_design_type() eq "greenhouse") {
 307         $design{$key}->{plot_name} = $prefix.$trial_name."_".$stock_name."_".$key.$suffix;
 308     }
 309         else {
 310       my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 311       $design{$key}->{plot_name} = $prefix.$trial_name."-rep".$rep_number."-".$stock_name."_".$plot_num_per_block."".$suffix;
 312             #$design{$key}->{plot_name} = $prefix.$trial_name."_".$key.$suffix;
 313         }
 314
 315         if($design{$key}->{subplots_names}){
 316             my $nums = $design{$key}->{subplots_names};
 317             my @named_subplots;
 318             foreach (@$nums){
 319                 push @named_subplots, $design{$key}->{plot_name}."_subplot_".$_;
 320             }
 321             $design{$key}->{subplots_names} = \@named_subplots;
 322         }
 323     }
 324
 325     #print STDERR Dumper(\%design);
 326
 327     return \%design;
 328 }
 329
 330 sub _check_controls_and_accessions_lists {
 331     my $self = shift;
 332     my @stock_list = $self->get_stock_list() ? @{$self->get_stock_list()} : ();
 333     my @control_list_crbd = $self->get_control_list_crbd() ? @{$self->get_control_list_crbd()} : ();
 334     my %control_names_lookup = map { $_ => 1 } @control_list_crbd;
 335     foreach my $stock_name_iter (@stock_list) {
 336         if (exists($control_names_lookup{$stock_name_iter})) {
 337             #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";
 338         }
 339     }
 340 }
 341
 342 1;