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