#!/usr/bin/perl

# http://perlmonks.org/?node_id=1193467

use strict;
use warnings;

my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
my @copy;

$_ == 6 .. $_ == 7 or push @copy, $_ for @$aref;

use Data::Dumper;
print Dumper \@copy;
[download]

c:\@Work\Perl\monks>perl -wMstrict -MData::Dump -le
"my $aref = [ 6, 7, 1, 6, 8, 9, 7, 2, 6, 98, 99, 7, 3, 7, 4, 6, 5, ];
 dd $aref;
 ;;
 my @copy;
 $_ == 6 .. $_ == 7 or push @copy, $_ for @$aref;
 ;;
 dd \@copy;
"
[6, 7, 1, 6, 8, 9, 7, 2, 6, 98, 99, 7, 3, 7, 4, 6, 5]

[1, 2, 3, 7, 4]
[download]

What's supposed to happen if a "start" code for an exclusion sequence is seen, but no corresponding "stop" code is ever seen? My assumption was that no exclusion would happen. I expected
    [6, 7, 1, 6, 8, 9, 7, 2, 6, 98, 99, 7, 3, 7, 4, 6, 5]
to yield
    [1, 2, 3, 7, 4, 6, 5]


---

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

Building upon your very elegant solution, but changing it somewhat so it now adds to the valid output a sequence at the end that starts with a 6 but never gets ended by a 7.

use Modern::PBP::Perl;

my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7, 1, 2, 6, 9, 8, 6, 5];
my @copy;
my @stack;

(($_ == 6 .. $_ == 7) and push @stack, $_) or (push @copy, $_ and @sta
+ck=()) for @$aref;
push @copy, @stack;

use Data::Dumper;
print Dumper \@copy;
[download]

CountZero

A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

My blog: Imperial Deltronics

What's supposed to happen if a "start" code for an exclusion sequence is seen, but no corresponding "stop" code is ever seen?

If the RHS of the flip-flop operator never gets true, then the flip-flop just stays as it is. Hence after 7,4 the 6 turns the flip-flop on, and 6,5 aren't pushed onto @copy.

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

• I assume that some sequence that starts with 6 but never has a "terminating" "7" means that those numbers appear in the result.
• sequence starts on the "first 6" and ends on "next 7" (if it ends at all, see previous)
• A "7" that occurs without a previous matching "6" is part of the results

In the code below, once a 6 is seen, I keep the numbers on a stack so that I can use them later if no matching 7 is found. The scalar value of @stack also does double duty as the "seen a 6 - inside of a potential sequence flag". I think the logic here is clear albeit a bit wordy. However well spaced out, simple code tends to run very quickly and I don't consider a bunch of white space a "problem"

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
#http://www.perlmonks.org/?node_id=1193467

my $aref = [1, 7, 6, 2, 2, 7, 1, 6, 99, 99,7,88, 7, 6,1,2,3];

my @result;
my @stack = ();

