RabbitFarm

2025-05-25

Ordered Format Array

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

Part 1: String Format

You are given a string and a positive integer. Write a script to format the string, removing any dashes, in groups of size given by the integer. The first group can be smaller than the integer but should have at least one character. Groups should be separated by dashes.

Our solution will be pretty short, contained in just a single file that has the following structure.

"ch-1.pl" 1≡


⟨preamble 2 ⟩
⟨process string as a list of characters 4 ⟩
⟨main 3 ⟩
◇

The preamble is just whatever we need to include. Here we aren’t using anything special, just specifying the latest Perl version.

⟨preamble 2 ⟩≡


use v5.40;
◇

Fragment referenced in 1, 5.

the main section is just some basic tests.

⟨main 3 ⟩≡


MAIN:{
say string_format q/ABC-D-E-F/, 3;
say string_format q/A-BC-D-E/, 2;
say string_format q/-A-B-CD-E/, 4;
}
◇

Fragment referenced in 1.

The approach is to maintain an array of arrays, with each sub-array being a new group of letters of the given size. We’ll process the string from right to left. This code seems to be well contained in a single subroutine. This sort of “stack processing” is straightforward enough to not require a lot of extra explanation.

⟨process string as a list of characters 4 ⟩≡


sub string_format{
my($s, $i) = @_;
my @s = split //, $s;
my @t = ([]);
{
my $s_ = pop @s;
unless($s_ eq q/-/){
my $t_ = shift @t;
if(@{$t_} == $i){
unshift @t, $t_;
unshift @t, [$s_];
}
else{
unshift @{$t_}, $s_;
unshift @t, $t_;
}
}
redo if @s;
}
return join(q/-/, map {join q//, @{$_}} @t);
}
◇

Fragment referenced in 1.

Sample Run
$ perl perl/ch-1.pl 
ABC-DEF 
A-BC-DE 
A-BCDE

Part 2: Rank Array

You are given an array of integers. Write a script to return an array of the ranks of each element:the lowest value has rank 1, next lowest rank 2, etc. If two elements are the same then they share the same rank.

Our solution will have the following structure.

"ch-2.pl" 5≡


⟨preamble 2 ⟩
⟨number larger 9 ⟩
⟨rank the elements in a list 7 ⟩
⟨main 6 ⟩
◇

The main section is just some basic tests.

⟨main 6 ⟩≡


MAIN:{
say q/(/ . join(q/, /, (rank_array 55, 22, 44, 33)) . q/)/;
say q/(/ . join(q/, /, (rank_array 10, 10, 10)) . q/)/;
say q/(/ . join(q/, /, (rank_array 5, 1, 1, 4, 3)) . q/)/;
}
◇

Fragment referenced in 5.

Just for fun, no sort will be used to solve this problem! What we will do instead is define a subroutine to return the number of unique elements larger than a given number. The fun comes at a cost! This is an O(n2) method.

⟨rank the elements in a list 7 ⟩≡


sub rank_array{
my(@i) = @_;
my %h;
my @unique = ();
⟨determine unique values from the given array of integers 8 ⟩
@unique = keys %h;
return map {number_larger $_, [@unique]} @i;
}
◇

Fragment referenced in 5.

We use a hash to determine the unique values in the given array

⟨determine unique values from the given array of integers 8 ⟩≡


do{$h{$_} = undef} for @i;
◇

Fragment referenced in 7.

Here’s where we compute how many unique numbers are larger than any given one

⟨number larger 9 ⟩≡


sub number_larger{
my($x, $unique) = @_;
return @{$unique} - grep {$_ > $x} @{$unique};
}
◇

Fragment referenced in 5.

Sample Run
$ perl perl/ch-2.pl 
(4, 1, 3, 2) 
(1, 1, 1) 
(4, 1, 1, 3, 2)

References

The Weekly Challenge 322
Generated Code

posted at: 10:27 by: Adam Russell | path: /perl | permanent link to this entry