diff options
| -rw-r--r-- | challenge-020/athanasius/perl5/ch-1.pl | 43 | ||||
| -rw-r--r-- | challenge-020/athanasius/perl5/ch-2.pl | 78 | ||||
| -rw-r--r-- | challenge-020/athanasius/perl6/ch-1.p6 | 33 | ||||
| -rw-r--r-- | challenge-020/athanasius/perl6/ch-2.p6 | 78 |
4 files changed, 232 insertions, 0 deletions
diff --git a/challenge-020/athanasius/perl5/ch-1.pl b/challenge-020/athanasius/perl5/ch-1.pl new file mode 100644 index 0000000000..84ba321638 --- /dev/null +++ b/challenge-020/athanasius/perl5/ch-1.pl @@ -0,0 +1,43 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 020 +========================= + +Task #1 +------- +Write a script to accept a string from command line and split it on change of +character. For example, if the string is *"ABBCDEEF"*, then it should split like +*"A"*, *"BB"*, *"C"*, *"D"*, *"EE"*, *"F"*. + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2019 PerlMonk Athanasius # +#--------------------------------------# + +use strict; +use warnings; +use Const::Fast; + +const my $DEFAULT => 'ABBCDEEF'; + +MAIN: +{ + my $string = $ARGV[0] // $DEFAULT; + my @matches = $string =~ / ( (.) \g{-1}* ) /gx; + my $select = 0; + @matches = grep { $select = !$select } @matches; + + print "\n", + "Original string: \"$string\"\n", + "After splitting on\n", + "changes of character: ", + join(', ', map { "\"$_\"" } @matches), + "\n"; +} + +################################################################################ diff --git a/challenge-020/athanasius/perl5/ch-2.pl b/challenge-020/athanasius/perl5/ch-2.pl new file mode 100644 index 0000000000..fc50bbc2aa --- /dev/null +++ b/challenge-020/athanasius/perl5/ch-2.pl @@ -0,0 +1,78 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 020 +========================= + +Task #2 +------- +Write a script to print the smallest pair of *Amicable Numbers*. For more infor- +mation, please checkout wikipedia +[ https://en.wikipedia.org/wiki/Amicable_numbers |page]. + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2019 PerlMonk Athanasius # +#--------------------------------------# + +use strict; +use warnings; +use Const::Fast; +use Getopt::Long; +use Math::Prime::Util qw( divisor_sum ); + +const my $PAIRS => 1; # Number of amicable pairs to find +const my $PERFECT => 0; # Include perfect numbers in the output? +const my $USAGE => "USAGE: perl $0 [--pairs <UInt>] [--perfect]\n"; + +BEGIN +{ + $| = 1; + print "\n"; +} + +MAIN: +{ + my $pairs_target = $PAIRS; + my $do_perfect = $PERFECT; + + GetOptions + ( + 'pairs=i' => \$pairs_target, + perfect => \$do_perfect, + + ) or die $USAGE; + + $pairs_target > 0 + or die "Value \"$pairs_target\" invalid for option pairs (must be " . + "greater than zero)\n$USAGE"; + + my $pairs_found = 0; + my $perfect_found = 0; + my %aliquot_sums = ( 0 => 0 ); + + for (my $n = 1; $pairs_found < $pairs_target; ++$n) + { + my $aliquot_sum = divisor_sum($n) - $n; + + $aliquot_sums{ $n } = $aliquot_sum; + + if ($aliquot_sum == $n) # n is a perfect number + { + printf "Perfect number #%d: %d\n", ++$perfect_found, $n + if $do_perfect; + } + elsif (exists $aliquot_sums{ $aliquot_sum } && # n is the larger of an + $aliquot_sums{ $aliquot_sum } == $n) # amicable pair + { + printf "Amicable pair %s#%d: (%d, %d)\n", + ($do_perfect ? ' ' : ''), ++$pairs_found, $aliquot_sum, $n; + } + } +} + +################################################################################ diff --git a/challenge-020/athanasius/perl6/ch-1.p6 b/challenge-020/athanasius/perl6/ch-1.p6 new file mode 100644 index 0000000000..df08246550 --- /dev/null +++ b/challenge-020/athanasius/perl6/ch-1.p6 @@ -0,0 +1,33 @@ +use v6; + +################################################################################ +=begin comment + +Perl Weekly Challenge 020 +========================= + +Task #1 +------- +Write a script to accept a string from command line and split it on change of +character. For example, if the string is *"ABBCDEEF"*, then it should split like +*"A"*, *"BB"*, *"C"*, *"D"*, *"EE"*, *"F"*. + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2019 PerlMonk Athanasius # +#--------------------------------------# + +my Str constant $DEFAULT = 'ABBCDEEF'; + +sub MAIN(Str:D $string = $DEFAULT) +{ + my @matches = $string ~~ m:g/ ( (.) $0* ) /; + my @substrings = @matches.map( { '"' ~ .Str ~ '"' } ); + + say "\nOriginal string: \"$string\"\n", + "After splitting on\nchanges of character: ", join(', ', @substrings); +} + +################################################################################ diff --git a/challenge-020/athanasius/perl6/ch-2.p6 b/challenge-020/athanasius/perl6/ch-2.p6 new file mode 100644 index 0000000000..d0154e5056 --- /dev/null +++ b/challenge-020/athanasius/perl6/ch-2.p6 @@ -0,0 +1,78 @@ +use v6; + +################################################################################ +=begin comment + +Perl Weekly Challenge 020 +========================= + +Task #2 +------- +Write a script to print the smallest pair of *Amicable Numbers*. For more infor- +mation, please checkout wikipedia +[ https://en.wikipedia.org/wiki/Amicable_numbers |page]. + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2019 PerlMonk Athanasius # +#--------------------------------------# + +use Math::Prime::Util:from<Perl5> <divisor_sum>; + +my Sub $divisor-sum := &Math::Prime::Util::divisor_sum; # Alias + +# Command-line defaults + +my UInt constant $PAIRS = 1; # Find first/smallest amicable pair only +my Bool constant $PERFECT = False; # Ignore perfect numbers + +BEGIN +{ + say ''; +} + +sub MAIN +( + UInt:D :$pairs = $PAIRS, #= the number of amicable pairs to find + Bool:D :$perfect = $PERFECT, #= include perfect numbers in the output? +) +{ + $pairs > 0 + or die "Value \"$pairs\" invalid for option pairs (must be greater " ~ + "than zero)\n$*USAGE"; + + my UInt $pairs-found = 0; + my UInt $perfect-found = 0; + my %aliquot-sums = ( 0 => 0 ); + + for 1 .. ∞ -> UInt $n + { + last if $pairs-found >= $pairs; + + my UInt $aliquot-sum = $divisor-sum($n) - $n; + %aliquot-sums{ $n } = $aliquot-sum; # record n's aliquot-sum + + if $aliquot-sum == $n # n is a perfect number + { + "Perfect number #%d: %d\n".printf(++$perfect-found, $n) if $perfect; + } + elsif %aliquot-sums{ $aliquot-sum }:exists && # n is the larger of an + %aliquot-sums{ $aliquot-sum } == $n # amicable pair + { + "Amicable pair %s#%d: (%d, %d)\n".printf: + ($perfect ?? ' ' !! ''), ++$pairs-found, $aliquot-sum, $n; + } + } + + CATCH + { + default + { + $*ERR.say: .message; + } + } +} + +################################################################################ |