2010-11-25 2 views
0

Мог ли я сделать что-то лучше или есть какой-то модуль, который делает это для меня?От колонки до строки

#!/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"; 
} 

выход:

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"; 
} 

выход:

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 
+0

Не могли бы вы изменить свой скрипт, чтобы получить результат: «Заполнить столбцы перед заполнением строк»? – 2010-11-26 09:40:22

+0

@sid_com: Извините, я не понимаю, что вы имеете в виду. – Toto 2010-11-26 12:37:26

1

Например:

% 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 

Как вы видите, words сценарий представляет входную колонку-майор, очень похожую на ls. Вот его источник.

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

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(); 
Смежные вопросы