foreach my $candidate (@$aref)
{
   if ($candidate == 6)   # starting flag
   { 
      push @stack,6;
   }
   elsif ($candidate == 7) #potential ending flag
   {
      if (@stack)
      {
          @stack=(); #throw away between 6, x, y, 7
      }
      else
      {
          push @result, 7;  # 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?
 

print Dumper \@result;

__END__
prints:
$VAR1 = [
          1,
          7,
          1,
          88,
          7,
          6,
          1,
          2,
          3
        ];
[download]

I was thinking along lines similar to Marshall:

c:\@Work\Perl\monks>perl -wMstrict -MData::Dump -le
"use constant {
   START => 6,
   STOP  => 7,
   };
 ;;
 my $aref = [ 6, 7, 1, 6, 8, 9, 7, 2, 6, 98, 99, 7, 3, 7, 4, 6, 5, ];
 dd $aref;
 ;;
 my @final;
 my $maybe_truncate;
 ;;
 for my $element (@$aref) {
   if (defined $maybe_truncate) {
     if ($element == STOP) {
       $#final = $maybe_truncate;
       undef $maybe_truncate;
       next;
       }
     }
   else {
     if ($element == START) {
       $maybe_truncate = $#final;
       }
     }
   push @final, $element;
   }
 ;;
 dd $aref;
 dd \@final;
"
[6, 7, 1, 6, 8, 9, 7, 2, 6, 98, 99, 7, 3, 7, 4, 6, 5]

[6, 7, 1, 6, 8, 9, 7, 2, 6, 98, 99, 7, 3, 7, 4, 6, 5]

[1, 2, 3, 7, 4, 6, 5]
[download]

I suspect this logic can be cleaned up significantly. I'd like get something approaching tybalt89's solution.

---

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

All my tests have returned the right results with Marshall's code .

 $./ignore_6_to_7.pl

Original Array : 1 6 2 2 7 1 6 99 99 7
Result: 1 1
**********

Original Array : 1 2 2
Result: 1 2 2
**********

Original Array : 1 1 6 7 2
Result: 1 1 2
**********

Original Array : 1 6 2 2 7 1 6 99 99 7
Result: 1 1
**********

Original Array : 2 7 6 2 6 7 2 7
Result: 2 7 2 7
**********

Original Array : 1 6 7 7
Result: 1 7
**********

Original Array : 2 7 6 2 6 2 7
Result: 2 7
**********

Original Array : 6 7 1 6 7 7
Result: 1 7
**********

Original Array : 6 8 1 6 7
Result:
**********
[download]

Hi pr33,

Wow, your question certainly got the Monks working on lots of solutions!

I recommend understanding every single program in this thread... Understand exactly how they work.

I am curious if this was some sort of homework assignment or not?
I am also curious about what other languages you know?

I did not assume that this was homework for the simple reason that the beginner classes that I work with would not have even covered array indicies before an assignment like this would be given. You wouldn't be thinking in that direction because, the class wouldn't have even talked about it! Of course it could be that you are in a "bad class". In any case all the better to show some better ways!

None of the code presented (except yours) uses splice() and array index. I hope that sends you a clear message! Normally use the Perl array iterators which do not depend upon some [$i] index value. Of course indicies can and should be used in some situations, but they should not be your first thought.

My code perhaps appears at first glance to be "complicated" as compared to some of the more brief solutions. I will try to explain the thought process. Maybe other Monks can do that for their code also?

I rejected at first thought any idea of splice() and index as being too complicated. Also your code did not require me to modify the input array "in place" - that means to me that I can use extra memory for the "solution".

I started with a foreach loop over all of the input numbers. There are actually 4 conditions:

• Something needs to happen if I see a "6"
• Something needs to happen if I see a "7"
I worked on those parts (ran the code) and made decisions about not needing a $flag and that @stack could serve that function.

Then I coded:

• Case where I am within a 6,x,yz,7 sequence
• Case where I am not within such a sequence.
There was some short back and forth to fine tune the singleton 7 idea, but there was a place for it within the 4 basic cases.

I recommend looking at Laurent_R's solution here. It is shorter but still has the basic 4 different situations.

Of course, "shorter, fewer lines" does not always mean "better" or even "faster". I tried to present some code for you that you could understand and modify if necessary to meet your needs.

What about

Original Array : 1 6 2 2 7 1 6 99 99
Result: ?
[download]

Thanks Marshall . The solution works . The other solution by tybalt89 also works, But I was looking for a more structured code similar to your's.

I am trying to splice the array on the copy and not original array But looks like the loop ends before it can read the next 6 in the list

It's not the loop ending prematurely, it is wrong indices.

This happens because splice shrinks the array @copy, and after that, the original and copy arrays aren't aligned any more. You need yet another variable which holds the amount of elements spliced off, and decrease $sixindex by that amount at the next splice operation, otherwise the offset is outside the @copy array.

Adding some debug print statements shows the problem:

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dump;
########

 my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
 my $flag = 0;
 my $i = 1;
 my $sixindex = 0;
 my @copy = @$aref;
if (scalar(@$aref) >= 2) {
    foreach my $x (0..$#{$aref}) {
        print "pass $x\n";
        dd $aref;
        dd \@copy;
        if (defined($aref->[$x])) {
               if ($aref->[$x] == 6) {
                 $flag = 1;
                 $sixindex = $x;
                 next;
               }

             if ($flag) {
                   unless ($aref->[$x] == 7) {
                     $i++;
                         next;
                  } elsif ($aref->[$x] == 7 ) {
                         print "splice $sixindex, ",($i+1),"\n";
                         splice(@copy, $sixindex, $i + 1);
                         $flag = 0;
                         $i = 1;
                         $sixindex = 0;
                     next;
              }
          }
      }
    }
}

dd \@copy;
__END__
pass 0
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
pass 1
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
pass 2
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
pass 3
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
pass 4
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
splice 1, 4
pass 5
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 1, 6, 99, 99, 7]
pass 6
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 1, 6, 99, 99, 7]
pass 7
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 1, 6, 99, 99, 7]
pass 8
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 1, 6, 99, 99, 7]
pass 9
[1, 6, 2, 2, 7, 1, 6, 99, 99, 7]
[1, 1, 6, 99, 99, 7]
splice 6, 4
[1, 1, 6, 99, 99, 7]
[download]

