← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/PhyloNetwork/muVector.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/PhyloNetwork/muVector.pm
 
1
# $Id: muVector.pm 14716 2008-06-11 06:48:28Z heikki $
 
2
#
 
3
# Module for Bio::PhyloNetwork::muVector
 
4
#
 
5
# Cared for by Gabriel Cardona <gabriel(dot)cardona(at)uib(dot)es>
 
6
#
 
7
# Copyright Gabriel Cardona
 
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::PhyloNetwork::muVector - Module to compute with vectors of arbitrary
 
16
dimension
 
17
 
 
18
=head1 SYNOPSIS
 
19
 
 
20
 use strict;
 
21
 use warnings;
 
22
 
 
23
 use Bio::PhyloNetwork::muVector;
 
24
 
 
25
 my $vec1=Bio::PhyloNetwork::muVector->new(4);
 
26
 my $vec2=Bio::PhyloNetwork::muVector->new([1,2,3,4]);
 
27
 my $vec3=Bio::PhyloNetwork::muVector->new([10,20,30,40]);
 
28
 
 
29
 my $vec4=$vec3-10*$vec2;
 
30
 if (($vec4 cmp $vec1) == 0) {
 
31
   print "$vec4 is zero\n";
 
32
 }
 
33
 
 
34
 my $vec5=Bio::PhyloNetwork::muVector->new([8,2,2,4]);
 
35
 my $vec6=Bio::PhyloNetwork::muVector->new([1,2,3,4]);
 
36
 
 
37
 print "Test poset $vec5 > $vec6: ".$vec5->geq_poset($vec6)."\n";
 
38
 print "Test lex $vec5 > $vec6: ".($vec5 cmp $vec6)."\n";
 
39
 
 
40
=head1 DESCRIPTION
 
41
 
 
42
This is a module to work with vectors. It creates
 
43
vectors of arbitrary length, defines its basic arithmetic operations,
 
44
its lexicographic ordering and the natural structure of poset.
 
45
 
 
46
=head1 AUTHOR
 
47
 
 
48
Gabriel Cardona, gabriel(dot)cardona(at)uib(dot)es
 
49
 
 
50
=head1 APPENDIX
 
51
 
 
52
The rest of the documentation details each of the object methods.
 
53
 
 
54
=cut
 
55
 
 
56
package Bio::PhyloNetwork::muVector;
 
57
 
 
58
use strict;
 
59
use warnings;
 
60
 
 
61
use base qw(Bio::Root::Root);
 
62
 
 
63
=head2 new
 
64
 
 
65
 Title   : new
 
66
 Usage   : my $mu = new Bio::PhyloNetwork::muVector();
 
67
 Function: Creates a new Bio::PhyloNetwork::muVector object
 
68
 Returns : Bio::PhyloNetwork::muVector
 
69
 Args    : integer or (reference to) an array
 
70
 
 
71
If given an integer as argument, returns a Bio::PhyloNetwork::muVector
 
72
object with dimension the integer given and initialized to zero.
 
73
If it is an anonimous array, then the vector is initialized with the values
 
74
in the array and with the corresponding dimension.
 
75
 
 
76
=cut
 
77
 
 
78
sub new {
 
79
  my ($pkg,$cont)=@_;
 
80
  my $self=$pkg->SUPER::new();
 
81
  my @arr=();
 
82
  if (!ref($cont)) {
 
83
    #$cont is a number; initialize to a zero-vector
 
84
    for (my $i=0; $i < $cont; $i++) {
 
85
      $arr[$i]=0;
 
86
    }
 
87
    $self->{arr}=\@arr;
 
88
  } else {
 
89
    #$cont points to an array
 
90
    @arr=@{$cont};
 
91
  }
 
92
  $self->{dim}=scalar @arr;
 
93
  $self->{arr}=\@arr;
 
94
  bless($self,$pkg);
 
95
  return $self;
 
96
}
 
97
 
 
98
sub dim {
 
99
  return shift->{dim}
 
100
}
 
101
 
 
102
use overload
 
103
  "+" => \&add,
 
104
  "-" => \&substract,
 
105
  "*" => \&scalarproduct,
 
