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
|
||||
|
||||
: svector{ ( accum -- accum )
|
||||
|
|
@ -10,3 +10,11 @@ IN: math.blas.syntax
|
|||
: zvector{ ( accum -- accum )
|
||||
\ } [ >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
|
||||
fry kernel macros math math.blas.cblas math.complex math.functions
|
||||
math.order multi-methods qualified sequences sequences.private
|
||||
shuffle ;
|
||||
combinators.short-circuit fry kernel macros math math.blas.cblas
|
||||
math.complex math.functions math.order multi-methods qualified
|
||||
sequences sequences.private shuffle ;
|
||||
QUALIFIED: syntax
|
||||
IN: math.blas.vectors
|
||||
|
||||
|
|
@ -135,10 +135,10 @@ PRIVATE>
|
|||
[ length>> 0 ]
|
||||
[ (blas-vector-like) ] tri ;
|
||||
|
||||
: empty-vector ( exemplar -- empty-vector )
|
||||
[ [ length>> ] [ element-type ] bi <c-array> ]
|
||||
[ length>> 1 ]
|
||||
[ (blas-vector-like) ] tri ;
|
||||
: empty-vector ( length exemplar -- empty-vector )
|
||||
[ element-type <c-array> ]
|
||||
[ 1 swap ] 2bi
|
||||
(blas-vector-like) ;
|
||||
|
||||
syntax:M: blas-vector-base length
|
||||
length>> ;
|
||||
|
|
@ -163,6 +163,12 @@ syntax:M: double-complex-blas-vector nth-unsafe
|
|||
syntax:M: double-complex-blas-vector set-nth-unsafe
|
||||
(prepare-nth) (set-z-complex-nth) ;
|
||||
|
||||
syntax:M: blas-vector-base equal?
|
||||
{
|
||||
[ [ length ] bi@ = ]
|
||||
[ [ = ] 2all? ]
|
||||
} 2&& ;
|
||||
|
||||
: >float-blas-vector ( seq -- v )
|
||||
[ >c-float-array ] [ length ] bi 1 <float-blas-vector> ;
|
||||
: >double-blas-vector ( seq -- v )
|
||||
|
|
@ -218,22 +224,21 @@ METHOD: n*V-in-place { number double-complex-blas-vector }
|
|||
[ (>z-complex) ] dip
|
||||
(prepare-scal) [ cblas_zscal ] dip ;
|
||||
|
||||
: n*V+V ( n v1 v2 -- n*v1+v2 ) clone n*V+V-in-place ;
|
||||
: n*V ( n v1 -- n*v1 ) clone n*V-in-place ;
|
||||
! : n*V ( n v1 -- n*v1 ) dup empty-vector n*V+V-in-place ; ! XXX which is faster?
|
||||
: 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 ; inline
|
||||
|
||||
: V+ ( v1 v2 -- v1+v2 )
|
||||
1.0 -rot n*V+V ;
|
||||
1.0 -rot n*V+V ; inline
|
||||
: V- ( v1 v2 -- v1-v2 )
|
||||
-1.0 spin n*V+V ;
|
||||
-1.0 spin n*V+V ; inline
|
||||
|
||||
: Vneg ( v1 -- -v1 )
|
||||
[ zero-vector ] keep V- ;
|
||||
[ zero-vector ] keep V- ; inline
|
||||
|
||||
: V*n ( v n -- v*n )
|
||||
swap n*V ;
|
||||
swap n*V ; inline
|
||||
: V/n ( v n -- v*n )
|
||||
recip swap n*V ;
|
||||
recip swap n*V ; inline
|
||||
|
||||
METHOD: V. { float-blas-vector float-blas-vector }
|
||||
(prepare-dot) cblas_sdot ;
|
||||
|
|
@ -281,4 +286,4 @@ METHOD: Viamax { double-complex-blas-vector }
|
|||
(prepare-nrm2) cblas_izamax ;
|
||||
|
||||
: Vamax ( v -- max )
|
||||
[ Viamax ] keep nth ;
|
||||
[ Viamax ] keep nth ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue