RabbitFarm

2024-10-05

Maximum Jumble

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

Part 1: Third Maximum

You are given an array of integers, @ints. Write a script to find the third distinct maximum in the given array. If a third maximum doesn’t exist then return the maximum number.

The majority of the work can be done in a couple of lines. We need only sort the distinct integers in the list and then return either the third largest number or, if none exists, the largest.

⟨sort and return the third largest (or just the largest) 1 ⟩≡


sub third_maximum{
my %h;
do{ $h{$_} = undef } for @_;
my @sorted = sort {$b <=> $a} keys %h;
return $sorted[2] if @sorted >= 3;
return $sorted[0];
}
◇

Fragment referenced in 2.

The rest of the code just tests this function.

"ch-1.pl" 2≡


⟨preamble 3 ⟩
⟨sort and return the third largest (or just the largest) 1 ⟩
⟨main 4 ⟩
◇

⟨preamble 3 ⟩≡


use v5.40;
◇

Fragment referenced in 2, 9.

⟨main 4 ⟩≡


MAIN:{
say third_maximum 5, 6, 4, 1;
say third_maximum 4, 5;
say third_maximum 1, 2, 2, 3;
}
◇

Fragment referenced in 2.

Sample Run
$ perl perl/ch-1.pl 
4 
5 
1

Part 2: Jumbled Letters

Your task is to write a program that takes English text as its input and outputs a jumbled version

The rules for jumbling are given as follows:

  1. The first and last letter of every word must stay the same.
  2. The remaining letters in the word are scrambled in a random order (if that happens to be the original order, that is OK).
  3. Whitespace, punctuation, and capitalization must stay the same.
  4. The order of words does not change, only the letters inside the word.

Looking closer at these rules the main thing we need to concern ourselves with is jumbling the letters with the exception of the first and last. The use of map will ensure the words are processed in order. To make sure the first/last letters are unchanged also depends on detecting punctuation.

Punctuation is determined by a regex. We’ll keep track of the locations so we can add them back later, after jumbling.

⟨strip punctuation 5 ⟩≡


my $stripped = [];
my $punctuation = [];
do{
$punctuation->[$_] = $w->[$_] if $w->[$_] =~ m/[[:punct:]]/;
push @{$stripped}, $w->[$_] if $w->[$_] !~ m/[[:punct:]]/;
} for 0 .. @{$w} - 1;
◇

Fragment referenced in 8.

Defines: $punctuation 7, $stripped 6, 7.

Uses: $w 8.

Now that we have the punctuation accounted for let’s do the jumble. We’ll do this by generating permutations and randomly select one.

⟨permutate the letters 6 ⟩≡


my $p = Algorithm::Permute->new(
[@{$stripped}[1 .. @{$stripped} - 2]]
);
my @p;
if(@{$stripped} > 2){
my @r = $p->next();
{
push @p, [@r];
@r = $p->next();
redo if @r;
}
$stripped = [$stripped->[0] ,
@{$p[rand @p]} ,
$stripped->[@{$stripped} - 1]];
}
$stripped = join q//, @{$stripped};
◇

Fragment referenced in 8.

Uses: $stripped 5.

Finally, add the punctuation back in.

⟨add punctuation back 7 ⟩≡


do{
substr $stripped, $_, 0, $punctuation->[$_]
if $punctuation->[$_];
} for 0 .. @{$punctuation} - 1;
$stripped . q/ /;
◇

Fragment referenced in 8.

Uses: $punctuation 5, $stripped 5.

⟨jumble the list of words 8 ⟩≡


sub jumble{
return map {
my $w = [split //, $_];
⟨strip punctuation 5 ⟩
⟨permutate the letters 6 ⟩
⟨add punctuation back 7 ⟩
} @_;
}
◇

Fragment referenced in 9.

Defines: $w 5.

The rest of the code drives some tests.

"ch-2.pl" 9≡


⟨preamble 3 ⟩
use Algorithm::Permute;
⟨jumble the list of words 8 ⟩
⟨main 10 ⟩
◇

⟨main 10 ⟩≡


MAIN:{
say q/in the ASCII range match all non-controls./;
say jumble qw/in the ASCII range match all non-controls./;
say q//;
say q/This handy module makes performing permutation.../;
say jumble qw/This handy module makes performing permutation.../;
}
◇

Fragment referenced in 9.

Sample Run
$ perl perl/ch-2.pl 
in the ASCII range match all non-controls. 
in the AISCI range macth all non-rloncots. 
 
This handy module makes performing permutation... 
Tihs handy mloude mkaes prifnremog prtaoimetun...

References

The Weekly Challenge 289
Generated Code

posted at: 21:02 by: Adam Russell | path: /perl | permanent link to this entry