steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

finished erg's math cleanup

cvs
Slava Pestov 2005-10-21 06:46:54 +00:00
parent 618104c4f6
commit 4731a18d21
8 changed files with 143 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/README.txt
View File

@ -29,3 +29,5 @@ library, but is useful enough to ship with the Factor distribution.
- contrib/xml.factor -- XML parser and writer (Daniel Ehrenberg) - contrib/xml.factor -- XML parser and writer (Daniel Ehrenberg)
- contrib/cairo/ -- cairo bindings (Sampo Vuori) - contrib/cairo/ -- cairo bindings (Sampo Vuori)
- contrib/math/ -- extended math library (Doug Coleman)

2
contrib/math/load.factor
View File

@ -4,6 +4,8 @@ USING: parser sequences words compiler ;
"contrib/math/combinatorics.factor" "contrib/math/combinatorics.factor"
"contrib/math/analysis.factor" "contrib/math/analysis.factor"
"contrib/math/polynomial.factor" "contrib/math/polynomial.factor"
"contrib/math/quaternions.factor"
"contrib/math/matrices.factor"
! "contrib/math/dimensions.factor" ! "contrib/math/dimensions.factor"
! "contrib/math/constants.factor" ! "contrib/math/constants.factor"

136
contrib/math/test.factor
View File

@ -70,3 +70,139 @@ USING: kernel math test sequences ;
[ t ] [ 11 gammaln 15.1044 - abs .0001 < ] unit-test [ t ] [ 11 gammaln 15.1044 - abs .0001 < ] unit-test
[ t ] [ 9000000000000000000000000000000000000000000 gammaln 8.811521863477754e+44 - abs 5.387515050969975e+30 < ] unit-test [ t ] [ 9000000000000000000000000000000000000000000 gammaln 8.811521863477754e+44 - abs 5.387515050969975e+30 < ] unit-test
[ 1 ] [ qi norm ] unit-test
[ 1 ] [ qj norm ] unit-test
[ 1 ] [ qk norm ] unit-test
[ 1 ] [ q1 norm ] unit-test
[ 0 ] [ q0 norm ] unit-test
[ 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 ] [ i qj n*v qk = ] unit-test
[ t ] [ qj i q*n qk v+ 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 ] [ i c>q qi = ] unit-test
[
@{ @{ 0 }@ @{ 0 }@ @{ 0 }@ }@
] [
3 1 zero-matrix
] unit-test
[
@{ @{ 1 0 0 }@
@{ 0 1 0 }@
@{ 0 0 1 }@ }@
] [
3 identity-matrix
] unit-test
[
@{ @{ 1 0 4 }@
@{ 0 7 0 }@
@{ 6 0 3 }@ }@
] [
@{ @{ 1 0 0 }@
@{ 0 2 0 }@
@{ 0 0 3 }@ }@
@{ @{ 0 0 4 }@
@{ 0 5 0 }@
@{ 6 0 0 }@ }@
m+
] unit-test
[
@{ @{ 1 0 4 }@
@{ 0 7 0 }@
@{ 6 0 3 }@ }@
] [
@{ @{ 1 0 0 }@
@{ 0 2 0 }@
@{ 0 0 3 }@ }@
@{ @{ 0 0 -4 }@
@{ 0 -5 0 }@
@{ -6 0 0 }@ }@
m-
] unit-test
[
@{ 10 20 30 }@
] [
10 @{ 1 2 3 }@ n*v
] unit-test
[
@{ 3 4 }@
] [
@{ @{ 1 0 }@
@{ 0 1 }@ }@
@{ 3 4 }@
m.v
] unit-test
[
@{ 4 3 }@
] [
@{ @{ 0 1 }@
@{ 1 0 }@ }@
@{ 3 4 }@
m.v
] unit-test
[ @{ 0 0 1 }@ ] [ @{ 1 0 0 }@ @{ 0 1 0 }@ cross ] unit-test
[ @{ 1 0 0 }@ ] [ @{ 0 1 0 }@ @{ 0 0 1 }@ cross ] unit-test
[ @{ 0 1 0 }@ ] [ @{ 0 0 1 }@ @{ 1 0 0 }@ cross ] unit-test
[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ ]
[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip flip ]
unit-test
[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ ]
[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ flip flip ]
unit-test
[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ ]
[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip ]
unit-test
[
@{ @{ 6 }@ }@
] [
@{ @{ 3 }@ }@ @{ @{ 2 }@ }@ m.
] unit-test
[
@{ @{ 11 }@ }@
] [
@{ @{ 1 3 }@ }@ @{ @{ 5 }@ @{ 2 }@ }@ m.
] unit-test
[
@{ @{ 28 }@ }@
] [
@{ @{ 2 4 6 }@ }@
@{ @{ 1 }@
@{ 2 }@
@{ 3 }@ }@
m.
] unit-test

