aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2020-10-13 09:28:01 +0100
committerGitHub <noreply@github.com>2020-10-13 09:28:01 +0100
commit8dde4a0f9d936858e2a86de8b0ac30c83fe7729e (patch)
tree3963993e50e3daf237cde69f2266e0d849b457ed
parent3de8c82d33415b7fcf11174d9fbf0c23a783c802 (diff)
parent661158ea51e71d9f81a38f70eef28ad136dc7d4d (diff)
downloadperlweeklychallenge-club-8dde4a0f9d936858e2a86de8b0ac30c83fe7729e.tar.gz
perlweeklychallenge-club-8dde4a0f9d936858e2a86de8b0ac30c83fe7729e.tar.bz2
perlweeklychallenge-club-8dde4a0f9d936858e2a86de8b0ac30c83fe7729e.zip
Merge pull request #2507 from PerlBoy1967/branch-for-challenge-082
Task 1 & 2
-rwxr-xr-xchallenge-082/perlboy1967/perl/ch-1.pl63
-rwxr-xr-xchallenge-082/perlboy1967/perl/ch-2.pl41
2 files changed, 104 insertions, 0 deletions
diff --git a/challenge-082/perlboy1967/perl/ch-1.pl b/challenge-082/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..43ffa86ce0
--- /dev/null
+++ b/challenge-082/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 082
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-082/
+#
+# Task 1 - Common Factors
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use strict;
+use warnings;
+
+@ARGV = qw(16 128) unless scalar @ARGV;
+
+my ($N, $M) = @ARGV;
+
+die '$N and $M must be positive integers and not equal'
+ unless (defined $N and $N =~ m#^[1-9][0-9]*$# and
+ defined $M and $M =~ m#^[1-9][0-9]*$#);
+
+my @n = factors($N);
+my @m = factors($M);
+
+my @i = intersect(\@n, \@m);
+
+printf "\$N = %d\n", $N;
+printf "\$M = %d\n", $M;
+print "\n";
+printf "The %d factors of \$N (%d) %s: %s\n",
+ scalar(@n), $N,
+ (scalar @n > 1 ? 'are' : 'is'),
+ join(', ', @n);
+printf "The %d factors of \$M (%d) %s: %s\n",
+ scalar(@m), $M,
+ (scalar @m > 1 ? 'are' : 'is'),
+ join(', ', @m);
+print "\n";
+printf "The %d common factors of \$N (%d) and \$M (%d) %s: %s\n\n",
+ scalar(@i), $N, $M,
+ (scalar @i > 1 ? 'are' : 'is'),
+ join(", ", @i);
+
+sub factors {
+ my ($n) = @_;
+
+ my @d;
+
+ for my $i (1 .. $n) {
+ my $d = int($n/$i);
+ push(@d, $i) if ($d * $i == $n);
+ }
+
+ return @d;
+}
+
+sub intersect {
+ my ($ar1, $ar2) = @_;
+
+ my %c = map { $_ => 1 } @$ar1;
+
+ return grep { exists $c{$_} } @$ar2;
+}
+
diff --git a/challenge-082/perlboy1967/perl/ch-2.pl b/challenge-082/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..e2756ba3f2
--- /dev/null
+++ b/challenge-082/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 082
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-082/
+#
+# Task 2 - Interleave String
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use strict;
+use warnings;
+
+use Data::Printer;
+
+@ARGV = qw(4X 123X678 1234XX678)
+ unless (scalar @ARGV >= 3);
+
+my ($A, $B, $C) = @ARGV;
+
+my $res = 'NONE';
+
+if (length($A) + length($B) == length($C) and
+ $C =~ m#^((?<A1>.*?)$B(?<A2>.*)|(?<B1>.*?)$A(?<B2>.*))$#gc) {
+ if (($+{A1} // '').($+{A2} // '') eq $A) {
+ $res = "$+{A1}|$B|$+{A2}";
+ } elsif (($+{B1} // '').($+{B2} // '') eq $B) {
+ $res = "$+{B1}|$A|$+{B2}";
+ }
+}
+
+printf qq{
+Input:
+ \$A = "$A"
+ \$B = "$B"
+ \$C = "$C"
+
+Output: %d
+
+Interleaving: $res
+}, $res ne 'NONE';
+