in reply to find which ranges share at least one common value

#! perl -slw
use strict;

my @ranges = map{
   my $a = rand( 900 );
   [ $a, $a + rand( 1000 - $a ) ]
} 1 .. 7;

print "$_ : [ @{ $ranges[ $_ ]} ]" for 0 .. 6;

my @overlaps;
for my $i1 ( 0 .. 6 ) {
    for my $i2 ( $i1+1 .. 6 ) {
        unless( $ranges[ $i1 ][ 0 ] > $ranges[ $i2 ][ 1 ]
             or $ranges[ $i1 ][ 1 ] < $ranges[ $i2 ][ 0 ]
        ) {
            push @{ $overlaps[ $i1 ] }, $i2;
        }
    }
}

defined $overlaps[ $_ ] 
    and print "$_ overlaps with @{ $overlaps[ $_ ] }" 
    for 0 .. 6;

__END__
c:\test>junk39
0 : [ 752.67333984375 781.958845257759 ]
1 : [ 45.5657958984375 108.800557162613 ]
2 : [ 574.887084960938 742.659308388829 ]
3 : [ 190.887451171875 585.887861438096 ]
4 : [ 20.7916259765625 200.777344871312 ]
5 : [ 306.353759765625 756.753877364099 ]
6 : [ 721.856689453125 821.619211696088 ]
0 overlaps with 5 6
1 overlaps with 4
2 overlaps with 3 5 6
3 overlaps with 4 5
5 overlaps with 6

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Replies are listed 'Best First'.
Re^2: find which ranges share at least one common value
by Anonymous Monk on Feb 08, 2011 at 13:08 UTC
    Thank you very much for this - your help is appreciated
[reply]
Re^2: find which ranges share at least one common value
by Anonymous Monk on Feb 08, 2011 at 14:37 UTC
    Hi

    I have been trying to get to grips with this and am hoping to replace the random generation of the ranges (which I presume is this bit: 

    my @ranges = map{
   my $a = rand( 900 );
   [ $a, $a + rand( 1000 - $a ) ]
} 1 .. 7;

    [download]
    with a way of reading in some values from a command's output, specifically, the first sector and last sector values from a disk partition table (which I can read in from a temporary file if needbe): 

    *                          First     Sector    Last
* Partition  Tag  Flags    Sector     Count    Sector  Mount Directory
       0      2    00    8392560  33558000  41950559
       1      3    01          0   8392560   8392559
       2      5    00          0  78156480  78156479
       3      0    00   41950560   6295440  48245999
       4      4    00   48246000   8392560  56638559
       5      0    00   56638560   8392560  65031119
       6      7    00   65031120   8392560  73423679
       7      0    00   73423680    106080  73529759

    [download]
    I am finding this to be pretty tough as I am a novice. Any help or suggestions appreciated.
[reply]
[d/l]
[select]

      Your getting this cos I'm bored waiting for a long running process to complete. In future, show some effort. 

      #! perl -slw
use strict;

<> for 1 .. 2; ## discard headers

## Read ranges stdin
my @ranges = map {
    [ (split)[3,5] ]
} <>;

print "$_ : [ @{ $ranges[ $_ ]} ]" for 0 .. $#ranges;

my @overlaps;
for my $i1 ( 0 .. $#ranges ) {
    for my $i2 ( $i1+1 .. $#ranges ) {
        unless( $ranges[ $i1 ][ 0 ] > $ranges[ $i2 ][ 1 ]
             or $ranges[ $i1 ][ 1 ] < $ranges[ $i2 ][ 0 ]
        ) {
            push @{ $overlaps[ $i1 ] }, $i2;
        }
    }
}

defined $overlaps[ $_ ]
    and print "$_ overlaps with @{ $overlaps[ $_ ] }"
    for 0 .. $#overlaps;

      [download]

      Use as parttable | script.pl. You should see output something like:

      0 : [ 8392560 41950559 ]
1 : [ 0 8392559 ]
2 : [ 0 78156479 ]
3 : [ 41950560 48245999 ]
4 : [ 48246000 56638559 ]
5 : [ 56638560 65031119 ]
6 : [ 65031120 73423679 ]
7 : [ 73423680 73529759 ]
0 overlaps with 2
1 overlaps with 2
2 overlaps with 3 4 5 6 7

      [download]
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
        Thanks a lot. I shall take some time to understand how this works.
[reply]

In Section Seekers of Perl Wisdom