106
  "<=>" => \&comparelex,
 
107
  "cmp" => \&comparelex,
 
108
  '""' => \&display,
 
109
  '@{}' => \&as_array;
 
110
 
 
111
sub as_array {
 
112
  return shift->{arr};
 
113
}
 
114
 
 
115
=head2 display
 
116
 
 
117
 Title   : display
 
118
 Usage   : my $str=$mu->display()
 
119
 Function: returns an string displaying its contents
 
120
 Returns : string
 
121
 Args    : none
 
122
 
 
123
This function is also overloaded to the "" operator.
 
124
 
 
125
=cut
 
126
 
 
127
sub display {
 
128
  my ($self)=@_;
 
129
  my @arr=@{$self->{arr}};
 
130
  return "(@arr)";
 
131
}
 
132
 
 
133
=head2 add
 
134
 
 
135
 Title   : add
 
136
 Usage   : $mu->add($mu2)
 
137
 Function: returns the sum of $mu and $mu2
 
138
 Returns : Bio::PhyloNetwork::muVector
 
139
 Args    : Bio::PhyloNetwork::muVector
 
140
 
 
141
This function is also overloaded to the + operator.
 
142
 
 
143
=cut
 
144
 
 
145
sub add {
 
146
  my ($v1,$v2)=@_;
 
147
 
 
148
  $v1->throw("Vectors not the same size") unless ($v1->{dim} == $v2->{dim});
 
149
  my $dim=$v1->{dim};
 
150
  my @sum=();
 
151
  for (my $i=0; $i<$dim; $i++) {
 
152
    $sum[$i]=$v1->[$i]+$v2->[$i];
 
153
  }
 
154
  my $result=Bio::PhyloNetwork::muVector->new(\@sum);
 
155
  return $result;
 
156
}
 
157
 
 
158
=head2 substract
 
159
 
 
160
 Title   : substract
 
161
 Usage   : $mu->substract($mu2)
 
162
 Function: returns the difference of $mu and $mu2
 
163
 Returns : Bio::PhyloNetwork::muVector
 
164
 Args    : Bio::PhyloNetwork::muVector
 
165
 
 
166
This function is also overloaded to the - operator.
 
167
 
 
168
=cut
 
169
 
 
170
sub substract {
 
171
  my ($v1,$v2)=@_;
 
172
 
 
173
  $v1->throw("Vectors not the same size") unless ($v1->{dim} == $v2->{dim});
 
174
  my $dim=$v1->{dim};
 
175
  my @sum=();
 
176
  for (my $i=0; $i<$dim; $i++) {
 
177
    $sum[$i]=$v1->{arr}->[$i]-$v2->{arr}->[$i];
 
178
  }
 
179
  my $result=Bio::PhyloNetwork::muVector->new(\@sum);
 
180
  return $result;
 
181
}
 
182
 
 
183
=head2 scalarproduct
 
184
 
 
185
 Title   : scalarproduct
 
186
 Usage   : $mu->scalarproduct($ct)
 
187
 Function: returns the scalar product of $ct and $mu
 
188
 Returns : Bio::PhyloNetwork::muVector
 
189
 Args    : scalar
 
190
 
 
191
This function is also overloaded to the * operator.
 
192
 
 
193
=cut
 
194
 
 
195
sub scalarproduct {
 
196
  my ($v1,$num,$swapped)=@_;
 
197
 
 
198
  my $dim=$v1->{dim};
 
199
  my @sum=();
 
200
  for (my $i=0; $i<$dim; $i++) {
 
201
    $sum[$i]=$num*$v1->{arr}->[$i];
 
202
  }
 
203
  my $result=Bio::PhyloNetwork::muVector->new(\@sum);
 
204
  return $result;
 
205
  return $result;
 
206
}
 
207
 
 
208
=head2 comparelex
 
209
 
 
210
 Title   : comparelex
 
211
 Usage   : $mu1->comparelex($mu2)
 
212
 Function: compares $mu and $mu2 w.r.t. the lexicographic ordering
 
213
 Returns : scalar (-1 if $mu1<$mu2, 0 if $mu1=$mu2, 1 if $mu1>$mu2)
 
