Performance Perl6：处理超大文件的最佳方式是什么？

上周我决定尝试一下Perl6，并开始重新实施我的一个程序。 我不得不说，Perl6对于对象编程来说非常容易，这是Perl5中让我非常痛苦的一个方面

我的程序必须读取和存储大文件，例如整个基因组（高达3 Gb或更多，请参见下面的示例1）或表格数据

代码的第一个版本是以Perl5的方式通过逐行迭代（“genome.fa.IO.lines”）生成的。这是非常缓慢的，无法在正确的执行时间

my class fasta {
  has Str $.file is required;
  has %!seq;

  submethod TWEAK() {
    my $id;
    my $s;

    for $!file.IO.lines -> $line {
      if $line ~~ /^\>/ {
        say $id;
        if $id.defined {
          %!seq{$id} = sequence.new(id => $id, seq => $s);
        }
        my $l = $line;
        $l ~~ s:g/^\>//;
        $id = $l;
        $s = "";
      }
      else {
        $s ~= $line;
      }
    }
    %!seq{$id} = sequence.new(id => $id, seq => $s);
  }
}


sub MAIN()
{
    my $f = fasta.new(file => "genome.fa");
}

所以在进行了一点RTFM之后，我在文件上更改了一个slurp，在\n上进行了一个拆分，我用for循环解析了这个拆分。通过这种方式，我成功地在2分钟内加载了数据。效果更好，但还不够。通过作弊，我的意思是删除\n的最大值（例2），我将执行时间减少到30秒。相当好，但不是完全满意，通过这个fasta格式不是最常用的

my class fasta {
  has Str $.file is required;
  has %!seq;

  submethod TWEAK() {
    my $id;
    my $s;

    say "Slurping ...";
    my $f = $!file.IO.slurp;

    say "Spliting file ...";
    my @lines = $f.split(/\n/);

    say "Parsing lines ...";
    for @lines -> $line {
      if $line !~~ /^\>/ {
          $s ~= $line;
      }
      else {
        say $id;
        if $id.defined {
          %!seq{$id} = seq.new(id => $id, seq => $s);
        }
        $id = $line;
        $id ~~ s:g/^\>//;
        $s = "";
      }
    }
    %!seq{$id} = seq.new(id => $id, seq => $s);
  }
}

sub MAIN()
{
    my $f = fasta.new(file => "genome.fa");
}

所以我又一次发现了语法的魔力。因此，无论使用何种fasta格式，新版本和45秒的执行时间。不是最快的方式，但更优雅和稳定

my grammar fastaGrammar {
  token TOP { <fasta>+ }

  token fasta   {<.ws><header><seq> }
  token header  { <sup><id>\n }
  token sup     { '>' }
  token id      { <[\d\w]>+ }
  token seq     { [<[ACGTNacgtn]>+\n]+ }

}

my class fastaActions {
  method TOP ($/){
    my @seqArray;

    for $<fasta> -> $f {
      @seqArray.push: seq.new(id => $f.<header><id>.made, seq => $f<seq>.made);
    }
    make @seqArray;
  }

  method fasta ($/) { make ~$/; }
  method id    ($/) { make ~$/; }
  method seq   ($/) { make $/.subst("\n", "", :g); }

}

my class fasta {
  has Str $.file is required;
  has %seq;

  submethod TWEAK() {

    say "=> Slurping ...";
    my $f = $!file.IO.slurp;

    say "=> Grammaring ...";
    my @seqArray = fastaGrammar.parse($f, actions => fastaActions).made;

    say "=> Storing data ...";
    for @seqArray -> $s {
      %!seq{$s.id} = $s;
    }
  }
}

sub MAIN()
{
    my $f = fasta.new(file => "genome.fa");
}

Fasta示例2：

>2L
GACAATGCACGACAGAGGAAGCAGAACAGATATTTAGATTGCCTCTCAT...            
>3R
TAGGGAGAAATATGATCGCGTATGCGAGAGTAGTGCCAACATATTGTGCT...

