正規表現クロスワード

目的もなくネット上を散策しているときに、「正規表現クロスワード」のページを見つけました。面白そうでしたので、Perl で挑戦してみることにしました。なお、パズルの詳細を知るためにも、下記のリンクから元のページもご覧ください。

            21  20
           ↙  ↙  ↙  ↙
    1 → □  □  □  □  ↙
  2 → □  □  □  □  □  ↙
  → □  □  □  □  □  □  ↙
→ □  □  Ｋ  Ｉ  Ｉ  □  □
  → □  □  □  □  □  □  ↖
    → □  □  □  □  □  ↖  14
      → □  □  □  □  ↖
           ↖  ↖  ↖  ↖
             8


マス目番号
         11  12  13  14
       21  22  23  24  25
     31  32  33  34  35  36
   41  42  43  44  45  46  47
     51  52  53  54  55  56
       61  62  63  63  65
         71  72  73  74

正規表現文字列
  1: [REDIS][AWS][JETTY]+
  2: [JAVA]+[DOCKER]+[EXPRESS]
  3: [HUBOT][SPRING]+ 
  4: [MONIT][EMBULK][KIBANA]+IOT
  5: [CONSUL]+[SENTRY]+[MYSQL]+
  6: [PIPELINEDB]+
  7: [HEROKU]+[ES6]
  8: [SDK]+([FLUENTD])\1
  9: [CONCOUR][SE][CI][BASH]+
 10: [LUIGI]+[JAVASCRIPT][KAFKA][AGILE]+
 11: \d([VIM]([MARKDOWN]))\1[EMACS]\2
 12: [PUPPET][QA](.)\1[SERVERSPEC][W3C]
 13: [MONGODB]+[NOMAD][ELASTIC][SEARCH]
 14: [GITHUB]+[ZABBIX][OPENRESTY]
 15: [TOMCAT]+[IPV6]+
 16: (GO|RUBY|PERL|PYTHON)[MQTT][LINUX]+
 17: [NGINX]+[REST][LUA]+
 18: [JENKINS]+
 19: [TE]RR[^AFORM][SLACK][MODEJS]
 20: [WYSIWYG][RAILS]+[ANSIBLE]+
 21: [VAR]+[NISH]+

六角形の小さなマス目が並べられて、大きな１つの六角形を形成しています。回りには正規表現が書かれていて、その正規表現がすべて成立するように、小さなマス目の空いているところに１文字ずつを割り当てていきます。画像から正規表現を読み取るのは難しいので、別に書き出してあります。中央の図の矢印側が文字列の始点になるので、例えば 8 番の正規表現は、71, 61, 51, 41 の順に並んだ文字列に適用されます。また、解法プログラムの中では、マス目の番号を 11, 12, ....., 73, 74 のように付けています。

while 1: マス目、正規表現データの読み込み

今回のプログラムでは、小さな仕事をする while ループを積み重ねることにしました。最初の while ループでは、マス目と正規表現のデータを読み込んで、マス目データの分解とマス目の文字 (または複数候補文字) を管理する %char ハッシュの初期化を行います。すでに割り当て済みのマス目 (43: K, 44: I, 45: I) は文字そのものを格納し、それ以外は複数の文字を格納できるように無名配列を割り当てておきます。また、while ループ間でのデータを受け渡すために、@work_1 と @work_2 の２つの配列を用意します。

use strict;
use warnings;
my %char = (43 => 'K', 44 => 'I', 45 => 'I');
my (@work_1, @work_2);

while (<DATA>) {
  my ($patt, $key) = split;
  $patt =~ s/\\d/[0123456789]/g;
  if ($patt =~ s/\(([^\(]+)\(([^\)]+)\)([^\)]+)\)/($1)($2)($3)/) {
    $patt =~ s/\\1/\\1\\2\\3/g;
  } elsif ($patt =~ s/\(([^\(]+)\(([^\)]+)\)\)/($1)($2)/) {
    $patt =~ s/\\1/\\1\\2/g;
  } elsif ($patt =~ s/\(\(([^\)]+)\)([^\)]+)\)/($1)($2)/) {
    $patt =~ s/\\([12])/$1 == 1 ? '\1\2' : '\1'/eg;
  }
  my @key = split /,/, $key;
  foreach my $i (@key) { $char{$i} = [] unless exists($char{$i}); }
  push @work_1, [\@key, $patt];
}

__DATA__
[REDIS][AWS][JETTY]+    11,12,13,14
[JAVA]+[DOCKER]+[EXPRESS]   21,22,23,24,25
[HUBOT][SPRING]+    31,32,33,36,35,36
[MONIT][EMBULK][KIBANA]+IOT 41,42,43,44,45,46,47
[CONSUL]+[SENTRY]+[MYSQL]+  51,52,53,54,55,56
[PIPELINEDB]+   61,62,63,64,65
[HEROKU]+[ES6]  71,72,73,74
[SDK]+([FLUENTD])\1 71,61,51,41
[CONCOUR][SE][CI][BASH]+    72,62,52,42,31
[LUIGI]+[JAVASCRIPT][KAFKA][AGILE]+ 73,63,53,43,32,21
\d([VIM]([MARKDOWN]))\1[EMACS]\2    74,64,54,34,33,22,11
[PUPPET][QA](.)\1[SERVERSPEC][W3C]  65,55,45,34,23,12
[MONGODB]+[NOMAD][ELASTIC][SEARCH]  56,46,35,24,13
[GITHUB]+[ZABBIX][OPENRESTY]    47,36,25,14
[TOMCAT]+[IPV6]+    47,56,65,74
(GO|RUBY|PERL|PYTHON)[MQTT][LINUX]+ 36,46,55,64,73
[NGINX]+[REST][LUA]+    25,35,45,54,63,72
[JENKINS]+  14,24,34,44,53,62,71
[TE]RR[^AFORM][SLACK][NODEJS]   13,23,33,43,52,61
[WYSIWYG][RAILS]+[ANSIBLE]+ 12,22,32,42,51
[VAR]+[NISH]+   11,21,31,41

正規表現の分解は次の節の while ループで行いますが、ここでは分解前に必要な処理だけを行います。１つ目は \d を文字クラス [0123456789] に変換しておくことで、他の多くの文字クラスと同じように処理できるようになります。2 つ目が、入れ子になっている丸カッコを展開することです。丸カッコの中に１つの丸カッコが入っている場合は、次の 3 つのパターンのいずれかになります。例えば、正規表現データ中の ([VIM](MARKDOWN)) の場合には、2 番目のパターンに展開されます。

