Geometric algebra: Difference between revisions
Content added Content deleted
m (→{{header|javascript}}: expand code) |
(→{{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> |
<syntaxhighlight lang="raku" line>class MultiVector is Mix { |
||
subset |
subset Vector of ::?CLASS is export where *.grades.all == 1; |
||
has UIntHash $.blades; |
|||
method narrow { $!blades.keys.any > 0 ?? self !! ($!blades{0} // 0) } |
|||
method narrow { self.keys.any > 0 ?? self !! (self{0} // 0) } |
|||
method grades { self.keys.map: *.base(2).comb.sum } |
|||
multi method new( |
multi method new(Real $x) returns ::?CLASS { self.new-from-pairs: 0 => $x } |
||
multi method new(Str $ where /^^ |
multi method new(Str $ where /^^e(\d+)$$/) { self.new-from-pairs: (1 +< (2*$0)) => 1 } |
||
our @e is export = map { |
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; |
|||
repeat { |
|||
$i +>= 1; |
|||
$n += [+] ($i +& $j).polymod(2 xx *); |
|||
} until $i == 0; |
|||
$n +& 1 ?? -1 !! 1; |
|||
} |
} |
||
} |
} |
||
multi infix:<+>( |
multi infix:<+>(::?CLASS $A, ::?CLASS $B) returns ::?CLASS is export { |
||
return |
return ::?CLASS.new-from-pairs: |$A.pairs, |$B.pairs; |
||
} |
} |
||
multi infix:<+>(Real $s, |
multi infix:<+>(Real $s, ::?CLASS $B) returns ::?CLASS is export { |
||
samewith $B.new($s), $B |
|||
} |
} |
||
multi infix:<+>( |
multi infix:<+>(::?CLASS $A, Real $s) returns ::?CLASS is export { |
||
samewith $s, $A |
|||
} |
|||
multi infix:<*>( |
multi infix:<*>(::?CLASS $, 0) is export { 0 } |
||
multi infix:<*>( |
multi infix:<*>(::?CLASS $A, 1) returns ::?CLASS is export { $A } |
||
multi infix:<*>( |
multi infix:<*>(::?CLASS $A, Real $s) returns ::?CLASS is export { |
||
::?CLASS.new-from-pairs: $A.pairs.map({Pair.new: .key, $s*.value}) |
|||
} |
} |
||
multi infix:<*>( |
multi infix:<*>(::?CLASS $A, ::?CLASS $B) returns ::?CLASS is export { |
||
::?CLASS.new-from-pairs: gather |
|||
MultiVector.new: do for $A.blades -> $a { |
|||
for $A.pairs -> $a { |
|||
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: | ||
) |
) |
||
} |
} |
||
} |
} |
||
} |
} |
||
multi infix:<**>( |
multi infix:<**>(::?CLASS $ , 0) returns ::?CLASS is export { ::?CLASS.new: (0 => 1).Mix } |
||
multi infix:<**>( |
multi infix:<**>(::?CLASS $A, 1) returns ::?CLASS is export { $A } |
||
multi infix:<**>( |
multi infix:<**>(::?CLASS $A, 2) returns ::?CLASS is export { $A * $A } |
||
multi infix:<**>( |
multi infix:<**>(::?CLASS $A, UInt $n where $n %% 2) returns ::?CLASS is export { ($A ** ($n div 2)) ** 2 } |
||
multi infix:<**>( |
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 { $s + -$A } |
|||
multi infix:< |
multi infix:<==>(::?CLASS $A, 0) returns Bool is export { $A.elems == 0 } |
||
multi infix:< |
multi infix:<==>(::?CLASS $A, ::?CLASS $B) returns Bool is export { samewith $A - $B, 0 } |
||
multi |
multi infix:<==>(Real $x, ::?CLASS $A) returns Bool is export { samewith $A, $x } |
||
multi infix:< |
multi infix:<==>(::?CLASS $A, Real $x) returns Bool is export { samewith $A, $A.new($x); } |
||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
::?CLASS.new-from-pairs: $_ => rand.round(.01) |
|||
⚫ | |||
}, ^32; |
|||
} |
|||
$narrowed ~~ Real and $narrowed == $x; |
|||
} |
} |
||
Line 2,148: | Line 2,153: | ||
######################################### |
######################################### |
||
⚫ | |||
use Test; |
use Test; |
||
constant N = 10; |
|||
plan |
plan 5; |
||
sub infix:< |
sub infix:<·>(Vector $x, Vector $y) { ($x*$y + $y*$x)/2 } |
||
subtest "Orthonormality", { |
|||
for ^ |
for ^N X ^N -> ($i, $j) { |
||
my $s = $i == $j ?? 1 !! 0; |
my $s = $i == $j ?? 1 !! 0; |
||
ok @e[$i] |
ok @e[$i]·@e[$j] == $s, "e$i·e$j = $s"; |
||
} |
} |
||
⚫ | |||
⚫ | |||
⚫ | |||
: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'; |
ok ($v**2).narrow ~~ Real, 'contraction'; |
||
</syntaxhighlight> |
|||
=={{header|Visual Basic .NET}}== |
=={{header|Visual Basic .NET}}== |