view release on metacpan or  search on metacpan

lib/CayleyDickson.pm  view on Meta::CPAN

      $cs = $o;
      $d  =  0;
      $ds =  0;
   }

   my $p;
   my $dp = $m->doubling_product;

   if    ($dp eq 'P0' ) { $p = (ref $m)->new($c * $a + $ii * $bs * $d , $d  * $as + $b  * $c ) }
   elsif ($dp eq 'P1' ) { $p = (ref $m)->new($c * $a + $ii * $d  * $bs, $as * $d  + $c  * $b ) }
   elsif ($dp eq 'P2' ) { $p = (ref $m)->new($a * $c + $ii * $bs * $d , $d  * $as + $b  * $c ) } # <= special twist pattern?
   elsif ($dp eq 'P3' ) { $p = (ref $m)->new($a * $c + $ii * $d  * $bs, $as * $d  + $c  * $b ) }
   elsif ($dp eq 'Pt0') { $p = (ref $m)->new($c * $a + $ii * $b  * $ds, $a  * $d  + $cs * $b ) } # <= default
   elsif ($dp eq 'Pt1') { $p = (ref $m)->new($c * $a + $ii * $ds * $b , $d  * $a  + $b  * $cs) }
   elsif ($dp eq 'Pt2') { $p = (ref $m)->new($a * $c + $ii * $b  * $ds, $a  * $d  + $cs * $b ) }
   elsif ($dp eq 'Pt3') { $p = (ref $m)->new($a * $c + $ii * $ds * $b , $d  * $a  + $b  * $cs) } # <= default for REAL?

   printf("Calculated: (%s) x (%s) = (%s)\n", ($swap ? ($o, $m) : ($m, $o)), $p) if DEBUG;
   $p
}



# 
# Tensor: $a->tensor($b) = A⊗ B = (a,b)⊗ (c,d) = (ac,ad,bc,bd)
#

sub tensor {
   my ( $m, $o ) = @_;

   my @pair;
   if ($m->is_complex) {
      @pair = ($m->a * $o, $m->b * $o)
   }
   else {
      @pair = ($m->a->tensor($o), $m->b->tensor($o))
   }
   (ref $m)->new(@pair)
}



#
# Creates a new CayleyDickson object
#   expects a list of two (powers of 2) numbers or objects ...
#

sub new {
   my $class    = shift;
   my @values   = @_;
   my $elements = scalar @values;
   my @pair;
   if ($elements > 2) {
      @pair = ( ($class->new( @values[0           .. $elements/2 - 1] )) ,
                ($class->new( @values[$elements/2 .. $elements   - 1] )) )
   }
   else {
      @pair = ( $values[0] ,
	        $values[1] )
   }
   bless [ $class->prepare(@pair) ] => $class;
}



#
# allows subclassing to modify the object pair just prior to creating the object.
#

sub prepare { shift; @_ }



#
# hold the left number/object in a and the right number/object in b.
#

sub a { ${(shift)}[0] }
sub b { ${(shift)}[1] }



#
# flat: list of the scalar values pointed to by a,b references in the object references in order ...
#

sub flat {
   my $m = shift;
   $m->is_complex ? ($m->a, $m->b) : ($m->a->flat, $m->b->flat)
}


# 
# print the beautiful objects in terse human format ...
#

sub as_string {
   my $m = shift;

   my $string = '';
   my $i = 0;

   my @flat = $m->flat;
   foreach my $t (@flat) {
      if ($t) {
         my ($sign, $value, $unit) = ('','','');
         if ($t < 0) {
            $sign = '-';
         }
         elsif (length $string) {
            $sign = '+';
         }
	 unless (abs($t) == 1 and $i) {
	 #if (abs($t) !=1 or not $i) {
	    $value = abs($t);
	 }
	 $unit = ${ SYMBOLS() }[$i];
	 $string .= sprintf '%s%s%s', $sign, $value, $unit;
      }
      $i ++
   }