branch-1-6/Bio/PhyloNetwork/muVector.pm

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