Geometric algebra: Difference between revisions

Content added Content deleted
(→‎{{header|Perl 6}}: rephrasing + minor fix in the verification code)
Line 505: Line 505:


=={{header|Perl 6}}==
=={{header|Perl 6}}==

Here we write a simplified version of the [https://github.com/grondilu/clifford Clifford] module. It is very general as it is of infinite dimension and also contains an anti-euclidean basis @ē in addition to the euclidean basis @e.


<lang perl6>unit class MultiVector;
<lang perl6>unit class MultiVector;
subset UIntHash of MixHash where .keys.all ~~ UInt;
has Real %.blades{UInt};
has UIntHash $.blades;
method clean { for %!blades { %!blades{.key} :delete unless .value; } }
method narrow {
method narrow { $!blades.keys.any > 0 ?? self !! ($!blades{0} // 0) }
for %!blades { return self if .key > 0 && .value !== 0; }
return %!blades{0} // 0;
⚫
}


sub e(UInt $n?) returns MultiVector is export {
multi method new(Real $x) returns MultiVector { self.new: (0 => $x).MixHash }
$n.defined ?? MultiVector.new(:blades(my Real %{UInt} = (1 +< $n) => 1)) !! MultiVector.new
multi method new(UIntHash $blades) returns MultiVector { self.new: :$blades }
}


multi method new(Str $ where /^^e(\d+)$$/) { self.new: (1 +< (2*$0)).MixHash }
⚫
my sub order(UInt:D $i is copy, UInt:D $j) is cached {
multi method new(Str $ where /^^ē(\d+)$$/) { self.new: (1 +< (2*$0 + 1)).MixHash }
⚫
my $n = 0;

⚫
repeat {
⚫
our @e is export = map { MultiVector.new: "e$_" }, ^Inf;
⚫
$i +>= 1;
our @ē is export = map { MultiVector.new: "ē$_" }, ^Inf;
⚫
$n += [+] ($i +& $j).base(2).comb;

⚫
} until $i == 0;
⚫
my sub order(UInt:D $i is copy, UInt:D $j) {
⚫
return $n +& 1 ?? -1 !! 1;
(state @)[$i][$j] //= do {
⚫
my $n = 0;
⚫
repeat {
⚫
$i +>= 1;
⚫
$n += [+] ($i +& $j).polymod(2 xx *);
⚫
} until $i == 0;
⚫
$n +& 1 ?? -1 !! 1;
⚫
}
}
}


multi infix:<+>(MultiVector $A, MultiVector $B) returns MultiVector is export {
multi infix:<+>(MultiVector $A, MultiVector $B) returns MultiVector is export {
my Real %blades{UInt} = $A.blades.clone;
return MultiVector.new: ($A.blades.pairs, |$B.blades.pairs).MixHash;
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 {
multi infix:<+>(Real $s, MultiVector $B) returns MultiVector is export {
my Real %blades{UInt} = $A.blades.clone;
return MultiVector.new: (0 => $s, |$B.blades.pairs).MixHash;
%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, Real $s) returns MultiVector is export { $s + $A }

⚫
multi infix:<*>(MultiVector $, 0) is export { 0 }
⚫
multi infix:<*>(MultiVector $A, 1) returns MultiVector is export { $A }
⚫
multi infix:<*>(MultiVector $A, Real $s) returns MultiVector is export {
MultiVector.new: $A.blades.pairs.map({Pair.new: .key, $s*.value}).MixHash
⚫
}
multi infix:<*>(MultiVector $A, MultiVector $B) returns MultiVector is export {
multi infix:<*>(MultiVector $A, MultiVector $B) returns MultiVector is export {
my Real %blades{UInt};
MultiVector.new: do for $A.blades -> $a {
for $A.blades -> $a {
|do for $B.blades -> $b {
for $B.blades -> $b {
($a.key +^ $b.key) => [*]
my $c = $a.key +^ $b.key;
$a.value, $b.value,
%blades{$c} += $a.value * $b.value * order($a.key, $b.key);
order($a.key, $b.key),
|grep +*, (
%blades{$c} :delete unless %blades{$c};
|(1, -1) xx * Z*
($a.key +& $b.key).polymod(2 xx *)
)
}
}
}
}.MixHash
return MultiVector.new: :%blades;
}
}
multi infix:<**>(MultiVector $ , 0) returns MultiVector is export { MultiVector.new }
multi infix:<**>(MultiVector $ , 0) returns MultiVector is export { MultiVector.new }
Line 559: Line 565:
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 { $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:<*>(Real $s, MultiVector $A) returns MultiVector is export { $A * $s }
multi infix:</>(MultiVector $A, Real $s) returns MultiVector is export { $A * (1/$s) }
multi infix:</>(MultiVector $A, Real $s) returns MultiVector is export { $A * (1/$s) }
Line 589: Line 590:
for ^5 X ^5 -> ($i, $j) {
for ^5 X ^5 -> ($i, $j) {
my $s = $i == $j ?? 1 !! 0;
my $s = $i == $j ?? 1 !! 0;
ok e($i) cdot e($j) == $s, "e$i cdot e$j = $s";
ok @e[$i] cdot @e[$j] == $s, "e$i cdot e$j = $s";
}
}
sub random {
sub random {
[+] map {
[+] map {
MultiVector.new:
MultiVector.new:
:blades(my Real %{UInt} = $_ => rand.round(.01))
:blades(($_ => rand.round(.01)).MixHash)
}, ^32;
}, ^32;
}
}
Line 604: Line 605:
ok ($a + $b)*$c == $a*$c + $b*$c, 'right distributivity';
ok ($a + $b)*$c == $a*$c + $b*$c, 'right distributivity';
my @coeff = (.5 - rand) xx 5;
my @coeff = (.5 - rand) xx 5;
my $v = [+] @coeff Z* map &e, ^5;
my $v = [+] @coeff Z* @e[^5];
ok ($v**2).narrow ~~ Real, 'contraction';</lang>
ok ($v**2).narrow ~~ Real, 'contraction';</pre>
{{out}}
<pre>1..29
ok 1 - e0 cdot e0 = 1
ok 2 - e0 cdot e1 = 0
ok 3 - e0 cdot e2 = 0
ok 4 - e0 cdot e3 = 0
ok 5 - e0 cdot e4 = 0
ok 6 - e1 cdot e0 = 0
ok 7 - e1 cdot e1 = 1
ok 8 - e1 cdot e2 = 0
ok 9 - e1 cdot e3 = 0
ok 10 - e1 cdot e4 = 0
ok 11 - e2 cdot e0 = 0
ok 12 - e2 cdot e1 = 0
ok 13 - e2 cdot e2 = 1
ok 14 - e2 cdot e3 = 0
ok 15 - e2 cdot e4 = 0
ok 16 - e3 cdot e0 = 0
ok 17 - e3 cdot e1 = 0
ok 18 - e3 cdot e2 = 0
ok 19 - e3 cdot e3 = 1
ok 20 - e3 cdot e4 = 0
ok 21 - e4 cdot e0 = 0
ok 22 - e4 cdot e1 = 0
ok 23 - e4 cdot e2 = 0
ok 24 - e4 cdot e3 = 0
ok 25 - e4 cdot e4 = 1
ok 26 - associativity
ok 27 - left distributivity
ok 28 - right distributivity
ok 29 - contraction</pre>
Retrieved from "https://rosettacode.org/wiki/Geometric_algebra"