use strict;
use warnings;

package Signif::Word;
use fields qw{sem prons n_prons rating};
#rating starts off = universal retention rate; later, takes into account
# properties of pronunciations (derived? many prons?)
#n_prons is number of pronunciations, whether or not discarded
use Signif::Pron;

sub new {
  my $type = shift(@_);
  my $sem = shift(@_);
  my Signif::Word $w = fields::new($type);
  $w->{sem} = $sem;
  $w->{prons} = [];
  print(qq{  Semantic $sem\n});
  return $w;
}

sub start_pron {
  my Signif::Word $word = shift(@_);
  my $pron = Signif::Pron->new(@_);
  $word->{n_prons}++;
  push(@{$word->{prons}}, $pron) if defined($pron);
  return $pron;
}

sub by_descending_rating {$b->rating <=> $a->rating;}

sub end {
  my Signif::Word $word = shift(@_);
  my $retention_rates = shift(@_);
  my $weight_derivs = shift(@_);  # 0..100
  my $max_prons_per_sem = shift(@_);
  if (!@{$word->{prons}}) {return undef;}
  #Figure out global rating for word: adjust rating (now just based on
  # retention rate universals) based on $weight_derivs and the deriv rating
  # of the individual words.
  #To do: consider also adjusting by how many candidate words there
  # were.
  if ($max_prons_per_sem < scalar(@{$word->{prons}})) {
    $word->{prons} = [sort by_descending_rating @{$word->{prons}}];
    $#{$word->{prons}} = $max_prons_per_sem - 1;
  }
  my $sem_retention_rate = $retention_rates->for_sem($word->{sem});
  my $best_pron_score = -1;
  foreach my $pron (@{$word->{prons}}) {
    my $pron_score = $pron->adjust_rating($weight_derivs, $sem_retention_rate);
    if ($pron_score > $best_pron_score) {
      $best_pron_score = $pron_score;
    }
  }
  $word->{rating} = $best_pron_score;
  return $word;
}

sub withdraw_pron {
  my Signif::Word $word = shift(@_);
  pop(@{$word->{prons}});
}

sub sem {
  my Signif::Word $word = shift(@_);
  return $word->{sem};
}

sub rating {
  my Signif::Word $word = shift(@_);
  return $word->{rating};
}

=for comment
For each pron, extract the part that will be used in the tests.
=cut
sub select {
  my Signif::Word $word = shift(@_);
  my $compare_part = shift(@_);  #e.g., 'C1'
  my $compare_metric = shift(@_); #e.g., 'place+voice'
  my $prons = $word->{prons};
  print(qq{$word->{sem}\n});
  foreach my $pron (@$prons) {
    $pron->select($compare_part, $compare_metric);
  }
  return $word;
}

sub score_against {
  my Signif::Word $word1 = shift(@_);
  my Signif::Word $word2 = shift(@_);
  my $chooser = shift(@_);
  if ($chooser =~ m{^average$}i) {return Score_Average($word1, $word2);}
  if ($chooser =~ m{^worst$}i) {return Score_Worst($word1, $word2);}
  if ($chooser =~ m{^best$}i) {return Score_Best($word1, $word2);}
  die(qq{Chooser algorithm ‘$chooser’ not implemented.\n});
}

sub Score_Average($$) {
  my Signif::Word $word1 = shift(@_);
  my Signif::Word $word2 = shift(@_);
  my $sum = 0;
  my $N = 0;
  foreach my $phon1 (@{$word1->{prons}}) {
    foreach my $phon2 (@{$word2->{prons}}) {
      my $score = $phon1->score_against($phon2);
      $sum += $score;
      $N++;
    }
  }
  return $sum / $N;
}

1;