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