in reply to 'ls -C' column style

I've put 2 spaces between the columns as that's how it looked in your example, but it wasn't specified. 

#! perl -sl
use strict;
use List::Util qw[ max sum ];
use Data::Dumper;

our $WIDTH ||= 80;

sub columnise {
    my( $width, @list ) = @_;
    my @lines;

    for my $rows ( 1 .. @list ) {
        my $cols = int( (@list + $rows -1) / $rows );
        my @aoa = map{
            [ @list[ $_ .. $_+$rows-1 ] ]
        } map{ $_ * $rows } 0 .. $cols-1;

        my @widths = map{
            2+ max map length( $_||'' ), @$_
        } @aoa;

        next if sum( @widths ) > $WIDTH;

        for my $row ( 0 .. $rows-1 ) {
            push @lines, join '', map{
                sprintf "%-$widths[ $_ ]s", $aoa[ $_ ][ $row ]||''
            } 0 .. $#aoa;
        }
        return @lines;
    }
}

chomp( my @list = sort <DATA> );
close DATA;

print for columnise $WIDTH, @list;

__DATA__
<<SNIP>>

[download]

Output at various widths

[20:52:55.75] P:\test>405274 -WIDTH=132
B           DB_File  Digest      Errno  Filter     IO    MIME       Op
+code  SDBM_File  Storable  Time     attrs    util
ByteLoader  Data     DynaLoader  Fcntl  GDBM_File  IPC   NDBM_File  PO
+SIX   Safe       Sys       Unicode  re
Cwd         Devel    Encode      File   I18N       List  ODBM_File  Pe
+rlIO  Socket     Thread    XS       threads

[20:46:45.06] P:\test>405274 -WIDTH=80
B           Digest      Filter     MIME       SDBM_File  Time     util
ByteLoader  DynaLoader  GDBM_File  NDBM_File  Safe       Unicode
Cwd         Encode      I18N       ODBM_File  Socket     XS
DB_File     Errno       IO         Opcode     Storable   attrs
Data        Fcntl       IPC        POSIX      Sys        re
Devel       File        List       PerlIO     Thread     threads

[20:47:05.06] P:\test>405274 -WIDTH=40
B           Filter     SDBM_File  util
ByteLoader  GDBM_File  Safe
Cwd         I18N       Socket
DB_File     IO         Storable
Data        IPC        Sys
Devel       List       Thread
Digest      MIME       Time
DynaLoader  NDBM_File  Unicode
Encode      ODBM_File  XS
Errno       Opcode     attrs
Fcntl       POSIX      re
File        PerlIO     threads

[20:47:15.53] P:\test>405274 -WIDTH=20
B           util
ByteLoader
Cwd
DB_File
Data
Devel
Digest
DynaLoader
Encode
Errno
Fcntl
File
Filter
GDBM_File
I18N
IO
IPC
List
MIME
NDBM_File
ODBM_File
Opcode
POSIX
PerlIO
SDBM_File
Safe
Socket
Storable
Sys
Thread
Time
Unicode
XS
attrs
re
threads

[20:47:23.53] P:\test>405274 -WIDTH=25
B           NDBM_File
ByteLoader  ODBM_File
Cwd         Opcode
DB_File     POSIX
Data        PerlIO
Devel       SDBM_File
Digest      Safe
DynaLoader  Socket
Encode      Storable
Errno       Sys
Fcntl       Thread
File        Time
Filter      Unicode
GDBM_File   XS
I18N        attrs
IO          re
IPC         threads
List        util
MIME

[download]
Examine what is said, not who speaks.
"Efficiency is intelligent laziness." -David Dunham
"Think for yourself!" - Abigail
"Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

Replies are listed 'Best First'.
Re^2: 'ls -C' column style
by hv (Prior) on Nov 05, 2004 at 11:03 UTC

    Thanks, this is just the sort of thing I was looking for.

    I notice that you treat the 2-char spacer as a "right-padding" on each column rather than as a "between padding" on each pair of columns; this becomes particularly obvious on the -WIDTH=20 example. But I think that would be fairly easy to change, at the cost of a bit of cleanness of the code.

    Hugo

[reply]
[d/l]

      You've probably done it already, but it suddenly struck me that this fixed the right-padding problem without needing to mess with the code much. 

      sub columnise {
    my( $width, @list ) = @_;
    my @lines;
    for my $rows ( 1 .. @list ) {
        my $cols = int( (@list + $rows -1) / $rows );
        my @aoa = map{
            [ @list[ $_ .. $_+$rows-1 ] ]
        } map{ $_ * $rows } 0 .. $cols-1;
        my @widths = map{
            max map length( $_||'' ), @$_
        } @aoa;
        next if sum( @widths, $#widths * 2 ) > $WIDTH;
        for my $row ( 0 .. $rows-1 ) {
            push @lines, join '  ', map{
                sprintf "%-$widths[ $_ ]s", $aoa[ $_ ][ $row ]||''
            } 0 .. $#aoa;
        }
        return @lines;
    }
}

      [download]

      I also played with your binary chop idea, but the list had to be quite long and the width quite narrow before it offset the extra code required.

      Examine what is said, not who speaks.
      "Efficiency is intelligent laziness." -David Dunham
      "Think for yourself!" - Abigail
      "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
[reply]
[d/l]

In Section Seekers of Perl Wisdom