Peter’s blog ✴ Week 342 ✴ 6 October 2025

THE WEEKLY CHALLENGE
Fun with characters

The Perl Camel

Task 2

Max score

You are given a string, $str, containing 0 and 1 only. Write a script to return the max score after splitting the string into two non-empty substrings. The score after splitting a string is the number of zeros in the left substring plus the number of ones in the right substring.

Examples


Example 1
Input: $str = '0011'
Output: 4
1: left = '0', right = '011' => 1 + 2 => 3
2: left = '00', right = '11' => 2 + 2 => 4
3: left = '001', right = '1' => 2 + 1 => 3

Example 2
Input: $str = '0000'
Output: 3
1: left = '0', right = '000' => 1 + 0 => 1
2: left = '00', right = '00' => 2 + 0 => 2
3: left = '000', right = '0' => 3 + 0 => 3

Example 3
Input: $str = '1111'
Output: 3
1: left = '1', right = '111' => 0 + 3 => 3
2: left = '11', right = '11' => 0 + 2 => 2
3: left = '111', right = '1' => 0 + 1 => 1

Example 4
Input: $str = '0101'
Output: 3
1: left = '0', right = '101' => 1 + 2 => 3
2: left = '01', right = '01' => 1 + 1 => 2
3: left = '010', right = '1' => 2 + 1 => 3

Example 5
Input: $str = '011101'
Output: 5
1: left = '0', right = '11101' => 1 + 4 => 5
2: left = '01', right = '1101' => 1 + 3 => 4
3: left = '011', right = '101' => 1 + 2 => 3
4: left = '0111', right = '01' => 1 + 1 => 2
5: left = '01110', right = '1' => 2 + 1 => 3

Analysis

My solution is as follows.

Suppose the division point is before the first character in $string - which is not allowed as an answer, but bear with me. All the characters are now in the right-hand substring, where a '1' scores 1, so the score is the count of 1s in $string - or equivalently just the sum of all characters in the string.

Now move the division point repeatedly one character to the right. If the character stepped over is a '1', the score drops by 1 because there is one fewer '1' in the right hand string. If it's a '0' the score increases by 1, because there's now an additional '0' in the left hand string.

And I do that until the division point gets to one character before the end of the string, at each step checking to see if the score is the best so far.

Note that I only examine each character in the string twice, regardless of the length of the string. For a long string, this will be much faster than evaluating the score from scratch at each division point.

Again, for brevity, I have assumed that the initial $string meets the definition in the challenge: ie it contains only '1' and '0' and is at least 2 characters long (because the substrings are stated to be non-empty).

Perl Weekly’s review

from PW issue 742

This is an example of clear, effective and useful Perl programming. The solutions are simple, understandable and free of needless complexity, making them prime examples of the "get it done right" philosophy. Peter focuses on writing maintainable code and exhibits a solid command of Perl idioms.

This review may cover either or both challenges for this week.

Try it 

Try running the script with any input:



example: 00110101100

Script


#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge/342/2

use v5.26;    # The Weekly Challenge - 2025-10-06
use utf8;     # Week 342 - task 2 - Max score
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

max_score('0011');
max_score('0000');
max_score('1111');
max_score('011101');
max_score('10');

my $string;
$string .= int(rand(2)) for 0..99;
max_score($string);

sub max_score {
    
    my ($string, @numbers, $score, $best, $j, $explain);
    
    # initialise
    $string = shift;
    @numbers = split('', $string);
    $best = -1;
    
    # count all the 1s
    $score += $_ for @numbers;
    
    # move the boundary steadily right, adjusting the score
    for $j (0 .. length($string) - 2) {
        $score += $numbers[$j] == 1 ? -1 : 1;
        
        # check if this is the best
        next unless $score > $best;
        $best = $score;
        $explain = substr($string, 0, $j + 1) . '~' . substr($string, $j + 1);
    }
    
    # report
    say qq[\nInput:  '$string'];
    say qq[Output: $best: $explain];
}

13 lines of code

Output from script


Input:  '0011'
Output: 4: 00~11

Input:  '0000'
Output: 3: 000~0

Input:  '1111'
Output: 3: 1~111

Input:  '011101'
Output: 5: 0~11101

Input:  '10'
Output: 0: 1~0

Input: 
   '000000001011100101011110010101100100001000001111110001001001110000
   1110000011000000100101110000010001'
Output: 62:
   0000000010111001010111100101011001000010000011111100010010011100001
   11000001100000010010111000001000~1

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain