【Perl6】あの素晴らしい「進捗どうですか？？？」をもう一度

こんばんは
Perl 6 Advent Calendar 2015の14日目です¹
今日は「進捗どうですか？？？」ネタのPerl5版をPerl6で書いてみます²

① 進捗どうですかブーム???に Perl でのりかかる - Qiita

まずは、この記事のコメント欄にあったソースをPerl6で書いてみます³

use v6;

my Str constant @dict = < 進捗 どう です か >;
my Str constant $qqq  = '？？？';
my Int $c = $qqq.chars;

until my Str @s = () {
  LAST {
    say $qqq;
    say $c ~ "文字で煽られました";
  }

  for @dict {
    # @s.push: @dict[ @dict.elems.rand.Int ];
    @s.push: @dict.pick;
    $c += @s[*-1].chars;
  }
  print @s;

  last if @dict eq @s;
}

ループを抜ける時に実行されるLASTブロックに出力処理を集めています。
あと、配列の中身から無作為抽出する処理でArray.pickが地味にいい仕事をします。

---

2016/01/06追記

そして、前述のコメントに筆者さんがコメント返されていました。

進捗どうですかブーム???に Perl でのりかかる - Qiita

それは４個毎に出力して最後の４個を比較しているので、途中で文字列が完成していても気づけないケースがありそうですね。

マジだ…

---

つぎに、本文の末尾再帰最適化 verをPerl6で書いてみます。

use v6;

my Str constant @words    = < 進捗 どう です か > ;
my Str constant $end_word = '???';

my Int $length = 0;
my @cache;

loop {
  LAST {
    print $end_word;
    $length += $end_word.chars;
    printf "\n%d文字で煽られました\n", $length;
  }

  print my $word = @words.pick;
  $length += $word.chars;
  @cache.push: $word;
  @cache.shift while @cache > @words;

  last if @cache eq @words ;
}

最適はやい。すてき。

② 十周くらい遅い、進捗どうですか。 - Qiita

つぎはこの方のソースをPerl6で書いてみます。

use v6;

my Str constant @words = < 進捗 どう です か >;
my Str @cache;

while 1 {
  @cache.push: @words.pick;
  last if @words eq @cache[ *-4 .. *-1 ];

  LAST {
    say my $c = [~] @cache.push: '？？？';
    printf "%d文字で煽られました\n", $c.chars ;
  }
}

元が簡潔に書かれていたこともありすっきりしています。

③ 「進捗・どう・です・か」をPerlで - Qiita

最後は自分のを。

use v6;

my Str constant @words = < 進捗 どう です か >;
my Str $w = @words.join;
my Str $word_buffer = '';

while 1 {
  $word_buffer ~= @words.pick;

  last if $word_buffer ~~ m:overlap/ <{ $w }> $$ /;

  LAST {
    $word_buffer ~= '？？？';
    say $word_buffer;
    say $word_buffer.chars, "文字で煽られました。";
  }
}

文字列$word_bufferの後ろの方を正規表現でチェックしています。
この場合、正規表現ではなくてStr.ends-withでもよいかんじ。

use v6;

my Str constant @words = < 進捗 どう です か >;
my Str constant $w = [~] @words;
my Str $word_buffer = '';

while 1 {
  $word_buffer ~= @words.pick;

  last if $word_buffer.ends-with( $w );

  LAST {
    $word_buffer ~= '？？？';
    say $word_buffer;
    say $word_buffer.chars, "文字で煽られました。";
  }
}

おわりです。
そして今日も進捗は芳しくない。

参考と注釈

• Perl5,Perl6で配列の末尾からひとつ前の要素を取り出す - Qiita
• Control Flow - Perl 6 Documentation

1. 事故レベルの遅刻 ↩

2. 本当はInline::Perl5 モジュールネタを書こうと思っていたけど自分の環境ではセットアップできなかったのです。 ↩

3. これが「？？？」も文字数カウントに入れていたので以降それに倣います。 ↩