Merge pull request #12181 from wanderdoc/master

PWC 324 and 325 (wanderdoc)

4 files changed, 283 insertions, 0 deletions

diff --git a/challenge-324/wanderdoc/perl/ch-1.pl b/challenge-324/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..811938bf32
--- /dev/null
+++ b/challenge-324/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given an array of integers and two integers $r amd $c.
+Write a script to create two dimension array having $r rows and $c columns using the given array.
+
+Example 1
+
+Input: @ints = (1, 2, 3, 4), $r = 2, $c = 2
+Output: ([1, 2], [3, 4])
+
+
+Example 2
+
+Input: @ints = (1, 2, 3), $r = 1, $c = 3
+Output: ([1, 2, 3])
+
+
+Example 3
+
+Input: @ints = (1, 2, 3, 4), $r = 4, $c = 1
+Output: ([1], [2], [3], [4])
+
+=cut
+
+use Test2::V0 -no_srand => 1;
+
+is(my_natatime([1, 2, 3, 4], 2, 2), [[1, 2], [3, 4]], 'Example 1');
+is(my_natatime([1, 2, 3], 1, 3), [[1, 2, 3]], 'Example 2');
+is(my_natatime([1, 2, 3, 4], 4, 1), [[1], [2], [3], [4]], 'Example 3');
+done_testing();
+
+sub my_natatime
+{
+     my ($aref, $r, $c) = @_;
+     die "Rows and columns mismatch!" if ( $r * $c != @$aref );
+     my @output;
+     while ( my @chunk = splice(@$aref, 0, $c) )
+     {
+          push @output, [@chunk];
+     }
+     return \@output;
+}
diff --git a/challenge-324/wanderdoc/perl/ch-2.pl b/challenge-324/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..d38f120936
--- /dev/null
+++ b/challenge-324/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,88 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given an array of integers.
+
+Write a script to return the sum of total XOR for every subset of given array.
+
+Example 1
+
+Input: @ints = (1, 3)
+Output: 6
+
+Subset [1],    total XOR = 1
+Subset [3],    total XOR = 3
+Subset [1, 3], total XOR => 1 XOR 3 => 2
+
+Sum of total XOR => 1 + 3 + 2 => 6
+
+
+Example 2
+
+Input: @ints = (5, 1, 6)
+Output: 28
+
+Subset [5],       total XOR = 5
+Subset [1],       total XOR = 1
+Subset [6],       total XOR = 6
+Subset [5, 1],    total XOR => 5 XOR 1 => 4
+Subset [5, 6],    total XOR => 5 XOR 6 => 3
+Subset [1, 6],    total XOR => 1 XOR 6 => 7
+Subset [5, 1, 6], total XOR => 5 XOR 1 XOR 6 => 2
+
+Sum of total XOR => 5 + 1 + 6 + 4 + 3 + 7 + 2 => 28
+
+
+Example 3
+
+Input: @ints = (3, 4, 5, 6, 7, 8)
+Output: 480
+
+=cut
+
+use Test2::V0 -no_srand => 1;
+
+is(total_xor(1, 3), 6, 'Example 1');
+is(total_xor(5, 1, 6), 28, 'Example 2');
+is(total_xor(3, 4, 5, 6, 7, 8), 480, 'Example 3');
+done_testing();
+
+sub total_xor
+{
+     my $iter = subsets(\@_);
+     my $xor_sum = 0;
+     while (my $p = $iter->()) 
+     {
+          next unless @$p;
+          $xor_sum += eval join('^', @$p);
+     }
+     return $xor_sum;
+}
+
+sub subsets
+{
+    my $aref = $_[0];
+    my $length = scalar @$aref;
+    my $total = 2 ** $length; # Total number of subsets
+    
+    my $current = 0; # Start from the first bitmask
+    
+    return sub 
+    {
+          if ($current >= $total) 
+          {
+               return undef; # All subsets are generated
+          }
+        
+          # Generate the current subset based on the bitmask
+          my $bitmask = sprintf("%0${length}b", $current);
+          my @bits = reverse split(//, $bitmask);
+          my @included = grep { $bits[$_] == 1 } 0 .. $#bits;
+        
+          $current++; # Increment the bitmask
+        
+          return [@{$aref}[@included]]; # Return the subset
+    };
+}
diff --git a/challenge-325/wanderdoc/perl/ch-1.pl b/challenge-325/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..2e46e9d12c
--- /dev/null
+++ b/challenge-325/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a binary array containing only 0 or/and 1.
+Write a script to find out the maximum consecutive 1 in the given array.
+
+Example 1
+
+Input: @binary = (0, 1, 1, 0, 1, 1, 1)
+Output: 3
+
+
+Example 2
+
+Input: @binary = (0, 0, 0, 0)
+Output: 0
+
+
+Example 3
+
+Input: @binary = (1, 0, 1, 0, 1, 1)
+Output: 2
+
+=cut
+
+use Test2::V0 -no_srand => 1;
+is(consecutive_one(0, 1, 1, 0, 1, 1, 1), 3, 'Example 1');
+is(consecutive_one(0, 0, 0, 0), 0, 'Example 2');
+is(consecutive_one(1, 0, 1, 0, 1, 1), 2, 'Example 3');
+done_testing();
+
+sub consecutive_one
+{
+     my @arr = @_;
+     my @output = (0);
+     my $counter = 0;
+     for my $elm ( @arr )
+     {
+          if ( 1 == $elm )
+          {
+               $counter++;
+          }
+          else
+          {
+               push @output, $counter;
+               $counter = 0;
+          }
+     }
+     push @output, $counter; # last element.
+     return (sort { $b <=> $a } @output)[0];
+}
diff --git a/challenge-325/wanderdoc/perl/ch-2.pl b/challenge-325/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..ef9a0ff342
--- /dev/null
+++ b/challenge-325/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given an array of item prices.
+
+Write a script to find out the final price of each items in the given array.
+
+There is a special discount scheme going on. If there’s an item with a lower or equal price later in the list, you get a discount equal to that later price (the first one you find in order).
+
+Example 1
+
+Input: @prices = (8, 4, 6, 2, 3)
+Output: (4, 2, 4, 2, 3)
+
+Item 0:
+The item price is 8.
+The first time that has price <= current item price is 4.
+Final price = 8 - 4 => 4
+
+Item 1:
+The item price is 4.
+The first time that has price <= current item price is 2.
+Final price = 4 - 2 => 2
+
+Item 2:
+The item price is 6.
+The first time that has price <= current item price is 2.
+Final price = 6 - 2 => 4
+
+Item 3:
+The item price is 2.
+No item has price <= current item price, no discount.
+Final price = 2
+
+Item 4:
+The item price is 3.
+Since it is the last item, so no discount.
+Final price = 3
+
+
+Example 2
+
+Input: @prices = (1, 2, 3, 4, 5)
+Output: (1, 2, 3, 4, 5)
+
+
+Example 3
+
+Input: @prices = (7, 1, 1, 5)
+Output: (6, 0, 1, 5)
+
+Item 0:
+The item price is 7.
+The first time that has price <= current item price is 1.
+Final price = 7 - 1 => 6
+
+Item 1:
+The item price is 1.
+The first time that has price <= current item price is 1.
+Final price = 1 - 1 => 0
+
+Item 2:
+The item price is 1.
+No item has price <= current item price, so no discount.
+Final price = 1
+
+Item 3:
+The item price is 5.
+Since it is the last item, so no discount.
+Final price = 5
+
+=cut
+
+
+
+use List::Util qw(first);
+use Test2::V0 -no_srand => 1;
+
+is(final_price(8, 4, 6, 2, 3), [4, 2, 4, 2, 3], 'Example 1');
+is(final_price(1, 2, 3, 4, 5), [1, 2, 3, 4, 5], 'Example 2');
+is(final_price(7, 1, 1, 5), [6, 0, 1, 5], 'Example 3');
+done_testing();
+
+sub final_price
+{
+     my @arr = @_;
+     my @output;
+
+     for my $idx ( 0 .. $#arr )
+     {
+          my $cand = (first{ $arr[$_] <= $arr[$idx]} $idx + 1 .. $#arr) // $idx;
+          push @output, $idx == $cand ? $arr[$idx] : $arr[$idx] - $arr[$cand];
+     }
+     return [@output];
+}