The weekly challenge 395 - Task 2: Word Squares

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-395/#TASK2
 3 #
 4 # Task 2: Word Squares
 5 # ====================
 6 #
 7 # You are given a list of equal lengths words.
 8 #
 9 # Write a script to arrange a set of words into a grid that reading across any
10 # row gives the exact same word as reading down its corresponding column.
11 #
12 ## Example 1
13 ##
14 ## Input: @words = ("MA", "AM", "MY", "ME")
15 ## Output: ("MA", "AM")
16 ##
17 ##     M A
18 ##     A M
19 #
20 ## Example 2
21 ##
22 ## Input: @words = ("SUN", "USE", "NET", "SEE", "TEN")
23 ## Output: ("SUN", "USE", "NET")
24 ##
25 ##     S U N
26 ##     U S E
27 ##     N E T
28 #
29 ## Example 3
30 ##
31 ## Input: @words = ("BOAT", "TEAL", "AREA", "TSAR", "OGRE")
32 ## Output: ("BOAT", "OGRE", "AREA", "TEAL")
33 ##
34 ##     B O A T
35 ##     O G R E
36 ##     A R E A
37 ##     T E A L
38 #
39 ## Example 4
40 ##
41 ## Input: @words = ("CARD", "AREA", "REAR", "DART")
42 ## Output: ("CARD", "AREA", "REAR", "DART")
43 ##
44 ##     C A R D
45 ##     A R E A
46 ##     R E A R
47 ##     D A R T
48 #
49 ## Example 5
50 ##
51 ## Input: @words = ("HEART", "TREND", "EMBER", "RESIN", "ABUSE")
52 ## Output: ("HEART", "EMBER", "ABUSE", "RESIN", "TREND")
53 ##
54 ##     H E A R T
55 ##     E M B E R
56 ##     A B U S E
57 ##     R E S I N
58 ##     T R E N D
59 #
60 ############################################################
61 ##
62 ## discussion
63 ##
64 ############################################################
65 #
66 # We create all possible permutations of the words in the list. We check
67 # whether we found a valied result for the first few elements of the
68 # permutation, and we continue our search otherwise.
69 
70 use v5.36;
71 use Algorithm::Combinatorics qw(permutations);
72 
73 sub word_squares(@words) {
74     say "Input: (" . join(", ", map { "\"$_\"" } @words) . ")";
75     my $length = length($words[0]);
76     foreach my $permutation (permutations(\@words)) {
77         my @p = @$permutation;
78         return say "Output: (" . join(", ", map { "\"$_\"" } @p[0..$length-1]) . ")"
79             if is_valid_permutation($length, @$permutation);
80     }
81     die "Didn't find a valid permutation";
82 }
83 
84 sub is_valid_permutation($len, @permutation) {
85     foreach my $i (0..$len-1) {
86         my $column = join("", map { substr($_, $i, 1) } @permutation[0..$len-1]);
87         my $row = $permutation[$i];
88         return 0 unless $row eq $column;
89     }
90     return 1;
91 }
92 
93 word_squares("MA", "AM", "MY", "ME");
94 word_squares("SUN", "USE", "NET", "SEE", "TEN");
95 word_squares("BOAT", "TEAL", "AREA", "TSAR", "OGRE");
96 word_squares("CARD", "AREA", "REAR", "DART");
97 word_squares("HEART", "TREND", "EMBER", "RESIN", "ABUSE");