math.matrices: rename m./m.v/v.m to mdot/mdotv/vdotm.

master
John Benediktsson 2020-02-26 12:51:04 -08:00
parent 1c5d417100
commit 07a5912afa
16 changed files with 40 additions and 39 deletions

View File

@ -114,7 +114,7 @@ $nl
{ $subsections m+ m- m* m/ m~ }
"Dot product (multiplication) of vectors and matrices:"
{ $subsections v.m m.v m. }
{ $subsections vdotm mdotv mdot }
"Transformations and elements of matrices:"
{ $subsections
@ -845,39 +845,39 @@ HELP: m/
}
} ;
HELP: m.v
HELP: mdotv
{ $values { "m" matrix } { "v" sequence } { "p" matrix } }
{ $description "Computes the dot product of a matrix and a vector." }
{ $notelist
{ $equiv-word-note "swapped" v.m }
{ $equiv-word-note "swapped" vdotm }
$2d-only-note
{ $matrix-scalar-note * + }
}
{ $examples
{ $example
"USING: math.matrices prettyprint ;"
"{ { 1 -1 2 } { 0 -3 1 } } { 2 1 0 } m.v ."
"{ { 1 -1 2 } { 0 -3 1 } } { 2 1 0 } mdotv ."
"{ 1 -3 }"
}
} ;
HELP: v.m
HELP: vdotm
{ $values { "v" sequence } { "m" matrix } { "p" matrix } }
{ $description "Computes the dot product of a vector and a matrix." }
{ $notelist
{ $equiv-word-note "swapped" m.v }
{ $equiv-word-note "swapped" mdotv }
$2d-only-note
{ $matrix-scalar-note * + }
}
{ $examples
{ $example
"USING: math.matrices prettyprint ;"
"{ 2 1 0 } { { 1 -1 2 } { 0 -3 1 } } v.m ."
"{ 2 1 0 } { { 1 -1 2 } { 0 -3 1 } } vdotm ."
"{ 2 -5 5 }"
}
} ;
HELP: m.
HELP: mdot
{ $values { "m" matrix } }
{ $description "Computes the dot product of two matrices, i.e multiplies them." }
{ $notelist
@ -887,7 +887,7 @@ HELP: m.
{ $examples
{ $example
"USING: math.matrices prettyprint ;"
"{ { 1 -1 2 } { 0 -3 1 } } { { 3 7 } { 9 12 } } m. ."
"{ { 1 -1 2 } { 0 -3 1 } } { { 3 7 } { 9 12 } } mdot ."
"{ { -6 -5 } { -27 -36 } }"
}
} ;

View File

@ -305,16 +305,16 @@ PRIVATE>
m-
] 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
{ { 3 4 } } [ { { 1 0 } { 0 1 } } { 3 4 } mdotv ] unit-test
{ { 4 3 } } [ { { 0 1 } { 1 0 } } { 3 4 } mdotv ] unit-test
{ { { 6 } } } [ { { 3 } } { { 2 } } m. ] unit-test
{ { { 11 } } } [ { { 1 3 } } { { 5 } { 2 } } m. ] unit-test
{ { { 6 } } } [ { { 3 } } { { 2 } } mdot ] unit-test
{ { { 11 } } } [ { { 1 3 } } { { 5 } { 2 } } mdot ] unit-test
{ { { 28 } } } [
{ { 2 4 6 } }
{ { 1 } { 2 } { 3 } }
m.
mdot
] unit-test

View File

@ -248,9 +248,9 @@ DEFER: matrix-set-nths
: m* ( m1 m2 -- m ) [ v* ] 2map ;
: m/ ( m1 m2 -- m ) [ v/ ] 2map ;
: v.m ( v m -- p ) flip [ vdot ] with map ;
: m.v ( m v -- p ) [ vdot ] curry map ;
: m. ( m m -- m ) flip [ swap m.v ] curry map ;
: vdotm ( v m -- p ) flip [ vdot ] with map ;
: mdotv ( m v -- p ) [ vdot ] curry map ;
: mdot ( m m -- m ) flip [ swap mdotv ] curry map ;
: m~ ( m1 m2 epsilon -- ? ) [ v~ ] curry 2all? ;

