splitting an array

[debraj]

Hi All ,

I have one array of numbers say (12 17 18 19 120 121 122 123 124 379
480 481).
Now I want to get the starting and ending of any cosecutive numbers
from this array .
For eg. result should be (12--12,17--19,120--124,379--379,480--481) .
Note that if a number without any sequence is present it will be
printed in the format 12--12 .

Thanx
debhatta

[Lao Coon]

[email]debhatta@hotmail.com[/email] (debraj) wrote in
news:f9f243e.0309052318.1696c5bb@posting.google.co m:

> Hi All ,
>
> I have one array of numbers say (12 17 18 19 120 121 122 123 124 379
> 480 481).
> Now I want to get the starting and ending of any cosecutive numbers
> from this array .
> For eg. result should be (12--12,17--19,120--124,379--379,480--481) .
> Note that if a number without any sequence is present it will be
> printed in the format 12--12 .

One way:

my @list = (12,17,18,19,120,121,122,123,123,379,480,481);
my @res;
for(my $i = $j = 0; $i < @list; $i++) {
$j++ if $i && $list[$i] != $list[$i-1]+1;
push @{$res[$j]}, $list[$i];
}

HTH
Lao

[Jay Tilton]

[email]debhatta@hotmail.com[/email] (debraj) wrote:

: I have one array of numbers say (12 17 18 19 120 121 122 123 124 379
: 480 481).
: Now I want to get the starting and ending of any cosecutive numbers
: from this array .
: For eg. result should be (12--12,17--19,120--124,379--379,480--481) .
: Note that if a number without any sequence is present it will be
: printed in the format 12--12 .

my @ary = (12,17,18,19,120,121,122,123,124,379,480,481);
my $seqs = join ',', map "$_--$_", sort {$a <=> $b} @ary;
1 while $seqs =~ s/(\d+),(??{$1+1})--(\d+)/$2/;
print "($seqs)\n";

[Jay Tilton]

[email]tiltonj@erols.com[/email] (Jay Tilton) wrote:

: [email]debhatta@hotmail.com[/email] (debraj) wrote:
:
: : I have one array of numbers say (12 17 18 19 120 121 122 123 124 379
: : 480 481).
: : Now I want to get the starting and ending of any cosecutive numbers
: : from this array .
: : For eg. result should be (12--12,17--19,120--124,379--379,480--481) .
: : Note that if a number without any sequence is present it will be
: : printed in the format 12--12 .
:
: my @ary = (12,17,18,19,120,121,122,123,124,379,480,481);
: my $seqs = join ',', map "$_--$_", sort {$a <=> $b} @ary;
: 1 while $seqs =~ s/(\d+),(??{$1+1})--(\d+)/$2/;
: print "($seqs)\n";

Or, using an actual data structure instead of a string,

my @ary = (12,17,18,19,120,121,122,123,124,379,480,481);
my @seqs = map [$_, $_], sort {$a <=> $b} @ary;
$seqs[$_-1][1] = (splice @seqs, $_, 1)[0]->[1]
for grep $seqs[$_-1][1] == $seqs[$_][0]-1 => reverse 1..$#seqs;
print join ',' => map sprintf('%d--%d', @$_), @seqs;

Kinda fun. I remember seeing variations on this problem solved before on
clpm, but I couldn't hit on the right Google Groups search terms. Any
pointers?

[LaDainian Tomlinson]

On Sat, 06 Sep 2003 03:18:25 -0400, debraj wrote:

> I have one array of numbers say (12 17 18 19 120 121 122 123 124 379 480
> 481).
> Now I want to get the starting and ending of any cosecutive numbers from
> this array .
> For eg. result should be (12--12,17--19,120--124,379--379,480--481) .
> Note that if a number without any sequence is present it will be
> printed in the format 12--12 .

This may not help much, but it works for your case and I learned a lot :-)


_(qw.12 17 18 19 120 121 122 123 124 379 480 481.);
sub _{
print($_ = shift);
while(@_){ ($_[0] == $_ + 1) ? $_ = shift : last; }
print("--$_\n"), (@_ && _(@_));
}

[Philip Lees]

On Sat, 06 Sep 2003 23:05:29 GMT, [email]tiltonj@erols.com[/email] (Jay Tilton)
wrote:

>Kinda fun. I remember seeing variations on this problem solved before on
>clpm, but I couldn't hit on the right Google Groups search terms. Any
>pointers?

Wasn't it one of MJDs quizzes of the week?

Phil

--
Ignore coming events if you wish to send me e-mail

[Tassilo v. Parseval]

Also sprach Philip Lees:

> On Sat, 06 Sep 2003 23:05:29 GMT, [email]tiltonj@erols.com[/email] (Jay Tilton)
> wrote:
>

>>Kinda fun. I remember seeing variations on this problem solved before on
>>clpm, but I couldn't hit on the right Google Groups search terms. Any
>>pointers?

>
> Wasn't it one of MJDs quizzes of the week?

Yes, it was some time ago. The related archive of discussions can
probably be found somewhere at <http://perl.plover.com/qotw/>.

Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus}) !JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexi ixesixeseg;y~\n~~dddd;eval

[Jay Tilton]

"Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de> wrote:

: Also sprach Philip Lees:
:
: > On Sat, 06 Sep 2003 23:05:29 GMT, [email]tiltonj@erols.com[/email] (Jay Tilton)
: > wrote:
: >
: >>Kinda fun. I remember seeing variations on this problem solved before on
: >>clpm, but I couldn't hit on the right Google Groups search terms. Any
: >>pointers?
: >
: > Wasn't it one of MJDs quizzes of the week?
:
: Yes, it was some time ago. The related archive of discussions can
: probably be found somewhere at <http://perl.plover.com/qotw/>.

Found it.
[url]http://article.gmane.org/gmane.comp.lang.perl.qotw.quiz-of-the-week/43[/url]

And naturally there's a module squirrelled away on CPAN that does the
job.

[Anno Siegel]

LaDainian Tomlinson <go@away.spam> wrote in comp.lang.perl.misc:

> On Sat, 06 Sep 2003 03:18:25 -0400, debraj wrote:

> > I have one array of numbers say (12 17 18 19 120 121 122 123 124 379 480
> > 481).
> > Now I want to get the starting and ending of any cosecutive numbers from
> > this array .
> > For eg. result should be (12--12,17--19,120--124,379--379,480--481) .
> > Note that if a number without any sequence is present it will be
> > printed in the format 12--12 .

>
> This may not help much, but it works for your case and I learned a lot :-)
>
>
> _(qw.12 17 18 19 120 121 122 123 124 379 480 481.);
> sub _{
> print($_ = shift);
> while(@_){ ($_[0] == $_ + 1) ? $_ = shift : last; }
> print("--$_\n"), (@_ && _(@_));
> }

Here is a solution based on matching and substitution:

sub trans {
my $str = '';
vec( $str, $_, 8) = ord '1' for @_; # any char except "\0"
$str =~ s/1+/"$-[ 0]-" . ($+[ 0] - 1)/eg;
split /\0+/, $str;
}

For this the original list doesn't have to be sorted.

Anno