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;
}