Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Converting python list range expressions to perl

by ibm1620 (Friar)
on Dec 03, 2022 at 18:29 UTC ( #11148536=perlquestion: print w/replies, xml ) Need Help??

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?

Replies are listed 'Best First'.
Re: Converting python list range expressions to perl
by AnomalousMonk (Archbishop) on Dec 03, 2022 at 19:11 UTC

    As Perl array slices (see perldata):

    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:  <%-{-{-{-<

      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
        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'
Re: Converting python list range expressions to perl
by kcott (Archbishop) on Dec 04, 2022 at 03:00 UTC

    G'day ibm1620,

    I think what you're looking for is splice.

    Test script:

    #!/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:]

    — Ken

      Ken, thanks for your writeup, including forcing me to learn a bit about Test -- I needed that! :-)

      I'd rather stick with Perl's slice capability since it reads more cleanly (to me, anyway) and doesn't require copying and modifying the source array. Here's how I ended up implementing and testing pyrange():

      #!/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]
        "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:

        PythonPerl
        [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: [:]

        — Ken

      splice() alters the array, slice does not. I do not intend this as disagreement. I am just trying to add information to help a newbie choose between implementations.

        "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?

        — Ken

Re: Converting python list range expressions to perl
by ibm1620 (Friar) 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)
Re: Converting python list range expressions to perl
by rsFalse (Chaplain) on Dec 06, 2022 at 14:40 UTC
    Possible transforming:
    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;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11148536]
Approved by davies
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (6)
As of 2023-01-30 17:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?