Rosetta Code

Geometric algebra: Difference between revisions

Page Discussion

Geometric algebra (view source)

Revision as of 19:53, 7 March 2024

2,797 bytes added ,  2 months ago
Added FreeBASIC
(Added FreeBASIC)
 
(3 intermediate revisions by 2 users not shown)
Line 820:
<br> <b>e</b>1<b>e</b>2<b>e</b>3 * <b>e</b>2<b>e</b>3 = - <b>e</b>1
<br> <b>e</b>1<b>e</b>2<b>e</b>3 * <b>e</b>1<b>e</b>2<b>e</b>3 = - <b>1</b>
 
=={{header|FreeBASIC}}==
{{trans|Wren}}
<syntaxhighlight lang="vbnet">Type Vector
dims(31) As Single
End Type
 
Function bitCount(i As Integer) As Integer
i = i - ((i Shr 1) And &h55555555)
i = (i And &h33333333) + ((i Shr 2) And &h33333333)
i = (i + (i Shr 4)) And &h0f0f0f0f
i = i + (i Shr 8)
i = i + (i Shr 16)
Return i And &h0000003F
End Function
 
Function ReorderingSign(i As Integer, j As Integer) As Integer
Dim As Integer k = i Shr 1
Dim As Integer sum = 0
While (k <> 0)
sum += bitCount(k And j)
k Shr= 1
Wend
Return Iif((sum And 1) = 0, 1, -1)
End Function
 
Function dot(lhs As Vector, rhs As Vector) As Vector
Dim result As Vector
For i As Integer = 0 To 31
result.dims(i) = 0.5 * (lhs.dims(i) * rhs.dims(i) + rhs.dims(i) * lhs.dims(i))
Next i
Return result
End Function
 
Function addition(lhs As Vector, rhs As Vector) As Vector
Dim result As Vector
For i As Integer = 0 To 31
result.dims(i) = lhs.dims(i) + rhs.dims(i)
Next i
Return result
End Function
 
Function multiply(lhs As Vector, rhs As Vector) As Vector
Dim result As Vector
Dim As Single s
Dim As Integer i, j, k
For i = 0 To 31
If lhs.dims(i) <> 0 Then
For j = 0 To 31
If rhs.dims(j) <> 0 Then
s = ReorderingSign(i, j) * lhs.dims(i) * rhs.dims(j)
k = i Xor j
result.dims(k) += s
End If
Next j
End If
Next i
Return result
End Function
 
Function multiplyScalar(lhs As Vector, rhs As Single) As Vector
Dim result As Vector
For i As Integer = 0 To 31
result.dims(i) = lhs.dims(i) * rhs
Next i
Return result
End Function
 
Function e(n As Integer) As Vector
If n > 4 Then Print "n must be less than 5": End
Dim result As Vector
result.dims(1 Shl n) = 1
Return result
End Function
 
Function randomVector() As Vector
Dim result As Vector
For i As Integer = 0 To 4
result = addition(result, multiplyScalar(e(i), Rnd))
Next i
Return result
End Function
 
Function randomMultiVector() As Vector
Dim result As Vector
For i As Integer = 0 To 31
result.dims(i) = Rnd
Next i
Return result
End Function
 
Randomize Timer
Dim a As Vector = randomMultiVector()
Dim b As Vector = randomMultiVector()
Dim c As Vector = randomMultiVector()
Dim x As Vector = randomVector()
 
' (ab)c == a(bc)
Print (multiply(multiply(a, b), c).dims(0))
Print (multiply(a, multiply(b, c)).dims(0))
Print
 
' a(b+c) == ab + ac
Print (multiply(a, addition(b, c)).dims(0))
Print (addition(multiply(a, b), multiply(a, c)).dims(0))
Print
 
' (a+b)c == ac + bc
Print (multiply(addition(a, b), c).dims(0))
Print (addition(multiply(a, c), multiply(b, c)).dims(0))
Print
 
' x^2 is real
Print (multiply(x, x).dims(0))
 
Sleep</syntaxhighlight>
 
=={{header|Go}}==
Line 2,073 ⟶ 2,189:
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 sub infix:<+·>(MultiVectorVector $Ax, MultiVectorVector $By) returns MultiVectorReal is export { (($x*$y + $y*$x)/2){0} }
return MultiVector.new: ($A.blades.pairs, |$B.blades.pairs).MixHash;
multi infix:<+>(::?CLASS $A, ::?CLASS $B) returns ::?CLASS is export {
}
return ::?CLASS.new-from-pairs: |$A.pairs, |$B.pairs;
multi infix:<+>(Real $s, MultiVector $B) returns MultiVector is export {
}
return MultiVector.new: (0 => $s, |$B.blades.pairs).MixHash;
multi infix:<+>(Real $s, ::?CLASS $B) returns ::?CLASS is export {
}
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::?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),
Line 2,122 ⟶ 2,240:
)
}
}.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 $s, MultiVector::?CLASS $A) returns MultiVector::?CLASS is export { $A * $s }
multi infix:</>(MultiVector::?CLASS $A, Real $s) returns MultiVector::?CLASS is export { $A * (1/$s) }
multi prefix:<->(MultiVector::?CLASS $A) returns MultiVector::?CLASS is export { return -1 * $A }
multi infix:<->(MultiVector::?CLASS $A, MultiVector::?CLASS $B) returns MultiVector::?CLASS is export { $A + -$B }
multi infix:<->(MultiVector::?CLASS $A, Real $s) returns MultiVector::?CLASS is export { $A + -$s }
multi infix:<->(Real $s, MultiVector::?CLASS $A) returns MultiVector::?CLASS is export { $s + -$A }
 
multi infix:<==>(MultiVector::?CLASS $A, MultiVector $B0) returns Bool is export { $A - $B.elems == 0 }
multi infix:<==>(Real::?CLASS $xA, MultiVector::?CLASS $AB) returns Bool is export { samewith $A ==- $xB, 0 }
multi infix:<==>(MultiVectorReal $Ax, Real::?CLASS $xA) returns Bool is export { samewith $A, $x }
multi infix:<==>(::?CLASS $A, Real $x) returns Bool is export { samewith $A, $A.new($x); }
my $narrowed = $A.narrow;
 
$narrowed ~~ Real and $narrowed == $x;
sub random is export {
[+] map {
::?CLASS.new-from-pairs: $_ => rand.round(.01)
}, ^32;
}
}
 
Line 2,148 ⟶ 2,271:
#########################################
 
import MultiVector;
use Test;
constant N = 10;
plan 29;
plan 5;
subtest "Orthonormality", {
sub infix:<cdot>($x, $y) { ($x*$y + $y*$x)/2 }
for ^N X ^N -> ($i, $j) {
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(($_ => rand.round(.01)).MixHash)
}, ^32;
}
Line 2,382 ⟶ 2,501:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">import "random" for Random
 
var bitCount = Fn.new { |i|
Jjuanhdez
2,130

edits

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