# 
# Hi, everyone.  This is my first posted solution to one of these
# wonderful quizzes.  I welcome any comments.
# 
# Stephen Hamilton
# San Diego, CA
# 
# 
# 
#!/usr/bin/perl

##############################################################################
# pqotw8.pl
#
# Write a Perl program which, given a dictionary, generates two output
# files, 'questions' and 'answers'.  'questions' should contain every
# sequence of four letters that appears in exactly one word of the
# dictionary, one sequence per line.  'answers' should contain the
# corresponding words that contain the sequences, in the same order,
# again one per line.  The input dictionary will contain one word per
# line.
# 
# Assumptions:  
#   Ignores non-alpha characters that may appear in a word, such as 
#   apostrophe ('), period (.), etc.
# 
#   Two words that are spelled exactly the same but are different in case 
#   (e.g., "Rose" and "rose") are the same word
##############################################################################

use locale; # Allow to work on foreign words
# use Benchmark qw(:all);

##############################################################################
# VARIABLES
##############################################################################

use constant DEBUG               => 0;          # In test mode?

my $question_output_file         = "questions"; # seq's in exactly one word
my $answers_output_file          = "answers";   # corresponding words
my $dictionary_file              = "words";     # list of words
my $number_of_sequential_letters = 4;           # use substrings this long

my %answer;                                     # key = substr, val = word
my %duplicate;                                  # substrs in multiple words

my $start_benchmark;                            # Time program starts

##############################################################################
# MAIN
##############################################################################

$start_benchmark = new Benchmark;

open_files();
find_answers();       # Read through words to find questions and
answers
write_output_files(); # Write question and answer files
close_files();

print "Total time:  ", 
      timestr(timediff(new Benchmark, $start_benchmark)), "\n\n"
  if DEBUG;

exit();

##############################################################################
# SUBROUTINES
##############################################################################

#-----------------------------------------------------------------------------
# open_files
#
# Open any files necessary for the program
#-----------------------------------------------------------------------------
sub open_files {
  open(WORDS, $dictionary_file) or die "Can't open $dictionary_file: $!";

  open(QUESTIONS, ">$question_output_file") 
    or die "Can't open $question_output_file:  $!";

  open(ANSWERS, ">$answers_output_file") 
    or die "Can't open $answers_output_file:  $!";
}

#-----------------------------------------------------------------------------
# find_answers
#
# Read through list of words to find questions and answers
#-----------------------------------------------------------------------------
sub find_answers {
  while (<WORDS>) {
    chomp;
    my $original_word = lc($_);            # Word to store as answer
    my $word          = $original_word;    # Word to chop into substrs to test
    $word             =~ s/\W//g;          # Remove all non-characters

    ### Skip words with fewer characters
    while (length($word) >= $number_of_sequential_letters) {
      ### Get first $number_of_sequential_letters characters
      my $substr = substr($word, 0, $number_of_sequential_letters);

      ### Has this string been found yet?
      if (!$answer{$substr}) {
        $answer{$substr} = $original_word; # Store word for answer
      }
      elsif ($answer{$substr} eq $word) {
        ### Do nothing - this word is in the word list more than once
      }
      else {
        $duplicate{$substr}++;             # Duplicate word
      }

      $word = substr($word, 1);            # Remove first letter from word
    }
  }
}

#-----------------------------------------------------------------------------
# write_output_files
#
# For each substring found with only one occurence, write substring to 
# questions file and original word to answers file
#-----------------------------------------------------------------------------
sub write_output_files {
  foreach my $substr (sort {$a cmp $b} keys %answer) {
    next if $duplicate{$substr};           # Ignore duplicates

    print QUESTIONS "$substr\n";
    print ANSWERS   "$answer{$substr}\n";
  }
}

#-----------------------------------------------------------------------------
# close_files
#-----------------------------------------------------------------------------
sub close_files {
  close(WORDS);
  close(QUESTIONS);
  close(ANSWERS);
}

__END__


__________________________________________________
Do you Yahoo!?
Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
http://mailplus.yahoo.com
