1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-307/#TASK2
 3 #
 4 # Task 2: Find Anagrams
 5 # =====================
 6 #
 7 # You are given a list of words, @words.
 8 #
 9 # Write a script to find any two consecutive words and if they are anagrams,
10 # drop the first word and keep the second. You continue this until there is no
11 # more anagrams in the given list and return the count of final list.
12 #
13 ## Example 1
14 ##
15 ## Input: @words = ("acca", "dog", "god", "perl", "repl")
16 ## Output: 3
17 ##
18 ## Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god"
19 ##         => ("acca", "god", "perl", "repl")
20 ## Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl"
21 ##         => ("acca", "god", "repl")
22 #
23 ## Example 2
24 ##
25 ## Input: @words = ("abba", "baba", "aabb", "ab", "ab")
26 ## Output: 2
27 ##
28 ## Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba"
29 ##         => ("baba", "aabb", "ab", "ab")
30 ## Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb"
31 ##         => ("aabb", "ab", "ab")
32 ## Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab"
33 ##         => ("aabb", "ab")
34 #
35 ############################################################
36 ##
37 ## discussion
38 ##
39 ############################################################
40 #
41 # As long as the length of the array keeps changing, check if two consecutive
42 # words are anagrams. If so, remove the first word and continue. Once the
43 # length of the array no longer changes, we can output the length.
44 
45 use v5.36;
46 
47 find_anagrams("acca", "dog", "god", "perl", "repl");
48 find_anagrams("abba", "baba", "aabb", "ab", "ab");
49 
50 sub find_anagrams (@words) {
51    say "Input: (" . join(", ", @words) . ")";
52    my $len = scalar(@words);
53    my $oldlen = 1 + $len;
54    while($oldlen != $len) {
55       my @tmp = ();
56       foreach my $i (0..$#words) {
57          if(is_anagram($words[$i], $words[$i+1])) {
58             push @tmp, @words[$i+1..$#words];
59             last;
60          } else {
61             push @tmp, $words[$i];
62          }
63       }
64       @words = @tmp;
65       $oldlen = $len;
66       $len = scalar(@words);
67    }
68    say "Output: $len";
69 }
70 
71 sub is_anagram($word1, $word2) {
72    my $w1;
73    my $w2;
74    return 0 unless defined $word2;
75    return 0 if length($word1) != length($word2);
76    foreach my $c (split//,$word1) {
77       $w1->{$c}++;
78    }
79    foreach my $c (split//,$word2) {
80       $w2->{$c}++;
81    }
82    foreach my $c (keys %$w1) {
83       return 0 if $w1->{$c} != $w2->{$c};
84    }
85    return 1;
86 }