The weekly challenge 359 - Task 2: String Reduction

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-359/#TASK2
 3 #
 4 # Task 2: String Reduction
 5 # ========================
 6 #
 7 # You are given a word containing only alphabets,
 8 #
 9 # Write a function that repeatedly removes adjacent duplicate characters from a
10 # string until no adjacent duplicates remain and return the final word.
11 #
12 ## Example 1
13 ##
14 ## Input: $word = "aabbccdd"
15 ## Output: ""
16 ##
17 ## Iteration 1: remove "aa", "bb", "cc", "dd" => ""
18 #
19 #
20 ## Example 2
21 ##
22 ## Input: $word = "abccba"
23 ## Output: ""
24 ##
25 ## Iteration 1: remove "cc" => "abba"
26 ## Iteration 2: remove "bb" => "aa"
27 ## Iteration 3: remove "aa" => ""
28 #
29 #
30 ## Example 3
31 ##
32 ## Input: $word = "abcdef"
33 ## Output: "abcdef"
34 ##
35 ## No duplicate found.
36 #
37 #
38 ## Example 4
39 ##
40 ## Input: $word = "aabbaeaccdd"
41 ## Output: "aea"
42 ##
43 ## Iteration 1: remove "aa", "bb", "cc", "dd" => "aea"
44 #
45 #
46 ## Example 5
47 ##
48 ## Input: $word = "mississippi"
49 ## Output: "m"
50 ##
51 ## Iteration 1: Remove "ss", "ss", "pp" => "miiii"
52 ## Iteration 2: Remove "ii", "ii" => "m"
53 #
54 ############################################################
55 ##
56 ## discussion
57 ##
58 ############################################################
59 #
60 # This is a fun oneliner - to remove one instance of adjacent
61 # duplicate characters, we only need to use a back reference
62 # in the regex:
63 #   $word =~ s/(.)\g1//;
64 # Since that returns the number of occurences that were changed,
65 # it will return 1 as long as there are adjacent duplicate characters.
66 # So we can just use it as the condition in an empty while loop to
67 # get the desired result.
68 #
69 
70 use v5.36;
71 
72 string_reduction("aabbccdd");
73 string_reduction("abccba");
74 string_reduction("abcdef");
75 string_reduction("aabbaeaccdd");
76 string_reduction("mississippi");
77 
78 sub string_reduction($word) {
79     say "Input: \"$word\"";
80     while($word =~ s/(.)\g1//) { }
81     say "Output: \"$word\"";
82 }