From column to row

问题:

Could I do something better or does exist some module which does that for me?

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

my @list = '01' .. '95';
my $col = 9;

my $row = int( ( $#list + $col ) / $col );
my $d = @list % $col;
my @arr;

my $i = 0;
for ( 0 .. $col ) {
    $i = 1 if $d and $_ >= $d;
    $arr[$_] = [splice( @list, 0, $row - $i )];
}

for my $e ( 0 .. $row - 1 ) {
    my @list;
    for my $c ( 0 .. $col - 1 ) {
    next if $d and $e == $row-1 and $c >= $d; 
        push @list, $arr[$c][$e];
    }
    say "@list";
}  

output:

01 12 23 34 45 56 66 76 86  
02 13 24 35 46 57 67 77 87  
03 14 25 36 47 58 68 78 88  
04 15 26 37 48 59 69 79 89  
05 16 27 38 49 60 70 80 90  
06 17 28 39 50 61 71 81 91  
07 18 29 40 51 62 72 82 92  
08 19 30 41 52 63 73 83 93  
09 20 31 42 53 64 74 84 94  
10 21 32 43 54 65 75 85 95  
11 22 33 44 55

回答1:

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

my @list = '01' .. '95';
my $col = 9;

my $end = int( $#list / $col );
for my $e(0..$end) {
  my @o;
  for(my $c=$e; $c<$list[-1]; $c+=$end+1) {
    push @o, $list[$c];
  }
  say "@o";
}

output:

01 12 23 34 45 56 67 78 89
02 13 24 35 46 57 68 79 90
03 14 25 36 47 58 69 80 91
04 15 26 37 48 59 70 81 92
05 16 27 38 49 60 71 82 93
06 17 28 39 50 61 72 83 94
07 18 29 40 51 62 73 84 95
08 19 30 41 52 63 74 85
09 20 31 42 53 64 75 86
10 21 32 43 54 65 76 87
11 22 33 44 55 66 77 88

回答2:

For example:

% cd src/perl/t

% ls
README       comp         mro          rantests     uni
TEST         harness      op           re           win32
base         io           perl         run          x2p
benchmark    japh         perl.supp    test.pl
cmd          lib          porting      thread_it.pl

% ls -1 | words
README        comp          mro           rantests      uni
TEST          harness       op            re            win32
base          io            perl          run           x2p
benchmark     japh          perl.supp     test.pl       
cmd           lib           porting       thread_it.pl 

As you see, the words script presents its input column-major, much like ls. Here’s its source.

#!/usr/bin/env perl
#
# words - read input stream, present in column major order to screen size
# Tom Christiansen <[e-mail]>

use strict;
use warnings;

our($elt, $rows, $cols, $xpix, $ypix, $mask, @list);

sub at_eol { ($elt+1) % $cols == 0; }   # is this the last elt on line?

my $maxlen = 1; # widest string yet seen

my $winsize = "\0" x 8;
my $TIOCGWINSZ = 0x40087468;  # should be require sys/ioctl.pl
if (ioctl(STDOUT, $TIOCGWINSZ, $winsize)) {
    ($rows, $cols, $xpix, $ypix) = unpack('S4', $winsize);
} else {
    ($cols) = `stty size 2>&1` =~ /^\d+ (\d+)$/;
    $cols ||= 80;
}

my $curlen = 0;
while (<>) {    # read stdin into $_
    s/\s+\z//;
    $maxlen = $curlen if (($curlen = length()) > $maxlen);
    push(@list, $_);
} 

$maxlen += 1;  # spaces

$cols = int($cols / $maxlen) || 1;
$rows = int(($#list+$cols) / $cols);
$mask = sprintf("%%-%ds ", $maxlen);

for ($elt = 0; $elt < $rows * $cols; $elt++) { 
    my $target =  ($elt%$cols) * $rows + int(($elt/$cols));
    my $piece = sprintf($mask, $target < ($#list+1) ? $list[$target] : "");
    $piece =~ s/\s+$// if at_eol();  # don't blank pad to at_eol of line
    print $piece;
    print "\n" if at_eol();
}

print "\n" if at_eol();