Imported Upstream version 2015.08.24

[deb_pkgs/scowl.git] / src / proc-census

diff --git a/src/proc-census b/src/proc-census
new file mode 100755 (executable)
index 0000000..b642936
--- /dev/null
+++ b/src/proc-census
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+@namefiles = qw(21986na.mes 3897male.nam 4946fema.len);
+
+foreach $f (@namefiles) {
+    open IN, "l/proper-names/$f" or die;
+    while (<IN>) {
+       tr /\r\n//d;
+       my $proper = $_;
+       tr /\'//d;
+       tr /[a-z]/[A-Z]/;
+       next if !/^[A-Z]+$/;
+       $proper{$_} = $proper;
+    }
+}
+
+chdir "r/census";
+
+@files = qw(dist.all.last  dist.female.first  dist.male.first);
+
+foreach $f (@files) {
+    open IN, $f;
+    open OUT, ">$f.lst";
+    $i = 0;
+    while (<IN>) {
+        if ($i++ == 1000) {
+            open OUT, ">$f-rest.lst";
+        }
+       ($_) = /^(\S+)/;
+       if (exists $proper{$_}) {
+           print OUT "$proper{$_}\n";
+       } else {
+           (s/^MC(.)(.+)/Mc$1\L$2\E/ 
+            or s/(.)(.+)/$1\L$2\E/);
+           print OUT "$_\n";
+       }
+    }
+    close IN;
+    close OUT;
+    qx"sort $f.lst -o $f.lst";
+    qx"sort $f-rest.lst -o $f-rest.lst";
+}