[SOLUTION] solution to qotw 2005/03

Hi all,

here is my solution to qotw 2005/03.

My function print_list gets three parameters, first the wanted width, second
the (ordered) list and third a display parameter for horizontal or vertical
ordering of the listitems. The default is the 1 (vertical, as described in
the quest).

My function prints a line in the wanted length above the output and a line
with the real length under the output.

Here is an output for width 30, 'vertical' sort and the list from the quest:

------------------------------
Abby   Al       Constance
Daniel Jonathan Julia
Sam    Terrence
-------------------------

This is the output with 'horizontal' sorting:

------------------------------
Abby      Daniel   Sam
Al        Jonathan Terrence
Constance Julia
---------------------------


perhaps I should better switch the use of horizontal and vertical here ;)

Greetings, Christian.


Here is the code, I soul not add it as a file, because tghe mail came back
to my, why a ever...


#!/usr/bin/perl
use strict;
use warnings;


=head1 QUEST

Quest of the weak # 2005 / 03

=head1 AUTHOR

Christian Dühl ([email protected])

=head1 TASK

Write a subroutine called print_list that takes a number indicating
the width of the display as a number of characters, and a list of
strings, and prints the strings in a sorted columnar display, using as
many columns that will fit in the display for the given list and as few
rows as possible.

The longest string in one column should appear exactly two spaces away
from the beginning of the next column.  (The columns are not
necessarily the same width.)

Each column should include consecutive elements in the sorted list,
such that the item following the last item in column 1 appears at the
top of column 2, and similarly for the remaining columns.

For example, given:

 @strings = qw(Jonathan Sam Abby Daniel Julia Terrence Constance Al);

print_list(30, @strings) prints:

 Abby       Daniel    Sam
 Al         Jonathan  Terrence
 Constance  Julia

print_list(40, @strings) prints:

 Abby  Constance  Jonathan  Sam
 Al    Daniel     Julia     Terrence

print_list(80, @strings) prints:

 Abby  Al  Constance  Daniel  Jonathan  Julia  Sam  Terrence

And print_list(1, @strings) prints:

 Abby
 Al
 Constance
 Daniel
 Jonathan
 Julia
 Sam
 Terrence

For a real world example of a similar display, see the Unix/Linux command,
'ls'.  For an example of how to determine the actual width of a terminal
window in characters (not required for this quiz, but good to know), see
the Perl Cookbook, 1st or 2nd edition, recipe 15.4.

=cut


my @list = qw/Jonathan Sam Abby Daniel Julia Terrence Constance Al/;

for (30, 40, 80, 1, 15) {
    print_list($_, [ sort @list ]);
    print "\n";
}
print_list(30, [ sort @list ], 2);

exit;


sub print_list {
    my ($width, $list, $sortorder) = (@_, 1);

   
#-------------------------------------------------------------------------
    # calculate extremal widthes of the hole list:
   
#-------------------------------------------------------------------------
    my ($maxl, $minl) = minmax_list($list);

   
#-------------------------------------------------------------------------
    # calculate the minimal and maximal number of needed columns for the
    # solution:
   
#-------------------------------------------------------------------------
    my $colmax = int( $width / ($minl + 1) );
    my $colmin = int( $width / ($maxl + 1) );
    $colmax = $colmin = 1 if $colmax < 1;

   
#-------------------------------------------------------------------------
    # test all possible solutions until one is small enough:
   
#-------------------------------------------------------------------------
    COLSET: for my $col (reverse $colmin .. $colmax) {
       
#---------------------------------------------------------------------
        # calculate the columns:
       
#---------------------------------------------------------------------
        my $row = int( scalar @$list / $col );
        ++$row if $col * $row < scalar @list;
        my @columns = fill_columns($col, $row, $list, $sortorder);

       
#---------------------------------------------------------------------
        # calculate the width of the columns:
       
#---------------------------------------------------------------------
        my $w = 0;
        my @colwidth;
        for my $lst (@columns) {
            my ($wmax, $wmin) = minmax_list($lst);
            push @colwidth, $wmax;
            $w += $wmax + 1;                 # +1 : space after the column
        }
        --$w;                                # no space after the last
column

       
#---------------------------------------------------------------------
        # print solution if ok:
       
#---------------------------------------------------------------------
        if ($w <= $width or $col == $colmin) {
            #print "Solution found for width $width with width $w:\n";
            print '-' x $width, "\n"; # print line with the wanted width

            for my $r (0..$row-1) {
                for my $c (0..$col-1) {
                    if ($c < scalar @columns        and
                        $r < scalar @{$columns[$c]}    )
                    {
                        printf "%*s ", -$colwidth[$c], $columns[$c]->[$r];
                    }
                }
                print "\n";
            } 

            print '-' x $w, "\n"; # print line with the real width
            last COLSET;          # no more solutions must be checked now
        }
    }
} # sub print_list


sub minmax_list {
    my ($list) = @_;

    my $maxl = 0;
    my $minl = -1;

    for my $word (@$list) {
        my $l = length $word;
        $maxl = $l if $l > $maxl;
        $minl = $l if $minl == -1 or $l < $minl;
    }

    return $maxl, $minl;
} # sub minmax_list


sub fill_columns {
    my ($col, $row, $list, $sortorder) = @_;

    my @columns;
    my $c = my $r = 0;
    for my $index (0..$#$list) {
        # horizontal:
        if ($sortorder == 2) {
            push @{ $columns[$c] }, $list->[$index];
            ++$r;
            if ($r == $row) {
                $r = 0;
                ++$c;
            }
        }
        # vertical:
        elsif ($sortorder == 1) {
            push @{ $columns[$c] }, $list->[$index];
            ++$c;
            if ($c == $col) {
                $c = 0;
            }
        }
        else {
            die "Unknown sort order '$sortorder'";
        }
    }

    return @columns;
} # sub fill_columns