perl logo Perl logo (Thanks to Olaf Alders)

The weekly challenge 314 - Task 2: Sort Column

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-314/#TASK2
 3 #
 4 # Task 2: Sort Column
 5 # ===================
 6 #
 7 # You are given a list of strings of same length.
 8 #
 9 # Write a script to make each column sorted lexicographically by deleting any
10 # non sorted columns.
11 #
12 # Return the total columns deleted.
13 #
14 ## Example 1
15 ##
16 ## Input: @list = ("swpc", "tyad", "azbe")
17 ## Output: 2
18 ##
19 ## swpc
20 ## tyad
21 ## azbe
22 ##
23 ## Column 1: "s", "t", "a" => non sorted
24 ## Column 2: "w", "y", "z" => sorted
25 ## Column 3: "p", "a", "b" => non sorted
26 ## Column 4: "c", "d", "e" => sorted
27 ##
28 ## Total columns to delete to make it sorted lexicographically.
29 #
30 ## Example 2
31 ##
32 ## Input: @list = ("cba", "daf", "ghi")
33 ## Output: 1
34 #
35 ## Example 3
36 ##
37 ## Input: @list = ("a", "b", "c")
38 ## Output: 0
39 #
40 ############################################################
41 ##
42 ## discussion
43 ##
44 ############################################################
45 #
46 # We start by collecting all columns into arrays. Then we check
47 # each element of each column: if it is lexicographically bigger
48 # than its predecessor, we are still good. Otherwise, we delete
49 # the column and move on to the next.
50 # In the end, we return the amount of deleted columns.
51 
52 use v5.36;
53 use Data::Dumper;
54 
55 sort_column("swpc", "tyad", "azbe");
56 sort_column("cba", "daf", "ghi");
57 sort_column("a", "b", "c");
58 
59 sub sort_column(@list) {
60     say "Input: (" . join(", ", @list) . ")";
61     my $columns;
62     foreach my $string (@list) {
63         my @chars = split //, $string;
64         foreach my $i (0..$#chars) {
65             push @{$columns->{$i}}, $chars[$i];
66         }
67     }
68     my $deleted = 0;
69     foreach my $c (sort { $a <=> $b } keys %$columns) {
70         my $last = -1;
71         foreach my $elem (@{$columns->{$c}}) {
72             my $tmp = ord($elem);
73             if($tmp < $last) {
74                 $deleted++;
75                 last;
76             }
77             $last = $tmp;
78         }
79     }
80     say "Output: $deleted";
81 }