View File

@ -9,14 +9,14 @@ IN: benchmark.3d-matrix-scalar
:: mv-matrix ( pitch yaw location -- matrix )
{ 1.0 0.0 0.0 } pitch <rotation-matrix4>
{ 0.0 1.0 0.0 } yaw <rotation-matrix4>
location vneg <translation-matrix4> m. m. ;
location vneg <translation-matrix4> mdot mdot ;
:: 3d-matrix-scalar-benchmark ( -- )
f :> result!
100000 [
{ 1024.0 768.0 } 0.7 0.25 1024.0 p-matrix :> p
3.0 1.0 { 10.0 -0.0 2.0 } mv-matrix :> mv
mv p m. result!
mv p mdot result!
] times
result . ;

View File

@ -19,13 +19,13 @@ IN: benchmark.pidigits
[ 2array ] 2bi@ 2array ;
: produce ( z y -- z' )
[ 10 ] dip -10 * 0 1 >matrix swap m. ;
[ 10 ] dip -10 * 0 1 >matrix swap mdot ;
: gen-x ( x -- matrix )
dup 2 * 1 + [ 2 * 0 ] keep >matrix ;
: consume ( z k -- z' )
gen-x m. ;
gen-x mdot ;
:: (padded-total) ( row col -- str n format )
"" row col + "%" "s\t:%d\n"

View File

@ -15,7 +15,7 @@ IN: game.debug.tests
} clear-framebuffer ;
:: draw-debug-tests ( world -- )
world [ wasd-p-matrix ] [ wasd-mv-matrix ] bi m. :> mvp-matrix
world [ wasd-p-matrix ] [ wasd-mv-matrix ] bi mdot :> mvp-matrix
{ 0 0 0 } clear-screen
[

View File

@ -5,4 +5,4 @@ IN: gml.geometry
GML: rot_vec ( v n alpha -- v )
! Inefficient!
deg>rad <rotation-matrix4> swap >array m.v >double-4 ;
deg>rad <rotation-matrix4> swap >array mdotv >double-4 ;

View File

@ -9,7 +9,6 @@ math.vectors.simd math.vectors.simd.cords method-chains models
namespaces sequences sets specialized-vectors typed ui
ui.gadgets ui.gadgets.worlds ui.gestures ui.pixel-formats
vectors ;
FROM: math.matrices => m.v ;
FROM: models => change-model ;
SPECIALIZED-VECTORS: ushort float-4 ;
IN: gml.viewer

View File

@ -49,7 +49,7 @@ TUPLE: raytrace-world < wasd-world
: sphere-center ( sphere -- center )
[ [ axis>> ] [ theta>> ] bi <rotation-matrix4> ]
[ home>> ] bi m.v ;
[ home>> ] bi mdotv ;
M: sphere audio-position sphere-center ; inline
M: sphere audio-distance radius>> fsqrt 2.0 * ; inline

View File

@ -40,12 +40,13 @@ M: wasd-world wasd-fly-vertically? drop t ;
: wasd-mv-matrix ( world -- matrix )
[ { 1.0 0.0 0.0 } swap pitch>> <rotation-matrix4> ]
[ { 0.0 1.0 0.0 } swap yaw>> <rotation-matrix4> ]
[ location>> vneg <translation-matrix4> ] tri m. m. ;
[ location>> vneg <translation-matrix4> ] tri mdot mdot ;
: wasd-mv-inv-matrix ( world -- matrix )
[ location>> <translation-matrix4> ]
[ { 0.0 -1.0 0.0 } swap yaw>> <rotation-matrix4> ]
[ { -1.0 0.0 0.0 } swap pitch>> <rotation-matrix4> ] tri m. m. ;
[ { -1.0 0.0 0.0 } swap pitch>> <rotation-matrix4> ] tri
mdot mdot ;
: wasd-p-matrix ( world -- matrix )
p-matrix>> ;
@ -69,7 +70,7 @@ CONSTANT: fov 0.7
loc world dim>> [ /f 0.5 - 2.0 * ] 2map
world wasd-fov-vector v*
first2 neg -1.0 0.0 4array
world wasd-mv-inv-matrix swap m.v ;
world wasd-mv-inv-matrix swap mdotv ;
: set-wasd-view ( world location yaw pitch -- world )
[ >>location ] [ >>yaw ] [ >>pitch ] tri* ;
@ -85,7 +86,7 @@ CONSTANT: fov 0.7
cosy 0.0 siny neg 3array
siny sinp * cosp cosy sinp * 3array
siny cosp * sinp neg cosy cosp * 3array 3array
v swap v.m ;
v swap vdotm ;
: ?pitch ( world -- pitch )
dup wasd-fly-vertically? [ pitch>> ] [ drop 0.0 ] if ;

View File

@ -203,8 +203,8 @@ DEFER: (d)
[ v- ] 2map ;
! Laplacian
: m.m' ( matrix -- matrix' ) dup flip m. ;
: m'.m ( matrix -- matrix' ) dup flip swap m. ;
: mdotm' ( matrix -- matrix' ) dup flip mdot ;
: m'dotm ( matrix -- matrix' ) dup flip swap mdot ;
: empty-matrix? ( matrix -- ? )
[ t ] [ first empty? ] if-empty ;
@ -221,7 +221,7 @@ DEFER: (d)
] if ;
: laplacian-matrix ( basis1 basis2 basis3 -- matrix )
dupd d-matrix m.m' [ d-matrix m'.m ] dip ?m+ ;
dupd d-matrix mdotm' [ d-matrix m'.m ] dip ?m+ ;
: laplacian-betti ( basis1 basis2 basis3 -- n )
laplacian-matrix null/rank drop ;

