Merge pull request #7085 from poti1/my

191 - Perl 🥷

3 files changed, 151 insertions, 0 deletions

diff --git a/challenge-191/tim-potapov/perl/ch-1.pl b/challenge-191/tim-potapov/perl/ch-1.pl
new file mode 100755
index 0000000000..70835fc62d
--- /dev/null
+++ b/challenge-191/tim-potapov/perl/ch-1.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+
+=pod
+
+Task 1: Twice Largest
+You are given list of integers, @list.
+
+Write a script to find out whether the largest item in the list is at
+least twice as large as each of the other items.
+
+=cut
+
+sub twice_as_big {
+    my ( $biggest, $next_biggest ) = sort { $b <=> $a } @_;
+    $biggest >= 2 * $next_biggest ? 1 : -1;
+}
+
+my @cases = (
+    {
+        Name   => 'Example 1',
+        Input  => [ 1, 2, 3, 4 ],
+        Output => -1,
+
+        # The largest in the given list is 4. However 4 is not greater than
+        # twice of every remaining elements.
+        # 1 x 2 < 4
+        # 2 x 2 > 4
+        # 2 x 3 > 4
+    },
+    {
+        Name   => 'Example 2',
+        Input  => [ 1, 2, 0, 5 ],
+        Output => 1,
+
+        # The largest in the given list is 5. Also 5 is greater than twice of
+        # every remaining elements.
+        # 1 x 2 < 5
+        # 2 x 2 < 5
+        # 0 x 2 < 5
+
+    },
+    {
+        Name   => 'Example 3',
+        Input  => [ 2, 6, 3, 1 ],
+        Output => 1,
+
+        # The largest in the given list is 6. Also 6 is greater than twice of
+        # every remaining elements.
+        # 2 x 2 < 6
+        # 3 x 2 < 6
+        # 1 x 2 < 6
+
+    },
+    {
+        Name   => 'Example 4',
+        Input  => [ 4, 5, 2, 3 ],
+        Output => -1,
+
+        # The largest in the given list is 5. Also 5 is not greater than twice
+        # of every remaining elements.
+        # 4 x 2 > 5
+        # 2 x 2 < 5
+        # 3 x 2 > 5
+    },
+);
+
+for ( @cases ) {
+    is twice_as_big( $_->{Input}->@* ), $_->{Output}, $_->{Name};
+}
+
+done_testing();
diff --git a/challenge-191/tim-potapov/perl/ch-2.pl b/challenge-191/tim-potapov/perl/ch-2.pl
new file mode 100755
index 0000000000..fa0d59b6b3
--- /dev/null
+++ b/challenge-191/tim-potapov/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+use Math::Combinatorics qw( permute );
+
+#TODO: Remove this debug code !!!
+use feature    qw(say);
+use Mojo::Util qw(dumper);
+
+=pod
+
+Task 2: Cute List
+You are given an integer, 0 < $n <= 15.
+
+Write a script to find the number of orderings of numbers that form a cute list.
+
+With an input @list = (1, 2, 3, .. $n) for positive integer $n,
+an ordering of @list is cute if for every entry, indexed with a base of 1, either
+
+    1) $list[$i] is evenly divisible by $i
+    or
+    2) $i is evenly divisible by $list[$i]
+
+=cut
+
+sub number_of_orderings {
+    my ( $n ) = @_;
+    my @lists = permute( 1 .. $n );
+    my %orderings;
+
+  LIST:
+    for my $list ( @lists ) {
+        while ( my ( $i, $entry ) = each @$list ) {
+            my $check1 = $list->[$i] % ( $i + 1 ) == 0;
+            my $check2 = ( $i + 1 ) % $list->[$i] == 0;
+            next LIST unless $check1 or $check2;
+        }
+        $orderings{"@$list"}++;
+    }
+
+    %orderings;
+}
+
+my @cases = (
+    {
+        Name   => 'Example 1',
+        Input  => 2,
+        Output => 2,
+
+      # Since $n = 2, the list can be made up of two integers only i.e. 1 and 2.
+      # Therefore we can have two list i.e. (1,2) and (2,1).
+      # @list = (1,2) is cute since
+      # $list[1] = 1 is divisible by 1 and $list[2] = 2 is divisible by 2.
+
+    },
+    {
+        Name   => 'Example 2',
+        Input  => 3,
+        Output => 3,
+    },
+    {
+        Name   => 'Example 2',
+        Input  => 4,
+        Output => 8,
+    },
+);
+
+for ( @cases ) {
+    is number_of_orderings( $_->{Input} ), $_->{Output},
+      "$_->{Name} - $_->{Input}";
+}
+
+done_testing();
diff --git a/challenge-191/tim-potapov/perl/cpanfile b/challenge-191/tim-potapov/perl/cpanfile
new file mode 100644
index 0000000000..752340d56f
--- /dev/null
+++ b/challenge-191/tim-potapov/perl/cpanfile
@@ -0,0 +1 @@
+require 'Math::Combinatorics';