Сохранение таблицы транслитерации в Perl - PullRequest
Новая
       1

Сохранение таблицы транслитерации в Perl

0 голосов
/ 10 марта 2011

Я хочу транслитерировать цифры от 1 до 8 с 0, но не знаю номер во время компиляции. Так как транслитерации не интерполируют переменные, я делаю это: 

@trs = (sub{die},sub{${$_[0]} =~ tr/[0,1]/[1,0]/},sub{${$_[0]} =~ tr/[0,2]/[2,0]/},sub{${$_[0]} =~ tr/[0,3]/[3,0]/},sub{${$_[0]} =~ tr/[0,4]/[4,0]/},sub{${$_[0]} =~ tr/[0,5]/[5,0]/},sub{${$_[0]} =~ tr/[0,6]/[6,0]/},sub{${$_[0]} =~ tr/[0,7]/[7,0]/},sub{${$_[0]} =~ tr/[0,8]/[8,0]/});

и затем индексировать его как: 

$trs[$character_to_transliterate](\$var_to_change);

Буду признателен, если кто-нибудь подскажет мне лучшее решение.

Ответы [ 3 ]

2 голосов
/ 10 марта 2011

Каждый раз, когда вы повторяете себя, вы должны видеть, можно ли делать то, что вы делаете, в цикле. Поскольку tr создает свои таблицы во время компиляции, вы можете использовать eval для доступа к компилятору во время выполнения: 

my @trs = (sub {die}, map {eval "sub {\$_[0] =~ tr/${_}0/0$_/}"} 1 .. 8);

my $x = 123;

$trs[2]($x);

print "$x\n"; # 103

Здесь также нет необходимости использовать ссылки, аргументы подпрограммы уже передаются по ссылке.

Если вы не хотите использовать строку eval, вам нужно использовать конструкцию, которая поддерживает модификацию во время выполнения. Для этого вы можете использовать оператор s///: 

sub subst {$_[0] =~ s/($_[1]|0)/$1 ? 0 : $_[1]/ge}

my $z = 1230;

subst $z => 2;

print "$z\n"; # 1032

Конструкция tr/// работает быстрее, чем s///, поскольку последняя поддерживает регулярные выражения.

1 голос
/ 10 марта 2011

Я бы предложил просто отказаться от tr в пользу чего-то, что на самом деле допускает немного метапрограммирования, например s///. Например: 

# Replace $to_swap with 0 and 0 with $to_swap, and leave
# everything else alone.
sub swap_with_0 {
    my ($digit, $to_swap) = @_;
    if ($digit == $to_swap) {
        return 0;
    } elsif ($digit == 0) {
        return $to_swap;
    } else {
        return $digit;
    }
}

# Swap 0 and $to_swap throughout $string
sub swap_digits {
    my ($string, $to_swap) = @_;
    $string =~ s/([0$to_swap])/swap_with_0($1, $to_swap)/eg;
    return $string;
}

, что удивительно просто. :)

0 голосов
/ 10 марта 2011

Вот короткая подпрограмма, которая использует замену вместо транслитерации: 

sub swap_digits {
    my ($str, $digit) = @_;
    $str =~ s{ (0) | $digit }{ defined $1 ? $digit : 0 }gex;
    return $str;
}
...