w267 & w268 - Task 1 & 2

4 files changed, 174 insertions, 0 deletions

diff --git a/challenge-267/perlboy1967/perl/ch1.pl b/challenge-267/perlboy1967/perl/ch1.pl
new file mode 100755
index 0000000000..a90be89fc8
--- /dev/null
+++ b/challenge-267/perlboy1967/perl/ch1.pl
@@ -0,0 +1,40 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 267
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-267
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Product Sign
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of @ints.
+
+Write a script to find the sign of product of all integers in the given
+array. The sign is 1 if the product is positive, -1 if the product is
+negative and 0 if product is zero.
+
+=cut
+
+use v5.32;
+use feature qw(signatures);
+use common::sense;
+
+use Test2::V0;
+
+sub productSign (@ints) {
+  my $sign = 1;
+  for (@ints) {
+    return 0 if $_ == 0;
+    $sign *= ($_ > 0 ? 1 : -1);
+  }
+  return $sign;
+}
+
+is(productSign(-1,-2,-3,-4,3,2,1),1,'Example 1');
+is(productSign(1,2,0,-2,-1),0,'Example 2');
+is(productSign(-1,-1,1,-1,2),-1,'Example 3');
+
+done_testing;
diff --git a/challenge-267/perlboy1967/perl/ch2.pl b/challenge-267/perlboy1967/perl/ch2.pl
new file mode 100755
index 0000000000..75b4d40fc1
--- /dev/null
+++ b/challenge-267/perlboy1967/perl/ch2.pl
@@ -0,0 +1,48 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 267
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-267
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Line Counts
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, and a 26-items array @widths containing
+the width of each character from a to z.
+
+Write a script to find out the number of lines and the width of the
+last line needed to display the given string, assuming you can only
+fit 100 width units on a line.
+
+=cut
+
+use v5.32;
+use feature qw(signatures);
+use common::sense;
+
+use Test2::V0;
+
+use List::AllUtils qw(mesh);
+
+sub lineCounts ($str,@widths) {
+  my %cw = mesh @{['a'..'z']}, @widths;
+  my ($lines,$width) = (1,0);
+  for (split //,$str) {
+    if ($width + $cw{$_} > 100) {
+      $width = $cw{$_}; $lines++;
+    } else {
+      $width += $cw{$_};
+    }
+  }
+  return ($lines,$width);
+}
+
+is([lineCounts('abcdefghijklmnopqrstuvwxyz',(10)x26)],
+   [3,60],'Example 1');
+is([lineCounts('bbbcccdddaaa',4,(10)x25)],
+   [2,4],'Example 2');
+
+done_testing;
diff --git a/challenge-268/perlboy1967/perl/ch1.pl b/challenge-268/perlboy1967/perl/ch1.pl
new file mode 100755
index 0000000000..74193f856b
--- /dev/null
+++ b/challenge-268/perlboy1967/perl/ch1.pl
@@ -0,0 +1,41 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 268
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-268
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Magic Number
+Submitted by: Mohammad Sajid Anwar
+
+You are given two arrays of integers of same size, @x and @y.
+
+Write a script to find the magic number that when added to each 
+elements of one of the array gives the second array. Elements order
+is not important.
+
+=cut
+
+use v5.32;
+use feature qw(signatures);
+use common::sense;
+
+use Test2::V0;
+
+use List::AllUtils qw(pairwise uniq);
+
+sub magicNumber($ar1,$ar2) {
+  my @d = uniq pairwise { $b - $a } 
+                        @{[sort {$a <=> $b} @$ar1]},
+                        @{[sort {$a <=> $b} @$ar2]};
+  return (@d == 1 ? $d[0] : undef);
+}
+
+is(magicNumber([3,7,5],[9,5,7]),2,'Example 1');
+is(magicNumber([1,2,1],[5,4,4]),3,'Example 2');
+is(magicNumber([2],[5]),3,'Example 3');
+is(magicNumber([0,1],[2,4]),undef,'Own test');
+
+done_testing;
diff --git a/challenge-268/perlboy1967/perl/ch2.pl b/challenge-268/perlboy1967/perl/ch2.pl
new file mode 100755
index 0000000000..9e165a160e
--- /dev/null
+++ b/challenge-268/perlboy1967/perl/ch2.pl
@@ -0,0 +1,45 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 268
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-268
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Number Game
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints, with even number of elements.
+
+Write a script to create a new array made up of elements of the given
+array. Pick the two smallest integers and add it to new array in
+decreasing order i.e. high to low. Keep doing until the given array is
+empty.
+
+=cut
+
+use v5.32;
+use feature qw(signatures);
+use common::sense;
+
+use Test2::V0;
+
+use List::AllUtils qw(all pairs pairwise);
+
+sub numberGame(@ints) {
+  my @before = @ints;
+  my @after;
+  while (1) {
+    push(@after,sort{$b<=>$a}@$_) for (pairs(sort{$a<=>$b}@before));
+    last if (all{$_ == 0} pairwise {$a-$b} @before,@after);
+    @before = @after; @after = ();
+  }
+  return @after;
+}
+
+is([numberGame(2,5,3,4)],[3,2,5,4],'Example 1');
+is([numberGame(9,4,1,3,6,4,6,1)],[1,1,4,3,6,4,9,6],'Example 2');
+is([numberGame(1,2,2,3)],[2,1,3,2],'Example 3');
+
+done_testing;