math.blas.vectors: Use new functors.

modern-harvey2
Doug Coleman 2017-12-28 18:30:26 -08:00
parent 048f86f366
commit b095c40e73
3 changed files with 177 additions and 208 deletions

View File

@ -34,10 +34,10 @@ ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
}
"Literal syntax:"
{ $subsections
postpone: \svector{
postpone: \dvector{
postpone: \cvector{
postpone: \zvector{
postpone: \Svector{
postpone: \Dvector{
postpone: \Cvector{
postpone: \Zvector{
} ;
ABOUT: "math.blas.vectors"
@ -145,23 +145,23 @@ HELP: Vsub
{ $values { "v" blas-vector-base } { "start" integer } { "length" integer } { "sub" blas-vector-base } }
{ $description "Slice a subvector out of " { $snippet "v" } " starting at " { $snippet "start" } " with the given " { $snippet "length" } ". The subvector will share storage with the parent vector." } ;
HELP: \svector{
{ $syntax "svector{ 1.0 -2.0 3.0 }" }
HELP: \Svector{
{ $syntax "Svector{ 1.0 -2.0 3.0 }" }
{ $description "Construct a literal " { $link float-blas-vector } "." } ;
HELP: \dvector{
{ $syntax "dvector{ 1.0 -2.0 3.0 }" }
HELP: \Dvector{
{ $syntax "Dvector{ 1.0 -2.0 3.0 }" }
{ $description "Construct a literal " { $link double-blas-vector } "." } ;
HELP: \cvector{
{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
HELP: \Cvector{
{ $syntax "Cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
{ $description "Construct a literal " { $link complex-float-blas-vector } "." } ;
HELP: \zvector{
{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
HELP: \Zvector{
{ $syntax "Zvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
{ $description "Construct a literal " { $link complex-double-blas-vector } "." } ;
{
postpone: \svector{ postpone: \dvector{
postpone: \cvector{ postpone: \zvector{
postpone: \Svector{ postpone: \Dvector{
postpone: \Cvector{ postpone: \Zvector{
} related-words

View File

@ -3,178 +3,178 @@ IN: math.blas.vectors.tests
! clone
{ svector{ 1.0 2.0 3.0 } } [ svector{ 1.0 2.0 3.0 } clone ] unit-test
{ f } [ svector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test
{ dvector{ 1.0 2.0 3.0 } } [ dvector{ 1.0 2.0 3.0 } clone ] unit-test
{ f } [ dvector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test
{ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } } [ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test
{ f } [ cvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test
{ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } } [ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test
{ f } [ zvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test
{ Svector{ 1.0 2.0 3.0 } } [ Svector{ 1.0 2.0 3.0 } clone ] unit-test
{ f } [ Svector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test
{ Dvector{ 1.0 2.0 3.0 } } [ Dvector{ 1.0 2.0 3.0 } clone ] unit-test
{ f } [ Dvector{ 1.0 2.0 3.0 } dup clone eq? ] unit-test
{ Cvector{ 1.0 C{ 2.0 3.0 } 4.0 } } [ Cvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test
{ f } [ Cvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test
{ Zvector{ 1.0 C{ 2.0 3.0 } 4.0 } } [ Zvector{ 1.0 C{ 2.0 3.0 } 4.0 } clone ] unit-test
{ f } [ Zvector{ 1.0 C{ 2.0 3.0 } 4.0 } dup clone eq? ] unit-test
! nth
{ 1.0 } [ 2 svector{ 3.0 2.0 1.0 } nth ] unit-test
{ 1.0 } [ 2 dvector{ 3.0 2.0 1.0 } nth ] unit-test
{ 1.0 } [ 2 Svector{ 3.0 2.0 1.0 } nth ] unit-test
{ 1.0 } [ 2 Dvector{ 3.0 2.0 1.0 } nth ] unit-test
{ C{ 1.0 2.0 } }
[ 2 cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test
[ 2 Cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test
{ C{ 1.0 2.0 } }
[ 2 zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test
[ 2 Zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } } nth ] unit-test
! set-nth
{ svector{ 3.0 2.0 0.0 } } [ 0.0 2 svector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test
{ dvector{ 3.0 2.0 0.0 } } [ 0.0 2 dvector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test
{ Svector{ 3.0 2.0 0.0 } } [ 0.0 2 Svector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test
{ Dvector{ 3.0 2.0 0.0 } } [ 0.0 2 Dvector{ 3.0 2.0 1.0 } [ set-nth ] keep ] unit-test
{ cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } } [
{ Cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } } [
C{ 3.0 4.0 } 2
cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } }
Cvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } }
[ set-nth ] keep
] unit-test
{ zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } } [
{ Zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 3.0 4.0 } } } [
C{ 3.0 4.0 } 2
zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } }
Zvector{ C{ -3.0 -2.0 } C{ -1.0 0.0 } C{ 1.0 2.0 } }
[ set-nth ] keep
] unit-test
! V+
{ svector{ 11.0 22.0 } } [ svector{ 1.0 2.0 } svector{ 10.0 20.0 } V+ ] unit-test
{ dvector{ 11.0 22.0 } } [ dvector{ 1.0 2.0 } dvector{ 10.0 20.0 } V+ ] unit-test
{ Svector{ 11.0 22.0 } } [ Svector{ 1.0 2.0 } Svector{ 10.0 20.0 } V+ ] unit-test
{ Dvector{ 11.0 22.0 } } [ Dvector{ 1.0 2.0 } Dvector{ 10.0 20.0 } V+ ] unit-test
{ cvector{ 11.0 C{ 22.0 33.0 } } }
[ cvector{ 1.0 C{ 2.0 3.0 } } cvector{ 10.0 C{ 20.0 30.0 } } V+ ]
{ Cvector{ 11.0 C{ 22.0 33.0 } } }
[ Cvector{ 1.0 C{ 2.0 3.0 } } Cvector{ 10.0 C{ 20.0 30.0 } } V+ ]
unit-test
{ zvector{ 11.0 C{ 22.0 33.0 } } }
[ zvector{ 1.0 C{ 2.0 3.0 } } zvector{ 10.0 C{ 20.0 30.0 } } V+ ]
{ Zvector{ 11.0 C{ 22.0 33.0 } } }
[ Zvector{ 1.0 C{ 2.0 3.0 } } Zvector{ 10.0 C{ 20.0 30.0 } } V+ ]
unit-test
! V-
{ svector{ 9.0 18.0 } } [ svector{ 10.0 20.0 } svector{ 1.0 2.0 } V- ] unit-test
{ dvector{ 9.0 18.0 } } [ dvector{ 10.0 20.0 } dvector{ 1.0 2.0 } V- ] unit-test
{ Svector{ 9.0 18.0 } } [ Svector{ 10.0 20.0 } Svector{ 1.0 2.0 } V- ] unit-test
{ Dvector{ 9.0 18.0 } } [ Dvector{ 10.0 20.0 } Dvector{ 1.0 2.0 } V- ] unit-test
{ cvector{ 9.0 C{ 18.0 27.0 } } }
[ cvector{ 10.0 C{ 20.0 30.0 } } cvector{ 1.0 C{ 2.0 3.0 } } V- ]
{ Cvector{ 9.0 C{ 18.0 27.0 } } }
[ Cvector{ 10.0 C{ 20.0 30.0 } } Cvector{ 1.0 C{ 2.0 3.0 } } V- ]
unit-test
{ zvector{ 9.0 C{ 18.0 27.0 } } }
[ zvector{ 10.0 C{ 20.0 30.0 } } zvector{ 1.0 C{ 2.0 3.0 } } V- ]
{ Zvector{ 9.0 C{ 18.0 27.0 } } }
[ Zvector{ 10.0 C{ 20.0 30.0 } } Zvector{ 1.0 C{ 2.0 3.0 } } V- ]
unit-test
! Vneg
{ svector{ 1.0 -2.0 } } [ svector{ -1.0 2.0 } Vneg ] unit-test
{ dvector{ 1.0 -2.0 } } [ dvector{ -1.0 2.0 } Vneg ] unit-test
{ Svector{ 1.0 -2.0 } } [ Svector{ -1.0 2.0 } Vneg ] unit-test
{ Dvector{ 1.0 -2.0 } } [ Dvector{ -1.0 2.0 } Vneg ] unit-test
{ cvector{ 1.0 C{ -2.0 3.0 } } } [ cvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test
{ zvector{ 1.0 C{ -2.0 3.0 } } } [ zvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test
{ Cvector{ 1.0 C{ -2.0 3.0 } } } [ Cvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test
{ Zvector{ 1.0 C{ -2.0 3.0 } } } [ Zvector{ -1.0 C{ 2.0 -3.0 } } Vneg ] unit-test
! n*V
{ svector{ 100.0 200.0 } } [ 10.0 svector{ 10.0 20.0 } n*V ] unit-test
{ dvector{ 100.0 200.0 } } [ 10.0 dvector{ 10.0 20.0 } n*V ] unit-test
{ Svector{ 100.0 200.0 } } [ 10.0 Svector{ 10.0 20.0 } n*V ] unit-test
{ Dvector{ 100.0 200.0 } } [ 10.0 Dvector{ 10.0 20.0 } n*V ] unit-test
{ cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ C{ 10.0 2.0 } cvector{ 2.0 C{ 1.0 1.0 } } n*V ]
{ Cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ C{ 10.0 2.0 } Cvector{ 2.0 C{ 1.0 1.0 } } n*V ]
unit-test
{ zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ C{ 10.0 2.0 } zvector{ 2.0 C{ 1.0 1.0 } } n*V ]
{ Zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ C{ 10.0 2.0 } Zvector{ 2.0 C{ 1.0 1.0 } } n*V ]
unit-test
! V*n
{ svector{ 100.0 200.0 } } [ svector{ 10.0 20.0 } 10.0 V*n ] unit-test
{ dvector{ 100.0 200.0 } } [ dvector{ 10.0 20.0 } 10.0 V*n ] unit-test
{ Svector{ 100.0 200.0 } } [ Svector{ 10.0 20.0 } 10.0 V*n ] unit-test
{ Dvector{ 100.0 200.0 } } [ Dvector{ 10.0 20.0 } 10.0 V*n ] unit-test
{ cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ cvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ]
{ Cvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ Cvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ]
unit-test
{ zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ zvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ]
{ Zvector{ C{ 20.0 4.0 } C{ 8.0 12.0 } } }
[ Zvector{ 2.0 C{ 1.0 1.0 } } C{ 10.0 2.0 } V*n ]
unit-test
! V/n
{ svector{ 1.0 2.0 } } [ svector{ 4.0 8.0 } 4.0 V/n ] unit-test
{ dvector{ 1.0 2.0 } } [ dvector{ 4.0 8.0 } 4.0 V/n ] unit-test
{ Svector{ 1.0 2.0 } } [ Svector{ 4.0 8.0 } 4.0 V/n ] unit-test
{ Dvector{ 1.0 2.0 } } [ Dvector{ 4.0 8.0 } 4.0 V/n ] unit-test
{ cvector{ C{ 0.0 -4.0 } 1.0 } }
[ cvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ]
{ Cvector{ C{ 0.0 -4.0 } 1.0 } }
[ Cvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ]
unit-test
{ zvector{ C{ 0.0 -4.0 } 1.0 } }
[ zvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ]
{ Zvector{ C{ 0.0 -4.0 } 1.0 } }
[ Zvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ]
unit-test
! V.
{ 7.0 } [ svector{ 1.0 2.5 } svector{ 2.0 2.0 } V. ] unit-test
{ 7.0 } [ dvector{ 1.0 2.5 } dvector{ 2.0 2.0 } V. ] unit-test
{ C{ 7.0 7.0 } } [ cvector{ C{ 1.0 1.0 } 2.5 } cvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test
{ C{ 7.0 7.0 } } [ zvector{ C{ 1.0 1.0 } 2.5 } zvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test
{ 7.0 } [ Svector{ 1.0 2.5 } Svector{ 2.0 2.0 } V. ] unit-test
{ 7.0 } [ Dvector{ 1.0 2.5 } Dvector{ 2.0 2.0 } V. ] unit-test
{ C{ 7.0 7.0 } } [ Cvector{ C{ 1.0 1.0 } 2.5 } Cvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test
{ C{ 7.0 7.0 } } [ Zvector{ C{ 1.0 1.0 } 2.5 } Zvector{ 2.0 C{ 2.0 2.0 } } V. ] unit-test
! V.conj
{ C{ 7.0 3.0 } } [ cvector{ C{ 1.0 1.0 } 2.5 } cvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test
{ C{ 7.0 3.0 } } [ zvector{ C{ 1.0 1.0 } 2.5 } zvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test
{ C{ 7.0 3.0 } } [ Cvector{ C{ 1.0 1.0 } 2.5 } Cvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test
{ C{ 7.0 3.0 } } [ Zvector{ C{ 1.0 1.0 } 2.5 } Zvector{ 2.0 C{ 2.0 2.0 } } V.conj ] unit-test
! Vnorm
{ t } [ svector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test
{ t } [ dvector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test
{ t } [ Svector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test
{ t } [ Dvector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test
{ t } [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
{ t } [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
{ t } [ Cvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
{ t } [ Zvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
! Vasum
{ 6.0 } [ svector{ 1.0 2.0 -3.0 } Vasum ] unit-test
{ 6.0 } [ dvector{ 1.0 2.0 -3.0 } Vasum ] unit-test
{ 6.0 } [ Svector{ 1.0 2.0 -3.0 } Vasum ] unit-test
{ 6.0 } [ Dvector{ 1.0 2.0 -3.0 } Vasum ] unit-test
{ 15.0 } [ cvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test
{ 15.0 } [ zvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test
{ 15.0 } [ Cvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test
{ 15.0 } [ Zvector{ 1.0 C{ -2.0 3.0 } C{ 4.0 -5.0 } } Vasum ] unit-test
! Vswap
{ svector{ 2.0 2.0 } svector{ 1.0 1.0 } }
[ svector{ 1.0 1.0 } svector{ 2.0 2.0 } Vswap ]
{ Svector{ 2.0 2.0 } Svector{ 1.0 1.0 } }
[ Svector{ 1.0 1.0 } Svector{ 2.0 2.0 } Vswap ]
unit-test
{ dvector{ 2.0 2.0 } dvector{ 1.0 1.0 } }
[ dvector{ 1.0 1.0 } dvector{ 2.0 2.0 } Vswap ]
{ Dvector{ 2.0 2.0 } Dvector{ 1.0 1.0 } }
[ Dvector{ 1.0 1.0 } Dvector{ 2.0 2.0 } Vswap ]
unit-test
{ cvector{ 2.0 C{ 2.0 2.0 } } cvector{ C{ 1.0 1.0 } 1.0 } }
[ cvector{ C{ 1.0 1.0 } 1.0 } cvector{ 2.0 C{ 2.0 2.0 } } Vswap ]
{ Cvector{ 2.0 C{ 2.0 2.0 } } Cvector{ C{ 1.0 1.0 } 1.0 } }
[ Cvector{ C{ 1.0 1.0 } 1.0 } Cvector{ 2.0 C{ 2.0 2.0 } } Vswap ]
unit-test
{ zvector{ 2.0 C{ 2.0 2.0 } } zvector{ C{ 1.0 1.0 } 1.0 } }
[ zvector{ C{ 1.0 1.0 } 1.0 } zvector{ 2.0 C{ 2.0 2.0 } } Vswap ]
{ Zvector{ 2.0 C{ 2.0 2.0 } } Zvector{ C{ 1.0 1.0 } 1.0 } }
[ Zvector{ C{ 1.0 1.0 } 1.0 } Zvector{ 2.0 C{ 2.0 2.0 } } Vswap ]
unit-test
! Viamax
{ 3 } [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 3 } [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 0 } [ cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 0 } [ zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 3 } [ Svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 3 } [ Dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 0 } [ Cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test
{ 0 } [ Zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Viamax ] unit-test
! Vamax
{ -6.0 } [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test
{ -6.0 } [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test
{ C{ 2.0 -5.0 } } [ cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test
{ C{ 2.0 -5.0 } } [ zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test
{ -6.0 } [ Svector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test
{ -6.0 } [ Dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } Vamax ] unit-test
{ C{ 2.0 -5.0 } } [ Cvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test
{ C{ 2.0 -5.0 } } [ Zvector{ C{ 2.0 -5.0 } 4.0 -6.0 -1.0 } Vamax ] unit-test
! Vsub
{ svector{ -5.0 4.0 -6.0 } } [ svector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test
{ dvector{ -5.0 4.0 -6.0 } } [ dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test
{ cvector{ -5.0 C{ 4.0 3.0 } -6.0 } } [ cvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test
{ zvector{ -5.0 C{ 4.0 3.0 } -6.0 } } [ zvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test
{ Svector{ -5.0 4.0 -6.0 } } [ Svector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test
{ Dvector{ -5.0 4.0 -6.0 } } [ Dvector{ 1.0 -5.0 4.0 -6.0 -1.0 } 1 3 Vsub ] unit-test
{ Cvector{ -5.0 C{ 4.0 3.0 } -6.0 } } [ Cvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test
{ Zvector{ -5.0 C{ 4.0 3.0 } -6.0 } } [ Zvector{ 1.0 -5.0 C{ 4.0 3.0 } -6.0 -1.0 } 1 3 Vsub ] unit-test

View File

@ -2,7 +2,8 @@ USING: accessors alien alien.c-types alien.complex alien.data
arrays ascii byte-arrays combinators combinators.short-circuit
fry kernel math math.blas.ffi math.complex math.functions
math.order sequences sequences.private functors words locals
parser prettyprint.backend prettyprint.custom specialized-arrays ;
parser prettyprint.backend prettyprint.custom specialized-arrays
functors2 ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
@ -128,121 +129,89 @@ M: blas-vector-base virtual@
: arg>double ( f -- f ) ; inline
<<
INLINE-FUNCTOR: blas-vector ( type: name t: name -- ) [[
TUPLE: ${type}-blas-vector < blas-vector-base ;
<FUNCTOR: (define-blas-vector) ( TYPE T -- )
: <${type}-blas-vector> ( underlying length inc -- vector ) ${type}-blas-vector boa ; inline
<<
: >${type}-blas-vector ( seq -- v )
[ ${type} >c-array underlying>> ] [ length ] bi 1 <${type}-blas-vector> ;
>>
<<
SYNTAX: ${t}vector{ \ } [ >${type}-blas-vector ] parse-literal ;
>>
<DIRECT-ARRAY> IS <direct-${TYPE}-array>
XCOPY IS ${T}COPY
XSWAP IS ${T}SWAP
IXAMAX IS I${T}AMAX
M: ${type}-blas-vector clone
${type} heap-size (prepare-copy)
[ ${t}COPY ] 3dip <${type}-blas-vector> ;
VECTOR DEFINES-CLASS ${TYPE}-blas-vector
<VECTOR> DEFINES <${TYPE}-blas-vector>
>VECTOR DEFINES >${TYPE}-blas-vector
M: ${type}-blas-vector element-type
drop ${type} ;
M: ${type}-blas-vector Vswap
(prepare-swap) [ ${t}SWAP ] 2dip ;
M: ${type}-blas-vector Viamax
(prepare-nrm2) I${t}AMAX 1 - ;
t [ T >lower ]
M: ${type}-blas-vector (blas-vector-like)
drop <${type}-blas-vector> ;
XVECTOR{ DEFINES ${t}vector{
XAXPY IS ${T}AXPY
XSCAL IS ${T}SCAL
WHERE
TUPLE: VECTOR < blas-vector-base ;
: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
: >VECTOR ( seq -- v )
[ TYPE >c-array underlying>> ] [ length ] bi 1 <VECTOR> ;
M: VECTOR clone
TYPE heap-size (prepare-copy)
[ XCOPY ] 3dip <VECTOR> ;
M: VECTOR element-type
drop TYPE ;
M: VECTOR Vswap
(prepare-swap) [ XSWAP ] 2dip ;
M: VECTOR Viamax
(prepare-nrm2) IXAMAX 1 - ;
M: VECTOR (blas-vector-like)
drop <VECTOR> ;
M: VECTOR (blas-direct-array)
M: ${type}-blas-vector (blas-direct-array)
[ underlying>> ]
[ [ length>> ] [ inc>> ] bi * ] bi
<DIRECT-ARRAY> ;
<direct-${type}-array> ;
M: VECTOR n*V+V!
(prepare-axpy) [ XAXPY ] dip ;
M: VECTOR n*V!
(prepare-scal) [ XSCAL ] dip ;
SYNTAX: XVECTOR{ \ } [ >VECTOR ] parse-literal ;
M: VECTOR pprint-delims
drop \ XVECTOR{ \ } ;
;FUNCTOR>
<FUNCTOR: (define-real-blas-vector) ( TYPE T -- )
VECTOR IS ${TYPE}-blas-vector
XDOT IS ${T}DOT
XNRM2 IS ${T}NRM2
XASUM IS ${T}ASUM
WHERE
M: VECTOR V.
(prepare-dot) XDOT ;
M: VECTOR V.conj
(prepare-dot) XDOT ;
M: VECTOR Vnorm
(prepare-nrm2) XNRM2 ;
M: VECTOR Vasum
(prepare-nrm2) XASUM ;
;FUNCTOR>
<FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- )
VECTOR IS ${TYPE}-blas-vector
XDOTU IS ${C}DOTU
XDOTC IS ${C}DOTC
XXNRM2 IS ${S}${C}NRM2
XXASUM IS ${S}${C}ASUM
WHERE
M: VECTOR V.
(prepare-dot) XDOTU ;
M: VECTOR V.conj
(prepare-dot) XDOTC ;
M: VECTOR Vnorm
(prepare-nrm2) XXNRM2 ;
M: VECTOR Vasum
(prepare-nrm2) XXASUM ;
;FUNCTOR>
: define-real-blas-vector ( TYPE T -- )
[ (define-blas-vector) ]
[ (define-real-blas-vector) ] 2bi ;
: define-complex-blas-vector ( TYPE C S -- )
[ drop (define-blas-vector) ]
[ (define-complex-blas-vector) ] 3bi ;
float "S" define-real-blas-vector
double "D" define-real-blas-vector
complex-float "C" "S" define-complex-blas-vector
complex-double "Z" "D" define-complex-blas-vector
M: ${type}-blas-vector n*V+V!
(prepare-axpy) [ ${t}AXPY ] dip ;
M: ${type}-blas-vector n*V!
(prepare-scal) [ ${t}SCAL ] dip ;
M: ${type}-blas-vector pprint-delims
drop \ ${t}vector{ \ } ;
]]
>>
<<
INLINE-FUNCTOR: real-blas-vector ( type: name t: name -- ) [[
<<
BLAS-VECTOR: ${type} ${t}
>>
M: ${type}-blas-vector V.
(prepare-dot) ${t}DOT ;
M: ${type}-blas-vector V.conj
(prepare-dot) ${t}DOT ;
M: ${type}-blas-vector Vnorm
(prepare-nrm2) ${t}NRM2 ;
M: ${type}-blas-vector Vasum
(prepare-nrm2) ${t}ASUM ;
]]
>>
<<
INLINE-FUNCTOR: complex-blas-vector ( type: name c: name s: name -- ) [[
<<
BLAS-VECTOR: ${type} ${c}
>>
M: ${type}-blas-vector V.
(prepare-dot) ${c}DOTU ;
M: ${type}-blas-vector V.conj
(prepare-dot) ${c}DOTC ;
M: ${type}-blas-vector Vnorm
(prepare-nrm2) ${s}${c}NRM2 ;
M: ${type}-blas-vector Vasum
(prepare-nrm2) ${s}${c}ASUM ;
]]
>>
COMPLEX-BLAS-VECTOR: complex-float C S
COMPLEX-BLAS-VECTOR: complex-double Z D
REAL-BLAS-VECTOR: float S
REAL-BLAS-VECTOR: double D
M: blas-vector-base >pprint-sequence ;
M: blas-vector-base pprint* pprint-object ;