#!/usr/bin/env perl
  
  # Reads a dictionary, and prints out a list of words that seem to be pronounced
  # as acronyms (not including plurals of acronyms, just acronyms).  Uses
  # the prons of the individual letters (A., B. and so on) to judge this.
  # Note: this is somewhat dependent on the convention used in CMUduct, that
  # the individual letters are spelled this way (e.g. "A.").
  
  $max_length = 6; # Max length of words that might be
   # acronyms.
  
  while(<>) { # Read the dict.
    chop;
    @A = split(" ", $_);
    $word = shift @A;
    $pron = join(" ", @A);
    if ($word =~ m/^([A-Z])\.$/ ) {
      chop $word; # Remove trailing "." to get just the letter
      $letter = $1;
      if (!defined $letter_prons{$letter} ) { 
        $letter_prons{$letter} = [ ]; # new anonymous array
      }
      $arrayref = $letter_prons{$letter};
      push @$arrayref, $pron;
    } elsif( length($word) <= $max_length ) {
      $pronof{$word . "," . $pron} = 1;
      $isword{$word} = 1;
      #if (!defined $prons{$word} ) {
      #  $prons{$word} = [ ];
      #}
      #  push @{$prons{$word}}, $pron;
    }
  }
  
  sub get_letter_prons;
  
  foreach $word (keys %isword) {
    my @letter_prons = get_letter_prons($word);
    foreach $pron (@letter_prons) {
      if (defined $pronof{$word.",".$pron}) {
        print "$word  $pron
  ";
      }
    }
  }
  
  
  sub get_letter_prons {
    @acronym = split("", shift); # The letters in the word.
    my @prons = ( "" );
    
    while (@acronym > 0) {
      $l = shift @acronym;
      $n = 1; # num-repeats of letter $l.
      while (@acronym > 0 && $acronym[0] eq $l) {
        $n++;
        shift @acronym;
      }
      my $arrayref = $letter_prons{$l};
      my @prons_of_block = ();
      if ($n == 1) { # Just one repeat.
        foreach $lpron ( @$arrayref ) {
          push @prons_of_block, $lpron; # typically (always?) just one pron of a letter.
        }
      } elsif ($n == 2) { # Two repeats.  Can be "double a" or "a a"
        foreach $lpron ( @$arrayref ) {
          push @prons_of_block, "D AH1 B AH0 L " . $lpron;
          push @prons_of_block, $lpron . $lpron;
        }
      } elsif ($n == 3) { # can be "triple a" or "a a a"
        foreach $lpron ( @$arrayref ) {
          push @prons_of_block, "T R IH1 P AH0 L " . $lpron;
          push @prons_of_block, $lpron . $lpron . $lpron;
        }
      } elsif ($n >= 4) { # let's say it can only be that letter repeated $n times..
        # not sure really.
        foreach $lpron ( @$arrayref ) {
          $nlpron = "";
          for ($m = 0; $m < $n; $m++) { $nlpron = $nlpron . $lpron; }
          push @prons_of_block, $nlpron;
        }
      }
      my @new_prons = ();
      foreach $pron (@prons) {
        foreach $pron_of_block(@prons_of_block) {
          if ($pron eq "") {
            push @new_prons, $pron_of_block;
          } else {
            push @new_prons, $pron . " " . $pron_of_block;
          }
        }
      }
      @prons = @new_prons;
    }
    return @prons;
  }