perl - 使用 perl 进行快速字节交换

Question

我最初在这里问这个问题:byte swap with perl

我修改了代码，但我发现一个程序可以在 0.002 秒内完成同样的任务。如果您查看链接，您会看到我是如何修改代码的。现在虽然这确实加快了一点点，但它仍然没有其他倒车程序快。这是修改后的代码:

my $hexin;
my $n;
 while (($n = read($fin, $bytes_in, 512)) == 512) {
        my @c = split('', $bytes_in);
        my $bytes_out = join('', $c[1], $c[0], $c[3], $c[2], $c[5], $c[4], $c[7], $c[6], $c[9], $c[8], $c[11], $c[10], $c[13], $c[12], $c[15], $c[14], 
                              $c[17], $c[16], $c[19], $c[18], $c[21], $c[20], $c[23], $c[22], $c[25], $c[24], $c[27], $c[26], $c[29], $c[28], $c[31], $c[30], 
                              $c[33], $c[32], $c[35], $c[34], $c[37], $c[36], $c[39], $c[38], $c[41], $c[40], $c[43], $c[42], $c[45], $c[44], $c[47], $c[46], 
                              $c[49], $c[48], $c[51], $c[50], $c[53], $c[52], $c[55], $c[54], $c[57], $c[56], $c[59], $c[58], $c[61], $c[60], $c[63], $c[62],
                              $c[65], $c[64], $c[67], $c[66], $c[69], $c[68], $c[71], $c[70], $c[73], $c[72], $c[75], $c[74], $c[77], $c[76], $c[79], $c[78], 
                              $c[81], $c[80], $c[83], $c[82], $c[85], $c[84], $c[87], $c[86], $c[89], $c[88], $c[91], $c[90], $c[93], $c[92], $c[95], $c[94],
                              $c[97], $c[96], $c[99], $c[98], $c[101], $c[100], $c[103], $c[102], $c[105], $c[104], $c[107], $c[106], $c[109], $c[108], $c[111], $c[110], 
                              $c[113], $c[112], $c[115], $c[114], $c[117], $c[116], $c[119], $c[118], $c[121], $c[120], $c[123], $c[122], $c[125], $c[124], $c[127], $c[126], 
                              $c[129], $c[128], $c[131], $c[130], $c[133], $c[132], $c[135], $c[134], $c[137], $c[136], $c[139], $c[138], $c[141], $c[140], $c[143], $c[142], 
                              $c[145], $c[144], $c[147], $c[146], $c[149], $c[148], $c[151], $c[150], $c[153], $c[152], $c[155], $c[154], $c[157], $c[156], $c[159], $c[158], 
                              $c[161], $c[160], $c[163], $c[162], $c[165], $c[164], $c[167], $c[166], $c[169], $c[168], $c[171], $c[170], $c[173], $c[172], $c[175], $c[174], 
                              $c[177], $c[176], $c[179], $c[178], $c[181], $c[180], $c[183], $c[182], $c[185], $c[184], $c[187], $c[186], $c[189], $c[188], $c[191], $c[190], 
                              $c[193], $c[192], $c[195], $c[194], $c[197], $c[196], $c[199], $c[198], $c[201], $c[200], $c[203], $c[202], $c[205], $c[204], $c[207], $c[206], 
                              $c[209], $c[208], $c[211], $c[210], $c[213], $c[212], $c[215], $c[214], $c[217], $c[216], $c[219], $c[218], $c[221], $c[220], $c[223], $c[222], 
                              $c[225], $c[224], $c[227], $c[226], $c[229], $c[228], $c[231], $c[230], $c[233], $c[232], $c[235], $c[234], $c[237], $c[236], $c[239], $c[238], 
                              $c[241], $c[240], $c[243], $c[242], $c[245], $c[244], $c[247], $c[246], $c[249], $c[248], $c[251], $c[250], $c[253], $c[252], $c[255], $c[254],
                              $c[257], $c[256], $c[259], $c[258], $c[261], $c[260], $c[263], $c[262], $c[265], $c[264], $c[267], $c[266], $c[269], $c[268], $c[271], $c[270], 
                              $c[273], $c[272], $c[275], $c[274], $c[277], $c[276], $c[279], $c[278], $c[281], $c[280], $c[283], $c[282], $c[285], $c[284], $c[287], $c[286], 
                              $c[289], $c[288], $c[291], $c[290], $c[293], $c[292], $c[295], $c[294], $c[297], $c[296], $c[299], $c[298], $c[301], $c[300], $c[303], $c[302], 
                              $c[305], $c[304], $c[307], $c[306], $c[309], $c[308], $c[311], $c[310], $c[313], $c[312], $c[315], $c[314], $c[317], $c[316], $c[319], $c[318],
                              $c[321], $c[320], $c[323], $c[322], $c[325], $c[324], $c[327], $c[326], $c[329], $c[328], $c[331], $c[330], $c[333], $c[332], $c[335], $c[334], 
                              $c[337], $c[336], $c[339], $c[338], $c[341], $c[340], $c[343], $c[342], $c[345], $c[344], $c[347], $c[346], $c[349], $c[348], $c[351], $c[350],
                              $c[353], $c[352], $c[355], $c[354], $c[357], $c[356], $c[359], $c[358], $c[361], $c[360], $c[363], $c[362], $c[365], $c[364], $c[367], $c[366], 
                              $c[369], $c[368], $c[371], $c[370], $c[373], $c[372], $c[375], $c[374], $c[377], $c[376], $c[379], $c[378], $c[381], $c[380], $c[383], $c[382], 
                              $c[385], $c[384], $c[387], $c[386], $c[389], $c[388], $c[391], $c[390], $c[393], $c[392], $c[395], $c[394], $c[397], $c[396], $c[399], $c[398], 
                              $c[401], $c[400], $c[403], $c[402], $c[405], $c[404], $c[407], $c[406], $c[409], $c[408], $c[411], $c[410], $c[413], $c[412], $c[415], $c[414], 
                              $c[417], $c[416], $c[419], $c[418], $c[421], $c[420], $c[423], $c[422], $c[425], $c[424], $c[427], $c[426], $c[429], $c[428], $c[431], $c[430], 
                              $c[433], $c[432], $c[435], $c[434], $c[437], $c[436], $c[439], $c[438], $c[441], $c[440], $c[443], $c[442], $c[445], $c[444], $c[447], $c[446], 
                              $c[449], $c[448], $c[451], $c[450], $c[453], $c[452], $c[455], $c[454], $c[457], $c[456], $c[459], $c[458], $c[461], $c[460], $c[463], $c[462], 
                              $c[465], $c[464], $c[467], $c[466], $c[469], $c[468], $c[471], $c[470], $c[473], $c[472], $c[475], $c[474], $c[477], $c[476], $c[479], $c[478], 
                              $c[481], $c[480], $c[483], $c[482], $c[485], $c[484], $c[487], $c[486], $c[489], $c[488], $c[491], $c[490], $c[493], $c[492], $c[495], $c[494], 
                              $c[497], $c[496], $c[499], $c[498], $c[501], $c[500], $c[503], $c[502], $c[505], $c[504], $c[507], $c[506], $c[509], $c[508], $c[511], $c[510]);
        print $fout $bytes_out;
}

