src/add-affixes

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 #use warnings;
   5 #no warnings 'uninitialized';
   6
   7 # Usage: add-affixes [<inc_level>] [<flags>]
   8
   9 my $inc_level = 0;
  10 if ($ARGV[0] =~ /^[\d.]+$/) {
  11   $inc_level = $ARGV[0];
  12   shift @ARGV;
  13 }
  14
  15 #print STDERR "Include Level: $inc_level\n";
  16
  17 my $use_all = 0;
  18 my $just_possessive = 0;
  19 my $no_possessive = 0;
  20 foreach (@ARGV) {
  21   if ($_ eq 'use-all') {$use_all = 2}
  22   elsif ($_ eq 'use-some') {$use_all = 1}
  23   elsif ($_ eq 'just-possessive') {$just_possessive = 1}
  24   elsif ($_ eq 'no-possessive') {$no_possessive = 1}
  25   else {die "ERROR: Invalid flag $_\n";}
  26 }
  27
  28 open F, "r/alt12dicts/2of12id.txt" or die;
  29
  30 my %lookup;
  31 my %remove;
  32 my %possessive;
  33 # possessive_cross = additional forms that should be looked up in the
  34 #   possessive hash
  35 my %possessive_cross;
  36
  37 while (<F>) {
  38   s/\r?\n$// or die;
  39   # (flags, base word, part of speach, infl forms)
  40   my ($d,$w,$p,$a) = /^([-@\+]?)(\w+) (.).*: ?(.*)$/ or die "Bad line: >$_<";
  41   $d =~ tr/+//d;
  42   $possessive{$w} = "$w\'s\n" if $p eq 'N' && ($d eq '' || $use_all);
  43   next if $use_all;
  44   my @a = $a =~ /([-~@!\w]+)/g;
  45   @a = map {"$d$_"} @a if ($d);
  46   my (@a0,@a1);
  47   foreach (@a) {if (s/^[~!-]//) {push @a0, $_} else {push @a1, $_}}
  48   $remove{"$w:$p"} = 1 unless @a1;
  49   foreach (@a0) {$remove{"$w:$p:$_"} = 1}
  50 }
  51
  52 # Maybe using AGID isn't a good idea here, many of the entries in AGID
  53 # are unchecked, for example "associationism" may be an uncountable
  54 # noun, but since the base entry is not in 2of12id it is not flagged
  55 # that way, thus the plural "associationisms" gets included.  However,
  56 # AGID still needs to be used for uppercase words since they are not
  57 # in 2of12id.  For now I won't worry about it since it primary effects
  58 # level 70 of SCOWL.
  59
  60 open F, "r/infl/infl.txt" or die;
  61
  62 while (<F>) {
  63   # (base word, part of speach, guess flag, infl forms)
  64   my ($w,$p,$q,$a) = /(\S+) (.)(.*): (.+)/ or die;
  65   # Add possive form if
  66   #  AGID things it is a noun and "use-some" or Uppercase
  67   #    (since 2of12id doesn't include uppercase)
  68   #  AGIG is guessing it is a noun and "use-all"
  69   my $add_possessive = $p eq 'N' && (($q eq '' && ($use_all || $w =~ /^[A-Z]/))
  70                                      || $use_all >= 2);
  71   $possessive{$w} = "$w\'s\n" if $add_possessive;
  72   next if $remove{"$w:$p"};
  73   next unless $q eq '' || $use_all >= 2;
  74   my @a = split /, | \| /, $a;
  75   @a = grep {my ($word,$tags,$level)
  76                  = /^([A-Za-z\']+)([~<!?]*)(| [\d.]+)(| {\S+})$/ or die $_;
  77              $_ = $word;
  78              $tags !~ /~|\?|!</ && $level <= $inc_level} @a;
  79   @a = grep {not $remove{"$w:$p:$_"}} @a;
  80   next unless @a;
  81   $lookup{$w} .= join("\n",@a)."\n";
  82
  83   # For irregular nouns that have plurals that do not end in s
  84   # then add the possessive form of the plural as well
  85   next unless $add_possessive;
  86   foreach (@a) {
  87     next if /s$/;
  88     $possessive{$_} .= "$_\'s\n";
  89     push @{$possessive_cross{$w}}, $_
  90   }
  91 }
  92
  93 unless ($no_possessive) {
  94
  95   open F, "r/special/not-possessive" or die;
  96
  97   while (<F>) {
  98     chop;
  99     delete $possessive{$_};
 100   }
 101
 102   open F, "working/possessive-also.lst" or die;
 103
 104   while (<F>) {
 105     chop;
 106     $possessive{$_} = "$_\'s\n";
 107   }
 108 }
 109
 110 while (<STDIN>) {
 111   print;
 112   chop;
 113   my $w = $_;
 114   print $lookup{$w} unless $just_possessive;
 115   print $possessive{$w} unless $no_possessive;
 116   unless ($just_possessive || $no_possessive) {
 117     foreach (@{$possessive_cross{$w}}) {
 118       print $possessive{$_}
 119     }
 120   }
 121 }