From 4731a18d2153804faee09cb08efaf99a308779f8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 21 Oct 2005 06:46:54 +0000
Subject: [PATCH] finished erg's math cleanup

---
 contrib/README.txt                   |   2 +
 contrib/math/load.factor             |   2 +
 contrib/math/test.factor             | 136 +++++++++++++++++++++++++++
 library/bootstrap/boot-stage1.factor |   3 +-
 library/math/quaternions.factor      |  77 ---------------
 library/test/math/matrices.factor    | 117 -----------------------
 library/test/math/quaternions.factor |  25 -----
 library/test/test.factor             |   4 +-
 8 files changed, 143 insertions(+), 223 deletions(-)
 delete mode 100644 library/math/quaternions.factor
 delete mode 100644 library/test/math/matrices.factor
 delete mode 100644 library/test/math/quaternions.factor

diff --git a/contrib/README.txt b/contrib/README.txt
index beead44abf..d19cfccaa7 100644
--- a/contrib/README.txt
+++ b/contrib/README.txt
@@ -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/cairo/ -- cairo bindings (Sampo Vuori)
+
+- contrib/math/ -- extended math library (Doug Coleman)
diff --git a/contrib/math/load.factor b/contrib/math/load.factor
index 626f7034d1..aae78c4925 100644
--- a/contrib/math/load.factor
+++ b/contrib/math/load.factor
@@ -4,6 +4,8 @@ USING: parser sequences words compiler ;
     "contrib/math/combinatorics.factor"
     "contrib/math/analysis.factor"
     "contrib/math/polynomial.factor"
+    "contrib/math/quaternions.factor"
+    "contrib/math/matrices.factor"
 
     ! "contrib/math/dimensions.factor"
     ! "contrib/math/constants.factor"
diff --git a/contrib/math/test.factor b/contrib/math/test.factor
index 4df209f6f3..80307d1257 100644
--- a/contrib/math/test.factor
+++ b/contrib/math/test.factor
@@ -70,3 +70,139 @@ USING: kernel math test sequences ;
 [ t ] [ 11 gammaln 15.1044 - abs .0001 < ] 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
diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index db27217379..30ff1f3511 100644
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -56,8 +56,7 @@ sequences io vectors words ;
         "/library/math/pow.factor"
         "/library/math/trig-hyp.factor"
         "/library/math/arc-trig-hyp.factor"
-        "/library/math/matrices.factor"
-        "/library/math/quaternions.factor"
+        "/library/math/vectors.factor"
         "/library/math/parse-numbers.factor"
 
         "/library/words.factor"
diff --git a/library/math/quaternions.factor b/library/math/quaternions.factor
deleted file mode 100644
index b9cdb90fd4..0000000000
--- a/library/math/quaternions.factor
+++ /dev/null
@@ -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* ;
diff --git a/library/test/math/matrices.factor b/library/test/math/matrices.factor
deleted file mode 100644
index dbd27f10ab..0000000000
--- a/library/test/math/matrices.factor
+++ /dev/null
@@ -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
diff --git a/library/test/math/quaternions.factor b/library/test/math/quaternions.factor
deleted file mode 100644
index 0039249759..0000000000
--- a/library/test/math/quaternions.factor
+++ /dev/null
@@ -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
diff --git a/library/test/test.factor b/library/test/test.factor
index 0e2aed67a2..e6398f206e 100644
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -87,8 +87,8 @@ SYMBOL: failures
         "words" "prettyprint" "random"
         "stream" "math/bitops"
         "math/math-combinators" "math/rational" "math/float"
-        "math/complex" "math/quaternions" "math/irrational"
-        "math/integer" "math/matrices"
+        "math/complex" "math/irrational"
+        "math/integer"
         "httpd/url-encoding" "httpd/html" "httpd/httpd"
         "httpd/http-client" "threads" "parsing-word"
         "inference" "interpreter" "alien"