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

math.matrices: Add some more matrix norms.

elevate-erg
Doug Coleman 2018-07-04 16:14:44 -05:00
parent 9af298fd49
commit 0e51880199
2 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/math/matrices/matrices-tests.factor
View File

@ -383,3 +383,12 @@ CONSTANT: test-points {
{ t } [ { { 1 2 } { 3 4 } } square-matrix? ] unit-test { t } [ { { 1 2 } { 3 4 } } square-matrix? ] unit-test
{ f } [ { { 1 } { 2 3 } } square-matrix? ] unit-test { f } [ { { 1 } { 2 3 } } square-matrix? ] unit-test
{ f } [ { { 1 2 } } square-matrix? ] unit-test { f } [ { { 1 2 } } square-matrix? ] unit-test
{ 9 }
[ { { 2 -2 1 } { 1 3 -1 } { 2 -4 2 } } m-1norm ] unit-test
{ 8 }
[ { { 2 -2 1 } { 1 3 -1 } { 2 -4 2 } } m-infinity-norm ] unit-test
{ 2.0 }
[ { { 1 1 } { 1 1 } } frobenius-norm ] unit-test

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

@ -141,6 +141,9 @@ IN: math.matrices
: mmin ( m -- n ) [ 1/0. ] dip [ [ min ] each ] each ; : mmin ( m -- n ) [ 1/0. ] dip [ [ min ] each ] each ;
: mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ; : mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ;
: mnorm ( m -- n ) dup mmax abs m/n ; : mnorm ( m -- n ) dup mmax abs m/n ;
: m-infinity-norm ( m -- n ) [ [ abs ] map-sum ] map supremum ;
: m-1norm ( m -- n ) flip m-infinity-norm ;
: frobenius-norm ( m -- n ) [ [ sq ] map-sum ] map-sum sqrt ;
: cross ( vec1 vec2 -- vec3 ) : cross ( vec1 vec2 -- vec3 )
[ [ { 1 2 0 } vshuffle ] [ { 2 0 1 } vshuffle ] bi* v* ] [ [ { 1 2 0 } vshuffle ] [ { 2 0 1 } vshuffle ] bi* v* ]