RabbitFarm

2021-05-02

Checking Phone Numbers and Transposing Tabular Data the Hard Way: The Weekly Challenge 110

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

posted at: 19:03 by: Adam Russell | path: /perl | permanent link to this entry

The Weekly Challenge 110 (Prolog Solutions)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution. Also, the challenge statements are given in a Perl context although for Prolog solutions some adjustments are made to account for the differing semantics between the two languages.

Part 1

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

Solution


:-initialization(main).

test('0044 1148820341').  
test('+44 1148820341').  
test('44-11-4882-0341').  
test('(44) 1148820341').   
test('00 1148820341').  

phone_number --> prefx,  space, area_exchange_subscriber.
prefx  --> ['('], digit, digit, [')'].
prefx --> ['+'], digit, digit.
prefx --> digit, digit, digit, digit.
space --> [' '].
area_exchange_subscriber --> digit, digit, digit, digit, digit, digit, digit, digit, digit, digit.
digit --> ['0']; ['1']; ['2']; ['3']; ['4']; ['5']; ['6']; ['7']; ['8']; ['9'].

run_tests:-
    test(T),
    atom_chars(T, C),   
    phrase(phone_number, C),
    write(T), nl.

main:-
    run_tests.

Sample Run


$$ gprolog --consult-file prolog/ch-1.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
Copyright (C) 1999-2020 Daniel Diaz
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-110/adam-russell/prolog/ch-1.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-110/adam-russell/prolog/ch-1.p compiled, 27 lines read - 5899 bytes written, 78 ms
| ?- run_tests.
0044 1148820341

true ? ;
+44 1148820341

true ? ;
(44) 1148820341

true ? ;

(1 ms) no

Notes

I skipped anything to do with actually reading the numbers from a file since that doesn’t really add to the interesting part of the problem. Instead the possible phone numbers to test are just stored in the Prolog db.

Testing is done via DCG. The DCG is a bit rotely written, for sure! DCG’s are a bit hard to debug so I thought I’d start out writing things out as obviously as possible and then come back to tighten things up. Coming back to the DCG later on, I thought there was something kind of attractive to the thing, as it is a bit close to the grammar I wrote in the Perl version of the solution. Perhaps someone looking at the Perl grammar would look at this and even not knowing Prolog be able to make perfect sense of it.

Part 2

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

Solution


:-initialization(main).

transpose(Columns, Transposed):-
    transpose(Columns, _, Transposed).
transpose([], Transposed, Transposed).
transpose([H|T], TransposedAccum, Transposed):-
    transpose_row(H, TransposedAccum, TransposedAccumNew),
    reverse(TransposedAccumNew, TransposedAccumNewReversed),
    transpose(T, TransposedAccumNewReversed, Transposed).

transpose_row(Row, TransposedAccum, RowTranspose):-
    transpose_row(Row, TransposedAccum, [], RowTranspose).
transpose_row([], [], RowTranspose, RowTranspose).
transpose_row([H|T], [HAccum|TAccum], RowTransposeAccum, RowTranspose):-
    append(HAccum, H, HAccum0),
    flatten(HAccum0, HAccum1),
    transpose_row(T, TAccum, [HAccum1 | RowTransposeAccum], RowTranspose).

main:-
    transpose([[1,2,3],[4,5,6]], Transposed),
    write(Transposed), nl.

Sample Run


$ gprolog --consult-file prolog/ch-2.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
Copyright (C) 1999-2020 Daniel Diaz
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-110/adam-russell/prolog/ch-2.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-110/adam-russell/prolog/ch-2.p compiled, 23 lines read - 2766 bytes written, 43 ms
[[1,4],[2,5],[3,6]]

Notes

Again, I skip over reading test data from a file and focus just on transposing a hardcoded table. This is fairly straightforward, and is another list processing exercise that would be well served by using DCGs, but the non-DCG approach seems to otherwise be a fairly standard exercise in recursion.

References

Challenge 110

posted at: 18:44 by: Adam Russell | path: /prolog | permanent link to this entry