(49G) Function of a Matrix

[Gerald H]

MFUN applies a function to a square matrix, calculator should be in approx & complex modes. For example, to find the natural log of matrix

M1=[[ -9. 0. -1. -4. ]
[ 4. 9. 3. 3. ]
[ 0. 4. -9. 9. ]
[ 5. -1. -6. -4. ]]

place M1 on stack level Y & 'LN(X)' on stack level X. MFUN returns the complex matrix

M2=[[ (2.17927367373,1.99350072846) (-.185449038469,-.25062812471) (.12978172209,1.13653167793) (-1.21072226166,-.24561453301) ]
[ (-.349990278973,-.725022350755) (2.17006519946,9.11517059164E-2) (.316994726521,-.413348667032) (-8.29926914019E-3,8.93282974816E-2) ]
[ (.499972969813,1.87320392796) (.360844076572,-.235504096367) (1.81399293871,1.06794824449) (2.26427803714,-.230793047339) ]
[ (1.5738586231,8.93453089839E-2) (.311847366461,-1.12327258886E-2) (-1.58567642989,5.09374150115E-2) (2.97368489567,-.011008025242) ]]

to stack level X.

As a check, you could then put 'e^X' on the stack & actuate MFUN again, to return

[[ (-8.99999999989,-1.62595437076E-10) (-7.789692811E-12,2.87950512152E-11) (-.999999999977,-1.80997814311E-10) (-3.99999999999,-1.76112719874E-11) ]
[ (3.99999999998,4.21474277251E-11) (9.00000000017,7.44661562123E-11) (2.99999999996,3.96498859739E-11) (3.00000000004,1.34469661894E-12) ]
[ (2.98413096713E-11,-1.53814112532E-10) (3.99999999998,4.04329178333E-11) (-8.99999999998,-1.19988781132E-10) (8.99999999994,1.82967287016E-10) ]
[ (4.99999999998,6.94233268647E-11) (-1.00000000004,6.827569037E-12) (-5.99999999997,-5.4121217567E-11) (-4.00000000003,1.19154531002E-10) ]]

where the imaginary parts are v small, so RE 0 RND looks more like the original M1.

I am sure the programme has enormous inefficiencies & would welcome improvements.

TI fans - the TI-92 does this out of the box, just use LN(M1).

Code:

::
  CK2&Dispatch
  # 49
  ::
    {
      Z1_
    }
    Z0_
    NULL{}
    DUPDUP
    BINT1
    BINT1
    BINT0
    FPTR2 ^RCLVX
    '
    NULLLAM
    BINT11
    NDUPN
    DOBIND
    BINT105
    BINT110
    ClrUserFlag
    ClrUserFlag
    BINT110
    BINT110
    SysITE
    SetUserFlag
    SetSysFlag
    BINT105
    BINT105
    SysITE
    ::
      SetUserFlag
      11GETLAM
      FPTR2 ^CKNUMARRY
      11PUTLAM
    ;
    DROP
    11GETLAM
    DUP
    MDIMSDROP
    DROP
    4PUTLAM
    FPTR2 ^MATEGVL
    FPTR2 ^MATRIX2LIST
    DUPLENCOMP
    4GETLAM
    #<
    IT
    ::
      BINT105
      SetSysFlag
      DROP
      11GETLAM
      FPTR2 ^CKNUMARRY
      DUP
      11PUTLAM
      FPTR2 ^MATEGVL
      FPTR2 ^MATRIX2LIST
    ;
    7PUTLAM
    BEGIN
    4GETLAM
    #0<>
    WHILE
    ::
      6GETLAM
      7GETLAM
      CARCOMP
      >TCOMP
      DUP
      6PUTLAM
      5GETLAM
      BINT1
      >TCOMP
      5PUTLAM
      3GETLAM
      NTHCOMPDROP
      7GETLAM
      CDRCOMP
      DUP
      7PUTLAM
      SWAP
      EQUALPOSCOMP
      2PUTLAM
      BEGIN
      2GETLAM
      #0<>
      WHILE
      ::
        7GETLAM
        INNERDUP
        #2+
        2GETLAM
        #-
        ROLLDROP
        #1-{}N
        DUP
        7PUTLAM
        5GETLAM
        DUP
        3GETLAM
        NTHCOMPDROP
        #1+
        3GETLAM
        ROT
        PUTLIST
        5PUTLAM
        6GETLAM
        3GETLAM
        NTHCOMPDROP
        EQUALPOSCOMP
        2PUTLAM
      ;
      REPEAT
      3GETLAM
      #1+
      3PUTLAM
      7GETLAM
      LENCOMP
      4PUTLAM
    ;
    REPEAT
    3GETLAM
    #1-
    3PUTLAM
    11GETLAM
    MDIMSDROP
    DROP
    4PUTLAM
    9GETLAM
    4GETLAM
    ONE_DO
    1GETLAM
    INDEX@
    FPTR2 ^#>Z
    PTR 2EF1F
    >TCOMP
    LOOP
    10GETLAM
    >TCOMP
    DUP
    9PUTLAM
    1GETLAM
    6GETLAM
    CARCOMP
    PTR 2EF27
    FPTR2 ^FLAGSYMBEXEC
    FPTR2 ^LIST2MATRIX
    5GETLAM
    CARCOMP
    BINT1
    #>
    IT
    ::
      5GETLAM
      CARCOMP
      ONE_DO
      9GETLAM
      INDEX@
      ZERO_DO
      1GETLAM
      FPTR2 ^DERIVext
      LOOP
      1GETLAM
      6GETLAM
      CARCOMP
      PTR 2EF27
      xSUBST
      xAXL
      LOOP
    ;
    3GETLAM
    BINT1
    #>
    IT
    ::
      3GETLAM
      #1+
      BINT2
      DO
      9GETLAM
      1GETLAM
      6GETLAM
      INDEX@
      NTHCOMPDROP
      PTR 2EF27
      FPTR2 ^FLAGSYMBEXEC
      FPTR2 ^LIST2MATRIX
      5GETLAM
      INDEX@
      NTHCOMPDROP
      BINT1
      #>
      IT
      ::
        5GETLAM
        INDEX@
        NTHCOMPDROP
        ONE_DO
        9GETLAM
        INDEX@
        ZERO_DO
        1GETLAM
        FPTR2 ^DERIVext
        LOOP
        1GETLAM
        6GETLAM
        JINDEX@
        NTHCOMPDROP
        PTR 2EF27
        xSUBST
        xAXL
        LOOP
      ;
      LOOP
    ;
    4GETLAM
    FPTR 3 68
    FPTR2 ^MATRREF
    4GETLAM
    #1+
    FPTR2 ^MATRIX-COL
    SWAPDROP
    FPTR2 ^MATRIX2LIST
    DUP
    8PUTLAM
    CARCOMP
    4GETLAM
    UNCOERCE
    PTR 2F28F
    FPTR2 ^SCL*MAT
    4GETLAM
    #1+
    BINT2
    DO
    8GETLAM
    INDEX@
    NTHCOMPDROP
    11GETLAM
    INDEX@
    #1-
    FPTR2 ^#>Z
    FPTR2 ^MAT^
    FPTR2 ^SCL*MAT
    FPTR2 ^MAT+
    LOOP
    ABND
    FPTR2 ^FLAGEXPAND
    BINT110
    BINT110
    UserITE
    ClrUserFlag
    ClrSysFlag
    BINT105
    BINT105
    UserITE
    ClrUserFlag
    ClrSysFlag
  ;
;