Bio/PhyloNetwork/muVector.pm

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