编辑 我应用了@Christoph和@timotimo的建议，并使用代码进行了测试：

my class fasta {
  has Str $.file is required;
  has %!seq;

  submethod TWEAK() {
    say "=> Slurping / Parsing / Storing ...";
    %!seq = slurp($!file, :enc<latin1>).split('>').skip(1).map: {
  .head => seq.new(id => .head, seq => .skip(1).join) given .split("\n").cache;
    }
  }
}


sub MAIN()
{
    my $f = fasta.new(file => "genome.fa");
}

我的班级fasta{
有Str$。文件是必需的；
有%！seq；
子方法调整（）{
说“=>Slurping/解析/存储…”；
%！seq=slurp（$！file，：enc）.split（'>'）。跳过（1）。映射：{
.head=>seq.new（id=>.head，seq=>.skip（1.join）给定的.split（“\n”）.cache；
}
}
}
副标题（）
{
我的$f=fasta.new（文件=>“genome.fa”）；
}

程序在2.7秒内完成，太棒了！ 我还在小麦基因组（10GB）上尝试了这个代码。它以35.2秒完成。 Perl6终于不那么慢了

---

非常感谢你的帮助

一个简单的改进是使用固定宽度编码，如

latin1

，以加快字符解码，尽管我不确定这会有多大帮助

就Rakudo的正则表达式/语法引擎而言，我发现它相当慢，因此可能确实需要采取更低级的方法

我没有做任何基准测试，但我首先要做的是这样的：

my %seqs = slurp('genome.fa', :enc<latin1>).split('>')[1..*].map: {
    .[0] => .[1..*].join given .split("\n");
}

最后，使用NQP内置代码重写命令式版本将速度提高了17倍，但考虑到潜在的可移植性问题，通常不鼓励编写此类代码，但如果您确实需要该级别的性能，现在可能需要：

use nqp;

my Mu $seqs := nqp::hash();
my str $data = slurp('genome.fa', :enc<latin1>);
my int $pos = 0;

my str @lines;

loop {
    $pos = nqp::index($data, '>', $pos);

    last if $pos < 0;

    my int $ks = $pos + 1;
    my int $ke = nqp::index($data, "\n", $ks);

    my int $ss = $ke + 1;
    my int $se = nqp::index($data ,'>', $ss);

    if $se < 0 {
        $se = nqp::chars($data);
    }

    $pos = $ss;
    my int $end;

    while $pos < $se {
        $end = nqp::index($data, "\n", $pos);
        nqp::push_s(@lines, nqp::substr($data, $pos, $end - $pos));
        $pos = $end + 1
    }

    nqp::bindkey($seqs, nqp::substr($data, $ks, $ke - $ks), nqp::join("", @lines));
    nqp::setelems(@lines, 0);
}

使用nqp；
我的Mu$seqs:=nqp:：hash（）；
我的str$data=slurp（'genome.fa'，：enc）；
我的int$pos=0；
我的str@lines；
环路{
$pos=nqp:：索引（$data，'>'，$pos）；
如果$pos<0，则为最后一个；
我的整数$ks=$pos+1；
我的int$ke=nqp:：index（$data，“\n”，$ks）；
my int$ss=$ke+1；
我的int$se=nqp:：index（$data，'>'，$ss）；
如果$se<0{
$se=nqp:：字符（$data）；
}
$pos=$ss；
我的int$end；
而$pos<$se{
$end=nqp:：index（$data，“\n”，$pos）；
nqp:：push_s（@lines，nqp:：substr（$data，$pos，$end-$pos））；
$pos=$end+1
}
nqp:：bindkey（$seqs，nqp:：substr（$data，$ks，$ke-$ks），nqp:：join（“，@lines））；
nqp:：setelems（@lines，0）；
}

您已经在尝试几种不同的机制。如果没有更多关于您尝试做什么的细节，您将很难回答这个问题。限制范围从11m30到17m20。（我很确定他没有将命运从STD移植到NQP。）请查看并使用P6+P5？1） P6在P5中，2）P5在P6中。改进你的P5OO？Stevan设计了P6OO，然后Moose设计了P5，现在你的第一个例子可以通过将正则表达式的使用降到零来加快速度；在我的机器上，随着这些变化，

