Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Getting for() to accept a tied array in one statement

by perlancar (Pilgrim)
on Apr 16, 2019 at 11:10 UTC ( #1232642=perlquestion: print w/replies, xml ) Need Help??

perlancar has asked for the wisdom of the Perl Monks concerning the following question:

To give a context, this question is part of my continuing quest to port Python's tqdm style (see Part 1 here: Porting tqdm to Perl). So basically I want to wrap an array or a list of values in a for() loop like this:

for("some", "el", "ems") { ... }
with some kind of iterator using this syntax:
for (wrapper("some", "elems")) { # some code }

So that for each iteration, as Perl executes some code, each element retrieval also gets to run my code, so I can do something. In the case of tqdm, I want to measure how long some code run so I can give feedback to user on how long the whole loop is going to take. Thus, in essence, adding a progress indicator just by wrapping the list of values given to for().

In Python, this is easy to do because for() already expects an iterator.

In Perl, I can use the array tie mechanism to do this:

tie @ary, "My::Class", "some", "el", "ems"; for (@ary) { some_code($_); }

The order of code being executed will be:

My::Class::TIEARRAY
My::Class::FETCHSIZE
My::Class::FETCH(0) -> "some"
some_code("some")
My::Class::FETCHSIZE
My::Class::FETCH(1) -> "el"
some_code("el")
My::Class::FETCHSIZE
My::Class::FETCH(2) -> "ems"
some_code("ems")

So far so good. However, I also want a nice syntax like in the Python version. Condensing the above syntax to what I want is still not possible: for (tie @ary, "My::Class", "some", "el", "ems") { ... } # NOPE

This makes for() only loops over a single value, the tied object.

for (do { tie @ary, "My::Class", "some", "el", "ems"; @ary }) { ... } # NOPE

This will FETCH() all elements first before giving them to for().

Any ideas? So far I'm thinking of creating a custom C<for()> function.

EDIT: Added some clarification/additional explanation.

Replies are listed 'Best First'.
Re: Getting for() to accept a tied array in one statement
by dave_the_m (Monsignor) on Apr 16, 2019 at 13:58 UTC
    Is it an absolute requirement to have all the code within the while/for expression? I.e. is the following acceptable:
    my $iter = TQDM::tqdm(1..10); while (<$iter>) { print "got [$_]\n"; }
    If so, then the behaviour you want is easily achieved using overloaded '<>'.

    Otherwise, I think you need a custom iterator function, e.g.

    sub iterate ($&) { my ($ary, $code) = @_; for (@$ary) { print "progress bar: $_\n"; $code->(); } } sub tqdm { bless [ @_ ] } iterate tqdm(1..10), sub { print "got [$_]\n"; };

    Dave.

      Yes, in this case the goal is on how easy it is to add a progress indicator to an existing code that uses for(). If a user has to change her for() to while(), that would count as less easy. It's akin in spirit to data dumping modules like XXX or Data::Dmp that returns its original argument so you can insert XXX or dmp just about anywhere in an existing Perl code.

      Next step after I conquer for(), will probably move on to while(). :-) Yes, I'll be looking into overloading the diamond operator or tying filehandle.

        I don't think its possible in perl to write a function foo() that will allow any of the following in the way you want:
        for (foo(list)) { ... } while (foo(list)) { .... } while (<foo(list)>) { .... }
        assuming that for and while are the perl built-ins, and that you're not using source filtering or keyword plugins etc.

        Dave.

Re: Getting for() to accept a tied array in one statement
by hdb (Monsignor) on Apr 16, 2019 at 12:15 UTC

    Never used tie before, so this is a good learning experience, even though like LanX I do not know either what this is good for. In any case, I think, this works as required:

    for( @{ tie my @x, "My::Class", "first", "second"; \@x } ) { print "$_\n"; }
      Your code which wraps tie in @{ ... } does not work because all elements are FETCH-ed first before the loop block code is executed. I.e. in the above case, FETCH(0) and FETCH(1) are called before "first" and "second" are print-ed by print(). The @{ ... } basically turns the tied array into list of values. I need to iterate over the tied array so the code in the loop block (in this case, print()) is executed along with FETCH/FETCHSIZE.

        I disagree. Here is the full code and FETCH is only called once for each element within the body of the loop:

        use strict; use warnings; package MyClass; use Tie::Array; our @ISA = ('Tie::Array'); our @data; # mandatory methods sub TIEARRAY { my $class = shift; bless \@data, $class; @data = @_ +; return \@data } sub FETCH { print "FETCH: "; my ($self, $index ) = @_; return $dat +a[$index] } sub FETCHSIZE { print "<FETCHSIZE> "; return scalar @data } package main; for( @{ tie my @x, "MyClass", "first", "second"; \@x } ) { print "In loop = "; print "$_\n"; }

        Output:

        In loop = FETCH: first In loop = FETCH: second
Re: Getting for() to accept a tied array in one statement
by LanX (Archbishop) on Apr 16, 2019 at 11:25 UTC
    > However, condensing the above syntax to what I want is still not possible:

    waht?

    please provide a test case clearly demonstrating what you want and what not.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

      for (tie @ary, "My::Class", "some", "contents") { ... } # NOPE

      does not work because for() gets a single-element list which is the tied object, not the tied array itself.

      for (do { tie @ary, "My::Class", "some", "contents"; @ary }) { ... } #NOPE

      does not work because for() gets an ordinary (non-magical) list of values. All the values from the tied array have been FETCH-ed. I need to iterate over the tied array so code inside the loop block and FETCH are executed once for each element, together.

      tie @ary, "My::Class", "some", "contents"; for (@ary) { ... }

      works, but I want something more similar to:

      for (wrapper(@ary)) { ... }

      where @ary is an ordinary array or a list of values.

        > because for() gets an ordinary (non-magical) list of values.

        That's not how I understand the output. It seems FETCHSIZE is only called once, but each element is fetched right before the iteration:

        #! /usr/bin/perl use warnings; use strict; use feature qw{ say }; { package My; use Tie::Array; use parent -norequire => 'Tie::StdArray'; sub TIEARRAY { warn "TIE: @_\n"; my $class = shift; bless [@_], $class } sub FETCHSIZE { warn "SIZE: @_\n"; return scalar @{ $_[0] } } sub FETCH { warn "FETCH: @_\n"; my ($ar, $idx) = @_; my $e = $ar->[$idx]; return ++$e } } for my $e (do { tie my @ar, 'My', qw( a b c ); @ar } ) { say "MAIN: $e"; }
        Output:
        TIE: My a b c SIZE: My=ARRAY(0x21eff40) FETCH: My=ARRAY(0x21eff40) 0 MAIN: b FETCH: My=ARRAY(0x21eff40) 1 MAIN: c FETCH: My=ARRAY(0x21eff40) 2 MAIN: d

        for my $e (@ar), on the other hand, calls FETCHSIZE before each FETCH.

        map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

        This:

        for (tie @ary, "My::Class", "some", "contents";) { ... }

        is exactly what you should NOT be doing

        Read: Tying-Arrays: If someone outside the class tries to dereference the object returned (doubtless thinking it an ARRAY ref), they'll blow up. This just goes to show you that you should respect an object's privacy.

        FETCH and FETCHSIZE are exactly for that you can: 'respect an object's privacy':

        Something like this:

        my $aryt = tie @ary, "My::Class", "some", "contents"; @ary = ... ; for (0..($aryt->FETCHSIZE-1)) { do-something($aryt->FETCH($_)); }
        you can't bend for into an object's method.

        Perl != Python

        the closest to a drop in replacement is maybe a customfunction sub xfor (&&) :

        xfor {@arr} sub { ...};

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Re: Getting for() to accept a tied array in one statement
by bliako (Priest) on Apr 17, 2019 at 10:08 UTC

    There is also the 3-part for:

    #!/usr/bin/env perl # author: bliako # for: https://perlmonks.org/?node_id=1232642 # 17/04/2019 use strict; use warnings; package Wrapper; # use: new(code, array) sub new { return bless {s=>$_[1],a=>[@_[2..$#_]],c=>0}, $_[0] } sub next { $_[0]->{s}->(); scalar(@{$_[0]->{a}}) > $_[0]->{c} ? $_[0]->{a}->[$_[0]->{c}++ +] : undef } sub reset { $_[0]->{c} = 0 } package main; for($_=Wrapper->new(sub{print "hello\n"}, 1..10);my $_2=$_->next;){ print "got=$_2\n"; }

    bw, bliako

Re: Getting for() to accept a tied array in one statement
by LanX (Archbishop) on Apr 18, 2019 at 14:19 UTC
    tie @ary, "My::Class", "some", "el", "ems"; for (@ary) { some_code($_); }

    What if the loop is left by last , next , redo , return or goto ?

    Does the code hooked into the tied array really catch all edge cases sufficiently for your progress-bar?

    edit

    Is there any ->DESTROY of the tied class being called?

    NB: As already told, be aware about restrictions on Perl versions.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

      Is there any ->DESTROY of the tied class being called?

      It depends where the @ary is defined. In the solution suggested by hdb, there is a DESTROY:

      use warnings; use strict; print "--- Begin loop ---\n"; for ( @{ tie my @ary, 'MyArray', qw/ x y z /; \@ary } ) { print "<$_>\n"; last if /y/; } print "--- End loop ---\n"; BEGIN { package MyArray; sub TIEARRAY { my $c = shift; bless { arr=>[@_] }, $c } # largely borrowed from Tie::StdArray sub FETCH { $_[0]{arr}[$_[1]] } sub STORE { $_[0]{arr}[$_[1]] = $_[2] } sub FETCHSIZE { scalar @{$_[0]{arr}} } sub STORESIZE { $#{$_[0]{arr}} = $_[1]-1 } sub EXTEND { $#{$_[0]{arr}} = $_[1]-1 } sub CLEAR { @{$_[0]{arr}} = () } sub POP { pop @{$_[0]{arr}} } sub SHIFT { shift @{$_[0]{arr}} } sub PUSH { my $o=shift; push @{$$o{arr}}, @_ } sub UNSHIFT { my $o=shift; unshift @{$$o{arr}}, @_ } sub EXISTS { exists $_[0]{arr}[$_[1]] } sub DELETE { delete $_[0]{arr}[$_[1]] } sub UNTIE { %{$_[0]}=(); return } sub DESTROY { %{$_[0]}=(); return } sub SPLICE { my $ob = shift; my $sz = $ob->FETCHSIZE; my $off = @_ ? shift : 0; $off += $sz if $off < 0; my $len = @_ ? shift : $sz-$off; return splice(@{$$ob{arr}}, $off, $len, @_); } # debug stuff: use Class::Method::Modifiers qw/around/; use Data::Dump qw/pp/; my @m = qw/ CLEAR DELETE DESTROY EXISTS EXTEND FETCH FETCHSIZE POP PUSH SHIFT SPLICE STORE STORESIZE TIEARRAY UNSHIFT UNTIE /; for my $m (@m) { around $m => sub { my $orig = shift; my $self = shift; my @args = @_; if (wantarray) { my @rv = $orig->($self, @_); print STDERR $m," ",pp(@args)," => ",pp(@rv),"\n"; return @rv; } # else my $rv = $orig->($self, @_); print STDERR $m," ",pp(@args)," => ",pp($rv),"\n"; return $rv; }; } } __END__ --- Begin loop --- TIEARRAY ("x", "y", "z") => bless({ arr => ["x", "y", "z"] }, "MyArray +") FETCHSIZE () => 3 FETCH 0 => "x" <x> FETCHSIZE () => 3 FETCH 1 => "y" <y> DESTROY () => undef --- End loop ---
        Haven't tested it yet but your results look convincing. :)

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

      What if the loop is left by last , next , redo , return or goto ?

      Nice catch. In the Python library, this must be handled explicitly by "closing" the iterator.

        > In the Python library, this must be handled explicitly

        LOL...

        well hooking into DESTROY should handle this implicitly.

        BTW: I forgot to list die and exception handling.

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2019-06-25 05:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Is there a future for codeless software?



    Results (101 votes). Check out past polls.

    Notices?