Interesting problem. One key is to use grep to filter a range to generate entries just for the ids that have been given. Because you don't know what ids you will end up with until all the data has been parsed, you need to generate the table data as a second step. Consider:

use warnings;
use strict;

my %data;
my %ids;

while (<DATA>) {
    chomp;
    my ($rid, $start, $end) = split;
    
    push @{$data{$rid}}, [$start, $end];
    @ids{$start, $end} = ();
}

my @idList = sort {$a <=> $b} keys %ids;

for my $rid (keys %data) {
    my @pairs = @{$data{$rid}};
    my %fields;
    
    $data{$rid} = [];
    @fields{grep exists $ids{$_}, $_->[0] .. $_->[1]} = () for @pairs;
    @{$data{$rid}} = map {exists $fields{$_}} @idList;
}

my $format = '%-3s' . ('%3d ' x keys %ids) . "\n";

printf $format, 'ID', sort {$a <=> $b} keys %ids;
printf $format, $_, @{$data{$_}} for sort keys %data;

__DATA__
A 1  2  
A 7  10
A 15 20
B 3  5  
B 11 15  
C 5  10  
D 10 20
[download]

Prints:

ID   1   2   3   5   7  10  11  15  20 
A    1   1   0   0   1   1   0   1   1 
B    0   0   1   1   0   0   1   1   0 
C    0   0   0   1   1   1   0   0   0 
D    0   0   0   0   0   1   1   1   1
[download]

$ perl -e'
$x = q[A 1  2  
A 7  10 
A 15 20 
B 3  5  
B 11 15  
C 5  10  
D 10 20  
];

open my $fh, q[<], \$x or die "Cannot open \$x: $!";

my ( $mask, %data, $max );
while ( <$fh> ) {
    my ( $key, @vals ) = split;
    for my $val ( @vals ) {
        vec( $mask, $val, 1 ) = vec( $data{ $key }, $val, 1 ) = 1;
        $max = $val if $max < $val;
        }
    }

my @vals;
for my $val ( 0 .. $max ) {
    push @vals, $val if vec $mask, $val, 1;
    }

my $width = length $vals[ -1 ];
printf q[ID] . ( " %${width}d" x @vals ) . "\n", @vals;

for my $key ( sort keys %data ) {
    printf q[%-2s], $key;
    for my $val ( @vals ) {
        printf q[ %*d], $width, vec $data{ $key }, $val, 1;
        }
    print "\n";
    }
'
ID  1  2  3  5  7 10 11 15 20
A   1  1  0  0  1  1  0  1  1
B   0  0  1  1  0  0  1  1  0
C   0  0  0  1  0  1  0  0  0
D   0  0  0  0  0  1  0  0  1
[download]

Hi,

You can use a HoH

my $result = {
    'A' => {
        1 => 1,
        2 => 1,
        7 => 1,
       10 => 1,
       ...
    },    
    'B' => {
       ...
    },
    ...    
};
[download]

Using something like this for generating it:

open my $fh, '<', $filename;

while (<$fh>) {
    chomp;
    my ($id, @numbers) = split;
    for my $number (@numbers) {
        $result->{$id}{$number} = 1;
    }
}
[download]

Update:

Later if you want to output it, you could do something like this:

my %unique_numbers = ();
for (values %$result) {
    for my $number (keys %$_) {
       $unique_numbers{$number} = 1;
    }
}
my @numbers = sort {$a <=> $b} keys %unique_numbers;

open my $out_fh, '>', $output_filename;

print $out_fh "IDs @numbers\n";

for my $id (sort keys %$result) {
   my @fields = $id; 
   for my $number (@numbers) {
        if (exists $result->{$id}{$number}) {
           push @fields, 1;
        }
        else {
           push @fields, 0;
        }
   }
   my $string = join " ", @fields;
   print $out_fh "$string\n";
}
[download]

I know, it's not so nice, but... if it's a throw away problem...

For the thing of having a fancy output, you can use format or take a look on CPAN, I remember to see some modules for producing a tabular ASCII output

Update 2:

Yes GrandFather, you're right, I just saw the "interval" thing :-)

Regards,

Consider what is generated for the OP's data line 'D 10 20' and contrast with OP's desired result. The task is not quite so simple. ;)

---

DWIM is Perl's answer to Gödel

#!/usr/bin/perl
use warnings;
use strict;

package main;

my %ranges = ();

while (<DATA>) {
    my ( $key, $initial_value, $final_value ) = split /\s+/, $_;
    push @{$ranges{$key}}, [ $initial_value, $final_value ];
}

my @headers = (1, 2, 3, 5, 7, 10, 11, 15, 20);

my @keys = ( 'A', 'B', 'C', 'D' );

my $value = sprintf "ID %2d %2d %2d %2d %2d %2d %2d %2d %2d\n", @heade
+rs;
print $value;

foreach my $k (@keys) {
    my @results = map { &in_range($k, $_) } @headers;
    $value = sprintf "%-2s %2d %2d %2d %2d %2d %2d %2d %2d %2d\n", $k,
+ @results;
    print $value;
}

sub in_range {
    my $letter = shift;
    my $test_value = shift;
    if ( defined( $ranges{$letter} )) {
        foreach my $ref ( @{$ranges{$letter}} ) {
            if (($ref->[0] <= $test_value) && 
                ($ref->[1] >= $test_value)) {
                return 1;
            }
        }
    }
    return 0;
}

__DATA__
A 1  2
A 7  10
A 15 20
B 3  5
B 11 15
C 5  10
D 10 20
[download]

~/perl/monks$ ./ranges.pl
ID  1  2  3  5  7 10 11 15 20
A   1  1  0  0  1  1  0  1  1
B   0  0  1  1  0  0  1  1  0
C   0  0  0  1  1  1  0  0  0
D   0  0  0  0  0  1  1  1  1
[download]

Thanks for you all Guys,

This was of great help.
Mozart