Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

RFC and debugging tips

by BrowserUk (Pope)
on Aug 29, 2002 at 00:28 UTC ( #193628=perlquestion: print w/replies, xml ) Need Help??
BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

With apologies to Zaxo for continuing to use boolean operators to construct switch statements, I'd appreciate any comments on this code. The sub uFIFO {} rather than the test code below it.

I'd also appreciate any pointers on why the last line of the while loop does nothing?

And the best way of debugging the problem?


#! perl -w use strict; sub uFIFO { my (%fifo, @fifo); my $next = 0; return sub { # no parameters - return the next value or reset the itera +tor and return undef if its the last. !@_ and return (scalar @fifo && $next < @fifo) ? ${$fifo[$next +++]} : ($next=0, undef) # we have parameters and the first one is defined, # push any defined values not already in the list and retu +rn the count of them or defined $_[0] and return scalar map{ defined $_ && !exists $fi +fo{$_} and push @fifo, \($fifo{ $ +_ } = $_) } @_ # We only get this far if the first value is undef! # reset iterator or lc($_[1]) eq 'reset' and $next = 0 # return all values possibly random order or lc($_[1]) eq 'all' and return keys %fifo # return all values possibly random order or lc($_[1]) eq 'ordered' and return map { ${ $_ } } @fifo # for testing only or lc($_[1]) eq 'dump' and return @fifo ; } } my $fifo1 = uFIFO(); # create a fifo - we can have as many as we need # create some test data and shuffle it my @test = ('a' .. 'z', 'i' .. 'r'); ($a=$_+rand @test-$_) and @test[$_,$a] = @test[$a,$_] for (0..$#test); printf "%15.15s: %s\n", 'Initial data', "@test"; # data in original or +der for comparison later $fifo1->( $_ ) for @test; #add some test data # Show only one copy of each made it in print sprintf( "%15.15s: ", 'Added'), "@{[$fifo1->( undef, 'all')]} + ", $/; # process the list, randomly adding some more and printing them out as + we process my $i; printf '%15.15s: ', 'Processed'; while( my $temp= $fifo1->() ) { print $temp, ' ' ; (0 == int(rand 4)) and $fifo1->( ++$i ); # Randomly add new values (0 == int(rand 4)) and $fifo1->( chr(97+rand 26) ); # nothing happ +ens here???? } print $/; print sprintf( "%15.15s: ", 'Ordered'), "@{ [ $fifo1->(undef, 'ordered +') ] }", $/; print sprintf("%15.15s: ", 'Unordered'), "@{ [ $fifo1->(undef, 'all') +] }" , $/; __END__ #output C:\test>193450 Initial data: j h m q f l a w p k u b d n t o r i k o q s l p c x y + n i m r z e g v j Added: a b c d e f g h i j k l m n o p q r s t u v w x y z Processed: j h m q f l a w p k u b d n t o r i s c x y z e g v 1 + 2 3 4 5 6 7 8 9 10 11 12 13 Ordered: j h m q f l a w p k u b d n t o r i s c x y z e g v 1 + 2 3 4 5 6 7 8 9 10 11 12 13 Unordered: a b c d e f g h i j k l m n 1 o 2 p 3 q 10 4 r 11 5 s + 12 6 t 13 7 u 8 v 9 w x y z C:\test>

What's this about a "crooked mitre"? I'm good at woodwork!

Replies are listed 'Best First'.
Re: RFC and debugging tips
by dws (Chancellor) on Aug 29, 2002 at 00:57 UTC
    And the best way of debugging the problem?

    Were I to try to debug this, I would first rework the code to be a lot more readable. I tried to work my way through this by sight, and gave up as soon as I got to the map{} that embedded an expression combining && and 'and', and a reference. Yikes.

    Look at this code from the perspective of trying to follow it by single stepping in the debugger (or setting breakpoints). For that to work, you need lines that don't try to do too much.

    Might it not be easier to debug code that read

    if ( 0 == @_ ) { if ( 0 < @fifo && $next < @fifo ) { return $fifo[$next++]; } else { $next = 0; return; } } elsif defined($_[0]) { ... and so on } else { ... handle 'reset' et al. }
    Code like this stands a chance of being debugable using the debugger, and a better chance of being debuggable by inspection.

Re: RFC and debugging tips
by Zaxo (Archbishop) on Aug 29, 2002 at 02:26 UTC

    In truth, I like using logical operators for this sort of thing, and personally find them very readable. Benefit of a C background.

    The thing that bothers me with reading your code is your API. It is emergent from the logic and not very intuitive. You are implementing a class with a single closure which takes zero or more arguments.

    • $fifo->() returns the next value from the queue, adjusting the state of $fifo.
    • $fifo->(undef) falls all the way through, returning a defined false and not altering state.
    • $fifo->($foo,@bar), with $foo defined, enqueues the elements of the arg list, returning the total length of the queue including those elements which have already been removed. This is unexpected, to me.
    • $fifo->(undef,'cmd'), for 'cmd' one of (reset|all|ordered|dump) either rewinds the queue (returning 0), or returns a peek at all its values.
    • $fifo->(undef,undef,@bar) triggers an undefined value warning.

    Note that each instance of a uFIFO carries an interpreter around with it.

    How about an implementation as a module? Make define a data class with a constructor, a $fifo->enqueue( @foo ) acting like push, and a $fifo->next() which acts like either shift or a nondestructive iterator, depending on what behavior you want. Other methods like 'all' or 'reset' then can be defined as methods also.

    I've coded a in terms of shift. If there's interest, I'll send it to the catacombs.

    After Compline,

Re: uFIFO mk.2
by BrowserUk (Pope) on Aug 29, 2002 at 21:04 UTC

    In reflection of dws's and Zaxo's comments below, and with the help of a tip from Jarich an rob_au in the CB, I've re-cast my uFIFO code.

    It's not designed nor destined to become a module. It's just an exploration of closures and what can be done with them.

    #! perl -w use strict; sub uFIFO { =pod uFIFO - a FIFO that retains only unique values with the ability to + iterate (with multiple independant iterators) implemented using closures. One copy of any value except undef will be retained. Calling syntax: my $fifo = uFIFO(); my $count = $fifo{add}( @list ); # counts only unique value +s added. my $iter1 = $fifo{iterator}(); # Values added whilst the +iterator is active my $iter2 = $fifo{iterator}(); # are handled correctly my $first = $iter1{first}(); # Resets to the oldest val +ue (and returns it) my $next = $iter{next}(); # get the next or undef my @unique= $fifo{all)(); # all entries, undefined o +rder my $unique= $fifo{all}(); # Size of the fifo my $sorted= $fifo{ordered}(); # All in fifo order (scala +r context as above) =cut my (%fifo, @fifo); return { # Push input item or list onto the fifo, return the number of +items added add => sub { return scalar grep { defined $_ && !exists $fifo{ $_ } and push @fifo, \($fifo { $_ } = $_ ); } @_; }, # returns an indepentent iterator for the fifo, iterator => sub { my $next = 0; return { # resets the iterator and returns the first item (Does +n't increment!) first => sub { return scalar @fifo ? ${ $fifo[ $next = 0 ] } : u +ndef; }, # get the next item from the fifo, #or resets and returns undef if at no more next => sub { return scalar @fifo && $next < @fifo? ${ $fifo[$ne +xt++] } : undef; }, }, }, # returns all the values from the fifo # (in a non-determinant order (efficiently)) in a list context # or a count of them in a scalar context all => sub { return keys %fifo; }, # returns all the values in the order in which they were added # earlier values remain in place. Later duplicates do not caus +e promotion. ordered => sub { return map { ${ $_ }} @fifo; }, } }

    If your interested in seeing in use and tested click

Re: RFC and debugging tips
by BrowserUk (Pope) on Aug 29, 2002 at 12:13 UTC

    To answer my own question (finally), the reason the last line of the loop "does nothing" is because thats the way I designed it! The list already contains all the lower-case alpha's, so trying to add more will do nothing! D'oh!

    Of course, what I had intended to do was (0 == int(rand 4)) and $fifo1->( chr(65+rand 26) ); but I just couldn't see it!

    Well It's better than the Abottoire, but Yorkshire!

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://193628]
Approved by Mr. Muskrat
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2017-01-21 05:21 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (182 votes). Check out past polls.