RabbitFarm
2025-07-13
Let’s Count All of Our Nice Strings
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1: Counter Integers
You are given a string containing only lower case English letters and digits. Write a script to replace every non-digit character with a space and then return all the distinct integers left.
The code can be contained in a single file which has the following structure. The different code sections are explained in detail later.
We don’t really need to do the replacement with spaces since we could just use a regex to get the numbers or even just iterate over the string character by character. Still though, in the spirit of fun we’ll do it anyway.
Ok, sure, now we have a string with spaces and numbers. Now we have to use a regex (maybe with split, or maybe not) or loop over the string anyway to get the numbers. But we could have just done that from the beginning!Well, let’s force ourselves to do something which makes use of our converted string. We are going to write the new string with spaces and numbers to a PNG image file. Later we are going to OCR the results.
The image will be 500x500 and be black text on a white background for ease of character recognition. This fixed size is fine for the examples, more complex examples would require dynamic sizing of the image. The font choice is somewhat arbitrary, although intuitively a fixed width font like Courier should be easier to OCR.
The file paths used here are for my system, MacOS 15.4.
-
sub write_image{
my($s) = @_;
my $width = 500;
my $height = 500;
my $image_file = q#/tmp/output_image.png#;
my $image = GD::Image->new($width, $height);
my $white = $image->colorAllocate(255, 255, 255);
my $black = $image->colorAllocate(0, 0, 0);
$image->filledRectangle(0, 0, $width - 1, $height - 1, $white);
my $font_path = q#/System/Library/Fonts/Courier.ttc#;
my $font_size = 14;
$image->stringFT($black, $font_path, $font_size, 0, 10, 50, $s);
open TEMP, q/>/, qq/$image_file/;
binmode TEMP;
print TEMP $image->png;
close TEMP;
return $image_file;
}
◇
This second subroutine will handle the OCRing of the image. It’ll also be the main subroutine we call which produces the final result.
After experimenting with tesseract and other open source OCR options it seemed far easier to make use of a hosted service. OCR::OcrSpace is a module ready made for interacting with OcrSpace, an OCR solution provider that offers a free tier of service suitable for our needs. Registration is required in order to obtain an API key.
-
sub counter_integers{
my($s) = @_;
my @numbers;
my $image = write_image($s);
my $ocrspace = OCR::OcrSpace->new();
my $ocrspace_parameters = { file => qq/$image/,
apikey => q/XXXXXXX/,
filetype => q/PNG/,
scale => q/True/,
isOverlayRequired => q/True/,
OCREngine => 2};
my $result = $ocrspace->get_result($ocrspace_parameters);
$result = decode_json($result);
my $lines = $result->{ParsedResults}[0]
->{TextOverlay}
->{Lines};
for my $line (@{$lines}){
for my $word (@{$line->{Words}}){
push @numbers, $word->{WordText};
}
}
return join q/, /, @numbers;
}
◇
Just to make sure things work as expected we’ll define a few short tests.
-
MAIN:{
print counter_integers q/the1weekly2challenge2/;
print qq/\n/;
print counter_integers q/go21od1lu5c7k/;
print qq/\n/;
print counter_integers q/4p3e2r1l/;
print qq/\n/;
}
◇
-
Fragment referenced in 1.
Sample Run
$ perl perl/ch-1.pl 1, 2, 2 21, 1, 5, 7 4, 3, 2, 1
Part 2: Nice String
You are given a string made up of lower and upper case English letters only. Write a script to return the longest substring of the give string which is nice. A string is nice if, for every letter of the alphabet that the string contains, it appears both in uppercase and lowercase.
We’ll do this in two subroutines: one for confirming if a substring is nice, and another for generating substrings.
This subroutine examines each letter and sets a hash value for both upper and lower case versions of the letter as they are seen. We return true if all letters have both an upper and lower case version.
-
sub is_nice{
my ($s) = @_;
my %seen;
for my $c (split //, $s){
if($c =~ m/[a-z]/) {
$seen{$c}{lower} = 1;
}
elsif($c =~ m/[A-Z]/) {
$seen{lc($c)}{upper} = 1;
}
}
for my $c (keys %seen){
return 0 unless exists $seen{$c}{lower} &&
exists $seen{$c}{upper};
}
return 1;
}
◇
-
Fragment referenced in 6.
Here we just generate all substrings in a nested loop.
-
sub nice_substring{
my ($s) = @_;
my $n = length($s);
my $longest = q//;
for my $i (0 .. $n - 1) {
for my $j ($i + 1 .. $n) {
my $substring = substr($s, $i, $j - $i);
if (is_nice($substring) &&
length($substring) > length($longest)){
$longest = $substring;
}
}
}
return $longest;
}
◇
-
Fragment referenced in 6.
The main section is just some basic tests.
-
MAIN:{
say nice_substring q/YaaAho/;
say nice_substring q/cC/;
say nice_substring q/A/;
}
◇
-
Fragment referenced in 6.
Sample Run
$ perl perl/ch-2.pl Weekly abc
References
posted at: 16:54 by: Adam Russell | path: /perl | permanent link to this entry