Perl Weekly Challenge: Week 325

Challenge 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

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

The initial idea I came up with, the naive way to do this, was to iterate through @binary keeping a running count of how many 1's encountered successively and a maximum count holding the length of the longest run of 1's. But there is I think a more efficient way. This is the Perl version of my solution.

The binary array is taken from command-line arguments and concatenated into a string with join(). Runs of consecutive 1's are found with a regular expression and then sort()ed from shortest to longest. To force list context, the sorted groups are wrapped in [] which actually gives an array reference. The [-1] element of the list is the last one and contains the longest consecutive run. The length of it is found with length() and printed with say(). There is one complication; this wont work if there were no groups of 1's as in example 2. In that case || 0 causes 0 to be printed.

$_ = join q{}, @ARGV; say length [sort /([1]+)/g]->[-1] || 0;

(Full code on Github.)

The Raku version is also a one-liner. $/ (I should have used @/ for clarity but they are both the same.) contains the number of matches found by a regular expression match. It is a Sequence not an array so we have to use the .tail() method instead of an array subscript to get the last element. An additional complication is that if no runs were found, $/ will contain the value Nil and then .chars() to measure the length won't work. The solution is to have || q{} to give an empty string in that case. The empty string has a length of 0 which is exactly what we want to output.

@*ARGS.join ~~ m:g/(<[1]>+)/; say ($/.sort.tail || q{}).chars

(Full code on Github.)

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

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

It's pretty straightforward.

We declare an array to hold the result.

my @result;

Then for each price...

for 0 ..^ @prices.elems -> $i {

...we set the discount to 0.

    my $discount = 0;

...Then we go through all of the prices after this one.

    for $i + 1 ..^ @prices.elems -> $j {

If any of them are less than or equal to the current price...

        if @prices[$j] <= @prices[$i] {

...we make that the discount value and exit the inner loop.

            $discount = @prices[$j];
            last;
        }
    }

The discount is applied to the current price (could be 0 if no lower prices were found) and the result is added to @result.

    @result.push(@prices[$i] - $discount);

Then we move on to the next price.

}

When all prices have been processed and discounts applied, we print out @result in the style of the spec.

say q{(}, @result.join(q{, }), q{)};

(Full code on Github.)

This is the Perl version which is the same barring syntactical differences.

my @result;

for my $i (0 .. scalar @prices - 1) {
    my $discount = 0;
    for my $j ($i + 1 .. scalar @prices - 1) {
        if ($prices[$j] <= $prices[$i]) {
            $discount = $prices[$j];
            last;
        }
    }
    push @result, $prices[$i] - $discount;
}

say q{(}, (join q{, }, @result ), q{)};

(Full code on Github.)