Merge pull request #3998 from adamcrussell/challenge-110

Challenge 110

8 files changed, 390 insertions, 0 deletions

diff --git a/challenge-110/adam-russell/blog.txt b/challenge-110/adam-russell/blog.txt
new file mode 100644
index 0000000000..d9f2ab1a37
--- /dev/null
+++ b/challenge-110/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2021/05/02
diff --git a/challenge-110/adam-russell/blog1.txt b/challenge-110/adam-russell/blog1.txt
new file mode 100644
index 0000000000..48e2854d85
--- /dev/null
+++ b/challenge-110/adam-russell/blog1.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/prolog/2021/05/02
diff --git a/challenge-110/adam-russell/perl/PhoneNumberParser.pm b/challenge-110/adam-russell/perl/PhoneNumberParser.pm
new file mode 100644
index 0000000000..b4aa74507f
--- /dev/null
+++ b/challenge-110/adam-russell/perl/PhoneNumberParser.pm
@@ -0,0 +1,218 @@
+####################################################################
+#
+#    This file was generated using Parse::Yapp version 1.21.
+#
+#        Don't edit this file, use source file instead.
+#
+#             ANY CHANGE MADE HERE WILL BE LOST !
+#
+####################################################################
+package PhoneNumberParser;
+use vars qw ( @ISA );
+use strict;
+
+@ISA= qw ( Parse::Yapp::Driver );
+use Parse::Yapp::Driver;
+
+
+
+sub new {
+        my($class)=shift;
+        ref($class)
+    and $class=ref($class);
+
+    my($self)=$class->SUPER::new( yyversion => '1.21',
+                                  yystates =>
+[
+	{#State 0
+		ACTIONS => {
+			'OPEN' => 1,
+			'DIGIT' => 5,
+			'PLUS' => 3
+		},
+		GOTOS => {
+			'phone_number' => 4,
+			'prefix' => 2
+		}
+	},
+	{#State 1
+		ACTIONS => {
+			'DIGIT' => 6
+		}
+	},
+	{#State 2
+		ACTIONS => {
+			'SPACE' => 7
+		}
+	},
+	{#State 3
+		ACTIONS => {
+			'DIGIT' => 8
+		}
+	},
+	{#State 4
+		ACTIONS => {
+			'' => 9
+		}
+	},
+	{#State 5
+		ACTIONS => {
+			'DIGIT' => 10
+		}
+	},
+	{#State 6
+		ACTIONS => {
+			'DIGIT' => 11
+		}
+	},
+	{#State 7
+		ACTIONS => {
+			'DIGIT' => 12
+		},
+		GOTOS => {
+			'area_exchange_subscriber' => 13
+		}
+	},
+	{#State 8
+		ACTIONS => {
+			'DIGIT' => 14
+		}
+	},
+	{#State 9
+		DEFAULT => 0
+	},
+	{#State 10
+		ACTIONS => {
+			'DIGIT' => 15
+		}
+	},
+	{#State 11
+		ACTIONS => {
+			'CLOSE' => 16
+		}
+	},
+	{#State 12
+		ACTIONS => {
+			'DIGIT' => 17
+		}
+	},
+	{#State 13
+		DEFAULT => -1
+	},
+	{#State 14
+		DEFAULT => -4
+	},
+	{#State 15
+		ACTIONS => {
+			'DIGIT' => 18
+		}
+	},
+	{#State 16
+		DEFAULT => -3
+	},
+	{#State 17
+		ACTIONS => {
+			'DIGIT' => 19
+		}
+	},
+	{#State 18
+		DEFAULT => -2
+	},
+	{#State 19
+		ACTIONS => {
+			'DIGIT' => 20
+		}
+	},
+	{#State 20
+		ACTIONS => {
+			'DIGIT' => 21
+		}
+	},
+	{#State 21
+		ACTIONS => {
+			'DIGIT' => 22
+		}
+	},
+	{#State 22
+		ACTIONS => {
+			'DIGIT' => 23
+		}
+	},
+	{#State 23
+		ACTIONS => {
+			'DIGIT' => 24
+		}
+	},
+	{#State 24
+		ACTIONS => {
+			'DIGIT' => 25
+		}
+	},
+	{#State 25
+		ACTIONS => {
+			'DIGIT' => 26
+		}
+	},
+	{#State 26
+		DEFAULT => -5
+	}
+],
+                                  yyrules  =>
+[
+	[#Rule 0
+		 '$start', 2, undef
+	],
+	[#Rule 1
+		 'phone_number', 3, undef
+	],
+	[#Rule 2
+		 'prefix', 4, undef
+	],
+	[#Rule 3
+		 'prefix', 4, undef
+	],
+	[#Rule 4
+		 'prefix', 3, undef
+	],
+	[#Rule 5
+		 'area_exchange_subscriber', 10, undef
+	]
+],
+                                  @_);
+    bless($self,$class);
+}
+
+#line 15 "PhoneNumberParser.yp"
+
+
+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;  
+}
+1;
diff --git a/challenge-110/adam-russell/perl/PhoneNumberParser.yp b/challenge-110/adam-russell/perl/PhoneNumberParser.yp
new file mode 100644
index 0000000000..3f85a6a55b
--- /dev/null
+++ b/challenge-110/adam-russell/perl/PhoneNumberParser.yp
@@ -0,0 +1,46 @@
+%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;  
+}
\ No newline at end of file
diff --git a/challenge-110/adam-russell/perl/ch-1.pl b/challenge-110/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..22b891b7a4
--- /dev/null
+++ b/challenge-110/adam-russell/perl/ch-1.pl
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+##
+# Write a script to display all valid phone numbers in a given text file.     
+##
+use Capture::Tiny q/capture_stdout/;
+use PhoneNumberParser;
+
+MAIN:{
+    my $parser = new PhoneNumberParser();
+    while(my $line = <DATA>){
+        $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
\ No newline at end of file
diff --git a/challenge-110/adam-russell/perl/ch-2.pl b/challenge-110/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..62b844c33f
--- /dev/null
+++ b/challenge-110/adam-russell/perl/ch-2.pl
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+##
+# You are given a text file.
+# Write a script to transpose the contents of the given file.
+##
+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 = <DATA>){
+        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
diff --git a/challenge-110/adam-russell/prolog/ch-1.p b/challenge-110/adam-russell/prolog/ch-1.p
new file mode 100644
index 0000000000..edbad2803b
--- /dev/null
+++ b/challenge-110/adam-russell/prolog/ch-1.p
@@ -0,0 +1,27 @@
+/*
+ Write a script to display all valid phone numbers in a given text file.     
+*/
+:-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.
diff --git a/challenge-110/adam-russell/prolog/ch-2.p b/challenge-110/adam-russell/prolog/ch-2.p
new file mode 100644
index 0000000000..7b8e9ada0a
--- /dev/null
+++ b/challenge-110/adam-russell/prolog/ch-2.p
@@ -0,0 +1,24 @@
+/*
+    Write a script to transpose the contents of a given file.
+*/
+:-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.
\ No newline at end of file