=for comment

Report on consistencies and conditional consistencies of vowel spellings
in English, British RP. 

Word set is drawn from Celex, edition 2.

Celex pronunciation key (when differs from SAMPA):
H  n=
J  tS
P  l=
R  linking r
1  eI
2  aI
3  3
4  OI
5  @U
6  aU
7  I@
8  E@
9  U@
'  "  following syll has primary stress 
"  %  following syll has 2ndary stress
-  .  syllable divider (precedes any stress marks)
$  O
#  A
_  dZ


=cut

use strict;
use warnings;


package Atom;
use fields qw{spelling pronunciation};

sub new {
  my $type = shift(@_);
  my Atom $atom = fields::new($type);
  $atom->{spelling} = shift(@_);
  my $pron = shift(@_);
  $pron =~ s{\s}{}g;
  $atom->{pronunciation} = $pron;
  return $atom;
}

sub dump {
  my Atom $atom = shift(@_);
  if (defined($atom->{spelling})) {print(qq{$atom->{spelling}=});}
  print($atom->{pronunciation});
}

package Alignment;
use fields qw{spelling pronunciation atoms};

sub new {
  my $type = shift(@_);
  my Alignment $al = fields::new($type);
  $al->{spelling} = shift(@_);
  $al->{pronunciation} = shift(@_);
  $al->{atoms} = [];
  return $al;
}

