Geometric algebra: Difference between revisions

Content added Content deleted
(→‎{{header|Raku}}: modernize)
Line 2,073: Line 2,073:
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.
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;
<syntaxhighlight lang="raku" line>class MultiVector is Mix {
subset UIntHash of MixHash where .keys.all ~~ UInt;
subset Vector of ::?CLASS is export where *.grades.all == 1;
has UIntHash $.blades;
method narrow { $!blades.keys.any > 0 ?? self !! ($!blades{0} // 0) }


multi method new(Real $x) returns MultiVector { self.new: (0 => $x).MixHash }
method narrow { self.keys.any > 0 ?? self !! (self{0} // 0) }
multi method new(UIntHash $blades) returns MultiVector { self.new: :$blades }
method grades { self.keys.map: *.base(2).comb.sum }


multi method new(Str $ where /^^e(\d+)$$/) { self.new: (1 +< (2*$0)).MixHash }
multi method new(Real $x) returns ::?CLASS { self.new-from-pairs: 0 => $x }
multi method new(Str $ where /^^ē(\d+)$$/) { self.new: (1 +< (2*$0 + 1)).MixHash }
multi method new(Str $ where /^^e(\d+)$$/) { self.new-from-pairs: (1 +< (2*$0)) => 1 }


our @e is export = map { MultiVector.new: "e$_" }, ^Inf;
our @e is export = map { ::?CLASS.new: "e$_" }, ^Inf;
our @ē is export = map { MultiVector.new: "ē$_" }, ^Inf;


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


multi infix:<+>(MultiVector $A, MultiVector $B) returns MultiVector is export {
multi infix:<+>(::?CLASS $A, ::?CLASS $B) returns ::?CLASS is export {
return MultiVector.new: ($A.blades.pairs, |$B.blades.pairs).MixHash;
return ::?CLASS.new-from-pairs: |$A.pairs, |$B.pairs;
}
}
multi infix:<+>(Real $s, MultiVector $B) returns MultiVector is export {
multi infix:<+>(Real $s, ::?CLASS $B) returns ::?CLASS is export {
return MultiVector.new: (0 => $s, |$B.blades.pairs).MixHash;
samewith $B.new($s), $B
}
}
multi infix:<+>(MultiVector $A, Real $s) returns MultiVector is export { $s + $A }
multi infix:<+>(::?CLASS $A, Real $s) returns ::?CLASS is export {
samewith $s, $A
}


multi infix:<*>(MultiVector $, 0) is export { 0 }
multi infix:<*>(::?CLASS $, 0) is export { 0 }
multi infix:<*>(MultiVector $A, 1) returns MultiVector is export { $A }
multi infix:<*>(::?CLASS $A, 1) returns ::?CLASS is export { $A }
multi infix:<*>(MultiVector $A, Real $s) returns MultiVector is export {
multi infix:<*>(::?CLASS $A, Real $s) returns ::?CLASS is export {
MultiVector.new: $A.blades.pairs.map({Pair.new: .key, $s*.value}).MixHash
::?CLASS.new-from-pairs: $A.pairs.map({Pair.new: .key, $s*.value})
}
}
multi infix:<*>(MultiVector $A, MultiVector $B) returns MultiVector is export {
multi infix:<*>(::?CLASS $A, ::?CLASS $B) returns ::?CLASS is export {
::?CLASS.new-from-pairs: gather
MultiVector.new: do for $A.blades -> $a {
|do for $B.blades -> $b {
for $A.pairs -> $a {
($a.key +^ $b.key) => [*]
for $B.pairs -> $b {
take ($a.key +^ $b.key) => [*]
$a.value, $b.value,
$a.value, $b.value,
order($a.key, $b.key),
order($a.key, $b.key),
Line 2,122: Line 2,122:
)
)
}
}
}.MixHash
}
}
}
multi infix:<**>(MultiVector $ , 0) returns MultiVector is export { MultiVector.new }
multi infix:<**>(::?CLASS $ , 0) returns ::?CLASS is export { ::?CLASS.new: (0 => 1).Mix }
multi infix:<**>(MultiVector $A, 1) returns MultiVector is export { $A }
multi infix:<**>(::?CLASS $A, 1) returns ::?CLASS is export { $A }
multi infix:<**>(MultiVector $A, 2) returns MultiVector is export { $A * $A }
multi infix:<**>(::?CLASS $A, 2) returns ::?CLASS is export { $A * $A }
multi infix:<**>(MultiVector $A, UInt $n where $n %% 2) returns MultiVector is export { ($A ** ($n div 2)) ** 2 }
multi infix:<**>(::?CLASS $A, UInt $n where $n %% 2) returns ::?CLASS 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:<**>(::?CLASS $A, UInt $n) returns ::?CLASS is export { $A * ($A ** ($n div 2)) ** 2 }

⚫
multi infix:<*>(Real $s, ::?CLASS $A) returns ::?CLASS is export { $A * $s }
⚫
multi infix:</>(::?CLASS $A, Real $s) returns ::?CLASS is export { $A * (1/$s) }
⚫
multi prefix:<->(::?CLASS $A) returns ::?CLASS is export { return -1 * $A }
⚫
multi infix:<->(::?CLASS $A, ::?CLASS $B) returns ::?CLASS is export { $A + -$B }
⚫
multi infix:<->(::?CLASS $A, Real $s) returns ::?CLASS is export { $A + -$s }
multi infix:<->(Real $s, ::?CLASS $A) returns ::?CLASS is export { $s + -$A }


multi infix:<*>(Real $s, MultiVector $A) returns MultiVector is export { $A * $s }
multi infix:<==>(::?CLASS $A, 0) returns Bool is export { $A.elems == 0 }
multi infix:</>(MultiVector $A, Real $s) returns MultiVector is export { $A * (1/$s) }
multi infix:<==>(::?CLASS $A, ::?CLASS $B) returns Bool is export { samewith $A - $B, 0 }
multi prefix:<->(MultiVector $A) returns MultiVector is export { return -1 * $A }
multi infix:<==>(Real $x, ::?CLASS $A) returns Bool is export { samewith $A, $x }
multi infix:<->(MultiVector $A, MultiVector $B) returns MultiVector is export { $A + -$B }
multi infix:<==>(::?CLASS $A, Real $x) returns Bool is export { samewith $A, $A.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 }


⚫
sub random is export {
⚫
multi infix:<==>(MultiVector $A, MultiVector $B) returns Bool is export { $A - $B == 0 }
⚫
[+] map {
⚫
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;
}
}


Line 2,148: Line 2,153:
#########################################
#########################################


⚫
import MultiVector;
use Test;
use Test;
constant N = 10;
plan 29;
plan 5;
sub infix:<cdot>($x, $y) { ($x*$y + $y*$x)/2 }
sub infix:<·>(Vector $x, Vector $y) { ($x*$y + $y*$x)/2 }
subtest "Orthonormality", {
for ^5 X ^5 -> ($i, $j) {
for ^N X ^N -> ($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]·@e[$j] == $s, "e$i·e$j = $s";
}
}
⚫
sub random {
⚫
[+] map {
⚫
MultiVector.new:
:blades(($_ => rand.round(.01)).MixHash)
}, ^32;
}
}
Line 2,172: Line 2,175:
my @coeff = (.5 - rand) xx 5;
my @coeff = (.5 - rand) xx 5;
my $v = [+] @coeff Z* @e[^5];
my $v = [+] @coeff Z* @e[^5];
ok ($v**2).narrow ~~ Real, 'contraction';</syntaxhighlight>
ok ($v**2).narrow ~~ Real, 'contraction';
</syntaxhighlight>


=={{header|Visual Basic .NET}}==
=={{header|Visual Basic .NET}}==
Retrieved from "https://rosettacode.org/wiki/Geometric_algebra"