RabbitFarm

2025-05-18

Back to a Unique Evaluation

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

Part 1: Distinct Average

You are given an array of numbers with even length. Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.

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

"ch-1.pl" 1≡


⟨preamble 2 ⟩
⟨distinct average calculation 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, 8.

the main section is just some basic tests.

⟨main 3 ⟩≡


MAIN:{
say distinct_average 1, 2, 4, 3, 5, 6;
say distinct_average 0, 2, 4, 8, 3, 5;
say distinct_average 7, 3, 1, 0, 5, 9;
}
◇

Fragment referenced in 1.

All the work is done in the following subroutine. This problem is straightforward enough to not require much more code than this.

To describe the details of this subroutine sections of it are separated out into their own code sections.

⟨distinct average calculation 4 ⟩≡


sub distinct_average{
my @numbers = ⟨sort the given numbers in ascending order 5 ⟩
my %averages;
⟨loop over the sorted numbers, compute and track the averages 6 ⟩
return 0 + keys %averages;
}
◇

Fragment referenced in 1.

Defines: %averages Never used, @numbers 6, @_ 5.

⟨sort the given numbers in ascending order 5 ⟩≡


sort {$a <=> $b} @_;
◇

Fragment referenced in 4.

Uses: @_ 4.

⟨loop over the sorted numbers, compute and track the averages 6 ⟩≡


for my $i (0 .. (@numbers / 2)){
my($x, $y) = ($numbers[$i], $numbers[@numbers - 1 - $i]);
$averages{⟨average computed to 7 decimal place 7 ⟩} = undef;
}
◇

Fragment referenced in 4.

Defines: $x 7, $y 7.

Uses: @numbers 4.

⟨average computed to 7 decimal place 7 ⟩≡


sprintf(q/%0.7f/, (($x + $y)/2))
◇

Fragment referenced in 6.

Uses: $x 6, $y 6.

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

Part 2: Backspace Compare

You are given two strings containing zero or more #. Write a script to return true if the two given strings are same by treating # as backspace.

Our solution will have the following structure.

"ch-2.pl" 8≡


⟨preamble 2 ⟩
⟨process strings  10 ⟩
⟨main 9 ⟩
◇

The main section is just some basic tests.

⟨main 9 ⟩≡


MAIN:{
say backspace_compare q/ab#c/, q/ad#c/;
say backspace_compare q/ab##/, q/a#b#/;
say backspace_compare q/a#b/, q/c/;
}
◇

Fragment referenced in 8.

The approach is to maintain two arrays (think of them as stacks), one for each string. As we process each string we will push a character onto the stack as each non-# character is encountered. We’ll pop a character from the stack for every # encountered. When both strings have been processed we’ll compare the two resulting stacks. This code seems to be well contained in a single subroutine.

⟨process strings  10 ⟩≡


sub backspace_compare{
my($s, $t) = @_;
my @s = split //, $s;
my @t = split //, $t;
my @u = ();
my @v = ();
{
my $s_ = shift @s || undef;
my $t_ = shift @t || undef;
push @u, $s_ if $s_ && $s_ ne q/#/;
push @v, $t_ if $t_ && $t_ ne q/#/;
pop @u if $s_ && $s_ eq q/#/;
pop @v if $t_ && $t_ eq q/#/;
redo if @s || @t;
}
return join(q//, @u) eq join(q//, @v)?q/true/:q/false/;
}
◇

Fragment referenced in 8.

Sample Run
$ perl perl/ch-2.pl 
true 
true 
false

References

The Weekly Challenge 321
Generated Code

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