File Coverage

blib/lib/GenOO/GeneCollection/Factory/FromTranscriptCollection.pm
Criterion Covered Total %
statement 54 55 98.1
branch 13 18 72.2
condition 3 3 100.0
subroutine 8 8 100.0
pod 0 1 0.0
total 78 85 91.7


line stmt bran cond sub pod time code
1             # POD documentation - main docs before the code
2              
3             =head1 NAME
4              
5             GenOO::GeneCollection::Factory::FromTranscriptCollection - Factory for creating GenOO::GeneCollection object from a Transcript Collection and a hash{transcript_name} = genename
6              
7             =head1 SYNOPSIS
8              
9             # Creates GenOO::GeneCollection object from a Transcript Collection and a hash
10              
11             # Preferably use it through the generic GenOO::GeneCollection::Factory
12             my $factory = GenOO::GeneCollection::Factory->create(
13             'FromTranscriptCollection',
14             {
15             annotation_hash => \%annotation,
16             transcript_collection => $transcript_collection
17             }
18             );
19              
20             =head1 DESCRIPTION
21              
22             An instance of this class is a concrete factory for the creation of a
23             L<GenOO::GeneCollection> object from a Transcript Collection
24             and a hash that has transcript names as keys and gene names as values.
25             It offers the method "read_collection" (as the consumed role requires) which returns the actual
26             L<GenOO::GeneCollection> object in the form of L<GenOO::RegionCollection::Type::DoubleHashArray>.
27             The latter is the implementation of the L<GenOO::RegionCollection> class based on the complex
28             data structure L<GenOO::Data::Structure::DoubleHashArray>.
29              
30             =head1 EXAMPLES
31              
32             # Create a concrete factory
33             my $factory_implementation = GenOO::GeneCollection::Factory->create(
34             'FromTranscriptCollection',
35             {
36             annotation_hash => \%annotation,
37             transcript_collection => $transcript_collection
38             }
39             );
40            
41             # Return the actual GenOO::GeneCollection object
42             my $collection = $factory_implementation->read_collection;
43             print ref($collection) # GenOO::RegionCollection::Type::DoubleHashArray
44              
45             =cut
46              
47             # Let the code begin...
48              
49             package GenOO::GeneCollection::Factory::FromTranscriptCollection;
50             $GenOO::GeneCollection::Factory::FromTranscriptCollection::VERSION = '1.5.2';
51 1     1   12274 use Moose;
  1         11  
  1         39  
52 1     1   8615 use namespace::autoclean;
  1         9  
  1         32  
53              
54 1     1   180 use GenOO::RegionCollection::Type::DoubleHashArray;
  1         3  
  1         57  
55 1     1   15 use GenOO::Gene;
  1         10  
  1         817  
56              
57             has 'annotation_hash' => (
58             isa => 'HashRef',
59             is => 'ro',
60             required => 1
61             );
62             has 'transcript_collection' => (
63             isa => 'GenOO::RegionCollection',
64             is => 'ro',
65             required => 1
66             );
67              
68             with 'GenOO::RegionCollection::Factory::Requires';
69              
70             #######################################################################
71             ######################## Interface Methods ########################
72             #######################################################################
73             sub read_collection {
74 1     1 0 2665 my ($self) = @_;
75            
76 1         65 my $collection = GenOO::RegionCollection::Type::DoubleHashArray->new;
77 1         18 my @all_genes = $self->_make_list_of_genes;
78 1         4 foreach my $gene ( @all_genes ) {
79 6         30 $collection->add_record($gene);
80             }
81 1         6 return $collection;
82             }
83              
84             sub _make_list_of_genes {
85 1     1   15 my ($self) = @_;
86            
87 1         13 my @outgenes;
88             my %transcripts_for_genename;
89             $self->transcript_collection->foreach_record_do( sub {
90 70     70   128 my ($transcript) = @_;
91            
92 70 100       2548 if (exists $self->annotation_hash->{$transcript->id}){
93 27         968 my $gene_name = $self->annotation_hash->{$transcript->id};
94 27         81 push @{$transcripts_for_genename{$gene_name}}, $transcript;
  27         135  
95             }
96 1         64 });
97            
98 1         15 foreach my $genename (keys %transcripts_for_genename) {
99 5         30 my ($merged_regions,$included_transcripts) = _merge($transcripts_for_genename{$genename});
100 5         25 for (my $i=0;$i<@$merged_regions;$i++) {
101 6         197 my $gene = GenOO::Gene->new(
102             name => $genename,
103             transcripts => $$included_transcripts[$i]
104             );
105 6         18 foreach my $transcript (@{$gene->transcripts}) {
  6         192  
106 27         689 $transcript->gene($gene);
107             }
108 6         200 push @outgenes, $gene;
109             }
110             }
111            
112 1         14 return @outgenes;
113             }
114              
115             sub _merge {
116 5     5   23 my ($regions_ref, $params) = @_;
117            
118 5 50       25 my $offset = exists $params->{'OFFSET'} ? $params->{'OFFSET'} : 0;
119 5 50       24 my $use_strand = exists $params->{'USE_STRAND'} ? $params->{'USE_STRAND'} : 1;
120            
121 5 100       32 my @sorted_regions = (@$regions_ref > 1) ? sort{$a->start <=> $b->start} @$regions_ref : @$regions_ref;
  69         1690  
122            
123 5         11 my @merged_regions;
124             my @included_regions;
125 5         23 foreach my $region (@sorted_regions) {
126            
127 27         50 my $merged_region = $merged_regions[-1];
128 27 100 100     132 if (defined $merged_region and $merged_region->overlaps($region, $use_strand, $offset)) {
129 21 50       56 if (wantarray) {
130 21         42 push @{$included_regions[-1]}, $region;
  21         55  
131             }
132 21 100       512 if ($region->stop() > $merged_region->stop) {
133 1         27 $merged_region->stop($region->stop);
134             }
135             }
136             else {
137 6         175 push @merged_regions, GenOO::GenomicRegion->new
138             (
139             start => $region->start,
140             stop => $region->stop,
141             strand => $region->strand,
142             chromosome => $region->chromosome,
143             );
144 6 50       27 if (wantarray) {
145 6         34 push @included_regions,[$region];
146             }
147             }
148             }
149              
150 5 50       18 if (wantarray) {
151 5         29 return (\@merged_regions, \@included_regions);
152             }
153             else {
154 0           return \@merged_regions;
155             }
156             }
157              
158             1;