Solutions to challenge-134

2 files changed, 140 insertions, 0 deletions

diff --git a/challenge-134/wanderdoc/perl/ch-1.pl b/challenge-134/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..9ee4483215
--- /dev/null
+++ b/challenge-134/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,70 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to generate first 5 Pandigital Numbers in base 10.
+As per the wikipedia, it says: A pandigital number is an integer that in a given base has among its significant digits each digit used in the base at least once.
+=cut
+
+
+
+
+
+
+
+
+
+
+use Algorithm::Combinatorics qw(permutations);
+
+use Mojo::UserAgent;
+my $ua = Mojo::UserAgent->new;
+my $dom = $ua->get( 'https://oeis.org/A050278/list' )->res->dom;
+
+my ($header) = $dom->find('h2')->each;
+
+my @numbers;
+$header->next->find('tr td tt')->each(sub { push @numbers, $_->text; });
+my %lookup = @numbers;
+@numbers = ();
+
+my $first = 1023456789;
+my $how_many = my $how_many_copy = shift // 5;
+
+my $last_digits = 1;
+
+# Simple "reverse factorial" to find the necessary number of digits from the right.
+my $divisor = 2;
+
+
+while ($how_many_copy > 1)
+{
+     $how_many_copy /= $divisor;
+     $last_digits++; 
+     $divisor++;
+}
+
+
+
+my $length = length($first);
+my $counter = 1;
+
+my $diff = $length - $last_digits;
+my ($constant, $variable) = unpack "A${diff}A${last_digits}", $first;
+
+my $template = "A1" x $last_digits;
+my @arr = unpack $template, $variable;
+
+my $iter = permutations(\@arr);
+while (my $p = $iter->next)
+{
+     my $candidate = join('',$constant, @$p);
+     if ( $counter < 22 )
+     {
+          die "Something wrong!$/" if ( $lookup{$counter} != $candidate );
+     }
+
+     print join(":\t", $counter++, $candidate), $/;
+     last if $counter > $how_many;
+}
\ No newline at end of file
diff --git a/challenge-134/wanderdoc/perl/ch-2.pl b/challenge-134/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..cde6f73421
--- /dev/null
+++ b/challenge-134/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,70 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given 2 positive numbers, $m and $n.
+
+Write a script to generate multiplcation table and display count of distinct terms.
+Example 1
+
+Input: $m = 3, $n = 3
+Output:
+
+      x | 1 2 3
+      --+------
+      1 | 1 2 3
+      2 | 2 4 6
+      3 | 3 6 9
+
+Distinct Terms: 1, 2, 3, 4, 6, 9
+Count: 6
+
+Example 2
+
+Input: $m = 3, $n = 5
+
+Output:
+
+      x | 1  2  3  4  5
+      --+--------------
+      1 | 1  2  3  4  5
+      2 | 2  4  6  8 10
+      3 | 3  6  9 12 15
+
+Distinct Terms: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15
+Count: 11
+=cut
+
+
+
+use Getopt::Std;
+my %options;
+getopts("m:n:", \%options);
+
+my $m = $options{m} // 9;
+my $n = $options{n} // 9;
+
+
+
+my $template = "%3s" x ($n + 2);
+printf("$template$/", ('x', '|', 1 .. $n) );
+print '-' x (($n + 2) * 3), $/;
+
+my %distinct;
+for my $digit_2 ( 1 .. $m )
+{
+     my @arr;
+
+     for my $digit_1 ( 1 .. $n )
+     {
+          push @arr, $digit_1 * $digit_2;
+     }
+     printf("$template$/", $digit_2, '|', @arr );
+     @distinct{@arr} = undef;
+}
+
+
+print "$/Distinct Terms: ", 
+     join(', ', sort {$a <=> $b} keys %distinct), $/;
+print "Count: ", scalar keys %distinct, $/;
\ No newline at end of file