diff --git a/basis/math/matrices/matrices-tests.factor b/basis/math/matrices/matrices-tests.factor index 0140ade96f..e7a1124d0d 100644 --- a/basis/math/matrices/matrices-tests.factor +++ b/basis/math/matrices/matrices-tests.factor @@ -208,6 +208,7 @@ IN: math.matrices.tests [ { { 4181 6765 } { 6765 10946 } } ] [ { { 0 1 } { 1 1 } } 20 m^n ] unit-test +[ { { 0 1 } { 1 1 } } -20 m^n ] [ negative-power-matrix? ] must-fail-with { { { 0 5 0 10 } { 6 7 12 14 } { 0 15 0 20 } { 18 21 24 28 } } diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index 8ef4484353..58e205fcfd 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -167,10 +167,15 @@ IN: math.matrices : norm-gram-schmidt ( seq -- orthonormal ) gram-schmidt [ normalize ] map ; -: m^n ( m n -- n ) +ERROR: negative-power-matrix m n ; + +: (m^n) ( m n -- n ) make-bits over first length identity-matrix [ [ dupd m. ] when [ dup m. ] dip ] reduce nip ; +: m^n ( m n -- n ) + dup 0 >= [ (m^n) ] [ negative-power-matrix ] if ; + : stitch ( m -- m' ) [ ] [ [ append ] 2map ] map-reduce ;