The second splice at pass 9 has an offset of 6, but the last element of @copy is at index 5. Pass 4 spliced off 4 elements, so you want offset 2 here (6 - 4).

This does what you want:

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dump;
########

 my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
 my $flag = 0;
 my $i = 1;
 my $sixindex = 0;
 my $spliced = 0;
 my @copy = @$aref;
if (scalar(@$aref) >= 2) {
    foreach my $x (0..$#{$aref}) {
        print "pass $x\n";
        dd $aref;
        dd \@copy;
        if (defined($aref->[$x])) {
               if ($aref->[$x] == 6) {
                 $flag = 1;
                 $sixindex = $x;
                 next;
               }

             if ($flag) {
                   unless ($aref->[$x] == 7) {
                     $i++;
                         next;
                  } elsif ($aref->[$x] == 7 ) {
                         print "splice ",$sixindex-$spliced, " ",($i+1
+),"\n";
                         splice(@copy, $sixindex-$spliced, $i + 1);
                         $spliced += $i + 1;
                         $flag = 0;
                         $i = 1;
                         $sixindex = 0;
                     next;
              }
          }
      }
    }
}

dd \@copy;
[download]

All that indexing stuff is only necessary because you make a copy of the array and delete the ignored elements later. Is that a requirement of the homework? If not, you could drop all that index counting and track keeping stuff, and just push the elements not to be ignored onto @copy :

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dump;
########

my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
my $flag = 0;
my @copy;
if (scalar(@$aref) >= 2) {
    foreach my $x (@$aref) {
        dd $aref;
        dd \@copy;
        if (defined($x)) {
             if ($x == 6) {
                 $flag = 1;
                 next;
             }

             if ($flag) {
                  next unless $x == 7;
                  $flag = 0;
                  next;
             }
             print "push \@copy,$x\n";
             push @copy, $x;
          }
    }
}

dd \@copy;
[download]

The only helper variable left now is $flag. But Perl has the ".." range operator which acts like a flip-flop, and as such has the $flag boolean built-in. Using that:

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dump;
########

my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
my $flag = 0;
my @copy;
if (scalar(@$aref) >= 2) {
    foreach my $x (@$aref) {
        dd $aref;
        dd \@copy;
        if (defined($x)) {
             if ($x == 6 .. $x == 7) {
                 next;
             }
             print "push \@copy,$x\n";
             push @copy, $x;
          }
    }
}

dd \@copy;
[download]

Condense that a bit further, and you have tybalt89's solution.

Thanks shmem. I have realized the problem with my code initially and couldn't think of a way to fix the offset going outside of the @copy array

The second solution using array values is precise and clear . I have tried the code and it yields right results for all the test iterations.

Alternatively, you can just use splice with a negative offset to remove elements from the end

#!perl
use strict;
use warnings;

while (<DATA>){
  chomp;
  my $aref = [ split /\s+/,$_ ];
  print join ' ', 'Original Array:', @$aref,"\n";

  my $start; my @copy=(); my $i=0;
  for (@$aref){
    push @copy,$_;
    if ($_ == 6){
      $start = $i unless defined $start;
    } elsif (defined $start && $_ == 7){
      splice @copy, $start-$i-1;
      $start = undef;
    }
    ++$i;
  }
  print join ' ','Results:',@copy,"\n"; 
}

__DATA__
1 6 2 2 7 1 6 99 99 7
1 2 2
1 1 6 7 2
1 6 2 2 7 1 6 99 99 7
2 7 6 2 6 7 2 7
1 6 7 7
2 7 6 2 6 2 7
6 7 1 6 7 7
6 8 1 6 7
[download]

poj

There's another way to do it: use decreasing indices and iterate from the end to the beginning. This keeps the arrays aligned after splice.

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

I first thought that Marshall's solution looked a bit complicated, but I ended up with something quite similar:

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;

my $aref = [6, 1, 7, 6, 2, 2, 7, 1, 6, 99, 99, 7, 88, 7, 6, 1, 2, 3];
my (@temp, @result);
my $flag = 0;

