Special binary substrings

You are given a binary string. Write a script to return all distinct non-empty substrings that have the same number of 0’s and 1’s, and all the 0’s and all the 1’s in these substrings are grouped consecutively.

Examples

Example 1
Input: $binary = '0101'
Output: ('01', '10')

Example 2
Input: $binary = '000111'
Output: ('000111', '0011', '01')

Example 3
Input: $binary = '000011'
Output:  ('0011', '01')

Example 4
Input: $binary = '10011100'
Output: ('10', '0011', '01', '1100')

Example 5
Input: $binary = '00000'
Output: ()

Analysis

My solution to this is simply to look for the strings '01' and '10' and then '0011' and '1100' and so on until the length of those exceeds the length of the string.

While this is almost instant for a string of thousands of characters, it could be said that using regexes is less efficient than making a single pass along the string, but that seems to me to involve some quite involved logic. So I'm sticking with my solution.

Try it 

#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2026-07-27
use utf8;     # Week 384 - task 2 - Special binary substrings
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

special_binary_substrings('0101');
special_binary_substrings('000111');
special_binary_substrings('000011');
special_binary_substrings('101');
special_binary_substrings('');
special_binary_substrings('1111111');

# longer example
my $z;
$z .= int(rand(2)) for 1 .. 500;
special_binary_substrings($z);

sub special_binary_substrings {
    
    my ($string, $test0, $test1, $result);
    
    # initialise
    $string = shift;
    say qq[\nInput:  '$string'];
    $test0 = $test1 = '';

    # check for 01, 10, 0011, 1100 ...
    while (length($test0) < length($string)) {
        $test0 = '0' . $test0 . '1';
        $test1 = '1' . $test1 . '0';
        $result .= qq['$test0', ] if $string =~ m|$test0|;
        $result .= qq['$test1', ] if $string =~ m|$test1|;
    }

    say qq[Output: ] . ($result ? substr($result, 0, -2) : 'none');
}

11 lines of code

Output from script

Input:  '0101'
Output: '01', '10'

Input:  '000111'
Output: '01', '0011', '000111'

Input:  '000011'
Output: '01', '0011'

Input:  '101'
Output: '01', '10'

Input:  ''
Output: none

Input:  '1111111'
Output: none

Input: 
   '110011110010001100101001011110011101011000011000101100111011010000
   1010101011011111011101011011001000100101000000011100110111000110101
   1000100011100101010101010010001110100010000101101001000101111100100
   1010101101111110001000111001011000100110001001111100001110000011001
   1000101111010000011110000011001001111111011000110001101101011111110
   1001000110111010011011100100011100100011111001010101001000110110001
   0010000010111101111010100011111100101011111110100011011110111010001
   10000100011001101101100001000001'
Output: '01', '10', '0011', '1100', '000111', '111000', '00001111',
   '11110000'