diff options
26 files changed, 1841 insertions, 1245 deletions
diff --git a/challenge-019/roger-bell-west/blog.txt b/challenge-019/roger-bell-west/blog.txt new file mode 100644 index 0000000000..148e2606bd --- /dev/null +++ b/challenge-019/roger-bell-west/blog.txt @@ -0,0 +1 @@ +https://blog.firedrake.org/archive/2019/08/Perl_Weekly_Challenge_19.html diff --git a/challenge-020/dave-jacoby/blog.txt b/challenge-020/dave-jacoby/blog.txt new file mode 100644 index 0000000000..40795ca915 --- /dev/null +++ b/challenge-020/dave-jacoby/blog.txt @@ -0,0 +1 @@ +https://jacoby.github.io/2019/08/05/perl-weekly-challenge-week-20.html diff --git a/challenge-020/dave-jacoby/perl5/ch-1.pl b/challenge-020/dave-jacoby/perl5/ch-1.pl new file mode 100755 index 0000000000..af335c0fdf --- /dev/null +++ b/challenge-020/dave-jacoby/perl5/ch-1.pl @@ -0,0 +1,41 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use utf8; +use feature qw{ fc postderef say signatures state switch }; +no warnings + qw{ experimental::postderef experimental::smartmatch experimental::signatures }; + +if (@ARGV) { + for my $string (@ARGV) { + say $string; + say join ', ', map { qq{"$_"} } split_on_change($string); + say ''; + } +} +else { + my $string = 'ABBCDEEF'; + say $string; + say join ', ', map { qq{"$_"} } split_on_change($string); + say ''; +} + +sub split_on_change ( $string ) { + my @array; + my $cache = ''; + for my $l ( split //, $string ) { + state $m = ''; + if ( $l eq $m ) { + $cache .= $l; + } + else { + $m = $l; + push @array, $cache; + $cache = $l; + } + } + push @array, $cache; + @array = grep { length $_ } @array; + return wantarray ? @array : \@array; +} diff --git a/challenge-020/dave-jacoby/perl5/ch-2.pl b/challenge-020/dave-jacoby/perl5/ch-2.pl new file mode 100755 index 0000000000..85eb0e13ab --- /dev/null +++ b/challenge-020/dave-jacoby/perl5/ch-2.pl @@ -0,0 +1,79 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use utf8; +use feature qw{ postderef say signatures state switch }; +no warnings + qw{ experimental::postderef experimental::smartmatch experimental::signatures }; + +## Amicable numbers are two different numbers so related +## that the sum of the proper divisors of each is equal +## to the other number. + +# I admit, I had to look at another implementation (in Python) +# to understand what is being asked. + +# I pulled out my previously-used factor() code, and reverted it back +# to (1..$n/2) rather than (1..sqrt $n) because of the demonstration +# in wikipedia gave the longer list. + +# sum0 returns a 0 instead of undef if the sum is 0, which doesn't +# affect real results but prevents ugly errors in the fail cases + +use List::Util qw{sum0}; +use JSON; +my $json = JSON->new->pretty->canonical; + +say join "\n", map { join ', ', $_->@* } amicable_pair(10_000); +exit; + +sub amicable_pair( $n ) { + my @result; + for my $x ( 1 .. $n ) { + + # $check is a hashref and exists to ensure that we only cover + # every number pair once. + # @pair is assigned by sorted $x ,$y so it contains 220, 284 + # and never 284, 220. + # $key is @pair joined together, so if "220,284" is covered + # we go on. + + # given any number x, y equals the sum of the factors for x. + # and here, z equals the sum of the factors of y. + # if x == y, that doesn't count, so we take care of that case + # before we even start looking at z. + + state $check; + my $y = sum_factors($x); + next if $x == $y; + my @pair = sort $x, $y; + my $key = join ',', @pair; + next if $check->{$key}++; + my $z = sum_factors($y); + if ( $x == $z ) { + push @result, \@pair; + } + } + return @result; +} + +sub sum_factors ( $n ) { + my @factors = factor($n); + return sum0 @factors; +} + +sub factor ( $n ) { + my @factors; + for my $i ( 1 .. $n / 2 ) { + push @factors, $i if $n % $i == 0; + } + return @factors; +} + +__DATA__ +220, 284 +1184, 1210 +2620, 2924 +5020, 5564 +6232, 6368 diff --git a/challenge-020/duane-powell/perl5/ch-1.pl b/challenge-020/duane-powell/perl5/ch-1.pl new file mode 100644 index 0000000000..3875696618 --- /dev/null +++ b/challenge-020/duane-powell/perl5/ch-1.pl @@ -0,0 +1,39 @@ +#!/usr/bin/perl +use Modern::Perl; + +# 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”. + +my $str = shift || "ABBCDEEF"; +my @str = split(//,$str); + +my ($a, $b) = splice(@str,0,2); +my $out = $a; +while (defined($b)) { + if ($a eq $b) { + $out .= $b; + } else { + print "$out,"; + $out = $b; + } + $a = $b; + $b = shift(@str); +} +say $out; + +__END__ + +./ch-1.pl +A,BB,C,D,EE,F + +./ch-1.pl "hello world" +h,e,ll,o, ,w,o,r,l,d + +./ch-1.pl "Nowww is the tttime for all gooood mmmeeennn" +N,o,www, ,i,s, ,t,h,e, ,ttt,i,m,e, ,f,o,r, ,a,ll, ,g,oooo,d, ,mmm,eee,nnn + +./ch-1.pl 3104630088 +3,1,0,4,6,3,00,88 + diff --git a/challenge-020/duane-powell/perl5/ch-2.pl b/challenge-020/duane-powell/perl5/ch-2.pl new file mode 100644 index 0000000000..6112356c11 --- /dev/null +++ b/challenge-020/duane-powell/perl5/ch-2.pl @@ -0,0 +1,89 @@ +#!/usr/bin/perl +use Modern::Perl; +use ntheory qw(divisors); + +# Write a script to print the smallest pair of Amicable Numbers. For more information, +# please checkout wikipedia https://en.wikipedia.org/wiki/Amicable_numbers +# The first ten amicable pairs are: +# (220, 284), (1184, 1210), (2620, 2924), (5020, 5564), (6232, 6368), (10744, 10856), +# (12285, 14595), (17296, 18416), (63020, 76084), and (66928, 66992) + +my $limit = shift || 76084; + +# iterate over all numbers up to limit and sum their divisors +my %n; # hash of divisors sums, for example, $n{10} = 8 = 1+2+5 +my $n = 1; +while ($n <= $limit) { + my @d = divisors($n); + pop(@d); #discard self, for example the divisors of 10 are 1,2,5,10, so discard 10 + + map { $n{$n} += $_ } @d; + $n++; +} + +# search our hash for pairs, $p +foreach my $n (sort {$a <=> $b} (keys %n)) { + my $p = $n{$n}; + if ( exists($n{$p}) ) { + say "($n, $n{$n})" if ($n{$p} == $n and $p != $n); + delete $n{$n}; # so we don't match twice + } +} + +__END__ + +./ch-2.pl +(220, 284) +(1184, 1210) +(2620, 2924) +(5020, 5564) +(6232, 6368) +(10744, 10856) +(12285, 14595) +(17296, 18416) +(63020, 76084) +(66928, 66992) +(67095, 71145) + +./ch-2.pl 1000000 +(220, 284) +(1184, 1210) +(2620, 2924) +(5020, 5564) +(6232, 6368) +(10744, 10856) +(12285, 14595) +(17296, 18416) +(63020, 76084) +(66928, 66992) +(67095, 71145) +(69615, 87633) +(79750, 88730) +(100485, 124155) +(122265, 139815) +(122368, 123152) +(141664, 153176) +(142310, 168730) +(171856, 176336) +(176272, 180848) +(185368, 203432) +(196724, 202444) +(280540, 365084) +(308620, 389924) +(319550, 430402) +(356408, 399592) +(437456, 455344) +(469028, 486178) +(503056, 514736) +(522405, 525915) +(600392, 669688) +(609928, 686072) +(624184, 691256) +(635624, 712216) +(643336, 652664) +(667964, 783556) +(726104, 796696) +(802725, 863835) +(879712, 901424) +(898216, 980984) + diff --git a/challenge-020/e-choroba/perl5/ch-1.pl b/challenge-020/e-choroba/perl5/ch-1.pl new file mode 100755 index 0000000000..f0c351f239 --- /dev/null +++ b/challenge-020/e-choroba/perl5/ch-1.pl @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use warnings; +use strict; +use feature qw{ say }; + +sub split_on_change { + my ($string) = @_; + my $i; + grep ++$i % 2, $string =~ /((.)\2*)/g +} + +use Test::More tests => 1; +is_deeply [split_on_change('ABBCDEEF')], + [qw[ A BB C D EE F ]]; diff --git a/challenge-020/e-choroba/perl5/ch-2.pl b/challenge-020/e-choroba/perl5/ch-2.pl new file mode 100755 index 0000000000..4e17ef1186 --- /dev/null +++ b/challenge-020/e-choroba/perl5/ch-2.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl +use warnings; +use strict; +use feature qw(say); + +use List::Util qw{ sum0 }; + +sub sum_divisors { + my $n = shift; + return sum0(grep 0 == $n % $_, 1 .. $n - 1) +} + +my ($a1, $a2) = (0, 0); +until ($a1 == sum_divisors($a2) && $a1 < $a2) { + $a2 = sum_divisors(++$a1); +} +say "$a1 $a2"; diff --git a/challenge-020/kevin-colyer/perl6/ch-1.p6 b/challenge-020/kevin-colyer/perl6/ch-1.p6 new file mode 100644 index 0000000000..611bbf57c8 --- /dev/null +++ b/challenge-020/kevin-colyer/perl6/ch-1.p6 @@ -0,0 +1,9 @@ +#!/usr/bin/perl6 +use v6; + +# 20.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”. + +sub MAIN ($string where .chars >0) { + .Str.say for $string ~~ m:g / ((.) $0*) / +} diff --git a/challenge-020/kevin-colyer/perl6/ch-2.p6 b/challenge-020/kevin-colyer/perl6/ch-2.p6 new file mode 100644 index 0000000000..6957341887 --- /dev/null +++ b/challenge-020/kevin-colyer/perl6/ch-2.p6 @@ -0,0 +1,32 @@ +#!/usr/bin/perl6 +use v6; + +# 20.2 +# Write a script to print the smallest pair of Amicable Numbers. https://en.wikipedia.org/wiki/Amicable_numbers + +# store sums of proper divisors in a hash to aid finding its amicable pair +my %spd; +my $i=1; + +loop { + %spd{$i}=sumProperDivisors($i); + + # if an amicable pair does not exist in the hash yet, keep filling hash up + if not %spd{%spd{$i}}:exists { + $i++ ; + next + }; + + # if hash has a pair, check it is amicable, and not just a perfect number + if %spd{%spd{$i}}==$i and %spd{$i} != $i { + say "($i," ~ %spd{$i} ~ ")"; + last + }; + # keep going... + $i++; +} + + +sub sumProperDivisors ($i) { + return [+] (1..^$i).grep: $i %% * ; +} diff --git a/challenge-020/pete-houston/perl5/ch-1.pl b/challenge-020/pete-houston/perl5/ch-1.pl new file mode 100644 index 0000000000..d31d828e0f --- /dev/null +++ b/challenge-020/pete-houston/perl5/ch-1.pl @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +#=============================================================================== +# +# USAGE: ./ch-1.pl STRING +# +# DESCRIPTION: Split argument string on character change +# +#=============================================================================== + +use strict; +use warnings; + +die "No argument string given.\n" unless defined $ARGV[0]; +my @chars = split //, $ARGV[0]; +my @out = shift @chars; +while (my $next = shift @chars) { + if (substr ($out[-1], 0, 1) eq $next) { + $out[-1] .= $next; + } else { + push @out, $next; + } +} +print "Result is @out\n"; diff --git a/challenge-020/roger-bell-west/perl5/ch-1.pl b/challenge-020/roger-bell-west/perl5/ch-1.pl new file mode 100755 index 0000000000..5816299fbe --- /dev/null +++ b/challenge-020/roger-bell-west/perl5/ch-1.pl @@ -0,0 +1,14 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use List::Util qw(pairmap); + +foreach my $in (@ARGV) { + print join(' ',splitchange($in)),"\n"; +} + +sub splitchange { + return pairmap {$a.$b} shift =~ /(.)(\g1*)/g; +} diff --git a/challenge-020/roger-bell-west/perl5/ch-2.pl b/challenge-020/roger-bell-west/perl5/ch-2.pl new file mode 100755 index 0000000000..8647aff669 --- /dev/null +++ b/challenge-020/roger-bell-west/perl5/ch-2.pl @@ -0,0 +1,23 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use Math::BigInt lib => 'GMP'; +use Math::Prime::Util qw(divisors); +use List::Util qw(sum); + +my $a=Math::BigInt->new(1); +while (1) { + $a++; + my @a=grep {$_ != $a} divisors($a); + my $b=sum(@a); + if ($b <= $a) { + next; + } + my @b=grep {$_ != $b} divisors($b); + my $aa=sum(@b); + if ($aa == $a) { + print "$a, $b\n"; + } +} diff --git a/challenge-020/roger-bell-west/perl6/ch-1.p6 b/challenge-020/roger-bell-west/perl6/ch-1.p6 new file mode 100755 index 0000000000..f369c23c39 --- /dev/null +++ b/challenge-020/roger-bell-west/perl6/ch-1.p6 @@ -0,0 +1,9 @@ +#! /usr/bin/perl6 + +for @*ARGS -> $in { + say join(' ',splitchange($in)); +} + +sub splitchange ($in) { + return map {$_.Str}, $in ~~ m:g/(.) {} :my $c = $0; ($c*)/; +} diff --git a/challenge-020/roger-bell-west/perl6/ch-2.p6 b/challenge-020/roger-bell-west/perl6/ch-2.p6 new file mode 100755 index 0000000000..9f095df46b --- /dev/null +++ b/challenge-020/roger-bell-west/perl6/ch-2.p6 @@ -0,0 +1,32 @@ +#! /usr/bin/perl6 + +my $a=1; +while (1) { + $a++; + my @a=divisors_unself($a); + unless (@a) { + next; + } + my $b=@a.sum; + if ($b <= $a) { + next; + } + my @b=divisors_unself($b); + unless (@b) { + next; + } + my $aa=@b.sum; + if ($aa == $a) { + print "$a, $b\n"; + } +} + +sub divisors_unself ($k) { + my @d=(1); + for 2..$k/2.Int -> $d { + if ($k % $d == 0) { + push @d,$d; + } + } + return @d; +}
\ No newline at end of file diff --git a/stats/pwc-challenge-019.json b/stats/pwc-challenge-019.json new file mode 100644 index 0000000000..f1df012e56 --- /dev/null +++ b/stats/pwc-challenge-019.json @@ -0,0 +1,596 @@ +{ + "series" : [ + { + "colorByPoint" : 1, + "data" : [ + { + "y" : 3, + "name" : "Adam Russell", + "drilldown" : "Adam Russell" + }, + { + "name" : "Andrezgz", + "drilldown" : "Andrezgz", + "y" : 2 + }, + { + "y" : 3, + "drilldown" : "Arne Sommer", + "name" : "Arne Sommer" + }, + { + "name" : "Athanasius", + "drilldown" : "Athanasius", + "y" : 4 + }, + { + "drilldown" : "Daniel Mantovani", + "name" : "Daniel Mantovani", + "y" : 2 + }, + { + "y" : 3, + "drilldown" : "Dave Cross", + "name" : "Dave Cross" + }, + { + "name" : "Dave Jacoby", + "drilldown" : "Dave Jacoby", + "y" : 3 + }, + { + "y" : 2, + "name" : "Duane Powell", + "drilldown" : "Duane Powell" + }, + { + "drilldown" : "Duncan C. White", + "name" : "Duncan C. White", + "y" : 2 + }, + { + "drilldown" : "E. Choroba", + "name" : "E. Choroba", + "y" : 3 + }, + { + "drilldown" : "Feng Chang", + "name" : "Feng Chang", + "y" : 4 + }, + { + "name" : "Francis Whittle", + "drilldown" : "Francis Whittle", + "y" : 3 + }, + { + "name" : "Guillermo Ramos", + "drilldown" : "Guillermo Ramos", + "y" : 2 + }, + { + "y" : 2, + "drilldown" : "Gustavo Chaves", + "name" : "Gustavo Chaves" + }, + { + "y" : 2, + "drilldown" : "Jaime Corchado", + "name" : "Jaime Corchado" + }, + { + "y" : 5, + "drilldown" : "Jaldhar H. Vyas", + "name" : "Jaldhar H. Vyas" + }, + { + "drilldown" : "Jo Christian Oterhals", + "name" : "Jo Christian Oterhals", + "y" : 3 + }, + { + "name" : "Joelle Maslak", + "drilldown" : "Joelle Maslak", + "y" : 6 + }, + { + "name" : "Kian-Meng Ang", + "drilldown" : "Kian-Meng Ang", + "y" : 2 + }, + { + "name" : "Laurent Rosenfeld", + "drilldown" : "Laurent Rosenfeld", + "y" : 5 + }, + { + "y" : 2, + "drilldown" : "Lubos Kolouch", + "name" : "Lubos Kolouch" + }, + { + "y" : 2, + "drilldown" : "Mark Anderson", + "name" : "Mark Anderson" + }, + { + "y" : 2, + "name" : "Noud", + "drilldown" : "Noud" + }, + { + "name" : "Ozzy", + "drilldown" : "Ozzy", + "y" : 2 + }, + { + "drilldown" : "Pete Houston", + "name" : "Pete Houston", + "y" : 2 + }, + { + "y" : 2, + "drilldown" : "Prajith P", + "name" : "Prajith P" + }, + { + "name" : "Randy Lauen", + "drilldown" : "Randy Lauen", + "y" : 3 + }, + { + "y" : 5, + "name" : "Roger Bell West", + "drilldown" : "Roger Bell West" + }, + { + "y" : 4, + "drilldown" : "Ruben Westerberg", + "name" : "Ruben Westerberg" + }, + { + "name" : "Simon Proctor", + "drilldown" : "Simon Proctor", + "y" : 2 + }, + { + "y" : 3, + "name" : "Steven Wilson", + "drilldown" : "Steven Wilson" + }, + { + "y" : 2, + "drilldown" : "Walt Mankowski", + "name" : "Walt Mankowski" + } + ], + "name" : "Perl Weekly Challenge - 019" + } + ], + "yAxis" : { + "title" : { + "text" : "Total Solutions" + } + }, + "xAxis" : { + "type" : "category" + }, + "chart" : { + "type" : "column" + }, + "legend" : { + "enabled" : 0 + }, + "title" : { + "text" : "Perl Weekly Challenge - 019" + }, + "tooltip" : { + "pointFormat" : "<span style='color:{point.color}'>{point.name}</span>: <b>{point.y:f}</b><br/>", + "headerFormat" : "<span style='font-size:11px'>{series.name}</span><br/>", + "followPointer" : 1 + }, + "plotOptions" : { + "series" : { + "dataLabels" : { + "format" : "{point.y}", + "enabled" : 1 + }, + "borderWidth" : 0 + } + }, + "subtitle" : { + "text" : "[Champions: 32] Last updated at 2019-08-05 11:27:24 GMT" + }, + "drilldown" : { + "series" : [ + { + "id" : "Adam Russell", + "name" : "Adam Russell", + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Blog", + 1 + ] + ] + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "id" : "Andrezgz", + "name" : "Andrezgz" + }, + { + "data" : [ + [ + "Perl 6", + 2 + ], + [ + "Blog", + 1 + ] + ], + "name" : "Arne Sommer", + "id" : "Arne Sommer" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Perl 6", + 2 + ] + ], + "name" : "Athanasius", + "id" : "Athanasius" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "id" : "Daniel Mantovani", + "name" : "Daniel Mantovani" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Blog", + 1 + ] + ], + "name" : "Dave Cross", + "id" : "Dave Cross" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Blog", + 1 + ] + ], + "id" : "Dave Jacoby", + "name" : "Dave Jacoby" + }, + { + "id" : "Duane Powell", + "name" : "Duane Powell", + "data" : [ + [ + "Perl 5", + 2 + ] + ] + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "name" : "Duncan C. White", + "id" : "Duncan C. White" + }, + { + "name" : "E. Choroba", + "id" : "E. Choroba", + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Blog", + 1 + ] + ] + }, + { + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Perl 6", + 2 + ] + ], + "name" : "Feng Chang", + "id" : "Feng Chang" + }, + { + "data" : [ + [ + "Perl 6", + 2 + ], + [ + "Blog", + 1 + ] + ], + "id" : "Francis Whittle", + "name" : "Francis Whittle" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "name" : "Guillermo Ramos", + "id" : "Guillermo Ramos" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "name" : "Gustavo Chaves", + "id" : "Gustavo Chaves" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "id" : "Jaime Corchado", + "name" : "Jaime Corchado" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Perl 6", + 2 + ], + [ + "Blog", + 1 + ] + ], + "name" : "Jaldhar H. Vyas", + "id" : "Jaldhar H. Vyas" + }, + { + "data" : [ + [ + "Perl 6", + 2 + ], + [ + "Blog", + 1 + ] + ], + "id" : "Jo Christian Oterhals", + "name" : "Jo Christian Oterhals" + }, + { + "name" : "Joelle Maslak", + "id" : "Joelle Maslak", + "data" : [ + [ + "Perl 5", + 3 + ], + [ + "Perl 6", + 3 + ] + ] + }, + { + "data" : [ + [ + "Perl 5", + 2 + ] + ], + "name" : "Kian-Meng Ang", + "id" : "Kian-Meng Ang" + }, + { + "data" : [ + [ + "Perl 5", + 2 + ], + [ + "Perl 6", + 2 + ], + [ + "Blog", + 1 + ] + ], + "id" : "Laurent Rosenfeld", + "name" : "Laurent Rosenfeld" + }, + { + "id" : "Lubos Kolouch", + "name" : "Lubos Kolouch", + "data" : [ + [ + "Perl 5", + 2 + ] + ] + }, + { + "name" : "Mark Anderson", + "id" : "Mark Anderson", + "data" : [ + [ + "Perl 5", + 2 + ] + ] + }, + { + "name" : "Noud", + "id" : "Noud", + "data" : [ + [ + "Perl 6", + 2 + ] + ] + }, + { + "data" : [ + [ + "Perl 6", + 2 + ] + ], + "name" : "Ozzy", + "id" : "Ozzy" + }, + { + "data" : [ + [ + "Perl 5", + 2 + |