The weekly challenge 260 - Task 2: Dictionary Rank

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-260/#TASK2
 3 #
 4 # Task 2: Dictionary Rank
 5 # =======================
 6 #
 7 # You are given a word, $word.
 8 #
 9 # Write a script to compute the dictionary rank of the given word.
10 #
11 ## Example 1
12 ##
13 ## Input: $word = 'CAT'
14 ## Output: 3
15 ##
16 ## All possible combinations of the letters:
17 ## CAT, CTA, ATC, TCA, ACT, TAC
18 ##
19 ## Arrange them in alphabetical order:
20 ## ACT, ATC, CAT, CTA, TAC, TCA
21 ##
22 ## CAT is the 3rd in the list.
23 ## Therefore the dictionary rank of CAT is 3.
24 #
25 ## Example 2
26 ##
27 ## Input: $word = 'GOOGLE'
28 ## Output: 88
29 #
30 ## Example 3
31 ##
32 ## Input: $word = 'SECRET'
33 ## Output: 255
34 #
35 ############################################################
36 ##
37 ## discussion
38 ##
39 ############################################################
40 #
41 # We first create all possible permutations, for which we use an
42 # iterator-based solution from Algorithm::Permute. Then we keep
43 # all permutations, removing duplicates (Algorithm::Permute will
44 # for example generate the word "GOOGLE" twice, once for each "O"
45 # in the first and the second of two possible positions). Then we
46 # just walk the sorted list, counting the index while walking, and
47 # returning 1+index once we found the original word.
48 
49 use strict;
50 use warnings;
51 use Algorithm::Permute;
52 
53 dictionary_rank('CAT');
54 dictionary_rank('GOOGLE');
55 dictionary_rank('SECRET');
56 
57 sub dictionary_rank {
58    my $word = shift;
59    print "Input: '$word'\n";
60    my @chars = split //, $word;
61    my @permutations = ();
62    my $p_iterator = Algorithm::Permute->new ( \@chars );
63    my $seen = {};
64    while(my @perm = $p_iterator->next) {
65       my $w = join("", @perm);
66       push @permutations, $w unless $seen->{$w};
67       $seen->{$w} = 1;
68    }
69    my @sorted = sort @permutations;
70    print join(", ", @sorted) . "\n";
71    my $i = 0;
72    while($i <= $#sorted) {
73       if($sorted[$i] eq $word) {
74          $i++;
75          print "Output: $i\n";
76          last;
77       }
78       $i++;
79    }
80 }