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

Re: Ignore a range of numbers ina List

by AnomalousMonk (Archbishop)
on Jun 25, 2017 at 19:21 UTC ( [id://1193525]=note: print w/replies, xml ) Need Help??


in reply to Ignore a range of numbers ina List

A bit late to the party, but here's a testing framework for many of the solutions given so far. Test cases from pr33's post are included. Only solutions passing all test cases are currently active.

use warnings; use strict; use Test::More 'no_plan'; use Test::NoWarnings; use Data::Dump qw(dd); # test sets ######################################################## use constant { A => 6, # start code Z => 7, # stop code }; use constant TEST_SET_1 => ( # includes test cases from pr33's pm#1193487 'no change, input list to output list', [ [ ], [ ], ], [ [ 5, ], [ 5, ], ], [ [ A, ], [ A, ], ], [ [ Z, ], [ Z, ], ], [ [ A, A, ], [ A, A, ], ], [ [ Z, Z, ], [ Z, Z, ], ], [ [ 1, 2, 2, ], [ 1, 2, 2, ], ], 'one or more subsequences eliminated', [ [ 1, A, 2, 2, Z, 1, A, 99, 99, Z, ], [ 1, 1, ], ], [ [ 1, 1, A, Z, 2, ], [ 1, 1, 2, ], ], [ [ 1, A, 2, 2, Z, 1, A, 99, 99, Z, ], [ 1, 1, ], ], [ [ 2, Z, A, 2, A, Z, 2, Z, ], [ 2, Z, 2, Z, ], ], [ [ 1, A, Z, Z,], [ 1, Z,], ], [ [ 2, Z, A, 2, A, 2, Z, ], [ 2, Z, ], ], [ [ A, Z, 1, A, Z, Z, ], [ 1, Z, ], ], [ [ A, 8, 1, A, Z, ], [ ], ], [ [ A, Z, 1, A, 8, 9, Z, 2, A, 98, 99, Z, 3, Z, 4, A, 5, ], [ 1, 2, 3, Z, 4, A, 5, ], ], [ [ A, 1, A, 8, 9, Z, 2, A, 98, 99, Z, 3, Z, 4, A, 5, ], [ 2, 3, Z, 4, A, 5, ], ], [ [ A, Z, 1, A, 8, 9, Z, 2, A, 98, 99, Z, 3, Z, 4, A, 5, Z, ], [ 1, 2, 3, Z, 4, ], ], ); # functions under test ############################################# sub Marshall_1193478 { # Marshall pm#1193478 my ($ar_input, ) = @_; my @result; my @stack = (); foreach my $candidate (@$ar_input) { if ($candidate == A) # starting flag { push @stack,A; } elsif ($candidate == Z) #potential ending flag { if (@stack) { @stack=(); #throw away between 6, x, y, 7 } else { push @result, Z; # a singleton 7 was seen } } elsif (@stack) # inside of sequence starting with 6 { push @stack, $candidate; } else { push @result, $candidate; } } push @result, @stack if @stack; # unfinished sequence starting with 6 +? return \@result; } # end sub Marshall_1193478() sub AnomalousMonk_1193486 { # similar to Marshall pm#1193478 my ($ar_input, ) = @_; my @final; my $maybe_truncate; for my $element (@$ar_input) { if (defined $maybe_truncate) { if ($element == Z) { $#final = $maybe_truncate; undef $maybe_truncate; next; } } else { if ($element == A) { $maybe_truncate = $#final; } } push @final, $element; } return \@final; } sub CountZero_1193493 { # CountZero pm#1193493 my ($ar_input, ) = @_; my @copy; my @stack; (($_ == A .. $_ == Z) and push @stack, $_) or (push @copy, $_ and @stack=()) for @$ar_input; push @copy, @stack; return \@copy; } sub am_1193498 { # pm#1193498 my ($ar_input, ) = @_; my @new = (); my $flag = 0; for (@$ar_input) { $flag = 1 if (!$flag and $_==A); push @new, $_ if !$flag; $flag = 0 if ($flag and $_==Z); } return \@new; } sub tybalt89_1193471 { # tybalt89 pm#1193471 my ($ar_input, ) = @_; my @copy; $_ == A .. $_ == Z or push @copy, $_ for @$ar_input; return \@copy; } sub shmem_1193496 { # shmem pm#1193496, after tybalt89 pm#1193471 my ($ar_input, ) = @_; my @copy; if (scalar(@$ar_input) >= 2) { foreach my $x (@$ar_input) { if (defined($x)) { if ($x == A .. $x == Z) { next; } push @copy, $x; } } } return \@copy; } sub Laurent_R_1193496 { # Laurent_R pm#1193509 my ($ar_input, ) = @_; my (@temp, @result); my $target_ref = \@result; for my $num (@$ar_input) { $target_ref = \@temp if $num == A; push @$target_ref, $num; $target_ref = \@result, @temp = () if $num == Z; } push @result, @temp; return \@result; } # testing, testing... ############################################## FUNT: for my $ar_funt ( # function name comment [ 'Marshall_1193478', 'Marshall pm#1193478', ], [ 'AnomalousMonk_1193486', 'similar to Marshall pm#1193478', ], # [ 'tybalt89_1193471', 'tybalt89 pm#1193471', ], # [ 'CountZero_1193493', 'extending tybalt89 pm#1193471', ], # [ 'shmem_1193496', 'after tybalt89 pm#1193471', ], [ 'Laurent_R_1193496', 'Laurent_R pm#1193509', ], # [ 'am_1193498', 'pm#1193498', ], ) { my ($func_name, $func_note) = @$ar_funt; *ignore_range = do { no strict 'refs'; *$func_name; }; defined $func_note ? note "\n $func_name() -- $func_note \n\n" : note "\n $func_name() \n\n" ; VECTOR: for my $ar_vector (TEST_SET_1) { if (not ref $ar_vector) { # comment string if not vector ref. note $ar_vector; next VECTOR; } my ($ar_input, $ar_expected) = @$ar_vector; my @input_copy = @$ar_input; # copy SHALLOW array for later check my $ar_got = ignore_range($ar_input); my $cmnt_str = make_cmnt_str($ar_got, $ar_expected); is_deeply $ar_got, $ar_expected, $cmnt_str; # input array referent is shallow, so next test should be kosher. is_deeply($ar_input, \@input_copy, 'no indirect alteration') or die 'indirect alteration' # stop testing immediately ; } # end for VECTOR } # end for FUNT note "\n done testing functions \n\n"; done_testing(); # utility subroutines ############################################## sub make_cmnt_str { my ($ar_got, $ar_expected) = @_; my $str = "[ @$ar_got ] vs [ @$ar_expected ]"; return $str; }


Give a man a fish:  <%-{-{-{-<

Replies are listed 'Best First'.
Re^2: Ignore a range of numbers in a List
by shmem (Chancellor) on Jun 25, 2017 at 22:14 UTC

    Nice! But this is far from complete. Paging through your code, I can see that it is fairly decent, although it is a bit terse regarding comments. Our in-house subset of Perl Best Practices is being observed, perltidy rules followed, overall goals are met by 88.75 percent. Superfluous use of '#' signs nonwithstanding, this can be rated between medium and high. But!

    Before any coding is done, there is testing. Before any testing is done, there are specs. But in this case, only sparse references to the specs are interspersed within your code without any links, neither to the original draft nor to the tickets regarding this issue.

    Please provide an exhaustive specification with bidirectional links to/from the source code via doxygen/pod/name-your-poison for the follow-up meeting tomorrow at 11am. It will not be televised.

    Thank you.

    update: I didn't consult sundialsvc4 regarding the markup of this document. "Mea culpa". SorryTM!

    perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1193525]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (7)
As of 2024-03-28 11:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found