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_accession_no' => (isa => 'Int',is => 'rw',predicate => 'has_replicated_accession_no',clearer => 'clear_replicated_accession_no');
  95
  96 has 'unreplicated_accession_no' => (isa => 'Int',is => 'rw',predicate => 'has_unreplicated_accession_no',clearer => 'clear_unreplicated_accession_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 "Alpha" || $_ eq "Lattice" || $_ eq "Augmented" || $_ eq "MAD" || $_ eq "genotyping_plate" || $_ eq "greenhouse" || $_ eq "p-rep" || $_ eq "splitplot" || $_ eq "westcott" },
 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 my $design;
 132
 133 sub get_design {
 134      print STDERR Dumper $design;
 135      return $design;
 136 }
 137
 138
 139 sub calculate_design {
 140     my $self = shift;
 141
 142     my $design;
 143
 144     if ($self->has_design_type()) {
 145         my $design_type = $self->get_design_type();
 146         if ($design_type eq "p-rep") { $design_type="Prep"; }
 147         print STDERR "DESIGN TYPE = ".$design_type."\n";
 148         $self->load_plugin($design_type);
 149         $design = $self->create_design();
 150     }
 151
 152     if ($design) {
 153         return 1;
 154     }
 155     else  {
 156         return 0;
 157     }
 158 }
 159
 160 sub isint{
 161   my $val = shift;
 162   return ($val =~ m/^\d+$/);
 163 }
 164
 165
 166 sub _validate_field_colNumber {
 167   my $colNum = shift;
 168   if (isint($colNum)){
 169     return $colNum;
 170   } else {
 171       die "Choose a different row number for field map generation. The product of number of accessions and rep when divided by row number should give an integer\n";
 172       return;
 173   }
 174
 175 }
 176
 177 sub _convert_plot_numbers {
 178   my $self = shift;
 179   my $plot_numbers_ref = shift;
 180   my $rep_numbers_ref = shift;
 181   my $number_of_reps = shift;
 182   my @plot_numbers = @{$plot_numbers_ref};
 183   my @rep_numbers = @{$rep_numbers_ref};
 184   my $total_plot_count = scalar(@plot_numbers);
 185   my $rep_plot_count = $total_plot_count / $number_of_reps;
 186   for (my $i = 0; $i < scalar(@plot_numbers); $i++) {
 187     my $plot_number;
 188     my $first_plot_number;
 189     if($self->has_plot_start_number || $self->has_plot_number_increment){
 190         if ($self->has_plot_start_number()){
 191           $first_plot_number = $self->get_plot_start_number();
 192         } else {
 193           $first_plot_number = 1;
 194         }
 195         if ($self->has_plot_number_increment()){
 196           $plot_number = $first_plot_number + ($i * $self->get_plot_number_increment());
 197         }
 198
 199         my $cheking = ($rep_numbers[$i] * $rep_plot_count) / $rep_plot_count;
 200         #print STDERR Dumper($cheking);
 201         my $new_plot;
 202         if ($cheking != 1){
 203             if (length($first_plot_number) == 3 ){
 204                 $new_plot = $cheking * 100;
 205                 $plot_number = ($i * $self->get_plot_number_increment()) + $new_plot - (($cheking -1) * $rep_plot_count) + 1;
 206             }
 207             #print STDERR Dumper($new_plot);
 208             if (length($first_plot_number) == 4 ){
 209                 $new_plot = $cheking * 1000;
 210                 $plot_number = ($i * $self->get_plot_number_increment()) + $new_plot - (($cheking -1) * $rep_plot_count) + 1;
 211             }
 212         }
 213
 214
 215         else {
 216           $plot_number = $first_plot_number + $i;
 217         }
 218     }
 219     else {
 220         $plot_number = $plot_numbers[$i];
 221     }
 222     $plot_numbers[$i] = $plot_number;
 223   }
 224   return \@plot_numbers;
 225 }
 226
 227 # the function below should be split up and moved to the relevant plugin...
 228 #
 229 sub _build_plot_names {
 230     my $self = shift;
 231     my $design_ref = shift;
 232     my %design = %{$design_ref};
 233     my $prefix = '';
 234     my $suffix = '';
 235     my $trial_name = $self->get_trial_name;
 236
 237     if ($self->has_plot_name_prefix()) {
 238         $prefix = $self->get_plot_name_prefix()."_";
 239     }
 240     if ($self->has_plot_name_suffix()) {
 241         $suffix = $self->get_plot_name_suffix();
 242     }
 243
 244     foreach my $key (keys %design) {
 245         $trial_name ||="";
 246         my $block_number = $design{$key}->{block_number};
 247         my $stock_name = $design{$key}->{stock_name};
 248         my $rep_number = $design{$key}->{rep_number};
 249         $design{$key}->{plot_number} = $key;
 250
 251         if ($self->get_design_type() eq "RCBD") { # as requested by IITA (Prasad)
 252             my $plot_num_per_block = $design{$key}->{plot_num_per_block};
 253             $design{$key}->{plot_number} = $design{$key}->{plot_num_per_block};
 254             #$design{$key}->{plot_name} = $prefix.$trial_name."_rep_".$rep_number."_".$stock_name."_".$block_number."_".$plot_num_per_block."".$suffix;
 255             $design{$key}->{plot_name} = $prefix.$trial_name."_rep".$rep_number."_".$stock_name."_".$plot_num_per_block."".$suffix;
 256         }
 257         elsif ($self->get_design_type() eq "Augmented") {
 258             $design{$key}->{plot_name} = $prefix.$trial_name."_plotno".$key."_".$stock_name."_".$suffix;
 259         }
 260     elsif ($self->get_design_type() eq "greenhouse") {
 261         $design{$key}->{plot_name} = $prefix.$trial_name."_".$stock_name."_".$key.$suffix;
 262     }
 263         else {
 264             $design{$key}->{plot_name} = $prefix.$trial_name."_".$key.$suffix;
 265         }
 266
 267         if($design{$key}->{subplots_names}){
 268             my $nums = $design{$key}->{subplots_names};
 269             my @named_subplots;
 270             foreach (@$nums){
 271                 push @named_subplots, $design{$key}->{plot_name}."_subplot_".$_;
 272             }
 273             $design{$key}->{subplots_names} = \@named_subplots;
 274         }
 275     }
 276
 277     #print STDERR Dumper(\%design);
 278
 279     return \%design;
 280 }
 281
 282 sub _check_controls_and_accessions_lists {
 283     my $self = shift;
 284     my @stock_list = $self->get_stock_list() ? @{$self->get_stock_list()} : ();
 285     my @control_list_crbd = $self->get_control_list_crbd() ? @{$self->get_control_list_crbd()} : ();
 286     my %control_names_lookup = map { $_ => 1 } @control_list_crbd;
 287     foreach my $stock_name_iter (@stock_list) {
 288         if (exists($control_names_lookup{$stock_name_iter})) {
 289             #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";
 290         }
 291     }
 292 }
 293
 294 1;