214
 Args    : Bio::PhyloNetwork::muVector
 
215
 
 
216
This function is also overloaded to the E<lt>=E<gt> and cmp operator.
 
217
 
 
218
=cut
 
219
 
 
220
sub comparelex {
 
221
  my ($v1,$v2)=@_;
 
222
 
 
223
  $v1->throw("Vectors not the same size") unless ($v1->{dim} == $v2->{dim});
 
224
  my $dim=$v1->{dim};
 
225
  for (my $i=0; $i<$dim; $i++) {
 
226
    return -1 if $v1->{arr}->[$i] < $v2->{arr}->[$i];
 
227
    return 1 if $v1->{arr}->[$i] > $v2->{arr}->[$i];
 
228
  }
 
229
  return 0;
 
230
}
 
231
 
 
232
=head2 geq_poset
 
233
 
 
234
 Title   : geq_poset
 
235
 Usage   : $mu1->geq_poset($mu2)
 
236
 Function: compares $mu and $mu2 w.r.t. the natural partial ordering
 
237
 Returns : boolean (1 if $mu >= $mu2, 0 otherwise)
 
238
 Args    : Bio::PhyloNetwork::muVector
 
239
 
 
240
=cut
 
241
 
 
242
sub geq_poset {
 
243
  my ($v1,$v2)=@_;
 
244
 
 
245
  $v1->throw("Vectors not the same size") unless ($v1->{dim} == $v2->{dim});
 
246
  my $dim=$v1->{dim};
 
247
  for (my $i=0; $i<$dim; $i++) {
 
248
    return 0 unless $v1->[$i] >= $v2->[$i];
 
249
  }
 
250
  return 1;
 
251
}
 
252
 
 
253
=head2 is_positive
 
254
 
 
255
 Title   : is_positive
 
256
 Usage   : $mu->is_positive()
 
257
 Function: tests if all components of $mu are positive (or zero)
 
258
 Returns : boolean
 
259
 Args    : none
 
260
 
 
261
=cut
 
262
 
 
263
sub is_positive {
 
264
  my ($v1)=@_;
 
265
 
 
266
  my $dim=$v1->{dim};
 
267
  for (my $i=0; $i<$dim; $i++) {
 
268
    return 0 unless $v1->[$i] >= 0;
 
269
  }
 
270
  return 1;
 
271
}
 
272
 
 
273
=head2 hamming
 
274
 
 
275
 Title   : hamming
 
276
 Usage   : $mu1->hamming($mu2)
 
277
 Function: returns the Hamming distance between $mu1 and $mu2
 
278
 Returns : scalar
 
279
 Args    : Bio::PhyloNetwork::muVector
 
280
 
 
281
=cut
 
282
 
 
283
sub hamming {
 
284
  my ($v1,$v2)=@_;
 
285
 
 
286
  $v1->throw("Vectors not the same size") unless ($v1->{dim} == $v2->{dim});
 
287
  my $dim=$v1->{dim};
 
288
  my $w=0;
 
289
  for (my $i=0; $i<$dim; $i++) {
 
290
    $w++ unless $v1->[$i] == $v2->[$i];
 
291
  }
 
292
  return $w;
 
293
}
 
294
 
 
295
=head2 manhattan
 
296
 
 
297
 Title   : manhattan
 
298
 Usage   : $mu1->manhattan($mu2)
 
299
 Function: returns the Manhattan distance between $mu1 and $mu2
 
300
 Returns : scalar
 
301
 Args    : Bio::PhyloNetwork::muVector
 
302
 
 
303
=cut
 
304
 
 
305
sub manhattan {
 
306
  my ($v1,$v2)=@_;
 
307
 
 
308
  $v1->throw("Vectors not the same size") unless ($v1->{dim} == $v2->{dim});
 
309
  my $dim=$v1->{dim};
 
310
  my $w=0;
 
311
  for (my $i=0; $i<$dim; $i++) {
 
312
    $w+= abs($v1->[$i] - $v2->[$i]);
 
313
  }
 
314
  return $w;
 
315
}
 
316
 
 
317
1;