makeconc.pl

   1 #! /usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         mkconc.pl
   5 # RCS:          $Header: /home/matthew/cvs/bible-kjv-4.10/makeconc.pl,v 2.0 2003/01/08 15:29:52 matthew Exp $
   6 # Description:  make Bible concordance: translation of Chip Chapin's ksh script
   7 # Author:       Chris Eich, SRSD
   8 # Created:      Wed Dec 23 11:00:18 1992
   9 # Modified:     Wed Dec 23 15:49:23 1992 (Chip Chapin) chip@hpclbis
  10 # Language:     perl
  11 # Status:       Experimental (Do Not Distribute)
  12 #
  13 ################################################################################
  14 #
  15 # Revisions:
  16 #
  17 # Wed Dec 23 15:19:45 1992 (Chip Chapin) chip@hpclbis
  18 #  Received from Chris Eich, replaces "makeconcordance" script.
  19 #  Made use of stopwords conditional.
  20 ###############################################################################
  21 use IO::Handle
  22
  23 # Putting . on PATH ensures that the bible program will be found.
  24 $ENV{'PATH'} =~ s/^:*/.:/;
  25
  26 $PROG = 'bible';
  27
  28 # Read a list of stop words, if any, one per line.
  29
  30 if (open(STOP, "$ARGV[0]")) {
  31     print "Excluding stopwords ($ARGV[0]) from concordance.\n";
  32     while (<STOP>) {
  33         # Ignore comments, mark stop word if one is found.
  34         $stopword{$&}++ if !/^#/ && /[a-z]+/;
  35     }
  36     close(STOP);
  37 } else {
  38     print "All words will be included in concordance (no stopwords).\n";
  39 }
  40
  41 # Generate plain text file, one "record" (e.g. bible verse) per line.
  42 # Fill %lines and $count tables, which are keyed by words.
  43
  44 open(BIBLE, "bible.rawtext");
  45 <BIBLE>; #discard the header line
  46 while (<BIBLE>) {
  47     s/^\S+\s+//;        # Cut off the record reference that starts each line.
  48     tr/A-Z/a-z/;        # Downcase.
  49     tr/a-z/ /c;         # Turn non-alpha into space.
  50     %seenonthisline = ();
  51     for $word (split(' ')) {
  52         next if $stopword{$word};
  53         $count{$word}++;        # Move below next line to count per-line.
  54         next if $seenonthisline{$word}++;
  55         #the header line discard still leaves $. 1 higher than we want
  56         $lines{$word} .= " " . ($. - 1);
  57     }
  58 }
  59 die $! if BIBLE->error();
  60
  61 # Create raw concordance, listing the lines where each word occurs.
  62
  63 open(RAWCONC, "> $PROG.rawconcordance") || die "$PROG.rawconcordance: $!\n";
  64 for $word (sort keys %lines) {
  65     print RAWCONC $word, $lines{$word}, "\n";
  66 }
  67 close(RAWCONC);
  68
  69 # Also create a wordcounts file, which gives the number of lines in
  70 # which each word occurs.  Note that we ARE counting cases where the
  71 # same word is used several times in the same record.  See the comment
  72 # above for "$count{$word}++" to change this to per-record.
  73
  74 open(COUNTS, "| sort -nrk 2 > $PROG.wordcounts");
  75 while (($word, $count) = each %count) {
  76     print COUNTS $word, "\t", $count, "\n";
  77 }
  78 close(COUNTS);
  79
  80 __END__
  81
  82 # Next ... create a binary form of the raw concordance.
  83 # This is handled by "makeconcfile", a program invoked from the
  84 # BRS makefile.
  85
  86 # so we're all done now.
  87
  88 # Interesting statistic: 89198 chars in all the words in the Bible,
  89 #                        617371 word-verse occurrances
  90 # from...
  91 #       awk '{chars += length($1); counts += $2}
  92 #               END {print "chars=" chars " counts=" counts}' bible.wordcounts
  93
  94 # end
  95
  96 ###############################################################################
  97 # Gnu Emacs variables...
  98 #
  99 #   Local Variables:
 100 #   mode:                               perl
 101 #   eval:                               (auto-fill-mode 0)
 102 #   default-header-comment-character:   ?#
 103 #   header-prefix:                      "#! /usr/bin/perl"
 104 #   header-suffix:                      "#"
 105 #   header-comment-character:           ?#
 106 #   end: