--- /dev/null
+USING: alien alien.c-types alien.syntax kernel system combinators ;
+IN: math.blas.cblas
+
+<< "cblas" {
+ { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] }
+ { [ os windows? ] [ "blas.dll" "cdecl" add-library ] }
+ { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] }
+ { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] }
+ [ "libblas.so" "cdecl" add-library ]
+} cond >>
+
+LIBRARY: cblas
+
+TYPEDEF: int CBLAS_ORDER
+: CblasRowMajor 101 ; inline
+: CblasColMajor 102 ; inline
+
+TYPEDEF: int CBLAS_TRANSPOSE
+: CblasNoTrans 111 ; inline
+: CblasTrans 112 ; inline
+: CblasConjTrans 113 ; inline
+
+TYPEDEF: int CBLAS_UPLO
+: CblasUpper 121 ; inline
+: CblasLower 122 ; inline
+
+TYPEDEF: int CBLAS_DIAG
+: CblasNonUnit 131 ; inline
+: CblasUnit 132 ; inline
+
+TYPEDEF: int CBLAS_SIDE
+: CblasLeft 141 ; inline
+: CblasRight 142 ; inline
+
+TYPEDEF: int CBLAS_INDEX
+
+C-STRUCT: float-complex
+ { "float" "real" }
+ { "float" "imag" } ;
+C-STRUCT: double-complex
+ { "double" "real" }
+ { "double" "imag" } ;
+
+! Level 1 BLAS (scalar-vector and vector-vector)
+
+FUNCTION: float cblas_sdsdot
+ ( int N, float alpha, float* X, int incX, float* Y, int incY ) ;
+FUNCTION: double cblas_dsdot
+ ( int N, float* X, int incX, float* Y, int incY ) ;
+FUNCTION: float cblas_sdot
+ ( int N, float* X, int incX, float* Y, int incY ) ;
+FUNCTION: double cblas_ddot
+ ( int N, double* X, int incX, double* Y, int incY ) ;
+
+FUNCTION: void cblas_cdotu_sub
+ ( int N, void* X, int incX, void* Y, int incY, void* dotu ) ;
+FUNCTION: void cblas_cdotc_sub
+ ( int N, void* X, int incX, void* Y, int incY, void* dotc ) ;
+
+FUNCTION: void cblas_zdotu_sub
+ ( int N, void* X, int incX, void* Y, int incY, void* dotu ) ;
+FUNCTION: void cblas_zdotc_sub
+ ( int N, void* X, int incX, void* Y, int incY, void* dotc ) ;
+
+FUNCTION: float cblas_snrm2
+ ( int N, float* X, int incX ) ;
+FUNCTION: float cblas_sasum
+ ( int N, float* X, int incX ) ;
+
+FUNCTION: double cblas_dnrm2
+ ( int N, double* X, int incX ) ;
+FUNCTION: double cblas_dasum
+ ( int N, double* X, int incX ) ;
+
+FUNCTION: float cblas_scnrm2
+ ( int N, void* X, int incX ) ;
+FUNCTION: float cblas_scasum
+ ( int N, void* X, int incX ) ;
+
+FUNCTION: double cblas_dznrm2
+ ( int N, void* X, int incX ) ;
+FUNCTION: double cblas_dzasum
+ ( int N, void* X, int incX ) ;
+
+FUNCTION: CBLAS_INDEX cblas_isamax
+ ( int N, float* X, int incX ) ;
+FUNCTION: CBLAS_INDEX cblas_idamax
+ ( int N, double* X, int incX ) ;
+FUNCTION: CBLAS_INDEX cblas_icamax
+ ( int N, void* X, int incX ) ;
+FUNCTION: CBLAS_INDEX cblas_izamax
+ ( int N, void* X, int incX ) ;
+
+FUNCTION: void cblas_sswap
+ ( int N, float* X, int incX, float* Y, int incY ) ;
+FUNCTION: void cblas_scopy
+ ( int N, float* X, int incX, float* Y, int incY ) ;
+FUNCTION: void cblas_saxpy
+ ( int N, float alpha, float* X, int incX, float* Y, int incY ) ;
+
+FUNCTION: void cblas_dswap
+ ( int N, double* X, int incX, double* Y, int incY ) ;
+FUNCTION: void cblas_dcopy
+ ( int N, double* X, int incX, double* Y, int incY ) ;
+FUNCTION: void cblas_daxpy
+ ( int N, double alpha, double* X, int incX, double* Y, int incY ) ;
+
+FUNCTION: void cblas_cswap
+ ( int N, void* X, int incX, void* Y, int incY ) ;
+FUNCTION: void cblas_ccopy
+ ( int N, void* X, int incX, void* Y, int incY ) ;
+FUNCTION: void cblas_caxpy
+ ( int N, void* alpha, void* X, int incX, void* Y, int incY ) ;
+
+FUNCTION: void cblas_zswap
+ ( int N, void* X, int incX, void* Y, int incY ) ;
+FUNCTION: void cblas_zcopy
+ ( int N, void* X, int incX, void* Y, int incY ) ;
+FUNCTION: void cblas_zaxpy
+ ( int N, void* alpha, void* X, int incX, void* Y, int incY ) ;
+
+FUNCTION: void cblas_sscal
+ ( int N, float alpha, float* X, int incX ) ;
+FUNCTION: void cblas_dscal
+ ( int N, double alpha, double* X, int incX ) ;
+FUNCTION: void cblas_cscal
+ ( int N, void* alpha, void* X, int incX ) ;
+FUNCTION: void cblas_zscal
+ ( int N, void* alpha, void* X, int incX ) ;
+FUNCTION: void cblas_csscal
+ ( int N, float alpha, void* X, int incX ) ;
+FUNCTION: void cblas_zdscal
+ ( int N, double alpha, void* X, int incX ) ;
+
+FUNCTION: void cblas_srotg
+ ( float* a, float* b, float* c, float* s ) ;
+FUNCTION: void cblas_srotmg
+ ( float* d1, float* d2, float* b1, float b2, float* P ) ;
+FUNCTION: void cblas_srot
+ ( int N, float* X, int incX, float* Y, int incY, float c, float s ) ;
+FUNCTION: void cblas_srotm
+ ( int N, float* X, int incX, float* Y, int incY, float* P ) ;
+
+FUNCTION: void cblas_drotg
+ ( double* a, double* b, double* c, double* s ) ;
+FUNCTION: void cblas_drotmg
+ ( double* d1, double* d2, double* b1, double b2, double* P ) ;
+FUNCTION: void cblas_drot
+ ( int N, double* X, int incX, double* Y, int incY, double c, double s ) ;
+FUNCTION: void cblas_drotm
+ ( int N, double* X, int incX, double* Y, int incY, double* P ) ;
+
+! Level 2 BLAS (matrix-vector)
+
+FUNCTION: void cblas_sgemv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ float alpha, float* A, int lda,
+ float* X, int incX, float beta,
+ float* Y, int incY ) ;
+FUNCTION: void cblas_sgbmv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ int KL, int KU, float alpha,
+ float* A, int lda, float* X,
+ int incX, float beta, float* Y, int incY ) ;
+FUNCTION: void cblas_strmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, float* A, int lda,
+ float* X, int incX ) ;
+FUNCTION: void cblas_stbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, float* A, int lda,
+ float* X, int incX ) ;
+FUNCTION: void cblas_stpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, float* Ap, float* X, int incX ) ;
+FUNCTION: void cblas_strsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, float* A, int lda, float* X,
+ int incX ) ;
+FUNCTION: void cblas_stbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, float* A, int lda,
+ float* X, int incX ) ;
+FUNCTION: void cblas_stpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, float* Ap, float* X, int incX ) ;
+
+FUNCTION: void cblas_dgemv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ double alpha, double* A, int lda,
+ double* X, int incX, double beta,
+ double* Y, int incY ) ;
+FUNCTION: void cblas_dgbmv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ int KL, int KU, double alpha,
+ double* A, int lda, double* X,
+ int incX, double beta, double* Y, int incY ) ;
+FUNCTION: void cblas_dtrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, double* A, int lda,
+ double* X, int incX ) ;
+FUNCTION: void cblas_dtbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, double* A, int lda,
+ double* X, int incX ) ;
+FUNCTION: void cblas_dtpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, double* Ap, double* X, int incX ) ;
+FUNCTION: void cblas_dtrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, double* A, int lda, double* X,
+ int incX ) ;
+FUNCTION: void cblas_dtbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, double* A, int lda,
+ double* X, int incX ) ;
+FUNCTION: void cblas_dtpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, double* Ap, double* X, int incX ) ;
+
+FUNCTION: void cblas_cgemv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ void* alpha, void* A, int lda,
+ void* X, int incX, void* beta,
+ void* Y, int incY ) ;
+FUNCTION: void cblas_cgbmv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ int KL, int KU, void* alpha,
+ void* A, int lda, void* X,
+ int incX, void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_ctrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* A, int lda,
+ void* X, int incX ) ;
+FUNCTION: void cblas_ctbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, void* A, int lda,
+ void* X, int incX ) ;
+FUNCTION: void cblas_ctpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* Ap, void* X, int incX ) ;
+FUNCTION: void cblas_ctrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* A, int lda, void* X,
+ int incX ) ;
+FUNCTION: void cblas_ctbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, void* A, int lda,
+ void* X, int incX ) ;
+FUNCTION: void cblas_ctpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* Ap, void* X, int incX ) ;
+
+FUNCTION: void cblas_zgemv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ void* alpha, void* A, int lda,
+ void* X, int incX, void* beta,
+ void* Y, int incY ) ;
+FUNCTION: void cblas_zgbmv ( CBLAS_ORDER Order,
+ CBLAS_TRANSPOSE TransA, int M, int N,
+ int KL, int KU, void* alpha,
+ void* A, int lda, void* X,
+ int incX, void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_ztrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* A, int lda,
+ void* X, int incX ) ;
+FUNCTION: void cblas_ztbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, void* A, int lda,
+ void* X, int incX ) ;
+FUNCTION: void cblas_ztpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* Ap, void* X, int incX ) ;
+FUNCTION: void cblas_ztrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* A, int lda, void* X,
+ int incX ) ;
+FUNCTION: void cblas_ztbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, int K, void* A, int lda,
+ void* X, int incX ) ;
+FUNCTION: void cblas_ztpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
+ int N, void* Ap, void* X, int incX ) ;
+
+
+FUNCTION: void cblas_ssymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, float* A,
+ int lda, float* X, int incX,
+ float beta, float* Y, int incY ) ;
+FUNCTION: void cblas_ssbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, int K, float alpha, float* A,
+ int lda, float* X, int incX,
+ float beta, float* Y, int incY ) ;
+FUNCTION: void cblas_sspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, float* Ap,
+ float* X, int incX,
+ float beta, float* Y, int incY ) ;
+FUNCTION: void cblas_sger ( CBLAS_ORDER Order, int M, int N,
+ float alpha, float* X, int incX,
+ float* Y, int incY, float* A, int lda ) ;
+FUNCTION: void cblas_ssyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, float* X,
+ int incX, float* A, int lda ) ;
+FUNCTION: void cblas_sspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, float* X,
+ int incX, float* Ap ) ;
+FUNCTION: void cblas_ssyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, float* X,
+ int incX, float* Y, int incY, float* A,
+ int lda ) ;
+FUNCTION: void cblas_sspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, float* X,
+ int incX, float* Y, int incY, float* A ) ;
+
+FUNCTION: void cblas_dsymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, double* A,
+ int lda, double* X, int incX,
+ double beta, double* Y, int incY ) ;
+FUNCTION: void cblas_dsbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, int K, double alpha, double* A,
+ int lda, double* X, int incX,
+ double beta, double* Y, int incY ) ;
+FUNCTION: void cblas_dspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, double* Ap,
+ double* X, int incX,
+ double beta, double* Y, int incY ) ;
+FUNCTION: void cblas_dger ( CBLAS_ORDER Order, int M, int N,
+ double alpha, double* X, int incX,
+ double* Y, int incY, double* A, int lda ) ;
+FUNCTION: void cblas_dsyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, double* X,
+ int incX, double* A, int lda ) ;
+FUNCTION: void cblas_dspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, double* X,
+ int incX, double* Ap ) ;
+FUNCTION: void cblas_dsyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, double* X,
+ int incX, double* Y, int incY, double* A,
+ int lda ) ;
+FUNCTION: void cblas_dspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, double* X,
+ int incX, double* Y, int incY, double* A ) ;
+
+
+FUNCTION: void cblas_chemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, void* alpha, void* A,
+ int lda, void* X, int incX,
+ void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_chbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, int K, void* alpha, void* A,
+ int lda, void* X, int incX,
+ void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_chpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, void* alpha, void* Ap,
+ void* X, int incX,
+ void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_cgeru ( CBLAS_ORDER Order, int M, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* A, int lda ) ;
+FUNCTION: void cblas_cgerc ( CBLAS_ORDER Order, int M, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* A, int lda ) ;
+FUNCTION: void cblas_cher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, void* X, int incX,
+ void* A, int lda ) ;
+FUNCTION: void cblas_chpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, float alpha, void* X,
+ int incX, void* A ) ;
+FUNCTION: void cblas_cher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* A, int lda ) ;
+FUNCTION: void cblas_chpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* Ap ) ;
+
+FUNCTION: void cblas_zhemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, void* alpha, void* A,
+ int lda, void* X, int incX,
+ void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_zhbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, int K, void* alpha, void* A,
+ int lda, void* X, int incX,
+ void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_zhpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, void* alpha, void* Ap,
+ void* X, int incX,
+ void* beta, void* Y, int incY ) ;
+FUNCTION: void cblas_zgeru ( CBLAS_ORDER Order, int M, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* A, int lda ) ;
+FUNCTION: void cblas_zgerc ( CBLAS_ORDER Order, int M, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* A, int lda ) ;
+FUNCTION: void cblas_zher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, void* X, int incX,
+ void* A, int lda ) ;
+FUNCTION: void cblas_zhpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ int N, double alpha, void* X,
+ int incX, void* A ) ;
+FUNCTION: void cblas_zher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* A, int lda ) ;
+FUNCTION: void cblas_zhpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
+ void* alpha, void* X, int incX,
+ void* Y, int incY, void* Ap ) ;
+
+! Level 3 BLAS (matrix-matrix)
+
+FUNCTION: void cblas_sgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
+ CBLAS_TRANSPOSE TransB, int M, int N,
+ int K, float alpha, float* A,
+ int lda, float* B, int ldb,
+ float beta, float* C, int ldc ) ;
+FUNCTION: void cblas_ssymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, int M, int N,
+ float alpha, float* A, int lda,
+ float* B, int ldb, float beta,
+ float* C, int ldc ) ;
+FUNCTION: void cblas_ssyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ float alpha, float* A, int lda,
+ float beta, float* C, int ldc ) ;
+FUNCTION: void cblas_ssyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ float alpha, float* A, int lda,
+ float* B, int ldb, float beta,
+ float* C, int ldc ) ;
+FUNCTION: void cblas_strmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ float alpha, float* A, int lda,
+ float* B, int ldb ) ;
+FUNCTION: void cblas_strsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ float alpha, float* A, int lda,
+ float* B, int ldb ) ;
+
+FUNCTION: void cblas_dgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
+ CBLAS_TRANSPOSE TransB, int M, int N,
+ int K, double alpha, double* A,
+ int lda, double* B, int ldb,
+ double beta, double* C, int ldc ) ;
+FUNCTION: void cblas_dsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, int M, int N,
+ double alpha, double* A, int lda,
+ double* B, int ldb, double beta,
+ double* C, int ldc ) ;
+FUNCTION: void cblas_dsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ double alpha, double* A, int lda,
+ double beta, double* C, int ldc ) ;
+FUNCTION: void cblas_dsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ double alpha, double* A, int lda,
+ double* B, int ldb, double beta,
+ double* C, int ldc ) ;
+FUNCTION: void cblas_dtrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ double alpha, double* A, int lda,
+ double* B, int ldb ) ;
+FUNCTION: void cblas_dtrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ double alpha, double* A, int lda,
+ double* B, int ldb ) ;
+
+FUNCTION: void cblas_cgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
+ CBLAS_TRANSPOSE TransB, int M, int N,
+ int K, void* alpha, void* A,
+ int lda, void* B, int ldb,
+ void* beta, void* C, int ldc ) ;
+FUNCTION: void cblas_csymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, void* beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_csyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ void* alpha, void* A, int lda,
+ void* beta, void* C, int ldc ) ;
+FUNCTION: void cblas_csyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, void* beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_ctrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb ) ;
+FUNCTION: void cblas_ctrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb ) ;
+
+FUNCTION: void cblas_zgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
+ CBLAS_TRANSPOSE TransB, int M, int N,
+ int K, void* alpha, void* A,
+ int lda, void* B, int ldb,
+ void* beta, void* C, int ldc ) ;
+FUNCTION: void cblas_zsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, void* beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_zsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ void* alpha, void* A, int lda,
+ void* beta, void* C, int ldc ) ;
+FUNCTION: void cblas_zsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, void* beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_ztrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb ) ;
+FUNCTION: void cblas_ztrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
+ CBLAS_DIAG Diag, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb ) ;
+
+FUNCTION: void cblas_chemm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, void* beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_cherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ float alpha, void* A, int lda,
+ float beta, void* C, int ldc ) ;
+FUNCTION: void cblas_cher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, float beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_zhemm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
+ CBLAS_UPLO Uplo, int M, int N,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, void* beta,
+ void* C, int ldc ) ;
+FUNCTION: void cblas_zherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ double alpha, void* A, int lda,
+ double beta, void* C, int ldc ) ;
+FUNCTION: void cblas_zher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
+ CBLAS_TRANSPOSE Trans, int N, int K,
+ void* alpha, void* A, int lda,
+ void* B, int ldb, double beta,
+ void* C, int ldc ) ;
+
--- /dev/null
+Low-level bindings to the C Basic Linear Algebra Subroutines (BLAS) library
--- /dev/null
+math
+bindings
+unportable
--- /dev/null
+USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ;
+IN: math.blas.matrices
+
+ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
+"Factor provides an interface to high-performance vector and matrix math routines available in the system's BLAS library. A set of specialized types are provided for handling packed, unboxed vector data:"
+{ $subsection "math.blas-types" }
+"Scalar-vector and vector-vector operations are available in the " { $vocab-link "math.blas.vectors" } " vocabulary:"
+{ $subsection "math.blas.vectors" }
+"Vector-matrix and matrix-matrix operations are available in the " { $vocab-link "math.blas.matrices" } " vocabulary:"
+{ $subsection "math.blas.matrices" }
+"The low-level BLAS C interface can be accessed directly through the " { $vocab-link "math.blas.cblas" } " vocabulary." ;
+
+ARTICLE: "math.blas-types" "BLAS interface types"
+"BLAS vectors come in single- and double-precision, real and complex flavors:"
+{ $subsection float-blas-vector }
+{ $subsection double-blas-vector }
+{ $subsection float-complex-blas-vector }
+{ $subsection double-complex-blas-vector }
+"These vector types all follow the " { $link sequence } " protocol. In addition, there are corresponding types for matrix data:"
+{ $subsection float-blas-matrix }
+{ $subsection double-blas-matrix }
+{ $subsection float-complex-blas-matrix }
+{ $subsection double-complex-blas-matrix }
+"Syntax words are provided for constructing literal vectors and matrices in the " { $vocab-link "math.blas.syntax" } " vocabulary:"
+{ $subsection "math.blas.syntax" }
+"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:"
+{ $subsection <float-blas-vector> }
+{ $subsection <double-blas-vector> }
+{ $subsection <float-complex-blas-vector> }
+{ $subsection <double-complex-blas-vector> }
+{ $subsection <float-blas-matrix> }
+{ $subsection <double-blas-matrix> }
+{ $subsection <float-complex-blas-matrix> }
+{ $subsection <double-complex-blas-matrix> }
+"For the simple case of creating a dense, zero-filled vector or matrix, simple empty object constructors are provided:"
+{ $subsection <empty-vector> }
+{ $subsection <empty-matrix> }
+"BLAS vectors and matrices can also be constructed from other Factor sequences:"
+{ $subsection >float-blas-vector }
+{ $subsection >double-blas-vector }
+{ $subsection >float-complex-blas-vector }
+{ $subsection >double-complex-blas-vector }
+{ $subsection >float-blas-matrix }
+{ $subsection >double-blas-matrix }
+{ $subsection >float-complex-blas-matrix }
+{ $subsection >double-complex-blas-matrix } ;
+
+ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
+"Transposing and slicing matrices:"
+{ $subsection Mtranspose }
+{ $subsection Mrows }
+{ $subsection Mcols }
+{ $subsection Msub }
+"Matrix-vector products:"
+{ $subsection n*M.V+n*V! }
+{ $subsection n*M.V+n*V }
+{ $subsection n*M.V }
+{ $subsection M.V }
+"Vector outer products:"
+{ $subsection n*V(*)V+M! }
+{ $subsection n*V(*)Vconj+M! }
+{ $subsection n*V(*)V+M }
+{ $subsection n*V(*)Vconj+M }
+{ $subsection n*V(*)V }
+{ $subsection n*V(*)Vconj }
+{ $subsection V(*) }
+{ $subsection V(*)conj }
+"Matrix products:"
+{ $subsection n*M.M+n*M! }
+{ $subsection n*M.M+n*M }
+{ $subsection n*M.M }
+{ $subsection M. }
+"Scalar-matrix products:"
+{ $subsection n*M! }
+{ $subsection n*M }
+{ $subsection M*n }
+{ $subsection M/n } ;
+
+ABOUT: "math.blas.matrices"
+
+HELP: blas-matrix-base
+{ $class-description "The base class for all BLAS matrix types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:"
+{ $list
+ { { $link float-blas-matrix } }
+ { { $link double-blas-matrix } }
+ { { $link float-complex-blas-matrix } }
+ { { $link double-complex-blas-matrix } }
+}
+"All of these subclasses share the same tuple layout:"
+{ $list
+ { { $snippet "underlying" } " contains an alien pointer referencing or byte-array containing a packed, column-major array of float, double, float complex, or double complex values;" }
+ { { $snippet "ld" } " indicates the distance, in elements, between matrix columns;" }
+ { { $snippet "rows" } " and " { $snippet "cols" } " indicate the number of significant rows and columns in the matrix;" }
+ { "and " { $snippet "transpose" } ", if set to a true value, indicates that the matrix should be treated as transposed relative to its in-memory representation." }
+} } ;
+
+{ blas-vector-base blas-matrix-base } related-words
+
+HELP: float-blas-matrix
+{ $class-description "A matrix of single-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
+HELP: double-blas-matrix
+{ $class-description "A matrix of double-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
+HELP: float-complex-blas-matrix
+{ $class-description "A matrix of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
+HELP: double-complex-blas-matrix
+{ $class-description "A matrix of double-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
+
+{
+ float-blas-matrix double-blas-matrix float-complex-blas-matrix double-complex-blas-matrix
+ float-blas-vector double-blas-vector float-complex-blas-vector double-complex-blas-vector
+} related-words
+
+HELP: Mwidth
+{ $values { "matrix" blas-matrix-base } { "width" integer } }
+{ $description "Returns the number of columns in " { $snippet "matrix" } "." } ;
+
+HELP: Mheight
+{ $values { "matrix" blas-matrix-base } { "height" integer } }
+{ $description "Returns the number of rows in " { $snippet "matrix" } "." } ;
+
+{ Mwidth Mheight } related-words
+
+HELP: n*M.V+n*V!
+{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "y=alpha*A.x+b*y" blas-vector-base } }
+{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } ", and overwrite the current contents of " { $snippet "y" } " with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." }
+{ $side-effects "y" } ;
+
+HELP: n*V(*)V+M!
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)y+A" blas-matrix-base } }
+{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGER and xGERU routines in BLAS." }
+{ $side-effects "A" } ;
+
+HELP: n*V(*)Vconj+M!
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)yconj+A" blas-matrix-base } }
+{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGERC routines in BLAS." }
+{ $side-effects "A" } ;
+
+HELP: n*M.M+n*M!
+{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "C=alpha*A.B+beta*C" blas-matrix-base } }
+{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." }
+{ $side-effects "C" } ;
+
+HELP: <empty-matrix>
+{ $values { "rows" integer } { "cols" integer } { "exemplar" blas-vector-base blas-matrix-base } { "matrix" blas-matrix-base } }
+{ $description "Create a matrix of all zeros with the given dimensions and the same element type as " { $snippet "exemplar" } "." } ;
+
+{ <zero-vector> <empty-vector> <empty-matrix> } related-words
+
+HELP: n*M.V+n*V
+{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "alpha*A.x+b*y" blas-vector-base } }
+{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". The returned vector will have the same length as " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." } ;
+
+HELP: n*V(*)V+M
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)y+A" blas-matrix-base } }
+{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
+
+HELP: n*V(*)Vconj+M
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)yconj+A" blas-matrix-base } }
+{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGERC routines in BLAS." } ;
+
+HELP: n*M.M+n*M
+{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "alpha*A.B+beta*C" blas-matrix-base } }
+{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ;
+
+HELP: n*M.V
+{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "alpha*A.x" blas-vector-base } }
+{ $description "Calculate the matrix-vector product " { $snippet "αAx" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
+
+HELP: M.V
+{ $values { "A" blas-matrix-base } { "x" blas-vector-base } { "A.x" blas-vector-base } }
+{ $description "Calculate the matrix-vector product " { $snippet "Ax" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
+
+{ n*M.V+n*V! n*M.V+n*V n*M.V M.V } related-words
+
+HELP: n*V(*)V
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)y" blas-matrix-base } }
+{ $description "Calculate the outer product " { $snippet "αx⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
+
+HELP: n*V(*)Vconj
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)yconj" blas-matrix-base } }
+{ $description "Calculate the outer product " { $snippet "αx⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
+
+HELP: V(*)
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)y" blas-matrix-base } }
+{ $description "Calculate the outer product " { $snippet "x⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
+
+HELP: V(*)conj
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)yconj" blas-matrix-base } }
+{ $description "Calculate the conjugate outer product " { $snippet "x⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
+
+{ n*V(*)V+M! n*V(*)Vconj+M! n*V(*)V+M n*V(*)Vconj+M n*V(*)V n*V(*)Vconj V(*) V(*)conj V. V.conj } related-words
+
+HELP: n*M.M
+{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "alpha*A.B" blas-matrix-base } }
+{ $description "Calculate the matrix product " { $snippet "αAB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
+
+HELP: M.
+{ $values { "A" blas-matrix-base } { "B" blas-matrix-base } { "A.B" blas-matrix-base } }
+{ $description "Calculate the matrix product " { $snippet "AB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
+
+{ n*M.M+n*M! n*M.M+n*M n*M.M M. } related-words
+
+HELP: Msub
+{ $values { "matrix" blas-matrix-base } { "row" integer } { "col" integer } { "height" integer } { "width" integer } { "sub" blas-matrix-base } }
+{ $description "Select a rectangular submatrix of " { $snippet "matrix" } " with the given dimensions. The returned submatrix will share the parent matrix's storage." } ;
+
+HELP: Mrows
+{ $values { "A" blas-matrix-base } { "rows" sequence } }
+{ $description "Return a sequence of BLAS vectors representing the rows of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
+
+HELP: Mcols
+{ $values { "A" blas-matrix-base } { "cols" sequence } }
+{ $description "Return a sequence of BLAS vectors representing the columns of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
+
+HELP: n*M!
+{ $values { "n" number } { "A" blas-matrix-base } { "A=n*A" blas-matrix-base } }
+{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and overwrite the current contents of A with the result." }
+{ $side-effects "A" } ;
+
+HELP: n*M
+{ $values { "n" number } { "A" blas-matrix-base } { "n*A" blas-matrix-base } }
+{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
+
+HELP: M*n
+{ $values { "A" blas-matrix-base } { "n" number } { "A*n" blas-matrix-base } }
+{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
+
+HELP: M/n
+{ $values { "A" blas-matrix-base } { "n" number } { "A/n" blas-matrix-base } }
+{ $description "Calculate the scalar-matrix product " { $snippet "(1/n)A" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
+
+{ n*M! n*M M*n M/n } related-words
+
+HELP: Mtranspose
+{ $values { "matrix" blas-matrix-base } { "matrix^T" blas-matrix-base } }
+{ $description "Returns the transpose of " { $snippet "matrix" } ". The returned matrix shares storage with the original matrix." } ;
+
+HELP: element-type
+{ $values { "v" blas-vector-base blas-matrix-base } { "type" string } }
+{ $description "Return the C type of the elements in the given BLAS vector or matrix." } ;
+
+HELP: <empty-vector>
+{ $values { "length" "The length of the new vector" } { "exemplar" blas-vector-base blas-matrix-base } { "vector" blas-vector-base } }
+{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ;
+
--- /dev/null
+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
+
--- /dev/null
+USING: accessors alien alien.c-types arrays byte-arrays combinators
+combinators.short-circuit fry kernel locals macros
+math math.blas.cblas math.blas.vectors math.blas.vectors.private
+math.complex math.functions math.order functors words
+sequences sequences.merged sequences.private shuffle
+specialized-arrays.direct.float specialized-arrays.direct.double
+specialized-arrays.float specialized-arrays.double ;
+IN: math.blas.matrices
+
+TUPLE: blas-matrix-base underlying ld rows cols transpose ;
+
+: Mtransposed? ( matrix -- ? )
+ transpose>> ; inline
+: Mwidth ( matrix -- width )
+ dup Mtransposed? [ rows>> ] [ cols>> ] if ; inline
+: Mheight ( matrix -- height )
+ dup Mtransposed? [ cols>> ] [ rows>> ] if ; inline
+
+GENERIC: n*M.V+n*V! ( alpha A x beta y -- y=alpha*A.x+b*y )
+GENERIC: n*V(*)V+M! ( alpha x y A -- A=alpha*x(*)y+A )
+GENERIC: n*V(*)Vconj+M! ( alpha x y A -- A=alpha*x(*)yconj+A )
+GENERIC: n*M.M+n*M! ( alpha A B beta C -- C=alpha*A.B+beta*C )
+
+<PRIVATE
+
+: (blas-transpose) ( matrix -- integer )
+ transpose>> [ CblasTrans ] [ CblasNoTrans ] if ;
+
+GENERIC: (blas-matrix-like) ( data ld rows cols transpose exemplar -- matrix )
+
+: (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 underlying>>
+ A ld>>
+ x underlying>>
+ x inc>>
+ beta >c-arg call
+ y underlying>>
+ 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 underlying>>
+ x inc>>
+ y underlying>>
+ y inc>>
+ A underlying>>
+ 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 underlying>>
+ A ld>>
+ B underlying>>
+ B ld>>
+ beta >c-arg call
+ C underlying>>
+ C ld>>
+ C f >>transpose ; inline
+
+: (>matrix) ( arrays >c-array -- c-array ld rows cols transpose )
+ '[ <merged> @ ] [ length dup ] [ first length ] tri f ; inline
+
+PRIVATE>
+
+! XXX should do a dense clone
+M: blas-matrix-base clone
+ [
+ [ {
+ [ underlying>> ]
+ [ ld>> ]
+ [ cols>> ]
+ [ element-type heap-size ]
+ } cleave * * memory>byte-array ]
+ [ {
+ [ ld>> ]
+ [ rows>> ]
+ [ cols>> ]
+ [ transpose>> ]
+ } cleave ]
+ 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! ;
+: n*V(*)V+M ( alpha x y A -- alpha*x(*)y+A )
+ clone n*V(*)V+M! ;
+: n*V(*)Vconj+M ( alpha x y A -- alpha*x(*)yconj+A )
+ clone n*V(*)Vconj+M! ;
+: n*M.M+n*M ( alpha A B beta C -- alpha*A.B+beta*C )
+ clone n*M.M+n*M! ;
+
+: n*M.V ( alpha A x -- alpha*A.x )
+ 1.0 2over [ Mheight ] dip <empty-vector>
+ n*M.V+n*V! ; inline
+
+: M.V ( A x -- A.x )
+ 1.0 -rot n*M.V ; inline
+
+: n*V(*)V ( alpha x y -- alpha*x(*)y )
+ 2dup [ length>> ] bi@ pick <empty-matrix>
+ n*V(*)V+M! ;
+: n*V(*)Vconj ( alpha x y -- alpha*x(*)yconj )
+ 2dup [ length>> ] bi@ pick <empty-matrix>
+ n*V(*)Vconj+M! ;
+
+: 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 ( alpha A B -- alpha*A.B )
+ 2dup [ Mheight ] [ Mwidth ] bi* pick <empty-matrix>
+ 1.0 swap n*M.M+n*M! ;
+
+: 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 underlying>> <displaced-alien>
+ matrix ld>>
+ height
+ width ;
+
+:: Msub ( matrix row col height width -- sub )
+ matrix dup transpose>>
+ [ col row width height ]
+ [ row col height width ] if (Msub)
+ matrix transpose>> matrix (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
+
+M: blas-matrix-rowcol-sequence length
+ length>> ;
+M: blas-matrix-rowcol-sequence nth-unsafe
+ {
+ [
+ [ rowcol-jump>> ]
+ [ parent>> element-type heap-size ]
+ [ parent>> underlying>> ] 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 -- cols )
+ dup transpose>> [ (Mrows) ] [ (Mcols) ] if ;
+
+: n*M! ( n A -- A=n*A )
+ [ (Mcols) [ n*V! drop ] with each ] keep ;
+
+: n*M ( n A -- n*A )
+ clone n*M! ; 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 )
+ [ {
+ [ underlying>> ]
+ [ ld>> ] [ rows>> ]
+ [ cols>> ]
+ [ transpose>> not ]
+ } cleave ] keep (blas-matrix-like) ;
+
+M: blas-matrix-base equal?
+ {
+ [ [ Mwidth ] bi@ = ]
+ [ [ Mcols ] bi@ [ = ] 2all? ]
+ } 2&& ;
+
+<<
+
+FUNCTOR: (define-blas-matrix) ( TYPE T U C -- )
+
+VECTOR IS ${TYPE}-blas-vector
+<VECTOR> IS <${TYPE}-blas-vector>
+>ARRAY IS >${TYPE}-array
+TYPE>ARG IS ${TYPE}>arg
+XGEMV IS cblas_${T}gemv
+XGEMM IS cblas_${T}gemm
+XGERU IS cblas_${T}ger${U}
+XGERC IS cblas_${T}ger${C}
+
+MATRIX DEFINES ${TYPE}-blas-matrix
+<MATRIX> DEFINES <${TYPE}-blas-matrix>
+>MATRIX DEFINES >${TYPE}-blas-matrix
+
+WHERE
+
+TUPLE: MATRIX < blas-matrix-base ;
+: <MATRIX> ( underlying ld rows cols transpose -- matrix )
+ MATRIX boa ; inline
+
+M: MATRIX element-type
+ drop TYPE ;
+M: MATRIX (blas-matrix-like)
+ drop <MATRIX> execute ;
+M: VECTOR (blas-matrix-like)
+ drop <MATRIX> execute ;
+M: MATRIX (blas-vector-like)
+ drop <VECTOR> execute ;
+
+: >MATRIX ( arrays -- matrix )
+ [ >ARRAY execute underlying>> ] (>matrix)
+ <MATRIX> execute ;
+
+M: VECTOR n*M.V+n*V!
+ [ TYPE>ARG execute ] (prepare-gemv)
+ [ XGEMV execute ] dip ;
+M: MATRIX n*M.M+n*M!
+ [ TYPE>ARG execute ] (prepare-gemm)
+ [ XGEMM execute ] dip ;
+M: MATRIX n*V(*)V+M!
+ [ TYPE>ARG execute ] (prepare-ger)
+ [ XGERU execute ] dip ;
+M: MATRIX n*V(*)Vconj+M!
+ [ TYPE>ARG execute ] (prepare-ger)
+ [ XGERC execute ] dip ;
+
+;FUNCTOR
+
+
+: define-real-blas-matrix ( TYPE T -- )
+ "" "" (define-blas-matrix) ;
+: define-complex-blas-matrix ( TYPE T -- )
+ "u" "c" (define-blas-matrix) ;
+
+"float" "s" define-real-blas-matrix
+"double" "d" define-real-blas-matrix
+"float-complex" "c" define-complex-blas-matrix
+"double-complex" "z" define-complex-blas-matrix
+
+>>
--- /dev/null
+BLAS level 2 and 3 matrix-vector and matrix-matrix operations
--- /dev/null
+math
+bindings
+unportable
--- /dev/null
+Literal syntax for BLAS vectors and matrices
--- /dev/null
+USING: help.markup help.syntax math.blas.matrices math.blas.vectors multiline ;
+IN: math.blas.syntax
+
+ARTICLE: "math.blas.syntax" "BLAS interface literal syntax"
+"Vectors:"
+{ $subsection POSTPONE: svector{ }
+{ $subsection POSTPONE: dvector{ }
+{ $subsection POSTPONE: cvector{ }
+{ $subsection POSTPONE: zvector{ }
+"Matrices:"
+{ $subsection POSTPONE: smatrix{ }
+{ $subsection POSTPONE: dmatrix{ }
+{ $subsection POSTPONE: cmatrix{ }
+{ $subsection POSTPONE: zmatrix{ } ;
+
+ABOUT: "math.blas.syntax"
+
+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 }" }
+{ $description "Construct a literal " { $link double-blas-vector } "." } ;
+
+HELP: cvector{
+{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
+{ $description "Construct a literal " { $link float-complex-blas-vector } "." } ;
+
+HELP: zvector{
+{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
+{ $description "Construct a literal " { $link double-complex-blas-vector } "." } ;
+
+{
+ POSTPONE: svector{ POSTPONE: dvector{
+ POSTPONE: cvector{ POSTPONE: zvector{
+} related-words
+
+HELP: smatrix{
+{ $syntax <" smatrix{
+ { 1.0 0.0 0.0 1.0 }
+ { 0.0 1.0 0.0 2.0 }
+ { 0.0 0.0 1.0 3.0 }
+ { 0.0 0.0 0.0 1.0 }
+} "> }
+{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
+
+HELP: dmatrix{
+{ $syntax <" dmatrix{
+ { 1.0 0.0 0.0 1.0 }
+ { 0.0 1.0 0.0 2.0 }
+ { 0.0 0.0 1.0 3.0 }
+ { 0.0 0.0 0.0 1.0 }
+} "> }
+{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
+
+HELP: cmatrix{
+{ $syntax <" cmatrix{
+ { 1.0 0.0 0.0 1.0 }
+ { 0.0 C{ 0.0 1.0 } 0.0 2.0 }
+ { 0.0 0.0 -1.0 3.0 }
+ { 0.0 0.0 0.0 C{ 0.0 -1.0 } }
+} "> }
+{ $description "Construct a literal " { $link float-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
+
+HELP: zmatrix{
+{ $syntax <" zmatrix{
+ { 1.0 0.0 0.0 1.0 }
+ { 0.0 C{ 0.0 1.0 } 0.0 2.0 }
+ { 0.0 0.0 -1.0 3.0 }
+ { 0.0 0.0 0.0 C{ 0.0 -1.0 } }
+} "> }
+{ $description "Construct a literal " { $link double-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
+
+{
+ POSTPONE: smatrix{ POSTPONE: dmatrix{
+ POSTPONE: cmatrix{ POSTPONE: zmatrix{
+} related-words
--- /dev/null
+USING: kernel math.blas.vectors math.blas.matrices parser
+arrays prettyprint.backend sequences ;
+IN: math.blas.syntax
+
+: svector{
+ \ } [ >float-blas-vector ] parse-literal ; parsing
+: dvector{
+ \ } [ >double-blas-vector ] parse-literal ; parsing
+: cvector{
+ \ } [ >float-complex-blas-vector ] parse-literal ; parsing
+: zvector{
+ \ } [ >double-complex-blas-vector ] parse-literal ; parsing
+
+: smatrix{
+ \ } [ >float-blas-matrix ] parse-literal ; parsing
+: dmatrix{
+ \ } [ >double-blas-matrix ] parse-literal ; parsing
+: cmatrix{
+ \ } [ >float-complex-blas-matrix ] parse-literal ; parsing
+: zmatrix{
+ \ } [ >double-complex-blas-matrix ] parse-literal ; parsing
+
+M: float-blas-vector pprint-delims
+ drop \ svector{ \ } ;
+M: double-blas-vector pprint-delims
+ drop \ dvector{ \ } ;
+M: float-complex-blas-vector pprint-delims
+ drop \ cvector{ \ } ;
+M: double-complex-blas-vector pprint-delims
+ drop \ zvector{ \ } ;
+
+M: float-blas-matrix pprint-delims
+ drop \ smatrix{ \ } ;
+M: double-blas-matrix pprint-delims
+ drop \ dmatrix{ \ } ;
+M: float-complex-blas-matrix pprint-delims
+ drop \ cmatrix{ \ } ;
+M: double-complex-blas-matrix pprint-delims
+ drop \ zmatrix{ \ } ;
+
+M: blas-vector-base >pprint-sequence ;
+M: blas-vector-base pprint* pprint-object ;
+M: blas-matrix-base >pprint-sequence Mrows ;
+M: blas-matrix-base pprint* pprint-object ;
--- /dev/null
+math
+unportable
--- /dev/null
+BLAS level 1 vector operations
--- /dev/null
+math
+unportable
--- /dev/null
+USING: alien byte-arrays help.markup help.syntax math sequences ;
+IN: math.blas.vectors
+
+ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
+"Slicing vectors:"
+{ $subsection Vsub }
+"Taking the norm (magnitude) of a vector:"
+{ $subsection Vnorm }
+"Summing and taking the maximum of elements:"
+{ $subsection Vasum }
+{ $subsection Viamax }
+{ $subsection Vamax }
+"Scalar-vector products:"
+{ $subsection n*V! }
+{ $subsection n*V }
+{ $subsection V*n }
+{ $subsection V/n }
+{ $subsection Vneg }
+"Vector addition:"
+{ $subsection n*V+V! }
+{ $subsection n*V+V }
+{ $subsection V+ }
+{ $subsection V- }
+"Vector inner products:"
+{ $subsection V. }
+{ $subsection V.conj } ;
+
+ABOUT: "math.blas.vectors"
+
+HELP: blas-vector-base
+{ $class-description "The base class for all BLAS vector types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:"
+{ $list
+ { { $link float-blas-vector } }
+ { { $link double-blas-vector } }
+ { { $link float-complex-blas-vector } }
+ { { $link double-complex-blas-vector } }
+}
+"All of these subclasses share the same tuple layout:"
+{ $list
+ { { $snippet "underlying" } " contains an alien pointer referencing or byte-array containing a packed array of float, double, float complex, or double complex values;" }
+ { { $snippet "length" } " indicates the length of the vector;" }
+ { "and " { $snippet "inc" } " indicates the distance, in elements, between elements." }
+} } ;
+
+HELP: float-blas-vector
+{ $class-description "A vector of single-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
+HELP: double-blas-vector
+{ $class-description "A vector of double-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
+HELP: float-complex-blas-vector
+{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
+HELP: double-complex-blas-vector
+{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
+
+HELP: n*V+V!
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "y=alpha*x+y" blas-vector-base } }
+{ $description "Calculate the vector sum " { $snippet "αx + y" } " and replace the existing contents of y with the result. Corresponds to the xAXPY routines in BLAS." }
+{ $side-effects "y" } ;
+
+HELP: n*V!
+{ $values { "alpha" number } { "x" blas-vector-base } { "x=alpha*x" blas-vector-base } }
+{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and replace the existing contents of x with the result. Corresponds to the xSCAL routines in BLAS." }
+{ $side-effects "x" } ;
+
+HELP: V.
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x.y" number } }
+{ $description "Calculate the inner product " { $snippet "x⋅y" } ". Corresponds to the xDOT and xDOTU routines in BLAS." } ;
+
+HELP: V.conj
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "xconj.y" number } }
+{ $description "Calculate the conjugate inner product " { $snippet "x̅⋅y" } ". Corresponds to the xDOTC routines in BLAS." } ;
+
+HELP: Vnorm
+{ $values { "x" blas-vector-base } { "norm" number } }
+{ $description "Calculate the norm-2, i.e., the magnitude or absolute value, of " { $snippet "x" } " (" { $snippet "‖x‖₂" } "). Corresponds to the xNRM2 routines in BLAS." } ;
+
+HELP: Vasum
+{ $values { "x" blas-vector-base } { "sum" number } }
+{ $description "Calculate the sum of the norm-1s of the elements of " { $snippet "x" } " (" { $snippet "Σ ‖xᵢ‖₁" } "). Corresponds to the xASUM routines in BLAS." } ;
+
+HELP: Vswap
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x=y" blas-vector-base } { "y=x" blas-vector-base } }
+{ $description "Swap the contents of " { $snippet "x" } " and " { $snippet "y" } " in place. Corresponds to the xSWAP routines in BLAS." }
+{ $side-effects "x" "y" } ;
+
+HELP: Viamax
+{ $values { "x" blas-vector-base } { "max-i" integer } }
+{ $description "Return the index of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the smallest index. Corresponds to the IxAMAX routines in BLAS." } ;
+
+HELP: Vamax
+{ $values { "x" blas-vector-base } { "max" number } }
+{ $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the first element. Corresponds to the IxAMAX routines in BLAS." } ;
+
+{ Viamax Vamax } related-words
+
+HELP: <zero-vector>
+{ $values { "exemplar" blas-vector-base } { "zero" blas-vector-base } }
+{ $description "Return a vector of zeros with the same length and element type as " { $snippet "v" } ". The vector is constructed with an " { $snippet "inc" } " of zero, so it is not suitable for receiving results from BLAS functions; it is intended to be used as a term in other vector calculations. To construct an empty vector that can be used to receive results, see " { $link <empty-vector> } "." } ;
+
+HELP: n*V+V
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x+y" blas-vector-base } }
+{ $description "Calculate the vector sum " { $snippet "αx + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
+
+HELP: n*V
+{ $values { "alpha" "a number" } { "x" blas-vector-base } { "alpha*x" blas-vector-base } }
+{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
+
+HELP: V+
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x+y" blas-vector-base } }
+{ $description "Calculate the vector sum " { $snippet "x + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
+
+HELP: V-
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x-y" blas-vector-base } }
+{ $description "Calculate the vector difference " { $snippet "x – y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
+
+HELP: Vneg
+{ $values { "x" blas-vector-base } { "-x" blas-vector-base } }
+{ $description "Negate the elements of " { $snippet "x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result." } ;
+
+HELP: V*n
+{ $values { "x" blas-vector-base } { "alpha" number } { "x*alpha" blas-vector-base } }
+{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
+
+HELP: V/n
+{ $values { "x" blas-vector-base } { "alpha" number } { "x/alpha" blas-vector-base } }
+{ $description "Calculate the scalar-vector product " { $snippet "(1/α)x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
+
+{ n*V+V! n*V! n*V+V n*V V+ V- Vneg V*n V/n } related-words
+
+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." } ;
--- /dev/null
+USING: kernel math.blas.vectors math.blas.syntax sequences tools.test ;
+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
+
+! 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
+
+[ 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
+
+[ 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
+
+! 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
+
+[ 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 } }
+ [ set-nth ] keep
+] unit-test
+[ 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 } }
+ [ 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
+
+[ 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+ ]
+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
+
+[ 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- ]
+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
+
+[ 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
+
+[ 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 ]
+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
+
+[ 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 ]
+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
+
+[ 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 ]
+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
+
+! 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
+
+! Vnorm
+
+[ 5.0 ] [ svector{ 3.0 4.0 } Vnorm ] unit-test
+[ 5.0 ] [ dvector{ 3.0 4.0 } Vnorm ] unit-test
+
+[ 13.0 ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
+[ 13.0 ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] 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
+
+[ 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 ]
+unit-test
+
+[ 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 ]
+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 ]
+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
+
+! 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
+
+! 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
--- /dev/null
+USING: accessors alien alien.c-types arrays byte-arrays combinators
+combinators.short-circuit fry kernel math math.blas.cblas
+math.complex math.functions math.order sequences.complex
+sequences.complex-components sequences sequences.private
+functors words locals
+specialized-arrays.float specialized-arrays.double
+specialized-arrays.direct.float specialized-arrays.direct.double ;
+IN: math.blas.vectors
+
+TUPLE: blas-vector-base underlying length inc ;
+
+INSTANCE: blas-vector-base virtual-sequence
+
+GENERIC: element-type ( v -- type )
+
+GENERIC: n*V+V! ( alpha x y -- y=alpha*x+y )
+GENERIC: n*V! ( alpha x -- x=alpha*x )
+GENERIC: V. ( x y -- x.y )
+GENERIC: V.conj ( x y -- xconj.y )
+GENERIC: Vnorm ( x -- norm )
+GENERIC: Vasum ( x -- sum )
+GENERIC: Vswap ( x y -- x=y y=x )
+GENERIC: Viamax ( x -- max-i )
+
+<PRIVATE
+
+GENERIC: (blas-vector-like) ( data length inc exemplar -- vector )
+
+GENERIC: (blas-direct-array) ( blas-vector -- direct-array )
+
+: shorter-length ( v1 v2 -- length )
+ [ length>> ] bi@ min ; inline
+: data-and-inc ( v -- data inc )
+ [ underlying>> ] [ inc>> ] bi ; inline
+: datas-and-incs ( v1 v2 -- v1-data v1-inc v2-data v2-inc )
+ [ data-and-inc ] bi@ ; inline
+
+:: (prepare-copy)
+ ( v element-size -- length v-data v-inc v-dest-data v-dest-inc
+ copy-data copy-length copy-inc )
+ v [ length>> ] [ data-and-inc ] bi
+ v length>> element-size * <byte-array>
+ 1
+ over v length>> 1 ;
+
+: (prepare-swap)
+ ( v1 v2 -- length v1-data v1-inc v2-data v2-inc
+ v1 v2 )
+ [ shorter-length ] [ datas-and-incs ] [ ] 2tri ;
+
+:: (prepare-axpy)
+ ( n v1 v2 -- length n v1-data v1-inc v2-data v2-inc
+ v2 )
+ v1 v2 shorter-length
+ n
+ v1 v2 datas-and-incs
+ v2 ;
+
+:: (prepare-scal)
+ ( n v -- length n v-data v-inc
+ v )
+ v length>>
+ n
+ v data-and-inc
+ v ;
+
+: (prepare-dot) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc )
+ [ shorter-length ] [ datas-and-incs ] 2bi ;
+
+: (prepare-nrm2) ( v -- length data inc )
+ [ length>> ] [ data-and-inc ] bi ;
+
+PRIVATE>
+
+: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline
+: n*V ( alpha x -- alpha*x ) clone n*V! ; inline
+
+: V+ ( x y -- x+y )
+ 1.0 -rot n*V+V ; inline
+: V- ( x y -- x-y )
+ -1.0 spin n*V+V ; inline
+
+: Vneg ( x -- -x )
+ -1.0 swap n*V ; inline
+
+: V*n ( x alpha -- x*alpha )
+ swap n*V ; inline
+: V/n ( x alpha -- x/alpha )
+ recip swap n*V ; inline
+
+: Vamax ( x -- max )
+ [ Viamax ] keep nth ; inline
+
+:: Vsub ( v start length -- sub )
+ v inc>> start * v element-type heap-size *
+ v underlying>> <displaced-alien>
+ length v inc>> v (blas-vector-like) ;
+
+: <zero-vector> ( exemplar -- zero )
+ [ element-type <c-object> ]
+ [ length>> 0 ]
+ [ (blas-vector-like) ] tri ;
+
+: <empty-vector> ( length exemplar -- vector )
+ [ element-type <c-array> ]
+ [ 1 swap ] 2bi
+ (blas-vector-like) ;
+
+M: blas-vector-base equal?
+ {
+ [ [ length ] bi@ = ]
+ [ [ = ] 2all? ]
+ } 2&& ;
+
+M: blas-vector-base length
+ length>> ;
+M: blas-vector-base virtual-seq
+ (blas-direct-array) ;
+M: blas-vector-base virtual@
+ [ inc>> * ] [ nip (blas-direct-array) ] 2bi ;
+
+: float>arg ( f -- f ) ; inline
+: double>arg ( f -- f ) ; inline
+: arg>float ( f -- f ) ; inline
+: arg>double ( f -- f ) ; inline
+
+<<
+
+FUNCTOR: (define-blas-vector) ( TYPE T -- )
+
+<DIRECT-ARRAY> IS <direct-${TYPE}-array>
+>ARRAY IS >${TYPE}-array
+XCOPY IS cblas_${T}copy
+XSWAP IS cblas_${T}swap
+IXAMAX IS cblas_i${T}amax
+
+VECTOR DEFINES ${TYPE}-blas-vector
+<VECTOR> DEFINES <${TYPE}-blas-vector>
+>VECTOR DEFINES >${TYPE}-blas-vector
+
+WHERE
+
+TUPLE: VECTOR < blas-vector-base ;
+: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
+
+: >VECTOR ( seq -- v )
+ [ >ARRAY execute underlying>> ] [ length ] bi 1 <VECTOR> execute ;
+
+M: VECTOR clone
+ TYPE heap-size (prepare-copy)
+ [ XCOPY execute ] 3dip <VECTOR> execute ;
+
+M: VECTOR element-type
+ drop TYPE ;
+M: VECTOR Vswap
+ (prepare-swap) [ XSWAP execute ] 2dip ;
+M: VECTOR Viamax
+ (prepare-nrm2) IXAMAX execute ;
+
+M: VECTOR (blas-vector-like)
+ drop <VECTOR> execute ;
+
+M: VECTOR (blas-direct-array)
+ [ underlying>> ]
+ [ [ length>> ] [ inc>> ] bi * ] bi
+ <DIRECT-ARRAY> execute ;
+
+;FUNCTOR
+
+
+FUNCTOR: (define-real-blas-vector) ( TYPE T -- )
+
+VECTOR IS ${TYPE}-blas-vector
+XDOT IS cblas_${T}dot
+XNRM2 IS cblas_${T}nrm2
+XASUM IS cblas_${T}asum
+XAXPY IS cblas_${T}axpy
+XSCAL IS cblas_${T}scal
+
+WHERE
+
+M: VECTOR V.
+ (prepare-dot) XDOT execute ;
+M: VECTOR V.conj
+ (prepare-dot) XDOT execute ;
+M: VECTOR Vnorm
+ (prepare-nrm2) XNRM2 execute ;
+M: VECTOR Vasum
+ (prepare-nrm2) XASUM execute ;
+M: VECTOR n*V+V!
+ (prepare-axpy) [ XAXPY execute ] dip ;
+M: VECTOR n*V!
+ (prepare-scal) [ XSCAL execute ] dip ;
+
+;FUNCTOR
+
+
+FUNCTOR: (define-complex-helpers) ( TYPE -- )
+
+<DIRECT-COMPLEX-ARRAY> DEFINES <direct-${TYPE}-complex-array>
+>COMPLEX-ARRAY DEFINES >${TYPE}-complex-array
+ARG>COMPLEX DEFINES arg>${TYPE}-complex
+COMPLEX>ARG DEFINES ${TYPE}-complex>arg
+<DIRECT-ARRAY> IS <direct-${TYPE}-array>
+>ARRAY IS >${TYPE}-array
+
+WHERE
+
+: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
+ 1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
+: >COMPLEX-ARRAY ( sequence -- sequence )
+ <complex-components> >ARRAY execute ;
+: COMPLEX>ARG ( complex -- alien )
+ >rect 2array >ARRAY execute underlying>> ;
+: ARG>COMPLEX ( alien -- complex )
+ 2 <DIRECT-ARRAY> execute first2 rect> ;
+
+;FUNCTOR
+
+
+FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- )
+
+VECTOR IS ${TYPE}-blas-vector
+XDOTU_SUB IS cblas_${C}dotu_sub
+XDOTC_SUB IS cblas_${C}dotc_sub
+XXNRM2 IS cblas_${S}${C}nrm2
+XXASUM IS cblas_${S}${C}asum
+XAXPY IS cblas_${C}axpy
+XSCAL IS cblas_${C}scal
+TYPE>ARG IS ${TYPE}>arg
+ARG>TYPE IS arg>${TYPE}
+
+WHERE
+
+M: VECTOR V.
+ (prepare-dot) TYPE <c-object>
+ [ XDOTU_SUB execute ] keep
+ ARG>TYPE execute ;
+M: VECTOR V.conj
+ (prepare-dot) TYPE <c-object>
+ [ XDOTC_SUB execute ] keep
+ ARG>TYPE execute ;
+M: VECTOR Vnorm
+ (prepare-nrm2) XXNRM2 execute ;
+M: VECTOR Vasum
+ (prepare-nrm2) XXASUM execute ;
+M: VECTOR n*V+V!
+ [ TYPE>ARG execute ] 2dip
+ (prepare-axpy) [ XAXPY execute ] dip ;
+M: VECTOR n*V!
+ [ TYPE>ARG execute ] dip
+ (prepare-scal) [ XSCAL execute ] dip ;
+
+;FUNCTOR
+
+
+: define-real-blas-vector ( TYPE T -- )
+ [ (define-blas-vector) ]
+ [ (define-real-blas-vector) ] 2bi ;
+:: define-complex-blas-vector ( TYPE C S -- )
+ TYPE (define-complex-helpers)
+ TYPE "-complex" append
+ [ C (define-blas-vector) ]
+ [ C S (define-complex-blas-vector) ] bi ;
+
+"float" "s" define-real-blas-vector
+"double" "d" define-real-blas-vector
+"float" "c" "s" define-complex-blas-vector
+"double" "z" "d" define-complex-blas-vector
+
+>>
+
--- /dev/null
+USING: help.markup help.syntax math multiline
+sequences sequences.complex-components ;
+IN: sequences.complex-components
+
+ARTICLE: "sequences.complex-components" "Complex component virtual sequences"
+"The " { $link complex-components } " class wraps a sequence of " { $link complex } " number values, presenting a sequence of " { $link real } " values made by interleaving the real and imaginary parts of the complex values in the original sequence."
+{ $subsection complex-components }
+{ $subsection <complex-components> } ;
+
+ABOUT: "sequences.complex-components"
+
+HELP: complex-components
+{ $class-description "Sequence wrapper class that transforms a sequence of " { $link complex } " number values into a sequence of " { $link real } " values, interleaving the real and imaginary parts of the complex values in the original sequence." }
+{ $examples { $example <"
+USING: prettyprint sequences arrays sequences.complex-components ;
+{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> >array .
+"> "{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ;
+
+HELP: <complex-components>
+{ $values { "sequence" sequence } { "complex-components" complex-components } }
+{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-components } " wrapper." }
+{ $examples
+{ $example <"
+USING: prettyprint sequences arrays
+sequences.complex-components ;
+{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> third .
+"> "-2.0" }
+{ $example <"
+USING: prettyprint sequences arrays
+sequences.complex-components ;
+{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> fourth .
+"> "0" }
+} ;
+
+{ complex-components <complex-components> } related-words
--- /dev/null
+USING: sequences.complex-components
+kernel sequences tools.test arrays accessors ;
+IN: sequences.complex-components.tests
+
+: test-array ( -- x )
+ { C{ 1.0 2.0 } 3.0 C{ 5.0 6.0 } } <complex-components> ;
+
+[ 6 ] [ test-array length ] unit-test
+
+[ 1.0 ] [ test-array first ] unit-test
+[ 2.0 ] [ test-array second ] unit-test
+[ 3.0 ] [ test-array third ] unit-test
+[ 0 ] [ test-array fourth ] unit-test
+
+[ { 1.0 2.0 3.0 0 5.0 6.0 } ] [ test-array >array ] unit-test
+
--- /dev/null
+USING: accessors kernel math math.functions combinators
+sequences sequences.private ;
+IN: sequences.complex-components
+
+TUPLE: complex-components seq ;
+INSTANCE: complex-components sequence
+
+: <complex-components> ( sequence -- complex-components )
+ complex-components boa ; inline
+
+<PRIVATE
+
+: complex-components@ ( n seq -- remainder n' seq' )
+ [ [ 1 bitand ] [ -1 shift ] bi ] [ seq>> ] bi* ; inline
+: complex-component ( remainder complex -- component )
+ swap {
+ { 0 [ real-part ] }
+ { 1 [ imaginary-part ] }
+ } case ;
+
+PRIVATE>
+
+M: complex-components length
+ seq>> length 1 shift ;
+M: complex-components nth-unsafe
+ complex-components@ nth-unsafe complex-component ;
+M: complex-components set-nth-unsafe
+ immutable ;
--- /dev/null
+Virtual sequence wrapper to convert complex values into real value pairs
--- /dev/null
+sequences
+math
--- /dev/null
+USING: help.markup help.syntax math multiline
+sequences sequences.complex ;
+IN: sequences.complex
+
+ARTICLE: "sequences.complex" "Complex virtual sequences"
+"The " { $link complex-sequence } " class wraps a sequence of " { $link real } " number values, presenting a sequence of " { $link complex } " values made by treating the underlying sequence as pairs of alternating real and imaginary values."
+{ $subsection complex-sequence }
+{ $subsection <complex-sequence> } ;
+
+ABOUT: "sequences.complex"
+
+HELP: complex-sequence
+{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." }
+{ $examples { $example <"
+USING: prettyprint
+specialized-arrays.double sequences.complex
+sequences arrays ;
+double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array .
+"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
+
+HELP: <complex-sequence>
+{ $values { "sequence" sequence } { "complex-sequence" complex-sequence } }
+{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." }
+{ $examples { $example <"
+USING: prettyprint
+specialized-arrays.double sequences.complex
+sequences arrays ;
+double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second .
+"> "C{ -2.0 2.0 }" } } ;
+
+{ complex-sequence <complex-sequence> } related-words
--- /dev/null
+USING: specialized-arrays.float sequences.complex
+kernel sequences tools.test arrays accessors ;
+IN: sequences.complex.tests
+
+: test-array ( -- x )
+ float-array{ 1.0 2.0 3.0 4.0 } clone <complex-sequence> ;
+: odd-length-test-array ( -- x )
+ float-array{ 1.0 2.0 3.0 4.0 5.0 } clone <complex-sequence> ;
+
+[ 2 ] [ test-array length ] unit-test
+[ 2 ] [ odd-length-test-array length ] unit-test
+
+[ C{ 1.0 2.0 } ] [ test-array first ] unit-test
+[ C{ 3.0 4.0 } ] [ test-array second ] unit-test
+
+[ { C{ 1.0 2.0 } C{ 3.0 4.0 } } ]
+[ test-array >array ] unit-test
+
+[ float-array{ 1.0 2.0 5.0 6.0 } ]
+[ test-array [ C{ 5.0 6.0 } 1 rot set-nth ] [ seq>> ] bi ]
+unit-test
+
+[ float-array{ 7.0 0.0 3.0 4.0 } ]
+[ test-array [ 7.0 0 rot set-nth ] [ seq>> ] bi ]
+unit-test
+
--- /dev/null
+USING: accessors kernel math math.functions
+sequences sequences.private ;
+IN: sequences.complex
+
+TUPLE: complex-sequence seq ;
+INSTANCE: complex-sequence sequence
+
+: <complex-sequence> ( sequence -- complex-sequence )
+ complex-sequence boa ; inline
+
+<PRIVATE
+
+: complex@ ( n seq -- n' seq' )
+ [ 1 shift ] [ seq>> ] bi* ; inline
+
+PRIVATE>
+
+M: complex-sequence length
+ seq>> length -1 shift ;
+M: complex-sequence nth-unsafe
+ complex@ [ nth-unsafe ] [ [ 1+ ] dip nth-unsafe ] 2bi rect> ;
+M: complex-sequence set-nth-unsafe
+ complex@
+ [ [ real-part ] [ ] [ ] tri* set-nth-unsafe ]
+ [ [ imaginary-part ] [ 1+ ] [ ] tri* set-nth-unsafe ] 3bi ;
--- /dev/null
+Virtual sequence wrapper to convert real pairs into complex values
--- /dev/null
+sequences
+math
+++ /dev/null
-USING: alien alien.c-types alien.syntax kernel system combinators ;
-IN: math.blas.cblas
-
-<< "cblas" {
- { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] }
- { [ os windows? ] [ "blas.dll" "cdecl" add-library ] }
- { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] }
- { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] }
- [ "libblas.so" "cdecl" add-library ]
-} cond >>
-
-LIBRARY: cblas
-
-TYPEDEF: int CBLAS_ORDER
-: CblasRowMajor 101 ; inline
-: CblasColMajor 102 ; inline
-
-TYPEDEF: int CBLAS_TRANSPOSE
-: CblasNoTrans 111 ; inline
-: CblasTrans 112 ; inline
-: CblasConjTrans 113 ; inline
-
-TYPEDEF: int CBLAS_UPLO
-: CblasUpper 121 ; inline
-: CblasLower 122 ; inline
-
-TYPEDEF: int CBLAS_DIAG
-: CblasNonUnit 131 ; inline
-: CblasUnit 132 ; inline
-
-TYPEDEF: int CBLAS_SIDE
-: CblasLeft 141 ; inline
-: CblasRight 142 ; inline
-
-TYPEDEF: int CBLAS_INDEX
-
-C-STRUCT: float-complex
- { "float" "real" }
- { "float" "imag" } ;
-C-STRUCT: double-complex
- { "double" "real" }
- { "double" "imag" } ;
-
-! Level 1 BLAS (scalar-vector and vector-vector)
-
-FUNCTION: float cblas_sdsdot
- ( int N, float alpha, float* X, int incX, float* Y, int incY ) ;
-FUNCTION: double cblas_dsdot
- ( int N, float* X, int incX, float* Y, int incY ) ;
-FUNCTION: float cblas_sdot
- ( int N, float* X, int incX, float* Y, int incY ) ;
-FUNCTION: double cblas_ddot
- ( int N, double* X, int incX, double* Y, int incY ) ;
-
-FUNCTION: void cblas_cdotu_sub
- ( int N, void* X, int incX, void* Y, int incY, void* dotu ) ;
-FUNCTION: void cblas_cdotc_sub
- ( int N, void* X, int incX, void* Y, int incY, void* dotc ) ;
-
-FUNCTION: void cblas_zdotu_sub
- ( int N, void* X, int incX, void* Y, int incY, void* dotu ) ;
-FUNCTION: void cblas_zdotc_sub
- ( int N, void* X, int incX, void* Y, int incY, void* dotc ) ;
-
-FUNCTION: float cblas_snrm2
- ( int N, float* X, int incX ) ;
-FUNCTION: float cblas_sasum
- ( int N, float* X, int incX ) ;
-
-FUNCTION: double cblas_dnrm2
- ( int N, double* X, int incX ) ;
-FUNCTION: double cblas_dasum
- ( int N, double* X, int incX ) ;
-
-FUNCTION: float cblas_scnrm2
- ( int N, void* X, int incX ) ;
-FUNCTION: float cblas_scasum
- ( int N, void* X, int incX ) ;
-
-FUNCTION: double cblas_dznrm2
- ( int N, void* X, int incX ) ;
-FUNCTION: double cblas_dzasum
- ( int N, void* X, int incX ) ;
-
-FUNCTION: CBLAS_INDEX cblas_isamax
- ( int N, float* X, int incX ) ;
-FUNCTION: CBLAS_INDEX cblas_idamax
- ( int N, double* X, int incX ) ;
-FUNCTION: CBLAS_INDEX cblas_icamax
- ( int N, void* X, int incX ) ;
-FUNCTION: CBLAS_INDEX cblas_izamax
- ( int N, void* X, int incX ) ;
-
-FUNCTION: void cblas_sswap
- ( int N, float* X, int incX, float* Y, int incY ) ;
-FUNCTION: void cblas_scopy
- ( int N, float* X, int incX, float* Y, int incY ) ;
-FUNCTION: void cblas_saxpy
- ( int N, float alpha, float* X, int incX, float* Y, int incY ) ;
-
-FUNCTION: void cblas_dswap
- ( int N, double* X, int incX, double* Y, int incY ) ;
-FUNCTION: void cblas_dcopy
- ( int N, double* X, int incX, double* Y, int incY ) ;
-FUNCTION: void cblas_daxpy
- ( int N, double alpha, double* X, int incX, double* Y, int incY ) ;
-
-FUNCTION: void cblas_cswap
- ( int N, void* X, int incX, void* Y, int incY ) ;
-FUNCTION: void cblas_ccopy
- ( int N, void* X, int incX, void* Y, int incY ) ;
-FUNCTION: void cblas_caxpy
- ( int N, void* alpha, void* X, int incX, void* Y, int incY ) ;
-
-FUNCTION: void cblas_zswap
- ( int N, void* X, int incX, void* Y, int incY ) ;
-FUNCTION: void cblas_zcopy
- ( int N, void* X, int incX, void* Y, int incY ) ;
-FUNCTION: void cblas_zaxpy
- ( int N, void* alpha, void* X, int incX, void* Y, int incY ) ;
-
-FUNCTION: void cblas_sscal
- ( int N, float alpha, float* X, int incX ) ;
-FUNCTION: void cblas_dscal
- ( int N, double alpha, double* X, int incX ) ;
-FUNCTION: void cblas_cscal
- ( int N, void* alpha, void* X, int incX ) ;
-FUNCTION: void cblas_zscal
- ( int N, void* alpha, void* X, int incX ) ;
-FUNCTION: void cblas_csscal
- ( int N, float alpha, void* X, int incX ) ;
-FUNCTION: void cblas_zdscal
- ( int N, double alpha, void* X, int incX ) ;
-
-FUNCTION: void cblas_srotg
- ( float* a, float* b, float* c, float* s ) ;
-FUNCTION: void cblas_srotmg
- ( float* d1, float* d2, float* b1, float b2, float* P ) ;
-FUNCTION: void cblas_srot
- ( int N, float* X, int incX, float* Y, int incY, float c, float s ) ;
-FUNCTION: void cblas_srotm
- ( int N, float* X, int incX, float* Y, int incY, float* P ) ;
-
-FUNCTION: void cblas_drotg
- ( double* a, double* b, double* c, double* s ) ;
-FUNCTION: void cblas_drotmg
- ( double* d1, double* d2, double* b1, double b2, double* P ) ;
-FUNCTION: void cblas_drot
- ( int N, double* X, int incX, double* Y, int incY, double c, double s ) ;
-FUNCTION: void cblas_drotm
- ( int N, double* X, int incX, double* Y, int incY, double* P ) ;
-
-! Level 2 BLAS (matrix-vector)
-
-FUNCTION: void cblas_sgemv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- float alpha, float* A, int lda,
- float* X, int incX, float beta,
- float* Y, int incY ) ;
-FUNCTION: void cblas_sgbmv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- int KL, int KU, float alpha,
- float* A, int lda, float* X,
- int incX, float beta, float* Y, int incY ) ;
-FUNCTION: void cblas_strmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, float* A, int lda,
- float* X, int incX ) ;
-FUNCTION: void cblas_stbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, float* A, int lda,
- float* X, int incX ) ;
-FUNCTION: void cblas_stpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, float* Ap, float* X, int incX ) ;
-FUNCTION: void cblas_strsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, float* A, int lda, float* X,
- int incX ) ;
-FUNCTION: void cblas_stbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, float* A, int lda,
- float* X, int incX ) ;
-FUNCTION: void cblas_stpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, float* Ap, float* X, int incX ) ;
-
-FUNCTION: void cblas_dgemv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- double alpha, double* A, int lda,
- double* X, int incX, double beta,
- double* Y, int incY ) ;
-FUNCTION: void cblas_dgbmv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- int KL, int KU, double alpha,
- double* A, int lda, double* X,
- int incX, double beta, double* Y, int incY ) ;
-FUNCTION: void cblas_dtrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, double* A, int lda,
- double* X, int incX ) ;
-FUNCTION: void cblas_dtbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, double* A, int lda,
- double* X, int incX ) ;
-FUNCTION: void cblas_dtpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, double* Ap, double* X, int incX ) ;
-FUNCTION: void cblas_dtrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, double* A, int lda, double* X,
- int incX ) ;
-FUNCTION: void cblas_dtbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, double* A, int lda,
- double* X, int incX ) ;
-FUNCTION: void cblas_dtpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, double* Ap, double* X, int incX ) ;
-
-FUNCTION: void cblas_cgemv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- void* alpha, void* A, int lda,
- void* X, int incX, void* beta,
- void* Y, int incY ) ;
-FUNCTION: void cblas_cgbmv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- int KL, int KU, void* alpha,
- void* A, int lda, void* X,
- int incX, void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_ctrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* A, int lda,
- void* X, int incX ) ;
-FUNCTION: void cblas_ctbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, void* A, int lda,
- void* X, int incX ) ;
-FUNCTION: void cblas_ctpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* Ap, void* X, int incX ) ;
-FUNCTION: void cblas_ctrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* A, int lda, void* X,
- int incX ) ;
-FUNCTION: void cblas_ctbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, void* A, int lda,
- void* X, int incX ) ;
-FUNCTION: void cblas_ctpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* Ap, void* X, int incX ) ;
-
-FUNCTION: void cblas_zgemv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- void* alpha, void* A, int lda,
- void* X, int incX, void* beta,
- void* Y, int incY ) ;
-FUNCTION: void cblas_zgbmv ( CBLAS_ORDER Order,
- CBLAS_TRANSPOSE TransA, int M, int N,
- int KL, int KU, void* alpha,
- void* A, int lda, void* X,
- int incX, void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_ztrmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* A, int lda,
- void* X, int incX ) ;
-FUNCTION: void cblas_ztbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, void* A, int lda,
- void* X, int incX ) ;
-FUNCTION: void cblas_ztpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* Ap, void* X, int incX ) ;
-FUNCTION: void cblas_ztrsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* A, int lda, void* X,
- int incX ) ;
-FUNCTION: void cblas_ztbsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, int K, void* A, int lda,
- void* X, int incX ) ;
-FUNCTION: void cblas_ztpsv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag,
- int N, void* Ap, void* X, int incX ) ;
-
-
-FUNCTION: void cblas_ssymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, float* A,
- int lda, float* X, int incX,
- float beta, float* Y, int incY ) ;
-FUNCTION: void cblas_ssbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, int K, float alpha, float* A,
- int lda, float* X, int incX,
- float beta, float* Y, int incY ) ;
-FUNCTION: void cblas_sspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, float* Ap,
- float* X, int incX,
- float beta, float* Y, int incY ) ;
-FUNCTION: void cblas_sger ( CBLAS_ORDER Order, int M, int N,
- float alpha, float* X, int incX,
- float* Y, int incY, float* A, int lda ) ;
-FUNCTION: void cblas_ssyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, float* X,
- int incX, float* A, int lda ) ;
-FUNCTION: void cblas_sspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, float* X,
- int incX, float* Ap ) ;
-FUNCTION: void cblas_ssyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, float* X,
- int incX, float* Y, int incY, float* A,
- int lda ) ;
-FUNCTION: void cblas_sspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, float* X,
- int incX, float* Y, int incY, float* A ) ;
-
-FUNCTION: void cblas_dsymv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, double* A,
- int lda, double* X, int incX,
- double beta, double* Y, int incY ) ;
-FUNCTION: void cblas_dsbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, int K, double alpha, double* A,
- int lda, double* X, int incX,
- double beta, double* Y, int incY ) ;
-FUNCTION: void cblas_dspmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, double* Ap,
- double* X, int incX,
- double beta, double* Y, int incY ) ;
-FUNCTION: void cblas_dger ( CBLAS_ORDER Order, int M, int N,
- double alpha, double* X, int incX,
- double* Y, int incY, double* A, int lda ) ;
-FUNCTION: void cblas_dsyr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, double* X,
- int incX, double* A, int lda ) ;
-FUNCTION: void cblas_dspr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, double* X,
- int incX, double* Ap ) ;
-FUNCTION: void cblas_dsyr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, double* X,
- int incX, double* Y, int incY, double* A,
- int lda ) ;
-FUNCTION: void cblas_dspr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, double* X,
- int incX, double* Y, int incY, double* A ) ;
-
-
-FUNCTION: void cblas_chemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, void* alpha, void* A,
- int lda, void* X, int incX,
- void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_chbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, int K, void* alpha, void* A,
- int lda, void* X, int incX,
- void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_chpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, void* alpha, void* Ap,
- void* X, int incX,
- void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_cgeru ( CBLAS_ORDER Order, int M, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* A, int lda ) ;
-FUNCTION: void cblas_cgerc ( CBLAS_ORDER Order, int M, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* A, int lda ) ;
-FUNCTION: void cblas_cher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, void* X, int incX,
- void* A, int lda ) ;
-FUNCTION: void cblas_chpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, float alpha, void* X,
- int incX, void* A ) ;
-FUNCTION: void cblas_cher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* A, int lda ) ;
-FUNCTION: void cblas_chpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* Ap ) ;
-
-FUNCTION: void cblas_zhemv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, void* alpha, void* A,
- int lda, void* X, int incX,
- void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_zhbmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, int K, void* alpha, void* A,
- int lda, void* X, int incX,
- void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_zhpmv ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, void* alpha, void* Ap,
- void* X, int incX,
- void* beta, void* Y, int incY ) ;
-FUNCTION: void cblas_zgeru ( CBLAS_ORDER Order, int M, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* A, int lda ) ;
-FUNCTION: void cblas_zgerc ( CBLAS_ORDER Order, int M, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* A, int lda ) ;
-FUNCTION: void cblas_zher ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, void* X, int incX,
- void* A, int lda ) ;
-FUNCTION: void cblas_zhpr ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- int N, double alpha, void* X,
- int incX, void* A ) ;
-FUNCTION: void cblas_zher2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* A, int lda ) ;
-FUNCTION: void cblas_zhpr2 ( CBLAS_ORDER Order, CBLAS_UPLO Uplo, int N,
- void* alpha, void* X, int incX,
- void* Y, int incY, void* Ap ) ;
-
-! Level 3 BLAS (matrix-matrix)
-
-FUNCTION: void cblas_sgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
- CBLAS_TRANSPOSE TransB, int M, int N,
- int K, float alpha, float* A,
- int lda, float* B, int ldb,
- float beta, float* C, int ldc ) ;
-FUNCTION: void cblas_ssymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, int M, int N,
- float alpha, float* A, int lda,
- float* B, int ldb, float beta,
- float* C, int ldc ) ;
-FUNCTION: void cblas_ssyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- float alpha, float* A, int lda,
- float beta, float* C, int ldc ) ;
-FUNCTION: void cblas_ssyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- float alpha, float* A, int lda,
- float* B, int ldb, float beta,
- float* C, int ldc ) ;
-FUNCTION: void cblas_strmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- float alpha, float* A, int lda,
- float* B, int ldb ) ;
-FUNCTION: void cblas_strsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- float alpha, float* A, int lda,
- float* B, int ldb ) ;
-
-FUNCTION: void cblas_dgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
- CBLAS_TRANSPOSE TransB, int M, int N,
- int K, double alpha, double* A,
- int lda, double* B, int ldb,
- double beta, double* C, int ldc ) ;
-FUNCTION: void cblas_dsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, int M, int N,
- double alpha, double* A, int lda,
- double* B, int ldb, double beta,
- double* C, int ldc ) ;
-FUNCTION: void cblas_dsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- double alpha, double* A, int lda,
- double beta, double* C, int ldc ) ;
-FUNCTION: void cblas_dsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- double alpha, double* A, int lda,
- double* B, int ldb, double beta,
- double* C, int ldc ) ;
-FUNCTION: void cblas_dtrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- double alpha, double* A, int lda,
- double* B, int ldb ) ;
-FUNCTION: void cblas_dtrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- double alpha, double* A, int lda,
- double* B, int ldb ) ;
-
-FUNCTION: void cblas_cgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
- CBLAS_TRANSPOSE TransB, int M, int N,
- int K, void* alpha, void* A,
- int lda, void* B, int ldb,
- void* beta, void* C, int ldc ) ;
-FUNCTION: void cblas_csymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb, void* beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_csyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- void* alpha, void* A, int lda,
- void* beta, void* C, int ldc ) ;
-FUNCTION: void cblas_csyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- void* alpha, void* A, int lda,
- void* B, int ldb, void* beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_ctrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb ) ;
-FUNCTION: void cblas_ctrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb ) ;
-
-FUNCTION: void cblas_zgemm ( CBLAS_ORDER Order, CBLAS_TRANSPOSE TransA,
- CBLAS_TRANSPOSE TransB, int M, int N,
- int K, void* alpha, void* A,
- int lda, void* B, int ldb,
- void* beta, void* C, int ldc ) ;
-FUNCTION: void cblas_zsymm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb, void* beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_zsyrk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- void* alpha, void* A, int lda,
- void* beta, void* C, int ldc ) ;
-FUNCTION: void cblas_zsyr2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- void* alpha, void* A, int lda,
- void* B, int ldb, void* beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_ztrmm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb ) ;
-FUNCTION: void cblas_ztrsm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
- CBLAS_DIAG Diag, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb ) ;
-
-FUNCTION: void cblas_chemm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb, void* beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_cherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- float alpha, void* A, int lda,
- float beta, void* C, int ldc ) ;
-FUNCTION: void cblas_cher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- void* alpha, void* A, int lda,
- void* B, int ldb, float beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_zhemm ( CBLAS_ORDER Order, CBLAS_SIDE Side,
- CBLAS_UPLO Uplo, int M, int N,
- void* alpha, void* A, int lda,
- void* B, int ldb, void* beta,
- void* C, int ldc ) ;
-FUNCTION: void cblas_zherk ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- double alpha, void* A, int lda,
- double beta, void* C, int ldc ) ;
-FUNCTION: void cblas_zher2k ( CBLAS_ORDER Order, CBLAS_UPLO Uplo,
- CBLAS_TRANSPOSE Trans, int N, int K,
- void* alpha, void* A, int lda,
- void* B, int ldb, double beta,
- void* C, int ldc ) ;
-
+++ /dev/null
-Low-level bindings to the C Basic Linear Algebra Subroutines (BLAS) library
+++ /dev/null
-math
-bindings
-unportable
+++ /dev/null
-USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ;
-IN: math.blas.matrices
-
-ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
-"Factor provides an interface to high-performance vector and matrix math routines available in the system's BLAS library. A set of specialized types are provided for handling packed, unboxed vector data:"
-{ $subsection "math.blas-types" }
-"Scalar-vector and vector-vector operations are available in the " { $vocab-link "math.blas.vectors" } " vocabulary:"
-{ $subsection "math.blas.vectors" }
-"Vector-matrix and matrix-matrix operations are available in the " { $vocab-link "math.blas.matrices" } " vocabulary:"
-{ $subsection "math.blas.matrices" }
-"The low-level BLAS C interface can be accessed directly through the " { $vocab-link "math.blas.cblas" } " vocabulary." ;
-
-ARTICLE: "math.blas-types" "BLAS interface types"
-"BLAS vectors come in single- and double-precision, real and complex flavors:"
-{ $subsection float-blas-vector }
-{ $subsection double-blas-vector }
-{ $subsection float-complex-blas-vector }
-{ $subsection double-complex-blas-vector }
-"These vector types all follow the " { $link sequence } " protocol. In addition, there are corresponding types for matrix data:"
-{ $subsection float-blas-matrix }
-{ $subsection double-blas-matrix }
-{ $subsection float-complex-blas-matrix }
-{ $subsection double-complex-blas-matrix }
-"Syntax words are provided for constructing literal vectors and matrices in the " { $vocab-link "math.blas.syntax" } " vocabulary:"
-{ $subsection "math.blas.syntax" }
-"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:"
-{ $subsection <float-blas-vector> }
-{ $subsection <double-blas-vector> }
-{ $subsection <float-complex-blas-vector> }
-{ $subsection <double-complex-blas-vector> }
-{ $subsection <float-blas-matrix> }
-{ $subsection <double-blas-matrix> }
-{ $subsection <float-complex-blas-matrix> }
-{ $subsection <double-complex-blas-matrix> }
-"For the simple case of creating a dense, zero-filled vector or matrix, simple empty object constructors are provided:"
-{ $subsection <empty-vector> }
-{ $subsection <empty-matrix> }
-"BLAS vectors and matrices can also be constructed from other Factor sequences:"
-{ $subsection >float-blas-vector }
-{ $subsection >double-blas-vector }
-{ $subsection >float-complex-blas-vector }
-{ $subsection >double-complex-blas-vector }
-{ $subsection >float-blas-matrix }
-{ $subsection >double-blas-matrix }
-{ $subsection >float-complex-blas-matrix }
-{ $subsection >double-complex-blas-matrix } ;
-
-ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
-"Transposing and slicing matrices:"
-{ $subsection Mtranspose }
-{ $subsection Mrows }
-{ $subsection Mcols }
-{ $subsection Msub }
-"Matrix-vector products:"
-{ $subsection n*M.V+n*V! }
-{ $subsection n*M.V+n*V }
-{ $subsection n*M.V }
-{ $subsection M.V }
-"Vector outer products:"
-{ $subsection n*V(*)V+M! }
-{ $subsection n*V(*)Vconj+M! }
-{ $subsection n*V(*)V+M }
-{ $subsection n*V(*)Vconj+M }
-{ $subsection n*V(*)V }
-{ $subsection n*V(*)Vconj }
-{ $subsection V(*) }
-{ $subsection V(*)conj }
-"Matrix products:"
-{ $subsection n*M.M+n*M! }
-{ $subsection n*M.M+n*M }
-{ $subsection n*M.M }
-{ $subsection M. }
-"Scalar-matrix products:"
-{ $subsection n*M! }
-{ $subsection n*M }
-{ $subsection M*n }
-{ $subsection M/n } ;
-
-ABOUT: "math.blas.matrices"
-
-HELP: blas-matrix-base
-{ $class-description "The base class for all BLAS matrix types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:"
-{ $list
- { { $link float-blas-matrix } }
- { { $link double-blas-matrix } }
- { { $link float-complex-blas-matrix } }
- { { $link double-complex-blas-matrix } }
-}
-"All of these subclasses share the same tuple layout:"
-{ $list
- { { $snippet "underlying" } " contains an alien pointer referencing or byte-array containing a packed, column-major array of float, double, float complex, or double complex values;" }
- { { $snippet "ld" } " indicates the distance, in elements, between matrix columns;" }
- { { $snippet "rows" } " and " { $snippet "cols" } " indicate the number of significant rows and columns in the matrix;" }
- { "and " { $snippet "transpose" } ", if set to a true value, indicates that the matrix should be treated as transposed relative to its in-memory representation." }
-} } ;
-
-{ blas-vector-base blas-matrix-base } related-words
-
-HELP: float-blas-matrix
-{ $class-description "A matrix of single-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
-HELP: double-blas-matrix
-{ $class-description "A matrix of double-precision floating-point values. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
-HELP: float-complex-blas-matrix
-{ $class-description "A matrix of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
-HELP: double-complex-blas-matrix
-{ $class-description "A matrix of double-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-matrix-base } "." } ;
-
-{
- float-blas-matrix double-blas-matrix float-complex-blas-matrix double-complex-blas-matrix
- float-blas-vector double-blas-vector float-complex-blas-vector double-complex-blas-vector
-} related-words
-
-HELP: Mwidth
-{ $values { "matrix" blas-matrix-base } { "width" integer } }
-{ $description "Returns the number of columns in " { $snippet "matrix" } "." } ;
-
-HELP: Mheight
-{ $values { "matrix" blas-matrix-base } { "height" integer } }
-{ $description "Returns the number of rows in " { $snippet "matrix" } "." } ;
-
-{ Mwidth Mheight } related-words
-
-HELP: n*M.V+n*V!
-{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "y=alpha*A.x+b*y" blas-vector-base } }
-{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } ", and overwrite the current contents of " { $snippet "y" } " with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." }
-{ $side-effects "y" } ;
-
-HELP: n*V(*)V+M!
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)y+A" blas-matrix-base } }
-{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGER and xGERU routines in BLAS." }
-{ $side-effects "A" } ;
-
-HELP: n*V(*)Vconj+M!
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)yconj+A" blas-matrix-base } }
-{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGERC routines in BLAS." }
-{ $side-effects "A" } ;
-
-HELP: n*M.M+n*M!
-{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "C=alpha*A.B+beta*C" blas-matrix-base } }
-{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." }
-{ $side-effects "C" } ;
-
-HELP: <empty-matrix>
-{ $values { "rows" integer } { "cols" integer } { "exemplar" blas-vector-base blas-matrix-base } { "matrix" blas-matrix-base } }
-{ $description "Create a matrix of all zeros with the given dimensions and the same element type as " { $snippet "exemplar" } "." } ;
-
-{ <zero-vector> <empty-vector> <empty-matrix> } related-words
-
-HELP: n*M.V+n*V
-{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "alpha*A.x+b*y" blas-vector-base } }
-{ $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". The returned vector will have the same length as " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." } ;
-
-HELP: n*V(*)V+M
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)y+A" blas-matrix-base } }
-{ $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
-
-HELP: n*V(*)Vconj+M
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)yconj+A" blas-matrix-base } }
-{ $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGERC routines in BLAS." } ;
-
-HELP: n*M.M+n*M
-{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "alpha*A.B+beta*C" blas-matrix-base } }
-{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ;
-
-HELP: n*M.V
-{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "alpha*A.x" blas-vector-base } }
-{ $description "Calculate the matrix-vector product " { $snippet "αAx" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
-
-HELP: M.V
-{ $values { "A" blas-matrix-base } { "x" blas-vector-base } { "A.x" blas-vector-base } }
-{ $description "Calculate the matrix-vector product " { $snippet "Ax" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
-
-{ n*M.V+n*V! n*M.V+n*V n*M.V M.V } related-words
-
-HELP: n*V(*)V
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)y" blas-matrix-base } }
-{ $description "Calculate the outer product " { $snippet "αx⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
-
-HELP: n*V(*)Vconj
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)yconj" blas-matrix-base } }
-{ $description "Calculate the outer product " { $snippet "αx⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
-
-HELP: V(*)
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)y" blas-matrix-base } }
-{ $description "Calculate the outer product " { $snippet "x⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
-
-HELP: V(*)conj
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)yconj" blas-matrix-base } }
-{ $description "Calculate the conjugate outer product " { $snippet "x⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
-
-{ n*V(*)V+M! n*V(*)Vconj+M! n*V(*)V+M n*V(*)Vconj+M n*V(*)V n*V(*)Vconj V(*) V(*)conj V. V.conj } related-words
-
-HELP: n*M.M
-{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "alpha*A.B" blas-matrix-base } }
-{ $description "Calculate the matrix product " { $snippet "αAB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
-
-HELP: M.
-{ $values { "A" blas-matrix-base } { "B" blas-matrix-base } { "A.B" blas-matrix-base } }
-{ $description "Calculate the matrix product " { $snippet "AB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
-
-{ n*M.M+n*M! n*M.M+n*M n*M.M M. } related-words
-
-HELP: Msub
-{ $values { "matrix" blas-matrix-base } { "row" integer } { "col" integer } { "height" integer } { "width" integer } { "sub" blas-matrix-base } }
-{ $description "Select a rectangular submatrix of " { $snippet "matrix" } " with the given dimensions. The returned submatrix will share the parent matrix's storage." } ;
-
-HELP: Mrows
-{ $values { "A" blas-matrix-base } { "rows" sequence } }
-{ $description "Return a sequence of BLAS vectors representing the rows of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
-
-HELP: Mcols
-{ $values { "A" blas-matrix-base } { "cols" sequence } }
-{ $description "Return a sequence of BLAS vectors representing the columns of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
-
-HELP: n*M!
-{ $values { "n" number } { "A" blas-matrix-base } { "A=n*A" blas-matrix-base } }
-{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and overwrite the current contents of A with the result." }
-{ $side-effects "A" } ;
-
-HELP: n*M
-{ $values { "n" number } { "A" blas-matrix-base } { "n*A" blas-matrix-base } }
-{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
-
-HELP: M*n
-{ $values { "A" blas-matrix-base } { "n" number } { "A*n" blas-matrix-base } }
-{ $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
-
-HELP: M/n
-{ $values { "A" blas-matrix-base } { "n" number } { "A/n" blas-matrix-base } }
-{ $description "Calculate the scalar-matrix product " { $snippet "(1/n)A" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
-
-{ n*M! n*M M*n M/n } related-words
-
-HELP: Mtranspose
-{ $values { "matrix" blas-matrix-base } { "matrix^T" blas-matrix-base } }
-{ $description "Returns the transpose of " { $snippet "matrix" } ". The returned matrix shares storage with the original matrix." } ;
-
-HELP: element-type
-{ $values { "v" blas-vector-base blas-matrix-base } { "type" string } }
-{ $description "Return the C type of the elements in the given BLAS vector or matrix." } ;
-
-HELP: <empty-vector>
-{ $values { "length" "The length of the new vector" } { "exemplar" blas-vector-base blas-matrix-base } { "vector" blas-vector-base } }
-{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ;
-
+++ /dev/null
-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
-
+++ /dev/null
-USING: accessors alien alien.c-types arrays byte-arrays combinators
-combinators.short-circuit fry kernel locals macros
-math math.blas.cblas math.blas.vectors math.blas.vectors.private
-math.complex math.functions math.order functors words
-sequences sequences.merged sequences.private shuffle
-specialized-arrays.direct.float specialized-arrays.direct.double
-specialized-arrays.float specialized-arrays.double ;
-IN: math.blas.matrices
-
-TUPLE: blas-matrix-base underlying ld rows cols transpose ;
-
-: Mtransposed? ( matrix -- ? )
- transpose>> ; inline
-: Mwidth ( matrix -- width )
- dup Mtransposed? [ rows>> ] [ cols>> ] if ; inline
-: Mheight ( matrix -- height )
- dup Mtransposed? [ cols>> ] [ rows>> ] if ; inline
-
-GENERIC: n*M.V+n*V! ( alpha A x beta y -- y=alpha*A.x+b*y )
-GENERIC: n*V(*)V+M! ( alpha x y A -- A=alpha*x(*)y+A )
-GENERIC: n*V(*)Vconj+M! ( alpha x y A -- A=alpha*x(*)yconj+A )
-GENERIC: n*M.M+n*M! ( alpha A B beta C -- C=alpha*A.B+beta*C )
-
-<PRIVATE
-
-: (blas-transpose) ( matrix -- integer )
- transpose>> [ CblasTrans ] [ CblasNoTrans ] if ;
-
-GENERIC: (blas-matrix-like) ( data ld rows cols transpose exemplar -- matrix )
-
-: (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 underlying>>
- A ld>>
- x underlying>>
- x inc>>
- beta >c-arg call
- y underlying>>
- 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 underlying>>
- x inc>>
- y underlying>>
- y inc>>
- A underlying>>
- 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 underlying>>
- A ld>>
- B underlying>>
- B ld>>
- beta >c-arg call
- C underlying>>
- C ld>>
- C f >>transpose ; inline
-
-: (>matrix) ( arrays >c-array -- c-array ld rows cols transpose )
- '[ <merged> @ ] [ length dup ] [ first length ] tri f ; inline
-
-PRIVATE>
-
-! XXX should do a dense clone
-M: blas-matrix-base clone
- [
- [ {
- [ underlying>> ]
- [ ld>> ]
- [ cols>> ]
- [ element-type heap-size ]
- } cleave * * memory>byte-array ]
- [ {
- [ ld>> ]
- [ rows>> ]
- [ cols>> ]
- [ transpose>> ]
- } cleave ]
- 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! ;
-: n*V(*)V+M ( alpha x y A -- alpha*x(*)y+A )
- clone n*V(*)V+M! ;
-: n*V(*)Vconj+M ( alpha x y A -- alpha*x(*)yconj+A )
- clone n*V(*)Vconj+M! ;
-: n*M.M+n*M ( alpha A B beta C -- alpha*A.B+beta*C )
- clone n*M.M+n*M! ;
-
-: n*M.V ( alpha A x -- alpha*A.x )
- 1.0 2over [ Mheight ] dip <empty-vector>
- n*M.V+n*V! ; inline
-
-: M.V ( A x -- A.x )
- 1.0 -rot n*M.V ; inline
-
-: n*V(*)V ( alpha x y -- alpha*x(*)y )
- 2dup [ length>> ] bi@ pick <empty-matrix>
- n*V(*)V+M! ;
-: n*V(*)Vconj ( alpha x y -- alpha*x(*)yconj )
- 2dup [ length>> ] bi@ pick <empty-matrix>
- n*V(*)Vconj+M! ;
-
-: 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 ( alpha A B -- alpha*A.B )
- 2dup [ Mheight ] [ Mwidth ] bi* pick <empty-matrix>
- 1.0 swap n*M.M+n*M! ;
-
-: 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 underlying>> <displaced-alien>
- matrix ld>>
- height
- width ;
-
-:: Msub ( matrix row col height width -- sub )
- matrix dup transpose>>
- [ col row width height ]
- [ row col height width ] if (Msub)
- matrix transpose>> matrix (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
-
-M: blas-matrix-rowcol-sequence length
- length>> ;
-M: blas-matrix-rowcol-sequence nth-unsafe
- {
- [
- [ rowcol-jump>> ]
- [ parent>> element-type heap-size ]
- [ parent>> underlying>> ] 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 -- cols )
- dup transpose>> [ (Mrows) ] [ (Mcols) ] if ;
-
-: n*M! ( n A -- A=n*A )
- [ (Mcols) [ n*V! drop ] with each ] keep ;
-
-: n*M ( n A -- n*A )
- clone n*M! ; 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 )
- [ {
- [ underlying>> ]
- [ ld>> ] [ rows>> ]
- [ cols>> ]
- [ transpose>> not ]
- } cleave ] keep (blas-matrix-like) ;
-
-M: blas-matrix-base equal?
- {
- [ [ Mwidth ] bi@ = ]
- [ [ Mcols ] bi@ [ = ] 2all? ]
- } 2&& ;
-
-<<
-
-FUNCTOR: (define-blas-matrix) ( TYPE T U C -- )
-
-VECTOR IS ${TYPE}-blas-vector
-<VECTOR> IS <${TYPE}-blas-vector>
->ARRAY IS >${TYPE}-array
-TYPE>ARG IS ${TYPE}>arg
-XGEMV IS cblas_${T}gemv
-XGEMM IS cblas_${T}gemm
-XGERU IS cblas_${T}ger${U}
-XGERC IS cblas_${T}ger${C}
-
-MATRIX DEFINES ${TYPE}-blas-matrix
-<MATRIX> DEFINES <${TYPE}-blas-matrix>
->MATRIX DEFINES >${TYPE}-blas-matrix
-
-WHERE
-
-TUPLE: MATRIX < blas-matrix-base ;
-: <MATRIX> ( underlying ld rows cols transpose -- matrix )
- MATRIX boa ; inline
-
-M: MATRIX element-type
- drop TYPE ;
-M: MATRIX (blas-matrix-like)
- drop <MATRIX> execute ;
-M: VECTOR (blas-matrix-like)
- drop <MATRIX> execute ;
-M: MATRIX (blas-vector-like)
- drop <VECTOR> execute ;
-
-: >MATRIX ( arrays -- matrix )
- [ >ARRAY execute underlying>> ] (>matrix)
- <MATRIX> execute ;
-
-M: VECTOR n*M.V+n*V!
- [ TYPE>ARG execute ] (prepare-gemv)
- [ XGEMV execute ] dip ;
-M: MATRIX n*M.M+n*M!
- [ TYPE>ARG execute ] (prepare-gemm)
- [ XGEMM execute ] dip ;
-M: MATRIX n*V(*)V+M!
- [ TYPE>ARG execute ] (prepare-ger)
- [ XGERU execute ] dip ;
-M: MATRIX n*V(*)Vconj+M!
- [ TYPE>ARG execute ] (prepare-ger)
- [ XGERC execute ] dip ;
-
-;FUNCTOR
-
-
-: define-real-blas-matrix ( TYPE T -- )
- "" "" (define-blas-matrix) ;
-: define-complex-blas-matrix ( TYPE T -- )
- "u" "c" (define-blas-matrix) ;
-
-"float" "s" define-real-blas-matrix
-"double" "d" define-real-blas-matrix
-"float-complex" "c" define-complex-blas-matrix
-"double-complex" "z" define-complex-blas-matrix
-
->>
+++ /dev/null
-BLAS level 2 and 3 matrix-vector and matrix-matrix operations
+++ /dev/null
-math
-bindings
-unportable
+++ /dev/null
-Literal syntax for BLAS vectors and matrices
+++ /dev/null
-USING: help.markup help.syntax math.blas.matrices math.blas.vectors multiline ;
-IN: math.blas.syntax
-
-ARTICLE: "math.blas.syntax" "BLAS interface literal syntax"
-"Vectors:"
-{ $subsection POSTPONE: svector{ }
-{ $subsection POSTPONE: dvector{ }
-{ $subsection POSTPONE: cvector{ }
-{ $subsection POSTPONE: zvector{ }
-"Matrices:"
-{ $subsection POSTPONE: smatrix{ }
-{ $subsection POSTPONE: dmatrix{ }
-{ $subsection POSTPONE: cmatrix{ }
-{ $subsection POSTPONE: zmatrix{ } ;
-
-ABOUT: "math.blas.syntax"
-
-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 }" }
-{ $description "Construct a literal " { $link double-blas-vector } "." } ;
-
-HELP: cvector{
-{ $syntax "cvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
-{ $description "Construct a literal " { $link float-complex-blas-vector } "." } ;
-
-HELP: zvector{
-{ $syntax "dvector{ 1.0 -2.0 C{ 3.0 -1.0 } }" }
-{ $description "Construct a literal " { $link double-complex-blas-vector } "." } ;
-
-{
- POSTPONE: svector{ POSTPONE: dvector{
- POSTPONE: cvector{ POSTPONE: zvector{
-} related-words
-
-HELP: smatrix{
-{ $syntax <" smatrix{
- { 1.0 0.0 0.0 1.0 }
- { 0.0 1.0 0.0 2.0 }
- { 0.0 0.0 1.0 3.0 }
- { 0.0 0.0 0.0 1.0 }
-} "> }
-{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
-
-HELP: dmatrix{
-{ $syntax <" dmatrix{
- { 1.0 0.0 0.0 1.0 }
- { 0.0 1.0 0.0 2.0 }
- { 0.0 0.0 1.0 3.0 }
- { 0.0 0.0 0.0 1.0 }
-} "> }
-{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
-
-HELP: cmatrix{
-{ $syntax <" cmatrix{
- { 1.0 0.0 0.0 1.0 }
- { 0.0 C{ 0.0 1.0 } 0.0 2.0 }
- { 0.0 0.0 -1.0 3.0 }
- { 0.0 0.0 0.0 C{ 0.0 -1.0 } }
-} "> }
-{ $description "Construct a literal " { $link float-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
-
-HELP: zmatrix{
-{ $syntax <" zmatrix{
- { 1.0 0.0 0.0 1.0 }
- { 0.0 C{ 0.0 1.0 } 0.0 2.0 }
- { 0.0 0.0 -1.0 3.0 }
- { 0.0 0.0 0.0 C{ 0.0 -1.0 } }
-} "> }
-{ $description "Construct a literal " { $link double-complex-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
-
-{
- POSTPONE: smatrix{ POSTPONE: dmatrix{
- POSTPONE: cmatrix{ POSTPONE: zmatrix{
-} related-words
+++ /dev/null
-USING: kernel math.blas.vectors math.blas.matrices parser
-arrays prettyprint.backend sequences ;
-IN: math.blas.syntax
-
-: svector{
- \ } [ >float-blas-vector ] parse-literal ; parsing
-: dvector{
- \ } [ >double-blas-vector ] parse-literal ; parsing
-: cvector{
- \ } [ >float-complex-blas-vector ] parse-literal ; parsing
-: zvector{
- \ } [ >double-complex-blas-vector ] parse-literal ; parsing
-
-: smatrix{
- \ } [ >float-blas-matrix ] parse-literal ; parsing
-: dmatrix{
- \ } [ >double-blas-matrix ] parse-literal ; parsing
-: cmatrix{
- \ } [ >float-complex-blas-matrix ] parse-literal ; parsing
-: zmatrix{
- \ } [ >double-complex-blas-matrix ] parse-literal ; parsing
-
-M: float-blas-vector pprint-delims
- drop \ svector{ \ } ;
-M: double-blas-vector pprint-delims
- drop \ dvector{ \ } ;
-M: float-complex-blas-vector pprint-delims
- drop \ cvector{ \ } ;
-M: double-complex-blas-vector pprint-delims
- drop \ zvector{ \ } ;
-
-M: float-blas-matrix pprint-delims
- drop \ smatrix{ \ } ;
-M: double-blas-matrix pprint-delims
- drop \ dmatrix{ \ } ;
-M: float-complex-blas-matrix pprint-delims
- drop \ cmatrix{ \ } ;
-M: double-complex-blas-matrix pprint-delims
- drop \ zmatrix{ \ } ;
-
-M: blas-vector-base >pprint-sequence ;
-M: blas-vector-base pprint* pprint-object ;
-M: blas-matrix-base >pprint-sequence Mrows ;
-M: blas-matrix-base pprint* pprint-object ;
+++ /dev/null
-math
-unportable
+++ /dev/null
-BLAS level 1 vector operations
+++ /dev/null
-math
-unportable
+++ /dev/null
-USING: alien byte-arrays help.markup help.syntax math sequences ;
-IN: math.blas.vectors
-
-ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
-"Slicing vectors:"
-{ $subsection Vsub }
-"Taking the norm (magnitude) of a vector:"
-{ $subsection Vnorm }
-"Summing and taking the maximum of elements:"
-{ $subsection Vasum }
-{ $subsection Viamax }
-{ $subsection Vamax }
-"Scalar-vector products:"
-{ $subsection n*V! }
-{ $subsection n*V }
-{ $subsection V*n }
-{ $subsection V/n }
-{ $subsection Vneg }
-"Vector addition:"
-{ $subsection n*V+V! }
-{ $subsection n*V+V }
-{ $subsection V+ }
-{ $subsection V- }
-"Vector inner products:"
-{ $subsection V. }
-{ $subsection V.conj } ;
-
-ABOUT: "math.blas.vectors"
-
-HELP: blas-vector-base
-{ $class-description "The base class for all BLAS vector types. Objects of this type should not be created directly; instead, instantiate one of the typed subclasses:"
-{ $list
- { { $link float-blas-vector } }
- { { $link double-blas-vector } }
- { { $link float-complex-blas-vector } }
- { { $link double-complex-blas-vector } }
-}
-"All of these subclasses share the same tuple layout:"
-{ $list
- { { $snippet "underlying" } " contains an alien pointer referencing or byte-array containing a packed array of float, double, float complex, or double complex values;" }
- { { $snippet "length" } " indicates the length of the vector;" }
- { "and " { $snippet "inc" } " indicates the distance, in elements, between elements." }
-} } ;
-
-HELP: float-blas-vector
-{ $class-description "A vector of single-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
-HELP: double-blas-vector
-{ $class-description "A vector of double-precision floating-point values. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
-HELP: float-complex-blas-vector
-{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
-HELP: double-complex-blas-vector
-{ $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
-
-HELP: n*V+V!
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "y=alpha*x+y" blas-vector-base } }
-{ $description "Calculate the vector sum " { $snippet "αx + y" } " and replace the existing contents of y with the result. Corresponds to the xAXPY routines in BLAS." }
-{ $side-effects "y" } ;
-
-HELP: n*V!
-{ $values { "alpha" number } { "x" blas-vector-base } { "x=alpha*x" blas-vector-base } }
-{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and replace the existing contents of x with the result. Corresponds to the xSCAL routines in BLAS." }
-{ $side-effects "x" } ;
-
-HELP: V.
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x.y" number } }
-{ $description "Calculate the inner product " { $snippet "x⋅y" } ". Corresponds to the xDOT and xDOTU routines in BLAS." } ;
-
-HELP: V.conj
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "xconj.y" number } }
-{ $description "Calculate the conjugate inner product " { $snippet "x̅⋅y" } ". Corresponds to the xDOTC routines in BLAS." } ;
-
-HELP: Vnorm
-{ $values { "x" blas-vector-base } { "norm" number } }
-{ $description "Calculate the norm-2, i.e., the magnitude or absolute value, of " { $snippet "x" } " (" { $snippet "‖x‖₂" } "). Corresponds to the xNRM2 routines in BLAS." } ;
-
-HELP: Vasum
-{ $values { "x" blas-vector-base } { "sum" number } }
-{ $description "Calculate the sum of the norm-1s of the elements of " { $snippet "x" } " (" { $snippet "Σ ‖xᵢ‖₁" } "). Corresponds to the xASUM routines in BLAS." } ;
-
-HELP: Vswap
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x=y" blas-vector-base } { "y=x" blas-vector-base } }
-{ $description "Swap the contents of " { $snippet "x" } " and " { $snippet "y" } " in place. Corresponds to the xSWAP routines in BLAS." }
-{ $side-effects "x" "y" } ;
-
-HELP: Viamax
-{ $values { "x" blas-vector-base } { "max-i" integer } }
-{ $description "Return the index of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the smallest index. Corresponds to the IxAMAX routines in BLAS." } ;
-
-HELP: Vamax
-{ $values { "x" blas-vector-base } { "max" number } }
-{ $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the first element. Corresponds to the IxAMAX routines in BLAS." } ;
-
-{ Viamax Vamax } related-words
-
-HELP: <zero-vector>
-{ $values { "exemplar" blas-vector-base } { "zero" blas-vector-base } }
-{ $description "Return a vector of zeros with the same length and element type as " { $snippet "v" } ". The vector is constructed with an " { $snippet "inc" } " of zero, so it is not suitable for receiving results from BLAS functions; it is intended to be used as a term in other vector calculations. To construct an empty vector that can be used to receive results, see " { $link <empty-vector> } "." } ;
-
-HELP: n*V+V
-{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x+y" blas-vector-base } }
-{ $description "Calculate the vector sum " { $snippet "αx + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
-
-HELP: n*V
-{ $values { "alpha" "a number" } { "x" blas-vector-base } { "alpha*x" blas-vector-base } }
-{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
-
-HELP: V+
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x+y" blas-vector-base } }
-{ $description "Calculate the vector sum " { $snippet "x + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
-
-HELP: V-
-{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x-y" blas-vector-base } }
-{ $description "Calculate the vector difference " { $snippet "x – y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
-
-HELP: Vneg
-{ $values { "x" blas-vector-base } { "-x" blas-vector-base } }
-{ $description "Negate the elements of " { $snippet "x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result." } ;
-
-HELP: V*n
-{ $values { "x" blas-vector-base } { "alpha" number } { "x*alpha" blas-vector-base } }
-{ $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
-
-HELP: V/n
-{ $values { "x" blas-vector-base } { "alpha" number } { "x/alpha" blas-vector-base } }
-{ $description "Calculate the scalar-vector product " { $snippet "(1/α)x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
-
-{ n*V+V! n*V! n*V+V n*V V+ V- Vneg V*n V/n } related-words
-
-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." } ;
+++ /dev/null
-USING: kernel math.blas.vectors math.blas.syntax sequences tools.test ;
-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
-
-! 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
-
-[ 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
-
-[ 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
-
-! 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
-
-[ 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 } }
- [ set-nth ] keep
-] unit-test
-[ 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 } }
- [ 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
-
-[ 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+ ]
-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
-
-[ 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- ]
-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
-
-[ 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
-
-[ 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 ]
-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
-
-[ 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 ]
-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
-
-[ 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 ]
-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
-
-! 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
-
-! Vnorm
-
-[ 5.0 ] [ svector{ 3.0 4.0 } Vnorm ] unit-test
-[ 5.0 ] [ dvector{ 3.0 4.0 } Vnorm ] unit-test
-
-[ 13.0 ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
-[ 13.0 ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] 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
-
-[ 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 ]
-unit-test
-
-[ 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 ]
-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 ]
-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
-
-! 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
-
-! 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
+++ /dev/null
-USING: accessors alien alien.c-types arrays byte-arrays combinators
-combinators.short-circuit fry kernel math math.blas.cblas
-math.complex math.functions math.order sequences.complex
-sequences.complex-components sequences sequences.private
-functors words locals
-specialized-arrays.float specialized-arrays.double
-specialized-arrays.direct.float specialized-arrays.direct.double ;
-IN: math.blas.vectors
-
-TUPLE: blas-vector-base underlying length inc ;
-
-INSTANCE: blas-vector-base virtual-sequence
-
-GENERIC: element-type ( v -- type )
-
-GENERIC: n*V+V! ( alpha x y -- y=alpha*x+y )
-GENERIC: n*V! ( alpha x -- x=alpha*x )
-GENERIC: V. ( x y -- x.y )
-GENERIC: V.conj ( x y -- xconj.y )
-GENERIC: Vnorm ( x -- norm )
-GENERIC: Vasum ( x -- sum )
-GENERIC: Vswap ( x y -- x=y y=x )
-GENERIC: Viamax ( x -- max-i )
-
-<PRIVATE
-
-GENERIC: (blas-vector-like) ( data length inc exemplar -- vector )
-
-GENERIC: (blas-direct-array) ( blas-vector -- direct-array )
-
-: shorter-length ( v1 v2 -- length )
- [ length>> ] bi@ min ; inline
-: data-and-inc ( v -- data inc )
- [ underlying>> ] [ inc>> ] bi ; inline
-: datas-and-incs ( v1 v2 -- v1-data v1-inc v2-data v2-inc )
- [ data-and-inc ] bi@ ; inline
-
-:: (prepare-copy)
- ( v element-size -- length v-data v-inc v-dest-data v-dest-inc
- copy-data copy-length copy-inc )
- v [ length>> ] [ data-and-inc ] bi
- v length>> element-size * <byte-array>
- 1
- over v length>> 1 ;
-
-: (prepare-swap)
- ( v1 v2 -- length v1-data v1-inc v2-data v2-inc
- v1 v2 )
- [ shorter-length ] [ datas-and-incs ] [ ] 2tri ;
-
-:: (prepare-axpy)
- ( n v1 v2 -- length n v1-data v1-inc v2-data v2-inc
- v2 )
- v1 v2 shorter-length
- n
- v1 v2 datas-and-incs
- v2 ;
-
-:: (prepare-scal)
- ( n v -- length n v-data v-inc
- v )
- v length>>
- n
- v data-and-inc
- v ;
-
-: (prepare-dot) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc )
- [ shorter-length ] [ datas-and-incs ] 2bi ;
-
-: (prepare-nrm2) ( v -- length data inc )
- [ length>> ] [ data-and-inc ] bi ;
-
-PRIVATE>
-
-: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline
-: n*V ( alpha x -- alpha*x ) clone n*V! ; inline
-
-: V+ ( x y -- x+y )
- 1.0 -rot n*V+V ; inline
-: V- ( x y -- x-y )
- -1.0 spin n*V+V ; inline
-
-: Vneg ( x -- -x )
- -1.0 swap n*V ; inline
-
-: V*n ( x alpha -- x*alpha )
- swap n*V ; inline
-: V/n ( x alpha -- x/alpha )
- recip swap n*V ; inline
-
-: Vamax ( x -- max )
- [ Viamax ] keep nth ; inline
-
-:: Vsub ( v start length -- sub )
- v inc>> start * v element-type heap-size *
- v underlying>> <displaced-alien>
- length v inc>> v (blas-vector-like) ;
-
-: <zero-vector> ( exemplar -- zero )
- [ element-type <c-object> ]
- [ length>> 0 ]
- [ (blas-vector-like) ] tri ;
-
-: <empty-vector> ( length exemplar -- vector )
- [ element-type <c-array> ]
- [ 1 swap ] 2bi
- (blas-vector-like) ;
-
-M: blas-vector-base equal?
- {
- [ [ length ] bi@ = ]
- [ [ = ] 2all? ]
- } 2&& ;
-
-M: blas-vector-base length
- length>> ;
-M: blas-vector-base virtual-seq
- (blas-direct-array) ;
-M: blas-vector-base virtual@
- [ inc>> * ] [ nip (blas-direct-array) ] 2bi ;
-
-: float>arg ( f -- f ) ; inline
-: double>arg ( f -- f ) ; inline
-: arg>float ( f -- f ) ; inline
-: arg>double ( f -- f ) ; inline
-
-<<
-
-FUNCTOR: (define-blas-vector) ( TYPE T -- )
-
-<DIRECT-ARRAY> IS <direct-${TYPE}-array>
->ARRAY IS >${TYPE}-array
-XCOPY IS cblas_${T}copy
-XSWAP IS cblas_${T}swap
-IXAMAX IS cblas_i${T}amax
-
-VECTOR DEFINES ${TYPE}-blas-vector
-<VECTOR> DEFINES <${TYPE}-blas-vector>
->VECTOR DEFINES >${TYPE}-blas-vector
-
-WHERE
-
-TUPLE: VECTOR < blas-vector-base ;
-: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
-
-: >VECTOR ( seq -- v )
- [ >ARRAY execute underlying>> ] [ length ] bi 1 <VECTOR> execute ;
-
-M: VECTOR clone
- TYPE heap-size (prepare-copy)
- [ XCOPY execute ] 3dip <VECTOR> execute ;
-
-M: VECTOR element-type
- drop TYPE ;
-M: VECTOR Vswap
- (prepare-swap) [ XSWAP execute ] 2dip ;
-M: VECTOR Viamax
- (prepare-nrm2) IXAMAX execute ;
-
-M: VECTOR (blas-vector-like)
- drop <VECTOR> execute ;
-
-M: VECTOR (blas-direct-array)
- [ underlying>> ]
- [ [ length>> ] [ inc>> ] bi * ] bi
- <DIRECT-ARRAY> execute ;
-
-;FUNCTOR
-
-
-FUNCTOR: (define-real-blas-vector) ( TYPE T -- )
-
-VECTOR IS ${TYPE}-blas-vector
-XDOT IS cblas_${T}dot
-XNRM2 IS cblas_${T}nrm2
-XASUM IS cblas_${T}asum
-XAXPY IS cblas_${T}axpy
-XSCAL IS cblas_${T}scal
-
-WHERE
-
-M: VECTOR V.
- (prepare-dot) XDOT execute ;
-M: VECTOR V.conj
- (prepare-dot) XDOT execute ;
-M: VECTOR Vnorm
- (prepare-nrm2) XNRM2 execute ;
-M: VECTOR Vasum
- (prepare-nrm2) XASUM execute ;
-M: VECTOR n*V+V!
- (prepare-axpy) [ XAXPY execute ] dip ;
-M: VECTOR n*V!
- (prepare-scal) [ XSCAL execute ] dip ;
-
-;FUNCTOR
-
-
-FUNCTOR: (define-complex-helpers) ( TYPE -- )
-
-<DIRECT-COMPLEX-ARRAY> DEFINES <direct-${TYPE}-complex-array>
->COMPLEX-ARRAY DEFINES >${TYPE}-complex-array
-ARG>COMPLEX DEFINES arg>${TYPE}-complex
-COMPLEX>ARG DEFINES ${TYPE}-complex>arg
-<DIRECT-ARRAY> IS <direct-${TYPE}-array>
->ARRAY IS >${TYPE}-array
-
-WHERE
-
-: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
- 1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
-: >COMPLEX-ARRAY ( sequence -- sequence )
- <complex-components> >ARRAY execute ;
-: COMPLEX>ARG ( complex -- alien )
- >rect 2array >ARRAY execute underlying>> ;
-: ARG>COMPLEX ( alien -- complex )
- 2 <DIRECT-ARRAY> execute first2 rect> ;
-
-;FUNCTOR
-
-
-FUNCTOR: (define-complex-blas-vector) ( TYPE C S -- )
-
-VECTOR IS ${TYPE}-blas-vector
-XDOTU_SUB IS cblas_${C}dotu_sub
-XDOTC_SUB IS cblas_${C}dotc_sub
-XXNRM2 IS cblas_${S}${C}nrm2
-XXASUM IS cblas_${S}${C}asum
-XAXPY IS cblas_${C}axpy
-XSCAL IS cblas_${C}scal
-TYPE>ARG IS ${TYPE}>arg
-ARG>TYPE IS arg>${TYPE}
-
-WHERE
-
-M: VECTOR V.
- (prepare-dot) TYPE <c-object>
- [ XDOTU_SUB execute ] keep
- ARG>TYPE execute ;
-M: VECTOR V.conj
- (prepare-dot) TYPE <c-object>
- [ XDOTC_SUB execute ] keep
- ARG>TYPE execute ;
-M: VECTOR Vnorm
- (prepare-nrm2) XXNRM2 execute ;
-M: VECTOR Vasum
- (prepare-nrm2) XXASUM execute ;
-M: VECTOR n*V+V!
- [ TYPE>ARG execute ] 2dip
- (prepare-axpy) [ XAXPY execute ] dip ;
-M: VECTOR n*V!
- [ TYPE>ARG execute ] dip
- (prepare-scal) [ XSCAL execute ] dip ;
-
-;FUNCTOR
-
-
-: define-real-blas-vector ( TYPE T -- )
- [ (define-blas-vector) ]
- [ (define-real-blas-vector) ] 2bi ;
-:: define-complex-blas-vector ( TYPE C S -- )
- TYPE (define-complex-helpers)
- TYPE "-complex" append
- [ C (define-blas-vector) ]
- [ C S (define-complex-blas-vector) ] bi ;
-
-"float" "s" define-real-blas-vector
-"double" "d" define-real-blas-vector
-"float" "c" "s" define-complex-blas-vector
-"double" "z" "d" define-complex-blas-vector
-
->>
-
+++ /dev/null
-USING: help.markup help.syntax math multiline
-sequences sequences.complex-components ;
-IN: sequences.complex-components
-
-ARTICLE: "sequences.complex-components" "Complex component virtual sequences"
-"The " { $link complex-components } " class wraps a sequence of " { $link complex } " number values, presenting a sequence of " { $link real } " values made by interleaving the real and imaginary parts of the complex values in the original sequence."
-{ $subsection complex-components }
-{ $subsection <complex-components> } ;
-
-ABOUT: "sequences.complex-components"
-
-HELP: complex-components
-{ $class-description "Sequence wrapper class that transforms a sequence of " { $link complex } " number values into a sequence of " { $link real } " values, interleaving the real and imaginary parts of the complex values in the original sequence." }
-{ $examples { $example <"
-USING: prettyprint sequences arrays sequences.complex-components ;
-{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> >array .
-"> "{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ;
-
-HELP: <complex-components>
-{ $values { "sequence" sequence } { "complex-components" complex-components } }
-{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-components } " wrapper." }
-{ $examples
-{ $example <"
-USING: prettyprint sequences arrays
-sequences.complex-components ;
-{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> third .
-"> "-2.0" }
-{ $example <"
-USING: prettyprint sequences arrays
-sequences.complex-components ;
-{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> fourth .
-"> "0" }
-} ;
-
-{ complex-components <complex-components> } related-words
+++ /dev/null
-USING: sequences.complex-components
-kernel sequences tools.test arrays accessors ;
-IN: sequences.complex-components.tests
-
-: test-array ( -- x )
- { C{ 1.0 2.0 } 3.0 C{ 5.0 6.0 } } <complex-components> ;
-
-[ 6 ] [ test-array length ] unit-test
-
-[ 1.0 ] [ test-array first ] unit-test
-[ 2.0 ] [ test-array second ] unit-test
-[ 3.0 ] [ test-array third ] unit-test
-[ 0 ] [ test-array fourth ] unit-test
-
-[ { 1.0 2.0 3.0 0 5.0 6.0 } ] [ test-array >array ] unit-test
-
+++ /dev/null
-USING: accessors kernel math math.functions combinators
-sequences sequences.private ;
-IN: sequences.complex-components
-
-TUPLE: complex-components seq ;
-INSTANCE: complex-components sequence
-
-: <complex-components> ( sequence -- complex-components )
- complex-components boa ; inline
-
-<PRIVATE
-
-: complex-components@ ( n seq -- remainder n' seq' )
- [ [ 1 bitand ] [ -1 shift ] bi ] [ seq>> ] bi* ; inline
-: complex-component ( remainder complex -- component )
- swap {
- { 0 [ real-part ] }
- { 1 [ imaginary-part ] }
- } case ;
-
-PRIVATE>
-
-M: complex-components length
- seq>> length 1 shift ;
-M: complex-components nth-unsafe
- complex-components@ nth-unsafe complex-component ;
-M: complex-components set-nth-unsafe
- immutable ;
+++ /dev/null
-Virtual sequence wrapper to convert complex values into real value pairs
+++ /dev/null
-sequences
-math
+++ /dev/null
-USING: help.markup help.syntax math multiline
-sequences sequences.complex ;
-IN: sequences.complex
-
-ARTICLE: "sequences.complex" "Complex virtual sequences"
-"The " { $link complex-sequence } " class wraps a sequence of " { $link real } " number values, presenting a sequence of " { $link complex } " values made by treating the underlying sequence as pairs of alternating real and imaginary values."
-{ $subsection complex-sequence }
-{ $subsection <complex-sequence> } ;
-
-ABOUT: "sequences.complex"
-
-HELP: complex-sequence
-{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." }
-{ $examples { $example <"
-USING: prettyprint
-specialized-arrays.double sequences.complex
-sequences arrays ;
-double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array .
-"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
-
-HELP: <complex-sequence>
-{ $values { "sequence" sequence } { "complex-sequence" complex-sequence } }
-{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." }
-{ $examples { $example <"
-USING: prettyprint
-specialized-arrays.double sequences.complex
-sequences arrays ;
-double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second .
-"> "C{ -2.0 2.0 }" } } ;
-
-{ complex-sequence <complex-sequence> } related-words
+++ /dev/null
-USING: specialized-arrays.float sequences.complex
-kernel sequences tools.test arrays accessors ;
-IN: sequences.complex.tests
-
-: test-array ( -- x )
- float-array{ 1.0 2.0 3.0 4.0 } clone <complex-sequence> ;
-: odd-length-test-array ( -- x )
- float-array{ 1.0 2.0 3.0 4.0 5.0 } clone <complex-sequence> ;
-
-[ 2 ] [ test-array length ] unit-test
-[ 2 ] [ odd-length-test-array length ] unit-test
-
-[ C{ 1.0 2.0 } ] [ test-array first ] unit-test
-[ C{ 3.0 4.0 } ] [ test-array second ] unit-test
-
-[ { C{ 1.0 2.0 } C{ 3.0 4.0 } } ]
-[ test-array >array ] unit-test
-
-[ float-array{ 1.0 2.0 5.0 6.0 } ]
-[ test-array [ C{ 5.0 6.0 } 1 rot set-nth ] [ seq>> ] bi ]
-unit-test
-
-[ float-array{ 7.0 0.0 3.0 4.0 } ]
-[ test-array [ 7.0 0 rot set-nth ] [ seq>> ] bi ]
-unit-test
-
+++ /dev/null
-USING: accessors kernel math math.functions
-sequences sequences.private ;
-IN: sequences.complex
-
-TUPLE: complex-sequence seq ;
-INSTANCE: complex-sequence sequence
-
-: <complex-sequence> ( sequence -- complex-sequence )
- complex-sequence boa ; inline
-
-<PRIVATE
-
-: complex@ ( n seq -- n' seq' )
- [ 1 shift ] [ seq>> ] bi* ; inline
-
-PRIVATE>
-
-M: complex-sequence length
- seq>> length -1 shift ;
-M: complex-sequence nth-unsafe
- complex@ [ nth-unsafe ] [ [ 1+ ] dip nth-unsafe ] 2bi rect> ;
-M: complex-sequence set-nth-unsafe
- complex@
- [ [ real-part ] [ ] [ ] tri* set-nth-unsafe ]
- [ [ imaginary-part ] [ 1+ ] [ ] tri* set-nth-unsafe ] 3bi ;
+++ /dev/null
-Virtual sequence wrapper to convert real pairs into complex values
+++ /dev/null
-sequences
-math
projects / factor.git / commitdiff