annotate variant_effect_predictor/Bio/MapIO/mapmaker.pm @ 0:2bc9b66ada89 draft default tip

Uploaded
author mahtabm
date Thu, 11 Apr 2013 06:29:17 -0400
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
1 # $Id: mapmaker.pm,v 1.5 2002/10/22 07:45:16 lapp Exp $
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
2 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
3 # BioPerl module for Bio::MapIO::mapmaker
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
4 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
5 # Cared for by Jason Stajich <jason@bioperl.org>
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
6 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
7 # Copyright Jason Stajich
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
8 #
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
9 # You may distribute this module under the same terms as perl itself
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
10
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
11 # POD documentation - main docs before the code
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
12
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
13 =head1 NAME
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
14
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
15 Bio::MapIO::mapmaker - A Mapmaker Map reader
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
16
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
17 =head1 SYNOPSIS
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
18
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
19 # do not use this object directly it is accessed through the Bio::MapIO system
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
20
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
21 use Bio::MapIO;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
22 my $mapio = new Bio::MapIO(-format => "mapmaker",
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
23 -file => "mapfile.map");
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
24 while( my $map = $mapio->next_map ) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
25 # get each map
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
26 foreach my $marker ( $map->each_element ) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
27 # loop through the markers associated with the map
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
28 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
29 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
30
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
31 =head1 DESCRIPTION
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
32
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
33 This object contains code for parsing and processing Mapmaker output
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
34 and creating L<Bio::Map::MapI> objects from it.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
35
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
36 =head1 FEEDBACK
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
37
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
38 =head2 Mailing Lists
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
39
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
40 User feedback is an integral part of the evolution of this and other
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
41 Bioperl modules. Send your comments and suggestions preferably to
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
42 the Bioperl mailing list. Your participation is much appreciated.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
43
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
44 bioperl-l@bioperl.org - General discussion
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
45 http://bioperl.org/MailList.shtml - About the mailing lists
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
46
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
47 =head2 Reporting Bugs
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
48
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
49 Report bugs to the Bioperl bug tracking system to help us keep track
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
50 of the bugs and their resolution. Bug reports can be submitted via
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
51 email or the web:
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
52
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
53 bioperl-bugs@bioperl.org
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
54 http://bugzilla.bioperl.org/
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
55
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
56 =head1 AUTHOR - Jason Stajich
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
57
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
58 Email jason@bioperl.org
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
59
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
60 Describe contact details here
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
61
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
62 =head1 CONTRIBUTORS
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
63
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
64 Additional contributors names and emails here
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
65
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
66 =head1 APPENDIX
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
67
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
68 The rest of the documentation details each of the object methods.
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
69 Internal methods are usually preceded with a _
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
70
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
71 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
72
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
73
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
74 # Let the code begin...
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
75
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
76
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
77 package Bio::MapIO::mapmaker;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
78 use vars qw(@ISA);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
79 use strict;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
80
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
81 use Bio::MapIO;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
82 use Bio::Map::SimpleMap;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
83 use Bio::Map::LinkagePosition;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
84 use Bio::Map::Marker;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
85
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
86 @ISA = qw(Bio::MapIO );
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
87
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
88 =head2 next_map
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
89
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
90 Title : next_tree
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
91 Usage : my $map = $factory->next_map;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
92 Function: Get a map from the factory
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
93 Returns : L<Bio::Map::MapI>
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
94 Args : none
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
95
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
96 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
97
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
98 sub next_map{
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
99 my ($self) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
100 my ($ready,$map) = (0,new Bio::Map::SimpleMap('-name' => '',
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
101 '-units' => 'cM',
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
102 '-type' => 'Genetic'));
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
103 my @markers;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
104 my $runningDistance = 0;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
105 while( defined($_ = $self->_readline()) ) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
106 if ( $ready || /^\s+Markers\s+Distance/ ) {
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
107 unless ( $ready ) { $ready = 1; next }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
108 } else { next }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
109
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
110 last if ( /-{5,}/); # map terminator is -------
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
111 s/ +/\t/;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
112 my ($number,$name,$distance) = split;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
113 $runningDistance += $distance;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
114 $runningDistance = '0.0' if $runningDistance == 0;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
115 # print "$_|$number-$name-$distance---------";
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
116 my $pos = new Bio::Map::LinkagePosition (-order => $number,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
117 -map => $map,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
118 -value => $runningDistance
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
119 );
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
120 my $marker = new Bio::Map::Marker(-name=> $name,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
121 -position => $pos,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
122 );
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
123 $marker->position($pos);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
124 # use Data::Dumper; print Dumper($marker); exit;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
125 # print $marker->position->value, "\n";
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
126 # use Data::Dumper; print Dumper($pos);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
127 # $map->add_element(new Bio::Map::Marker('-name'=> $name,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
128 # '-position' => $pos,
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
129 # ));
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
130 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
131 # return undef if( ! $ready );
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
132 return $map;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
133 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
134
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
135 =head2 write_map
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
136
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
137 Title : write_tree
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
138 Usage : $factory->write_map($map);
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
139 Function: Write a map out through the factory
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
140 Returns : none
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
141 Args : Bio::Map::MapI
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
142
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
143 =cut
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
144
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
145 sub write_map{
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
146 my ($self,@args) = @_;
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
147 $self->throw_not_implemented();
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
148 }
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
149
2bc9b66ada89 Uploaded
mahtabm
parents:
diff changeset
150 1;