RabbitFarm

2023-07-23

Shuffled Operations

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

Part 1

You are given a string and an array of indices of same length as string. Write a script to return the string after re-arranging the indices in the correct order.

Solution


use v5.38;
sub shuffle_string{
    my($s, $indices) = @_;
    my @s = split(//, $s);
    my @t;
    do { $t[$_] = shift @s } for @{$indices};
    return join(q//, @t);
}

MAIN:{
    say shuffle_string(q/lacelengh/, [3, 2, 0, 5, 4, 8, 6, 7, 1]);
    say shuffle_string(q/rulepark/, [4, 7, 3, 1, 0, 5, 2, 6]);
}

Sample Run


$ perl perl/ch-1.pl 
challenge
perlraku

Notes

I had to think of this one a bit! What we need to do is take each letter, from left to right, and assign it a new position. It's not often you see a shift within another loop but here that is the key to getting everything working.

Part 2

You are given an array of non-negative integers, @ints. Write a script to return the minimum number of operations to make every element equal zero.

Solution


use v5.38;
sub zero_array{
    my $operations = 0;
    do{
        return $operations if 0 == unpack(q/%32I*/, pack(q/I*/, @_));
        my $minimum = (sort { $a <=> $b } grep { $_ > 0 } @_)[0];
        @_ = map { $_ > 0 ? $_ - $minimum : 0 } @_; 
        $operations++;
    } for @_;
}

MAIN:{
    say zero_array 1, 5, 0, 3, 5;
    say zero_array 0;
    say zero_array 2, 1, 4, 0, 3
}

Sample Run


$ perl perl/ch-2.pl 
3
0
4

Notes

Usually I assign function arguments new names, even if I am just passing in a single array of values like in this example. I decided this time to not do it, I don't think readability is sacrificed. Provided the reader actually knows what @_ is I think for a short function such as this it's fine. In fact, I think an argument could be made that readability is actually enhanced since lines such as the one with both a sort and a grep are kept to a shorter length.

References

Challenge 226

posted at: 20:55 by: Adam Russell | path: /perl | permanent link to this entry