lib/Language/Befunge/Vector.pm

   1 #
   2 # This file is part of Language::Befunge.
   3 # Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8 #
   9
  10 package Language::Befunge::Vector;
  11
  12 use strict;
  13 use warnings;
  14 use integer;
  15 use Carp;
  16
  17 use overload
  18         '-'   => \&vector_subtract,
  19         'neg' => \&vector_invert,
  20         '+'   => \&vector_add,
  21         '+='  => \&vector_add_inplace,
  22         '='   => \&vector_copy,
  23         '=='  => \&vector_equality,
  24         '!='  => \&vector_inequality,
  25         '""'  => \&vector_as_string;
  26
  27
  28 # -- CONSTRUCTORS
  29
  30 #
  31 # my $v = LB::Vector->new( $x [, $y, ...] );
  32 #
  33 # Create a new vector. The arguments are the actual vector data; one
  34 # integer per dimension.
  35 #
  36 sub new {
  37         my $pkg = shift;
  38
  39     # sanity checks
  40         my $usage = "Usage: $pkg->new(\$x, ...)";
  41         croak $usage unless scalar(@_) > 0;
  42
  43     # regular LBV object
  44     my $self = [@_];
  45     bless $self, $pkg;
  46         return $self;
  47 }
  48
  49
  50 #
  51 # new_zeroes( dimensions )
  52 #
  53 # Creates a new vector, set to the origin (all zeroes).  ->new_zeroes(2) is
  54 #exactly equivalent to ->new(0, 0).
  55 #
  56 sub new_zeroes {
  57         my $package = shift;
  58         my $dimensions = shift;
  59         my $usage = "Usage: $package->new_zeroes(\$dimensions)";
  60         croak $usage unless defined $dimensions;
  61         croak $usage unless $dimensions > 0;
  62     my @initial;
  63     push(@initial,0) for(1..$dimensions);
  64         return bless([@initial], $package);
  65 }
  66
  67
  68 # -- PUBLIC METHODS
  69
  70 #- accessors
  71
  72 #
  73 # my $dims = $vec->get_dims;
  74 #
  75 # Return the number of dimensions, an integer.
  76 #
  77 sub get_dims {
  78         my $self = shift;
  79         return scalar(@$self);
  80 }
  81
  82
  83 #
  84 # my $val = $vec->get_component($dim);
  85 #
  86 # Get the value for dimension $dim.
  87 #
  88 sub get_component {
  89     my ($self, $dim) = @_;
  90     croak "No such dimension $dim!" unless $dim >= 0 && $self->get_dims > $dim;
  91     return $self->[$dim];
  92 }
  93
  94
  95 # - mutators
  96
  97 #
  98 # $vec->set_component($dim, $value);
  99 #
 100 # Set the value for dimension $dim to $value.
 101 #
 102 sub set_component {
 103     my ($self, $dim, $val) = @_;
 104     croak "No such dimension $dim!" unless $dim >= 0 && $self->get_dims > $dim;
 105     $self->[$dim] = $val;
 106 }
 107
 108
 109 #- math ops
 110
 111 #
 112 # vector_subtract( v2 )
 113 #
 114 #     $v0 = $v1->vector_subtract($v2);
 115 #     $v0 = $v1 - $v2;
 116 #
 117 # Returns a new Vector object, which is the result of v1 minus v2.
 118 #
 119 sub vector_subtract {
 120         my ($v1, $v2) = @_;
 121         croak "uneven dimensions in vector subtraction!" unless $v1->get_dims == $v2->get_dims;
 122         my $vr = ref($v1)->new_zeroes($v1->get_dims);
 123         for(my $i = 0; $i < $v1->get_dims; $i++) {
 124                 $vr->[$i] = $v1->[$i] - $v2->[$i];
 125         }
 126         return $vr;
 127 }
 128
 129
 130 #
 131 # vector_invert( )
 132 #
 133 #     $v1->vector_invert();
 134 #     $v2 = -$v1;
 135 #
 136 # Subtracts v1 from the origin. Effectively, gives the inverse of the
 137 # original vector.  The new vector is the same distance from the origin,
 138 #in the opposite direction.
 139 #
 140 sub vector_invert {
 141         my ($v1) = @_;
 142         my $rv = ref($v1)->new_zeroes($v1->get_dims);
 143         for(my $i = 0; $i < $v1->get_dims; $i++) {
 144                 $rv->[$i] = -$v1->[$i];
 145         }
 146         return $rv;
 147 }
 148
 149
 150 #
 151 # vector_add( v2 )
 152 #
 153 #     $v0 = $v1->vector_add($v2);
 154 #     $v0 = $v1 + $v2;
 155 #
 156 # Returns a new Vector object, which is the result of v1 plus v2.
 157 #
 158 sub vector_add {
 159         my ($v1, $v2) = @_;
 160         croak "uneven dimensions in vector addition!" unless $v1->get_dims == $v2->get_dims;
 161         my $rv = ref($v1)->new_zeroes($v1->get_dims);
 162         for(my $i = 0; $i < $v1->get_dims; $i++) {
 163                 $rv->[$i] = $v1->[$i] + $v2->[$i];
 164         }
 165         return $rv;
 166 }
 167
 168
 169 #
 170 # vector_add_inplace( v2 )
 171 #
 172 #      $v1->vector_add_inplace($v2);
 173 #      $v1 += $v2;
 174 #
 175 # Adds v2 to v1, and stores the result back into v1.
 176 #
 177 sub vector_add_inplace {
 178         my ($v1, $v2) = @_;
 179         croak "uneven dimensions in vector addition!" unless $v1->get_dims == $v2->get_dims;
 180         for(my $i = 0; $i < $v1->get_dims; $i++) {
 181                 $v1->[$i] += $v2->[$i];
 182         }
 183         return $v1;
 184 }
 185
 186
 187 #
 188 # vector_copy( )
 189 #
 190 #     $v0 = $v1->vector_copy();
 191 #     $v0 = $v1;
 192 #
 193 # Returns a new Vector object, which has the same dimensions and coordinates as v1.
 194 #
 195 sub vector_copy {
 196         my $v = shift;
 197         return bless [@$v], ref $v;
 198 }
 199
 200
 201 #
 202 # get_all_components( )
 203 #
 204 #     my $v = Language::Befunge::Vector->new(1, 2, 3);
 205 #     # $v now holds a 3-dimensional vector, <1,2,3>
 206 #     my @list = $v->get_all_components(); # returns (1, 2, 3)
 207 #
 208 # Gets the value for all dimensions, in order from 0..N.
 209 #
 210 sub get_all_components {
 211         my ($self) = @_;
 212         return @$self;
 213 }
 214
 215
 216 #
 217 # zero( )
 218 #
 219 # Sets the vector back to the origin, all 0's. See also the constructor,
 220 # new_from_origin, above.
 221 #
 222 sub zero {
 223         my ($self) = @_;
 224     @$self = (0) x $self->get_dims;
 225 }
 226
 227
 228 #
 229 # bounds_check( begin, end )
 230 #
 231 #     die "out of bounds"
 232 #         unless $vector->bounds_check($begin, $end);
 233 #
 234 # Checks whether the given vector is within the box defined by begin and end.
 235 # Returns 1 if vector is contained within the box, and 0 otherwise.
 236 #
 237 sub bounds_check {
 238         my ($vchk, $begin, $end) = @_;
 239         croak "uneven dimensions in bounds check!" unless $vchk->get_dims == $begin->get_dims;
 240         croak "uneven dimensions in bounds check!" unless $vchk->get_dims == $end->get_dims;
 241         for(my $d = 0; $d < $vchk->get_dims; $d++) {
 242                 return 0 if $vchk->get_component($d) < $begin->get_component($d);
 243                 return 0 if $vchk->get_component($d) >   $end->get_component($d);
 244         }
 245         return 1;
 246 }
 247
 248
 249 #
 250 # vector_as_string( )
 251 #
 252 # Returns the stringified form of the vector.  For instance, a Befunge vector might look like "(1,2)".
 253 #
 254 sub vector_as_string {
 255         my $self = shift;
 256         return "(" . join(",",@$self) . ")";
 257 }
 258
 259
 260 #
 261 # vector_equality( v2 )
 262 #
 263 #     print("Equal!\n") if $v1->vector_equality($v2);
 264 #     print("Equal!\n") if $v1 == $v2;
 265 #
 266 # Checks whether the vectors both point at the same spot. Returns 1 if they
 267 # do, 0 if they don't.
 268 #
 269 sub vector_equality {
 270         my ($v1, $v2) = @_;
 271         croak "uneven dimensions in bounds check!" unless $v1->get_dims == $v2->get_dims;
 272         for(my $d = 0; $d < $v1->get_dims; $d++) {
 273                 return 0 unless $v1->get_component($d) == $v2->get_component($d);
 274         }
 275         return 1;
 276 }
 277
 278
 279 #
 280 # vector_inequality( v2 )
 281 #
 282 #     print("Equal!\n") unless $v1->vector_inequality($v2);
 283 #     print("Equal!\n") unless $v1 != $v2;
 284 #
 285 # Checks whether the vectors point to different spots. Returns 1 if they
 286 # don't, 0 if they do.  Compare vector_equality, above.
 287 #
 288 sub vector_inequality {
 289         return !vector_equality(@_);
 290 }
 291
 292 1;
 293 __END__
 294
 295 =head1 NAME
 296
 297 Language::Befunge::Vector - an opaque, N-dimensional vector class.
 298
 299
 300 =head1 SYNOPSIS
 301
 302     my $v1 = Language::Befunge::Vector->new($d, $x, $y, ...);
 303     my $v2 = Language::Befunge::Vector->new_zeroes($d);
 304
 305 =head1 DESCRIPTION
 306
 307 This class abstracts normal vector manipulation.  It lets you pass
 308 around one argument to your functions, rather than N arguments, one
 309 per dimension.  This means much of your code doesn't have to care
 310 how many dimensions you're working with.
 311
 312 You can do vector arithmetic, test for equality, or even stringify
 313 the vector to a string like I<"(1,2,3)">.
 314
 315
 316 =head1 CONSTRUCTORS
 317
 318 =head2 new( dimensions, x, [y, ...] )
 319
 320 Creates a new vector.  The first argument is an integer specifying
 321 how many dimensions this vector operates in.  The remaining arguments
 322 constitute the actual vector data; one integer per dimension.
 323
 324
 325 =head2 new_zeroes( dimensions )
 326
 327 Creates a new vector, set to the origin (all zeroes).
 328 ->B<new_zeroes>(2) is exactly equivalent to ->B<new>(2, 0, 0).
 329
 330
 331 =head1 PUBLIC METHODS
 332
 333 =head2 get_dims(  )
 334
 335 Returns the number of dimensions, an integer.
 336
 337
 338 =head2 vector_subtract( v2 )
 339
 340     $v0 = $v1->vector_subtract($v2);
 341     $v0 = $v1 - $v2;
 342
 343 Returns a new Vector object, which is the result of I<v1> minus I<v2>.
 344
 345
 346 =head2 vector_invert( )
 347
 348     $v1->vector_invert();
 349     $v2 = -$v1;
 350
 351 Subtracts I<v1> from the origin.  Effectively, gives the inverse of
 352 the original vector.  The new vector is the same distance from the
 353 origin, in the opposite direction.
 354
 355
 356 =head2 vector_add( v2 )
 357
 358     $v0 = $v1->vector_add($v2);
 359     $v0 = $v1 + $v2;
 360
 361 Returns a new Vector object, which is the result of I<v1> plus I<v2>.
 362
 363
 364 =head2 vector_add_inplace( v2 )
 365
 366     $v1->vector_add_inplace($v2);
 367     $v1 += $v2;
 368
 369 Adds I<v2> to I<v1>, and stores the result back into I<v1>.
 370
 371
 372 =head2 vector_copy( )
 373
 374     $v0 = $v1->vector_copy();
 375     $v0 = $v1;
 376
 377 Returns a new Vector object, which has the same dimensions and
 378 coordinates as I<v1>.
 379
 380
 381 =head2 set_component( dimension, data )
 382
 383     $v->set_component(0, 1); # set X to 1
 384
 385 Sets the value for dimension I<dimension> to the value I<data>.
 386
 387
 388 =head2 get_component( dimension )
 389
 390     my $x = $v->get_component(0);
 391
 392 Gets the value for dimension I<dimension>.
 393
 394
 395 =head2 get_all_components( )
 396
 397     my $v = Language::Befunge::Vector->new(3, 1, 2, 3);
 398     # $v now holds a 3-dimensional vector, <1,2,3>
 399     my @list = $v->get_all_components(); # returns (1, 2, 3)
 400
 401 Gets the value for all dimensions, in order from 0..N.
 402
 403
 404 =head2 zero( )
 405
 406 Sets the vector back to the origin, all 0's.  See also the
 407 constructor, B<new_from_origin>, above.
 408
 409
 410 =head2 bounds_check( begin, end )
 411
 412     die "out of bounds"
 413         unless $vector->bounds_check($begin, $end);
 414
 415 Checks whether the given I<vector> is within the box defined by
 416 I<begin> and I<end>.  Returns I<1> if I<vector> is contained within
 417 the box, and I<0> otherwise.
 418
 419
 420 =head2 vector_as_string( )
 421
 422 Returns the stringified form of the vector.  For instance, a Befunge
 423 vector might look like I<"(1,2)">.
 424
 425
 426 =head2 vector_equality( v2 )
 427
 428     print("Equal!\n") if $v1->vector_equality($v2);
 429     print("Equal!\n") if $v1 == $v2;
 430
 431 Checks whether the vectors both point at the same spot.  Returns
 432 I<1> if they do, I<0> if they don't.
 433
 434
 435 =head2 vector_inequality( v2 )
 436
 437     print("Equal!\n") unless $v1->vector_inequality($v2);
 438     print("Equal!\n") unless $v1 != $v2;
 439
 440 Checks whether the vectors point to different spots.  Returns
 441 I<1> if they don't, I<0> if they do.  Compare B<vector_equality>,
 442 above.
 443
 444
 445
 446 =head1 SEE ALSO
 447
 448 L<Language::Befunge>
 449
 450
 451 =head1 AUTHOR
 452
 453 Jerome Quelin, E<lt>jquelin@cpan.orgE<gt>
 454
 455 Development is discussed on E<lt>language-befunge@mongueurs.netE<gt>
 456
 457
 458 =head1 COPYRIGHT & LICENSE
 459
 460 Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
 461
 462 This program is free software; you can redistribute it and/or modify
 463 it under the same terms as Perl itself.
 464
 465
 466 =cut
 467