Geometric algebra

From Rosetta Code
Revision as of 21:28, 17 October 2015 by Grondilu (talk | contribs) (→‎{{header|Perl 6}}: don't need the grade method for this task)
Geometric algebra is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Geometric algebra is an other name for Clifford algebras and it's basically an algebra containing a vector space and obeying the following axioms:

The purpose of this task is to implement such an algebra with vectors of arbitrary size, or up to 32 dimensions if that's easier to implement in your language.

To demonstrate your solution, you will use it to implement quaternions:

  • define a scalar product function as the symmetric part of the geometric product
  • define a function which allows for creation of an orthonormal basis

,

  • verify the orthonormality for i, j, k in .
  • define the following three constants:
  • verify that

JavaScript

<lang javascript>var CGA = function () {

   function e(n) {

var result = []; result[1 << n] = 1; return result;

   }
   function neg(x) { return multiply([-1], x) }
   function bitCount(i) {

// Note that unsigned shifting (>>>) is not required. i = i - ((i >> 1) & 0x55555555); i = (i & 0x33333333) + ((i >> 2) & 0x33333333); i = (i + (i >> 4)) & 0x0F0F0F0F; i = i + (i >> 8); i = i + (i >> 16); return i & 0x0000003F;

   }
   function reorderingSign(a, b) {

a >>= 1; var sum = 0; while (a != 0) { sum += bitCount(a & b); a >>= 1; } return (sum & 1) == 0 ? 1 : -1;

   }
   function add(a, b) {

var result = []; for (var i = 0; i < 32; i++) { if (a[i] && b[i]) { var r = a[i] + b[i]; if (r !== 0) { result[i] = r; } } else if (a[i]) { result[i] = a[i]; } else if (b[i]) { result[i] = b[i]; } } return result;

   }
   function multiply(a, b)
   {

var result = []; for (var i = 0; i < 32; i++) { if (a[i]) { for (var j = 0; j < 32; j++) { if (b[j]) { var s = reorderingSign(i, j) * a[i] * b[j]; // if (i == 1 && j == 1) { s *= -1 } // e0*e0 == -1 var k = i ^ j; if (result[k]) { result[k] += s; } else { result[k] = s; } } } } } return result;

   }
   return {

e  : e, neg : neg, add : add, mul : multiply

   };

}(); </lang>

And then, from the console:

<lang javascript>var e = CGA.e; function cdot(a, b) { return CGA.mul([0.5], CGA.add(CGA.mul(a, b), CGA.mul(b, a))) }

console.log(cdot(e(1), e(1))); // [1] console.log(cdot(e(2), e(2))); // [1] console.log(cdot(e(3), e(3))); // [1]

console.log(cdot(e(1), e(2))); // [] which means 0 console.log(cdot(e(1), e(3))); // [] console.log(cdot(e(2), e(3))); // []

var i = CGA.mul(e(1), e(2)); var j = CGA.mul(e(2), e(3)); var k = CGA.mul(e(1), e(3));

console.log(CGA.mul(i, i)); // [-1] console.log(CGA.mul(j, j)); // [-1] console.log(CGA.mul(k, k)); // [-1] console.log(CGA.mul(CGA.mul(i, j), k)); // [-1] </lang>

J

This example is incorrect. Please fix the code and remove this message.
Details: The task description explicitly states that the purpose of implementing quaternions is to demonstrate the implementation of the geometric algebra. Using an existing implementation of quaternions defeats that purpose.

Note: I believe the task description is currently broken. See talk page. It will not be possible to have a consistent implementation until the task's description of quaternions matches that of Clifford algebra.

Using the implementation from the Quaternion type task:

<lang J> e=: {&(#:2^3 A. i.4)

  dot=: +/ .*
  0 1 2 3 dot&e"0/0 1 2 3

1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1

  i=: (e 1) mul (e 2)
  j=: (e 2) mul (e 3)
  k=: (e 1) mul (e 3)
  i

0 1 0 0

  j

0 0 1 0

  k

0 0 0 1

  i mul j mul k

_1 0 0 0

  i mul i

_1 0 0 0

  j mul j

_1 0 0 0

  k mul k

_1 0 0 0</lang>

Note that the first element of this quaternion data structure is the "real" component.

Perl 6

<lang perl6>unit class MultiVector; has Real %.blades{UInt}; method clean { for %!blades { %!blades{.key} :delete unless .value; } } method narrow {

   for %!blades { return self if .key > 0 && .value !== 0; }
   return %!blades{0} // 0;

}

sub e(UInt $n?) returns MultiVector is export {

   $n.defined ?? MultiVector.new(:blades(my Real %{UInt} = (1 +< $n) => 1)) !! MultiVector.new

}

my sub order(UInt:D $i is copy, UInt:D $j) is cached {

   my $n = 0;
   repeat {

$i +>= 1; $n += [+] ($i +& $j).base(2).comb;

   } until $i == 0;
   return $n +& 1 ?? -1 !! 1;

}

multi infix:<+>(MultiVector $A, MultiVector $B) returns MultiVector is export {

   my Real %blades{UInt} = $A.blades.clone;
   for $B.blades {

%blades{.key} += .value; %blades{.key} :delete unless %blades{.key};

   }
   return MultiVector.new: :%blades;

} multi infix:<+>(Real $s, MultiVector $A) returns MultiVector is export {

   my Real %blades{UInt} = $A.blades.clone;
   %blades{0} += $s;
   %blades{0} :delete unless %blades{0};
   return MultiVector.new: :%blades;

} multi infix:<+>(MultiVector $A, Real $s) returns MultiVector is export { $s + $A } multi infix:<*>(MultiVector $A, MultiVector $B) returns MultiVector is export {

   my Real %blades{UInt};
   for $A.blades -> $a {

for $B.blades -> $b { my $c = $a.key +^ $b.key; %blades{$c} += $a.value * $b.value * order($a.key, $b.key); %blades{$c} :delete unless %blades{$c}; }

   }
   return MultiVector.new: :%blades;

} multi infix:<**>(MultiVector $ , 0) returns MultiVector is export { MultiVector.new } multi infix:<**>(MultiVector $A, 1) returns MultiVector is export { $A } multi infix:<**>(MultiVector $A, 2) returns MultiVector is export { $A * $A } multi infix:<**>(MultiVector $A, UInt $n where $n %% 2) returns MultiVector is export { ($A ** ($n div 2)) ** 2 } multi infix:<**>(MultiVector $A, UInt $n) returns MultiVector is export { $A * ($A ** ($n div 2)) ** 2 }

multi infix:<*>(MultiVector $, 0) returns MultiVector is export { MultiVector.new } multi infix:<*>(MultiVector $A, 1) returns MultiVector is export { $A } multi infix:<*>(MultiVector $A, Real $s) returns MultiVector is export {

   return MultiVector.new: :blades(my Real %{UInt} = map { .key => $s * .value }, $A.blades);

} multi infix:<*>(Real $s, MultiVector $A) returns MultiVector is export { $A * $s } multi infix:</>(MultiVector $A, Real $s) returns MultiVector is export { $A * (1/$s) } multi prefix:<->(MultiVector $A) returns MultiVector is export { return -1 * $A } multi infix:<->(MultiVector $A, MultiVector $B) returns MultiVector is export { $A + -$B } multi infix:<->(MultiVector $A, Real $s) returns MultiVector is export { $A + -$s } multi infix:<->(Real $s, MultiVector $A) returns MultiVector is export { $s + -$A }

multi infix:<==>(MultiVector $A, MultiVector $B) returns Bool is export { $A - $B == 0 } multi infix:<==>(Real $x, MultiVector $A) returns Bool is export { $A == $x } multi infix:<==>(MultiVector $A, Real $x) returns Bool is export {

   my $narrowed = $A.narrow;
   $narrowed ~~ Real and $narrowed == $x;

}</lang>

And here is the code implementing and verifying quaternions:

<lang perl6>use MultiVector; use Test;

plan 7;

sub infix:<cdot>($a, $b) { ($a*$b + $b*$a) / 2 }

ok e(1) cdot e(1) == 1, "e1.e1 = 1"; ok e(1) cdot e(2) == 0, "e1.e2 = 0"; ok e(1) cdot e(3) == 0, "e1.e3 = 0"; ok e(2) cdot e(2) == 1, "e2.e2 = 1"; ok e(2) cdot e(3) == 0, "e2.e3 = 0"; ok e(3) cdot e(3) == 1, "e3.e3 = 1";

my constant i = e(1)*e(2); my constant j = e(2)*e(3); my constant k = e(1)*e(3);

ok i**2 == j**2 == k**2 == i*j*k == -1, "i² = j² = k² = ijk = -1";</lang>

Output:
1..7
ok 1 - e1.e1 = 1
ok 2 - e1.e2 = 0
ok 3 - e1.e3 = 0
ok 4 - e2.e2 = 1
ok 5 - e2.e3 = 0
ok 6 - e3.e3 = 1
ok 7 - i² = j² = k² = ijk = -1