for my $num (@$aref) {
    $flag = 1 if $num == 6;
    if ($flag) {
        push @temp, $num;
    } else {
        push @result, $num;
    }
    if ($num == 7) {
        @temp = ();
        $flag = 0;
    } 
}
push @result, @temp;
print Dumper \@result;
[download]

Using references to the @result and @temp arrays rather that a $flag can make the for loop significantly shorter:

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;

my $aref = [1, 7, 6, 2, 2, 7, 1, 2, 6, 99, 99, 7, 88, 7, 6, 1, 2, 3];
my (@temp, @result);
my $target_ref = \@result;

for my $num (@$aref) {
    $target_ref = \@temp if $num == 6;
    push @$target_ref, $num;
    $target_ref = \@result, @temp = () if $num == 7;
}
push @result, @temp;
print Dumper \@result;
[download]

Output:

$ perl range4.pl
$VAR1 = [
          1,
          7,
          1,
          2,
          88,
          7,
          6,
          1,
          2,
          3
        ];
[download]

You have a semi-reasonable model for what you wish to do. But consider the possibilities of using a while loop (cf: perldoc  perlsysn)

Also, please note that your advance rejection of regex approaches flies in the face of the PM appoach: "we're here to help you learn."

Thanks .

It is not that I didn't want to use Regex , But just wanted to try out the Non-Regex solution .

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.

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". Sorry^TM!

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

use Data::Dumper;
my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
my @new = ();
my $flag = 0;
for (@$aref) {
    $flag = 1 if (!$flag and $_==6);
    push @new, $_ if !$flag;
    $flag = 0 if ($flag and $_==7);
}
$aref = \@new;
print Dumper $aref;
[download]

This won't work if the list has a six not followed somewhere by a seven, for example with a list like:

my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7, 5, 3, 6, 5, 88];
[download]

the last three digits are omitted from the result, although they are not in a 6..7 range.

Sure, but I was explaining algorithm for the OP and was deliberately avoiding that part of the discussion, because normally, one does not allow e.g. a left bracket without a right bracket before even letting the data through to the processing phase - that is a "syntax error" in my book. So in my example, if the flag is still turned on after the loop I would terminate with an error message, unless the OP specifically stated that an unterminated 6 is allowed, in which case I would save what isn't being pushed into a separate array and push it at the end if the flag is still turned on i.e.:

use Data::Dumper;
my $allow_loose6 = 1;
my $aref = [1, 6, 2, 2, 7, 1, 6, 99, 99, 7];
my @new = ();
my @loose = ();
my $flag = 0;
for (@$aref) {
    $flag = 1 if (!$flag and $_==6);
    if (!$flag) {
    push @new, $_;
    }
    else {
        push @loose, $_;
    }
    if ($flag and $_==7) {
        $flag = 0;
    @loose = ();
    }
}
$aref = \@new;
if ($allow_loose6) {
    push @$aref, @loose;
}
elsif (@loose) {
    die "Unterminated 6 detected";
}
print Dumper $aref
[download]

One world, one people

> It is not that I didn't want to use Regex , But just wanted to try out the Non-Regex solution .

Please note that to be able to kill a chicken using only the tongue does not make you a better chef

But do you like banning elements using a blacklist hash?

perl -e "$h{6}=$h{7}=1;for (@ARGV){print qq($_ ) unless exists $h{$_}}
+" 1 6 2 2 7 1 6 99 99 7

1 2 2 1 99 99
[download]

L*

perl -e "$h{6}=$h{7}=1;for (@ARGV){print qq($_ ) unless exists $h{$_}}" 1 6 2 2 7 1 6 99 99 7

In this case, exists is not needed, because all numbers in the blacklist have values that evaluate to true:

>perl -e "$h{6}=$h{7}=1;for (@ARGV){print qq($_ ) unless $h{$_}}" 1 6 
+2 2 7 1 6 99 99 7
1 2 2 1 99 99
>
[download]

And for the same reason, we can shorten that a little bit more by using OR instead of postfix unless:

>perl -e "$h{6}=$h{7}=1;for(@ARGV){$h{$_}||print qq($_ )}" 1 6 2 2 7 1
+ 6 99 99 7
1 2 2 1 99 99
>
[download]

Switching to postfix for gets rid of a few more characters:

>perl -e "$h{6}=$h{7}=1;$h{$_}||print qq($_ )for@ARGV" 1 6 2 2 7 1 6 9
+9 99 7
1 2 2 1 99 99
>
[download]

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

Most of the posts in this thread are wrong by title. Way too much "numbers ina List".