vector-friendlier math.quaternions

db4
Joe Groff 2010-02-02 00:30:21 -08:00
parent 1ee05e38fb
commit 8cf05e9909
3 changed files with 51 additions and 71 deletions

View File

@ -4,17 +4,17 @@ IN: math.quaternions
HELP: q+
{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u+v" "a quaternion" } }
{ $description "Add quaternions." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q+ ." "{ C{ 0 1 } 1 }" } } ;
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 1 0 0 } { 0 0 1 0 } q+ ." "{ 0 1 1 0 }" } } ;
HELP: q-
{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u-v" "a quaternion" } }
{ $description "Subtract quaternions." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q- ." "{ C{ 0 1 } -1 }" } } ;
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 1 0 0 } { 0 0 1 0 } q- ." "{ 0 1 -1 0 }" } } ;
HELP: q*
{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u*v" "a quaternion" } }
{ $description "Multiply quaternions." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q* ." "{ 0 C{ 0 1 } }" } } ;
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 1 0 0 } { 0 0 1 0 } q* ." "{ 0 0 0 1 }" } } ;
HELP: qconjugate
{ $values { "u" "a quaternion" } { "u'" "a quaternion" } }
@ -27,28 +27,17 @@ HELP: qrecip
HELP: q/
{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u/v" "a quaternion" } }
{ $description "Divide quaternions." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 C{ 0 1 } } { 0 1 } q/ ." "{ C{ 0 1 } 0 }" } } ;
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 0 0 1 } { 0 0 1 0 } q/ ." "{ 0 1 0 0 }" } } ;
HELP: q*n
{ $values { "q" "a quaternion" } { "n" number } { "q" "a quaternion" } }
{ $description "Multiplies each element of " { $snippet "q" } " by " { $snippet "n" } "." }
{ $notes "You will get the wrong result if you try to multiply a quaternion by a complex number on the right using " { $link v*n } ". Use this word instead."
$nl "Note that " { $link v*n } " with a quaternion and a real is okay." } ;
{ $values { "q" "a quaternion" } { "n" real } { "q" "a quaternion" } }
{ $description "Multiplies each element of " { $snippet "q" } " by real value " { $snippet "n" } "." }
{ $notes "To multiply a quaternion with a complex value, use " { $link c>q } " " { $link q* } "." } ;
HELP: c>q
{ $values { "c" number } { "q" "a quaternion" } }
{ $description "Turn a complex number into a quaternion." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "C{ 0 1 } c>q ." "{ C{ 0 1 } 0 }" } } ;
HELP: v>q
{ $values { "v" vector } { "q" "a quaternion" } }
{ $description "Turn a 3-vector into a quaternion with real part 0." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 1 0 0 } v>q ." "{ C{ 0 1 } 0 }" } } ;
HELP: q>v
{ $values { "q" "a quaternion" } { "v" vector } }
{ $description "Get the vector part of a quaternion, discarding the real part." }
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } q>v ." "{ 1 0 0 }" } } ;
{ $examples { $example "USING: math.quaternions prettyprint ;" "C{ 0 1 } c>q ." "{ 0 1 0 0 }" } } ;
HELP: euler
{ $values { "phi" number } { "theta" number } { "psi" number } { "q" "a quaternion" } }

View File

@ -2,6 +2,12 @@ IN: math.quaternions.tests
USING: tools.test math.quaternions kernel math.vectors
math.constants ;
CONSTANT: q0 { 0 0 0 0 }
CONSTANT: q1 { 1 0 0 0 }
CONSTANT: qi { 0 1 0 0 }
CONSTANT: qj { 0 0 1 0 }
CONSTANT: qk { 0 0 0 1 }
[ 1.0 ] [ qi norm ] unit-test
[ 1.0 ] [ qj norm ] unit-test
[ 1.0 ] [ qk norm ] unit-test
@ -10,18 +16,13 @@ math.constants ;
[ t ] [ qi qj q* qk = ] unit-test
[ t ] [ qj qk q* qi = ] unit-test
[ t ] [ qk qi q* qj = ] unit-test
[ t ] [ qi qi q* q1 v+ q0 = ] unit-test
[ t ] [ qj qj q* q1 v+ q0 = ] unit-test
[ t ] [ qk qk q* q1 v+ q0 = ] unit-test
[ t ] [ qi qj qk q* q* q1 v+ q0 = ] unit-test
[ t ] [ C{ 0 1 } qj n*v qk = ] unit-test
[ t ] [ qj C{ 0 1 } q*n qk v+ q0 = ] unit-test
[ t ] [ qi qi q* q1 q+ q0 = ] unit-test
[ t ] [ qj qj q* q1 q+ q0 = ] unit-test
[ t ] [ qk qk q* q1 q+ q0 = ] unit-test
[ t ] [ qi qj qk q* q* q1 q+ q0 = ] unit-test
[ t ] [ qk qj q/ qi = ] unit-test
[ t ] [ qi qk q/ qj = ] unit-test
[ t ] [ qj qi q/ qk = ] unit-test
[ t ] [ qi q>v v>q qi = ] unit-test
[ t ] [ qj q>v v>q qj = ] unit-test
[ t ] [ qk q>v v>q qk = ] unit-test
[ t ] [ 1 c>q q1 = ] unit-test
[ t ] [ C{ 0 1 } c>q qi = ] unit-test
[ t ] [ qi qi q+ qi 2 q*n = ] unit-test

View File

@ -1,72 +1,62 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.functions math.vectors sequences ;
USING: arrays combinators kernel math math.functions math.libm math.vectors sequences ;
IN: math.quaternions
! Everybody's favorite non-commutative skew field, the quaternions!
! Quaternions are represented as pairs of complex numbers, using the
! identity: (a+bi)+(c+di)j = a+bi+cj+dk.
<PRIVATE
: ** ( x y -- z ) conjugate * ; inline
: 2q ( u v -- u' u'' v' v'' ) [ first2 ] bi@ ; inline
: q*a ( u v -- a ) 2q swapd ** [ * ] dip - ; inline
: q*b ( u v -- b ) 2q [ ** swap ] dip * + ; inline
PRIVATE>
: q+ ( u v -- u+v )
v+ ;
v+ ; inline
: q- ( u v -- u-v )
v- ;
v- ; inline
: q* ( u v -- u*v )
[ q*a ] [ q*b ] 2bi 2array ;
{
[ [ { 1 0 0 0 } vshuffle ] [ { 1 1 2 3 } vshuffle ] bi* v* ]
[ [ { 2 1 2 3 } vshuffle ] [ { 2 0 0 0 } vshuffle ] bi* v* v+ ]
[ [ { 3 2 3 1 } vshuffle ] [ { 3 3 1 2 } vshuffle ] bi* v* v+ ]
[ [ { 0 3 1 2 } vshuffle ] [ { 0 2 3 1 } vshuffle ] bi* v* v- ]
} 2cleave { -1 1 1 1 } v* ; inline
: qconjugate ( u -- u' )
first2 [ conjugate ] [ neg ] bi* 2array ;
{ 1 -1 -1 -1 } v* ; inline
: qrecip ( u -- 1/u )
qconjugate dup norm-sq v/n ;
qconjugate dup norm-sq v/n ; inline
: q/ ( u v -- u/v )
qrecip q* ;
qrecip q* ; inline
: n*q ( q n -- q )
v*n ; inline
: q*n ( q n -- q )
conjugate v*n ;
v*n ; inline
: n>q ( n -- q )
0 0 0 4array ; inline
: n>q-like ( c exemplar -- q )
[ 0 0 0 ] dip 4sequence ; inline
: c>q ( c -- q )
0 2array ;
>rect 0 0 4array ; inline
: v>q ( v -- q )
first3 rect> [ 0 swap rect> ] dip 2array ;
: q>v ( q -- v )
first2 [ imaginary-part ] dip >rect 3array ;
! Zero
CONSTANT: q0 { 0 0 }
! Units
CONSTANT: q1 { 1 0 }
CONSTANT: qi { C{ 0 1 } 0 }
CONSTANT: qj { 0 1 }
CONSTANT: qk { 0 C{ 0 1 } }
: c>q-like ( c exemplar -- q )
[ >rect 0 0 ] dip 4sequence ; inline
! Euler angles
<PRIVATE
: (euler) ( theta unit -- q )
[ -0.5 * [ cos c>q ] [ sin ] bi ] dip n*v v- ;
: (euler) ( theta exemplar shuffle -- q )
swap
[ 0.5 * [ fcos ] [ fsin ] bi 0.0 0.0 ] [ call ] [ 4sequence ] tri* ; inline
PRIVATE>
: euler-like ( phi theta psi exemplar -- q )
[ [ ] (euler) ] [ [ swapd ] (euler) ] [ [ rot ] (euler) ] tri-curry tri* q* q* ; inline
: euler ( phi theta psi -- q )
[ qi (euler) ] [ qj (euler) ] [ qk (euler) ] tri* q* q* ;
{ } euler-like ; inline