The weekly challenge 215 - Task 2 - All zeroes and ones

  1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-215/#TASK2
  3 #
  4 # Task 2: Number Placement
  5 # ========================
  6 #
  7 # You are given a list of numbers having just 0 and 1. You are also
  8 # given placement count (>=1).
  9 #
 10 # Write a script to find out if it is possible to replace 0 with 1
 11 # in the given list. The only condition is that you can only replace
 12 # when there is no 1 on either side. Print 1 if it is possible
 13 # otherwise 0.
 14 #
 15 ## Example 1:
 16 ##
 17 ## Input: @numbers = (1,0,0,0,1), $count = 1
 18 ## Output: 1
 19 ##
 20 ## You are asked to replace only one 0 as given count is 1.
 21 ## We can easily replace middle 0 in the list i.e. (1,0,1,0,1).
 22 #
 23 ## Example 2:
 24 ##
 25 ## Input: @numbers = (1,0,0,0,1), $count = 2
 26 ## Output: 0
 27 ##
 28 ## You are asked to replace two 0's as given count is 2.
 29 ## It is impossible to replace two 0's.
 30 #
 31 ## Example 3:
 32 ##
 33 ## Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3
 34 ## Output: 1
 35 #
 36 ############################################################
 37 ##
 38 ## discussion
 39 ##
 40 ############################################################
 41 #
 42 # So, if we can replace $count 0's with 1's, we should print 1,
 43 # otherwise 0. number_placement() will do that, calling the
 44 # can_replace() function to check the possibility.
 45 # can_replace() replaces one 0 with a 1 via the replace() function,
 46 # and if that worked, calls itself recursively with the new array
 47 # and $count - 1.
 48 # replace() short-circuits its execution by replacing the first
 49 # possible 0 that can be replaced and then returning the resulting
 50 # new array, leaving everything else for the recursive calls of the
 51 # can_replace() function and subsequent replace() calls
 52 
 53 use strict;
 54 use warnings;
 55 
 56 number_placement( [1,0,0,0,1], 1);
 57 number_placement( [1,0,0,0,1], 2);
 58 number_placement( [1,0,0,0,0,0,0,0,1], 3);
 59 
 60 sub number_placement {
 61    my ($numbers, $count) = @_;
 62    print "Input: (" . join(",", @$numbers), "), $count\n";
 63    die "Illegal count" unless $count > 0;
 64    print "Output: ";
 65    if(can_replace($numbers, $count)) {
 66       print "1\n";
 67    } else {
 68       print "0\n";
 69    }
 70 }
 71 
 72 sub can_replace {
 73    my ($numbers, $count) = @_;
 74    return 1 unless $count; # nothing left to do, all replacements done
 75    my $new_numbers = replace($numbers);
 76    if($new_numbers) {
 77       return can_replace($new_numbers, $count - 1);
 78    }
 79    return 0;
 80 }
 81 
 82 # replace one 0 with a 1 in the given array.
 83 # We do this by finding the first 0 that we can
 84 # replace. Once that is replaced, we return the
 85 # new array with the replacement in place. If we
 86 # can't replace a 0 with a 1, we return undef
 87 # to signal this fact
 88 sub replace {
 89    my $numbers = shift;
 90    my $new_numbers = [ @$numbers ];
 91    my $last_idx = scalar(@$numbers) - 1;
 92    foreach my $i (0..$last_idx) {
 93       my $can_replace = 0;
 94       if($numbers->[$i] == 0) {
 95          $can_replace = 1;
 96          if($i > 0) {
 97             if($numbers->[$i-1] == 0) {
 98                $can_replace = 1;
 99             } else {
100                $can_replace = 0;
101             }
102          }
103          if($i < $last_idx && $can_replace) {
104             if($numbers->[$i+1] == 0) {
105                $can_replace = 1;
106             } else {
107                $can_replace = 0;
108             }
109          }
110          if($can_replace) {
111             $new_numbers->[$i] = 1;
112             return $new_numbers;
113          }
114       }
115    }
116    return undef;
117 }