# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+use warnings;
use strict;
use Data::Dumper;
};
-my $CHECK_ALL = 1; # Global flag indicating that BED input and output is checked thoroughly.
-
-
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> BED format <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
# Reads a BED entry given a filehandle.
my ( $fh, # file handle
- $cols, # columns to read - OPTIONAL (3,4,5,6,8,9 or 12)
+ $cols, # columns to read - OPTIONAL (3,4,5,6,8,9 or 12)
+ $check, # check integrity of BED values - OPTIONAL
) = @_;
# Returns a list.
$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//;
}
pop @entry if scalar @entry > $cols;
- bed_entry_check( \@entry ) if $CHECK_ALL;
+ bed_entry_check( \@entry ) if $check;
return wantarray ? @entry : \@entry;
}
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.
@{ $entry } = @{ $entry }[ 0 .. $cols - 1 ];
}
- bed_entry_check( $entry ) if $CHECK_ALL;
+ bed_entry_check( $entry ) if $check;
$fh = \*STDOUT if not defined $fh;
# Returns nothing.
- my ( $cols, @block_sizes, @block_starts );
+ my ( $entry, $cols, @block_sizes, @block_starts );
- $cols = scalar @{ $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 ]") );
+ 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 ]") );
+ 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 ]") );
+ 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 ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - chromEnd must be greater than chromStart - not "$bed->[ chromStart ] > $bed->[ chromEnd ]") );
}
- return if @{ $bed } == 3;
+ return if $cols == 3;
if ( $bed->[ name ] =~ /\s/ ) {
- Maasha::Common::error( qq(Bad BED entry - no white space allowed in name field: "$bed->[ name ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - no white space allowed in name field: "$bed->[ name ]") );
}
- return if @{ $bed } == 4;
+ return if $cols == 4;
if ( $bed->[ score ] =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - score must be a whole number - not "$bed->[ score ]") );
+ 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 ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - score must be between 0 and 1000 - not "$bed->[ score ]") );
}
- return if @{ $bed } == 5;
+ 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 ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - strand must be + or - not "$bed->[ strand ]") );
}
- return if @{ $bed } == 6;
+ return if $cols == 6;
if ( $bed->[ thickStart ] =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - thickStart must be a whole number - not "$bed->[ thickStart ]") );
+ 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 ]") );
+ 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 ]") );
+ 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 ]") );
+ 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 ]") );
+ 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 ]") );
+ 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 ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - thickEnd must be less than chromEnd - not "$bed->[ thickEnd ] > $bed->[ chromEnd ]") );
}
- return if @{ $bed } == 8;
+ 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 ]") );
+ 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 @{ $bed } == 9;
+ return if $cols == 9;
if ( $bed->[ blockCount ] =~ /\D/ ) {
- Maasha::Common::error( qq(Bad BED entry - blockCount must be a whole number - not "$bed->[ blockCount ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockCount must be a whole number - not "$bed->[ blockCount ]") );
}
@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 ]") );
+ Maasha::Common::error( qq(Bad BED entry "$entry" - blockSizes "$bed->[ blockSizes ]" must match blockCount "$bed->[ blockCount ]") );
}
@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 ]") );
+ 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: ) .
+ 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 ]) );
}
}
# 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 ( defined $bp_record->{ "CHR_BEG" } ) {
$bed_entry[ chromStart ] = $bp_record->{ "CHR_BEG" };
}
if ( defined $bp_record->{ "CHR_END" } ) {
- $bed_entry[ chromEnd ] = $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" };
+ $bed_entry[ chromEnd ] = $bp_record->{ "S_END" } + 1;
} else {
return undef;
}
- $bed_entry[ chromEnd ]++;
-
return wantarray ? @bed_entry : \@bed_entry if $cols == 3;
$bed_entry[ name ] = $bp_record->{ "Q_ID" } || return wantarray ? @bed_entry : \@bed_entry;
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;
}
defined $bp_record->{ "THICK_END" } )
{
$bed_entry[ thickStart ] = $bp_record->{ "THICK_BEG" };
- $bed_entry[ thickEnd ] = $bp_record->{ "THICK_END" };
+ $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;
- if ( exists $bp_record->{ "COLOR" } ) {
+ if ( defined $bp_record->{ "COLOR" } )
+ {
$bed_entry[ itemRgb ] = $bp_record->{ "COLOR" };
- } else {
- return wantarray ? @bed_entry : \@bed_entry;
+ }
+ elsif ( defined $bp_record->{ "BLOCK_COUNT" } )
+ {
+ $bed_entry[ itemRgb ] = 0;
}
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" } )
+ defined $bp_record->{ "S_BEGS" } )
+ {
+ @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 ]++;
+ # $bed_entry[ thickEnd ] = $bp_record->{ "THICK_END" } + 1;
}
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