RabbitFarm

2025-06-12

Consecutive Search for Discount Prices

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1: Consecutive One

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.

The core of the solution is contained in a main loop. The resulting code can be contained in a single file.

"ch-1.pl" 1≡


use v5.40;
⟨recursively count consecutive ones 3 ⟩
⟨find the longest consecutive sequence of ones 2 ⟩
⟨main 4 ⟩
◇

We’ll use a recursive procedure, which we’ll call from a subroutine which sets up some variables. We’ll pass scalar references to a recursive subroutine. When the recursion completes the $max_consecutive variable will hold the final answer.

⟨find the longest consecutive sequence of ones 2 ⟩≡


sub consecutive_one{
my(@i) = @_;
my($consecutive, $max_consecutive) = (0, 0);
consecutive_one_r(\@i, \$consecutive, \$max_consecutive);
return $max_consecutive;
}
◇

Fragment referenced in 1.

Defines: $consecutive 3, $max_consecutive 3.

Now, let’s define our recursion. We’ll terminate the recursion when we’ve exhausted the input array.

⟨recursively count consecutive ones 3 ⟩≡


sub consecutive_one_r{
my($i, $consecutive, $max_consecutive) = @_;
my $x;
unless(@{$i} == 0){
$x = pop @{$i};
if($x == 0){
$$max_consecutive = $$consecutive if $$consecutive > $$max_consecutive;
$$consecutive = 0;
}
if($x == 1){
$$consecutive++;
}
consecutive_one_r($i, $consecutive, $max_consecutive);
}
elsif(@{$i} == 1){
$x = pop @{$i};
if($x == 0){
$$max_consecutive = $$consecutive if $$consecutive > $$max_consecutive;
}
if($x == 1){
$$consecutive++;
$$max_consecutive = $$consecutive if $$consecutive > $$max_consecutive;
}
consecutive_one_r($i, $consecutive, $max_consecutive);
}
}
◇

Fragment referenced in 1.

Uses: $consecutive 2, $max_consecutive 2.

Just to make sure things work as expected we’ll define a few short tests. The double chop is just a lazy way to make sure there aren’t any trailing commas in the output.

⟨main 4 ⟩≡


MAIN:{
say consecutive_one(0, 1, 1, 0, 1, 1, 1);
say consecutive_one(0, 0, 0, 0);
say consecutive_one(1, 0, 1, 0, 1, 1);
}
◇

Fragment referenced in 1.

Sample Run
$ perl perl/ch-1.pl 
3 
0 
2

Part 2: Final Price

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).

Hey, let’s use recursion again for this too!

"ch-2.pl" 5≡


use v5.40;
⟨search for lower price 7 ⟩
⟨calculate lowest prices 8 ⟩
⟨main 6 ⟩
◇

The main section is just some basic tests.

⟨main 6 ⟩≡


MAIN:{
say join q/, /, calculate_lowest_prices 8, 4, 6, 2, 3;
say join q/, /, calculate_lowest_prices 1, 2, 3, 4, 5;
say join q/, /, calculate_lowest_prices 7, 1, 1, 5;
}
◇

Fragment referenced in 5.

First, let’s introduce a recursive subroutine that scans ahead and finds the next lowest price in the list. As in part one we’ll use a scalar reference.

⟨search for lower price 7 ⟩≡


sub search_lower{
my($prices, $price, $lower) = @_;
if(@{$prices} > 0){
my $next_price = shift @{$prices};
search_lower($prices, $price, $lower) unless $next_price <= $price;
$$lower = $next_price if $next_price <= $price;
}
}
◇

Fragment referenced in 5.

Uses: $lower 8.

With that subroutine defined we can use it to solve the main task at hand.

⟨calculate lowest prices 8 ⟩≡


sub calculate_lowest_prices{
my @prices = @_;
my @lowest = ();
for my $i (0 .. @prices - 1){
my $lower = 0;
search_lower [@prices[$i + 1 .. @prices - 1]], $prices[$i], \$lower;
push @lowest, $prices[$i] - $lower;
}
return @lowest;
}
◇

Fragment referenced in 5.

Defines: $lower 7.

Sample Run
$ perl perl/ch-2.pl 
4, 2, 4, 2, 3 
1, 2, 3, 4, 5 
6, 0, 1, 5

References

The Weekly Challenge 325
Generated Code

posted at: 22:13 by: Adam Russell | path: /perl | permanent link to this entry