View File

@ -10,7 +10,7 @@ HELP: inverse
{ $example
"USING: kernel math.matrices prettyprint ;"
"FROM: math.matrices.elimination => inverse ;"
"{ { 3 4 } { 7 9 } } dup inverse m. 2 <identity-matrix> = ."
"{ { 3 4 } { 7 9 } } dup inverse mdot 2 <identity-matrix> = ."
"t"
}
} ;

View File

@ -306,7 +306,7 @@ M: matrix recip
! TODO: use the faster algorithm: [ determinant zero? ]
: invertible-matrix? ( matrix -- ? )
[ dimension first2 max <identity-matrix> ] keep
dup recip m. = ;
dup recip mdot = ;
: linearly-independent-matrix? ( matrix -- ? ) ;
@ -314,7 +314,7 @@ M: matrix recip
! this is the original definition of m^n as committed in 2012; it has not been lost
: (m^n) ( m n -- n )
make-bits over first length <identity-matrix>
[ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
[ [ dupd mdot ] when [ dup mdot ] dip ] reduce nip ;
PRIVATE>
! A^-1 is the inverse but other negative powers are nonsense

View File

@ -162,7 +162,7 @@ PRIVATE>
<PRIVATE
: transform ( triple matrix -- new-triple )
[ 1array ] dip m. first ;
[ 1array ] dip mdot first ;
PRIVATE>

View File

@ -35,7 +35,7 @@ IN: rosetta-code.conjugate-transpose
dup conj-t = ;
: normal-matrix? ( matrix -- ? )
dup conj-t [ m. ] [ swap m. ] 2bi = ;
dup conj-t [ mdot ] [ swap mdot ] 2bi = ;
: unitary-matrix? ( matrix -- ? )
[ dup conj-t m. ] [ length <identity-matrix> ] bi = ;
[ dup conj-t mdot ] [ length <identity-matrix> ] bi = ;

View File

@ -51,7 +51,8 @@ TUPLE: triplets-count primitives total ;
: <0-triplets-count> ( -- a ) 0 0 \ triplets-count boa ;
: next-triplet ( triplet T -- triplet' ) [ 1array ] [ m. ] bi* first ;
: next-triplet ( triplet T -- triplet' )
[ 1array ] [ mdot ] bi* first ;
: candidates-triplets ( seed -- candidates )
${ T1 T2 T3 } [ next-triplet ] with map ;