lib/CXGN/Trial/TrialLayoutDownload/PlantLayout.pm

   1 package CXGN::Trial::TrialLayoutDownload::PlantLayout;
   2
   3 =head1 NAME
   4
   5 CXGN::Trial::TrialLayoutDownload::PlantLayout - an object to handle downloading a plant level trial layout. this should only be called from CXGN::Trial::TrialLayoutDownload
   6
   7 =head1 USAGE
   8
   9 my $trial_plant_layout = CXGN::Trial::TrialLayoutDownload::PlantLayout->new({
  10     schema => $schema,
  11     trial_id => $trial_id,
  12     data_level => $data_level,
  13     selected_columns => \%selected_cols,
  14     selected_trait_ids => \@selected_traits,
  15     treatment_project_ids => $treatments,
  16     design => $design,
  17     trial => $selected_trial,
  18     treatment_info_hash => \%treatment_info_hash,
  19     overall_performance_hash => \%fieldbook_trait_hash,
  20     all_stats => $all_stats,
  21 });
  22 my $result = $trial_plant_layout->retrieve();
  23
  24 =head1 DESCRIPTION
  25
  26 Will output an array of arrays, where each row is a plant in the trial. the columns are based on the supplied selected_cols and the columns will include any treatments (management factors) that are part of the trial. additionally, trait performance can be included in column using the overall_performance_hash. this should only be called from CXGN::Trial::TrialLayoutDownload
  27
  28 =head1 AUTHORS
  29
  30 =cut
  31
  32 use strict;
  33 use warnings;
  34 use Moose;
  35 use Try::Tiny;
  36 use Data::Dumper;
  37 use SGN::Model::Cvterm;
  38 use CXGN::Stock;
  39 use CXGN::Stock::Accession;
  40 use JSON;
  41
  42 extends 'CXGN::Trial::TrialLayoutDownload';
  43
  44 sub retrieve {
  45     my $self = shift;
  46     my $schema = $self->schema();
  47     my %selected_cols = %{$self->selected_columns};
  48     my %design = %{$self->design};
  49     my $trial = $self->trial;
  50     my $treatment_info_hash = $self->treatment_info_hash || {};
  51     my $treatment_list = $treatment_info_hash->{treatment_trial_list} || [];
  52     my $treatment_name_list = $treatment_info_hash->{treatment_trial_names_list} || [];
  53     my $treatment_units_hash_list = $treatment_info_hash->{treatment_units_hash_list} || [];
  54     my $trait_header = $self->trait_header || [];
  55     my $exact_performance_hash = $self->exact_performance_hash || {};
  56     my $overall_performance_hash = $self->overall_performance_hash || {};
  57     my $all_stats = $self->all_stats;
  58     my @output;
  59     my $trial_stock_type = $self->trial_stock_type();
  60
  61     my @possible_cols = ('plant_name','plant_id','subplot_name','subplot_id','plot_name','plot_id','accession_name','accession_id','plot_number','block_number','is_a_control','range_number','rep_number','row_number','col_number','seedlot_name','seed_transaction_operator','num_seed_per_plot','subplot_number','plant_number','pedigree','location_name','trial_name','year','synonyms','tier','plot_geo_json');
  62
  63     my @header;
  64     foreach (@possible_cols){
  65         if ($selected_cols{$_}){
  66             if (($_ eq 'accession_name') && ($trial_stock_type eq 'family_name')) {
  67                 push @header, 'family_name';
  68             } elsif (($_ eq 'accession_name') && ($trial_stock_type eq 'cross')) {
  69                 push @header, 'cross_unique_id';
  70             } else {
  71                 push @header, $_;
  72             }
  73         }
  74     }
  75
  76     foreach (@$treatment_name_list){
  77         push @header, "ManagementFactor:".$_;
  78     }
  79     foreach (@$trait_header){
  80         push @header, $_;
  81     }
  82
  83     push @output, \@header;
  84
  85     my $trial_name = $trial->get_name ? $trial->get_name : '';
  86     my $location_name = $trial->get_location ? $trial->get_location->[1] : '';
  87     my $trial_year = $trial->get_year ? $trial->get_year : '';
  88     my $pedigree_strings = $self->_get_all_pedigrees(\%design);
  89
  90     #Turn plot level design into a plant level design that can be sorted on plot_number and then plant index number..
  91     my @plant_design;
  92     while (my($plot_number, $design_info) = each %design){
  93         my $acc_synonyms = '';
  94         if (exists($selected_cols{'synonyms'})){
  95             my $accession = CXGN::Stock::Accession->new({schema=>$schema, stock_id=>$design_info->{"accession_id"}});
  96             $acc_synonyms = join ',', @{$accession->synonyms};
  97         }
  98         my $acc_pedigree = '';
  99         if (exists($selected_cols{'pedigree'})){
 100             $acc_pedigree = $pedigree_strings->{$design_info->{"accession_name"}};
 101         }
 102         $design_info->{synonyms} = $acc_synonyms;
 103         $design_info->{pedigree} = $acc_pedigree;
 104
 105         my $subplot_plant_names = $design_info->{'subplots_plant_names'};
 106         my $subplot_names = $design_info->{'subplot_names'};
 107         my $subplot_ids = $design_info->{'subplot_ids'};
 108         my $subplot_index_numbers = $design_info->{'subplot_index_numbers'};
 109         my $j = 0;
 110         my %plant_subplot_hash;
 111         foreach my $subplot_name (@$subplot_names){
 112             my $plant_names = $subplot_plant_names->{$subplot_name};
 113             foreach my $plant_name (@$plant_names){
 114                 $plant_subplot_hash{$plant_name}->{subplot_id} = $subplot_ids->[$j];
 115                 $plant_subplot_hash{$plant_name}->{subplot_number} = $subplot_index_numbers->[$j];
 116                 $plant_subplot_hash{$plant_name}->{subplot_name} = $subplot_name;
 117             }
 118             $j++;
 119         }
 120
 121         my $plant_names = $design_info->{'plant_names'};
 122         my $plant_ids = $design_info->{'plant_ids'};
 123         my $plant_index_numbers = $design_info->{'plant_index_numbers'};
 124         my $i = 0;
 125         foreach my $plant_name (@$plant_names){
 126             my %plant_design = %$design_info;
 127             $plant_design{plant_name} = $plant_name;
 128             $plant_design{plant_id} = $plant_ids->[$i];
 129             $plant_design{plant_number} = $plant_index_numbers->[$i];
 130             $plant_design{subplot_name} = $plant_subplot_hash{$plant_name}->{subplot_name};
 131             $plant_design{subplot_id} = $plant_subplot_hash{$plant_name}->{subplot_id};
 132             $plant_design{subplot_number} = $plant_subplot_hash{$plant_name}->{subplot_number};
 133             push @plant_design, \%plant_design;
 134             $i++;
 135         }
 136     }
 137     #print STDERR Dumper \@plant_design;
 138
 139     my @overall_trait_names = sort keys %$overall_performance_hash;
 140     my @exact_trait_names = sort keys %$exact_performance_hash;
 141
 142     no warnings 'uninitialized';
 143     @plant_design = sort { $a->{plot_number} <=> $b->{plot_number} || $a->{subplot_number} <=> $b->{subplot_number} || $a->{plant_number} <=> $b->{plant_number} } @plant_design;
 144
 145     foreach my $design_info (@plant_design) {
 146         my $line;
 147         foreach my $c (@possible_cols){
 148             if ($selected_cols{$c}){
 149                 if ($c eq 'location_name'){
 150                     push @$line, $location_name;
 151                 } elsif ($c eq 'plot_geo_json'){
 152                     push @$line, $design_info->{"plot_geo_json"} ? encode_json $design_info->{"plot_geo_json"} : '';
 153                 } elsif ($c eq 'trial_name'){
 154                     push @$line, $trial_name;
 155                 } elsif ($c eq 'year'){
 156                     push @$line, $trial_year;
 157                 } elsif ($c eq 'tier'){
 158                     my $row = $design_info->{"row_number"} ? $design_info->{"row_number"} : '';
 159                     my $col = $design_info->{"col_number"} ? $design_info->{"col_number"} : '';
 160                     push @$line, $row."/".$col;
 161                 } else {
 162                     push @$line, $design_info->{$c};
 163                 }
 164             }
 165         }
 166         $line = $self->_add_treatment_to_line($treatment_units_hash_list, $line, $design_info->{plant_name});
 167         $line = $self->_add_exact_performance_to_line(\@exact_trait_names, $line, $exact_performance_hash, $design_info->{plant_name});
 168         $line = $self->_add_overall_performance_to_line(\@overall_trait_names, $line, $overall_performance_hash, $design_info, $all_stats);
 169         push @output, $line;
 170     }
 171
 172     return \@output;
 173 }
 174
 175 1;