Rosetta Code

Geometric algebra: Difference between revisions

Page Discussion

Geometric algebra (view source)

Revision as of 17:57, 30 April 2016

464 bytes removed ,  8 years ago
→‎{{header|Perl 6}}: modernize
(→‎{{header|Perl 6}}: rephrasing + minor fix in the verification code)
Line 505:
 
=={{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;
subset UIntHash of MixHash where .keys.all ~~ UInt;
has RealUIntHash %$.blades{UInt};
method clean { for %!blades { %!blades{.key} :delete unless .value; } }
method narrow { $!blades.keys.any > 0 ?? self !! ($!blades{0} // 0) }
for %!blades { return self if .key > 0 && .value !== 0; }
return %!blades{0} // 0;
}▼
 
submulti emethod new(UIntReal $n?x) returns MultiVector is{ exportself.new: {(0 => $x).MixHash }
multi method new(UIntHash $n.definedblades) ??returns MultiVector { self.new(: :$blades(my Real %{UInt} = (1 +< $n) => 1)) !! MultiVector.new
}
 
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 return= map { MultiVector.new: :%blades"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) is cached {
return $n +& 1 ?? -1 !! 1;▼
(state @)[$i][$j] //= do {
▲ my $n = 0;
▲ repeat {
▲ $i +>= 1;
▲ $n += [+] ($i +& $j).basepolymod(2 xx *).comb;
▲ } until $i == 0;
▲ return $n +& 1 ?? -1 !! 1;
}▼
}
 
multi infix:<+>(MultiVector $A, MultiVector $B) returns MultiVector is export {
myreturn RealMultiVector.new: %($A.blades{UInt} =.pairs, |$AB.blades.clonepairs).MixHash;
for $B.blades {
%blades{.key} += .value;
%blades{.key} :delete unless %blades{.key};
▲ }
▲ return MultiVector.new: :%blades;
}
multi infix:<+>(Real $s, MultiVector $AB) returns MultiVector is export {
myreturn RealMultiVector.new: %blades{UInt}(0 => $As, |$B.blades.clonepairs).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, 1 0) returns MultiVector is export { $A0 }▼
multi infix:<*>(MultiVector $A, Real $s1) returns MultiVector is export { $A }▼
multi infix:<*>(MultiVector $A, Real 0$s) returns MultiVector is export { MultiVector.new }▼
MultiVector.new: $A.blades.pairs.map({Pair.new: .key, $s*.value}).MixHash
▲}
multi infix:<*>(MultiVector $A, MultiVector $B) returns MultiVector is export {
myMultiVector.new: Realdo %for $A.blades -> $a {UInt};
|do for $AB.blades -> $ab {
for ($Ba.bladeskey ->+^ $b.key) => {[*]
my $c = $a.key +^value, $b.key;value,
%blades{$c} += $a.value * $b.value * 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 }
Line 559 ⟶ 565:
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) }
Line 589 ⟶ 590:
for ^5 X ^5 -> ($i, $j) {
my $s = $i == $j ?? 1 !! 0;
ok @e([$i)] cdot @e([$j)] == $s, "e$i cdot e$j = $s";
}
sub random {
[+] map {
MultiVector.new:
:blades(my Real %{UInt} = ($_ => rand.round(.01)).MixHash)
}, ^32;
}
Line 604 ⟶ 605:
ok ($a + $b)*$c == $a*$c + $b*$c, 'right distributivity';
my @coeff = (.5 - rand) xx 5;
my $v = [+] @coeff Z* map &@e, [^5];
ok ($v**2).narrow ~~ Real, 'contraction';</langpre>
{{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>
Grondilu
1,934

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/262362"