|
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.
<syntaxhighlight lang="raku" line>unit class MultiVector; is Mix {
subset UIntHashVector of MixHash::?CLASS is export where *.keysgrades.all ~~== UInt1;
has UIntHash $.blades;
method narrow { $!blades.keys.any > 0 ?? self !! ($!blades{0} // 0) }
multi method new(Realnarrow $x){ returnsself.keys.any MultiVector> {0 ?? self.new: !! (self{0} =>// $x0).MixHash }
multi method new(UIntHash $blades) returns MultiVectorgrades { self.newkeys.map: :$blades*.base(2).comb.sum }
multi method new(StrReal $x) wherereturns /^^e(\d+)$$/)::?CLASS { self.new-from-pairs: (10 +<=> (2*$0)).MixHashx }
multi method new(Str $ where /^^ēe(\d+)$$/) { self.new-from-pairs: (1 +< (2*$0)) +=> 1)).MixHash }
our @e is export = map { MultiVector::?CLASS.new: "e$_" }, ^Inf;
our @ē is export = map { MultiVector.new: "ē$_" }, ^Inf;
my sub order(UInt:D $i is copy, UInt:D $j) {
(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::?CLASS $A, MultiVector::?CLASS $B) returns MultiVector::?CLASS is export {
return MultiVector::?CLASS.new-from-pairs: (|$A.blades.pairs, |$B.blades.pairs).MixHash;
}
multi infix:<+>(Real $s, MultiVector::?CLASS $B) returns MultiVector::?CLASS is export {
returnsamewith MultiVector$B.new: (0 => $s), |$B.blades.pairs).MixHash;
}
multi infix:<+>(MultiVector::?CLASS $A, Real $s) returns MultiVector::?CLASS is export { $s + $A }
samewith $s, $A
}
multi infix:<*>(MultiVector::?CLASS $, 0) is export { 0 }
multi infix:<*>(MultiVector::?CLASS $A, 1) returns MultiVector::?CLASS is export { $A }
multi infix:<*>(MultiVector::?CLASS $A, Real $s) returns MultiVector::?CLASS is export {
MultiVector::?CLASS.new-from-pairs: $A.blades.pairs.map({Pair.new: .key, $s*.value}).MixHash
}
multi infix:<*>(MultiVector::?CLASS $A, MultiVector::?CLASS $B) returns MultiVector::?CLASS is export {
::?CLASS.new-from-pairs: gather
MultiVector.new: do for $A.blades -> $a {
|do for $BA.bladespairs -> $ba {
for ($aB.keypairs +^-> $b.key) => [*]{
take ($a.key +^ $b.key) => [*]
$a.value, $b.value,
order($a.key, $b.key),
)
}
}.MixHash
}
multi infix:<**>(MultiVector::?CLASS $ , 0) returns MultiVector::?CLASS is export { MultiVector::?CLASS.new: (0 => 1).Mix }
multi infix:<**>(MultiVector::?CLASS $A, 1) returns MultiVector::?CLASS is export { $A }
multi infix:<**>(MultiVector::?CLASS $A, 2) returns MultiVector::?CLASS is export { $A * $A }
multi infix:<**>(MultiVector::?CLASS $A, UInt $n where $n %% 2) returns MultiVector::?CLASS is export { ($A ** ($n div 2)) ** 2 }
multi infix:<**>(MultiVector::?CLASS $A, UInt $n) returns MultiVector::?CLASS is export { $A * ($A ** ($n div 2)) ** 2 }
multi infix:< ==*>(Real $ xs, MultiVector::?CLASS $A) returns Bool::?CLASS is export { $A ==* $ xs } ▼
multi infix:< -/>( MultiVector::?CLASS $A, Real $s) returns MultiVector::?CLASS is export { $A +* -(1/$s ) } ▼
multi infixprefix:<->( Real $s, MultiVector::?CLASS $A) returns MultiVector::?CLASS is export { $s +return - 1 * $A } ▼
multi infix:< ==->( MultiVector::?CLASS $A, MultiVector::?CLASS $B) returns Bool::?CLASS is export { $A -+ -$B == 0 } ▼
multi infix:< ==->( MultiVector::?CLASS $A, Real $ xs) returns Bool::?CLASS is export { $A + -$s }▼
multi infix:<->(Real $s, ::?CLASS $A) returns ::?CLASS is export { $s + -$A }
multi infix:<*==>(Real::?CLASS $sA, MultiVector $A0) returns MultiVectorBool is export { $A.elems *== $s0 }
multi infix:</==>(MultiVector::?CLASS $A, Real::?CLASS $sB) returns MultiVectorBool is export { samewith $A *- (1/$s)B, 0 }
multi prefixinfix:<-==>(MultiVectorReal $x, ::?CLASS $A) returns MultiVectorBool is export { return -1 *samewith $A, $x }
multi infix:<-==>(MultiVector::?CLASS $A, MultiVectorReal $Bx) returns MultiVectorBool is export { samewith $A, + -$BA.new($x); }
▲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 }
::?CLASS.new-from-pairs: $_ => rand.round(.01)
▲multi infix:<==>(MultiVector $A, Real $x) returns Bool is export {
my $narrowed =}, $A.narrow^32;
}
$narrowed ~~ Real and $narrowed == $x;
}
#########################################
import MultiVector .new:;▼use Test;
constant N = 10;
plan 295;
sub infix:<cdot·>(Vector $x, Vector $y) { ($x*$y + $y*$x)/2 }
subtest "Orthonormality", {
for ^5N X ^5N -> ($i, $j) {
my $s = $i == $j ?? 1 !! 0;
ok @e[$i] cdot ·@e[$j] == $s, "e$i cdot ·e$j = $s";
}
:blades(($_ => rand.round(.01)).MixHash)
}, ^32;
}
my @coeff = (.5 - rand) xx 5;
my $v = [+] @coeff Z* @e[^5];
ok ($v**2).narrow ~~ Real, 'contraction';</syntaxhighlight>
</syntaxhighlight>
=={{header|Visual Basic .NET}}==
|