|
ibm1620 has asked for the wisdom of the Perl Monks concerning the following question:
Dear PerlMonks,
I'm translating some python(2) code into perl, and I'm hoping there are some bilingual sorts who can help. (It's an interesting poetry writing program that I don't think I can begin to understand until I at least have it in a language I understand. Plus I'm hoping it'll run faster in Perl. Otherwise I wouldn't be undertaking this labor of love. :-p )
One of the biggest headaches is translating Python's list range expressions into equivalent Perl array expressions. In Python you can write:
a = [ 'a','b','c','d','e','f','g' ]
a[:3] # abc
a[:-3] # abcd
a[3:] # defg
a[-3:] # efg
In Perl, using List::Util qw/head tail/, the equivalent is:
my @a = qw/a b c d e f g/;
# python a[:3] = 'abc' (ie. select first 3)
say join( '', head( 3, @a)) . " should be abc";
# python a[:-3] = 'abcd' (ie. omit last 3)
say join( '', head( -3, @a)) . " should be abcd"; # except when -0!
# python a[3:] = 'defg' (ie. omit first 3)
say join( '', tail( -3, @a)) . " should be defg"; # except when -0!
# python a[-3:] = 'efg' (ie. select last 3)
say join( '', tail( 3, @a)) . " should be efg";
Of course, most of the time the code contains a variable, not a hard-coded 3. And then my solution breaks on head(-$p, @a) and tail(-$p, @a) when $p is 0.
Is there a CPAN module that might support python-like specification of array ranges in a concise manner?
|
Re: Converting python list range expressions to perl
by AnomalousMonk (Archbishop) on Dec 03, 2022 at 19:11 UTC
|
c:\@Work\Perl\monks>perl
use strict;
use warnings;
$\ = $/;
my @ra = 'a' .. 'g';
print @ra[ 0 .. 2 ]; # python a[:3] = 'abc' (ie. select first 3
+)
print @ra[ -@ra .. -4 ]; # python a[:-3] = 'abcd' (ie. omit last 3)
print @ra[ 3 .. $#ra ]; # python a[3:] = 'defg' (ie. omit first 3)
print @ra[ -3 .. -1 ]; # python a[-3:] = 'efg' (ie. select last 3
+)
^Z
abc
abcd
defg
efg
Give a man a fish: <%-{-{-{-<
| [reply]
[d/l]
[select] |
|
|
you posted first. I did come up with a slight variation on the 2nd task.
use strict;
use warnings;
use 5.10.0; #for say
#a = [ 'a','b','c','d','e','f','g' ]
my @a = qw(a b c d e f g);
#a[:3] # abc
say @a[0..2]; # only first 3
#a[:-3] # abcd
say @a[0..$#a-3]; # exclude last 3
#a[3:] # defg
say @a[3..$#a]; # exclude first 3
#a[-3:] # efg
say @a[-3..-1]; # only last 3
| [reply]
[d/l] |
|
|
Okay, took the hint and did it all with slices. Does this look right?
use v5.36;
no warnings q/experimental/; # no warns about for-list
sub range($aref, $start=undef, $end=undef) {
if (!defined $start) {
$start = 0;
if ($end >= 0) {
$end = $end - 1;
}
else {
$end = $#$aref + $end;
}
}
elsif (!defined $end) {
$end = $#$aref;
if ($start < 0) {
$start = $#$aref + $start + 1 ;
}
}
else {
die "a[i:j] ranges not supported yet";
}
print "\@a[$start .. $end] ";
return [@$aref[$start .. $end]];
}
my @a = qw/a b c d e f g/;
my @tests = (
[3, undef, 'defg'],
[0, undef, 'abcdefg'],
[-3, undef, 'efg'],
[undef, 3, 'abc'],
[undef, 0, ''],
[undef, -3, 'abcd'],
);
for my ($i, $j, $answer) (map {@{$_}} @tests) {
printf("a[%s:%s] -> ", $i // '', $j // '');
printf("range(a, %s, %s) -> ", $i // 'undef', $j // 'undef');
my $aref = range(\@a, $i, $j);
my $join = join '', @$aref;
printf("'$join', expecting '$answer'\n");
}
And it checks out:
a[3:] -> range(a, 3, undef) -> @a[3 .. 6] 'defg', expecting 'defg'
a[0:] -> range(a, 0, undef) -> @a[0 .. 6] 'abcdefg', expecting 'abcdef
+g'
a[-3:] -> range(a, -3, undef) -> @a[4 .. 6] 'efg', expecting 'efg'
a[:3] -> range(a, undef, 3) -> @a[0 .. 2] 'abc', expecting 'abc'
a[:0] -> range(a, undef, 0) -> @a[0 .. -1] '', expecting ''
a[:-3] -> range(a, undef, -3) -> @a[0 .. 3] 'abcd', expecting 'abcd'
| [reply]
[d/l]
[select] |
Re: Converting python list range expressions to perl
by kcott (Archbishop) on Dec 04, 2022 at 03:00 UTC
|
#!/usr/bin/env perl
use v5.36;
use constant {
AREF => 0,
PYTHON => 1,
EXP => 2,
};
use Test::More;
my @test_array = 'a' .. 'g';
my @tests = (
[\@test_array, '[:3]', 'abc'],
[\@test_array, '[:-3]', 'abcd'],
[\@test_array, '[3:]', 'defg'],
[\@test_array, '[-3:]', 'efg'],
);
plan tests => 0+@tests;
for my $test (@tests) {
is get_array_slice_by_python_expr($test->@[AREF, PYTHON]),
$test->[EXP], "Testing: $test->[PYTHON]";
}
sub get_array_slice_by_python_expr ($aref, $python) {
state $re = qr{^\[(|-?\d+):(|-?\d+)\]$};
my @temp_array = $aref->@*;
my ($offset, $length) = $python =~ $re;
$offset ||= 0;
return length($length)
? join('', splice @temp_array, $offset, $length)
: join('', splice @temp_array, $offset);
}
Output:
1..4
ok 1 - Testing: [:3]
ok 2 - Testing: [:-3]
ok 3 - Testing: [3:]
ok 4 - Testing: [-3:]
| [reply]
[d/l]
[select] |
|
|
#!/usr/bin/env perl
use v5.36;
use constant {
AREF => 0,
PYTHON => 1,
EXP => 2,
};
use Test::More;
my @test_array = 'a' .. 'g';
my @tests = (
[\@test_array, '[:3]', 'abc'],
[\@test_array, '[:-3]', 'abcd'],
[\@test_array, '[3:]', 'defg'],
[\@test_array, '[-3:]', 'efg'],
[\@test_array, '[-3:-1]', 'ef'], # testing double-ended ranges
[\@test_array, '[-3:-3]', ''],
[\@test_array, '[3:-1]', 'def'],
);
plan tests => 0+@tests;
for my $test (@tests) {
is get_array_slice_by_python_expr($test->@[AREF, PYTHON]),
$test->[EXP], "Testing: $test->[PYTHON]";
}
sub get_array_slice_by_python_expr ($aref, $python) {
### $re modified to return undef instead of '' when endpoint omitt
+ed
state $re = qr{^ \[ ( -? \d+ )? : ( -? \d+ )? \] $}x;
my ($start, $stop) = $python =~ $re;
my $range_aref = pyrange($aref, $start, $stop);
return join '', @$range_aref;
}
sub pyrange($aref, $start=undef, $stop=undef) {
if (!defined $start) {
$start = 0;
}
elsif ($start < 0) {
$start = @$aref + $start;
}
if (!defined $stop) {
$stop = $#$aref;
}
elsif ($stop >= 0) {
$stop = $stop - 1;
}
else {
$stop = @$aref + $stop - 1;
}
return [@$aref[$start .. $stop]];
}
Output:
$ ./test
1..7
ok 1 - Testing: [:3]
ok 2 - Testing: [:-3]
ok 3 - Testing: [3:]
ok 4 - Testing: [-3:]
ok 5 - Testing: [-3:-1]
ok 6 - Testing: [-3:-3]
ok 7 - Testing: [3:-1]
| [reply]
[d/l]
[select] |
|
|
"Ken, thanks for your writeup, including forcing me to learn a bit about Test -- I needed that! :-)"
You're welcome. It's good to be able to start a script with use v5.36;.
"I'd rather stick with Perl's slice capability since it reads more cleanly (to me, anyway) ..."
What you choose is entirely up to you.
This correlation stood out for me:
| Python | Perl |
|---|
| [OFFSET:LENGTH] | splice ARRAY, OFFSET, LENGTH |
| [:LENGTH] | splice ARRAY, 0, LENGTH |
| [OFFSET:] | splice ARRAY, OFFSET |
| [:] | splice ARRAY, 0 |
"... and doesn't require copying and modifying the source array."
The source array, @test_array, is not modified at all.
The temporary copy, @temp_array,
is modified in the last statement of (my) get_array_slice_by_python_expr() function;
it's then immediately discarded as it goes out of scope.
I added your three new tests, plus a fourth ([:]), to my original code:
[\@test_array, '[-3:-1]', 'ef'],
[\@test_array, '[-3:-3]', ''],
[\@test_array, '[3:-1]', 'def'],
[\@test_array, '[:]', 'abcdefg'],
All pass:
1..8
ok 1 - Testing: [:3]
ok 2 - Testing: [:-3]
ok 3 - Testing: [3:]
ok 4 - Testing: [-3:]
ok 5 - Testing: [-3:-1]
ok 6 - Testing: [-3:-3]
ok 7 - Testing: [3:-1]
ok 8 - Testing: [:]
| [reply]
[d/l]
[select] |
|
|
|
|
| |
|
| [reply]
[d/l] |
|
|
"splice() alters the array, slice does not."
Which array do you believe is being altered?
"I do not intend this as disagreement."
Fair enough.
With what are you not intending to disagree?
"I am just trying to add information to help a newbie choose between implementations."
Well, I suppose we might be able to help with that.
What information are you trying to add?
Also, as it may affect the wording, is this generic information for an arbitrary newbie,
or did you have a specific newbie in mind?
| [reply]
[d/l] |
Re: Converting python list range expressions to perl
by ibm1620 (Hermit) on Dec 07, 2022 at 02:14 UTC
|
Here are two subroutines that allow a direct translation of Python list range expressions to Perl array slicing, including handling out-of-range arguments in the same way that Python does. One uses Perl slices, the other uses Perl splices as proposed by kcott.
Update: Off-by-one bug where start >= number of elements in array, fixed.
#!/usr/bin/env perl
use v5.36;
use List::Util qw/min max/;
### Method 1: pyrange() - use Perl slice
sub pyrange_slice ( $aref, $start = '', $end = '' ) {
# Convert start to a non-negative offset from 0 to @$aref-1
my $offset =
!length($start) ? 0
: $start < 0 ? max( @$aref + $start, 0 )
: min( 0 + @$aref, $start ); ### UPDATE was
+$#$aref
# Convert end to a non-negative offset from 0 to @$aref
my $beyond =
( !length($end) ? @$aref
: $end < 0 ? max( @$aref + $end, 0 )
: min( 0 + @$aref, $end ) );
return [ @$aref[ $offset .. $beyond - 1 ] ];
}
### Method 2: kcott_fixed() - use Perl splice()
# Convert [start:stop] to (offset,length) where both offset and length
+ are
# non-negative.
sub pyrange_splice ( $aref, $start = '', $end = '' ) {
my @temp_array = $aref->@*;
# Convert start to a non-negative offset from 0 to @$aref-1
my $offset =
!length($start) ? 0
: $start < 0 ? max( @$aref + $start, 0 )
: min( 0 + @$aref, $start ); ### UPDATE was
+ $#$aref
# Convert end to a non-negative offset from 0 to @$aref
my $beyond =
!length($end) ? @$aref
: $end < 0 ? max( @$aref + $end, 0 )
: min( 0 + @$aref, $end );
# Compute length, zero if range is inverted
my $length = max( $beyond - $offset, 0 );
# By now both $offset and $length are non-negative
return [ splice @temp_array, $offset, $length ];
}
### Method 3: ask_py() - see what Python does
sub ask_py ( $aref, $start = '', $end = '' ) {
# Generate python code to evaluate range expression
state $py_pat = <<~'EOF';
x=list('%s') # break string into list of chars
y=x[%s:%s] # get list range
print(''.join(y)) # back to string
EOF
my $expr = sprintf $py_pat, ( join '', @$aref ), $start, $end;
my $r = qx{python3 -c "$expr"};
chomp $r;
return [ split //, $r ];
}
use constant {
AREF => 0,
PYTHON => 1,
EXP => 2,
};
use Test::More;
my @test_array = 'a' .. 'k';
my @tests = (
[ \@test_array, '[:3]', 'abc' ],
[ \@test_array, '[:-3]', 'abcdefgh' ],
[ \@test_array, '[-3:]', 'ijk' ],
[ \@test_array, '[3:]', 'defghijk' ],
[ \@test_array, '[10:]', 'k' ],
[ \@test_array, '[:]', 'abcdefghijk' ],
[ \@test_array, '[:0]', '' ],
# testing double-ended ranges
[ \@test_array, '[-3:-1]', 'ij' ],
[ \@test_array, '[-3:-3]', '' ],
[ \@test_array, '[-3:0]', '' ],
[ \@test_array, '[-3:2]', '' ],
[ \@test_array, '[-11:-1]', 'abcdefghij' ],
[ \@test_array, '[-11:-0]', '' ],
[ \@test_array, '[-12:-1]', 'abcdefghij' ],
[ \@test_array, '[-12:1]', 'a' ],
[ \@test_array, '[-2:10]', 'j' ],
[ \@test_array, '[3:-1]', 'defghij' ],
[ \@test_array, '[7:-5]', '' ],
[ \@test_array, '[3:4]', 'd' ],
[ \@test_array, '[0:12]', 'abcdefghijk' ],
);
# Convert python notation to pair of ints now, so we're not timing thi
+s
# process
my $re = qr{^ \[ ( | -? \d+ )? : ( | -? \d+ )? \] $}x;
for my $aref (@tests) {
my ( $start, $stop ) = $aref->[1] =~ /$re/;
$aref->[1] = [ $start, $stop ];
}
my @methods = (
[ Perl_slice => \&pyrange_slice ],
[ Perl_splice => \&pyrange_splice ],
[ Python => \&ask_py ],
);
my %methods = map { $_->@* } @methods;
my $method;
my $c_ref;
benchmark();
tester();
#
# Benchmarking
#
sub benchmark() {
use Benchmark qw/:all/;
cmpthese(
-1,
{
use_slice => sub { run( $methods{Perl_slice} ) },
use_splice => sub { run( $methods{Perl_splice} ) },
}
);
}
sub run ($c) {
$c_ref = $c;
for my $test (@tests) {
get_array_slice_by_python_expr( $test->@[ AREF, PYTHON ] );
}
}
#
# Testing
#
sub tester {
plan tests => ( 0 + @tests ) * (@methods);
for my $aref (@methods) {
( $method, $c_ref ) = @$aref;
say "\nTESTING $method with array (" . ( join '', @test_array
+) . ')';
for my $test (@tests) {
is get_array_slice_by_python_expr( $test->@[ AREF, PYTHON
+] ),
$test->[EXP],
sprintf 'Testing: [%s:%s] expecting (%s)', $test->[PYTHO
+N]->@*,
$test->[EXP];
}
}
}
sub get_array_slice_by_python_expr ( $aref, $python ) {
my ( $start, $stop ) = @$python;
my $range_aref = $c_ref->( $aref, $start, $stop );
return join '', @$range_aref;
}
Output:
Rate use_splice use_slice
use_splice 33810/s -- -39%
use_slice 55351/s 64% --
1..60
TESTING Perl_slice with array (abcdefghijk)
ok 1 - Testing: [:3] expecting (abc)
ok 2 - Testing: [:-3] expecting (abcdefgh)
ok 3 - Testing: [-3:] expecting (ijk)
ok 4 - Testing: [3:] expecting (defghijk)
ok 5 - Testing: [10:] expecting (k)
ok 6 - Testing: [:] expecting (abcdefghijk)
ok 7 - Testing: [:0] expecting ()
ok 8 - Testing: [-3:-1] expecting (ij)
ok 9 - Testing: [-3:-3] expecting ()
ok 10 - Testing: [-3:0] expecting ()
ok 11 - Testing: [-3:2] expecting ()
ok 12 - Testing: [-11:-1] expecting (abcdefghij)
ok 13 - Testing: [-11:-0] expecting ()
ok 14 - Testing: [-12:-1] expecting (abcdefghij)
ok 15 - Testing: [-12:1] expecting (a)
ok 16 - Testing: [-2:10] expecting (j)
ok 17 - Testing: [3:-1] expecting (defghij)
ok 18 - Testing: [7:-5] expecting ()
ok 19 - Testing: [3:4] expecting (d)
ok 20 - Testing: [0:12] expecting (abcdefghijk)
TESTING Perl_splice with array (abcdefghijk)
ok 21 - Testing: [:3] expecting (abc)
ok 22 - Testing: [:-3] expecting (abcdefgh)
ok 23 - Testing: [-3:] expecting (ijk)
ok 24 - Testing: [3:] expecting (defghijk)
ok 25 - Testing: [10:] expecting (k)
ok 26 - Testing: [:] expecting (abcdefghijk)
ok 27 - Testing: [:0] expecting ()
ok 28 - Testing: [-3:-1] expecting (ij)
ok 29 - Testing: [-3:-3] expecting ()
ok 30 - Testing: [-3:0] expecting ()
ok 31 - Testing: [-3:2] expecting ()
ok 32 - Testing: [-11:-1] expecting (abcdefghij)
ok 33 - Testing: [-11:-0] expecting ()
ok 34 - Testing: [-12:-1] expecting (abcdefghij)
ok 35 - Testing: [-12:1] expecting (a)
ok 36 - Testing: [-2:10] expecting (j)
ok 37 - Testing: [3:-1] expecting (defghij)
ok 38 - Testing: [7:-5] expecting ()
ok 39 - Testing: [3:4] expecting (d)
ok 40 - Testing: [0:12] expecting (abcdefghijk)
TESTING Python with array (abcdefghijk)
ok 41 - Testing: [:3] expecting (abc)
ok 42 - Testing: [:-3] expecting (abcdefgh)
ok 43 - Testing: [-3:] expecting (ijk)
ok 44 - Testing: [3:] expecting (defghijk)
ok 45 - Testing: [10:] expecting (k)
ok 46 - Testing: [:] expecting (abcdefghijk)
ok 47 - Testing: [:0] expecting ()
ok 48 - Testing: [-3:-1] expecting (ij)
ok 49 - Testing: [-3:-3] expecting ()
ok 50 - Testing: [-3:0] expecting ()
ok 51 - Testing: [-3:2] expecting ()
ok 52 - Testing: [-11:-1] expecting (abcdefghij)
ok 53 - Testing: [-11:-0] expecting ()
ok 54 - Testing: [-12:-1] expecting (abcdefghij)
ok 55 - Testing: [-12:1] expecting (a)
ok 56 - Testing: [-2:10] expecting (j)
ok 57 - Testing: [3:-1] expecting (defghij)
ok 58 - Testing: [7:-5] expecting ()
ok 59 - Testing: [3:4] expecting (d)
ok 60 - Testing: [0:12] expecting (abcdefghijk)
| [reply]
[d/l]
[select] |
Re: Converting python list range expressions to perl
by rsFalse (Chaplain) on Dec 06, 2022 at 14:40 UTC
|
my @a = 'a' .. 'g';
my $py_range = <>; # '[x:y]'
my $perl_range = $py_range =~ s{\[:}{[0:}r =~ s{:\]}{:0]}r =~ s/:\K-?\
+d+/$&-1/er =~ s/-\d+/$&+@a/ger =~ s/:/../r;
print eval '@a' . $perl_range;
| [reply]
[d/l] |
|
|
