Perl Weekly Challenge 325.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 325.
Task 1: Consecutive One
Submitted by: Mohammad Sajid Anwar
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
I just need to keep a pair of variables, the current number of consecutive 1’s and the maximum so far, which yields the result. The results fits a oneliner.
Example 1:
perl -E '
$c=$m=0; for(@ARGV){($_&&++$c)||($c=0);($m<$c)&&($m=$c)}say "@ARGV -> $m"
' 0 1 1 0 1 1 1
Results:
0 1 1 0 1 1 1 -> 3
Example 2:
perl -E '
$c=$m=0; for(@ARGV){($_&&++$c)||($c=0);($m<$c)&&($m=$c)}say "@ARGV -> $m"
' 0 0 0 0
Results:
0 0 0 0 -> 0
Example 3:
perl -E '
$c=$m=0; for(@ARGV){($_&&++$c)||($c=0);($m<$c)&&($m=$c)}say "@ARGV -> $m"
' 1 0 1 0 1 1
Results:
1 0 1 0 1 1 -> 2
The full code is
1 # Perl weekly challenge 325
2 # Task 1: Consecutive One
3 #
4 # See https://wlmb.github.io/2025/06/09/PWC325/#task-1-consecutive-one
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 B1 B2...
8 to find the largest run of 1's among the bits B1 B2...
9 FIN
10 my $current=0;
11 my $max=0;
12 for(@ARGV){
13 $current=0, next if $_==0;
14 ++$current, ($max<$current)&&($max=$current), next if $_==1;
15 die "Only 0's and 1's allowed: $_";
16 }
17 say "@ARGV -> $max";
Examples:
./ch-1.pl 0 1 1 0 1 1 1
./ch-1.pl 0 0 0 0
./ch-1.pl 1 0 1 0 1 1
Task 2: Final Price
Submitted by: Mohammad Sajid Anwar
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
I do a simple double iteration over the indices of the array. I apply the discount and finish the inner iteration as soon as possible. This yields a simple solution, altohugh it has an N² performance in the worst case. The result fits a oneliner.
perl -E '
@c=@ARGV;for(0..@c-1){for my $j($_+1..@c-1){$d=$c[$_]-$c[$j]; $c[$_]=$d,last if $d>=0}} say "@ARGV -> @c"
' 8 4 6 2 3
Example 1:
perl -E '
@c=@ARGV;for(0..@c-1){for my $j($_+1..@c-1){$d=$c[$_]-$c[$j]; $c[$_]=$d,last if $d>=0}} say "@ARGV -> @c"
' 8 4 6 2 3
Results:
8 4 6 2 3 -> 4 2 4 2 3
Example 2:
perl -E '
@c=@ARGV;for(0..@c-1){for my $j($_+1..@c-1){$d=$c[$_]-$c[$j]; $c[$_]=$d,last if $d>=0}} say "@ARGV -> @c"
' 1 2 3 4 5
Results:
1 2 3 4 5 -> 1 2 3 4 5
Example 3:
perl -E '
@c=@ARGV;for(0..@c-1){for my $j($_+1..@c-1){$d=$c[$_]-$c[$j]; $c[$_]=$d,last if $d>=0}} say "@ARGV -> @c"
' 7 1 1 5
Results:
6 0 1 5 -> 6 0 1 5
The full code is:
1 # Perl weekly challenge 325
2 # Task 2: Final Price
3 #
4 # See https://wlmb.github.io/2025/06/09/PWC325/#task-2-final-price
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 P1 P2...
8 to apply discount to prices P1 P2...
9 A discount consists of subtracting from Pn the next possible Pm.
10 FIN
11 my @results=@ARGV;
12 for(0..@results-1){
13 for my $j($_+1..@results-1){
14 my $discounted=$results[$_]-$results[$j];
15 $results[$_]=$discounted,last if $discounted>=0;
16 }
17 }
18 say "@ARGV -> @results"
Examples:
./ch-2.pl 8 4 6 2 3
./ch-2.pl 1 2 3 4 5
./ch-2.pl 7 1 1 5
Results:
8 4 6 2 3 -> 4 2 4 2 3
1 2 3 4 5 -> 1 2 3 4 5
7 1 1 5 -> 6 0 1 5
/;
Written on June 9, 2025