Sort column

You are given a list of strings of the same length. Write a script to make each column sorted lexicographically by deleting any non-sorted columns. Return the number of total columns deleted.

Examples

Example 1
Input: @list = ("swpc", "tyad", "azbe")
Output: 2
swpc
tyad
azbe
Column 1: "s", "t", "a" => non sorted
Column 2: "w", "y", "z" => sorted
Column 3: "p", "a", "b" => non sorted
Column 4: "c", "d", "e" => sorted
Total 2 columns to delete to make it sorted 
   lexicographically.

Example 2
Input: @list = ("cba", "daf", "ghi")
Output: 1

Example 3
Input: @list = ("a", "b", "c")
Output: 0

Analysis

This is easily done as a double loop: first over columns and then over rows. Each cell is compared to the one above it (initialised to '@', which sorts before 'a') and if it is lexically less, the column is marked to be deleted.

I mark it by setting a hash element: $bad{$col} = 1, and the count of unsorted columns is then keys %bad in scalar context.

As with many such challenges I am sure it can, and somebody will, do it in fewer lines, but I do it this way to make the code easier to understand, and thus probably easier to maintain.

Smart move for catching the edge case. Well documented solution and bonus DIY tool as always. Super cool, keep it up.

Try it 

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2025-03-24
use utf8;     # Week 314 - task 2 - Sort column
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

sort_column('swpc', 'tyad', 'azbe');
sort_column('cba', 'daf', 'ghi');
sort_column('a', 'b', 'c');

sort_column('accountant', 'complexion', 'salamander', 'vegetables');
sort_column('sandwich', 'sandaich', 'sandwiah', 'sanawich');
sort_column('z', 'z', 'z', 'z');
sort_column('challenge');

sub sort_column {
    
    my (@rows, $prev, $col, $row, $this, %bad);
    @rows = @_;
    
    # loop over columns
    for $col (0 .. length($rows[0]) - 1) {
        $prev = '@';
        
        # loop over rows
        for $row (@rows) {
            $this = substr($row, $col, 1);
            
            # test for lexical order
            $bad{$col} = 1 if $this lt $prev;
            $prev = $this;
        }
    }
        
    say qq[\nInput:  \@strings = ('] . join(qq[', '], @rows) . qq[')];
    say qq[Output: ] . scalar(keys %bad);
}

11 lines of code

Output from script

Input:  @strings = ('swpc', 'tyad', 'azbe')
Output: 2

Input:  @strings = ('cba', 'daf', 'ghi')
Output: 1

Input:  @strings = ('a', 'b', 'c')
Output: 0

Input:  @strings = ('accountant', 'complexion', 
   'salamander', 'vegetables')
Output: 9

Input:  @strings = ('sandwich', 'sandaich', 'sandwiah', 
   'sanawich')
Output: 3

Input:  @strings = ('z', 'z', 'z', 'z')
Output: 0

Input:  @strings = ('challenge')
Output: 0