3
library/bootstrap/boot-stage1.factor
View File

@ -56,8 +56,7 @@ sequences io vectors words ;
"/library/math/pow.factor" "/library/math/pow.factor"
"/library/math/trig-hyp.factor" "/library/math/trig-hyp.factor"
"/library/math/arc-trig-hyp.factor" "/library/math/arc-trig-hyp.factor"
"/library/math/matrices.factor" "/library/math/vectors.factor"
"/library/math/quaternions.factor"
"/library/math/parse-numbers.factor" "/library/math/parse-numbers.factor"
"/library/words.factor" "/library/words.factor"

77
library/math/quaternions.factor
View File

@ -1,77 +0,0 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! 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.
USING: arrays kernel math sequences ;
IN: math-internals
: 2q [ first2 ] 2apply ; inline
: q*a 2q swapd ** >r * r> - ; inline
: q*b 2q >r ** swap r> * + ; inline
IN: math
: q* ( u v -- u*v )
#! Multiply quaternions.
[ q*a ] 2keep q*b 2array ;
: qconjugate ( u -- u' )
#! Quaternion conjugate.
first2 neg >r conjugate r> 2array ;
: qrecip ( u -- 1/u )
#! Quaternion inverse.
qconjugate dup norm-sq v/n ;
: q/ ( u v -- u/v )
#! Divide quaternions.
qrecip q* ;
: q*n ( q n -- q )
#! Note: you will get the wrong result if you try to
#! multiply a quaternion by a complex number on the right
#! using v*n. Use this word instead. Note that v*n with a
#! quaternion and a real is okay.
conjugate v*n ;
: c>q ( c -- q )
#! Turn a complex number into a quaternion.
0 2array ;
: v>q ( v -- q )
#! Turn a 3-vector into a quaternion with real part 0.
first3 rect> >r 0 swap rect> r> 2array ;
: q>v ( q -- v )
#! Get the vector part of a quaternion, discarding the real
#! part.
first2 >r imaginary r> >rect 3array ;
: cross ( u v -- u*v )
#! Cross product of two 3-vectors can be computed using
#! quaternion multiplication.
[ v>q ] 2apply q* q>v ;
! Zero
: q0 @{ 0 0 }@ ;
! Units
: q1 @{ 1 0 }@ ;
: qi @{ #{ 0 1 }# 0 }@ ;
: qj @{ 0 1 }@ ;
: qk @{ 0 #{ 0 1 }# }@ ;
! Euler angles -- see
! http://www.mathworks.com/access/helpdesk/help/toolbox/aeroblks/euleranglestoquaternions.html
: (euler) ( theta unit -- q )
>r -0.5 * dup cos c>q swap sin r> n*v v- ;
: euler ( phi theta psi -- q )
qk (euler) >r qj (euler) >r qi (euler) r> q* r> q* ;

117
library/test/math/matrices.factor
View File

@ -1,117 +0,0 @@
IN: temporary
USING: kernel lists math matrices namespaces sequences test
vectors ;
[
@{ @{ 0 }@ @{ 0 }@ @{ 0 }@ }@
] [
3 1 zero-matrix
] unit-test
[
@{ @{ 1 0 0 }@
@{ 0 1 0 }@
@{ 0 0 1 }@ }@
] [
3 identity-matrix
] unit-test
[
@{ @{ 1 0 4 }@
@{ 0 7 0 }@
@{ 6 0 3 }@ }@
] [
@{ @{ 1 0 0 }@
@{ 0 2 0 }@
@{ 0 0 3 }@ }@
@{ @{ 0 0 4 }@
@{ 0 5 0 }@
@{ 6 0 0 }@ }@
m+
] unit-test
[
@{ @{ 1 0 4 }@
@{ 0 7 0 }@
@{ 6 0 3 }@ }@
] [
@{ @{ 1 0 0 }@
@{ 0 2 0 }@
@{ 0 0 3 }@ }@
@{ @{ 0 0 -4 }@
@{ 0 -5 0 }@
@{ -6 0 0 }@ }@
m-
] unit-test
[
@{ 10 20 30 }@
] [
10 @{ 1 2 3 }@ n*v
] unit-test
[
@{ 3 4 }@
] [
@{ @{ 1 0 }@
@{ 0 1 }@ }@
@{ 3 4 }@
m.v
] unit-test
[
@{ 4 3 }@
] [
@{ @{ 0 1 }@
@{ 1 0 }@ }@
@{ 3 4 }@
m.v
] unit-test
[ @{ 0 0 1 }@ ] [ @{ 1 0 0 }@ @{ 0 1 0 }@ cross ] unit-test
[ @{ 1 0 0 }@ ] [ @{ 0 1 0 }@ @{ 0 0 1 }@ cross ] unit-test
[ @{ 0 1 0 }@ ] [ @{ 0 0 1 }@ @{ 1 0 0 }@ cross ] unit-test
[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ ]
[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip flip ]
unit-test
[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ ]
[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ flip flip ]
unit-test
[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ ]
[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip ]
unit-test
[
@{ @{ 6 }@ }@
] [
@{ @{ 3 }@ }@ @{ @{ 2 }@ }@ m.
] unit-test
[
@{ @{ 11 }@ }@
] [
@{ @{ 1 3 }@ }@ @{ @{ 5 }@ @{ 2 }@ }@ m.
] unit-test
[
@{ @{ 28 }@ }@
] [
@{ @{ 2 4 6 }@ }@
@{ @{ 1 }@
@{ 2 }@
@{ 3 }@ }@
m.
] unit-test

25
library/test/math/quaternions.factor
View File

@ -1,25 +0,0 @@
IN: temporary
USING: kernel math test ;
[ 1 ] [ qi norm ] unit-test
[ 1 ] [ qj norm ] unit-test
[ 1 ] [ qk norm ] unit-test
[ 1 ] [ q1 norm ] unit-test
[ 0 ] [ q0 norm ] unit-test
[ 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 ] [ i qj n*v qk = ] unit-test
[ t ] [ qj i q*n qk v+ 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 ] [ i c>q qi = ] unit-test

4
library/test/test.factor
View File

@ -87,8 +87,8 @@ SYMBOL: failures
"words" "prettyprint" "random" "words" "prettyprint" "random"
"stream" "math/bitops" "stream" "math/bitops"
"math/math-combinators" "math/rational" "math/float" "math/math-combinators" "math/rational" "math/float"
"math/complex" "math/quaternions" "math/irrational" "math/complex" "math/irrational"
"math/integer" "math/matrices" "math/integer"
"httpd/url-encoding" "httpd/html" "httpd/httpd" "httpd/url-encoding" "httpd/html" "httpd/httpd"
"httpd/http-client" "threads" "parsing-word" "httpd/http-client" "threads" "parsing-word"
"inference" "interpreter" "alien" "inference" "interpreter" "alien"