Geometric algebra: Difference between revisions
(→{{header|Perl 6}}: simplify by assuming an euclidean metric) |
(→{{header|Perl 6}}: compactify a bit by removing a few returns) |
||
Line 63: | Line 63: | ||
return MultiVector.new: :%blades; |
return MultiVector.new: :%blades; |
||
} |
} |
||
multi infix:<**>(MultiVector $ , 0) returns MultiVector is export { |
multi infix:<**>(MultiVector $ , 0) returns MultiVector is export { MultiVector.new } |
||
multi infix:<**>(MultiVector $A, 1) returns MultiVector is export { |
multi infix:<**>(MultiVector $A, 1) returns MultiVector is export { $A } |
||
multi infix:<**>(MultiVector $A, 2) returns MultiVector is export { |
multi infix:<**>(MultiVector $A, 2) returns MultiVector is export { $A * $A } |
||
multi infix:<**>(MultiVector $A, UInt $n where $n %% 2) returns MultiVector is export { |
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 $A, UInt $n) returns MultiVector is export { |
|||
return $A * ($A ** ($n div 2)) ** 2; |
|||
} |
|||
multi infix:<*>(MultiVector $, 0) returns MultiVector is export { MultiVector.new } |
multi infix:<*>(MultiVector $, 0) returns MultiVector is export { MultiVector.new } |
Revision as of 00:25, 14 October 2015
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 for a vector space of countable, yet infinite dimension. You'll then pick three random elements of this algebra, along with a random vector, and verify that the axioms are respected.
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>
The code required to test the axioms is the following:
<lang perl6>use MultiVector; use Test;
plan 4;
sub random {
[+] map { MultiVector.new: :blades(my Real %{UInt} = $_ => rand.round(.01)) }, (^32).pick(5);
}
my ($a, $b, $c) = random() xx 3;
ok ($a*$b)*$c == $a*($b*$c), 'associativity'; 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>
- Output:
1..4 ok 1 - associativity ok 2 - left distributivity ok 3 - right distributivity ok 4 - contraction