CODEWITHSUNDEEP
perltransliteration
user246100
user246100

Reputation: 670

Saving a transliteration table in perl

I want to transliterate digits from 1 - 8 with 0 but not knowing the number at compile time. Since transliterations do not interpolate variables I'm doing this:

@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]/});

and then index it like: 

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

I would appreciate if anyone can point me to a best looking solution.

Upvotes: 0

Views: 333

Answers (3)

Eric Strom
Eric Strom

Reputation: 40152

Any time that you are repeating yourself, you should see if what you are doing can be done in a loop. Since tr creates its tables at compile time, you can use eval to access the compiler at runtime:

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

my $x = 123;

$trs[2]($x);

print "$x\n"; # 103

There is also no need to use references here, subroutine arguments are already passed by reference.

If you do not want to use string eval, you need to use a construct that supports runtime modification. For that you can use the s/// operator:

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

my $z = 1230;

subst $z => 2;

print "$z\n"; # 1032

The tr/// construct is faster than s/// since the latter supports regular expressions.

Upvotes: 2

hobbs
hobbs

Reputation: 240404

I'd suggest simply ditching tr in favor of something that actually permits a little bit of metaprogramming like s///. For example:

# 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;
}

which is surprisingly straightforward. :)

Upvotes: 1

Sean
Sean

Reputation: 29790

Here's a short subroutine that uses substitution instead of transliteration:

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

Upvotes: 0

Related Questions