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.

"ch-1.pl" 1


use GD;
use JSON;
use OCR::OcrSpace;
write text to image 3
ocr image 4
main 5

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.

replace all non-digit characters with a space 2 ⟩≡


$s =~ tr/a-z/ /;

Fragment referenced in 4.

Uses: $s 4.

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.

write text to image 3 ⟩≡


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;
}

Fragment referenced in 1.

Uses: $s 4.

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.

ocr image 4 ⟩≡


sub counter_integers{
my($s) = @_;
my @numbers;
replace all non-digit characters with a space 2
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;
}

Fragment referenced in 1.

Defines: $s 2, 3.

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

main 5 ⟩≡


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.

"ch-2.pl" 6


use v5.40;
is_nice 7
nice substring 8
main 9

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.

is_nice 7 ⟩≡


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.

nice substring 8 ⟩≡


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 9 ⟩≡


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

OCR API Service
The Weekly Challenge 329
Generated Code

posted at: 16:54 by: Adam Russell | path: /perl | permanent link to this entry