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)