...(...(...)...)...\1...\2...  =>  ...(...)(...)(...)...\1\2\3...\2...
...(...(...))...\1...\2...     =>  ...(...)(...)...\1\2...\2...
...((...)...)...\1...\2...     =>  ...(...)(...)...\1\2...\1...

2 つの処理の適用を受けるのは１行のみであり、適用後は次のようになります。

\d([VIM]([MARKDOWN]))\1[EMACS]\2  =>  [0123456789]([VIM])([MARKDOWN])\1\2[EMACS]\2

処理済みのデータは、配列 @work_1 に格納されます。while ループ終了時の @work_1 の内容は、以下のようになります。各行のデータは無名配列に格納され、その中に 2 つの要素が格納されます。最初がマス目番号のリスト、2 つ目が正規表現の文字列データとなります。

[[11, 12, 13, 14],             '[REDIS][AWS][JETTY]+'],
[[21, 22, 23, 24, 25],         '[JAVA]+[DOCKER]+[EXPRESS]'],
[[31, 32, 33, 36, 35, 36],     '[HUBOT][SPRING]+'],
[[41, 42, 43, 44, 45, 46, 47], '[MONIT][EMBULK][KIBANA]+IOT'],
[[51, 52, 53, 54, 55, 56],     '[CONSUL]+[SENTRY]+[MYSQL]+'],
[[61, 62, 63, 64, 65],         '[PIPELINEDB]+'],
[[71, 72, 73, 74],             '[HEROKU]+[ES6]'],
[[71, 61, 51, 41],             '[SDK]+([FLUENTD])\1'],
[[72, 62, 52, 42, 31],         '[CONCOUR][SE][CI][BASH]+'],
[[73, 63, 53, 43, 32, 21],     '[LUIGI]+[JAVASCRIPT][KAFKA][AGILE]+'],
[[74, 64, 54, 34, 33, 22, 11], '[0123456789]([VIM])([MARKDOWN])\1\2[EMACS]\2'],
[[65, 55, 45, 34, 23, 12],     '[PUPPET][QA](.)\1[SERVERSPEC][W3C]'],
[[56, 46, 35, 24, 13],         '[MONGODB]+[NOMAD][ELASTIC][SEARCH]'],
[[47, 36, 25, 14],             '[GITHUB]+[ZABBIX][OPENRESTY]'],
[[47, 56, 65, 74],             '[TOMCAT]+[IPV6]+'],
[[36, 46, 55, 64, 73],         '(GO|RUBY|PERL|PYTHON)[MQTT][LINUX]+'],
[[25, 35, 45, 54, 63, 72],     '[NGINX]+[REST][LUA]+'],
[[14, 24, 34, 44, 53, 62, 71], '[JENKINS]+'],
[[13, 23, 33, 43, 52, 61],     '[TE]RR[^AFORM][SLACK][NODEJS]'],
[[12, 22, 32, 42, 51],         '[WYSIWYG][RAILS]+[ANSIBLE]+'],
[[11, 21, 31, 41],             '[VAR]+[NISH]+']

while 2: 正規表現の分割と展開

２つ目の while ループでは、１つ目のループで手を付けなかった正規表現文字列の分割を行います。分割の単位は、"文字クラス"、"リテラル文字"、"丸カッコ文字列"、"後方参照文字列" の４種類になります。"文字クラス" には、否定文字クラスと量指定子 (今回のデータでは + のみ) が含まれます。

正規表現文字列は変数 $patt に入れられ、先頭から種類ごとに切り出し、配列 @regex に格納されます。その際に、文字クラスのみは、効率を考えて重複した文字を削除 (例: [EXPRESS] => [XPRES]) しておきます。なお、丸カッコの中に１つの文字クラスという文字列 (例: ([FLUENTD])) が 3 つあるのですが、いずれも重複した文字がないので手抜きしたコードになっています。

