w191 - Task 1 & 2

2 files changed, 111 insertions, 0 deletions

diff --git a/challenge-191/perlboy1967/perl/ch-1.pl b/challenge-191/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..96b2fc993b
--- /dev/null
+++ b/challenge-191/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 191
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-191/#TASK1
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Twice Largest
+Submitted by: Mohammad S Anwar
+
+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
+
+use v5.16;
+use warnings;
+
+use Test::More;
+use List::Util qw(max);
+use List::MoreUtils qw(all none firstidx);
+
+
+sub twiceLargest {
+  return -1 if @_ < 2;
+
+  my $max = max(@_);
+
+  return ((firstidx { $max < ($_ << 1) } grep { $_ != $max } @_) == -1 ? 1 : -1);
+}
+
+
+is(twiceLargest(1,2,3,4),-1);
+is(twiceLargest(1,2,0,5),1);
+is(twiceLargest(2,6,3,1),1);
+is(twiceLargest(1),-1);
+is(twiceLargest(1,2),1);
+is(twiceLargest(),-1);
+
+done_testing;
diff --git a/challenge-191/perlboy1967/perl/ch-2.pl b/challenge-191/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..47d9a9fbfc
--- /dev/null
+++ b/challenge-191/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,67 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 191
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-191/#TASK2
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Cute List
+Submitted by: Mohammad S Anwar
+
+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
+
+use v5.16;
+use warnings;
+
+use Time::HiRes qw(gettimeofday tv_interval);
+use Algorithm::Permute;
+use List::MoreUtils qw(firstidx);
+use Memoize;
+
+memoize('isCuteEntry');
+
+use Data::Printer output => 'stdout';
+
+sub isCuteEntry ($$) {
+  state $c;
+  my $idx = $_[0].'|'.$_[1];
+
+  return $c->{$idx} if defined $c->{$idx};
+
+  $c->{$idx} = (($_[0] % $_[1]) != 0 and ($_[1] % $_[0]) != 0) ? 1 : 0;
+
+  return $c->{$idx};
+}
+
+sub nCuteLists {
+  my $n = 0;
+  my $m = 0;
+  my $p = Algorithm::Permute->new([1 .. $_[0]]);
+  while (my @l = $p->next) {
+    $m++;
+    my $i = 1;
+    $n++ if ((firstidx { isCuteEntry($l[$i-1],$i++) } @l) == -1);
+  }
+
+  return "$n / $m";
+}
+
+# Note, testing up to 12 because of time lengthy
+
+for (1..12) {
+  my $t0 = [gettimeofday];
+  printf "nCuteLists($_) = %s (in %f seconds)\n", nCuteLists($_), tv_interval ($t0);
+}