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