$Bio::MUST::Core::IdList::VERSION
=
'0.250200'
;
'Bio::MUST::Core::Roles::Listable'
;
has
'ids'
=> (
traits
=> [
'Array'
],
is
=>
'ro'
,
isa
=>
'Bio::MUST::Core::Types::full_ids'
,
default
=>
sub
{ [] },
coerce
=> 1,
writer
=>
'_set_ids'
,
handles
=> {
count_ids
=>
'count'
,
all_ids
=>
'elements'
,
add_id
=>
'push'
,
get_id
=>
'get'
,
},
);
has
'_index_for'
=> (
traits
=> [
'Hash'
],
is
=>
'ro'
,
isa
=>
'HashRef[Num]'
,
init_arg
=>
undef
,
lazy
=> 1,
builder
=>
'_build_index_for'
,
handles
=> {
count_indices
=>
'count'
,
is_listed
=>
'defined'
,
index_for
=>
'get'
,
set_index
=>
'set'
,
},
);
sub
_build_index_for {
my
$self
=
shift
;
my
$i
= 0;
return
{
map
{
$_
->
full_id
=>
$i
++ }
$self
->all_seq_ids };
}
after
'add_id'
=>
sub
{
my
$self
=
shift
;
my
$n
=
$self
->count_ids;
my
$i
=
$self
->count_indices;
return
if
$n
==
$i
;
$self
->set_index(
map
{
$_
->
full_id
=>
$i
++ } (
$self
->all_seq_ids)[
$i
..
$n
-1]
);
return
;
};
sub
all_seq_ids {
my
$self
=
shift
;
return
map
{ SeqId->new(
full_id
=>
$_
) }
$self
->all_ids;
}
sub
negative_list {
my
$self
=
shift
;
my
$listable
=
shift
;
my
@ids
=
map
{
$_
->full_id }
$listable
->all_seq_ids;
return
$self
->new(
ids
=> [
grep
{ not
$self
->is_listed(
$_
) }
@ids
] );
}
sub
reordered_ali {
return
shift
->_ali_from_list_(1,
@_
);
}
sub
filtered_ali {
return
shift
->_ali_from_list_(0,
@_
);
}
sub
_ali_from_list_ {
my
$self
=
shift
;
my
$reorder
=
shift
;
my
$ali
=
shift
;
my
$lookup
=
shift
;
$lookup
=
$ali
->lookup
if
$ali
->can(
'lookup'
);
my
$new_ali
= Ali->new(
comments
=> [
$ali
->all_comments,
'built by '
. (
$reorder
?
'reordered_ali'
:
'filtered_ali'
)
],
);
if
(
defined
$lookup
) {
my
@ids
=
map
{
$_
->full_id }
$self
->all_seq_ids;
my
@slots
=
$lookup
->index_for(
@ids
);
@slots
=
sort
{
$a
<=>
$b
}
@slots
unless
$reorder
;
$new_ali
->add_seq(
$ali
->get_seq(
$_
)->clone )
for
@slots
;
}
else
{
SEQ:
for
my
$seq
(
$ali
->all_seqs) {
next
SEQ
unless
$self
->is_listed(
$seq
->full_id);
if
(
$reorder
) {
$new_ali
->set_seq(
$self
->index_for(
$seq
->full_id),
$seq
->clone
);
next
SEQ;
}
$new_ali
->add_seq(
$seq
->clone);
}
$new_ali
->_set_seqs(
[
$new_ali
->filter_seqs(
sub
{
defined
} ) ]
)
if
$reorder
;
}
return
$new_ali
;
}
sub
load {
my
$class
=
shift
;
my
$infile
=
shift
;
my
$args
=
shift
// {};
my
$col
=
$args
->{column} // 0;
my
$sep
=
$args
->{separator} //
qr{\t}
xms;
open
my
$in
,
'<'
,
$infile
;
my
$list
=
$class
->new();
my
@ids
;
LINE:
while
(
my
$line
= <
$in
>) {
chomp
$line
;
next
LINE
if
$line
=~
$EMPTY_LINE
||
$list
->is_comment(
$line
);
my
@fields
=
split
$sep
,
$line
;
push
@ids
,
$fields
[
$col
];
}
$list
->_set_ids( \
@ids
);
return
$list
;
}
sub
load_lis {
my
$class
=
shift
;
my
$infile
=
shift
;
open
my
$in
,
'<'
,
$infile
;
my
$list
=
$class
->new();
my
$count
;
my
@ids
;
LINE:
while
(
my
$line
= <
$in
>) {
chomp
$line
;
next
LINE
if
$line
=~
$EMPTY_LINE
||
$list
->is_comment(
$line
);
if
(!
defined
$count
&&
$line
=~
$COUNT_LINE
) {
$count
=
$line
;
next
LINE;
}
push
@ids
,
$line
;
}
$list
->_set_ids( \
@ids
);
carp
'[BMC] Warning: id list size does not match id count in header!'
unless
$list
->count_ids ==
$count
;
return
$list
;
}
sub
store {
my
$self
=
shift
;
my
$outfile
=
shift
;
open
my
$out
,
'>'
,
$outfile
;
print
{
$out
}
$self
->header;
say
{
$out
}
join
"\n"
,
$self
->all_ids;
return
;
}
sub
store_lis {
my
$self
=
shift
;
my
$outfile
=
shift
;
open
my
$out
,
'>'
,
$outfile
;
print
{
$out
}
$self
->header;
say
{
$out
}
$self
->count_ids;
say
{
$out
}
join
"\n"
,
$self
->all_ids;
return
;
}
__PACKAGE__->meta->make_immutable;
1;