# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+use warnings;
use strict;
use Data::Dumper;
# Reads a BED entry given a filehandle.
- my ( $fh, # file handle
- $cols, # columns to read - OPTIONAL (3,4,5,6,8,9 or 12)
- $check, # check integrity of BED values - OPTIONAL
- ) = @_;
-
- # Returns a hash.
-
- my ( $line, %entry );
-
- $line = <$fh>;
-
- $line =~ tr/\n\r//d; # some people have carriage returns in their BED files -> Grrrr
-
- return if not defined $line;
-
- if ( not defined $cols ) {
- $cols = 1 + $line =~ tr/\t//;
- }
-
- if ( $cols == 3 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' }
- ) = split "\t", $line, $cols + 1;
- }
- elsif ( $cols == 4 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' },
- $entry{ 'name' }
- ) = split "\t", $line, $cols + 1;
- }
- elsif ( $cols == 5 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' },
- $entry{ 'name' },
- $entry{ 'score' }
- ) = split "\t", $line, $cols + 1;
- }
- elsif ( $cols == 6 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' },
- $entry{ 'name' },
- $entry{ 'score' },
- $entry{ 'strand' }
- ) = split "\t", $line, $cols + 1;
- }
- elsif ( $cols == 8 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' },
- $entry{ 'name' },
- $entry{ 'score' },
- $entry{ 'strand' },
- $entry{ 'thickStart' },
- $entry{ 'thickEnd' },
- ) = split "\t", $line, $cols + 1;
- }
- elsif ( $cols == 9 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' },
- $entry{ 'name' },
- $entry{ 'score' },
- $entry{ 'strand' },
- $entry{ 'thickStart' },
- $entry{ 'thickEnd' },
- $entry{ 'itemRgb' },
- ) = split "\t", $line, $cols + 1;
- }
- elsif ( $cols == 12 )
- {
- (
- $entry{ 'chrom' },
- $entry{ 'chromStart' },
- $entry{ 'chromEnd' },
- $entry{ 'name' },
- $entry{ 'score' },
- $entry{ 'strand' },
- $entry{ 'thickStart' },
- $entry{ 'thickEnd' },
- $entry{ 'itemRgb' },
- $entry{ 'blockCount' },
- $entry{ 'blockSizes' },
- $entry{ 'blockStarts' }
- ) = split "\t", $line, $cols + 1;
- }
- else
- {
- Maasha::Common::error( qq(Bad BED entry column count: $cols) );
- }
-
- bed_entry_check( \%entry ) if $check;
-
- return wantarray ? %entry : \%entry;
-}
-
-
-sub bed_entry_get_list
-{
- # Martin A. Hansen, September 2008.
-
- # Reads a BED entry given a filehandle.
-
my ( $fh, # file handle
$cols, # columns to read - OPTIONAL (3,4,5,6,8,9 or 12)
$check, # check integrity of BED values - OPTIONAL
$line = <$fh>;
- $line =~ tr/\n\r//d; # some people have carriage returns in their BED files -> Grrrr
-
return if not defined $line;
+ $line =~ tr/\n\r//d; # some people have carriage returns in their BED files -> Grrrr
+
if ( not defined $cols ) {
$cols = 1 + $line =~ tr/\t//;
}
# Writes a BED entry array to file.
- my ( $entry, # hash
+ my ( $entry, # list
$fh, # file handle - OPTIONAL
$cols, # number of columns in BED file - OPTIONAL (3,4,5,6,8,9 or 12)
$check, # check integrity of BED values - OPTIONAL
# Returns nothing.
- $cols = scalar keys %{ $entry } if not $cols;
+ if ( $cols and $cols < scalar @{ $entry } ) {
+ @{ $entry } = @{ $entry }[ 0 .. $cols - 1 ];
+ }
bed_entry_check( $entry ) if $check;
$fh = \*STDOUT if not defined $fh;
- if ( $cols == 3 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- ), "\n";
- }
- elsif ( $cols == 4 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- $entry->{ 'name' },
- ), "\n";
- }
- elsif ( $cols == 5 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- $entry->{ 'name' },
- $entry->{ 'score' },
- ), "\n";
- }
- elsif ( $cols == 6 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- $entry->{ 'name' },
- $entry->{ 'score' },
- $entry->{ 'strand' },
- ), "\n";
- }
- elsif ( $cols == 8 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- $entry->{ 'name' },
- $entry->{ 'score' },
- $entry->{ 'strand' },
- $entry->{ 'thickStart' },
- $entry->{ 'thickEnd' },
- ), "\n";
- }
- elsif ( $cols == 9 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- $entry->{ 'name' },
- $entry->{ 'score' },
- $entry->{ 'strand' },
- $entry->{ 'thickStart' },
- $entry->{ 'thickEnd' },
- $entry->{ 'itemRgb' },
- ), "\n";
- }
- elsif ( $cols == 12 )
- {
- print $fh join( "\t",
- $entry->{ 'chrom' },
- $entry->{ 'chromStart' },
- $entry->{ 'chromEnd' },
- $entry->{ 'name' },
- $entry->{ 'score' },
- $entry->{ 'strand' },
- $entry->{ 'thickStart' },
- $entry->{ 'thickEnd' },
- $entry->{ 'itemRgb' },
- $entry->{ 'blockCount' },
- $entry->{ 'blockSizes' },
- $entry->{ 'blockStarts' },
- ), "\n";
- }
- else
- {
- Maasha::Common::error( qq(Bad BED entry column count: $cols) );
- }
+ print $fh join( "\t", @{ $entry } ), "\n";
}
+
sub bed_entry_check
{
# Martin A. Hansen, November 2008.
# Checks a BED entry for integrity and
# raises an error if there is a problem.
- my ( $bed, # hash ref
+ my ( $bed, # array ref
) = @_;
# Returns nothing.
- my ( $cols, @block_sizes, @block_starts );
+ my ( $entry, $cols, @block_sizes, @block_starts );
- $cols = scalar keys %{ $bed };
+ $entry = join "\t", @{ $bed };
+ $cols = scalar @{ $bed };
if ( $cols < 3 ) {
- Maasha::Common::error( qq(Bad BED entry - must contain at least 3 columns - not $cols) );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - must contain at least 3 columns - not $cols) );
}
if ( $cols > 12 ) {
- Maasha::Common::error( qq(Bad BED entry - must contains no more than 12 columns - not $cols) );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - must contains no more than 12 columns - not $cols) );
}
- if ( $bed->{ 'chrom' } =~ /\s/ ) {
- Maasha::Common::error( qq(Bad BED entry - no white space allowed in chrom field: "$bed->{ 'chrom' }") );
+ if ( $bed->[ chrom ] =~ /\s/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - no white space allowed in chrom field: "$bed->[ chrom ]") );
}
- if ( $bed->{ 'chromStart' } =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - chromStart must be a whole number - not "$bed->{ 'chromStart' }") );
+ if ( $bed->[ chromStart ] =~ /\D/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - chromStart must be a whole number - not "$bed->[ chromStart ]") );
}
- if ( $bed->{ 'chromEnd' } =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - chromEnd must be a whole number - not "$bed->{ 'chromEnd' }") );
+ if ( $bed->[ chromEnd ] =~ /\D/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - chromEnd must be a whole number - not "$bed->[ chromEnd ]") );
}
- if ( $bed->{ 'chromEnd' } < $bed->{ 'chromStart' } ) {
- Maasha::Common::error( qq(Bad BED entry - chromEnd must be greater than chromStart - not "$bed->{ 'chromStart' } > $bed->{ 'chromEnd' }") );
+ if ( $bed->[ chromEnd ] < $bed->[ chromStart ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - chromEnd must be greater than chromStart - not "$bed->[ chromStart ] > $bed->[ chromEnd ]") );
}
return if $cols == 3;
- if ( $bed->{ 'name' } =~ /\s/ ) {
- Maasha::Common::error( qq(Bad BED entry - no white space allowed in name field: "$bed->{ 'name' }") );
+ if ( $bed->[ name ] =~ /\s/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - no white space allowed in name field: "$bed->[ name ]") );
}
return if $cols == 4;
- if ( $bed->{ 'score' } =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - score must be a whole number - not "$bed->{ 'score' }") );
+ if ( $bed->[ score ] =~ /\D/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - score must be a whole number - not "$bed->[ score ]") );
}
- # if ( $bed->{ 'score' } < 0 or $bed->{ 'score' } > 1000 ) { # disabled - too restrictive !
- if ( $bed->{ 'score' } < 0 ) {
- Maasha::Common::error( qq(Bad BED entry - score must be between 0 and 1000 - not "$bed->{ 'score' }") );
+ # if ( $bed->[ score ] < 0 or $bed->[ score ] > 1000 ) { # disabled - too restrictive !
+ if ( $bed->[ score ] < 0 ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - score must be between 0 and 1000 - not "$bed->[ score ]") );
}
return if $cols == 5;
- if ( $bed->{ 'strand' } ne '+' and $bed->{ 'strand' } ne '-' ) {
- Maasha::Common::error( qq(Bad BED entry - strand must be + or - not "$bed->{ 'strand' }") );
+ if ( $bed->[ strand ] ne '+' and $bed->[ strand ] ne '-' ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - strand must be + or - not "$bed->[ strand ]") );
}
return if $cols == 6;
- if ( $bed->{ 'thickStart' } =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - thickStart must be a whole number - not "$bed->{ 'thickStart' }") );
+ if ( $bed->[ thickStart ] =~ /\D/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickStart must be a whole number - not "$bed->[ thickStart ]") );
}
- if ( $bed->{ 'thickEnd' } =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - thickEnd must be a whole number - not "$bed->{ 'thickEnd' }") );
+ if ( $bed->[ thickEnd ] =~ /\D/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickEnd must be a whole number - not "$bed->[ thickEnd ]") );
}
- if ( $bed->{ 'thickEnd' } < $bed->{ 'thickStart' } ) {
- Maasha::Common::error( qq(Bad BED entry - thickEnd must be greater than thickStart - not "$bed->{ 'thickStart' } > $bed->{ 'thickEnd' }") );
+ if ( $bed->[ thickEnd ] < $bed->[ thickStart ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickEnd must be greater than thickStart - not "$bed->[ thickStart ] > $bed->[ thickEnd ]") );
}
- if ( $bed->{ 'thickStart' } < $bed->{ 'chromStart' } ) {
- Maasha::Common::error( qq(Bad BED entry - thickStart must be greater than chromStart - not "$bed->{ 'thickStart' } < $bed->{ 'chromStart' }") );
+ if ( $bed->[ thickStart ] < $bed->[ chromStart ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickStart must be greater than chromStart - not "$bed->[ thickStart ] < $bed->[ chromStart ]") );
}
- if ( $bed->{ 'thickStart' } > $bed->{ 'chromEnd' } ) {
- Maasha::Common::error( qq(Bad BED entry - thickStart must be less than chromEnd - not "$bed->{ 'thickStart' } > $bed->{ 'chromEnd' }") );
+ if ( $bed->[ thickStart ] > $bed->[ chromEnd ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickStart must be less than chromEnd - not "$bed->[ thickStart ] > $bed->[ chromEnd ]") );
}
- if ( $bed->{ 'thickEnd' } < $bed->{ 'chromStart' } ) {
- Maasha::Common::error( qq(Bad BED entry - thickEnd must be greater than chromStart - not "$bed->{ 'thickEnd' } < $bed->{ 'chromStart' }") );
+ if ( $bed->[ thickEnd ] < $bed->[ chromStart ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickEnd must be greater than chromStart - not "$bed->[ thickEnd ] < $bed->[ chromStart ]") );
}
- if ( $bed->{ 'thickEnd' } > $bed->{ 'chromEnd' } ) {
- Maasha::Common::error( qq(Bad BED entry - thickEnd must be less than chromEnd - not "$bed->{ 'thickEnd' } > $bed->{ 'chromEnd' }") );
+ if ( $bed->[ thickEnd ] > $bed->[ chromEnd ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickEnd must be less than chromEnd - not "$bed->[ thickEnd ] > $bed->[ chromEnd ]") );
}
return if $cols == 8;
- if ( $bed->{ 'itemRgb' } !~ /^(0|\d{1,3},\d{1,3},\d{1,3},?)$/ ) {
- Maasha::Common::error( qq(Bad BED entry - itemRgb must be 0 or in the form of 255,0,0 - not "$bed->{ 'itemRgb' }") );
+ if ( $bed->[ itemRgb ] !~ /^(0|\d{1,3},\d{1,3},\d{1,3},?)$/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - itemRgb must be 0 or in the form of 255,0,0 - not "$bed->[ itemRgb ]") );
}
return if $cols == 9;
- if ( $bed->{ 'blockCount' } =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - blockCount must be a whole number - not "$bed->{ 'blockCount' }") );
+ if ( $bed->[ blockCount ] =~ /\D/ ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockCount must be a whole number - not "$bed->[ blockCount ]") );
}
- @block_sizes = split ",", $bed->{ 'blockSizes' };
+ @block_sizes = split ",", $bed->[ blockSizes ];
if ( grep /\D/, @block_sizes ) {
- Maasha::Common::error( qq(Bad BED entry - blockSizes must be whole numbers - not "$bed->{ 'blockSizes' }") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockSizes must be whole numbers - not "$bed->[ blockSizes ]") );
}
- if ( $bed->{ 'blockCount' } != scalar @block_sizes ) {
- Maasha::Common::error( qq(Bad BED entry - blockSizes "$bed->{ 'blockSizes' }" must match blockCount "$bed->{ 'blockCount' }") );
+ if ( $bed->[ blockCount ] != scalar @block_sizes ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockSizes "$bed->[ blockSizes ]" must match blockCount "$bed->[ blockCount ]") );
}
- @block_starts = split ",", $bed->{ 'blockStarts' };
+ @block_starts = split ",", $bed->[ blockStarts ];
if ( grep /\D/, @block_starts ) {
- Maasha::Common::error( qq(Bad BED entry - blockStarts must be whole numbers - not "$bed->{ 'blockStarts' }") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockStarts must be whole numbers - not "$bed->[ blockStarts ]") );
}
- if ( $bed->{ 'blockCount' } != scalar @block_starts ) {
- Maasha::Common::error( qq(Bad BED entry - blockStarts "$bed->{ 'blockStarts' }" must match blockCount "$bed->{ 'blockCount' }") );
+ if ( $bed->[ blockCount ] != scalar @block_starts ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockStarts "$bed->[ blockStarts ]" must match blockCount "$bed->[ blockCount ]") );
}
- if ( $bed->{ 'chromStart' } + $block_starts[ -1 ] + $block_sizes[ -1 ] != $bed->{ 'chromEnd' } ) {
- Maasha::Common::error( qq(Bad BED entry - chromStart + blockStarts[last] + blockSizes[last] must equal chromEnd: ) .
- qq($bed->{ 'chromStart' } + $block_starts[ -1 ] + $block_sizes[ -1 ] != $bed->{ 'chromEnd' }) );
+ if ( $bed->[ chromStart ] + $block_starts[ -1 ] + $block_sizes[ -1 ] != $bed->[ chromEnd ] ) {
+ Maasha::Common::error( qq(Bad BED entry "$entry" - chromStart + blockStarts[last] + blockSizes[last] must equal chromEnd: ) .
+ qq($bed->[ chromStart ] + $block_starts[ -1 ] + $block_sizes[ -1 ] != $bed->[ chromEnd ]) );
}
}
{
# Martin A. Hansen, November 2008.
- # Converts a BED entry given as a hashref
+ # Converts a BED entry given as an arrayref
# to a Biopiece record which is returned as
# a hashref.
# will be the exact position in contrary to the
# UCSC scheme.
- my ( $bed_entry, # BED entry as hashref
+ my ( $bed_entry, # BED entry as arrayref
) = @_;
# Returns a hashref
my ( $cols, %bp_record );
- $cols = scalar keys %{ $bed_entry };
+ $cols = scalar @{ $bed_entry };
- if ( not exists $bed_entry->{ 'chrom' } and
- not exists $bed_entry->{ 'chromStart' } and
- not exists $bed_entry->{ 'chromEnd' } )
+ if ( not defined $bed_entry->[ chrom ] and
+ not defined $bed_entry->[ chromStart ] and
+ not defined $bed_entry->[ chromEnd ] )
{
return 0;
}
- $bp_record{ 'REC_TYPE' } = 'BED';
- $bp_record{ 'BED_COLS' } = $cols;
- $bp_record{ 'CHR' } = $bed_entry->{ 'chrom' };
- $bp_record{ 'CHR_BEG' } = $bed_entry->{ 'chromStart' };
- $bp_record{ 'CHR_END' } = $bed_entry->{ 'chromEnd' } - 1;
- $bp_record{ 'BED_LEN' } = $bed_entry->{ 'chromEnd' } - $bed_entry->{ 'chromStart' };
+ $bp_record{ "REC_TYPE" } = "BED";
+ $bp_record{ "BED_COLS" } = $cols;
+ $bp_record{ "CHR" } = $bed_entry->[ chrom ];
+ $bp_record{ "CHR_BEG" } = $bed_entry->[ chromStart ];
+ $bp_record{ "CHR_END" } = $bed_entry->[ chromEnd ] - 1;
+ $bp_record{ "BED_LEN" } = $bed_entry->[ chromEnd ] - $bed_entry->[ chromStart ];
return wantarray ? %bp_record : \%bp_record if $cols == 3;
- $bp_record{ 'Q_ID' } = $bed_entry->{ 'name' };
+ $bp_record{ "Q_ID" } = $bed_entry->[ name ];
return wantarray ? %bp_record : \%bp_record if $cols == 4;
- $bp_record{ 'SCORE' } = $bed_entry->{ 'score' };
+ $bp_record{ "SCORE" } = $bed_entry->[ score ];
return wantarray ? %bp_record : \%bp_record if $cols == 5;
- $bp_record{ 'STRAND' } = $bed_entry->{ 'strand' };
+ $bp_record{ "STRAND" } = $bed_entry->[ strand ];
return wantarray ? %bp_record : \%bp_record if $cols == 6;
- $bp_record{ 'THICK_BEG' } = $bed_entry->{ 'thickStart' };
- $bp_record{ 'THICK_END' } = $bed_entry->{ 'thickEnd' } - 1;
+ $bp_record{ "THICK_BEG" } = $bed_entry->[ thickStart ];
+ $bp_record{ "THICK_END" } = $bed_entry->[ thickEnd ] - 1;
return wantarray ? %bp_record : \%bp_record if $cols == 8;
- $bp_record{ 'COLOR' } = $bed_entry->{ 'itemRgb' };
+ $bp_record{ "COLOR" } = $bed_entry->[ itemRgb ];
return wantarray ? %bp_record : \%bp_record if $cols == 9;
- $bp_record{ 'BLOCK_COUNT' } = $bed_entry->{ 'blockCount' };
- $bp_record{ 'BLOCK_LENS' } = $bed_entry->{ 'blockSizes' };
- $bp_record{ 'Q_BEGS' } = $bed_entry->{ 'blockStarts' };
+ $bp_record{ "BLOCK_COUNT" } = $bed_entry->[ blockCount ];
+ $bp_record{ "BLOCK_LENS" } = $bed_entry->[ blockSizes ];
+ $bp_record{ "Q_BEGS" } = $bed_entry->[ blockStarts ];
return wantarray ? %bp_record : \%bp_record;
}
# record is converted and undef is returned if
# convertion failed.
- # IMPORTANT! The BED_END and THICK_END positions
+ # IMPORTANT! The chromEnd and thickEnd positions
# will be the inexact position used in the
- # UCSC scheme.
+ # UCSC scheme (+1 to all ends).
my ( $bp_record, # hashref
$cols, # number of columns in BED entry - OPTIONAL (but faster)
# Returns arrayref.
- my ( %bed_entry );
+ my ( @bed_entry, @begs );
$cols ||= 12; # max number of columns possible
- $bed_entry{ 'chrom' } = $bp_record->{ 'CHR' } ||
- $bp_record->{ 'S_ID' } ||
- return undef;
+ $bed_entry[ chrom ] = $bp_record->{ "CHR" } ||
+ $bp_record->{ "S_ID" } ||
+ return undef;
- if ( exists $bp_record->{ 'CHR_BEG' } ) {
- $bed_entry{ 'chromStart' } = $bp_record->{ 'CHR_BEG' };
- } elsif ( exists $bp_record->{ 'S_BEG' } ) {
- $bed_entry{ 'chromStart' } = $bp_record->{ 'S_BEG' };
+ if ( defined $bp_record->{ "CHR_BEG" } ) {
+ $bed_entry[ chromStart ] = $bp_record->{ "CHR_BEG" };
+ } elsif ( defined $bp_record->{ "S_BEG" } ) {
+ $bed_entry[ chromStart ] = $bp_record->{ "S_BEG" };
} else {
return undef;
}
- if ( exists $bp_record->{ 'CHR_END' } ) {
- $bed_entry{ 'chromEnd' } = $bp_record->{ 'CHR_END' };
- } elsif ( exists $bp_record->{ 'S_END' }) {
- $bed_entry{ 'chromEnd' } = $bp_record->{ 'S_END' };
+ if ( defined $bp_record->{ "CHR_END" } ) {
+ $bed_entry[ chromEnd ] = $bp_record->{ "CHR_END" } + 1;
+ } elsif ( defined $bp_record->{ "S_END" }) {
+ $bed_entry[ chromEnd ] = $bp_record->{ "S_END" } + 1;
} else {
return undef;
}
- $bed_entry{ 'chromEnd' }++;
-
- return wantarray ? %bed_entry : \%bed_entry if $cols == 3;
+ return wantarray ? @bed_entry : \@bed_entry if $cols == 3;
- $bed_entry{ 'name' } = $bp_record->{ 'Q_ID' } || return wantarray ? %bed_entry : \%bed_entry;
+ $bed_entry[ name ] = $bp_record->{ "Q_ID" } || return wantarray ? @bed_entry : \@bed_entry;
- return wantarray ? %bed_entry : \%bed_entry if $cols == 4;
+ return wantarray ? @bed_entry : \@bed_entry if $cols == 4;
- if ( exists $bp_record->{ 'SCORE' } ) {
- $bed_entry{ 'score' } = $bp_record->{ 'SCORE' };
+ if ( exists $bp_record->{ "SCORE" } ) {
+ $bed_entry[ score ] = $bp_record->{ "SCORE" };
+ } elsif ( exists $bp_record->{ "BIT_SCORE" } ) {
+ $bed_entry[ score ] = $bp_record->{ "BIT_SCORE" };
} else {
- return wantarray ? %bed_entry : \%bed_entry;
+ return wantarray ? @bed_entry : \@bed_entry;
}
- return wantarray ? %bed_entry : \%bed_entry if $cols == 5;
+ return wantarray ? @bed_entry : \@bed_entry if $cols == 5;
- if ( exists $bp_record->{ 'STRAND' } ) {
- $bed_entry{ 'strand' } = $bp_record->{ 'STRAND' };
+ if ( exists $bp_record->{ "STRAND" } ) {
+ $bed_entry[ strand ] = $bp_record->{ "STRAND" };
} else {
- return wantarray ? %bed_entry : \%bed_entry;
+ return wantarray ? @bed_entry : \@bed_entry;
}
- return wantarray ? %bed_entry : \%bed_entry if $cols == 6;
+ return wantarray ? @bed_entry : \@bed_entry if $cols == 6;
- if ( defined $bp_record->{ 'THICK_BEG' } and
- defined $bp_record->{ 'THICK_END' } )
+ if ( defined $bp_record->{ "THICK_BEG" } and
+ defined $bp_record->{ "THICK_END" } )
{
- $bed_entry{ 'thickStart' } = $bp_record->{ 'THICK_BEG' };
- $bed_entry{ 'thickEnd' } = $bp_record->{ 'THICK_END' };
+ $bed_entry[ thickStart ] = $bp_record->{ "THICK_BEG" };
+ $bed_entry[ thickEnd ] = $bp_record->{ "THICK_END" } + 1;
+ }
+ elsif ( defined $bp_record->{ "BLOCK_COUNT" } )
+ {
+ $bed_entry[ thickStart ] = $bed_entry[ chromStart ];
+ $bed_entry[ thickEnd ] = $bed_entry[ chromEnd ];
}
- return wantarray ? %bed_entry : \%bed_entry if $cols == 8;
+ return wantarray ? @bed_entry : \@bed_entry if $cols == 8;
- if ( exists $bp_record->{ 'COLOR' } ) {
- $bed_entry{ 'itemRgb' } = $bp_record->{ 'COLOR' };
- } else {
- return wantarray ? %bed_entry : \%bed_entry;
+ if ( defined $bp_record->{ "COLOR" } )
+ {
+ $bed_entry[ itemRgb ] = $bp_record->{ "COLOR" };
+ }
+ elsif ( defined $bp_record->{ "BLOCK_COUNT" } )
+ {
+ $bed_entry[ itemRgb ] = 0;
}
- return wantarray ? %bed_entry : \%bed_entry if $cols == 9;
+ return wantarray ? @bed_entry : \@bed_entry if $cols == 9;
- if ( defined $bp_record->{ 'BLOCK_COUNT' } and
- defined $bp_record->{ 'BLOCK_LENS' } and
- defined $bp_record->{ 'Q_BEGS' } )
+ if ( defined $bp_record->{ "BLOCK_COUNT" } and
+ defined $bp_record->{ "BLOCK_LENS" } and
+ defined $bp_record->{ "S_BEGS" } )
{
- $bed_entry{ 'blockCount' } = $bp_record->{ 'BLOCK_COUNT' };
- $bed_entry{ 'blockSizes' } = $bp_record->{ 'BLOCK_LENS' };
- $bed_entry{ 'blockStarts' } = $bp_record->{ 'Q_BEGS' };
- $bed_entry{ 'thickEnd' }++;
+ @begs = split ",", $bp_record->{ "S_BEGS" };
+ map { $_ -= $bed_entry[ chromStart ] } @begs;
+
+ $bed_entry[ blockCount ] = $bp_record->{ "BLOCK_COUNT" };
+ $bed_entry[ blockSizes ] = $bp_record->{ "BLOCK_LENS" };
+ $bed_entry[ blockStarts ] = join ",", @begs;
+ # $bed_entry[ thickEnd ] = $bp_record->{ "THICK_END" } + 1;
+ }
+ elsif ( defined $bp_record->{ "BLOCK_COUNT" } and
+ defined $bp_record->{ "BLOCK_LENS" } and
+ defined $bp_record->{ "Q_BEGS" } )
+ {
+ $bed_entry[ blockCount ] = $bp_record->{ "BLOCK_COUNT" };
+ $bed_entry[ blockSizes ] = $bp_record->{ "BLOCK_LENS" };
+ $bed_entry[ blockStarts ] = $bp_record->{ "Q_BEGS" };
+ # $bed_entry[ thickEnd ] = $bp_record->{ "THICK_END" } + 1;
}
- return wantarray ? %bed_entry : \%bed_entry;
+ return wantarray ? @bed_entry : \@bed_entry;
}
}
+sub bed_upload_to_ucsc
+{
+ # Martin A. Hansen, September 2007.
+
+ # Upload a BED file to the UCSC database.
+
+ my ( $tmp_dir, # temporary directory
+ $file, # file to upload,
+ $options, # argument hashref
+ $append, # flag indicating table should be appended
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $args, $table, $sql_file, $fh_out, $fh_in );
+
+ if ( $append ) {
+ $args = join " ", $options->{ "database" }, $options->{ "table" }, "-tmpDir=$tmp_dir", "-oldTable", $file;
+ } else {
+ $args = join " ", $options->{ "database" }, $options->{ "table" }, "-tmpDir=$tmp_dir", $file;
+ }
+
+ if ( $options->{ "table" } =~ /rnaSecStr/ )
+ {
+ $table = $options->{ "table" };
+
+ print qq(uploading secondary structure table:"$table"\n) if $options->{ "verbose" };
+
+ $sql_file = "$tmp_dir/upload_RNA_SS.sql";
+
+ $fh_out = Maasha::Filesys::file_write_open( $sql_file );
+
+ print $fh_out qq(
+CREATE TABLE $table (
+ bin smallint not null, # Bin number for browser speedup
+ chrom varchar(255) not null, # Chromosome or FPC contig
+ chromStart int unsigned not null, # Start position in chromosome
+ chromEnd int unsigned not null, # End position in chromosome
+ name varchar(255) not null, # Name of item
+ score int unsigned not null, # Score from 0-1000
+ strand char(1) not null, # + or -
+ size int unsigned not null, # Size of element.
+ secStr longblob not null, # Parentheses and '.'s which define the secondary structure
+ conf longblob not null, # Confidence of secondary-structure annotation per position (0.0-1.0).
+ #Indices
+ INDEX(name(16)),
+ INDEX(chrom(8), bin),
+ INDEX(chrom(8), chromStart)
+);
+ );
+
+ close $fh_out;
+
+ Maasha::Common::run( "hgLoadBed", "-notItemRgb -sqlTable=$sql_file $options->{ 'database' } $options->{ 'table' } -tmpDir=$tmp_dir $file > /dev/null 2>&1" );
+
+ unlink $sql_file;
+ }
+ else
+ {
+ Maasha::Common::run( "hgLoadBed", "$args > /dev/null 2>&1" );
+ }
+}
+
+
+sub bed_analyze
+{
+ # Martin A. Hansen, March 2008.
+
+ # Given a bed record, analysis this to give information
+ # about intron/exon sizes.
+
+ my ( $entry, # BED entry
+ ) = @_;
+
+ # Returns hashref.
+
+ my ( $i, @begs, @lens, $exon_max, $exon_min, $exon_len, $exon_tot, $intron_max, $intron_min, $intron_len, $intron_tot );
+
+ $exon_max = 0;
+ $exon_min = 9999999999;
+ $intron_max = 0;
+ $intron_min = 9999999999;
+
+ $entry->{ "EXONS" } = $entry->{ "BLOCK_COUNT" };
+
+ @begs = split /,/, $entry->{ "Q_BEGS" };
+ @lens = split /,/, $entry->{ "BLOCK_LENS" };
+
+ for ( $i = 0; $i < $entry->{ "BLOCK_COUNT" }; $i++ )
+ {
+ $exon_len = $lens[ $i ];
+
+ $entry->{ "EXON_LEN_$i" } = $exon_len;
+
+ $exon_max = $exon_len if $exon_len > $exon_max;
+ $exon_min = $exon_len if $exon_len < $exon_min;
+
+ $exon_tot += $exon_len;
+ }
+
+ $entry->{ "EXON_LEN_-1" } = $exon_len;
+ $entry->{ "EXON_MAX_LEN" } = $exon_max;
+ $entry->{ "EXON_MIN_LEN" } = $exon_min;
+ $entry->{ "EXON_MEAN_LEN" } = int( $exon_tot / $entry->{ "EXONS" } );
+
+ $entry->{ "INTRONS" } = $entry->{ "BLOCK_COUNT" } - 1;
+ $entry->{ "INTRONS" } = 0 if $entry->{ "INTRONS" } < 0;
+
+ if ( $entry->{ "INTRONS" } )
+ {
+ for ( $i = 1; $i < $entry->{ "BLOCK_COUNT" }; $i++ )
+ {
+ $intron_len = $begs[ $i ] - ( $begs[ $i - 1 ] + $lens[ $i - 1 ] );
+
+ $entry->{ "INTRON_LEN_" . ( $i - 1 ) } = $intron_len;
+
+ $intron_max = $intron_len if $intron_len > $intron_max;
+ $intron_min = $intron_len if $intron_len < $intron_min;
+
+ $intron_tot += $intron_len;
+ }
+
+ $entry->{ "INTRON_LEN_-1" } = $intron_len;
+ $entry->{ "INTRON_MAX_LEN" } = $intron_max;
+ $entry->{ "INTRON_MIN_LEN" } = $intron_min;
+ $entry->{ "INTRON_MEAN_LEN" } = int( $intron_tot / $entry->{ "INTRONS" } );
+ }
+
+ return wantarray ? %{ $entry } : $entry;
+}
+
+
+sub bed_merge_entries
+{
+ # Martin A. Hansen, February 2008.
+
+ # Merge a list of given BED entries in one big entry.
+
+ my ( $entries, # list of BED entries to be merged
+ ) = @_;
+
+ # Returns hash.
+
+ my ( $i, @q_ids, @q_begs, @blocksizes, @new_q_begs, @new_blocksizes, %new_entry );
+
+ @{ $entries } = sort { $a->{ "CHR_BEG" } <=> $b->{ "CHR_BEG" } } @{ $entries };
+
+ for ( $i = 0; $i < @{ $entries }; $i++ )
+ {
+ Maasha::Common::error( qq(Attempted merge of BED entries from different chromosomes) ) if $entries->[ 0 ]->{ "CHR" } ne $entries->[ $i ]->{ "CHR" };
+ Maasha::Common::error( qq(Attempted merge of BED entries from different strands) ) if $entries->[ 0 ]->{ "STRAND" } ne $entries->[ $i ]->{ "STRAND" };
+
+ push @q_ids, $entries->[ $i ]->{ "Q_ID" } || sprintf( "ID%06d", $i );
+
+ if ( exists $entries->[ $i ]->{ "Q_BEGS" } )
+ {
+ @q_begs = split ",", $entries->[ $i ]->{ "Q_BEGS" };
+ @blocksizes = split ",", $entries->[ $i ]->{ "BLOCK_LENS" };
+ }
+ else
+ {
+ @q_begs = 0;
+ @blocksizes = $entries->[ $i ]->{ "CHR_END" } - $entries->[ $i ]->{ "CHR_BEG" } + 1;
+ }
+
+ map { $_ += $entries->[ $i ]->{ "CHR_BEG" } } @q_begs;
+
+ push @new_q_begs, @q_begs;
+ push @new_blocksizes, @blocksizes;
+ }
+
+ map { $_ -= $entries->[ 0 ]->{ "CHR_BEG" } } @new_q_begs;
+
+ %new_entry = (
+ CHR => $entries->[ 0 ]->{ "CHR" },
+ CHR_BEG => $entries->[ 0 ]->{ "CHR_BEG" },
+ CHR_END => $entries->[ -1 ]->{ "CHR_END" },
+ REC_TYPE => "BED",
+ BED_LEN => $entries->[ -1 ]->{ "CHR_END" } - $entries->[ 0 ]->{ "CHR_BEG" } + 1,
+ BED_COLS => 12,
+ Q_ID => join( ":", @q_ids ),
+ SCORE => 999,
+ STRAND => $entries->[ 0 ]->{ "STRAND" } || "+",
+ THICK_BEG => $entries->[ 0 ]->{ "THICK_BEG" } || $entries->[ 0 ]->{ "CHR_BEG" },
+ THICK_END => $entries->[ -1 ]->{ "THICK_END" } || $entries->[ -1 ]->{ "CHR_END" },
+ COLOR => 0,
+ BLOCK_COUNT => scalar @new_q_begs,
+ BLOCK_LENS => join( ",", @new_blocksizes ),
+ Q_BEGS => join( ",", @new_q_begs ),
+ );
+
+ return wantarray ? %new_entry : \%new_entry;
+}
+
+
+sub bed_split_entry
+{
+ # Martin A. Hansen, February 2008.
+
+ # Splits a given BED entry into a list of blocks,
+ # which are returned. A list of 6 column BED entry is returned.
+
+ my ( $entry, # BED entry hashref
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @q_begs, @blocksizes, $block, @blocks, $i );
+
+ if ( exists $entry->{ "BLOCK_COUNT" } )
+ {
+ @q_begs = split ",", $entry->{ "Q_BEGS" };
+ @blocksizes = split ",", $entry->{ "BLOCK_LENS" };
+
+ for ( $i = 0; $i < @q_begs; $i++ )
+ {
+ undef $block;
+
+ $block->{ "CHR" } = $entry->{ "CHR" };
+ $block->{ "CHR_BEG" } = $entry->{ "CHR_BEG" } + $q_begs[ $i ];
+ $block->{ "CHR_END" } = $entry->{ "CHR_BEG" } + $q_begs[ $i ] + $blocksizes[ $i ] - 1;
+ $block->{ "Q_ID" } = $entry->{ "Q_ID" } . sprintf( "_%03d", $i );
+ $block->{ "SCORE" } = $entry->{ "SCORE" };
+ $block->{ "STRAND" } = $entry->{ "STRAND" };
+ $block->{ "BED_LEN" } = $block->{ "CHR_END" } - $block->{ "CHR_BEG" } + 1,
+ $block->{ "BED_COLS" } = 6;
+ $block->{ "REC_TYPE" } = "BED";
+
+ push @blocks, $block;
+ }
+ }
+ else
+ {
+ @blocks = @{ $entry };
+ }
+
+ return wantarray ? @blocks : \@blocks;
+}
+
+
+sub bed_overlap
+{
+ # Martin A. Hansen, February 2008.
+
+ # Checks if two BED entries overlap and
+ # return 1 if so - else 0;
+
+ my ( $entry1, # hashref
+ $entry2, # hashref
+ $no_strand, # don't check strand flag - OPTIONAL
+ ) = @_;
+
+ # Return bolean.
+
+ return 0 if $entry1->{ "CHR" } ne $entry2->{ "CHR" };
+ return 0 if $entry1->{ "STRAND" } ne $entry2->{ "STRAND" };
+
+ if ( $entry1->{ "CHR_END" } < $entry2->{ "CHR_BEG" } or $entry1->{ "CHR_BEG" } > $entry2->{ "CHR_END" } ) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+
+
+
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
projects / biopieces.git / blobdiff