diff options
| -rw-r--r-- | challenge-001/john-barrett/perl5/README.md | 75 | ||||
| -rwxr-xr-x | challenge-002/john-barrett/perl5/ch-1.pl | 9 | ||||
| -rwxr-xr-x | challenge-002/john-barrett/perl5/ch-2.pl | 43 |
3 files changed, 127 insertions, 0 deletions
diff --git a/challenge-001/john-barrett/perl5/README.md b/challenge-001/john-barrett/perl5/README.md new file mode 100644 index 0000000000..65a2fb6106 --- /dev/null +++ b/challenge-001/john-barrett/perl5/README.md @@ -0,0 +1,75 @@ +As published on https://perlweeklychallenge.org/blog/a-new-week-a-new-challenge/ <br/> +Submissions demonstrated here using [Reply](https://metacpan.org/pod/Reply). + +> Write a script to replace the character ‘e’ with ‘E’ in the string ‘Perl Weekly Challenge’. Also print the number of times the character ‘e’ is found in the string. + +I didn't write a script so I fail this challenge already. + +``` +0> my $foo = 'Perl Weekly Challenge' +$res[0] = "Perl Weekly Challenge" +1> $foo =~ s/e/E/g; +$res[1] = 5 +2> $foo +$res[2] = "PErl WEEkly ChallEngE" +3> +``` + +> Write a one-liner to solve the FizzBuzz problem and print the numbers 1 through 20. However, any number divisible by 3 should be replaced by the word ‘fizz’ and any divisible by 5 by the word ‘buzz’. Those numbers that are both divisible by 3 and 5 become ‘fizzbuzz’. + +I don't remember where I saw this, but it is my favourite Perl5 FizzBuzz: + +``` +4> { no strict; no warnings; map { (fizz)[$_%3].(buzz)[$_%5]||$_ } 1..20 } +$res[4] = [ + [0] 1, + [1] 2, + [2] "fizz", + [3] 4, + [4] "buzz", + [5] "fizz", + [6] 7, + [7] 8, + [8] "fizz", + [9] "buzz", + [10] 11, + [11] "fizz", + [12] 13, + [13] 14, + [14] "fizzbuzz", + [15] 16, + [16] 17, + [17] "fizz", + [18] 19, + [19] "buzz" +] +``` + +Since I didn't write that myself I also fail the second part of the challenge. Not going well. Let's see... + +``` +$ perl -MAcme::FizzBuzz -e '1' | head -n 20 | tr '[:upper:]' '[:lower:]' +1 +2 +fizz +4 +buzz +fizz +7 +8 +fizz +buzz +11 +fizz +13 +14 +fizzbuzz +16 +17 +fizz +19 +buzz +``` + + There! + diff --git a/challenge-002/john-barrett/perl5/ch-1.pl b/challenge-002/john-barrett/perl5/ch-1.pl new file mode 100755 index 0000000000..1567a4ba3c --- /dev/null +++ b/challenge-002/john-barrett/perl5/ch-1.pl @@ -0,0 +1,9 @@ +#!/usr/bin/env perl + +# ./ch-1.pl 00123 + +$ARGV[0] > 0 && printf ( + ( $ARGV[0] =~ /\./ + ? "%g\n" + : "%d\n" ), $ARGV[0] +); diff --git a/challenge-002/john-barrett/perl5/ch-2.pl b/challenge-002/john-barrett/perl5/ch-2.pl new file mode 100755 index 0000000000..f18215e4f0 --- /dev/null +++ b/challenge-002/john-barrett/perl5/ch-2.pl @@ -0,0 +1,43 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw/ say /; + +# Usage, e.g. +# ./ch-2.pl -to-base35 123 +# ./ch-2.pl -from-base35 ABCD + +my %args = @ARGV; +my @charset = ( 0..9, 'A'..'Y' ); +my $base = @charset; + +say to_base35( $args{'-to-base35'} ) if $args{'-to-base35'}; +say from_base35( $args{'-from-base35'} ) if $args{'-from-base35'}; + +sub from_base35 { + my ( $base35 ) = @_; + my $sign = $base35 =~ s/-//g ? '-' : ''; + my @digits = split '', $base35; + my $idx = join '', @charset; + my $pos = 0; + my $val; + while ( my $char = pop @digits ) { + $val += index( $idx, $char ) * ( $base ** $pos ); + $pos++; + } + $sign . $val; +} + +sub to_base35 { + my ( $int ) = @_; + my $sign = ( $int < 0 ) ? '-' : ''; + my @digits; + $int = abs( $int ); + do { + push @digits, $charset[ $int % $base ]; + $int = int( $int / $base ); + } while ( $int > 0 ); + $sign . join '', reverse @digits; +} + |
