Is a merge interval function available?

S

sln

I'm wondering there is already a function in perl library that can
merge intervals. For example, if I have the following intervals ('['
and ']' means closed interval as in
http://en.wikipedia.org/wiki/Interval_(mathematics)#Excluding_the_endpoints)

[1, 3]
[2, 9]
[10,13]
[11,12]

I want to get the following merged intervals.

[1,9]
[10,13]

Could somebody let me know if there is a function in the perl library?

Here's another way.

-sln

---------------
use strict;
use warnings;

my @sets = (
[20, 40],
[1, 3],
[2, 9],
[10,13],
[11,13],
[1, 2],
[11,12],
[1, 5],
);

my @merged_sets = interval(\@sets);

print "\nOriginal sets:\n";
for my $st (@sets) {
if (@{$st}) {
printf " %2s, %2s\n", @{$st};
}
}
print "\nMerged sets:\n";
for my $st (@merged_sets) {
if (@{$st}) {
printf " %2s, %2s\n", @{$st};
}
}
exit (0);

##
sub interval
{
my ($sref,$start) = @_;
return if (ref($sref) ne 'ARRAY');

if (!defined $start) {
if (wantarray) {
my @tmpsets = map {[@{$_}]} @{$sref};
$sref = \@tmpsets;
}
@{$sref} = sort {$a->[0]<=>$b->[0] || $a->[1]<=>$b->[1]} @{$sref};
$start = 0;
}
my $last = $sref->[$start];
++$start;

if (@{$last}) {
for my $ndx ($start .. @{$sref}-1)
{
my $cur = $sref->[$ndx];
next if (!@{$cur});

if ($cur->[0] >= $last->[0] && $cur->[0] <= $last->[1] )
{
$last->[1] = $cur->[1] if ($cur->[1] > $last->[1]);
@{$cur} = ();
}
else {
last;
}
}
}
interval($sref, $start) if ( $start < @{$sref});
if (wantarray) {
return sort {$a->[0] <=> $b->[0]} map {@{$_} ? $_ : () } @{$sref};
}
}

__END__

Output -

Original sets:
20, 40
1, 3
2, 9
10, 13
11, 13
1, 2
11, 12
1, 5

Merged sets:
1, 9
10, 13
20, 40
 
S

sln

I'm wondering there is already a function in perl library that can
merge intervals. For example, if I have the following intervals ('['
and ']' means closed interval as in
http://en.wikipedia.org/wiki/Interval_(mathematics)#Excluding_the_endpoints)

[1, 3]
[2, 9]
[10,13]
[11,12]

I want to get the following merged intervals.

[1,9]
[10,13]

Could somebody let me know if there is a function in the perl library?

Should be non-recursive, my bad.

-sln

-------------
use strict;
use warnings;

my @sets = (
[20, 40],
[1, 3],
[2, 9],
[10,13],
[11,13],
[1, 2],
[11,12],
[1, 5],
[7, 15],
);

my @merged_sets = mrgInterval(\@sets);

print "\nOriginal sets:\n";
for my $st (@sets) {
if (@{$st}) {
printf " %2s, %2s\n", @{$st};
}
}
print "\nMerged sets:\n";
for my $st (@merged_sets) {
printf " %2s, %2s\n", @{$st};
}
exit (0);

##
sub mrgInterval
{
my ($sref,$start) = @_;
return if (ref($sref) ne 'ARRAY');

if (!defined $start) {
if (wantarray) {
my @tmpsets = map {[@{$_}]} @{$sref};
$sref = \@tmpsets;
}
@{$sref} = sort {$a->[0]<=>$b->[0] || $a->[1]<=>$b->[1]} @{$sref};
$start = 0;
}

while ($start < @{$sref})
{
my $last = $sref->[$start];
++$start;

if (@{$last}) {
for my $ndx ($start .. @{$sref}-1)
{
my $cur = $sref->[$ndx];
next if (!@{$cur});

if ($cur->[0] >= $last->[0] && $cur->[0] <= $last->[1] )
{
if ($cur->[1] > $last->[1]) {
$last->[1] = $cur->[1];
}
@{$cur} = ();
}
else {
last;
}
}
}
}
if (wantarray) {
return sort {$a->[0] <=> $b->[0]} map {@{$_} ? $_ : () } @{$sref};
}
}

__END__

Original sets:
20, 40
1, 3
2, 9
10, 13
11, 13
1, 2
11, 12
1, 5
7, 15

Merged sets:
1, 15
20, 40
 
J

Josef

Peng said:
I'm wondering there is already a function in perl library that can
merge intervals.

Maybe CPAN is with you: Set::Infinite, Set::IntSpan

br,
Josef
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,769
Messages
2,569,580
Members
45,055
Latest member
SlimSparkKetoACVReview

Latest Threads

Top