编辑我现在就是这样做的。瞬间发生 ;)

my ($buf, $data, $n, $bytes);

 while (($n = read $infile, $data, 16384) != 0) {
    print $outfile pack("v*", unpack("n*", $data));
    $bytes+=$n;
}

使用 pack/unpack 的速度更快……呈指数增长

Answer 1

下次您想做类似的事情时，请使用切片!

print $fout join '', @c[1,0,3,2,...];

但这不会对速度产生太大影响。下面应该会好很多。

print $fout pack 'N*', unpack 'V*', pack 'v*', unpack 'n*', $bytes_in;

或

$bytes =~ s/(..)(..)/$2$1/sg;
print $fout $bytes;

此外，一次读取更大的 block ，例如 64*1024。

---

当处理 512 字节的字符串时:(“list”是你的原始代码)

         Rate slice  list subst  pack
slice  3100/s    --   -7%  -38%  -86%
list   3327/s    7%    --  -34%  -85%
subst  5038/s   63%   51%    --  -77%
pack  21859/s  605%  557%  334%    --

处理 64KB 字符串时:

        Rate  list slice subst  pack
list  14.9/s    --   -2%  -60%  -92%
slice 15.2/s    2%    --  -59%  -92%
subst 37.1/s  148%  144%    --  -80%
pack   188/s 1160% 1135%  407%    --

基准代码:

use strict;
use warnings;

use Benchmark qw( cmpthese );

my @indexes = map { $_+1, $_+0, $_+3, $_+2 } 0..512/4-1;

my $list = join ',', map "\$c[$_]", @indexes;
my $slice = '@c['.join(',', @indexes).']';

my %tests512 = (
   list  => 'my @c = split //, $str; my $x = join "", '.$list.';',
   slice => 'my @c = split //, $str; my $x = join "", '.$slice.';',
   pack  => 'my $x = pack "N*", unpack "V*", pack "v*", unpack "n*", $str;',
   subst => '$str =~ s/(..)(..)/$2$1/sg; my $x = $str;',
);

my %tests64KB = (
   list  => 'my $x = join "", map { my @c = split //; '.$list.' } unpack "(a512)*", $str;',
   slice => 'my $x = join "", map { my @c = split //; '.$slice.' } unpack "(a512)*", $str;',
   pack  => 'my $x = pack "N*", unpack "V*", pack "v*", unpack "n*", $str;',
   subst => '$str =~ s/(..)(..)/$2$1/sg; my $x = $str;',
);

$_ = 'use strict; use warnings; our $str; ' . $_ . ' 1;'
   for values(%tests512), values(%tests64KB);

{ local our $str = "\x00" x 512;       cmpthese(-3, \%tests512 ); }
{ local our $str = "\x00" x (64*1024); cmpthese(-3, \%tests64KB); }