BLAS level 2/level 3 interface words
Joe Groff
parent
f70634bb01
commit
727d9edcd3
|
|
@ -0,0 +1 @@
|
||||||
|
Joe Groff
|
||||||
|
|
@ -0,0 +1,710 @@
|
||||||
|
USING: kernel math.blas.matrices math.blas.vectors math.blas.syntax
|
||||||
|
sequences tools.test ;
|
||||||
|
IN: math.blas.matrices.tests
|
||||||
|
|
||||||
|
! clone
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 1.0 2.0 3.0 }
|
||||||
|
{ 4.0 5.0 6.0 }
|
||||||
|
{ 7.0 8.0 9.0 }
|
||||||
|
} ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 2.0 3.0 }
|
||||||
|
{ 4.0 5.0 6.0 }
|
||||||
|
{ 7.0 8.0 9.0 }
|
||||||
|
} clone
|
||||||
|
] unit-test
|
||||||
|
[ f ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 2.0 3.0 }
|
||||||
|
{ 4.0 5.0 6.0 }
|
||||||
|
{ 7.0 8.0 9.0 }
|
||||||
|
} dup clone eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 }
|
||||||
|
{ 4.0 5.0 6.0 }
|
||||||
|
{ 7.0 8.0 9.0 }
|
||||||
|
} ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 }
|
||||||
|
{ 4.0 5.0 6.0 }
|
||||||
|
{ 7.0 8.0 9.0 }
|
||||||
|
} clone
|
||||||
|
] unit-test
|
||||||
|
[ f ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 }
|
||||||
|
{ 4.0 5.0 6.0 }
|
||||||
|
{ 7.0 8.0 9.0 }
|
||||||
|
} dup clone eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||||
|
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||||
|
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||||
|
} ] [
|
||||||
|
cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||||
|
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||||
|
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||||
|
} clone
|
||||||
|
] unit-test
|
||||||
|
[ f ] [
|
||||||
|
cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||||
|
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||||
|
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||||
|
} dup clone eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||||
|
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||||
|
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||||
|
} ] [
|
||||||
|
zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||||
|
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||||
|
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||||
|
} clone
|
||||||
|
] unit-test
|
||||||
|
[ f ] [
|
||||||
|
zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } 2.0 3.0 }
|
||||||
|
{ 4.0 C{ 5.0 2.0 } 6.0 }
|
||||||
|
{ 7.0 8.0 C{ 9.0 3.0 } }
|
||||||
|
} dup clone eq?
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! M.V
|
||||||
|
|
||||||
|
[ svector{ 3.0 1.0 6.0 } ] [
|
||||||
|
smatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 0.0 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
}
|
||||||
|
svector{ 1.0 2.0 3.0 1.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
[ svector{ -2.0 1.0 3.0 14.0 } ] [
|
||||||
|
smatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 0.0 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
} Mtranspose
|
||||||
|
svector{ 1.0 2.0 3.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dvector{ 3.0 1.0 6.0 } ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 0.0 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
}
|
||||||
|
dvector{ 1.0 2.0 3.0 1.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
[ dvector{ -2.0 1.0 3.0 14.0 } ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 0.0 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
} Mtranspose
|
||||||
|
dvector{ 1.0 2.0 3.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [
|
||||||
|
cmatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
}
|
||||||
|
cvector{ 1.0 2.0 3.0 1.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
[ cvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [
|
||||||
|
cmatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
} Mtranspose
|
||||||
|
cvector{ 1.0 2.0 3.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zvector{ 3.0 C{ 1.0 2.0 } 6.0 } ] [
|
||||||
|
zmatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
}
|
||||||
|
zvector{ 1.0 2.0 3.0 1.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
[ zvector{ -2.0 C{ 1.0 2.0 } 3.0 14.0 } ] [
|
||||||
|
zmatrix{
|
||||||
|
{ 0.0 1.0 0.0 1.0 }
|
||||||
|
{ -1.0 C{ 0.0 1.0 } 0.0 2.0 }
|
||||||
|
{ 0.0 0.0 1.0 3.0 }
|
||||||
|
} Mtranspose
|
||||||
|
zvector{ 1.0 2.0 3.0 }
|
||||||
|
M.V
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! V(*)
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 4.0 6.0 8.0 }
|
||||||
|
{ 3.0 6.0 9.0 12.0 }
|
||||||
|
} ] [
|
||||||
|
svector{ 1.0 2.0 3.0 } svector{ 1.0 2.0 3.0 4.0 } V(*)
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 4.0 6.0 8.0 }
|
||||||
|
{ 3.0 6.0 9.0 12.0 }
|
||||||
|
} ] [
|
||||||
|
dvector{ 1.0 2.0 3.0 } dvector{ 1.0 2.0 3.0 4.0 } V(*)
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 }
|
||||||
|
{ 2.0 4.0 C{ 6.0 -6.0 } 8.0 }
|
||||||
|
{ C{ 3.0 3.0 } C{ 6.0 6.0 } 18.0 C{ 12.0 12.0 } }
|
||||||
|
} ] [
|
||||||
|
cvector{ 1.0 2.0 C{ 3.0 3.0 } } cvector{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 } V(*)
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 }
|
||||||
|
{ 2.0 4.0 C{ 6.0 -6.0 } 8.0 }
|
||||||
|
{ C{ 3.0 3.0 } C{ 6.0 6.0 } 18.0 C{ 12.0 12.0 } }
|
||||||
|
} ] [
|
||||||
|
zvector{ 1.0 2.0 C{ 3.0 3.0 } } zvector{ 1.0 2.0 C{ 3.0 -3.0 } 4.0 } V(*)
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! M.
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 0.0 4.0 0.0 0.0 10.0 }
|
||||||
|
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} smatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 1.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 4.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 10.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} Mtranspose smatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} Mtranspose M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 0.0 4.0 0.0 0.0 10.0 }
|
||||||
|
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 4.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 10.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 2.0 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} Mtranspose dmatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} Mtranspose M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 0.0 C{ 4.0 -4.0 } 0.0 0.0 10.0 }
|
||||||
|
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 C{ 4.0 -4.0 } 0.0 }
|
||||||
|
{ 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 4.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 10.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} Mtranspose cmatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} Mtranspose M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 0.0 C{ 4.0 -4.0 } 0.0 0.0 10.0 }
|
||||||
|
{ 0.0 0.0 0.0 0.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 C{ 4.0 -4.0 } 0.0 }
|
||||||
|
{ 0.0 -3.0 0.0 0.0 }
|
||||||
|
{ 4.0 0.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 10.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 4.0 0.0 }
|
||||||
|
{ 0.0 C{ 2.0 -2.0 } 0.0 0.0 5.0 }
|
||||||
|
{ 0.0 0.0 3.0 0.0 0.0 }
|
||||||
|
} Mtranspose zmatrix{
|
||||||
|
{ 1.0 0.0 0.0 }
|
||||||
|
{ 0.0 0.0 -1.0 }
|
||||||
|
{ 0.0 2.0 0.0 }
|
||||||
|
{ 0.0 0.0 0.0 }
|
||||||
|
} Mtranspose M.
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! n*M
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 2.0 0.0 }
|
||||||
|
{ 0.0 2.0 }
|
||||||
|
} ] [
|
||||||
|
2.0 smatrix{
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
{ 0.0 1.0 }
|
||||||
|
} n*M
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 2.0 0.0 }
|
||||||
|
{ 0.0 2.0 }
|
||||||
|
} ] [
|
||||||
|
2.0 dmatrix{
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
{ 0.0 1.0 }
|
||||||
|
} n*M
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ C{ 2.0 1.0 } 0.0 }
|
||||||
|
{ 0.0 C{ -1.0 2.0 } }
|
||||||
|
} ] [
|
||||||
|
C{ 2.0 1.0 } cmatrix{
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
{ 0.0 C{ 0.0 1.0 } }
|
||||||
|
} n*M
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ C{ 2.0 1.0 } 0.0 }
|
||||||
|
{ 0.0 C{ -1.0 2.0 } }
|
||||||
|
} ] [
|
||||||
|
C{ 2.0 1.0 } zmatrix{
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
{ 0.0 C{ 0.0 1.0 } }
|
||||||
|
} n*M
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! Mrows, Mcols
|
||||||
|
|
||||||
|
[ svector{ 3.0 3.0 3.0 } ] [
|
||||||
|
2 smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ svector{ 3.0 2.0 3.0 4.0 } ] [
|
||||||
|
2 smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mrows length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ svector{ 3.0 3.0 3.0 } ] [
|
||||||
|
2 smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ svector{ 3.0 2.0 3.0 4.0 } ] [
|
||||||
|
2 smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
smatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mrows length
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dvector{ 3.0 3.0 3.0 } ] [
|
||||||
|
2 dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ dvector{ 3.0 2.0 3.0 4.0 } ] [
|
||||||
|
2 dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mrows length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ dvector{ 3.0 3.0 3.0 } ] [
|
||||||
|
2 dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ dvector{ 3.0 2.0 3.0 4.0 } ] [
|
||||||
|
2 dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 1.0 2.0 3.0 4.0 }
|
||||||
|
{ 2.0 2.0 3.0 4.0 }
|
||||||
|
{ 3.0 2.0 3.0 4.0 }
|
||||||
|
} Mtranspose Mrows length
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||||
|
2 cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ cvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||||
|
2 cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mrows length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ cvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||||
|
2 cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ cvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||||
|
2 cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
cmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mrows length
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||||
|
2 zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ zvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||||
|
2 zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mrows length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ zvector{ C{ 3.0 1.0 } C{ 3.0 2.0 } C{ 3.0 3.0 } } ] [
|
||||||
|
2 zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mrows nth
|
||||||
|
] unit-test
|
||||||
|
[ zvector{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } } ] [
|
||||||
|
2 zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mcols nth
|
||||||
|
] unit-test
|
||||||
|
[ 3 ] [
|
||||||
|
zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mcols length
|
||||||
|
] unit-test
|
||||||
|
[ 4 ] [
|
||||||
|
zmatrix{
|
||||||
|
{ C{ 1.0 1.0 } C{ 2.0 1.0 } C{ 3.0 1.0 } C{ 4.0 1.0 } }
|
||||||
|
{ C{ 1.0 2.0 } C{ 2.0 2.0 } C{ 3.0 2.0 } C{ 4.0 2.0 } }
|
||||||
|
{ C{ 1.0 3.0 } C{ 2.0 3.0 } C{ 3.0 3.0 } C{ 4.0 3.0 } }
|
||||||
|
} Mtranspose Mrows length
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
! Msub
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 3.0 2.0 1.0 }
|
||||||
|
{ 0.0 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
smatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} 1 2 2 3 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ smatrix{
|
||||||
|
{ 3.0 0.0 }
|
||||||
|
{ 2.0 1.0 }
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
smatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} Mtranspose 2 1 3 2 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 3.0 2.0 1.0 }
|
||||||
|
{ 0.0 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} 1 2 2 3 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ dmatrix{
|
||||||
|
{ 3.0 0.0 }
|
||||||
|
{ 2.0 1.0 }
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
dmatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 3.0 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} Mtranspose 2 1 3 2 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ C{ 3.0 3.0 } 2.0 1.0 }
|
||||||
|
{ 0.0 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
cmatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} 1 2 2 3 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ cmatrix{
|
||||||
|
{ C{ 3.0 3.0 } 0.0 }
|
||||||
|
{ 2.0 1.0 }
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
cmatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} Mtranspose 2 1 3 2 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ C{ 3.0 3.0 } 2.0 1.0 }
|
||||||
|
{ 0.0 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
zmatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} 1 2 2 3 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ zmatrix{
|
||||||
|
{ C{ 3.0 3.0 } 0.0 }
|
||||||
|
{ 2.0 1.0 }
|
||||||
|
{ 1.0 0.0 }
|
||||||
|
} ] [
|
||||||
|
zmatrix{
|
||||||
|
{ 0.0 1.0 2.0 3.0 2.0 }
|
||||||
|
{ 1.0 0.0 C{ 3.0 3.0 } 2.0 1.0 }
|
||||||
|
{ 2.0 3.0 0.0 1.0 0.0 }
|
||||||
|
} Mtranspose 2 1 3 2 Msub
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
|
@ -0,0 +1,306 @@
|
||||||
|
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
||||||
|
combinators.lib combinators.short-circuit fry kernel locals macros
|
||||||
|
math math.blas.cblas math.blas.vectors math.blas.vectors.private
|
||||||
|
math.complex math.functions math.order multi-methods qualified
|
||||||
|
sequences sequences.private shuffle symbols ;
|
||||||
|
QUALIFIED: syntax
|
||||||
|
IN: math.blas.matrices
|
||||||
|
|
||||||
|
TUPLE: blas-matrix-base data ld rows cols transpose ;
|
||||||
|
TUPLE: float-blas-matrix < blas-matrix-base ;
|
||||||
|
TUPLE: double-blas-matrix < blas-matrix-base ;
|
||||||
|
TUPLE: float-complex-blas-matrix < blas-matrix-base ;
|
||||||
|
TUPLE: double-complex-blas-matrix < blas-matrix-base ;
|
||||||
|
|
||||||
|
C: <float-blas-matrix> float-blas-matrix
|
||||||
|
C: <double-blas-matrix> double-blas-matrix
|
||||||
|
C: <float-complex-blas-matrix> float-complex-blas-matrix
|
||||||
|
C: <double-complex-blas-matrix> double-complex-blas-matrix
|
||||||
|
|
||||||
|
METHOD: element-type { float-blas-matrix }
|
||||||
|
drop "float" ;
|
||||||
|
METHOD: element-type { double-blas-matrix }
|
||||||
|
drop "double" ;
|
||||||
|
METHOD: element-type { float-complex-blas-matrix }
|
||||||
|
drop "CBLAS_C" ;
|
||||||
|
METHOD: element-type { double-complex-blas-matrix }
|
||||||
|
drop "CBLAS_Z" ;
|
||||||
|
|
||||||
|
: Mtransposed? ( matrix -- ? )
|
||||||
|
transpose>> ; inline
|
||||||
|
: Mwidth ( matrix -- width )
|
||||||
|
dup Mtransposed? [ rows>> ] [ cols>> ] if ; inline
|
||||||
|
: Mheight ( matrix -- height )
|
||||||
|
dup Mtransposed? [ cols>> ] [ rows>> ] if ; inline
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: (blas-transpose) ( matrix -- integer )
|
||||||
|
transpose>> [ CblasTrans ] [ CblasNoTrans ] if ;
|
||||||
|
|
||||||
|
GENERIC: (blas-matrix-like) ( data ld rows cols transpose exemplar -- matrix )
|
||||||
|
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object float-blas-matrix }
|
||||||
|
drop <float-blas-matrix> ;
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object double-blas-matrix }
|
||||||
|
drop <double-blas-matrix> ;
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object float-complex-blas-matrix }
|
||||||
|
drop <float-complex-blas-matrix> ;
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object double-complex-blas-matrix }
|
||||||
|
drop <double-complex-blas-matrix> ;
|
||||||
|
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object float-blas-vector }
|
||||||
|
drop <float-blas-matrix> ;
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object double-blas-vector }
|
||||||
|
drop <double-blas-matrix> ;
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object float-complex-blas-vector }
|
||||||
|
drop <float-complex-blas-matrix> ;
|
||||||
|
METHOD: (blas-matrix-like) { object object object object object double-complex-blas-vector }
|
||||||
|
drop <double-complex-blas-matrix> ;
|
||||||
|
|
||||||
|
METHOD: (blas-vector-like) { object object object float-blas-matrix }
|
||||||
|
drop <float-blas-vector> ;
|
||||||
|
METHOD: (blas-vector-like) { object object object double-blas-matrix }
|
||||||
|
drop <double-blas-vector> ;
|
||||||
|
METHOD: (blas-vector-like) { object object object float-complex-blas-matrix }
|
||||||
|
drop <float-complex-blas-vector> ;
|
||||||
|
METHOD: (blas-vector-like) { object object object double-complex-blas-matrix }
|
||||||
|
drop <double-complex-blas-vector> ;
|
||||||
|
|
||||||
|
: (validate-gemv) ( A x y -- )
|
||||||
|
{
|
||||||
|
[ drop [ Mwidth ] [ length>> ] bi* = ]
|
||||||
|
[ nip [ Mheight ] [ length>> ] bi* = ]
|
||||||
|
} 3&&
|
||||||
|
[ "Mismatched matrix and vectors in matrix-vector multiplication" throw ] unless ;
|
||||||
|
|
||||||
|
:: (prepare-gemv) ( alpha A x beta y >c-arg -- order A-trans m n alpha A-data A-ld x-data x-inc beta y-data y-inc y )
|
||||||
|
A x y (validate-gemv)
|
||||||
|
CblasColMajor
|
||||||
|
A (blas-transpose)
|
||||||
|
A rows>>
|
||||||
|
A cols>>
|
||||||
|
alpha >c-arg call
|
||||||
|
A data>>
|
||||||
|
A ld>>
|
||||||
|
x data>>
|
||||||
|
x inc>>
|
||||||
|
beta >c-arg call
|
||||||
|
y data>>
|
||||||
|
y inc>>
|
||||||
|
y ; inline
|
||||||
|
|
||||||
|
: (validate-ger) ( x y A -- )
|
||||||
|
{
|
||||||
|
[ nip [ length>> ] [ Mheight ] bi* = ]
|
||||||
|
[ nipd [ length>> ] [ Mwidth ] bi* = ]
|
||||||
|
} 3&&
|
||||||
|
[ "Mismatched vertices and matrix in vector outer product" throw ] unless ;
|
||||||
|
|
||||||
|
:: (prepare-ger) ( alpha x y A >c-arg -- order m n alpha x-data x-inc y-data y-inc A-data A-ld A )
|
||||||
|
x y A (validate-ger)
|
||||||
|
CblasColMajor
|
||||||
|
A rows>>
|
||||||
|
A cols>>
|
||||||
|
alpha >c-arg call
|
||||||
|
x data>>
|
||||||
|
x inc>>
|
||||||
|
y data>>
|
||||||
|
y inc>>
|
||||||
|
A data>>
|
||||||
|
A ld>>
|
||||||
|
A f >>transpose ; inline
|
||||||
|
|
||||||
|
: (validate-gemm) ( A B C -- )
|
||||||
|
{
|
||||||
|
[ drop [ Mwidth ] [ Mheight ] bi* = ]
|
||||||
|
[ nip [ Mheight ] bi@ = ]
|
||||||
|
[ nipd [ Mwidth ] bi@ = ]
|
||||||
|
} 3&& [ "Mismatched matrices in matrix multiplication" throw ] unless ;
|
||||||
|
|
||||||
|
:: (prepare-gemm) ( alpha A B beta C >c-arg -- order A-trans B-trans m n k alpha A-data A-ld B-data B-ld beta C-data C-ld C )
|
||||||
|
A B C (validate-gemm)
|
||||||
|
CblasColMajor
|
||||||
|
A (blas-transpose)
|
||||||
|
B (blas-transpose)
|
||||||
|
C rows>>
|
||||||
|
C cols>>
|
||||||
|
A Mwidth
|
||||||
|
alpha >c-arg call
|
||||||
|
A data>>
|
||||||
|
A ld>>
|
||||||
|
B data>>
|
||||||
|
B ld>>
|
||||||
|
beta >c-arg call
|
||||||
|
C data>>
|
||||||
|
C ld>>
|
||||||
|
C f >>transpose ; inline
|
||||||
|
|
||||||
|
: (>matrix) ( arrays >c-array -- c-array ld rows cols transpose )
|
||||||
|
[ flip ] dip
|
||||||
|
'[ concat @ ] [ first length dup ] [ length ] tri f ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: >float-blas-matrix ( arrays -- matrix )
|
||||||
|
[ >c-float-array ] (>matrix) <float-blas-matrix> ;
|
||||||
|
: >double-blas-matrix ( arrays -- matrix )
|
||||||
|
[ >c-double-array ] (>matrix) <double-blas-matrix> ;
|
||||||
|
: >float-complex-blas-matrix ( arrays -- matrix )
|
||||||
|
[ (flatten-complex-sequence) >c-float-array ] (>matrix)
|
||||||
|
<float-complex-blas-matrix> ;
|
||||||
|
: >double-complex-blas-matrix ( arrays -- matrix )
|
||||||
|
[ (flatten-complex-sequence) >c-double-array ] (>matrix)
|
||||||
|
<double-complex-blas-matrix> ;
|
||||||
|
|
||||||
|
GENERIC: n*M.V+n*V-in-place ( alpha A x beta y -- y=alpha*A.x+b*y )
|
||||||
|
GENERIC: n*V(*)V+M-in-place ( alpha x y A -- A=alpha*x(*)y+A )
|
||||||
|
GENERIC: n*V(*)Vconj+M-in-place ( alpha x y A -- A=alpha*x(*)yconj+A )
|
||||||
|
GENERIC: n*M.M+n*M-in-place ( alpha A B beta C -- C=alpha*A.B+beta*C )
|
||||||
|
|
||||||
|
METHOD: n*M.V+n*V-in-place { real float-blas-matrix float-blas-vector real float-blas-vector }
|
||||||
|
[ ] (prepare-gemv) [ cblas_sgemv ] dip ;
|
||||||
|
METHOD: n*M.V+n*V-in-place { real double-blas-matrix double-blas-vector real double-blas-vector }
|
||||||
|
[ ] (prepare-gemv) [ cblas_dgemv ] dip ;
|
||||||
|
METHOD: n*M.V+n*V-in-place { number float-complex-blas-matrix float-complex-blas-vector number float-complex-blas-vector }
|
||||||
|
[ (>c-complex) ] (prepare-gemv) [ cblas_cgemv ] dip ;
|
||||||
|
METHOD: n*M.V+n*V-in-place { number double-complex-blas-matrix double-complex-blas-vector number double-complex-blas-vector }
|
||||||
|
[ (>z-complex) ] (prepare-gemv) [ cblas_zgemv ] dip ;
|
||||||
|
|
||||||
|
METHOD: n*V(*)V+M-in-place { real float-blas-vector float-blas-vector float-blas-matrix }
|
||||||
|
[ ] (prepare-ger) [ cblas_sger ] dip ;
|
||||||
|
METHOD: n*V(*)V+M-in-place { real double-blas-vector double-blas-vector double-blas-matrix }
|
||||||
|
[ ] (prepare-ger) [ cblas_dger ] dip ;
|
||||||
|
METHOD: n*V(*)V+M-in-place { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
|
||||||
|
[ (>c-complex) ] (prepare-ger) [ cblas_cgeru ] dip ;
|
||||||
|
METHOD: n*V(*)V+M-in-place { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
|
||||||
|
[ (>z-complex) ] (prepare-ger) [ cblas_zgeru ] dip ;
|
||||||
|
|
||||||
|
METHOD: n*V(*)Vconj+M-in-place { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
|
||||||
|
[ (>c-complex) ] (prepare-ger) [ cblas_cgerc ] dip ;
|
||||||
|
METHOD: n*V(*)Vconj+M-in-place { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
|
||||||
|
[ (>z-complex) ] (prepare-ger) [ cblas_zgerc ] dip ;
|
||||||
|
|
||||||
|
METHOD: n*M.M+n*M-in-place { real float-blas-matrix float-blas-matrix real float-blas-matrix }
|
||||||
|
[ ] (prepare-gemm) [ cblas_sgemm ] dip ;
|
||||||
|
METHOD: n*M.M+n*M-in-place { real double-blas-matrix double-blas-matrix real double-blas-matrix }
|
||||||
|
[ ] (prepare-gemm) [ cblas_dgemm ] dip ;
|
||||||
|
METHOD: n*M.M+n*M-in-place { number float-complex-blas-matrix float-complex-blas-matrix number float-complex-blas-matrix }
|
||||||
|
[ (>c-complex) ] (prepare-gemm) [ cblas_cgemm ] dip ;
|
||||||
|
METHOD: n*M.M+n*M-in-place { number double-complex-blas-matrix double-complex-blas-matrix number double-complex-blas-matrix }
|
||||||
|
[ (>z-complex) ] (prepare-gemm) [ cblas_zgemm ] dip ;
|
||||||
|
|
||||||
|
! XXX should do a dense clone
|
||||||
|
syntax:M: blas-matrix-base clone
|
||||||
|
[
|
||||||
|
[
|
||||||
|
{ data>> ld>> cols>> element-type } get-slots
|
||||||
|
heap-size * * memory>byte-array
|
||||||
|
] [ { ld>> rows>> cols>> transpose>> } get-slots ] bi
|
||||||
|
] keep (blas-matrix-like) ;
|
||||||
|
|
||||||
|
! XXX try rounding stride to next 128 bit bound for better vectorizin'
|
||||||
|
: empty-matrix ( rows cols exemplar -- matrix )
|
||||||
|
[ element-type [ * ] dip <c-array> ]
|
||||||
|
[ 2drop ]
|
||||||
|
[ f swap (blas-matrix-like) ] 3tri ;
|
||||||
|
|
||||||
|
: n*M.V+n*V ( alpha A x beta y -- alpha*A.x+b*y )
|
||||||
|
clone n*M.V+n*V-in-place ;
|
||||||
|
: n*V(*)V+M ( alpha x y A -- alpha*x(*)y+A )
|
||||||
|
clone n*V(*)V+M-in-place ;
|
||||||
|
: n*V(*)Vconj+M ( alpha x y A -- alpha*x(*)yconj+A )
|
||||||
|
clone n*V(*)Vconj+M-in-place ;
|
||||||
|
: n*M.M+n*M ( alpha A B beta C -- alpha*A.B+beta*C )
|
||||||
|
clone n*M.M+n*M-in-place ;
|
||||||
|
|
||||||
|
: n*M.V ( alpha A x -- alpha*A.x )
|
||||||
|
1.0 2over [ Mheight ] dip empty-vector
|
||||||
|
n*M.V+n*V-in-place ; inline
|
||||||
|
|
||||||
|
: M.V ( A x -- A.x )
|
||||||
|
1.0 -rot n*M.V ; inline
|
||||||
|
|
||||||
|
: n*V(*)V ( n x y -- n*x(*)y )
|
||||||
|
2dup [ length>> ] bi@ pick empty-matrix
|
||||||
|
n*V(*)V+M-in-place ;
|
||||||
|
: n*V(*)Vconj ( n x y -- n*x(*)yconj )
|
||||||
|
2dup [ length>> ] bi@ pick empty-matrix
|
||||||
|
n*V(*)Vconj+M-in-place ;
|
||||||
|
|
||||||
|
: V(*) ( x y -- x(*)y )
|
||||||
|
1.0 -rot n*V(*)V ; inline
|
||||||
|
: V(*)conj ( x y -- x(*)yconj )
|
||||||
|
1.0 -rot n*V(*)Vconj ; inline
|
||||||
|
|
||||||
|
: n*M.M ( n A B -- n*A.B )
|
||||||
|
2dup [ Mheight ] [ Mwidth ] bi* pick empty-matrix
|
||||||
|
1.0 swap n*M.M+n*M-in-place ;
|
||||||
|
|
||||||
|
: M. ( A B -- A.B )
|
||||||
|
1.0 -rot n*M.M ; inline
|
||||||
|
|
||||||
|
:: (Msub) ( matrix row col height width -- data ld rows cols )
|
||||||
|
matrix ld>> col * row + matrix element-type heap-size *
|
||||||
|
matrix data>> <displaced-alien>
|
||||||
|
matrix ld>>
|
||||||
|
height
|
||||||
|
width ;
|
||||||
|
|
||||||
|
: Msub ( matrix row col height width -- submatrix )
|
||||||
|
5 npick dup transpose>>
|
||||||
|
[ nip [ [ swap ] 2dip swap ] when (Msub) ] 2keep
|
||||||
|
swap (blas-matrix-like) ;
|
||||||
|
|
||||||
|
TUPLE: blas-matrix-rowcol-sequence parent inc rowcol-length rowcol-jump length ;
|
||||||
|
C: <blas-matrix-rowcol-sequence> blas-matrix-rowcol-sequence
|
||||||
|
|
||||||
|
INSTANCE: blas-matrix-rowcol-sequence sequence
|
||||||
|
|
||||||
|
syntax:M: blas-matrix-rowcol-sequence length
|
||||||
|
length>> ;
|
||||||
|
syntax:M: blas-matrix-rowcol-sequence nth-unsafe
|
||||||
|
{
|
||||||
|
[
|
||||||
|
[ rowcol-jump>> ]
|
||||||
|
[ parent>> element-type heap-size ]
|
||||||
|
[ parent>> data>> ] tri
|
||||||
|
[ * * ] dip <displaced-alien>
|
||||||
|
]
|
||||||
|
[ rowcol-length>> ]
|
||||||
|
[ inc>> ]
|
||||||
|
[ parent>> ]
|
||||||
|
} cleave (blas-vector-like) ;
|
||||||
|
|
||||||
|
: (Mcols) ( A -- columns )
|
||||||
|
{ [ ] [ drop 1 ] [ rows>> ] [ ld>> ] [ cols>> ] } cleave
|
||||||
|
<blas-matrix-rowcol-sequence> ;
|
||||||
|
: (Mrows) ( A -- rows )
|
||||||
|
{ [ ] [ ld>> ] [ cols>> ] [ drop 1 ] [ rows>> ] } cleave
|
||||||
|
<blas-matrix-rowcol-sequence> ;
|
||||||
|
|
||||||
|
: Mrows ( A -- rows )
|
||||||
|
dup transpose>> [ (Mcols) ] [ (Mrows) ] if ;
|
||||||
|
: Mcols ( A -- rows )
|
||||||
|
dup transpose>> [ (Mrows) ] [ (Mcols) ] if ;
|
||||||
|
|
||||||
|
: n*M-in-place ( n A -- A=n*A )
|
||||||
|
[ (Mcols) [ n*V-in-place drop ] with each ] keep ;
|
||||||
|
|
||||||
|
: n*M ( n A -- n*A )
|
||||||
|
clone n*M-in-place ; inline
|
||||||
|
|
||||||
|
: M*n ( A n -- A*n )
|
||||||
|
swap n*M ; inline
|
||||||
|
: M/n ( A n -- A/n )
|
||||||
|
recip swap n*M ; inline
|
||||||
|
|
||||||
|
: Mtranspose ( matrix -- matrix^T )
|
||||||
|
[ { data>> ld>> rows>> cols>> transpose>> } get-slots not ] keep (blas-matrix-like) ;
|
||||||
|
|
||||||
|
syntax:M: blas-matrix-base equal?
|
||||||
|
{
|
||||||
|
[ [ Mwidth ] bi@ = ]
|
||||||
|
[ [ Mcols ] bi@ [ = ] 2all? ]
|
||||||
|
} 2&& ;
|
||||||
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
BLAS level 2 and 3 matrix-vector and matrix-matrix operations
|
||||||
|
|
@ -0,0 +1,2 @@
|
||||||
|
math
|
||||||
|
bindings
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
USING: kernel math.blas.vectors parser ;
|
USING: kernel math.blas.matrices math.blas.vectors parser ;
|
||||||
IN: math.blas.syntax
|
IN: math.blas.syntax
|
||||||
|
|
||||||
: svector{ ( accum -- accum )
|
: svector{ ( accum -- accum )
|
||||||
|
|
@ -10,3 +10,11 @@ IN: math.blas.syntax
|
||||||
: zvector{ ( accum -- accum )
|
: zvector{ ( accum -- accum )
|
||||||
\ } [ >double-complex-blas-vector ] parse-literal ; parsing
|
\ } [ >double-complex-blas-vector ] parse-literal ; parsing
|
||||||
|
|
||||||
|
: smatrix{ ( accum -- accum )
|
||||||
|
\ } [ >float-blas-matrix ] parse-literal ; parsing
|
||||||
|
: dmatrix{ ( accum -- accum )
|
||||||
|
\ } [ >double-blas-matrix ] parse-literal ; parsing
|
||||||
|
: cmatrix{ ( accum -- accum )
|
||||||
|
\ } [ >float-complex-blas-matrix ] parse-literal ; parsing
|
||||||
|
: zmatrix{ ( accum -- accum )
|
||||||
|
\ } [ >double-complex-blas-matrix ] parse-literal ; parsing
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
||||||
fry kernel macros math math.blas.cblas math.complex math.functions
|
combinators.short-circuit fry kernel macros math math.blas.cblas
|
||||||
math.order multi-methods qualified sequences sequences.private
|
math.complex math.functions math.order multi-methods qualified
|
||||||
shuffle ;
|
sequences sequences.private shuffle ;
|
||||||
QUALIFIED: syntax
|
QUALIFIED: syntax
|
||||||
IN: math.blas.vectors
|
IN: math.blas.vectors
|
||||||
|
|
||||||
|
|
@ -135,10 +135,10 @@ PRIVATE>
|
||||||
[ length>> 0 ]
|
[ length>> 0 ]
|
||||||
[ (blas-vector-like) ] tri ;
|
[ (blas-vector-like) ] tri ;
|
||||||
|
|
||||||
: empty-vector ( exemplar -- empty-vector )
|
: empty-vector ( length exemplar -- empty-vector )
|
||||||
[ [ length>> ] [ element-type ] bi <c-array> ]
|
[ element-type <c-array> ]
|
||||||
[ length>> 1 ]
|
[ 1 swap ] 2bi
|
||||||
[ (blas-vector-like) ] tri ;
|
(blas-vector-like) ;
|
||||||
|
|
||||||
syntax:M: blas-vector-base length
|
syntax:M: blas-vector-base length
|
||||||
length>> ;
|
length>> ;
|
||||||
|
|
@ -163,6 +163,12 @@ syntax:M: double-complex-blas-vector nth-unsafe
|
||||||
syntax:M: double-complex-blas-vector set-nth-unsafe
|
syntax:M: double-complex-blas-vector set-nth-unsafe
|
||||||
(prepare-nth) (set-z-complex-nth) ;
|
(prepare-nth) (set-z-complex-nth) ;
|
||||||
|
|
||||||
|
syntax:M: blas-vector-base equal?
|
||||||
|
{
|
||||||
|
[ [ length ] bi@ = ]
|
||||||
|
[ [ = ] 2all? ]
|
||||||
|
} 2&& ;
|
||||||
|
|
||||||
: >float-blas-vector ( seq -- v )
|
: >float-blas-vector ( seq -- v )
|
||||||
[ >c-float-array ] [ length ] bi 1 <float-blas-vector> ;
|
[ >c-float-array ] [ length ] bi 1 <float-blas-vector> ;
|
||||||
: >double-blas-vector ( seq -- v )
|
: >double-blas-vector ( seq -- v )
|
||||||
|
|
@ -218,22 +224,21 @@ METHOD: n*V-in-place { number double-complex-blas-vector }
|
||||||
[ (>z-complex) ] dip
|
[ (>z-complex) ] dip
|
||||||
(prepare-scal) [ cblas_zscal ] dip ;
|
(prepare-scal) [ cblas_zscal ] dip ;
|
||||||
|
|
||||||
: n*V+V ( n v1 v2 -- n*v1+v2 ) clone n*V+V-in-place ;
|
: n*V+V ( n v1 v2 -- n*v1+v2 ) clone n*V+V-in-place ; inline
|
||||||
: n*V ( n v1 -- n*v1 ) clone n*V-in-place ;
|
: n*V ( n v1 -- n*v1 ) clone n*V-in-place ; inline
|
||||||
! : n*V ( n v1 -- n*v1 ) dup empty-vector n*V+V-in-place ; ! XXX which is faster?
|
|
||||||
|
|
||||||
: V+ ( v1 v2 -- v1+v2 )
|
: V+ ( v1 v2 -- v1+v2 )
|
||||||
1.0 -rot n*V+V ;
|
1.0 -rot n*V+V ; inline
|
||||||
: V- ( v1 v2 -- v1-v2 )
|
: V- ( v1 v2 -- v1-v2 )
|
||||||
-1.0 spin n*V+V ;
|
-1.0 spin n*V+V ; inline
|
||||||
|
|
||||||
: Vneg ( v1 -- -v1 )
|
: Vneg ( v1 -- -v1 )
|
||||||
[ zero-vector ] keep V- ;
|
[ zero-vector ] keep V- ; inline
|
||||||
|
|
||||||
: V*n ( v n -- v*n )
|
: V*n ( v n -- v*n )
|
||||||
swap n*V ;
|
swap n*V ; inline
|
||||||
: V/n ( v n -- v*n )
|
: V/n ( v n -- v*n )
|
||||||
recip swap n*V ;
|
recip swap n*V ; inline
|
||||||
|
|
||||||
METHOD: V. { float-blas-vector float-blas-vector }
|
METHOD: V. { float-blas-vector float-blas-vector }
|
||||||
(prepare-dot) cblas_sdot ;
|
(prepare-dot) cblas_sdot ;
|
||||||
|
|
@ -281,4 +286,4 @@ METHOD: Viamax { double-complex-blas-vector }
|
||||||
(prepare-nrm2) cblas_izamax ;
|
(prepare-nrm2) cblas_izamax ;
|
||||||
|
|
||||||
: Vamax ( v -- max )
|
: Vamax ( v -- max )
|
||||||
[ Viamax ] keep nth ;
|
[ Viamax ] keep nth ; inline
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue