Perl слово disenvoweling: удаление всех гласных, кроме первого и последнего

Чтобы сократить количество имен, но при этом сохранить их несколько читабельными, я хотел бы удалить все гласные из строк, кроме первого и последнего вхождения. Например, я бы хотел, чтобы "Миннесота" стала "Миннстой".

my $name="Minnesota";

Я попытался использовать синтаксис регулярных выражений с нулевой шириной в Perl, например, так:

$name =~ s/(?<=[aeiou])([^aeiou]*)[aeiou]/$1/ig; # minnst

Однако, хотя это правильно заботится о первом гласном, оно удаляет последний. Чтобы это исправить, я попытался сохранить последний гласный на месте, например:

$name =~ s/(?<=[aeiou])([^aeiou]*)([aeiou])([aeiou][^aeiou]*)$/$1$3/ig; # minnesota

Это также не сработало, предположительно потому, что '$' привязывает все регулярные выражения к концу строки.

Конечно, я мог бы найти положение первого гласного, перевернуть остальную часть строки и удалить все гласные, кроме первого (последнего), а также перевернуть и объединить строки, но это не очень элегантно. Я чувствую, что пропускаю один из вариантов синтаксиса нулевой ширины.

Источник

3 ответа

Решение

Просто укажите конечное граничное условие для вашего регулярного выражения: (?![^aeiou]*$):

use strict;
use warnings;

my @words = qw(Minnesota concatenate strings elegant I feel overlooking options syntax any greatly appreciated);

for (@words) {
    my $word = $_;

    $word =~ s/(?<=[aeiou])([^aeiou]*)[aeiou](?![^aeiou]*$)/$1/ig;

    printf "%-12s -> %s\n", $_, $word;
}

Выходы:

Minnesota    -> Minnsta
concatenate  -> conctnte
strings      -> strings
elegant      -> elgant
I            -> I
feel         -> feel
overlooking  -> ovrlking
options      -> optons
syntax       -> syntax
any          -> any
greatly      -> greatly
appreciated  -> apprcted
Источник

Для меня это работает ("1" впереди намеренно):

1 while ($name =~ s/^(.+)[AEIOUaeiou]/$1/g );

если вы хотите сохранить минимальную длину $name (например, 3):

1 while (length $name > 3 && $name =~ s/^(.+)[AEIOUaeiou]/$1/g );

Вместо написания 'AEIOUaeiou' вы, конечно, можете использовать флаг 'i', чтобы игнорировать регистр. Я записал это явно для облегчения чтения.

Конечно, вы можете поставить любые символы в скобки.

Источник

Убедитесь, что после МАТЧИ есть гласная, но исключите ее из МАТЧ.

$name =~ s/(?<=[aeiou])([^aeiou]*)[aeiou](?=.*[aeiou])/$1/ig;

Замены, сделанные вашим регулярным выражением:

  • Миннесота => nne -> nn => Миннсота
  • Minnsota => nnso -> nns => Minnsta
  • Minnsta => nnsta -> nnst => Minnst
  • Minnst => nnsta -> nnst => Minnst

Таким образом, последняя замена заменяет 'nnsta' на 'nnst'.

my $name="Minnesota";
my $prev = '';
while ( $name ne $prev ) {
    $prev = $name;
    $name =~ s/(?<=[aeiou])([^aeiou]*)[aeiou]/$1/i;
    print "$prev => ${^MATCH} -> $1 => $name\n";
}
Источник
Другие вопросы по тегам