aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2019-08-11 11:18:53 +0100
committerGitHub <noreply@github.com>2019-08-11 11:18:53 +0100
commit50c05ac99f4143eba05399d6425aa0d4dad65451 (patch)
tree5daa3c548ec1e34e4868926afb02b96369faf924
parent22667e9a84c0e718176d2c2f757a69fa4be725c7 (diff)
parentbaa0029eaef4dad08858975bb07de56b9fffce1a (diff)
downloadperlweeklychallenge-club-50c05ac99f4143eba05399d6425aa0d4dad65451.tar.gz
perlweeklychallenge-club-50c05ac99f4143eba05399d6425aa0d4dad65451.tar.bz2
perlweeklychallenge-club-50c05ac99f4143eba05399d6425aa0d4dad65451.zip
Merge pull request #498 from kianmeng/master
Add task 1 & 2 answer
-rw-r--r--challenge-020/kian-meng-ang/perl5/ch-1.pl24
-rw-r--r--challenge-020/kian-meng-ang/perl5/ch-2.pl46
2 files changed, 70 insertions, 0 deletions
diff --git a/challenge-020/kian-meng-ang/perl5/ch-1.pl b/challenge-020/kian-meng-ang/perl5/ch-1.pl
new file mode 100644
index 0000000000..57b98df1d9
--- /dev/null
+++ b/challenge-020/kian-meng-ang/perl5/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# vi:et:sw=4 ts=4 ft=perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw(say);
+use Carp;
+
+my $str = $ARGV[0] || carp 'Missing string!';
+my ($groups, $i, $prev) = ([], 0, substr$str, 0, 1);
+foreach my $char (split //, $str) {
+ $i++ if ($char ne $prev);
+ $groups->[$i] .= $char;
+ $prev = $char;
+}
+
+say join q|,|, ( map { sprintf '"%s"', $_ } @{$groups} );
+
+1;
+
+__END__
+$ perl ch-1.pl ABBCDEEF
+"A","BB","C","D","EE","F"
diff --git a/challenge-020/kian-meng-ang/perl5/ch-2.pl b/challenge-020/kian-meng-ang/perl5/ch-2.pl
new file mode 100644
index 0000000000..a72568fa3c
--- /dev/null
+++ b/challenge-020/kian-meng-ang/perl5/ch-2.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+# vi:et:sw=4 ts=4 ft=perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw(say signatures);
+no warnings qw(experimental::signatures);
+use Carp;
+use Math::Prime::Util qw(is_prime);
+
+# See https://www.youtube.com/watch?v=fUSZBVYZdKY
+# See https://en.wikipedia.org/wiki/Amicable_numbers
+
+sub generate_amicable_numbers($n) {
+ carp '$n must larger than 1' if ($n <= 1);
+
+ # Using Thābit ibn Qurra theorem.
+ # See https://en.wikipedia.org/wiki/Thabit_number
+ my $p = (3 * (2 ** ($n - 1))) - 1;
+ my $q = (3 * (2 ** $n)) - 1;
+ my $r = (9 * (2 ** (2 * $n - 1))) - 1;
+
+ my ($an1, $an2);
+ if (is_prime($p) && is_prime($q) && is_prime($r)) {
+ $an1 = (2 ** $n) * $p * $q;
+ $an2 = (2 ** $n) * $r;
+ }
+ return ($an1, $an2);
+}
+
+my $n = 2;
+while (1) {
+ if (my ($an1, $an2) = generate_amicable_numbers($n)) {
+ say "$n => ($an1,$an2)";
+ last;
+ }
+ $n++;
+}
+
+1;
+
+__END__
+
+$ perl ch-2.pl
+2 => (220,284)