The weekly challenge 342 - Task 1: Balance String

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-342/#TASK1
 3 #
 4 # Task 1: Balance String
 5 # ======================
 6 #
 7 # You are given a string made up of lowercase English letters and digits only.
 8 #
 9 # Write a script to format the give string where no letter is followed by
10 # another letter and no digit is followed by another digit. If there are
11 # multiple valid rearrangements, always return the lexicographically smallest
12 # one. Return empty string if it is impossible to format the string.
13 #
14 ## Example 1
15 ##
16 ## Input: $str = "a0b1c2"
17 ## Output: "0a1b2c"
18 #
19 #
20 ## Example 2
21 ##
22 ## Input: $str = "abc12"
23 ## Output: "a1b2c"
24 #
25 #
26 ## Example 3
27 ##
28 ## Input: $str = "0a2b1c3"
29 ## Output: "0a1b2c3"
30 #
31 #
32 ## Example 4
33 ##
34 ## Input: $str = "1a23"
35 ## Output: ""
36 #
37 #
38 ## Example 5
39 ##
40 ## Input: $str = "ab123"
41 ## Output: "1a2b3"
42 #
43 ############################################################
44 ##
45 ## discussion
46 ##
47 ############################################################
48 #
49 # First, we split $str into its parts. Then we pick all the digits
50 # into one array and all characters into another one - both of these
51 # arrays sorted. If one of the arrays is longer by more than 1 than
52 # the other array, there is no solution, so we return the empty
53 # string. Otherwise we take turns picking elements from each array.
54 
55 use v5.36;
56 
57 balance_string("a0b1c2");
58 balance_string("abc12");
59 balance_string("0a2b1c3");
60 balance_string("1a23");
61 balance_string("ab123");
62 
63 sub balance_string($str) {
64     say "Input: $str";
65 
66     my @parts = split //, $str;
67     my @digits = sort grep { m/\d/ } @parts;
68     my @chars = sort grep { ! m/\d/ } @parts;
69     my (@first, @second);
70 
71     my $d = scalar @digits;
72     my $c = scalar @chars;
73     my $result = "";
74 
75     return say "Output: \"\"" if abs($d - $c) > 1;
76 
77     # We pick the first element from the longer array first,
78     # or a digit if the arrays share the same length
79     if($d >= $c) {
80         @first = @digits;
81         @second = @chars;
82     } else {
83         @first = @chars;
84         @second = @digits;
85     }
86 
87     # pick one element from each array
88     while(@first) {
89         $result .= shift @first;
90         $result .= shift @second if @second;
91     }
92 
93     say "Output: $result";
94 }