Какое регулярное выражение Perl может соответствовать непрерывному подмножеству цифр 12345?

Question

Мне бы хотелось, чтобы регулярное выражение Perl соответствовало любому смежному подмножеству строки '12345'.

Возможно, у меня просто замораживание мозга, но это мой тестовый код и лучший на текущий момент регулярный код.Я могу понять, как исправить ситуацию, добавив альтернативы, но мне интересно, какую изящную альтернативу мне не хватает.[ Мне специально не нужны захваты для цифр;Я оставил образец регулярного выражения без скобок без захвата, чтобы сделать его немного менее загроможденным. ]

Контрольный пример:

use strict;
use warnings;

my @good = qw( 1 12 123 1234 12345 2 23 234 2345 3 34 345 4 45 5);
my @bad  = qw( 0 6 13 134 1345 145 15 124 1245 125 1235 24 245 25
               35 21 32 43 54 543 5432 54321);

my $qr = qr/^(1?(2?(3(4(5)?)?)?)?)$/;   # 3 'good', 3 'bad' failures
#my $qr = qr/^(1?(2(3(4(5)?)?)?)?)$/;   # 6 'good' failures.
my $fail = 0;

foreach my $opt (@good)
{
    printf "GOOD %d: $opt - missed by regex\n", ++$fail if ($opt !~ /$qr/);
}

foreach my $opt (@bad)
{
    printf "BAD %d: $opt - allowed by regex\n", ++$fail if ($opt =~ /$qr/);
}

print(($fail == 0) ? "PASS\n" : "FAIL\n");

Пример выходных данных:

Кейс1 (закомментировано):

GOOD 1: 3 - missed by regex
GOOD 2: 34 - missed by regex
GOOD 3: 345 - missed by regex
GOOD 4: 4 - missed by regex
GOOD 5: 45 - missed by regex
GOOD 6: 5 - missed by regex
FAIL

Случай 2 (активный):

GOOD 1: 4 - missed by regex
GOOD 2: 45 - missed by regex
GOOD 3: 5 - missed by regex
BAD 4: 13 - allowed by regex
BAD 5: 134 - allowed by regex
BAD 6: 1345 - allowed by regex
FAIL

Итак, вы можете написать хорошее простое симметричное регулярное выражение, которое соответствует тому, что я хочу, а не тому, что яне так?

---

Это регулярное выражение позволяет пройти тестовый пример, но не так элегантно, как я надеялся:

my $qr = qr/^((1?(2(3(4(5)?)?)?)?)|(3?(4(5)?)?)|5)$/;

---

Тестовый пример с решением Джастина

use strict;
use warnings;

my @good = qw( 1 12 123 1234 12345 2 23 234 2345 3 34 345 4 45 5);
my @bad  = qw( 0 6 13 134 1345 145 15 124 1245 125 1235 24 245 25
               35 21 32 43 54 543 5432 54321 11 122 1233 1223 12234);

#my $qr = qr/^(1?(2?(3(4(5)?)?)?)?)$/;   # 3 'good', 3 'bad' failures
#my $qr = qr/^(1?(2(3(4(5)?)?)?)?)$/;    # 6 'good' failures.
#my $qr = qr/^((1?(2(3(4(5)?)?)?)?)|(3?(4(5)?)?)|5)$/;  # Passes

# Ysth's solution - passes
#my $qr = qr/^[12345](?:(?<=1)2|(?<=2)3|(?<=3)4|(?<=4)5)*$/;

my $fail = 0;

foreach my $opt (@good)
{
    printf "GOOD %d: $opt - missed by regex\n", ++$fail if ('12345' !~ /$opt/);
    #printf "GOOD %d: $opt - missed by regex\n", ++$fail if ($opt !~ /$qr/);
}

foreach my $opt (@bad)
{
    printf "BAD %d: $opt - allowed by regex\n", ++$fail if ('12345' =~ /$opt/);
    #printf "BAD %d: $opt - allowed by regex\n", ++$fail if ($opt =~ /$qr/);
}

print(($fail == 0) ? "PASS\n" : "FAIL\n");

Answer 1

Обратный матч:

'12345' =~ /$opt/

Answer 2

Вот пересмотренная версия идеи Джастина:

index('12345', $opt) >= 0;

Или, если вам нужно исключить пустую строку

index('12345', $opt) >= 0 and length $opt;

Таким образом, вам не нужно проверять $opt для метасхем регулярных выражений. Я не уверен, какая версия будет быстрее.

Answer 3

/^[12345](?:(?<=1)2|(?<=2)3|(?<=3)4|(?<=4)5)*\z/

Извините, дважды ошибся. Это должно сделать это. Однако точный список всех возможных совпадений будет быстрее.

Answer 4

Хотите что-то лучше, чем

/\b(1|12|123|1234|12345|2|23|234|2345|3|34|345|4|45|5)\b/