RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given a text file. Write a script to display all valid phone numbers in the given text file.

Solution

use Capture::Tiny q/capture_stdout/;
use PhoneNumberParser;

MAIN:{
    my $parser = new PhoneNumberParser();
    while(my $line = ){
        $line =~ s/^\s+|\s+$//g;
        my $syntax_error = capture_stdout {
            $parser->parse($line); 
        };
        print("$line\n") if !$syntax_error;
    }
}   

__DATA__
0044 1148820341
 +44 1148820341
  44-11-4882-0341
(44) 1148820341
 00 1148820341

The Parse::Yapp grammar.

%token SPACE DIGIT OPEN CLOSE PLUS
%%

phone_number: prefix SPACE area_exchange_subscriber
;

prefix: DIGIT DIGIT DIGIT DIGIT
    | OPEN DIGIT DIGIT CLOSE
    | PLUS DIGIT DIGIT
;   

area_exchange_subscriber: DIGIT DIGIT DIGIT DIGIT DIGIT DIGIT DIGIT DIGIT DIGIT DIGIT
;

%%

sub lexer{
    my($parser) = @_;
    $parser->YYData->{INPUT} or return('', undef);
    ##
    # send tokens to parser
    ##
    for($parser->YYData->{INPUT}){
        s/^(\s)// and return ("SPACE", $1);
        s/^(\d)// and return ("DIGIT", $1);
        s/^(\()// and return ("OPEN", $1);
        s/^(\))// and return ("CLOSE", $1);
        s/^(\+)// and return ("PLUS", $1);
    }  
}

sub error{
    exists $_[0]->YYData->{ERRMSG}
    and do{
        print $_[0]->YYData->{ERRMSG};
            return;
    };
    print "syntax error\n"; 
}

sub parse{
    my($self, $input) = @_;
    $self->YYData->{INPUT} = $input;
    my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
    return $result;  
}

Sample Run

$ yapp perl/PhoneNumberParser.yp
$ perl -Iperl perl/ch-1.pl
0044 1148820341
+44 1148820341
(44) 1148820341

Notes

While a set of regular expression would have done the job quite nicely I figured I’d use this problem as a reason to shake the rust off my grammar writing skills. Not that I am a master parser writer or anything, but Parse::Yapp makes it easy enough!

Well, easy is a bit relative I suppose. This is definitely not the simplest way of performing this task.

Part 2

You are given a text file. Write a script to transpose the contents of the given file.

Solution

sub transpose{
    my @columns = @_;
    return transpose_r([], \@columns);  
}

sub transpose_r{
    my($transposed, $remaining) = @_;
    return $transposed if(@{$remaining} == 0);   
    $transposed = transpose_row_r($transposed, $remaining->[0]);  
    shift @{$remaining}; 
    transpose_r($transposed, $remaining);  
}

sub transpose_row_r{
    my($transposed, $row) = @_;
    return $transposed if(@{$row} == 0); 
    my $index = @{$row} - 1;
    push @{$transposed->[$index]}, pop @{$row};  
    transpose_row_r($transposed, $row);    
}

MAIN:{
    my @columns;
    while(my $line = ){
        chomp($line);
        my @fields = split(/,/, $line);   
        push @columns, \@fields; 
    }
    my $transposed = transpose(@columns);   
    for my $i (0 .. @{$transposed} - 1){
        print join(",", @{$transposed->[$i]}) . "\n";       
    }    
}

__DATA__
name,age,sex
Mohammad,45,m
Joe,20,m
Julie,35,f
Cristina,10,f

Sample Run

$ perl perl/ch-2.pl
name,Mohammad,Joe,Julie,Cristina
age,45,20,35,10
sex,m,m,f,f

Notes

Similar to Part 1 this is also not the easiest way to perform this task. Here the same sort of recursion is used that is used in the Prolog version of the solution to this part. That is, we recurse over the table itself and then for each row perform a separate recursion to perform the transpostion.

References

Challenge 110