sub addAtom {
  my Alignment $al = shift(@_);
  my $spell = shift(@_);
  my $pron = shift(@_);
  if ($pron =~ s{^((?:['"-]\s)+)}{}) {
    push(@{$al->{atoms}}, Atom->new(undef, $1));
  }
  push(@{$al->{atoms}}, Atom->new($spell, $pron));
}

sub dump {
  my Alignment $al = shift(@_);
  print(qq{<$al->{spelling}> /$al->{pronunciation}/:});
  foreach my Atom $atom (@{$al->{atoms}}) {
    print(q{ });
    $atom->dump();
  }
  print(qq{\n});
}

sub forEachAtom {
  my Alignment $al = shift(@_);
  my $cb = shift(@_);
  my $atoms = $al->{atoms};
  foreach my Atom $atom (@$atoms) {$cb->($atom);}
}

package KnownCorrespondence;
use fields qw{spell spellRE spellLen pron pronRE pronLen};

package Aligner;
use fields qw{spell pron spellLen pronLen spellCons phonCons
   knownCorrespondences stressorsRE};
# stressorsRE is a regular expression that matches any stress mark at the
#   current position \G
# knownCorrespondences maps a byte (viz., initial letter of a spelling)
#   to a list of KnownCorrespondence objects whose spelling begins with that
#   byte. That is, given the letter at the current position, it returns all 
#   sound-spelling correspondences that could apply at this point.
# spellCons - for a given alignment between a word spelling and pronunciation,
#   tells how many letters are grouped together with the letter than begins
#   an alignment group at this position. E.g., in TREAT=/t r i t /, there would
#   be entries [0]=>1, [1]=>1, [2]=>2, and [4]=>1, meaning that spelling 
#   positions 0, 1, and 4 begin single-letter spellings (T, R, T), but that
#   at position 2 a 2-letter spelling begins (EA). Note that the value at
#   cell 3 has undetermined content, because the preceding entry has already
#   told us that no spelling begins there.
# phonCons - like spellCons, except this tells how many bytes in the 
#   pronunciation are
#   spelled by the letter group that begins at this position *in the spelling*.
#   E.g., in FOX=/f ɑ k s /, there would
#   be entries [0]=>2, [1]=>3, [2]=>4; note the counts include the following
#   space (F=/f /) and that IPA characters may have more than one byte per
#   character (O=/ɑ /, 2 characters but 3 bytes).
# spell - the spelling string currently being processed by Spell_and_Pron
# pron - the pronunciation string currently being processed by Spell_and_Pron
# spellLen - number of bytes in current spelling string
# pronLen - number of bytes in current pronunciation string

our $correspondencesFileName = q{correspondences};

sub new {
  my $type = shift(@_);
  my Aligner $aligner = fields::new($type);
  eval { $aligner->initPatterns($correspondencesFileName); };
  if ($@) {
    die(qq{$@\nTherefore could not create Align object.
    (In Aligner->new)});
  }
  $aligner->{spellCons} = [];
  $aligner->{phonCons} = [];
  return $aligner;
}

# Parse one line of a correspondence file, returning a KnownCorrespondence
# object. We already know the line is not blank, nor contains a <STRESS>.
sub translateCorrespondence($) {
  my $s = shift(@_);
  my($spell, $pron) = split(m{\t}, $s);
  my KnownCorrespondence $kc = fields::new(q{KnownCorrespondence});
  my $spellAfters;
  if ($pron =~ q{^<PUNCT> $}) {$pron = q{};}

  #Contexts:
  if ($spell =~ m{^(.+?)\((.+)$}) {
    $spell = $1;
    $spellAfters = $2;
    $spellAfters =~ s{#}{\$};
  }
  my $spellBefores;
  if ($spell =~ m{^(.+?)\)(.+)$}) {
    $spell = $2;
    $spellBefores = $1;
    $spellBefores =~ s{#}{\^};
  }

  $kc->{spell} = $spell;
  my $pattern = $spell;
  if (defined($spellBefores)) {$pattern = qq{(?<=$spellBefores)$pattern};}
  if (defined($spellAfters)) {$pattern .= qq{(?:$spellAfters)};}
  $kc->{spellRE} = qr{$pattern};
  #print STDERR qq{$s: $kc->{spellRE}\n};
  $kc->{spellLen} = length($spell);
  $kc->{pron} = $pron;
  $kc->{pronLen} = length($pron);
  $pron = quotemeta($pron);
  $kc->{pronRE} = qr{$pron};
  return $kc;
}

# Process "correspondences" file (or whichever file whose name gets passed in)
# once, at initialization time, filling in the {known_correspondences} and
# {stressors_re} fields of the Align object.
sub initPatterns($$) {
  my Aligner $aligner = shift(@_);
  my $fileName = shift(@_);
  $fileName = $correspondencesFileName unless defined($fileName);
  my $stressors = []; #list of all spellings declared <STRESS>
  $aligner->{knownCorrespondences} = {};
  open(my $file, q{<}, $fileName) 
    or die(qq{Correspondences file '$fileName' could not be found.
   (In Align.pm Init_Patterns)});
  while (defined(my $string = <$file>)) {
    chomp($string);
    $string .= q{ }; #Implied phoneme terminator at end of each line
    next unless $string =~ m{\S}; #Ignore blank lines
    if ($string =~ m{^<STRESS>\t(.+)$}) {
      push(@$stressors, $1);
    } else {
      my KnownCorrespondence $kc = translateCorrespondence($string);
      my $letter = substr($kc->{spell}, 0, 1); #index by 1st letter
      push(@{$aligner->{knownCorrespondences}->{$letter}}, $kc);
    }
  }
  close($file);
  #Turn array of <STRESS> spellings into regexp matching any <STRESS>:
  if (@$stressors) {
    my $stressorsString = join(q{|}, @$stressors);
    $aligner->{stressorsRE} = qr{\G($stressorsString)};
    # print(STDERR qq{aligner->{stressorsRE} = $aligner->{stressorsRE}});
  }
}

sub align {
  my Aligner $align = shift(@_);
  $align->{spell} = shift(@_);
  $align->{pron} = shift(@_);
  $align->{pron} =~ s{R$}{};
  $align->{pron} =~ s{(\S)}{$1 }g;
  $align->{spellLen} = length($align->{spell});
  $align->{pronLen} = length($align->{pron});
  
  #This recursive alignment procedure does all the real work, filling in a 
  # parse chart (spell_cons and phon_cons fields):
  if (!$align->alignRec(0, 0, 0)) { #start at the very beginning
    die(qq{Alignment failed between $align->{spell} and /$align->{pron}/
    (In Aligner::align)});
  }

  #Now linearize the chart into a list we can return to caller.
  # spell_cons tells how many bytes (letters) in each local alignment,
  # and phon_cons tells how many bytes are in the corresponding pronunciation;
  # NB It is indexed same as the corresponding spelling.
  # So we just read each local alignment off left to right.
  my Alignment $alignment = Alignment->new($align->{spell}, $align->{pron});
  for (my $s = 0, my $p = 0; $s < $align->{spellLen}; ) {
    my $numSCons = $align->{spellCons}->[$s];
    my $numPCons = $align->{phonCons}->[$s];
    $alignment->addAtom(
      substr($align->{spell}, $s, $numSCons),
      substr($align->{pron},  $p, $numPCons));
    $s += $numSCons;
    $p += $numPCons;
  }
  return $alignment;
}


#This is the workhorse, called recursively to align spelling and pronunciation.
# $spellPos tells where we are in the spelling. We try all possible 
# spelling-sound correspondences that start with that letter until one
# succeeds (matches both the spelling and the pronunciation at the 
# current location) AND the rest of the string also gives a valid alignment.
# Each time there's a match, we write into the parse chart for the current
# location in the spelling the number of bytes of spelling (spellCons) and
# pronunciation (phonCons) that are accounted for by this alignment.
#NB that this depth-first strategy means that only one alignment is
# obtained, and that the preferred alignment of multiple alignments can to
# some degree be controlled by ordering the correspondences in the source
# file.
sub alignRec {
  my Aligner $align = shift(@_);
  my $spellPos = shift(@_);  #where we are in the spelling
  my $pronPos = shift(@_);   #where we are in the pronunciation
  my $unspelt = shift(@_);   #the number of bytes of <STRESS> 
       #pronunciation marks we have
       #     encountered but not yet matched with anything (because they
       #     associate with the phoneme to the right).
  
  #Tail end condition: if the recursive parse takes us past the end of the
  # spelling, this tail of the recursion is successful if we have also run
  # out of pronunciation, but a failure if there is pronunciation still
  # unaligned with anything:
  if ($spellPos >= $align->{spellLen}) {
    if ($pronPos >= $align->{pronLen}) {
      return 1;  #success
    } else {
      return undef;  #failure
    }
  }
  #Similarly, the tail fails if we run out of pronunciation but do have
  # letters still unaccounted for at the end:
  if ($pronPos >= $align->{pronLen}) {return undef;}

  #See if the pronunciation has a <STRESS> symbol at the current position.
  # If so, record match; don't expect there to be anything in the 
  # spelling.
  pos($align->{pron}) = $pronPos;
  if (defined($align->{stressorsRE}) 
      and $align->{pron} =~ $align->{stressorsRE}) {
    #print STDERR qq{Stressor!\n};
    my $unlen = length($1);
    $unspelt += $unlen;
    return $align->alignRec($spellPos, $pronPos + $unlen, $unspelt);
  }

  #Get from our index the correspondences
  # that begin with the byte (letter) at the current position in the
  #  spelling.
  my $letter = substr($align->{spell}, $spellPos, 1);
  #Try each of them in the same order they appeared in the correspondences
  # file:
  my $knownCorrespondences = $align->{knownCorrespondences}->{$letter};
  if (defined($knownCorrespondences)) {
    foreach my KnownCorrespondence $corr (@$knownCorrespondences) {
      pos($align->{spell}) = $spellPos;
      pos($align->{pron}) = $pronPos;
      if ($align->{spell} =~ m{\G$corr->{spellRE}} and 
          $align->{pron} =~ m{\G$corr->{pronRE}}) {
        #Local success: the full spelling regexp and the pronunciation regexp
        # have both succeeded. So we enter the data in the chart. 
        $align->{spellCons}->[$spellPos] = $corr->{spellLen};
        $align->{phonCons}->[$spellPos] = $unspelt + $corr->{pronLen};
        #Now we try to align the rest of the spelling and pronunciation.
        # If that works, we've succeeded:
        return 1 if
          $align->alignRec(
            $spellPos + $corr->{spellLen}, $pronPos + $corr->{pronLen}, 0);
        #Else we pop back here (backtrack) and try the next correspondence
        # rule for the current letter.
      }
    }
  }
  #If none of the correspondence rules succeed with a tail match, then
  # this call fails; we pop up for another level of backtracking, if any:
  undef;
}

package Lemma;
use fields qw{id spelling cobFreq morphStatus lang nParses
  NVAffComp
  Der 
  Comp
  DerComp
  Def
  Imm
  ImmSubCat
  ImmSA
  ImmAllo
  ImmSubst
  ImmOpac
  TransDer
  ImmInfix
  ImmRevers
  FlatSA
  StrucLab 
  StrucAllo
  StrucSubst
  StrucOpac
  pronunciation
  wordforms};

sub loadParse {
  my $lemma = shift(@_);
  my $fields = shift(@_);
  $lemma->{NVAffComp} = shift(@$fields);
  $lemma->{Der} = shift(@$fields);
  $lemma->{Comp} = shift(@$fields);
  $lemma->{DerComp} = shift(@$fields);
  $lemma->{Def} = shift(@$fields);
  $lemma->{Imm} = shift(@$fields);
  $lemma->{ImmSubCat} = shift(@$fields);
  $lemma->{ImmSA} = shift(@$fields);
  $lemma->{ImmAllo} = shift(@$fields);
  $lemma->{ImmSubst} = shift(@$fields);
  $lemma->{ImmOpac} = shift(@$fields);
  $lemma->{TransDer} = shift(@$fields);
  $lemma->{ImmInfix} = shift(@$fields);
  $lemma->{ImmRevers} = shift(@$fields);
  $lemma->{FlatSA} = shift(@$fields);
  $lemma->{StrucLab} = shift(@$fields);
  $lemma->{StrucAllo} = shift(@$fields);
  $lemma->{StrucSubst} = shift(@$fields);
  $lemma->{StrucOpac} = shift(@$fields);
  
}

sub new {
  my $type = shift(@_);
  my $lemma = fields::new($type);
  my $line = shift(@_);
  $line =~ s{\s+$}{};
  my $fields = [split(m{\\}, $line)];
  $lemma->{id} = shift(@$fields);
  $lemma->{spelling} = shift(@$fields);
  $lemma->{cobFreq} = shift(@$fields);
  $lemma->{morphStatus} = shift(@$fields);
  $lemma->{lang} = shift(@$fields);
  $lemma->{nParses} = shift(@$fields);
  if ($lemma->{nParses} > 0) {
    $lemma->loadParse($fields);
  }
  return $lemma;
}

sub id {
  my Lemma $lemma = shift(@_);
  return $lemma->{id} + 0;
}

sub addWordform {
  my Lemma $lemma = shift(@_);
  my $wf = shift(@_);
  push(@{$lemma->{wordforms}}, $wf);
}

sub addPronunciation {
  my Lemma $lemma = shift(@_);
  my $fields = shift(@_);
  my $p = $fields->[4];
  die() if !defined($p) or $p eq q{};
  $lemma->{pronunciation} = $p;
}

sub spelling {
  my Lemma $lemma = shift(@_);
  return $lemma->{spelling};
}

our $morphStatusCodes = {
  q{M} => q{monomorphemic},
  q{C} => q{complex},
  q{Z} => q{zero derived},
  q{F} => q{contraction},
  q{I} => q{morph NA},
  q{O} => q{morph obscure},
  q{R} => q{based on root},
  q{U} => q{morph undetermined}
};

our $immSubCatCodes = {
  q{N} => q{NOUN},
  q{A} => q{ADJ},
  q{Q} => q{NUM},
  q{D} => q{ART},
  q{O} => q{PRO},
  q{B} => q{ADV},
  q{P} => q{PREP},
  q{C} => q{CONJ},
  q{I} => q{INTERJ},
  q{S} => q{CONTRACTION},
  q{T} => q{COMPLEX CONTRACTION},
  q{x} => q{AFFIX},
  q{1} => q{VI},
  q{2} => q{VT},
  q{3} => q{VI/VT},
  q{0} => q{VERB},
  q{?} => q{?},
};

sub immSubCat($) {
  my $codes = shift(@_);
  my @arr = split(m{}, $codes);
  my @out = ();
  foreach my $code (@arr) {
    my $text = $immSubCatCodes->{$code};
    if (!defined($text)) {die($code);}
    push(@out, $text);
  }
  return join(q{+}, @out);
}

our $immAlloCodes = {
  q{B} => q{blend},
  q{C} => q{clipping},
  q{D} => q{derivational allomorphy},
  q{F} => q{flectional allomorphy},
  q{Z} => q{conversion},
  q{?} => q{allomorphy?},
};

sub immAllo($) {
  my $codes = shift(@_);
  if ($codes eq q{N}) {return undef;}
  my @arr = split(m{}, $codes);
  my @out = ();
  foreach my $code (@arr) {
    my $text = $immAlloCodes->{$code};
    die($code) unless defined($text);
    push(@out, $text);
  }
  return join(q{+}, @out);
}

our $alreadyProcessed = {};
our Aligner $aligner = Aligner->new();

our $stressRE = qr{['"-]};
our $vowelRE = qr{[EI16\@\{]};
our $consRE = qr{[bdnrt_]};
our $syllabicConsRE = qr{[P]};
our $phonemeRE = qr{$stressRE|$vowelRE|$consRE|$syllabicConsRE};

sub process {
  my Lemma $lemma = shift(@_);
  my $judgements = shift(@_);
  my $spelling = $lemma->{spelling};
  my $pronunciation = $lemma->{pronunciation};
  my $key = qq{$spelling/$pronunciation};
  return if exists($alreadyProcessed->{$key});
  return unless $spelling =~ m{^[a-z]+$};
  return if length($spelling) < 2 and $spelling !~ m{^[aIO]$};
  #return unless $spelling =~ m{^[A-Za-z]+$};
  #return if $spelling =~ m{.[A-Z]};
  return if $pronunciation =~ m{~};  #foreign phonemes
  my $judge = $judgements->{lc($spelling)};
  if (defined($judge)) {
    if ($judge eq q{rejected}) {
      #print(qq{$spelling rejected\n});
      return;
    }
  } else {
    return if $lemma->{cobFreq} <= 0;
  }
  my $lang = $lemma->{lang};
  return if $lang ne q{} and $lang ne q{B};
  return unless $lemma->{morphStatus} =~ 
     #m{[MORU]};
    m{[M]};  #just the monomorphemics
  $alreadyProcessed->{$key} = 1;
  my Alignment $alignment = $aligner->align($spelling, $pronunciation);
  $alignment->dump();
}

sub dump {
  my Lemma $lemma = shift(@_);
  my $spelling = $lemma->{spelling};
  my $lang = $lemma->{lang};
  print(qq{$lemma->{spelling} /$lemma->{pronunciation}/, freq=$lemma->{cobFreq}});
  print(q{, }, $morphStatusCodes->{$lemma->{morphStatus}});
  #print(qq{, lang=$lemma->{lang}}) if $lemma->{lang} ne q{};
  if ($lemma->{nParses} > 0) {
    if ($lemma->{NVAffComp} eq q{Y}) {print(q{, NVAffComp});}
    if ($lemma->{Der} eq q{Y}) {print(q{, Der});}
    if ($lemma->{Comp} eq q{Y}) {print(q{, Comp});}
    if ($lemma->{DerComp} eq q{Y}) {print(q{, DerComp});}
    print(qq{; IMMED: $lemma->{Imm}});
    my $immSubCatText =  immSubCat($lemma->{ImmSubCat});
    print(qq{, $immSubCatText});
    print(qq{, $lemma->{ImmSA}});  #useful?
    my $immAllo = immAllo($lemma->{ImmAllo});
    print(qq{, $immAllo}) if defined($immAllo);
    print(qq{, AFFIX SUB}) if ($lemma->{ImmSubst} eq q{Y});
    print(qq{, OPAQUE}) if ($lemma->{ImmOpac} eq q{Y});
    print(qq{, TransDer=$lemma->{TransDer}}) if ($lemma->{TransDer} ne q{} and $lemma->{TransDer} ne q{#});
    print(qq{, INFIX}) if ($lemma->{ImmInfix} eq q{Y});  #none
    print(qq{, REVERSAL}) if ($lemma->{ImmRevers} eq q{Y});
    print(qq{; FULL: $lemma->{StrucLab}});
    print(qq{, $lemma->{FlatSA}});
    my $strucAllo = immAllo($lemma->{StrucAllo});
    print(qq{, $strucAllo})  if defined($strucAllo);
    print(qq{, AFFIX SUB}) if $lemma->{StrucSubst} eq q{Y};
    print(qq{, OPAQUE}) if $lemma->{StrucOpac} eq q{Y};
  }
  print(qq{\n});
}

package Wordform;
use fields qw{id spelling cobFreq lemmaID flectType transInfl
  PronCnt PronStatus PhonStrsDISC};

sub new {
  my $type = shift(@_);
  my $wf = fields::new($type);
  my $line = shift(@_);
  $line =~ s{\s+$}{};
  my $fields = [split(m{\\}, $line)];
  $wf->{id} = shift(@$fields);
  $wf->{spelling} = shift(@$fields);
  $wf->{cobFreq} = shift(@$fields);
  $wf->{lemmaID} = shift(@$fields);
  $wf->{flectType} = shift(@$fields);
  $wf->{transInfl} = shift(@$fields);
  return $wf;
}

sub id {
  my Wordform $wf = shift(@_);
  return $wf->{id};
}

sub lemmaID {
  my Wordform $wf = shift(@_);
  return $wf->{lemmaID};
}

sub addPronunciation {
  my Wordform $wf = shift(@_);
  my $fields = shift(@_);
  for (my $i = 0; $i < 4; $i++) {shift(@$fields);}
  $wf->{PronCnt} = shift(@$fields);
  if ($wf->{PronCnt} < 1) {die($wf->{PronCnt});}
  $wf->{PronStatus} = shift(@$fields);
  $wf->{PhonStrsDISC} = shift(@$fields);
}

package main;

our $lemmas = [];
our $wordforms = [];
our $judgements = {};

sub processLine_eml($) {
  my $line = shift(@_);
  my Lemma $lemma = Lemma->new($line);
  $lemmas->[$lemma->id()] = $lemma;
}

sub processLine_epl($) {
  my $line = shift(@_);
  $line =~ s{\s+$}{};
  my $fields = [split(m{\\}, $line)];
  my Lemma $lemma = $lemmas->[shift(@$fields)];
  $lemma->addPronunciation($fields);
}

sub processLine_emw($) {
  my $line = shift(@_);
  my Wordform $wf = Wordform->new($line);
  my $lemmaID = $wf->lemmaID();
  my Lemma $lemma = $lemmas->[$lemmaID];
  if (!defined($lemma)) {
    die(qq{No lemma #$lemmaID});
  }
  $lemma->addWordform($wf);
  my $wfID = $wf->id();
  $wordforms->[$wfID] = $wf;
}

sub processLine_epw($) {
  my $line = shift(@_);
  $line =~ s{\s+$}{};
  my $fields = [split(m{\\}, $line)];
  my Wordform $wf = $wordforms->[$fields->[0]];
  $wf->addPronunciation($fields);
}

sub processLines($$) {
  my($file, $sub) = @_;
  open(my $in, q{<}, qq{/home/bkessler/RAT/data/Celex/CD2/english/e$file/e$file.cd}) or die(qq{Error opening file `$file':\n$!});
  while (defined(my $line = <$in>)) {
    $sub->($line);
  }
  close($in);
}

sub read_eml() {
  processLines(
    q{ml}, 
    \&processLine_eml);
}

sub read_epl() {
  processLines(
    q{pl}, 
    \&processLine_epl);
}

sub read_emw() {
  processLines(
    q{mw}, 
    \&processLine_emw);
}

sub read_epw() {
  processLines(
    q{pw}, 
    \&processLine_epw);
}

sub readCelex() {
  read_eml();
  read_epl();
  #read_emw();
  #read_epw();
}

sub sortLemmas() {
  my $array = [];
  my $nLemmas = scalar(@$lemmas);
  for (my $id = 0; $id < $nLemmas; $id++) {
    my Lemma $lemma = $lemmas->[$id];
    next unless defined($lemma);
    my $spell = $lemma->spelling();
    push(@$array, [$id, uc($spell), $spell]);
  }
  return [sort alphabetically @$array];
}

sub alphabetically {
  ($a->[1] cmp $b->[1]) || ($b->[2] cmp $a->[2]);
}

sub dumpData() {
  my $sorted = sortLemmas();
  foreach my $key (@$sorted) {
    my Lemma $lemma = $lemmas->[$key->[0]];
    $lemma->dump();
  }
}

sub processData($) {
  my $judgements = shift(@_);
  my $nLemmas = scalar(@$lemmas);
  for (my $id = 0; $id < $nLemmas; $id++) {
    my Lemma $lemma = $lemmas->[$id];
    next unless defined($lemma);
    $lemma->process($judgements);
  }
}

sub readMarie() {
  open(my $in, q{<}, q{data/nonZenos.txt}) or die($!);
  my $header = readline($in);
  while (defined(my $line = <$in>)) {
    chomp($line);
    if ($line =~ m{^\s*(\d+)\s+(.+)$}) {
      my $freq = $1;
      my $spell = lc($2);
      if ($spell =~ m{^(\S+)\s+x}) {
        $spell = $1;
        $judgements->{$spell} = q{rejected};
      } elsif ($freq <= 20) {
        $judgements->{$spell} = q{approved};
      }
    } else {die($line);}
  }
  close($in);
}

sub main() {
  readMarie();
  readCelex();
  #dumpData();
  processData($judgements);
}

main();
