Geometric algebra: Difference between revisions

From Rosetta Code
Content added Content deleted
(rephrasing)
(proposing implementing quaternions for demonstrating the task)
Line 11: Line 11:
</math>
</math>


The purpose of this task is to implement such an algebra with vectors of arbitrary size. You'll then pick three random elements of this algebra, along with a random vector, and verify that the axioms are respected.
The purpose of this task is to implement such an algebra with vectors of arbitrary size.

To demonstrate your solution, you will use it to implement [[Quaternion type|quaternions]].
From an orthonormal basis <math>(\mathbf{i},\mathbf{j},\mathbf{k})</math>, create the three elements:
:<math>\begin{array}{c}
I = \mathbf{ij}\\
J = \mathbf{jk}\\
K = \mathbf{ik}
\end{array}</math>

and show that <math>I^2 = J^2 = J^2 = IJK = -1</math>.


=={{header|Perl 6}}==
=={{header|Perl 6}}==
Line 88: Line 98:
}</lang>
}</lang>


An here is the code implementing and verifying quaternions:
The code required to test the axioms is the following:


<lang perl6>use MultiVector;
<lang perl6>use MultiVector;
use Test;
use Test;


plan 4;
plan 1;

sub random {
[+] map {
MultiVector.new:
:blades(my Real %{UInt} = $_ => rand.round(.01))
}, (^32).pick(5);
}


my ($a, $b, $c) = random() xx 3;
my constant i = e(1)*e(2);
my constant j = e(2)*e(3);
my constant k = e(1)*e(3);


ok ($a*$b)*$c == $a*($b*$c), 'associativity';
ok i**2 == j**2 == k**2 == i*j*k == -1;</lang>
ok $a*($b + $c) == $a*$b + $a*$c, 'left distributivity';
ok ($a + $b)*$c == $a*$c + $b*$c, 'right distributivity';
my @coeff = (.5 - rand) xx 4;
my $v = [+] @coeff Z* map &e, ^4;
ok ($v**2).narrow ~~ Real, 'contraction';</lang>
{{out}}
{{out}}
<pre>1..4
<pre>1..1
ok 1 - associativity
ok 1 -</pre>
ok 2 - left distributivity
ok 3 - right distributivity
ok 4 - contraction</pre>

Revision as of 09:51, 17 October 2015

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.

To demonstrate your solution, you will use it to implement quaternions. From an orthonormal basis , create the three elements:

and show that Failed to parse (Conversion error. Server ("https://wikimedia.org/api/rest_") reported: "Cannot get mml. upstream connect error or disconnect/reset before headers. reset reason: connection termination"): {\displaystyle I^{2}=J^{2}=J^{2}=IJK=-1} .

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 grade(UInt $n) is cached { [+] $n.base(2).comb } 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>

An here is the code implementing and verifying quaternions:

<lang perl6>use MultiVector; use Test;

plan 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;</lang>

Output:
1..1
ok 1 -