RabbitFarm

2025-07-06

A Good String Is Irreplaceable

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

Part 1: Replace all ?

You are given a string containing only lower case English letters and ?. Write a script to replace all ? in the given string so that the string doesn’t contain consecutive repeating characters.

The core of the solution is contained in a single subroutine. The resulting code can be contained in a single file.

"ch-1.pl" 1≡


use v5.40;
⟨replace all ?s 2 ⟩
⟨main 4 ⟩
◇

The approach we take is to randomly select a new letter and test to make sure that it does not match the preceding or succeeding letter.

⟨replace all ?s 2 ⟩≡


sub replace_all{
my($s) = @_;
my @s = split //, $s;
my @r = ();
{
my $c = shift @s;
my $before = pop @r;
my $after = shift @s;
my $replace;
if($c eq q/?/){
⟨replace 3 ⟩
push @r, $before, $replace if $before;
push @r, $replace if !$before;
}
else{
push @r, $before, $c if $before;
push @r, $c if !$before;
}
unshift @s, $after if $after;
redo if $after;
}
return join q//, @r;
}
◇

Fragment referenced in 1.

Defines: $after 3, $before 3, $replace 3.

Finding the replacement is done in a loop that repeatedly tries to find a relacement that does not match the preceding or following character. Since the number of potential conflicts is so small this will not (most likely require many iterations.

⟨replace 3 ⟩≡


do{
$replace = chr(int(97 + rand(123 - 97)));
$replace = undef if $before && $replace eq $before;
$replace = undef if $after && $replace eq $after;
} while(!$replace);
◇

Fragment referenced in 2.

Uses: $after 2, $before 2, $replace 2.

Just to make sure things work as expected we’ll define a few short tests.

⟨main 4 ⟩≡


MAIN:{
say replace_all q/a?z/;
say replace_all q/pe?k/;
say replace_all q/gra?te/;
}
◇

Fragment referenced in 1.

Sample Run
$ perl perl/ch-1.pl 
atz 
peck 
graqte

Part 2: Good String

You are given a string made up of lower and upper case English letters only. Write a script to return the good string of the given string. A string is called good string if it doesn’t have two adjacent same characters, one in upper case and other is lower case.

We’ll define a subroutine for detecting and returning non-good pairs of letters. We know we’re done when this subroutine returns undef.

"ch-2.pl" 5≡


use v5.40;
⟨bad pairs 6 ⟩
⟨make good 7 ⟩
⟨main 8 ⟩
◇

We’ll call these pairs of letters bad pairs. To see if we have a matching pair we’ll just compare the ascii values.

⟨bad pairs 6 ⟩≡


sub bad_pair{
my($s) = @_;
my @s = split q//, $s;
return undef if !@s;
{
my($x, $y) = (ord shift @s, ord shift @s);
if($x == $y + 32 || $x == $y - 32){
return chr($x) . chr($y);
}
unshift @s, chr($y);
redo unless @s == 1;
}
return undef;
}
◇

Fragment referenced in 5.

We use that bad_pair subroutine repeatedly in a loop until all bad pairs are removed.

⟨make good 7 ⟩≡


sub make_good{
my($s) = @_;
{
my $bad_pair = bad_pair $s;
$s =~ s/$bad_pair// if $bad_pair;
redo if bad_pair $s;
}
return $s;
}
◇

Fragment referenced in 5.

The main section is just some basic tests.

⟨main 8 ⟩≡


MAIN:{
say make_good q/WeEeekly/;
say make_good q/abBAdD/;
say make_good q/abc/;
}
◇

Fragment referenced in 5.

Sample Run
$ perl perl/ch-2.pl 
Weekly 
 
abc

References

The Weekly Challenge 328
Generated Code

posted at: 17:39 by: Adam Russell | path: /perl | permanent link to this entry