For a given matrix, return the determinant and the permanent of the matrix.

The determinant is given by

 



det
(
A
)
=

∑

σ


sgn
⁡
(
σ
)

∏

i
=
1


n



M

i
,

σ

i






{\displaystyle \det(A)=\sum _{\sigma }\operatorname {sgn}(\sigma )\prod _{i=1}^{n}M_{i,\sigma _{i}}}


while the permanent is given by

 



perm
⁡
(
A
)
=

∑

σ



∏

i
=
1


n



M

i
,

σ

i






{\displaystyle \operatorname {perm} (A)=\sum _{\sigma }\prod _{i=1}^{n}M_{i,\sigma _{i}}}


In both cases the sum is over the permutations 



σ


{\displaystyle \sigma }

 of the permutations of 1, 2, ..., n. (A permutation's sign is 1 if there are an even number of inversions and -1 otherwise; see parity of a permutation.)

More efficient algorithms for the determinant are known: LU decomposition, see for example wp:LU decomposition#Computing the determinant. Efficient methods for calculating the permanent are not known.



Related task

 Permutations by swapping


*        Matrix arithmetic         13/05/2016
MATARI   START
         STM    R14,R12,12(R13)    save caller's registers
         LR     R12,R15            set R12 as base register
         USING  MATARI,R12         notify assembler
         LA     R11,SAVEAREA       get the address of my savearea
         ST     R13,4(R11)         save caller's savearea pointer
         ST     R11,8(R13)         save my savearea pointer
         LR     R13,R11            set R13 to point to my savearea
         LA     R1,TT              @tt
         BAL    R14,DETER          call deter(tt)
         LR     R2,R0              R2=deter(tt)
         LR     R3,R1              R3=perm(tt)
         XDECO  R2,PG1+12          edit determinant
         XPRNT  PG1,80             print determinant
         XDECO  R3,PG2+12          edit permanent
         XPRNT  PG2,80             print permanent
EXITALL  L      R13,SAVEAREA+4     restore caller's savearea address
         LM     R14,R12,12(R13)    restore caller's registers
         XR     R15,R15            set return code to 0
         BR     R14                return to caller
SAVEAREA DS     18F                main savearea
TT       DC     F'3'               matrix size 
         DC     F'2',F'9',F'4',F'7',F'5',F'3',F'6',F'1',F'8' <==input
PG1      DC     CL80'determinant='
PG2      DC     CL80'permanent='
XDEC     DS     CL12
*        recursive function        (R0,R1)=deter(t)   (python style)
DETER    CNOP   0,4                  returns determinant and permanent
         STM    R14,R12,12(R13)    save all registers
         LR     R9,R1              save R1
         L      R2,0(R1)           n
         BCTR   R2,0               n-1
         LR     R11,R2             n-1
         MR     R10,R2             (n-1)*(n-1)
         SLA    R11,2              (n-1)*(n-1)*4
         LA     R11,1(R11)         size of q array
         A      R11,=A(STACKLEN)   R11 storage amount required
         GETMAIN RU,LV=(R11)       allocate storage for stack
         USING  STACK,R10          make storage addressable
         LR     R10,R1             establish stack addressability
         LA     R1,SAVEAREB        get the address of my savearea
         ST     R13,4(R1)          save caller's savearea pointer
         ST     R1,8(R13)          save my savearea pointer
         LR     R13,R1             set R13 to point to my savearea
         LR     R1,R9              restore R1
         LR     R9,R1              @t
         L      R4,0(R9)           t(0)
         ST     R4,N               n=t(0)
IF1      CH     R4,=H'1'           if n=1
         BNE    SIF1               then
         L      R2,4(R9)             t(1)
         ST     R2,R                 r=t(1)
         ST     R2,S                 s=t(1)
         B      EIF1               else
SIF1     L      R2,N                 n
         BCTR   R2,0                 n-1
         ST     R2,Q                 q(0)=n-1
         ST     R2,NM1               nm1=n-1
         LA     R0,1                 1
         ST     R0,SGN               sgn=1
         SR     R0,R0                0
         ST     R0,R                 r=0
         ST     R0,S                 s=0
         LA     R6,1                 k=1
LOOPK    C      R6,N                 do k=1 to n
         BH     ELOOPK               leave k
         SR     R0,R0                  0
         ST     R0,JQ                  jq=0
         ST     R0,KTI                 kti=0
         LA     R7,1                   iq=1
LOOPIQ   C      R7,NM1                 do iq=1 to n-1
         BH     ELOOPIQ                leave iq
         LR     R2,R7                    iq
         LA     R2,1(R2)                 iq+1
         ST     R2,IT                    it=iq+1
         L      R2,KTI                   kti
         A      R2,N                     kti+n
         ST     R2,KTI                   kti=kti+n
         ST     R2,KT                    kt=kti
         LA     R8,1                     jt=1
LOOPJT   C      R8,N                     do jt=1 to n
         BH     ELOOPJT                  leave jt
         L      R2,KT                      kt
         LA     R2,1(R2)                   kt+1
         ST     R2,KT                      kt=kt+1
IF2      CR     R8,R6                      if jt<>k
         BE     EIF2                       then
         L      R2,JQ                        jq
         LA     R2,1(R2)                     jq+1
         ST     R2,JQ                        jq=jq+1
         L      R1,KT                        kt
         SLA    R1,2                         *4
         L      R2,0(R1,R9)                  t(kt)
         L      R1,JQ                        jq
         SLA    R1,2                         *4
         ST     R2,Q(R1)                     q(jq)=t(kt)
EIF2     EQU    *                          end if
         LA     R8,1(R8)                   jt=jt+1
         B      LOOPJT                   next jt
ELOOPJT  LA     R7,1(R7)                 iq=iq+1
         B      LOOPIQ                 next iq
ELOOPIQ  LR     R1,R6                  k
         SLA    R1,2                   *4
         L      R5,0(R1,R9)            t(k)
         LR     R2,R5                  R2,R5=t(k)
         LA     R1,Q                   @q
         BAL    R14,DETER              call deter(q)
         LR     R3,R0                  R3=deter(q)
         ST     R1,P                   p=perm(q)
         MR     R4,R3                  R5=t(k)*deter(q)
         M      R4,SGN                 R5=sgn*t(k)*deter(q)
         A      R5,R                   +r
         ST     R5,R                   r=r+sgn*t(k)*deter(q)
         LR     R5,R2                  t(k)
         M      R4,P                   R5=t(k)*perm(q)
         A      R5,S                   +s
         ST     R5,S                   s=s+t(k)*perm(q)
         L      R2,SGN                 sgn
         LCR    R2,R2                  -sgn
         ST     R2,SGN                 sgn=-sgn
         LA     R6,1(R6)               k=k+1
         B      LOOPK                next k
ELOOPK   EQU    *                    end do
EIF1     EQU    *                  end if 
EXIT     L      R13,SAVEAREB+4     restore caller's savearea address
         L      R2,R               return value (determinant)
         L      R3,S               return value (permanent)
         XR     R15,R15            set return code to 0        
         FREEMAIN A=(R10),LV=(R11) free allocated storage
         LR     R0,R2              first return value
         LR     R1,R3              second return value
         L      R14,12(R13)        restore caller's return address
         LM     R2,R12,28(R13)     restore registers R2 to R12
         BR     R14                return to caller
IT       DS     F                  static area (out of stack)
KT       DS     F                  "
JQ       DS     F                  "
KTI      DS     F                  "
P        DS     F                  "
         DROP   R12                base no longer needed
STACK    DSECT                     dynamic area (stack)
SAVEAREB DS     18F                function savearea
N        DS     F                  n
NM1      DS     F                  n-1
R        DS     F                  determinant accu
S        DS     F                  permanent accu
SGN      DS     F                  sign
STACKLEN EQU    *-STACK
Q        DS     F                  sub matrix q((n-1)*(n-1)+1)
         YREGS  
         END    MATARI