Renovate math.blas.vectors to build off of functors and specialized-arrays. Add complex and complex-components sequence wrappers. Fix small bug in functors
Joe Groff
parent
d4071b08e4
commit
f990647d67
|
|
@ -17,7 +17,7 @@ IN: functors
|
||||||
scan-param parsed
|
scan-param parsed
|
||||||
scan {
|
scan {
|
||||||
{ ";" [ tuple parsed f parsed ] }
|
{ ";" [ tuple parsed f parsed ] }
|
||||||
{ "<" [ scan-param [ parse-tuple-slots ] { } make parsed ] }
|
{ "<" [ scan-param parsed [ parse-tuple-slots ] { } make parsed ] }
|
||||||
[
|
[
|
||||||
[ tuple parsed ] dip
|
[ tuple parsed ] dip
|
||||||
[ parse-slot-name [ parse-tuple-slots ] when ] { }
|
[ parse-slot-name [ parse-tuple-slots ] when ] { }
|
||||||
|
|
|
||||||
|
|
@ -34,10 +34,10 @@ TYPEDEF: int CBLAS_SIDE
|
||||||
|
|
||||||
TYPEDEF: int CBLAS_INDEX
|
TYPEDEF: int CBLAS_INDEX
|
||||||
|
|
||||||
C-STRUCT: CBLAS_C
|
C-STRUCT: float-complex
|
||||||
{ "float" "real" }
|
{ "float" "real" }
|
||||||
{ "float" "imag" } ;
|
{ "float" "imag" } ;
|
||||||
C-STRUCT: CBLAS_Z
|
C-STRUCT: double-complex
|
||||||
{ "double" "real" }
|
{ "double" "real" }
|
||||||
{ "double" "imag" } ;
|
{ "double" "imag" } ;
|
||||||
|
|
||||||
|
|
@ -53,14 +53,14 @@ FUNCTION: double cblas_ddot
|
||||||
( int N, double* X, int incX, double* Y, int incY ) ;
|
( int N, double* X, int incX, double* Y, int incY ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_cdotu_sub
|
FUNCTION: void cblas_cdotu_sub
|
||||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY, CBLAS_C* dotu ) ;
|
( int N, void* X, int incX, void* Y, int incY, void* dotu ) ;
|
||||||
FUNCTION: void cblas_cdotc_sub
|
FUNCTION: void cblas_cdotc_sub
|
||||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY, CBLAS_C* dotc ) ;
|
( int N, void* X, int incX, void* Y, int incY, void* dotc ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_zdotu_sub
|
FUNCTION: void cblas_zdotu_sub
|
||||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY, CBLAS_Z* dotu ) ;
|
( int N, void* X, int incX, void* Y, int incY, void* dotu ) ;
|
||||||
FUNCTION: void cblas_zdotc_sub
|
FUNCTION: void cblas_zdotc_sub
|
||||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY, CBLAS_Z* dotc ) ;
|
( int N, void* X, int incX, void* Y, int incY, void* dotc ) ;
|
||||||
|
|
||||||
FUNCTION: float cblas_snrm2
|
FUNCTION: float cblas_snrm2
|
||||||
( int N, float* X, int incX ) ;
|
( int N, float* X, int incX ) ;
|
||||||
|
|
@ -73,23 +73,23 @@ FUNCTION: double cblas_dasum
|
||||||
( int N, double* X, int incX ) ;
|
( int N, double* X, int incX ) ;
|
||||||
|
|
||||||
FUNCTION: float cblas_scnrm2
|
FUNCTION: float cblas_scnrm2
|
||||||
( int N, CBLAS_C* X, int incX ) ;
|
( int N, void* X, int incX ) ;
|
||||||
FUNCTION: float cblas_scasum
|
FUNCTION: float cblas_scasum
|
||||||
( int N, CBLAS_C* X, int incX ) ;
|
( int N, void* X, int incX ) ;
|
||||||
|
|
||||||
FUNCTION: double cblas_dznrm2
|
FUNCTION: double cblas_dznrm2
|
||||||
( int N, CBLAS_Z* X, int incX ) ;
|
( int N, void* X, int incX ) ;
|
||||||
FUNCTION: double cblas_dzasum
|
FUNCTION: double cblas_dzasum
|
||||||
( int N, CBLAS_Z* X, int incX ) ;
|
( int N, void* X, int incX ) ;
|
||||||
|
|
||||||
FUNCTION: CBLAS_INDEX cblas_isamax
|
FUNCTION: CBLAS_INDEX cblas_isamax
|
||||||
( int N, float* X, int incX ) ;
|
( int N, float* X, int incX ) ;
|
||||||
FUNCTION: CBLAS_INDEX cblas_idamax
|
FUNCTION: CBLAS_INDEX cblas_idamax
|
||||||
( int N, double* X, int incX ) ;
|
( int N, double* X, int incX ) ;
|
||||||
FUNCTION: CBLAS_INDEX cblas_icamax
|
FUNCTION: CBLAS_INDEX cblas_icamax
|
||||||
( int N, CBLAS_C* X, int incX ) ;
|
( int N, void* X, int incX ) ;
|
||||||
FUNCTION: CBLAS_INDEX cblas_izamax
|
FUNCTION: CBLAS_INDEX cblas_izamax
|
||||||
( int N, CBLAS_Z* X, int incX ) ;
|
( int N, void* X, int incX ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_sswap
|
FUNCTION: void cblas_sswap
|
||||||
( int N, float* X, int incX, float* Y, int incY ) ;
|
( int N, float* X, int incX, float* Y, int incY ) ;
|
||||||
|
|
@ -106,31 +106,31 @@ FUNCTION: void cblas_daxpy
|
||||||
( int N, double alpha, double* X, int incX, double* Y, int incY ) ;
|
( int N, double alpha, double* X, int incX, double* Y, int incY ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_cswap
|
FUNCTION: void cblas_cswap
|
||||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY ) ;
|
( int N, void* X, int incX, void* Y, int incY ) ;
|
||||||
FUNCTION: void cblas_ccopy
|
FUNCTION: void cblas_ccopy
|
||||||
( int N, CBLAS_C* X, int incX, CBLAS_C* Y, int incY ) ;
|
( int N, void* X, int incX, void* Y, int incY ) ;
|
||||||
FUNCTION: void cblas_caxpy
|
FUNCTION: void cblas_caxpy
|
||||||
( int N, CBLAS_C* alpha, CBLAS_C* X, int incX, CBLAS_C* Y, int incY ) ;
|
( int N, void* alpha, void* X, int incX, void* Y, int incY ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_zswap
|
FUNCTION: void cblas_zswap
|
||||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY ) ;
|
( int N, void* X, int incX, void* Y, int incY ) ;
|
||||||
FUNCTION: void cblas_zcopy
|
FUNCTION: void cblas_zcopy
|
||||||
( int N, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY ) ;
|
( int N, void* X, int incX, void* Y, int incY ) ;
|
||||||
FUNCTION: void cblas_zaxpy
|
FUNCTION: void cblas_zaxpy
|
||||||
( int N, CBLAS_Z* alpha, CBLAS_Z* X, int incX, CBLAS_Z* Y, int incY ) ;
|
( int N, void* alpha, void* X, int incX, void* Y, int incY ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_sscal
|
FUNCTION: void cblas_sscal
|
||||||
( int N, float alpha, float* X, int incX ) ;
|
( int N, float alpha, float* X, int incX ) ;
|
||||||
FUNCTION: void cblas_dscal
|
FUNCTION: void cblas_dscal
|
||||||
( int N, double alpha, double* X, int incX ) ;
|
( int N, double alpha, double* X, int incX ) ;
|
||||||
FUNCTION: void cblas_cscal
|
FUNCTION: void cblas_cscal
|
||||||
( int N, CBLAS_C* alpha, CBLAS_C* X, int incX ) ;
|
( int N, void* alpha, void* X, int incX ) ;
|
||||||
FUNCTION: void cblas_zscal
|
FUNCTION: void cblas_zscal
|
||||||
( int N, CBLAS_Z* alpha, CBLAS_Z* X, int incX ) ;
|
( int N, void* alpha, void* X, int incX ) ;
|
||||||
FUNCTION: void cblas_csscal
|
FUNCTION: void cblas_csscal
|
||||||
( int N, float alpha, CBLAS_C* X, int incX ) ;
|
( int N, float alpha, void* X, int incX ) ;
|
||||||
FUNCTION: void cblas_zdscal
|
FUNCTION: void cblas_zdscal
|
||||||
( int N, double alpha, CBLAS_Z* X, int incX ) ;
|
( int N, double alpha, void* X, int incX ) ;
|
||||||
|
|
||||||
FUNCTION: void cblas_srotg
|
FUNCTION: void cblas_srotg
|
||||||
( float* a, float* b, float* c, float* s ) ;
|
( float* a, float* b, float* c, float* s ) ;
|
||||||
|
|
|
||||||
|
|
@ -37,7 +37,7 @@ HELP: blas-vector-base
|
||||||
}
|
}
|
||||||
"All of these subclasses share the same tuple layout:"
|
"All of these subclasses share the same tuple layout:"
|
||||||
{ $list
|
{ $list
|
||||||
{ { $snippet "data" } " contains an alien pointer referencing or byte-array containing a packed array of float, double, float complex, or double complex values;" }
|
{ { $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;" }
|
{ { $snippet "length" } " indicates the length of the vector;" }
|
||||||
{ "and " { $snippet "inc" } " indicates the distance, in elements, between elements." }
|
{ "and " { $snippet "inc" } " indicates the distance, in elements, between elements." }
|
||||||
} } ;
|
} } ;
|
||||||
|
|
|
||||||
|
|
@ -1,231 +1,77 @@
|
||||||
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
USING: accessors alien alien.c-types arrays byte-arrays combinators
|
||||||
combinators.short-circuit fry kernel macros math math.blas.cblas
|
combinators.short-circuit fry kernel math math.blas.cblas
|
||||||
math.complex math.functions math.order multi-methods qualified
|
math.complex math.functions math.order sequences.complex
|
||||||
sequences sequences.private generalizations
|
sequences.complex-components sequences sequences.private
|
||||||
|
generalizations functors words locals
|
||||||
specialized-arrays.float specialized-arrays.double
|
specialized-arrays.float specialized-arrays.double
|
||||||
specialized-arrays.direct.float specialized-arrays.direct.double ;
|
specialized-arrays.direct.float specialized-arrays.direct.double ;
|
||||||
QUALIFIED: syntax
|
|
||||||
IN: math.blas.vectors
|
IN: math.blas.vectors
|
||||||
|
|
||||||
TUPLE: blas-vector-base data length inc ;
|
TUPLE: blas-vector-base underlying length inc ;
|
||||||
TUPLE: float-blas-vector < blas-vector-base ;
|
|
||||||
TUPLE: double-blas-vector < blas-vector-base ;
|
|
||||||
TUPLE: float-complex-blas-vector < blas-vector-base ;
|
|
||||||
TUPLE: double-complex-blas-vector < blas-vector-base ;
|
|
||||||
|
|
||||||
INSTANCE: float-blas-vector sequence
|
INSTANCE: blas-vector-base virtual-sequence
|
||||||
INSTANCE: double-blas-vector sequence
|
|
||||||
INSTANCE: float-complex-blas-vector sequence
|
|
||||||
INSTANCE: double-complex-blas-vector sequence
|
|
||||||
|
|
||||||
C: <float-blas-vector> float-blas-vector
|
GENERIC: element-type ( v -- type )
|
||||||
C: <double-blas-vector> double-blas-vector
|
|
||||||
C: <float-complex-blas-vector> float-complex-blas-vector
|
|
||||||
C: <double-complex-blas-vector> double-complex-blas-vector
|
|
||||||
|
|
||||||
GENERIC: n*V+V! ( alpha x y -- y=alpha*x+y )
|
GENERIC: n*V+V! ( alpha x y -- y=alpha*x+y )
|
||||||
GENERIC: n*V! ( alpha x -- x=alpha*x )
|
GENERIC: n*V! ( alpha x -- x=alpha*x )
|
||||||
|
|
||||||
GENERIC: V. ( x y -- x.y )
|
GENERIC: V. ( x y -- x.y )
|
||||||
GENERIC: V.conj ( x y -- xconj.y )
|
GENERIC: V.conj ( x y -- xconj.y )
|
||||||
GENERIC: Vnorm ( x -- norm )
|
GENERIC: Vnorm ( x -- norm )
|
||||||
GENERIC: Vasum ( x -- sum )
|
GENERIC: Vasum ( x -- sum )
|
||||||
GENERIC: Vswap ( x y -- x=y y=x )
|
GENERIC: Vswap ( x y -- x=y y=x )
|
||||||
|
|
||||||
GENERIC: Viamax ( x -- max-i )
|
GENERIC: Viamax ( x -- max-i )
|
||||||
|
|
||||||
GENERIC: element-type ( v -- type )
|
|
||||||
|
|
||||||
METHOD: element-type { float-blas-vector }
|
|
||||||
drop "float" ;
|
|
||||||
METHOD: element-type { double-blas-vector }
|
|
||||||
drop "double" ;
|
|
||||||
METHOD: element-type { float-complex-blas-vector }
|
|
||||||
drop "CBLAS_C" ;
|
|
||||||
METHOD: element-type { double-complex-blas-vector }
|
|
||||||
drop "CBLAS_Z" ;
|
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
GENERIC: (blas-vector-like) ( data length inc exemplar -- vector )
|
GENERIC: (blas-vector-like) ( data length inc exemplar -- vector )
|
||||||
|
|
||||||
METHOD: (blas-vector-like) { object object object float-blas-vector }
|
GENERIC: (blas-direct-array) ( blas-vector -- direct-array )
|
||||||
drop <float-blas-vector> ;
|
|
||||||
METHOD: (blas-vector-like) { object object object double-blas-vector }
|
|
||||||
drop <double-blas-vector> ;
|
|
||||||
METHOD: (blas-vector-like) { object object object float-complex-blas-vector }
|
|
||||||
drop <float-complex-blas-vector> ;
|
|
||||||
METHOD: (blas-vector-like) { object object object double-complex-blas-vector }
|
|
||||||
drop <double-complex-blas-vector> ;
|
|
||||||
|
|
||||||
: (prepare-copy) ( v element-size -- length v-data v-inc v-dest-data v-dest-inc )
|
: shorter-length ( v1 v2 -- length )
|
||||||
[ [ length>> ] [ data>> ] [ inc>> ] tri ] dip
|
[ length>> ] bi@ min ; inline
|
||||||
4 npick * <byte-array>
|
: data-and-inc ( v -- data inc )
|
||||||
1 ;
|
[ underlying>> ] [ inc>> ] bi ; inline
|
||||||
|
: datas-and-incs ( v1 v2 -- v1-data v1-inc v2-data v2-inc )
|
||||||
|
[ data-and-inc ] bi@ ; inline
|
||||||
|
|
||||||
MACRO: (do-copy) ( copy make-vector -- )
|
:: (prepare-copy)
|
||||||
'[ over 6 npick _ 2dip 1 @ ] ;
|
( 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 )
|
: (prepare-swap)
|
||||||
[
|
( v1 v2 -- length v1-data v1-inc v2-data v2-inc
|
||||||
[ [ length>> ] bi@ min ]
|
v1 v2 )
|
||||||
[ [ [ data>> ] [ inc>> ] bi ] bi@ ] 2bi
|
[ shorter-length ] [ datas-and-incs ] [ ] 2tri ;
|
||||||
] 2keep ;
|
|
||||||
|
|
||||||
: (prepare-axpy) ( n v1 v2 -- length n v1-data v1-inc v2-data v2-inc v2 )
|
:: (prepare-axpy)
|
||||||
[
|
( n v1 v2 -- length n v1-data v1-inc v2-data v2-inc
|
||||||
[ [ length>> ] bi@ min swap ]
|
v2 )
|
||||||
[ [ [ data>> ] [ inc>> ] bi ] bi@ ] 2bi
|
v1 v2 shorter-length
|
||||||
] keep ;
|
n
|
||||||
|
v1 v2 datas-and-incs
|
||||||
|
v2 ;
|
||||||
|
|
||||||
: (prepare-scal) ( n v -- length n v-data v-inc v )
|
:: (prepare-scal)
|
||||||
[ [ length>> swap ] [ data>> ] [ inc>> ] tri ] keep ;
|
( 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 )
|
: (prepare-dot) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc )
|
||||||
[ [ length>> ] bi@ min ]
|
[ shorter-length ] [ datas-and-incs ] 2bi ;
|
||||||
[ [ [ data>> ] [ inc>> ] bi ] bi@ ] 2bi ;
|
|
||||||
|
|
||||||
: (prepare-nrm2) ( v -- length v1-data v1-inc )
|
: (prepare-nrm2) ( v -- length data inc )
|
||||||
[ length>> ] [ data>> ] [ inc>> ] tri ;
|
[ length>> ] [ data-and-inc ] bi ;
|
||||||
|
|
||||||
: (flatten-complex-sequence) ( seq -- seq' )
|
|
||||||
[ [ real-part ] [ imaginary-part ] bi 2array ] map concat ;
|
|
||||||
|
|
||||||
: (>c-complex) ( complex -- alien )
|
|
||||||
[ real-part ] [ imaginary-part ] bi float-array{ } 2sequence underlying>> ;
|
|
||||||
: (>z-complex) ( complex -- alien )
|
|
||||||
[ real-part ] [ imaginary-part ] bi double-array{ } 2sequence underlying>> ;
|
|
||||||
|
|
||||||
: (c-complex>) ( alien -- complex )
|
|
||||||
2 <direct-float-array> first2 rect> ;
|
|
||||||
: (z-complex>) ( alien -- complex )
|
|
||||||
2 <direct-double-array> first2 rect> ;
|
|
||||||
|
|
||||||
: (prepare-nth) ( n v -- n*inc v-data )
|
|
||||||
[ inc>> ] [ data>> ] bi [ * ] dip ;
|
|
||||||
|
|
||||||
MACRO: (complex-nth) ( nth-quot -- )
|
|
||||||
'[
|
|
||||||
[ 2 * dup 1+ ] dip
|
|
||||||
_ curry bi@ rect>
|
|
||||||
] ;
|
|
||||||
|
|
||||||
: (c-complex-nth) ( n alien -- complex )
|
|
||||||
[ float-nth ] (complex-nth) ;
|
|
||||||
: (z-complex-nth) ( n alien -- complex )
|
|
||||||
[ double-nth ] (complex-nth) ;
|
|
||||||
|
|
||||||
MACRO: (set-complex-nth) ( set-nth-quot -- )
|
|
||||||
'[
|
|
||||||
[
|
|
||||||
[ [ real-part ] [ imaginary-part ] bi ]
|
|
||||||
[ 2 * dup 1+ ] bi*
|
|
||||||
swapd
|
|
||||||
] dip
|
|
||||||
_ curry 2bi@
|
|
||||||
] ;
|
|
||||||
|
|
||||||
: (set-c-complex-nth) ( complex n alien -- )
|
|
||||||
[ set-float-nth ] (set-complex-nth) ;
|
|
||||||
: (set-z-complex-nth) ( complex n alien -- )
|
|
||||||
[ set-double-nth ] (set-complex-nth) ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: <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) ;
|
|
||||||
|
|
||||||
syntax:M: blas-vector-base length
|
|
||||||
length>> ;
|
|
||||||
|
|
||||||
syntax:M: float-blas-vector nth-unsafe
|
|
||||||
(prepare-nth) float-nth ;
|
|
||||||
syntax:M: float-blas-vector set-nth-unsafe
|
|
||||||
(prepare-nth) set-float-nth ;
|
|
||||||
|
|
||||||
syntax:M: double-blas-vector nth-unsafe
|
|
||||||
(prepare-nth) double-nth ;
|
|
||||||
syntax:M: double-blas-vector set-nth-unsafe
|
|
||||||
(prepare-nth) set-double-nth ;
|
|
||||||
|
|
||||||
syntax:M: float-complex-blas-vector nth-unsafe
|
|
||||||
(prepare-nth) (c-complex-nth) ;
|
|
||||||
syntax:M: float-complex-blas-vector set-nth-unsafe
|
|
||||||
(prepare-nth) (set-c-complex-nth) ;
|
|
||||||
|
|
||||||
syntax:M: double-complex-blas-vector nth-unsafe
|
|
||||||
(prepare-nth) (z-complex-nth) ;
|
|
||||||
syntax:M: double-complex-blas-vector set-nth-unsafe
|
|
||||||
(prepare-nth) (set-z-complex-nth) ;
|
|
||||||
|
|
||||||
syntax:M: blas-vector-base equal?
|
|
||||||
{
|
|
||||||
[ [ length ] bi@ = ]
|
|
||||||
[ [ = ] 2all? ]
|
|
||||||
} 2&& ;
|
|
||||||
|
|
||||||
: >float-blas-vector ( seq -- v )
|
|
||||||
[ >float-array underlying>> ] [ length ] bi 1 <float-blas-vector> ;
|
|
||||||
: >double-blas-vector ( seq -- v )
|
|
||||||
[ >double-array underlying>> ] [ length ] bi 1 <double-blas-vector> ;
|
|
||||||
: >float-complex-blas-vector ( seq -- v )
|
|
||||||
[ (flatten-complex-sequence) >float-array underlying>> ] [ length ] bi
|
|
||||||
1 <float-complex-blas-vector> ;
|
|
||||||
: >double-complex-blas-vector ( seq -- v )
|
|
||||||
[ (flatten-complex-sequence) >double-array underlying>> ] [ length ] bi
|
|
||||||
1 <double-complex-blas-vector> ;
|
|
||||||
|
|
||||||
syntax:M: float-blas-vector clone
|
|
||||||
"float" heap-size (prepare-copy)
|
|
||||||
[ cblas_scopy ] [ <float-blas-vector> ] (do-copy) ;
|
|
||||||
syntax:M: double-blas-vector clone
|
|
||||||
"double" heap-size (prepare-copy)
|
|
||||||
[ cblas_dcopy ] [ <double-blas-vector> ] (do-copy) ;
|
|
||||||
syntax:M: float-complex-blas-vector clone
|
|
||||||
"CBLAS_C" heap-size (prepare-copy)
|
|
||||||
[ cblas_ccopy ] [ <float-complex-blas-vector> ] (do-copy) ;
|
|
||||||
syntax:M: double-complex-blas-vector clone
|
|
||||||
"CBLAS_Z" heap-size (prepare-copy)
|
|
||||||
[ cblas_zcopy ] [ <double-complex-blas-vector> ] (do-copy) ;
|
|
||||||
|
|
||||||
METHOD: Vswap { float-blas-vector float-blas-vector }
|
|
||||||
(prepare-swap) [ cblas_sswap ] 2dip ;
|
|
||||||
METHOD: Vswap { double-blas-vector double-blas-vector }
|
|
||||||
(prepare-swap) [ cblas_dswap ] 2dip ;
|
|
||||||
METHOD: Vswap { float-complex-blas-vector float-complex-blas-vector }
|
|
||||||
(prepare-swap) [ cblas_cswap ] 2dip ;
|
|
||||||
METHOD: Vswap { double-complex-blas-vector double-complex-blas-vector }
|
|
||||||
(prepare-swap) [ cblas_zswap ] 2dip ;
|
|
||||||
|
|
||||||
METHOD: n*V+V! { real float-blas-vector float-blas-vector }
|
|
||||||
(prepare-axpy) [ cblas_saxpy ] dip ;
|
|
||||||
METHOD: n*V+V! { real double-blas-vector double-blas-vector }
|
|
||||||
(prepare-axpy) [ cblas_daxpy ] dip ;
|
|
||||||
METHOD: n*V+V! { number float-complex-blas-vector float-complex-blas-vector }
|
|
||||||
[ (>c-complex) ] 2dip
|
|
||||||
(prepare-axpy) [ cblas_caxpy ] dip ;
|
|
||||||
METHOD: n*V+V! { number double-complex-blas-vector double-complex-blas-vector }
|
|
||||||
[ (>z-complex) ] 2dip
|
|
||||||
(prepare-axpy) [ cblas_zaxpy ] dip ;
|
|
||||||
|
|
||||||
METHOD: n*V! { real float-blas-vector }
|
|
||||||
(prepare-scal) [ cblas_sscal ] dip ;
|
|
||||||
METHOD: n*V! { real double-blas-vector }
|
|
||||||
(prepare-scal) [ cblas_dscal ] dip ;
|
|
||||||
METHOD: n*V! { number float-complex-blas-vector }
|
|
||||||
[ (>c-complex) ] dip
|
|
||||||
(prepare-scal) [ cblas_cscal ] dip ;
|
|
||||||
METHOD: n*V! { number double-complex-blas-vector }
|
|
||||||
[ (>z-complex) ] dip
|
|
||||||
(prepare-scal) [ cblas_zscal ] dip ;
|
|
||||||
|
|
||||||
: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline
|
: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline
|
||||||
: n*V ( alpha x -- alpha*x ) clone n*V! ; inline
|
: n*V ( alpha x -- alpha*x ) clone n*V! ; inline
|
||||||
|
|
||||||
|
|
@ -242,62 +88,170 @@ METHOD: n*V! { number double-complex-blas-vector }
|
||||||
: V/n ( x alpha -- x/alpha )
|
: V/n ( x alpha -- x/alpha )
|
||||||
recip swap n*V ; inline
|
recip swap n*V ; inline
|
||||||
|
|
||||||
METHOD: V. { float-blas-vector float-blas-vector }
|
|
||||||
(prepare-dot) cblas_sdot ;
|
|
||||||
METHOD: V. { double-blas-vector double-blas-vector }
|
|
||||||
(prepare-dot) cblas_ddot ;
|
|
||||||
METHOD: V. { float-complex-blas-vector float-complex-blas-vector }
|
|
||||||
(prepare-dot)
|
|
||||||
"CBLAS_C" <c-object> [ cblas_cdotu_sub ] keep (c-complex>) ;
|
|
||||||
METHOD: V. { double-complex-blas-vector double-complex-blas-vector }
|
|
||||||
(prepare-dot)
|
|
||||||
"CBLAS_Z" <c-object> [ cblas_zdotu_sub ] keep (z-complex>) ;
|
|
||||||
|
|
||||||
METHOD: V.conj { float-blas-vector float-blas-vector }
|
|
||||||
(prepare-dot) cblas_sdot ;
|
|
||||||
METHOD: V.conj { double-blas-vector double-blas-vector }
|
|
||||||
(prepare-dot) cblas_ddot ;
|
|
||||||
METHOD: V.conj { float-complex-blas-vector float-complex-blas-vector }
|
|
||||||
(prepare-dot)
|
|
||||||
"CBLAS_C" <c-object> [ cblas_cdotc_sub ] keep (c-complex>) ;
|
|
||||||
METHOD: V.conj { double-complex-blas-vector double-complex-blas-vector }
|
|
||||||
(prepare-dot)
|
|
||||||
"CBLAS_Z" <c-object> [ cblas_zdotc_sub ] keep (z-complex>) ;
|
|
||||||
|
|
||||||
METHOD: Vnorm { float-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_snrm2 ;
|
|
||||||
METHOD: Vnorm { double-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_dnrm2 ;
|
|
||||||
METHOD: Vnorm { float-complex-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_scnrm2 ;
|
|
||||||
METHOD: Vnorm { double-complex-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_dznrm2 ;
|
|
||||||
|
|
||||||
METHOD: Vasum { float-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_sasum ;
|
|
||||||
METHOD: Vasum { double-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_dasum ;
|
|
||||||
METHOD: Vasum { float-complex-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_scasum ;
|
|
||||||
METHOD: Vasum { double-complex-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_dzasum ;
|
|
||||||
|
|
||||||
METHOD: Viamax { float-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_isamax ;
|
|
||||||
METHOD: Viamax { double-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_idamax ;
|
|
||||||
METHOD: Viamax { float-complex-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_icamax ;
|
|
||||||
METHOD: Viamax { double-complex-blas-vector }
|
|
||||||
(prepare-nrm2) cblas_izamax ;
|
|
||||||
|
|
||||||
: Vamax ( x -- max )
|
: Vamax ( x -- max )
|
||||||
[ Viamax ] keep nth ; inline
|
[ Viamax ] keep nth ; inline
|
||||||
|
|
||||||
: Vsub ( v start length -- sub )
|
:: Vsub ( v start length -- sub )
|
||||||
rot [
|
v inc>> start * v element-type heap-size *
|
||||||
[
|
v underlying>> <displaced-alien>
|
||||||
nip [ inc>> ] [ element-type heap-size ] [ data>> ] tri
|
length v inc>> v (blas-vector-like) ;
|
||||||
[ * * ] dip <displaced-alien>
|
|
||||||
] [ swap 2nip ] [ 2nip inc>> ] 3tri
|
: <zero-vector> ( exemplar -- zero )
|
||||||
] keep (blas-vector-like) ;
|
[ 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 ;
|
||||||
|
|
||||||
|
|
||||||
|
<<
|
||||||
|
|
||||||
|
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
|
||||||
|
XAXPY IS cblas_${T}axpy
|
||||||
|
XSCAL IS cblas_${T}scal
|
||||||
|
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 n*V+V!
|
||||||
|
(prepare-axpy) [ XAXPY execute ] dip ;
|
||||||
|
M: VECTOR n*V!
|
||||||
|
(prepare-scal) [ XSCAL execute ] dip ;
|
||||||
|
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
|
||||||
|
|
||||||
|
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 ;
|
||||||
|
|
||||||
|
;FUNCTOR
|
||||||
|
|
||||||
|
|
||||||
|
FUNCTOR: (define-complex-helpers) ( TYPE -- )
|
||||||
|
|
||||||
|
<DIRECT-COMPLEX-ARRAY> DEFINES <direct-${TYPE}-complex-array>
|
||||||
|
>COMPLEX-ARRAY DEFINES >${TYPE}-complex-array
|
||||||
|
ALIEN>COMPLEX DEFINES alien>${TYPE}-complex
|
||||||
|
<DIRECT-ARRAY> IS <direct-${TYPE}-array>
|
||||||
|
>ARRAY IS >${TYPE}-array
|
||||||
|
|
||||||
|
WHERE
|
||||||
|
|
||||||
|
: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
|
||||||
|
<DIRECT-ARRAY> execute <complex-sequence> ;
|
||||||
|
: >COMPLEX-ARRAY ( sequence -- sequence )
|
||||||
|
<complex-components> >ARRAY execute ;
|
||||||
|
: ALIEN>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
|
||||||
|
ALIEN>TYPE IS alien>${TYPE}
|
||||||
|
|
||||||
|
WHERE
|
||||||
|
|
||||||
|
M: VECTOR V.
|
||||||
|
(prepare-dot) TYPE <c-object>
|
||||||
|
[ XDOTU_SUB execute ] keep
|
||||||
|
ALIEN>TYPE execute ;
|
||||||
|
M: VECTOR V.conj
|
||||||
|
(prepare-dot) TYPE <c-object>
|
||||||
|
[ XDOTC_SUB execute ] keep
|
||||||
|
ALIEN>TYPE execute ;
|
||||||
|
M: VECTOR Vnorm
|
||||||
|
(prepare-nrm2) XXNRM2 execute ;
|
||||||
|
M: VECTOR Vasum
|
||||||
|
(prepare-nrm2) XXASUM execute ;
|
||||||
|
|
||||||
|
;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
|
||||||
|
|
||||||
|
>>
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Joe Groff
|
||||||
|
|
@ -0,0 +1,33 @@
|
||||||
|
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: 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: sequences arrays sequences.complex-components ;
|
||||||
|
{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> third
|
||||||
|
"> "-2.0" }
|
||||||
|
{ $example <"
|
||||||
|
USING: 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
|
||||||
|
|
@ -0,0 +1,16 @@
|
||||||
|
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
|
||||||
|
|
||||||
|
|
@ -0,0 +1,28 @@
|
||||||
|
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-sequence )
|
||||||
|
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 ;
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Virtual sequence wrapper to convert complex values into real value pairs
|
||||||
|
|
@ -0,0 +1,2 @@
|
||||||
|
sequences
|
||||||
|
math
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Joe Groff
|
||||||
|
|
@ -0,0 +1,29 @@
|
||||||
|
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: 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: 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
|
||||||
|
|
@ -0,0 +1,26 @@
|
||||||
|
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
|
||||||
|
|
||||||
|
|
@ -0,0 +1,25 @@
|
||||||
|
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 ;
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Virtual sequence wrapper to convert real pairs into complex values
|
||||||
|
|
@ -0,0 +1,2 @@
|
||||||
|
sequences
|
||||||
|
math
|
||||||
Loading…
Reference in New Issue