while (my $ref = shift @work_1) {
  my ($patt, @key, @regex) = ($ref->[1], @{$ref->[0]});
  while ($patt) {
    if ($patt =~ s/^(\[\^?\w+\]\+?)//) {
      my $copy = $1;
      $copy =~ s/(\w)(?=.*\1)//g;
      push @regex, $copy;
    } elsif ($patt =~ s/^(\w)//) {
      push @regex, $1;
    } elsif ($patt =~ s/^(\([^\)]+\))//) {
      push @regex, $1;
    } elsif ($patt =~ s/^(\\.)//) {
      push @regex, $1;
    }
  }

  if (join('',@regex) =~ /\(((?:\w+\|)+\w+)\)(?!.*\\)/) {
    my (@select, @choice) = split /\|/, $1;
    my ($i) = grep { $regex[$_] =~ /\(/ } 0 .. $#regex;
    foreach my $item (@select) {
      push @choice, $item if (length($item) + @regex - 1) <= @key;
    }
    if (@choice == 1) {
      splice @regex, $i, 1, split(//, $choice[0]);
    } elsif (@choice > 1) {
      $regex[$i] =~ s/\(.+\)/'(' . join('|', @choice) . ')'/e;
    }
  }

  my @plus_idx = grep { $regex[$_] =~ /\+$/ } 0 .. $#regex;
  if (@plus_idx == 1) {
    my $i = $#key - $#regex;
    my $copy = $regex[$plus_idx[0]]; $copy =~ s/\+$//;
    splice @regex, $plus_idx[0], 1, ($copy) x ($i + 1);
  } elsif (@plus_idx >= 2) {
    my $copy = $regex[$plus_idx[-1]]; $copy =~ s/\+$//;
    $regex[$plus_idx[-1]] =~ s/\+$/*/;
    splice @regex, $plus_idx[-1] + 1, 0, $copy;
    $copy = $regex[$plus_idx[0]]; $copy =~ s/\+$//;
    $regex[$plus_idx[0]] =~ s/\+$/*/;
    splice @regex, $plus_idx[0], 0, $copy;
  }

  $ref->[1] = \@regex;
  push @work_2, $ref;
}

正規表現を分割したら、選択や量指定子が含まれていないかチェックします。選択が含まれているのは、次の 1 つのデータのみです。マス目のリストから、５文字の文字列に適用される正規表現であることがわかります。

[36, 46, 55, 64, 73],   ['(GO|RUBY|PERL|PYTHON)', '[MQTT]',  '[LINUX]+']

正規表現リストには選択の他に２つの文字クラスが含まれ、そのうちの１つに量指定子 + が含まれているので、最少でも２文字消費されることになります。選択に許されるのは、最多でも 3 文字ということになります。したがって、4 文字以上の選択肢は許されないことになり、GO 以外は選択肢から除去することができます。また、後方参照もないので、丸カッコも除去することでき、結果 GO はリテラル文字なので分割できます。

['(GO|RUBY|PERL|PYTHON)', '[MQTT]',  '[LINUX]+'] => ['G', 'O', '[MQTT]', '[LINUX]+']

+ や * の量指定子の処理は、１つの場合と２つ以上の場合で分けて考えます。1 つの場合は、文字数が分かっているので簡単です。上記の選択を処理後のデータにも、量指定子 + が１つ含まれています。他の正規表現はすべて１文字にマッチするので、[LINUX]+ を [LINUX] ２つに変換します。

[36, 46, 55, 64, 73],   ['G', 'O', '[MQTT]',  '[LINUX]+'] => ['G', 'O', '[MQTT]',  '[LINUX]', '[LINUX]']

量指定子が２つ以上含まれている場合、最初または最後 (または両方) の + を、正規表現の性質上から次のように変換できます。今回のパズルには * が使われていないので、かならず最初と最後の両方を変換できます。これで、マス目 36 に [CONSUL] が、マス目 56 に [MYSQL] が適用されることがハッキリします。

[51, 52, 53, 54, 55, 56],
['[CONSUL]+', '[SENTRY]+' '[MYSQL]+']  =>  ['[CONSUL]', '[CONSUL]*', '[SENTRY]+', '[MYSQL]*', '[MYSQL]']

２つ目の while で処理したデータは、次の while ループに渡すために配列 @work_2 に保存します。@work_2 の内容は、次のようになります。

[[11, 12, 13, 14],             ['[REDIS]', '[AWS]', '[JETY]', '[JETY]']],
[[21, 22, 23, 24, 25],         ['[JVA]', '[JVA]*', '[DOCKER]*', '[DOCKER]', '[XPRES]']],
[[31, 32, 33, 36, 35, 36],     ['[HUBOT]', '[SPRING]', '[SPRING]', '[SPRING]', '[SPRING]', '[SPRING]']],
[[41, 42, 43, 44, 45, 46, 47], ['[MONIT]', '[EMBULK]', '[KIBNA]', '[KIBNA]', 'I', 'O', 'T']],
[[51, 52, 53, 54, 55, 56],     ['[CONSUL]', '[CONSUL]*', '[SENTRY]+', '[MYSQL]*', '[MYSQL]']],
[[61, 62, 63, 64, 65],         ['[PLINEDB]', '[PLINEDB]', '[PLINEDB]', '[PLINEDB]', '[PLINEDB]']],
[[71, 72, 73, 74],             ['[HEROKU]', '[HEROKU]', '[HEROKU]', '[ES6]']],
[[71, 61, 51, 41],             ['[SDK]', '[SDK]', '([FLUENTD])', '\1']],
[[72, 62, 52, 42, 31],         ['[NCOUR]', '[SE]', '[CI]', '[BASH]', '[BASH]']],
[[73, 63, 53, 43, 32, 21],     ['[LUGI]', '[LUGI]*', '[JVASCRIPT]', '[FKA]', '[AGILE]*', '[AGILE]']],
[[74, 64, 54, 34, 33, 22, 11], ['[0123456789]', '([VIM])', '([MARKDOWN])', '\1', '\2', '[EMACS]', '\2']],
[[65, 55, 45, 34, 23, 12],     ['[UPET]', '[QA]', '(.)', '\1', '[VRSPEC]', '[W3C]']],
[[56, 46, 35, 24, 13],         ['[MNGODB]', '[MNGODB]', '[NOMAD]', '[ELASTIC]', '[SEARCH]']],
[[47, 36, 25, 14],             ['[GITHUB]', '[GITHUB]', '[ZABIX]', '[OPNRESTY]']],
[[47, 56, 65, 74],             ['[OMCAT]', '[OMCAT]*', '[IPV6]*', '[IPV6]']],
[[36, 46, 55, 64, 73],         ['G', 'O', '[MQT]', '[LINUX]', '[LINUX]']],
[[25, 35, 45, 54, 63, 72],     ['[GINX]', '[GINX]*', '[REST]', '[LUA]*', '[LUA]']],
[[14, 24, 34, 44, 53, 62, 71], ['[JEKINS]', '[JEKINS]', '[JEKINS]', '[JEKINS]', '[JEKINS]', '[JEKINS]', '[JEKINS]']],
[[13, 23, 33, 43, 52, 61],     ['[TE]', 'R', 'R', '[^AFORM]', '[SLACK]', '[NODEJS]']],
[[12, 22, 32, 42, 51],         ['[SIWYG]', '[RAILS]', '[RAILS]*', '[ANSIBLE]*', '[ANSIBLE]']],
[[11, 21, 31, 41],             ['[VAR]', '[VAR]*', '[NISH]*', '[NISH]']]

while 3: マス目への文字の割り当て

３番目の while ループでは、マス目番号と正規表現の対応関係が決定しているペアをハッシュ %char に登録等の作業をします。なお、対応関係が決定していないマス目は、スキップして後の処理に委ねます。

[[11, 12, 13, 14],     ['[REDIS]', '[AWS]', '[JETY]', '[JETY]']]                 # すべてのマス目
[[21, 22, 23, 24, 25], ['[JVA]', '[JVA]*', '[DOCKER]*', '[DOCKER]', '[XPRES]']]  # 21, 25, 24 のマス目

マス目数と正規表現数が同じでも、対応関係が決定しているわけではありません。上記の例では、[JVA] が２つ、[JVA] と [DOCKER] が１つずつ、[DOCKER] が２つ、の３つのケースが考えられます。正規表現に量指定子が含まれている場合は、先頭と末尾から対応関係が決定しているマス目を取得します。

while (my $ref = shift @work_2) {
  my ($r_key, $r_reg) = @$ref;
  my @aster_idx = grep { $r_reg->[$_] =~ /\*$/ } 0 .. $#{$r_reg};
  if (@aster_idx) {
    my @quiry_idx;
    foreach my $i (0 .. $#$r_reg) {
      last if $r_reg->[$i] =~ /\*$/;
      push @quiry_idx, $i;
    }
    foreach my $i (reverse -7 .. -1) {
      last if $r_reg->[$i] =~ /\*$/;
      push @quiry_idx, $i;
    }
    assign($r_key->[$_], $r_reg->[$_]) foreach @quiry_idx;
  } else {
    assign($r_key->[$_], $r_reg->[$_]) foreach 0 .. $#$r_reg;
  }
  push @work_1, $ref if grep /\*$|\(/, @$r_reg;
}

３番目の while ループは非常に短いもので、多くの作業はサブルーチン assign で行なっています。サブルーチンには、マス目番号と正規表現を渡します。このループで保存しておくのは、後の処理に委ねる * や (...) が含むものだけになります。

sub assign {
  my ($key, $patt) = @_;
  if (!ref $char{$key}) {
    if ($patt =~ /^\[\^/) {
      if ($patt =~ /$char{$key}/) {
        print "error occurred\n";
        exit;
      }
    } elsif ($patt =~ /^\(?\[/) {
      if ($patt !~ /$char{$key}/) {
        print "error occurred\n";
        exit;
      }
    } elsif (length($patt) == 1) {
      if ($patt ne $char{$key}) {
        print "error occurred\n";
        exit;
      }
    }
  } elsif (@{$char{$key}} == 0) {
    if ($patt =~ /^\(?\[/) {
      push @{$char{$key}}, grep(/\w/, split //, $patt);
    } elsif (length($patt) == 1) {
      $char{$key} = $patt;
    }
  } else {
    if (length($patt) == 1) {
      if (grep /$patt/, @{$char{$key}}) {
        @{$char{$key}} = ($patt);
      } else {
        print "error occurred\n";
        exit;
      }
    } elsif ($patt =~ /^\(?\[/) {
      foreach my $i (reverse 0 .. $#{$char{$key}}) {
        splice @{$char{$key}}, $i, 1 if $patt !~ /$char{$key}->[$i]/;
      }
    }  elsif ($patt =~ /^\[\^/) {
      foreach my $i (reverse 0 .. $#{$char{$key}}) {
        splice @{$char{$key}}, $i, 1 if $patt =~ /$char{$key}->[$i]/;
      }
    }
    if (@{$char{$key}} == 1) {
      $char{$key} = $char{$key}->[0];
    }
  }
}

サブルーチン assign での主役は %char ハッシュになります。初期状態では、文字が確定しているのが３マス (43:K, 44:I, 45:I) で、その他のマス目が空の無名配列になります。無名配列には、その後の処理で文字クラスから候補文字が入ることになります。ハッシュ %char の値の状態は 3 つあり、それぞれに分けて処理します。

$char{$key}: 確定文字
すでに文字は確定しているので、チェック作業のみを行います。文字クラスであれば含まれていることを、否定文字クラスであれば含まれていないことを、リテラル文字であれば同じあることを確認します。
$char{$key}: 空の無名配列
空の無名配列の場合には、とりあえず渡されたものを受け入れておきます。文字クラスであれば各文字を文字候補として無名配列に入れ、リテラル文字であれば無名配列を削除して上書き代入します。

空の無名配列の処理に、否定文字クラスが含まれていません。残りの文字すべてを無名配列に入れるのも現実的ではありませんし、チェック作業を行うこともできません。今回の正規表現データには否定文字クラスは 1 つだけであり、それも末尾に近い位置なので問題になりませんが、たくさんの否定文字クラスがある場合は別の対策が必要になります。
$char{$key}: 候補文字が入った無名配列
各候補文字の妥当性をチェックしていきます。文字クラスであれば含まれていることを、否定文字クラスであれば含まれていないことを、リテラル文字ならば同じことをチェックし、該当しなければ無名配列から除去されることになります。なお、この作業の後は無名配列に含む文字が 1 つに減ることがあり、その場合は確定文字として上書き代入します。

3番目の while が終わった段階で、%char ハッシュの状態は次のようになります。文字が確定されていない 10 のマス目が残っていることになります。

11: R      12: W             13: E                14: E
21: A      22: A,S           23: R                24: E                 25: X
31: H,B    32: S,P,R,I,N,G   33: R                34: J,E,K,I,N,S       35: N    36: G
41: N,I    42: B             43: K                44: I                 45: I    46: O   47: T
51: N,L    52: C             53: J,E,K,I,N,S      54: M,A,R,K,D,O,W,N   55: Q    56: M
61: D      62: E             63: P,L,I,N,E,D,B    64: I                 65: P,E
71: K      72: U             73: U                74: 6

while 4: 丸カッコと後方参照

通常の正規表現では丸カッコが具体的文字列を捕捉した後に後方参照が行われますが、今回の「正規表現クロスワード」では後方参照を丸カッコ側が参照することもできます。言い換えると、丸カッコと後方参照を 1 つのグループとして扱い、対等なメンバと考えることができます。

while (my $ref = shift @work_1) {
  my ($r_key, $r_reg) = @$ref;
  my @paren_idx = grep { $r_reg->[$_] =~ /^\(/ } 0 .. $#$r_reg;
  if (@paren_idx) {
    foreach my $i (0 .. $#paren_idx) {
      my $j = $i + 1; my (@paren_grp, @chars, %count);
      push @paren_grp, $r_key->[$paren_idx[$i]];
      push @paren_grp, $r_key->[$_] foreach grep { $r_reg->[$_] =~ /\\$j/ } 0 .. $#$r_reg;
      foreach my $k (@paren_grp) {
        push @chars, !ref($char{$k}) ? $char{$k} : @{$char{$k}};
      }
      ++$count{$_} foreach @chars;
      my @common = grep { $count{$_} == @paren_grp } keys %count;
      if (@common == 1) {
        ref($char{$_}) and $char{$_} = $common[0] foreach @paren_grp;
      } elsif (@common >= 2) {
        @{$char{$_}} = @common foreach @paren_grp;
      }
    }
  }
  push @work_2, $ref if grep /\*$/, @$r_reg;
}

丸カッコと後方参照に関連するマス目のデータを、ハッシュ %char から抜き出してみましょう。いずれのグループも、マス目の文字を確定できることがわかります。最初の 51:N,L と 41:N,I では、共通する文字が N なのでそれ以外の文字を除去することができます。2 番目以降のグループは、文字が確定しているマス目があるので簡単に特定することができます。

[71,61,51,41], ['[SDK]','[SDK]','([FLUENTD])','\1']
  (51:N,L  41:N,I) => (51:N  41:N)

[74,64,54,34,33,22,11], ['[0123456789]','([VIM])','([MARKDOWN])','\1','\2','[EMACS]','\2']
  (64:I  34:J,E,K,I,N,S) => (64:I  34:I)
  (54:M,A,R,K,D,O,W,N  33:R  11:R) => (54:R  33:R  11:R)

[65,55,45,34,23,12], ['[UPET]','[QA]','(.)','\1','[VRSPEC]','[W3C]']
  (45:I  34:J,E,K,I,N,S) => (45:I  34:I)

丸カッコと後方参照の処理で 4 つのマス目の文字を確定することでき、残る未確定のマス目は 6 つになりました。最後の while ループでは、量指定子の展開を行います。

while 5: 量指定子の展開

while 2: で扱った量指定子の展開は正規表現の性質から導き出したものですが、この節の展開は関連するマス目のデータとの照合で進めていくものです。マス目のデータがある程度揃うまで行うことができないので、最後の段階で行うのが適当です。ここでの目標は、正規表現中の量指定子をすべて除去することで、マス目と正規表現の１対１対応を確立することです。。

while (my $ref = shift @work_2) {
  my ($r_key, $r_reg) = @$ref;
  foreach my $i (0 .. $#$r_reg) {
    if ($r_reg->[$i] =~ /\*$/) {
      my $sq_char = ref $char{$r_key->[$i]} ? join('', @{$char{$r_key->[$i]}}) : $char{$r_key->[$i]};
      if ("$sq_char:$r_reg->[$i]" =~ /(\w).*:.*\1/) {
        if (join('', $sq_char, ':', $r_reg->[$i+1]) =~ /(\w).*:.*\1/) {
          expand($r_key, $r_reg);
          last;
        } else {
          my $copy = $r_reg->[$i]; $copy =~ s/\*$//;
          splice @$r_reg, $i, 0, $copy;
        }
      } else {
        splice @$r_reg, $i, 1;
        expand($r_key, $r_reg);
        redo if $r_reg->[$i] =~ /\*$/;
      }
    }
  }
  if (grep /\*$/, @$r_reg) {
    foreach my $i (reverse -7 .. -1) {
      if ($r_reg->[$i] =~ /\*$/) {
        my $sq_char = ref $char{$r_key->[$i]} ? join('', @{$char{$r_key->[$i]}}) : $char{$r_key->[$i]};
        if ("$sq_char:$r_reg->[$i]" =~ /(\w).*:.*\1/) {
          if (join('', $sq_char, ':', $r_reg->[$i-1]) =~ /(\w).*:.*\1/) {
            expand($r_key, $r_reg);
            last;
          } else {
            my $copy = $r_reg->[$i]; $copy =~ s/\*$//;
            splice @$r_reg, $i + 1, 0, $copy;
          }
        } else {
          splice @$r_reg, $i, 1;
          expand($r_key, $r_reg);
          next if grep /\*$/, @$r_reg;
          last;
        }
      }
    }
  }
  if (!grep /\*/, @$r_reg) { assign($r_key->[$_], $r_reg->[$_]) foreach 0 .. $#$r_key; }
  else { push @work_2, $ref; }
}

sub expand {
  my ($r_key, $r_reg) = @_;
  if (join('', @$r_reg) =~ /^[^*]*\+/) {
    my ($j) = grep { $r_reg->[$_] =~ /\+$/ } 0 .. $#$r_reg;
    my $copy = $r_reg->[$j]; $copy =~ s/\+//; $r_reg->[$j] =~ s/\+/*/;
    splice @$r_reg, $j, 0, $copy;
  }
  if (join('', @$r_reg) =~ /\+[^*]*$/) {
    my ($j) = grep { $r_reg->[$_] =~ /\+$/ } 0 .. $#$r_reg;
    my $copy = $r_reg->[$j]; $copy =~ s/\+//; $r_reg->[$j] =~ s/\+/*/;
    splice @$r_reg, $j + 1, 0, $copy;
  }
  if (join('', @$r_reg) =~ /^[^+*]*[+*][^+*]*$/) {
    my ($j) = grep { $r_reg->[$_] =~ /(\+|\*)$/ } 0 .. $#$r_reg;
    my $copy = $r_reg->[$j]; $copy =~ s/(\+|\*)$//;
    my $k = $#$r_key - $#$r_reg;
    splice @$r_reg, $j, 1, ($copy) x ($k + 1);
  }
  my @aster_idx = grep { $r_reg->[$_] =~ /\*$/ } 0 .. $#$r_reg;
  if (@aster_idx == 2 and $aster_idx[0] + 1 == $aster_idx[1] and $#$r_key < $#$r_reg) {
    my $second = splice @$r_reg, $aster_idx[1], 1;
    $second =~ s/\W//g; $r_reg->[$aster_idx[0]] =~ s/^\[/[$second/;
    $r_reg->[$aster_idx[0]] =~ s/(\w)(?=.*\1)//g; $r_reg->[$aster_idx[0]] =~ s/\*$//;
  }
}

少し分かりにくいところがあるので、具体的な例を挙げて説明しましょう。下記の例では、51 に [CONSEL] が、56 に [MYSQL] の対応が決定しています。量指定子 * が１個以上になる場合、最初の量指定子付正規表現 [CONSEL]* では必ず 52 に入り、２つ目以降は 53, 54, ... に入ることになります。最後の正規表現 [MYSQL]* では必ず 55 に入り、２つ目以降は 54, 53, ... に入ります。

[51,52,53,54,55,56], 51:N  52:C  53:J,E,K,I,N,S  54:R  55:Q  56:M
['[CONSEL]','[CONSEL]*','[SENTRY]+','[MYSQL]*','[MYSQL]']

量指定子 * のマッチは、始点のマス目から始めます。[CONSEL]* であれば 52 から、[MYSQL]* であれば 55 からということになり、マッチの可能性の有無でその後の処理が変わっていきます。

マッチの可能性がない
マス目の文字が確定している場合はその文字が含まれていない、複数の候補なら共通の文字がない場合に、該当の正規表現を削除することができます。次の例では、23 のマス目の文字が R なので [JVA]* を除去することができます。
```
   [21,22,23,24,25]  21:A  22:A,S  23:R  24:E  25:X
   ['[JVA]','[JVA]','[JVA]*','[DOCKER]*','[DOCKER]','[XPRES]']
=> ['[JVA]','[JVA]','[DOCKER]*','[DOCKER]','[XPRES]']
```
[JVA]* を除去すると量指定子が１つになるのでマス目数に合わせて展開することでき、結果として [DOCKER]* の * が取れて、すべてのマス目と正規表現が１対１で対応することになります。
マッチの可能性がある
マッチする可能性がある場合には、次の位置の正規表現のマッチ可能性の有無を調べます。下記の a. の例では、52 のマス目の正規表現 [SENTRY]+ のマッチ可能性の有無を調べ、その結果によりさらに処理が分岐します。
1. マッチの可能性がない
  52 のマス目には C が入っているので [CONSUL] にはマッチするが、[SENTRY] にはマッチしないので、52 のマス目には [CONSUL] が適用されることが確定します。この場合、正規表現 [CONSEL]* を [CONSEL][CONSEL]* (後ろからの例: [MYSQL]* => [MYSQL]*[MYSQL]) に展開できます。展開後は、53 のマス目に対して同様の処理を続けます。
```
   [51,52,53,54,55,56], 51:N  52:C  53:J,E,K,I,N,S  54:R  55:Q  56:M
   ['[CONSEL]','[CONSEL]*','[SENTRY]+','[MYSQL]*','[MYSQL]']
=> ['[CONSEL]','[CONSEL]','[CONSEL]*','[SENTRY]+','[MYSQL]*','[MYSQL]']
```
2. マッチの可能性がある
  53 のマス目の候補文字のいずれかは [CONSEL] にも [SENTRY] にもマッチするので、どちらの正規表現がマッチするか確定できないので、これ以上の処理は続けらないことにになります。この場合は、処理を中止して後ろの [MYSQL]* から処理を再開します。
```
   [51,52,53,54,55,56], 51:N  52:C  53:J,E,K,I,N,S  54:R  55:Q  56:M
   ['[CONSEL]','[CONSEL]','[CONSEL]*','[SENTRY]+','[MYSQL]*','[MYSQL]']
```
  今回のコードには組み込んでいませんが、53 のマス目の候補文字を絞り込むことができます。正規表現の並び [CONSEL]*[SENTRY]+ の最後の文字が + ですので、[CONSEL] と [SENTRY] のどちらか一方が適用されます。候補文字 J, K, I は、両方ともに含まれていないので除外できます (53:J,E,K,I,N,S => 53:E,N,S)。

では、量指定子が消える過程を最初から最後まで示すことにしましょう。例として、未確定マス目が多いものを選びました。次の例では、6 マスのうち 3 マスが未確定となっています。また、量指定子付正規表現は 2 つになっています。

     [73,63,53,43,32,21]  73:U  63:P,L,I,N,E,D,B  53:E,N,S  43:K  32:S,P,R,I,N,G  21:A
     ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]*','[AGILE]']

(1)63: [LUGI] と [JAVASCRIPT] の両方にマッチ可能なので処理中止
     [73,63,53,43,32,21]  73:U  63:P,L,I,N,E,D,B  53:E,N,S  43:K  32:S,P,R,I,N,G  21:A
     ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]*','[AGILE]']

(2)32: [AGILE] にマッチ、[FKA] にマッチしないので、[AGILE] に決定
     [73,63,53,43,32,21]  73:U  63:P,L,I,N,E,D,B  53:E,N,S  43:K  32:S,P,R,I,N,G  21:A
     ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]*','[AGILE]']
  => ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]*','[AGILE]','[AGILE]']

(3)43: [AGILE] に K が含まれないので削除
     [73,63,53,43,32,21]  73:U  63:P,L,I,N,E,D,B  53:E,N,S  43:K  32:S,P,R,I,N,G  21:A
     ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]*','[AGILE]','[AGILE]']
  => ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]','[AGILE]']

(4)量指定子が１つになったのでマス目数に合わせて展開
     [73,63,53,43,32,21]  73:U  63:P,L,I,N,E,D,B  53:E,N,S  43:K  32:S,P,R,I,N,G  21:A
     ['[LUGI]','[LUGI]*','[JVASCRIPT]','[FKA]','[AGILE]','[AGILE]']
  => ['[LUGI]','[LUGI]','[JVASCRIPT]','[FKA]','[AGILE]','[AGILE]']

(5)マス目と正規表現の照合
     [73,63,53,43,32,21]  73:U  63:P,L,I,N,E,D,B  53:E,N,S  43:K  32:S,P,R,I,N,G  21:A
                       => 73:U  63:L,I            53:S      43:K  32:I,G          21:A
     ['[LUGI]','[LUGI]','[JVASCRIPT]','[FKA]','[AGILE]','[AGILE]']

マス目の候補文字と正規表現を照合した結果、53 のマス目は文字が確定され、63 と 32 のマス目は 2 文字に絞り込むことができました。63 も 32 も、この後の処理で、１文字に確定されることになります。

まとめ

無事に、パズルの正解を得ることができました。while ループごとに、途中の経過を確認しながら進めたのが良かったのではないかと思っています。パズルの正解とともに、関連の資料とプログラムをまとめたものを記しておきます。すべての対象文字列は、正規表現とマッチするはずですので、ヒマなときにでも確認してみてください。

パズルの正解
         R   W   E   E
       A   A   R   E   X
     H   I   R   I   N   G
   N   B   K   I   I   O   T
     N   C   S   R   Q   M
       D   E   L   I   P
         K   U   U   6



パズルの問題
            21  20
           ↙  ↙  ↙  ↙
    1 → □  □  □  □  ↙
  2 → □  □  □  □  □  ↙
  → □  □  □  □  □  □  ↙
→ □  □  Ｋ  Ｉ  Ｉ  □  □
  → □  □  □  □  □  □  ↖
    → □  □  □  □  □  ↖  14
      → □  □  □  □  ↖
           ↖  ↖  ↖  ↖
             8


マス目番号
         11  12  13  14
       21  22  23  24  25
     31  32  33  34  35  36
   41  42  43  44  45  46  47
     51  52  53  54  55  56
       61  62  63  63  65
         71  72  73  74

                       対象文字列   正規表現
 1: 11,12,13,14            RWEE      [REDIS][AWS][JETTY]+
 2: 21,22,23,24,25         AAREX     [JAVA]+[DOCKER]+[EXPRESS]
 3: 31,32,33,36,35,36      HIRING    [HUBOT][SPRING]+
 4: 41,42,43,44,45,46,47   NBKIIOT   [MONIT][EMBULK][KIBANA]+IOT
 5: 51,52,53,54,55,56      NCSRQM    [CONSUL]+[SENTRY]+[MYSQL]+
 6: 61,62,63,64,65         DELIP     [PIPELINEDB]+
 7: 71,72,73,74            KUU6      [HEROKU]+[ES6]
 8: 71,61,51,41            KDNN      [SDK]+([FLUENTD])\1
 9: 72,62,52,42,31         UECBH     [CONCOUR][SE][CI][BASH]+
10: 73,63,53,43,32,21      ULSKIA    [LUIGI]+[JAVASCRIPT][KAFKA][AGILE]+
11: 74,64,54,34,33,22,11   6IRIRAR   \d([VIM]([MARKDOWN]))\1[EMACS]\2
12: 65,55,45,34,23,12      PQIIRW    [PUPPET][QA](.)\1[SERVERSPEC][W3C]
13: 56,46,35,24,13         MONEE     [MONGODB]+[NOMAD][ELASTIC][SEARCH]
14: 47,36,25,14            TGXE      [GITHUB]+[ZABBIX][OPENRESTY]
15: 47,56,65,74            TMP6      [TOMCAT]+[IPV6]+
16: 36,46,55,64,73         GOQIU     (GO|RUBY|PERL|PYTHON)[MQTT][LINUX]+
17: 25,35,45,54,63,72      XNIRLU    [NGINX]+[REST][LUA]+
18: 14,24,34,44,53,62,71   EEIISEK   [JENKINS]+
19: 13,23,33,43,52,61      ERRKCD    [TE]RR[^AFORM][SLACK][NODEJS]
20: 12,22,32,42,51         WAIBN     [WYSIWYG][RAILS]+[ANSIBLE]+
21: 11,21,31,41            RAHN      [VAR]+[NISH]+

use strict;
use warnings;
my %char = (43 => 'K', 44 => 'I', 45 => 'I');
my (@work_1, @work_2);

while (<DATA>) {
  my ($patt, $key) = split;
  $patt =~ s/\\d/[0123456789]/g;
  if ($patt =~ s/\(([^\(]+)\(([^\)]+)\)([^\)]+)\)/($1)($2)($3)/) {
    $patt =~ s/\\1/\\1\\2\\3/g;
  } elsif ($patt =~ s/\(([^\(]+)\(([^\)]+)\)\)/($1)($2)/) {
    $patt =~ s/\\1/\\1\\2/g;
  } elsif ($patt =~ s/\(\(([^\)]+)\)([^\)]+)\)/($1)($2)/) {
    $patt =~ s/\\([12])/$1 == 1 ? '\1\2' : '\1'/eg;
  }
  my @key = split /,/, $key;
  foreach my $i (@key) { $char{$i} = [] unless exists($char{$i}); }
  push @work_1, [\@key, $patt];
}

while (my $ref = shift @work_1) {
  my ($patt, @key, @regex) = ($ref->[1], @{$ref->[0]});
  while ($patt) {
    if ($patt =~ s/^(\[\^?\w+\]\+?)//) {
      my $copy = $1;
      $copy =~ s/(\w)(?=.*\1)//g;
      push @regex, $copy;
    } elsif ($patt =~ s/^(\w)//) {
      push @regex, $1;
    } elsif ($patt =~ s/^(\([^\)]+\))//) {
      push @regex, $1;
    } elsif ($patt =~ s/^(\\.)//) {
      push @regex, $1;
    }
  }

  if (join('',@regex) =~ /\(((?:\w+\|)+\w+)\)(?!.*\\)/) {
    my (@select, @choice) = split /\|/, $1;
    my ($i) = grep { $regex[$_] =~ /\(/ } 0 .. $#regex;
    foreach my $item (@select) {
      push @choice, $item if (length($item) + @regex - 1) <= @key;
    }
    if (@choice == 1) {
      splice @regex, $i, 1, split(//, $choice[0]);
    } elsif (@choice > 1) {
      $regex[$i] =~ s/\(.+\)/'(' . join('|', @choice) . ')'/e;
    }
  }

  my @plus_idx = grep { $regex[$_] =~ /\+$/ } 0 .. $#regex;
  if (@plus_idx == 1) {
    my $i = $#key - $#regex;
    my $copy = $regex[$plus_idx[0]]; $copy =~ s/\+$//;
    splice @regex, $plus_idx[0], 1, ($copy) x ($i + 1);
  } elsif (@plus_idx >= 2) {
    my $copy = $regex[$plus_idx[-1]]; $copy =~ s/\+$//;
    $regex[$plus_idx[-1]] =~ s/\+$/*/;
    splice @regex, $plus_idx[-1] + 1, 0, $copy;
    $copy = $regex[$plus_idx[0]]; $copy =~ s/\+$//;
    $regex[$plus_idx[0]] =~ s/\+$/*/;
    splice @regex, $plus_idx[0], 0, $copy;
  }

  $ref->[1] = \@regex;
  push @work_2, $ref;
}

while (my $ref = shift @work_2) {
  my ($r_key, $r_reg) = @$ref;
  my @aster_idx = grep { $r_reg->[$_] =~ /\*$/ } 0 .. $#{$r_reg};
  if (@aster_idx) {
    my @quiry_idx;
    foreach my $i (0 .. $#$r_reg) {
      last if $r_reg->[$i] =~ /\*$/;
      push @quiry_idx, $i;
    }
    foreach my $i (reverse -7 .. -1) {
      last if $r_reg->[$i] =~ /\*$/;
      push @quiry_idx, $i;
    }
    assign($r_key->[$_], $r_reg->[$_]) foreach @quiry_idx;
  } else {
    assign($r_key->[$_], $r_reg->[$_]) foreach 0 .. $#$r_reg;
  }
  push @work_1, $ref if grep /\*$|\(/, @$r_reg;
}

while (my $ref = shift @work_1) {
  my ($r_key, $r_reg) = @$ref;
  my @paren_idx = grep { $r_reg->[$_] =~ /^\(/ } 0 .. $#$r_reg;
  if (@paren_idx) {
    foreach my $i (0 .. $#paren_idx) {
      my $j = $i + 1; my (@paren_grp, @chars, %count);
      push @paren_grp, $r_key->[$paren_idx[$i]];
      push @paren_grp, $r_key->[$_] foreach grep { $r_reg->[$_] =~ /\\$j/ } 0 .. $#$r_reg;
      foreach my $k (@paren_grp) {
        push @chars, !ref($char{$k}) ? $char{$k} : @{$char{$k}};
      }
      ++$count{$_} foreach @chars;
      my @common = grep { $count{$_} == @paren_grp } keys %count;
      if (@common == 1) {
        ref($char{$_}) and $char{$_} = $common[0] foreach @paren_grp;
      } elsif (@common >= 2) {
        @{$char{$_}} = @common foreach @paren_grp;
      }
    }
  }
  push @work_2, $ref if grep /\*$/, @$r_reg;
}

while (my $ref = shift @work_2) {
  my ($r_key, $r_reg) = @$ref;
  foreach my $i (0 .. $#$r_reg) {
    if ($r_reg->[$i] =~ /\*$/) {
      my $sq_char = ref $char{$r_key->[$i]} ? join('', @{$char{$r_key->[$i]}}) : $char{$r_key->[$i]};
      if ("$sq_char:$r_reg->[$i]" =~ /(\w).*:.*\1/) {
        if (join('', $sq_char, ':', $r_reg->[$i+1]) =~ /(\w).*:.*\1/) {
          expand($r_key, $r_reg);
          last;
        } else {
          my $copy = $r_reg->[$i]; $copy =~ s/\*$//;
          splice @$r_reg, $i, 0, $copy;
        }
      } else {
        splice @$r_reg, $i, 1;
        expand($r_key, $r_reg);
        redo if $r_reg->[$i] =~ /\*$/;
      }
    }
  }
  if (grep /\*$/, @$r_reg) {
    foreach my $i (reverse -7 .. -1) {
      if ($r_reg->[$i] =~ /\*$/) {
        my $sq_char = ref $char{$r_key->[$i]} ? join('', @{$char{$r_key->[$i]}}) : $char{$r_key->[$i]};
        if ("$sq_char:$r_reg->[$i]" =~ /(\w).*:.*\1/) {
          if (join('', $sq_char, ':', $r_reg->[$i-1]) =~ /(\w).*:.*\1/) {
            expand($r_key, $r_reg);
            last;
          } else {
            my $copy = $r_reg->[$i]; $copy =~ s/\*$//;
            splice @$r_reg, $i + 1, 0, $copy;
          }
        } else {
          splice @$r_reg, $i, 1;
          expand($r_key, $r_reg);
          next if grep /\*$/, @$r_reg;
          last;
        }
      }
    }
  }
  if (!grep /\*/, @$r_reg) { assign($r_key->[$_], $r_reg->[$_]) foreach 0 .. $#$r_key; }
  else { push @work_2, $ref; }
}

my @keys = sort keys %char;
foreach my $i (0 .. $#keys) {
  if (substr($keys[$i],1,1) == 1) {
    my $j = abs(4 - substr($keys[$i],0,1));
    print "  " x $j;
  }
  print "$char{$keys[$i]}";
  if ($i == $#keys or substr($keys[$i],0,1) ne substr($keys[$i+1],0,1)) { print "\n"; }
  else { print "   "; }
}

sub assign {
  my ($key, $patt) = @_;
  if (!ref $char{$key}) {
    if ($patt =~ /^\[\^/) {
      if ($patt =~ /$char{$key}/) {
        print "error occurred\n";
        exit;
      }
    } elsif ($patt =~ /^\(?\[/) {
      if ($patt !~ /$char{$key}/) {
        print "error occurred\n";
        exit;
      }
    } elsif (length($patt) == 1) {
      if ($patt ne $char{$key}) {
        print "error occurred\n";
        exit;
      }
    }
  } elsif (@{$char{$key}} == 0) {
    if ($patt =~ /^\(?\[/) {
      push @{$char{$key}}, grep(/\w/, split //, $patt);
    } elsif (length($patt) == 1) {
      $char{$key} = $patt;
    }
  } else {
    if (length($patt) == 1) {
      if (grep /$patt/, @{$char{$key}}) {
        @{$char{$key}} = ($patt);
      } else {
        print "error occurred\n";
        exit;
      }
    } elsif ($patt =~ /^\(?\[/) {
      foreach my $i (reverse 0 .. $#{$char{$key}}) {
        splice @{$char{$key}}, $i, 1 if $patt !~ /$char{$key}->[$i]/;
      }
    }  elsif ($patt =~ /^\[\^/) {
      foreach my $i (reverse 0 .. $#{$char{$key}}) {
        splice @{$char{$key}}, $i, 1 if $patt =~ /$char{$key}->[$i]/;
      }
    }
    if (@{$char{$key}} == 1) {
      $char{$key} = $char{$key}->[0];
    }
  }
}

sub expand {
  my ($r_key, $r_reg) = @_;
  if (join('', @$r_reg) =~ /^[^*]*\+/) {
    my ($j) = grep { $r_reg->[$_] =~ /\+$/ } 0 .. $#$r_reg;
    my $copy = $r_reg->[$j]; $copy =~ s/\+//; $r_reg->[$j] =~ s/\+/*/;
    splice @$r_reg, $j, 0, $copy;
  }
  if (join('', @$r_reg) =~ /\+[^*]*$/) {
    my ($j) = grep { $r_reg->[$_] =~ /\+$/ } 0 .. $#$r_reg;
    my $copy = $r_reg->[$j]; $copy =~ s/\+//; $r_reg->[$j] =~ s/\+/*/;
    splice @$r_reg, $j + 1, 0, $copy;
  }
  if (join('', @$r_reg) =~ /^[^+*]*[+*][^+*]*$/) {
    my ($j) = grep { $r_reg->[$_] =~ /(\+|\*)$/ } 0 .. $#$r_reg;
    my $copy = $r_reg->[$j]; $copy =~ s/(\+|\*)$//;
    my $k = $#$r_key - $#$r_reg;
    splice @$r_reg, $j, 1, ($copy) x ($k + 1);
  }
  my @aster_idx = grep { $r_reg->[$_] =~ /\*$/ } 0 .. $#$r_reg;
  if (@aster_idx == 2 and $aster_idx[0] + 1 == $aster_idx[1] and $#$r_key < $#$r_reg) {
    my $second = splice @$r_reg, $aster_idx[1], 1;
    $second =~ s/\W//g; $r_reg->[$aster_idx[0]] =~ s/^\[/[$second/;
    $r_reg->[$aster_idx[0]] =~ s/(\w)(?=.*\1)//g; $r_reg->[$aster_idx[0]] =~ s/\*$//;
  }
}

__DATA__
[REDIS][AWS][JETTY]+    11,12,13,14
[JAVA]+[DOCKER]+[EXPRESS]   21,22,23,24,25
[HUBOT][SPRING]+    31,32,33,36,35,36
[MONIT][EMBULK][KIBANA]+IOT 41,42,43,44,45,46,47
[CONSUL]+[SENTRY]+[MYSQL]+  51,52,53,54,55,56
[PIPELINEDB]+   61,62,63,64,65
[HEROKU]+[ES6]  71,72,73,74
[SDK]+([FLUENTD])\1 71,61,51,41
[CONCOUR][SE][CI][BASH]+    72,62,52,42,31
[LUIGI]+[JAVASCRIPT][KAFKA][AGILE]+ 73,63,53,43,32,21
\d([VIM]([MARKDOWN]))\1[EMACS]\2    74,64,54,34,33,22,11
[PUPPET][QA](.)\1[SERVERSPEC][W3C]  65,55,45,34,23,12
[MONGODB]+[NOMAD][ELASTIC][SEARCH]  56,46,35,24,13
[GITHUB]+[ZABBIX][OPENRESTY]    47,36,25,14
[TOMCAT]+[IPV6]+    47,56,65,74
(GO|RUBY|PERL|PYTHON)[MQTT][LINUX]+ 36,46,55,64,73
[NGINX]+[REST][LUA]+    25,35,45,54,63,72
[JENKINS]+  14,24,34,44,53,62,71
[TE]RR[^AFORM][SLACK][NODEJS]   13,23,33,43,52,61
[WYSIWYG][RAILS]+[ANSIBLE]+ 12,22,32,42,51
[VAR]+[NISH]+   11,21,31,41

(2017/10/01)

TopPage