Re: [QUIZ] Perl 'Easy' Quiz of the Week #2005-1

Roger Burton West <roger-UvLOT2mcgw/[email protected]> Mon, 24 Jan 2005 15:37:31 +0000
Newsgroups gmane.comp.lang.perl.qotw.discuss
Message-ID <[email protected]>
On Fri, Jan 21, 2005 at 10:36:52PM -0500, Daniel Martin wrote:

>Your program should take 2 arguments, an input filename and an output
>filename.  It would be convenient if your program also worked with
>fewer arguments, but I'm not going to make that part of the quiz.  (If
>you do decide to go the extra mile and also accept fewer arguments,
>with only one argument your program should use STDOUT as the output
>file, and with no arguments your program should behave as a filter -
>STDIN for input, STDOUT for output.)

This was a relatively easy thing to do, so I did it.

>As an added challenge, the file may be entirely too big to fit into
>available memory.  Your program should still behave properly.  It is
>in fact possible to write a solution whose memory requirements are
>determined by the maximum length of an individual line, not the number
>of lines in the file.

This of course makes the trivial solution ("shove everything into a
hash" - often a good principle when writing Perl) unacceptable.
However, a state machine seems to get the job done without too much
difficulty, and stores only the two most recent stems. It passes all
the test cases given.

#! /usr/bin/perl -w

use strict;

my $setsuffix='M';

my $in=shift @ARGV || '-';
my $out=shift @ARGV || '-';

open IN,"<$in" || die "no input";
open OUT,">$out" || die "no output";

# states:
# 0: not yet sent a suffix for the current stem
# 1: sent a suffix          "   "     "      "

my $state=1;
my $oldstem='!';
while (my $line=<IN>) {
  chomp $line;
  $line =~ /^(\w+)\.([A-Z])$/ || die "invalid input '$line'\n";
  my ($stem,$suffix)=($1,$2);
  if ($stem ne $oldstem) {
    if ($state==0) {
      print OUT "$oldstem.$setsuffix\n";
    }
    $state=0;
    $oldstem=$stem;
  }
  if ($state==0) {
    if ($setsuffix eq $suffix) {
      $state=1;
    } elsif ($setsuffix lt $suffix) {
      print OUT "$stem.$setsuffix\n";
      $state=1;
    }
  }
  print OUT "$line\n";
}
if ($state==0) {
  print OUT "$oldstem.$setsuffix\n";
}

close OUT;
close IN;