[r2]: trunk / rdet.fs History

Child: [r3] (diff)

Download this file

rdet.fs    57 lines (48 with data), 1.1 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
\ Matrix Determinant
\
\ Copyright (C) 2011 David Khling <dvdkhlng TA gmx TOD de>
\
\ License: GPL3 or later, NO WARRANTY
\
\ Created: Aug 2011
require ./imatrix.fs
require ./mod.fs
\ todo: factor similar to SNF.
: }}rdet { n M{{ -- result }
\ note: destroys the contents of M{{ during computation
1 { result }
n 0 ?DO
\ search pivot (i.e. swap rows to ensure m(i,i)>0)
n I ?DO
M{{ I J }} @ IF
I J <> IF
M{{ I 0 }} M{{ J 0 }} n iexchange
result rnegate TO result
THEN
LEAVE
THEN
LOOP
\ read pivot, adjust result, precompute inverse
M{{ I I }} @ dup result r* TO result ( s: pivot)
dup 0= IF \ zero pivot
UNLOOP EXIT \ -> abort with determinant zero
THEN
rinv { p^-1 }
\ zero columns I in rows below
n I 1+ ?DO
M{{ I J }} @ ?dup IF
p^-1 r*
n J ?DO
DUP M{{ K I }} @ r* M{{ J I }} r-!
LOOP
drop
THEN
LOOP
LOOP
result ;
\ Customize Emacs
0 [IF]
Local Variables:
compile-command: "gforth rdet-test.fs -e bye"
End:
[THEN]