[SPOILER] Perl 'Easy' Quiz of the Week #2005-2

This was fun!

Here is yet another example. The main theme of this solution is to
traverse the original list in chunks of column-lengt and building two
representaions of an array while doing it.  And doing this repeadtedly
for a increased nr of rows, starting with the lowest possible (1),
until it fits in the specified width.

The [col][row] -representaion of the array is used for finding the
longest word in that column, and the [row][col] -representation is
used for the later printing, which is done with a single printf per
row. Both arrays consists only of indexes to the original list, so no
moving of elements is needed.


#! /usr/bin/perl

use strict;
use warnings;
use List::Util 'max';

{ # separate main-scoop from subroutines scoops
    my @strings = qw(Jonathan Sam Abby Daniel Julia Terrence Constance Al);
    print_list(1, @strings);
    print_list(30, @strings);
    print_list(40, @strings);
    print_list(80, @strings);
}


sub print_list {
    my $width = shift;
    return unless ( @_ );
    my @words = sort @_;

    # A easy-acess list of all lengths.
    my @lengths = map { length } @words;
    
  ROW: # Loop to find the minimum needed nr of rows.
    for my $row ( 0 .. $#words ) {
	my $i   = 0; # current index.
	my $c   = 0; # current column.
	my $tot = 0; # acumulated length needed for this row.
	my @col;     # $col[x] contains a list of indexes in @words to use in column x.
	my @row;     # $row[x] contains a list of indexes in @words to use in row x.
	my @len;     # $len[x] is the length of the longest word in column x.
	while ( $i < @words ) {
	    for ( 0 .. $row ) {
		$col[$c][$_] = $i;
		$row[$_][$c] = $i++; 
		last unless ( $i < @words );
	    }
	    # What is the highest wordlength in this column?
	    $len[$c] = max @lengths[@{$col[$c]}] ;

	    if ( ($tot += $len[$c]) > $width ) {
		# It didn't fit! we need more rows.
		next ROW;
	    }
	    $tot += 2; # add the two spaces separator.
	    $c++;
	}
	# Yes! it fits. Start printing.
	for my $line ( 0 .. $row ) {
	    # Create formatstring.
	    my $fmt;
	    for ( 0 .. $#{$row[$line]}-1 ) {
		# all formatcodes execept the last should make room for two extra spaces.
		$fmt .= "%-" . ($len[$_]+2) . "s" ;
	    }
	    $fmt .= "%s";
	    
	    # And finally, print this line.
	    printf "$fmt\n",@words[@{$row[$line]}];
	}
	return;
    }

    # No fit at all, just print a word on each line.
    print join("\n",@words),"\n";
}

__END__


-- 
 Christer