Peter’s blog ✴ Week 304 ✴ 13 January 2025

THE WEEKLY CHALLENGE
Adding ones and maxing the mean

The Perl Camel

Task 1

Arrange binary

You are given a list of binary digits (0 and 1) and a positive integer, $n. Write a script to return true if you can modify the list by replacing at least $n digits with 1s so that no two consecutive digits are 1, and otherwise return false.

Examples


Example 1
Input: @digits = (1, 0, 0, 0, 1), $n = 1
Output: true
Re-arranged list: (1, 0, 1, 0, 1)

Example 2
Input: @digits = (1, 0, 0, 0, 1), $n = 2
Output: false

Analysis

There are 3 cases where we can change a 0 to a 1:

  • Any sequence of 3 zeroes, 0, 0, 0 → 0, 1, 0
  • A starting sequence of 0, 0 → 1, 0
  • An ending sequence of 0, 0 → 0, 1

We can make this even easier by temporarily adding a zero to either end of the sequence, in which case we are simply changing 0, 0, 0 →
0, 1, 0.

And that's what I did. Most of the rest of the code is just formatting the input and output.

Perl Weekly’s review

from Perl Weekly issue 704

Nice hack to make the task easier. DIY tool lets you play with it too.

Try it 

Try running the script with any input:



example: 1, 0, 0, 0, 1, 0, 0



example: 2

Script


#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2025-01-13
use utf8;     # Week 304 - task 1 - Arrange binary
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

arrange_binary ([1, 0, 0, 0, 1], 1);
arrange_binary ([1, 0, 1, 0, 1], 1);
arrange_binary ([0, 0, 1, 0, 1, 0, 0], 1);
arrange_binary ([1, 0, 0, 0, 0, 0, 0, 0, 1], 1);
arrange_binary ([0, 0, 0, 0], 1);

sub arrange_binary {
    
    my ($string, $n, $count, @ints);
    
    # initialise
    @ints = @{$_[0]};
    $n = $_[1];
    
    # join @ints as string and add 0 at each end
    $string = '0' . join('', @ints) .'0';
    
    # count possible replacements
    $count = 0;
    $count ++ while $string =~ s|000|010|;
    $string =~ s|^.(.*).$|$1|;
    
    # report result
    say qq[\nInput:  \@ints =  (] . join(', ', @ints) . qq[), \$n = $n];
    if ($count >= $n) {
        say qq[Output: true     (] . join(', ', split('', $string)) . qq[), replaced $count];
    } else {
        say qq[Output: false];
    }
}

13 lines of code

Output from script


Input:  @ints =  (1, 0, 0, 0, 1), $n = 1
Output: true     (1, 0, 1, 0, 1), replaced 1

Input:  @ints =  (1, 0, 1, 0, 1), $n = 1
Output: false

Input:  @ints =  (0, 0, 1, 0, 1, 0, 0), $n = 1
Output: true     (1, 0, 1, 0, 1, 0, 1), replaced 2

Input:  @ints =  (1, 0, 0, 0, 0, 0, 0, 0, 1), $n = 1
Output: true     (1, 0, 1, 0, 1, 0, 1, 0, 1), replaced 3

Input:  @ints =  (0, 0, 0, 0), $n = 1
Output: true     (1, 0, 1, 0), replaced 2

 

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