$Bio::EnsEMBL::Mapper::VERSION
=
'112.0.0_58'
;
$Bio::EnsEMBL::Mapper::VERSION
=
'112.0.058'
;
sub
new {
my
(
$proto
,
$from
,
$to
,
$from_cs
,
$to_cs
) =
@_
;
if
( !
defined
(
$to
) || !
defined
(
$from
) ) {
throw(
"Must supply 'to' and 'from' tags"
);
}
my
$class
=
ref
(
$proto
) ||
$proto
;
my
$self
=
bless
( {
"_pair_$from"
=> {},
"_pair_$to"
=> {},
"_tree_$from"
=> {},
"_tree_$to"
=> {},
'pair_count'
=> 0,
'to'
=>
$to
,
'from'
=>
$from
,
'to_cs'
=>
$to_cs
,
'from_cs'
=>
$from_cs
},
$class
);
return
$self
;
}
sub
flush {
my
$self
=
shift
;
my
$from
=
$self
->from();
my
$to
=
$self
->to();
$self
->{
"_pair_$from"
} = {};
$self
->{
"_pair_$to"
} = {};
$self
->{
"_tree_$from"
} = {};
$self
->{
"_tree_$to"
} = {};
$self
->{
'pair_count'
} = 0;
}
sub
map_coordinates {
my
(
$self
,
$id
,
$start
,
$end
,
$strand
,
$type
,
$include_original_region
,
$cdna_coding_start
) =
@_
;
unless
(
defined
(
$id
)
&&
defined
(
$start
)
&&
defined
(
$end
)
&&
defined
(
$strand
)
&&
defined
(
$type
) )
{
throw(
"Expecting at least 5 arguments"
);
}
$cdna_coding_start
=
defined
$cdna_coding_start
?
$cdna_coding_start
: 1;
if
(
$start
==
$end
+ 1 ) {
return
$self
->map_insert(
$id
,
$start
,
$end
,
$strand
,
$type
,
undef
,
$include_original_region
);
}
if
( !
$self
->{
'_is_sorted'
} ) {
$self
->_sort() }
my
$hash
=
$self
->{
"_pair_$type"
};
my
(
$from
,
$to
,
$cs
);
if
(
$type
eq
$self
->{
'to'
} ) {
$from
=
'to'
;
$to
=
'from'
;
$cs
=
$self
->{
'from_cs'
};
}
else
{
$from
=
'from'
;
$to
=
'to'
;
$cs
=
$self
->{
'to_cs'
};
}
unless
(
defined
$hash
) {
throw(
"Type $type is neither to or from coordinate systems"
);
}
my
@result
;
my
@paired_result
;
if
( !
defined
$hash
->{
uc
(
$id
) } ) {
my
$gap
= Bio::EnsEMBL::Mapper::Gap->new(
$start
,
$end
);
if
(
$include_original_region
) {
push
@paired_result
, {
'original'
=>
$gap
,
'mapped'
=>
$gap
};
return
@paired_result
;
}
else
{
push
@result
,
$gap
;
return
@result
;
}
}
my
$last_used_pair
;
if
( !
defined
(
$self
->{
"_tree_$type"
}->{
uc
(
$id
) } )) {
$self
->{
"_tree_$type"
}->{
uc
(
$id
) } = _build_immutable_tree(
$from
,
$hash
->{
uc
(
$id
) });
}
my
$overlap
=
$self
->{
"_tree_$type"
}->{
uc
(
$id
) }->query(
$start
,
$end
);
my
$rank
= 0;
my
$orig_start
=
$start
;
my
$last_target_coord
=
undef
;
foreach
my
$i
(@{
$overlap
}) {
my
$pair
=
$i
->data;
my
$self_coord
=
$pair
->{
$from
};
my
$target_coord
=
$pair
->{
$to
};
if
(
defined
(
$last_target_coord
) &&
$target_coord
->{
'id'
} ne
$last_target_coord
) {
if
(
$self_coord
->{
'start'
} <
$start
) {
$start
=
$orig_start
;
}
}
else
{
$last_target_coord
=
$target_coord
->{
'id'
};
}
if
(
$start
<
$self_coord
->{
'start'
} ) {
my
$gap
= Bio::EnsEMBL::Mapper::Gap->new(
$start
,
$self_coord
->{
'start'
} - 1,
$rank
);
push
(
@result
,
$gap
);
push
(
@paired_result
, {
'original'
=>
$gap
,
'mapped'
=>
$gap
});
$start
=
$gap
->{
'end'
} + 1;
}
my
(
$target_start
,
$target_end
);
my
(
$ori_start
,
$ori_end
);
my
$res
;
if
(
exists
$pair
->{
'indel'
} ) {
$target_start
=
$target_coord
->{
'start'
};
$target_end
=
$target_coord
->{
'end'
};
$ori_start
=
$self_coord
->{
'start'
};
$ori_end
=
$self_coord
->{
'end'
};
my
$gap
= Bio::EnsEMBL::Mapper::Gap->new(
$start
,
(
$self_coord
->{
'end'
} <
$end
?
$self_coord
->{
'end'
} :
$end
) );
my
$coord
=
Bio::EnsEMBL::Mapper::Coordinate->new(
$target_coord
->{
'id'
},
$target_start
,
$target_end
,
$pair
->{
'ori'
}
*$strand
,
$cs
);
$res
= Bio::EnsEMBL::Mapper::IndelCoordinate->new(
$gap
,
$coord
);
}
else
{
if
(
$pair
->{
'ori'
} == 1 ) {
$target_start
=
$target_coord
->{
'start'
} + (
$start
-
$self_coord
->{
'start'
} );
}
else
{
$target_end
=
$target_coord
->{
'end'
} - (
$start
-
$self_coord
->{
'start'
} );
}
if
(
$end
>
$self_coord
->{
'end'
} ) {
if
(
$pair
->{
'ori'
} == 1 ) {
$target_end
=
$target_coord
->{
'end'
};
}
else
{
$target_start
=
$target_coord
->{
'start'
};
}
}
else
{
if
(
$pair
->{
'ori'
} == 1 ) {
$target_end
=
$target_coord
->{
'start'
} +
(
$end
-
$self_coord
->{
'start'
} );
}
else
{
$target_start
=
$target_coord
->{
'end'
} - (
$end
-
$self_coord
->{
'start'
} );
}
}
$res
= Bio::EnsEMBL::Mapper::Coordinate->new(
$target_coord
->{
'id'
},
$target_start
,
$target_end
,
$pair
->{
'ori'
}
*$strand
,
$cs
,
$rank
);
$ori_start
= (
$start
-
$cdna_coding_start
) + 1;
$ori_end
=
$ori_start
+ (
$target_end
-
$target_start
);
}
push
(
@result
,
$res
);
my
$res_ori
= Bio::EnsEMBL::Mapper::Coordinate->new(
$self_coord
->{
'id'
},
$ori_start
,
$ori_end
,
$pair
->{
'ori'
}
*$strand
,
$cs
,
$rank
);
push
(
@paired_result
, {
'original'
=>
$res_ori
,
'mapped'
=>
$res
});
$last_used_pair
=
$pair
;
$start
=
$self_coord
->{
'end'
} + 1;
}
if
( !
defined
$last_used_pair
) {
my
$gap
= Bio::EnsEMBL::Mapper::Gap->new(
$start
,
$end
);
push
(
@result
,
$gap
);
push
(
@paired_result
, {
'original'
=>
$gap
,
'mapped'
=>
$gap
});
}
elsif
(
$last_used_pair
->{
$from
}->{
'end'
} <
$end
) {
my
$gap
= Bio::EnsEMBL::Mapper::Gap->new(
$last_used_pair
->{
$from
}->{
'end'
} + 1,
$end
,
$rank
);
push
(
@result
,
$gap
);
push
(
@paired_result
, {
'original'
=>
$gap
,
'mapped'
=>
$gap
});
}
if
(
$strand
== -1 ) {
@result
=
reverse
(
@result
);
@paired_result
=
reverse
(
@paired_result
);
}
if
(
$include_original_region
){
return
@paired_result
;
}
else
{
return
@result
;
}
}
sub
map_insert {
my
(
$self
,
$id
,
$start
,
$end
,
$strand
,
$type
,
$fastmap
,
$include_original_region
) =
@_
;
(
$start
,
$end
) =(
$end
,
$start
);
my
@coords
=
$self
->map_coordinates(
$id
,
$start
,
$end
,
$strand
,
$type
,
$include_original_region
);
if
(
@coords
== 1) {
my
$c
=
$coords
[0];
if
(
$include_original_region
) {
my
$m
=
$c
->{
'mapped'
};
my
$orig
=
$c
->{
'original'
};
(
$m
->{
'start'
},
$m
->{
'end'
}) = (
$m
->{
'end'
},
$m
->{
'start'
});
(
$orig
->{
'start'
},
$orig
->{
'end'
}) = (
$orig
->{
'end'
},
$orig
->{
'start'
});
}
else
{
(
$c
->{
'start'
},
$c
->{
'end'
}) = (
$c
->{
'end'
},
$c
->{
'start'
});
}
}
else
{
throw(
"Unexpected: Got "
,
scalar
(
@coords
),
" expected 2."
)
if
(
@coords
!= 2);
my
(
$c1
,
$c2
);
if
(
$strand
== -1) {
(
$c2
,
$c1
) =
@coords
;
}
else
{
(
$c1
,
$c2
) =
@coords
;
}
@coords
= ();
my
(
$m1
,
$m2
);
if
(
$include_original_region
) {
(
$m1
,
$m2
) = (
$c1
->{
'mapped'
},
$c2
->{
'mapped'
});
}
else
{
(
$m1
,
$m2
) = (
$c1
,
$c2
);
}
if
(
ref
(
$m1
) eq
'Bio::EnsEMBL::Mapper::Coordinate'
) {
if
(
$m1
->{
'strand'
} *
$strand
== -1) {
$m1
->{
'end'
}--;
}
else
{
$m1
->{
'start'
}++;
}
if
(
$include_original_region
) {
$c1
->{
'mapped'
} =
$m1
;
@coords
= (
$c1
);
}
else
{
@coords
= (
$m1
);
}
}
if
(
ref
(
$m2
) eq
'Bio::EnsEMBL::Mapper::Coordinate'
) {
if
(
$m2
->{
'strand'
} *
$strand
== -1) {
$m2
->{
'start'
}++;
}
else
{
$m2
->{
'end'
}--;
}
if
(
$strand
== -1) {
if
(
$include_original_region
) {
$c2
->{
'mapped'
} =
$m2
;
unshift
@coords
,
$c2
;
}
else
{
unshift
@coords
,
$m2
;
}
}
else
{
if
(
$include_original_region
) {
$c2
->{
'mapped'
} =
$m2
;
push
@coords
,
$c2
;
}
else
{
push
@coords
,
$m2
;
}
}
}
if
(
$include_original_region
) {
foreach
my
$coord
(
@coords
) {
my
$orig
=
$coord
->{
'original'
};
(
$orig
->{
'start'
},
$orig
->{
'end'
}) =
(
$orig
->{
'end'
},
$orig
->{
'start'
});
}
}
}
if
(
$fastmap
) {
return
undef
if
(
@coords
!= 1);
my
$c
=
$include_original_region
?
$coords
[0]->{
'mapped'
} :
$coords
[0];
return
(
$c
->{
'id'
},
$c
->{
'start'
},
$c
->{
'end'
},
$c
->{
'strand'
},
$c
->{
'coord_system'
});
}
return
@coords
;
}
sub
fastmap {
my
(
$self
,
$id
,
$start
,
$end
,
$strand
,
$type
) =
@_
;
my
(
$from
,
$to
,
$cs
);
if
(
$end
+1 ==
$start
) {
return
$self
->map_insert(
$id
,
$start
,
$end
,
$strand
,
$type
, 1);
}
if
( !
$self
->{
'_is_sorted'
} ) {
$self
->_sort() }
if
(
$type
eq
$self
->{
'to'
}) {
$from
=
'to'
;
$to
=
'from'
;
$cs
=
$self
->{
'from_cs'
};
}
else
{
$from
=
'from'
;
$to
=
'to'
;
$cs
=
$self
->{
'to_cs'
};
}
my
$hash
=
$self
->{
"_pair_$type"
} or
throw(
"Type $type is neither to or from coordinate systems"
);
my
$pairs
=
$hash
->{
uc
(
$id
)};
foreach
my
$pair
(
@$pairs
) {
my
$self_coord
=
$pair
->{
$from
};
my
$target_coord
=
$pair
->{
$to
};
if
(
$start
<
$self_coord
->{
'start'
} ||
$end
>
$self_coord
->{
'end'
} ) {
next
;
}
if
(
$pair
->{
'ori'
} == 1 ) {
return
(
$target_coord
->{
'id'
},
$target_coord
->{
'start'
}+
$start
-
$self_coord
->{
'start'
},
$target_coord
->{
'start'
}+
$end
-
$self_coord
->{
'start'
},
$strand
,
$cs
);
}
else
{
return
(
$target_coord
->{
'id'
},
$target_coord
->{
'end'
} - (
$end
-
$self_coord
->{
'start'
}),
$target_coord
->{
'end'
} - (
$start
-
$self_coord
->{
'start'
}),
-
$strand
,
$cs
);
}
}
return
();
}
sub
add_map_coordinates {
my
(
$self
,
$contig_id
,
$contig_start
,
$contig_end
,
$contig_ori
,
$chr_name
,
$chr_start
,
$chr_end
)
=
@_
;
unless
(
defined
(
$contig_id
)
&&
defined
(
$contig_start
)
&&
defined
(
$contig_end
)
&&
defined
(
$contig_ori
)
&&
defined
(
$chr_name
)
&&
defined
(
$chr_start
)
&&
defined
(
$chr_end
) )
{
throw(
"7 arguments expected"
);
}
if
( (
$chr_end
>
$chr_start
) and (
$contig_end
-
$contig_start
) != (
$chr_end
-
$chr_start
) ) {
throw(
"Cannot deal with mis-lengthed mappings so far"
);
}
my
$from
= Bio::EnsEMBL::Mapper::Unit->new(
$contig_id
,
$contig_start
,
$contig_end
);
my
$to
=
Bio::EnsEMBL::Mapper::Unit->new(
$chr_name
,
$chr_start
,
$chr_end
);
my
$pair
= Bio::EnsEMBL::Mapper::Pair->new(
$from
,
$to
,
$contig_ori
);
my
$map_to
=
$self
->{
'to'
};
my
$map_from
=
$self
->{
'from'
};
push
( @{
$self
->{
"_pair_$map_to"
}->{
uc
(
$chr_name
) } },
$pair
);
push
( @{
$self
->{
"_pair_$map_from"
}->{
uc
(
$contig_id
) } },
$pair
);
$self
->{
"_tree_$map_to"
}->{
uc
(
$contig_id
) } =
undef
;
$self
->{
"_tree_$map_from"
}->{
uc
(
$contig_id
) } =
undef
;
$self
->{
'pair_count'
}++;
$self
->{
'_is_sorted'
} = 0;
}
sub
add_indel_coordinates{
my
(
$self
,
$contig_id
,
$contig_start
,
$contig_end
,
$contig_ori
,
$chr_name
,
$chr_start
,
$chr_end
) =
@_
;
unless
(
defined
(
$contig_id
) &&
defined
(
$contig_start
) &&
defined
(
$contig_end
)
&&
defined
(
$contig_ori
) &&
defined
(
$chr_name
) &&
defined
(
$chr_start
)
&&
defined
(
$chr_end
)) {
throw(
"7 arguments expected"
);
}
my
$from
=
Bio::EnsEMBL::Mapper::Unit->new(
$contig_id
,
$contig_start
,
$contig_end
);
my
$to
=
Bio::EnsEMBL::Mapper::Unit->new(
$chr_name
,
$chr_start
,
$chr_end
);
my
$pair
= Bio::EnsEMBL::Mapper::IndelPair->new(
$from
,
$to
,
$contig_ori
);
my
$map_to
=
$self
->{
'to'
};
my
$map_from
=
$self
->{
'from'
};
push
( @{
$self
->{
"_pair_$map_to"
}->{
uc
(
$chr_name
)}},
$pair
);
push
( @{
$self
->{
"_pair_$map_from"
}->{
uc
(
$contig_id
)}},
$pair
);
$self
->{
"_tree_$map_to"
}->{
uc
(
$chr_name
) } =
undef
;
$self
->{
"_tree_$map_from"
}->{
uc
(
$contig_id
) } =
undef
;
$self
->{
'pair_count'
}++;
$self
->{
'_is_sorted'
} = 0;
return
1;
}
sub
map_indel {
my
(
$self
,
$id
,
$start
,
$end
,
$strand
,
$type
) =
@_
;
(
$start
,
$end
) = (
$end
,
$start
);
if
( !
$self
->{
'_is_sorted'
} ) {
$self
->_sort() }
my
$hash
=
$self
->{
"_pair_$type"
};
my
(
$from
,
$to
,
$cs
);
if
(
$type
eq
$self
->{
'to'
} ) {
$from
=
'to'
;
$to
=
'from'
;
$cs
=
$self
->{
'from_cs'
};
}
else
{
$from
=
'from'
;
$to
=
'to'
;
$cs
=
$self
->{
'to_cs'
};
}
unless
(
defined
$hash
) {
throw(
"Type $type is neither to or from coordinate systems"
);
}
my
@indel_coordinates
;
if
( !
defined
$self
->{
"_tree_$type"
}->{
uc
(
$id
) } ) {
$self
->{
"_tree_$type"
}->{
uc
(
$id
) } = _build_immutable_tree(
$from
,
$hash
->{
uc
(
$id
) });
}
my
$overlap
=
$self
->{
"_tree_$type"
}->{
uc
(
$id
) }->query(
$start
,
$end
);
foreach
my
$i
(@{
$overlap
}) {
my
$pair
=
$i
->data;
my
$self_coord
=
$pair
->{
$from
};
my
$target_coord
=
$pair
->{
$to
};
if
(
exists
$pair
->{
'indel'
} ) {
my
$to
=
Bio::EnsEMBL::Mapper::Unit->new(
$target_coord
->{
'id'
},
$target_coord
->{
'start'
},
$target_coord
->{
'end'
}, );
push
@indel_coordinates
,
$to
;
last
;
}
}
return
@indel_coordinates
;
}
sub
add_Mapper{
my
(
$self
,
$mapper
) =
@_
;
my
$mapper_to
=
$mapper
->{
'to'
};
my
$mapper_from
=
$mapper
->{
'from'
};
if
(
$mapper_to
ne
$self
->{
'to'
} or
$mapper_from
ne
$self
->{
'from'
}) {
throw(
"Trying to add an incompatible Mapper"
);
}
my
$count_a
= 0;
foreach
my
$seq_name
(
keys
%{
$mapper
->{
"_pair_$mapper_to"
}}) {
push
(@{
$self
->{
"_pair_$mapper_to"
}->{
$seq_name
}},
@{
$mapper
->{
"_pair_$mapper_to"
}->{
$seq_name
}});
$self
->{
"_tree_$mapper_to"
}->{
uc
(
$seq_name
) } =
undef
;
$count_a
+=
scalar
(@{
$mapper
->{
"_pair_$mapper_to"
}->{
$seq_name
}});
}
my
$count_b
= 0;
foreach
my
$seq_name
(
keys
%{
$mapper
->{
"_pair_$mapper_from"
}}) {
push
(@{
$self
->{
"_pair_$mapper_from"
}->{
$seq_name
}},
@{
$mapper
->{
"_pair_$mapper_from"
}->{
$seq_name
}});
$self
->{
"_tree_$mapper_from"
}->{
uc
(
$seq_name
) } =
undef
;
$count_b
+=
scalar
(@{
$mapper
->{
"_pair_$mapper_from"
}->{
$seq_name
}});
}
if
(
$count_a
==
$count_b
) {
$self
->{
'pair_count'
} +=
$count_a
;
}
else
{
throw(
"Trying to add a funny Mapper"
);
}
$self
->{
'_is_sorted'
} = 0;
return
1;
}
sub
list_pairs {
my
(
$self
,
$id
,
$start
,
$end
,
$type
) =
@_
;
if
( !
$self
->{
'_is_sorted'
} ) {
$self
->_sort() }
if
( !
defined
$type
) {
throw(
"Expected 4 arguments"
);
}
if
(
$start
>
$end
) {
throw(
"Start is greater than end "
.
"for id $id, start $start, end $end\n"
);
}
my
$hash
=
$self
->{
"_pair_$type"
};
my
(
$from
,
$to
);
if
(
$type
eq
$self
->{
'to'
} ) {
$from
=
'to'
;
$to
=
'from'
;
}
else
{
$from
=
'from'
;
$to
=
'to'
;
}
unless
(
defined
$hash
) {
throw(
"Type $type is neither to or from coordinate systems"
);
}
my
@list
;
unless
(
exists
$hash
->{
uc
(
$id
) } ) {
return
();
}
@list
= @{
$hash
->{
uc
(
$id
) } };
my
@output
;
if
(
$start
== -1 &&
$end
== -1 ) {
return
@list
;
}
else
{
foreach
my
$p
(
@list
) {
if
(
$p
->{
$from
}->{
'end'
} <
$start
) {
next
;
}
if
(
$p
->{
$from
}->{
'start'
} >
$end
) {
last
;
}
push
(
@output
,
$p
);
}
return
@output
;
}
}
sub
to {
my
(
$self
,
$value
) =
@_
;
if
(
defined
(
$value
) ) {
$self
->{
'to'
} =
$value
;
}
return
$self
->{
'to'
};
}
sub
from {
my
(
$self
,
$value
) =
@_
;
if
(
defined
(
$value
) ) {
$self
->{
'from'
} =
$value
;
}
return
$self
->{
'from'
};
}
sub
_dump{
my
(
$self
,
$fh
) =
@_
;
if
( !
defined
$fh
) {
$fh
= \
*STDERR
;
}
my
$from
=
$self
->{
'from'
};
my
$to
=
$self
->{
'to'
};
print
$fh
"dumping from-hash _pair_$from\n"
;
foreach
my
$id
(
keys
%{
$self
->{
"_pair_$from"
}} ) {
print
$fh
"{_pair_$from}->{"
.
uc
(
$id
) .
"}:\n"
;
foreach
my
$pair
( @{
$self
->{
"_pair_$from"
}->{
uc
(
$id
)}} ) {
print
$fh
" "
,
$pair
->from->start,
" "
,
$pair
->from->end,
":"
,
$pair
->to->start,
" "
,
$pair
->to->end,
" "
,
$pair
->to->id,
"\n"
;
}
if
(
defined
(
$self
->{
"_tree_$from"
}->{
uc
(
$id
)})) {
print
$fh
"{_tree_$from}->{"
.
uc
(
$id
) .
"} instantiated\n"
;
}
else
{
print
$fh
"{_tree_$from}->{"
.
uc
(
$id
) .
"} empty\n"
;
}
}
print
$fh
"dumping to-hash _pair_$to\n"
;
foreach
my
$id
(
keys
%{
$self
->{
"_pair_$to"
}} ) {
print
$fh
"{_pair_$to}->{"
.
uc
(
$id
) .
"}:\n"
;
foreach
my
$pair
( @{
$self
->{
"_pair_$to"
}->{
uc
(
$id
)}} ) {
print
$fh
" "
,
$pair
->to->start,
" "
,
$pair
->to->end,
":"
,
$pair
->from->start,
" "
,
$pair
->from->end,
" "
,
$pair
->from->id,
"\n"
;
}
if
(
defined
(
$self
->{
"_tree_$to"
}->{
uc
(
$id
)})) {
print
$fh
"{_tree_$to}->{"
.
uc
(
$id
) .
"} instantiated\n"
;
}
else
{
print
$fh
"{_tree_$to}->{"
.
uc
(
$id
) .
"} empty\n"
;
}
}
}
sub
_sort {
my
(
$self
) =
@_
;
my
$to
=
$self
->{
'to'
};
my
$from
=
$self
->{
'from'
};
foreach
my
$id
(
keys
%{
$self
->{
"_pair_$from"
} } ) {
@{
$self
->{
"_pair_$from"
}->{
$id
} } =
sort
{
$a
->{
'from'
}->{
'start'
} <=>
$b
->{
'from'
}->{
'start'
} }
@{
$self
->{
"_pair_$from"
}->{
$id
} };
}
foreach
my
$id
(
keys
%{
$self
->{
"_pair_$to"
} } ) {
@{
$self
->{
"_pair_$to"
}->{
$id
} } =
sort
{
$a
->{
'to'
}->{
'start'
} <=>
$b
->{
'to'
}->{
'start'
} }
@{
$self
->{
"_pair_$to"
}->{
$id
} };
}
$self
->_merge_pairs();
$self
->_is_sorted(1);
}
sub
_merge_pairs {
my
$self
=
shift
;
my
(
$lr
,
$lr_from
,
$del_pair
,
$next_pair
,
$current_pair
);
my
$map_to
=
$self
->{
'to'
};
my
$map_from
=
$self
->{
'from'
};
$self
->{
'pair_count'
} = 0;
for
my
$key
(
keys
%{
$self
->{
"_pair_$map_to"
}} ) {
$self
->{
"_tree_$map_to"
}->{
uc
(
$key
) } =
undef
;
$lr
=
$self
->{
"_pair_$map_to"
}->{
$key
};
my
$i
= 0;
my
$next
= 1;
my
$length
= $
while
(
$next
<=
$length
) {
$current_pair
=
$lr
->[
$i
];
$next_pair
=
$lr
->[
$next
];
$del_pair
=
undef
;
if
(
exists
$current_pair
->{
'indel'
} ||
exists
$next_pair
->{
'indel'
}){
$next
++;
$i
++;
}
else
{
if
(
$current_pair
->{
'to'
}->{
'start'
} ==
$next_pair
->{
'to'
}->{
'start'
}
&&
$current_pair
->{
'from'
}->{
'id'
} ==
$next_pair
->{
'from'
}->{
'id'
}
&&
$current_pair
->{
'from'
}->{
'start'
} ==
$next_pair
->{
'from'
}->{
'start'
}) {
$del_pair
=
$next_pair
;
}
elsif
( (
$current_pair
->{
'from'
}->{
'id'
} eq
$next_pair
->{
'from'
}->{
'id'
} ) &&
(
$next_pair
->{
'ori'
} ==
$current_pair
->{
'ori'
} ) &&
(
$next_pair
->{
'to'
}->{
'start'
} -1 ==
$current_pair
->{
'to'
}->{
'end'
} )) {
if
(
$current_pair
->{
'ori'
} == 1 ) {
if
(
$next_pair
->{
'from'
}->{
'start'
} - 1 ==
$current_pair
->{
'from'
}->{
'end'
} ) {
$current_pair
->{
'to'
}->{
'end'
} =
$next_pair
->{
'to'
}->{
'end'
};
$current_pair
->{
'from'
}->{
'end'
} =
$next_pair
->{
'from'
}->{
'end'
};
$del_pair
=
$next_pair
;
}
}
else
{
if
(
$next_pair
->{
'from'
}->{
'end'
} + 1 ==
$current_pair
->{
'from'
}->{
'start'
} ) {
$current_pair
->{
'to'
}->{
'end'
} =
$next_pair
->{
'to'
}->{
'end'
};
$current_pair
->{
'from'
}->{
'start'
} =
$next_pair
->{
'from'
}->{
'start'
};
$del_pair
=
$next_pair
;
}
}
}
if
(
defined
$del_pair
) {
splice
(
@$lr
,
$next
, 1 );
$lr_from
=
$self
->{
"_pair_$map_from"
}->{
uc
(
$del_pair
->{
'from'
}->{
'id'
})};
for
(
my
$j
=0;
$j
<= $
if
(
$lr_from
->[
$j
] ==
$del_pair
) {
splice
(
@$lr_from
,
$j
, 1 );
last
;
}
}
$length
--;
if
(
$length
<
$next
) {
last
; }
}
else
{
$next
++;
$i
++;
}
}
}
$self
->{
'pair_count'
} +=
scalar
(
@$lr
);
}
}
sub
_is_sorted {
my
(
$self
,
$value
) =
@_
;
$self
->{
'_is_sorted'
} =
$value
if
(
defined
(
$value
));
return
$self
->{
'_is_sorted'
};
}
sub
_build_immutable_tree {
my
(
$pair_side
,
$pair_list
) =
@_
;
my
$from_intervals
;
foreach
my
$i
(@{
$pair_list
}) {
my
$start
=
$i
->{
$pair_side
}{start};
my
$end
=
$i
->{
$pair_side
}{end};
if
(
$end
<
$start
) {
(
$end
,
$start
) = (
$start
,
$end
);
}
push
@{
$from_intervals
}, Bio::EnsEMBL::Utils::Interval->new(
$start
,
$end
,
$i
);
}
return
Bio::EnsEMBL::Utils::Tree::Interval::Immutable->new(
$from_intervals
);
}
1;