lib/SGN/Controller/solGS/modelAccuracy.pm

   1 package SGN::Controller::solGS::modelAccuracy;
   2
   3
   4 use Moose;
   5 use namespace::autoclean;
   6
   7
   8 use Carp qw/ carp confess croak /;
   9 use File::Slurp qw /write_file read_file/;
  10 use JSON;
  11 use Math::Round::Var;
  12 use Statistics::Descriptive;
  13
  14
  15 BEGIN { extends 'Catalyst::Controller' }
  16
  17 sub download_validation :Path('/solgs/download/model/validation') Args() {
  18     my ($self, $c) = @_;
  19
  20         my $args = $c->req->param('arguments');
  21     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
  22
  23         my $validation_file = $self->download_validation_file($c);
  24
  25         my $ret = {'validation_file' => $validation_file};
  26         $ret = to_json($ret);
  27         $c->res->content_type('application/json');
  28     $c->res->body($ret);
  29
  30 }
  31
  32
  33 sub get_model_accuracy_value {
  34     my ($self, $c, $model_id, $trait_abbr) = @_;
  35
  36     my $cv_stat = $self->cross_validation_stat($c, $model_id, $trait_abbr);
  37
  38     my ($accuracy) = grep{ $_->[0] eq 'Mean accuracy'} @$cv_stat;
  39
  40     $c->stash->{accuracy_value} = $accuracy->[1];
  41
  42 }
  43
  44
  45 sub get_cross_validations {
  46     my ($self, $c, $model_id, $trait_abbr) = @_;
  47
  48     $c->stash->{training_pop_id} = $model_id;
  49     $c->stash->{trait_abbr} = $trait_abbr;
  50
  51     $c->controller('solGS::Files')->validation_file($c);
  52     my $file = $c->stash->{validation_file};
  53
  54     my $cvs = $c->controller('solGS::Utils')->read_file_data($file);
  55     my @raw_cvs = grep { $_->[0] =~ /CV Fold/i } @$cvs;
  56
  57     return \@raw_cvs;
  58 }
  59
  60
  61 sub model_accuracy_report {
  62     my ($self, $c) = @_;
  63     my $file = $c->stash->{validation_file};
  64
  65     my $accuracy;
  66     if (!-e $file)
  67     {
  68         $accuracy = [["Validation file doesn't exist.", "None"]];
  69     }
  70     elsif (!-s $file)
  71     {
  72         $accuracy = [["There is no cross-validation output report.", "None"]];
  73     }
  74     else
  75     {
  76         my $model_id = $c->stash->{training_pop_id};
  77         my $trait_abbr = $c->stash->{trait_abbr};
  78
  79         $c->stash->{accuracy_report} = $self->cross_validation_stat($c, $model_id, $trait_abbr);
  80     }
  81
  82 }
  83
  84 sub append_val_summary_stat {
  85     my ($self, $c, $val_file) = @_;
  86
  87     my $model_id = $c->stash->{training_pop_id};
  88     my $trait_abbr = $c->stash->{trait_abbr};
  89     my $summary_stat = $self->cross_validation_stat($c, $model_id, $trait_abbr);
  90     my $summary_txt  = "\n----summary statistics----\n";
  91     $summary_stat = join("\n", map { $_->[0] . "\t" . $_->[1] }  @$summary_stat);
  92     $summary_txt .= $summary_stat;
  93
  94     my $val_txt = read_file($val_file, {binmode=>'utf8'});
  95     if ($val_txt !~ /summary statistics/) {
  96         write_file($val_file,
  97             {append => 1, binmode => 'utf8'},
  98             $summary_txt
  99         );
 100     }
 101 }
 102
 103 sub cross_validation_stat {
 104     my ($self, $c, $model_id, $trait_abbr) = @_;
 105
 106     my $cv_data = $self->get_cross_validations($c, $model_id, $trait_abbr);
 107
 108     my @data = map {$_->[1] =~ s/\s+//r } @$cv_data;
 109
 110     my $stat = Statistics::Descriptive::Full->new();
 111     $stat->add_data(@data);
 112
 113     my $min  = $stat->min;
 114     my $max  = $stat->max;
 115     my $mean = $stat->mean;
 116     my $med  = $stat->median;
 117     my $std  = $stat->standard_deviation;
 118     my $cv   = ($std / $mean) * 100;
 119     my $cnt  = scalar(@data);
 120
 121     my $round = Math::Round::Var->new(0.01);
 122     $std  = $round->round($std);
 123     $mean = $round->round($mean);
 124     $cv   = $round->round($cv);
 125
 126     $cv  = $cv . '%';
 127
 128     my @desc_stat = (
 129         ['No. of K-folds', 10],
 130         ['Replications', 2],
 131         ['Total cross-validation runs', $cnt],
 132         ['Minimum accuracy', $min],
 133         ['Maximum accuracy', $max],
 134         ['Standard deviation', $std],
 135         ['Coefficient of variation', $cv],
 136         ['Median accuracy', $med],
 137         ['Mean accuracy',  $mean]
 138         );
 139
 140     return \@desc_stat;
 141
 142 }
 143
 144
 145 sub create_model_summary {
 146     my ($self, $c, $model_id, $trait_id) = @_;
 147
 148     my $protocol_id = $c->stash->{genotyping_protocol_id};
 149
 150     $c->controller('solGS::Trait')->get_trait_details($c, $trait_id);
 151     my $tr_abbr = $c->stash->{trait_abbr};
 152
 153     my $path = $c->req->path;
 154
 155         my $data_set_type;
 156         if ($path =~ /solgs\/traits\/all\/population\//)
 157         {
 158
 159                 $data_set_type = 'single_population';
 160         }
 161         elsif ($path =~ /solgs\/models\/combined\/trials\//)
 162         {
 163                 $data_set_type = 'combined_populations';
 164         }
 165
 166         my $args = {
 167                 'trait_id' => $trait_id,
 168                 'training_pop_id' => $model_id,
 169                 'genotyping_protocol_id' => $protocol_id,
 170                 'data_set_type' => $data_set_type
 171         };
 172
 173         my $model_page = $c->controller('solGS::Path')->model_page_url($args);
 174         my $trait_page = qq | <a href="$model_page" onclick="solGS.waitPage()">$tr_abbr</a>|;
 175
 176     $self->get_model_accuracy_value($c, $model_id, $tr_abbr);
 177     my $accuracy_value = $c->stash->{accuracy_value};
 178
 179     my $heritability = $c->controller("solGS::gebvPhenoRegression")->get_heritability($c, $model_id, $trait_id);
 180     my $additive_variance = $c->controller("solGS::gebvPhenoRegression")->get_additive_variance($c, $model_id, $trait_id);
 181
 182     my $model_summary = [$trait_page, $accuracy_value, $additive_variance, $heritability];
 183
 184     $c->stash->{model_summary} = $model_summary;
 185
 186 }
 187
 188 sub download_validation_file {
 189         my ($self, $c) = @_;
 190
 191         $c->controller('solGS::Trait')->get_trait_details($c, $c->stash->{trait_id});
 192
 193         my $file = $c->controller('solGS::Files')->validation_file($c);
 194     $self->append_val_summary_stat($c, $file);
 195         $file = $c->controller('solGS::Files')->copy_to_tempfiles_subdir( $c, $file, 'solgs' );
 196
 197         return $file;
 198 }
 199
 200
 201 sub begin : Private {
 202     my ($self, $c) = @_;
 203
 204     $c->controller('solGS::Files')->get_solgs_dirs($c);
 205
 206 }
 207
 208
 209 ####
 210 1;
 211 ###