steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.matrices: faster square-rows and square-cols.

db4
John Benediktsson 2013-05-14 13:46:44 -07:00
parent a8979ad9bc
commit bcbf3198f7
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/math/matrices/matrices.factor
View File

@ -198,7 +198,6 @@ IN: math.matrices
: set-indices ( object sequence matrix -- ) : set-indices ( object sequence matrix -- )
'[ _ set-index ] with each ; inline '[ _ set-index ] with each ; inline
: matrix-map ( matrix quot -- ) : matrix-map ( matrix quot -- )
'[ _ map ] map ; inline '[ _ map ] map ; inline
@ -224,24 +223,24 @@ IN: math.matrices
GENERIC: square-rows ( object -- matrix ) GENERIC: square-rows ( object -- matrix )
M: integer square-rows iota square-rows ; M: integer square-rows iota square-rows ;
M: sequence square-rows dup [ nip ] cartesian-map ; M: sequence square-rows
>array [ length ] keep [ clone ] curry { } replicate-as ;
GENERIC: square-cols ( object -- matrix ) GENERIC: square-cols ( object -- matrix )
M: integer square-cols iota square-cols ; M: integer square-cols iota square-cols ;
M: sequence square-cols dup [ drop ] cartesian-map ; M: sequence square-cols
[ length ] keep [ <array> ] with { } map-as ;
: make-matrix-with-indices ( m n quot -- matrix ) : make-matrix-with-indices ( m n quot -- matrix )
[ [ iota ] bi@ ] dip '[ @ ] cartesian-map ; inline [ [ iota ] bi@ ] dip '[ @ ] cartesian-map ; inline
: null-matrix? ( matrix -- ? ) empty? ; : null-matrix? ( matrix -- ? ) empty? ; inline
: well-formed-matrix? ( matrix -- ? ) : well-formed-matrix? ( matrix -- ? )
dup null-matrix? [ [ t ] [
drop t
] [
[ ] [ first length ] bi [ ] [ first length ] bi
'[ length _ = ] all? '[ length _ = ] all?
] if ; ] if-empty ;
: dim ( matrix -- pair/f ) : dim ( matrix -- pair/f )
[ 2 0 <array> ] [ 2 0 <array> ]
@ -262,7 +261,6 @@ M: sequence square-cols dup [ drop ] cartesian-map ;
: lower-matrix-indices ( matrix -- matrix' ) : lower-matrix-indices ( matrix -- matrix' )
dimension-range [ head-slice >array ] 2map concat ; dimension-range [ head-slice >array ] 2map concat ;
: make-lower-matrix ( object m n -- matrix ) : make-lower-matrix ( object m n -- matrix )
zero-matrix [ lower-matrix-indices ] [ set-indices ] [ ] tri ; zero-matrix [ lower-matrix-indices ] [ set-indices ] [ ] tri ;