The weekly challenge 384 - Task 2: Special Binary Substrings

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-384/#TASK2
 3 #
 4 # Task 2: Special Binary Substrings
 5 # =================================
 6 #
 7 # You are given a binary string.
 8 #
 9 # Write a script to return all non-empty substrings (distinct) that have the
10 # same number of 0’s and 1’s, and all the 0’s and all the 1’s in these
11 # substrings are grouped consecutively.
12 #
13 ## Example 1
14 ##
15 ## Input: $binary = "0101"
16 ## Output: ("01", "10")
17 #
18 ## Example 2
19 ##
20 ## Input: $binary = "000111"
21 ## Output: ("000111", "0011", "01")
22 #
23 ## Example 3
24 ##
25 ## Input: $binary = "000011"
26 ## Output:  ("0011", "01")
27 #
28 ## Example 4
29 ##
30 ## Input: $binary = "10011100"
31 ## Output: ("10", "0011", "01", "1100")
32 #
33 ## Example 5
34 ##
35 ## Input: $binary = "00000"
36 ## Output: ()
37 #
38 ############################################################
39 ##
40 ## discussion
41 ##
42 ############################################################
43 #
44 # We create all possible substrings of $binary, skip if we find
45 # one we already saw before, and then keep it if it is a special one.
46 # The special binary substrings are of even length, and either start
47 # with all 0s and end with all 1s or vice versa, with an equal
48 # amount of 0s and 1s.
49 
50 use v5.36;
51 
52 special_binary_substrings("0101");
53 special_binary_substrings("000111");
54 special_binary_substrings("000011");
55 special_binary_substrings("10011100");
56 special_binary_substrings("00000");
57 
58 sub special_binary_substrings($binary) {
59     say "Input: \"$binary\"";
60     my @result = ();
61     my $seen = {};
62     my $len = length($binary);
63     foreach my $start (0..$len-1) {
64         foreach my $length (1..$len-$start) {
65             my $str = substr($binary, $start, $length);
66             next if $seen->{$str};
67             if(is_special($str)) {
68                 push @result, $str;
69                 $seen->{$str} = 1;
70             }
71         }
72     }
73     say "Output: (" . join(", ", map {"\"$_\""} @result) . ")";
74 }
75 
76 sub is_special($binary) {
77     return 0 if length($binary) % 2;
78     my $left = substr($binary, 0, length($binary)/2);
79     my $right = substr($binary, length($binary)/2, length($binary)/2);
80     if($left =~ m/^0+$/) {
81         return 1 if $right =~ m/^1+$/;
82     } elsif ($left =~ m/^1+$/) {
83         return 1 if $right =~ m/^0+$/;
84     }
85     return 0;
86 }