$file.IO.slurp.lines

而不是

$file.IO.lines

，

$line.从（“>”）开始，而不是
行~/^>/
，
$l=$l.substr（1）
而不是
$l~~s:///code>。另外，从循环中删除“say$id”。如果你真的需要输出，也许
put%！seq.keys.join（“\n”）
在TWEAK末尾或在单独的方法中。对于任何想要尝试该脚本的人，这里有一个生成一些示例fasta数据的单行代码：
my$f=“genome.fa”.IO.open（：w）；my@ids=（“A”。“Z”）.组合（20）.pick（*）；虽然$f.tell<300_000_000{$f.put（“>”~@ids.shift.join（））；$f.put（.roll（80.join（））for ^（2..15）.pick}
我不确定它是否属于评论，或者属于自己的答案，但我写了一篇关于这个问题的博客文章：“请快一点”：使用
.skip（1）可以大大加快你的第一个答案
而不是
[1..*]
，以及
.head
和
。跳过循环体内部的（1）
；此外，它还需要将
.split（“\n”）
增强为
.split（\n”）.cache
，以便head和skip方法对其进行处理。在我的机器上从47秒下降到12秒。我有更多的想法，在后面的评论中，或者可能有自己的答案。第二段代码的简要介绍显示，花费的时间主要来源于
。^
范围构造函数操作符。使用
$pos，$end-$pos
而不是
$pos..^$end
将我的时间从16.2秒减少到8.75秒，因此几乎缩短了一半。在输入打破该假设之前，moarvm不会自动执行类似于假设拉丁1编码的操作吗？换句话说，
：enc
对于一个实际上是拉丁1的文件来说，从性能的角度来看，它不是很大程度上或者完全是多余的吗？@raiph它所做的是尝试存储从utf8源读取的数据，每个字位数为8位，直到遇到不合适的情况，在这一点上它将转换为每个字位数为32位。我确实相信，utf8解码器比拉丁1解码器投入了更多的优化工作，当我尝试切换编码时，几乎没有任何区别。将带有本机int的版本转换为使用nqp ops（顺便说一句，这些代码没有官方支持，使用这些
my %seqs;
my $data = slurp('genome.fa', :enc<latin1>);
my $pos = 0;
loop {
    $pos = $data.index('>', $pos) // last;

    my $ks = $pos + 1;
    my $ke = $data.index("\n", $ks);

    my $ss = $ke + 1;
    my $se = $data.index('>', $ss) // $data.chars;

    my @lines;

    $pos = $ss;
    while $pos < $se {
        my $end = $data.index("\n", $pos);
        @lines.push($data.substr($pos..^$end));
        $pos = $end + 1
    }

    %seqs{$data.substr($ks..^$ke)} = @lines.join;
}

my %seqs = slurp('genome.fa', :enc<latin-1>).split('>').skip(1).map: {
    .head => .skip(1).join given .split("\n").cache;
}

use nqp;

my Mu $seqs := nqp::hash();
my str $data = slurp('genome.fa', :enc<latin1>);
my int $pos = 0;

my str @lines;

loop {
    $pos = nqp::index($data, '>', $pos);

    last if $pos < 0;

    my int $ks = $pos + 1;
    my int $ke = nqp::index($data, "\n", $ks);

    my int $ss = $ke + 1;
    my int $se = nqp::index($data ,'>', $ss);

    if $se < 0 {
        $se = nqp::chars($data);
    }

    $pos = $ss;
    my int $end;

    while $pos < $se {
        $end = nqp::index($data, "\n", $pos);
        nqp::push_s(@lines, nqp::substr($data, $pos, $end - $pos));
        $pos = $end + 1
    }

    nqp::bindkey($seqs, nqp::substr($data, $ks, $ke - $ks), nqp::join("", @lines));
    nqp::setelems(@lines, 0);
}