Skip to content

Commit feecb90

Browse files
WombleWomble
committed
implemented matrices as tables
1 parent 0a48a20 commit feecb90

2 files changed

Lines changed: 78 additions & 32 deletions

File tree

‎extras/arc.el‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -408,7 +408,7 @@ rigidly along with this one."
408408
;; like def if the first form is placed on the next line, otherwise
409409
;; it is indented like any other form (i.e. forms line up under first).
410410

411-
;(eval-when-compile (require 'cl-macs))
411+
(eval-when-compile (require 'cl-macs))
412412

413413
(let ((arc-indent-function-list
414414
;; format is ((LEVEL . SYMS) ...)

‎lib/math.arc‎

Lines changed: 77 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,12 @@
1919
(def ones dims
2020
(init-matrix dims 1))
2121

22+
(mac elt (mat pos)
23+
"access the element of the matix given by co-ords listed in pos"
24+
(if (cdr pos)
25+
`(elt (,mat ,(last pos)) ,(butlast pos))
26+
`(,mat ,(car pos))))
27+
2228
(def mat-to-table (mat)
2329
"coerces a list-of-lists representation of a matrix into a hash table one where the key is a list of indices (0 referenced)"
2430
(let ans (table)
@@ -31,15 +37,27 @@
3137
(rec mat (list)))
3238
ans))
3339

34-
35-
(mac elt (mat pos)
36-
"access the element of the matix given by co-ords listed in pos"
37-
(if (cdr pos)
38-
`(elt (,mat ,(car pos)) ,(cdr pos))
39-
`(,mat ,(car pos))))
40+
(def table-to-mat (tab)
41+
"coerces a table representation of a matrix into a list-of-lists one"
42+
(let key-val-lis (list)
43+
(maptable (fn (key val) (push (cons key val) key-val-lis)) tab)
44+
(let rec (afn (lis)
45+
(if (is (len caar.lis) 1) (map cdr (sort (fn (x y) (< caar.x caar.y)) lis)) ;if there is only one index sort by it
46+
(map (fn (tp) (self:map [cons (butlast car._) cdr._] tp)) ;
47+
(tuples (sort (fn (x y) (< (last car.x) (last car.y))) lis) ; if there is more than one index: collect into tuples of the rightmost index and list the answers of rec on each tuple
48+
(len:keep [is (last car._) 0] lis))))) ;
49+
50+
(rec key-val-lis))))
51+
52+
(def ident-matrix (rank size (o table? nil))
53+
(let M (mat-to-table (zeros (n-of rank size)))
54+
(for i 0 (- size 1)
55+
(= (M (n-of size i)) 1))
56+
(if table? M
57+
(table-to-mat M))))
4058

4159
(def matrix-multiply (a b)
42-
"multiplies the matrix a by the matrix b (N.B. Rank one row vectors need to be in the form ((a b c d ...)) /NOT/ (a b c d), i.e. initiated with dims=(1 n) not (n))"
60+
"multiplies the matrix a by the matrix b (N.B. Rank one row vectors need to be in the form ((a b c d ...)) /NOT/ (a b c d), i.e. initiated with dims=(1 n) not (n))"
4361
(with (col (fn (mat i) (map [_ i] mat))
4462
result-matrix (list))
4563
(for rw 0 (- len.a 1)
@@ -60,30 +78,58 @@ mat_n0*x_0 + mat_n1*x_1 ... mat_nn*x_n = rhs_n
6078

6179
using gaussian elimination and returns a list of x's (N.B. not efficient for large sparce matrices)"
6280
(zap flat rhs)
63-
(withs (N (if (no (is len.mat (len car.mat))) (err "mat must be a square matrix, use co-effs of 0 for equations which dont have a certain variable in them")
64-
len.mat)
65-
tmp (list)
66-
MAX 0
67-
i 0 j 0 k 0
68-
X (zeros N))
69-
(for i 0 (- N 1) (push (join mat.i (cons rhs.i ())) tmp))
70-
(let M rev.tmp
71-
;elimination step
72-
(loop (= i 0) (<= i (- N 1)) (++ i)
73-
(= MAX i)
74-
(loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
75-
(if (> (abs:elt M (j i)) (abs:elt M (MAX i))) (= MAX j)))
76-
(if (isnt MAX i) (swap M.i M.MAX))
77-
(loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
78-
(loop (= k N) (>= k i) (-- k)
79-
(-- (elt M (j k)) (/ (* (elt M (i k)) (elt M (j i))) (elt M (i i))))))) ;;end of elimination step
80-
;;substitution
81-
(loop (= j (- N 1)) (>= j 0) (-- j)
82-
(= tmp 0.0)
83-
(loop (= k (+ j 1)) (<= k(- N 1)) (++ k) (++ tmp (* (elt M (j k)) X.k)))
84-
(= X.j (/ (- (elt M (j N)) tmp) (elt M (j j))))))
85-
X))
86-
81+
(if (acons mat)
82+
(withs (N (if (no (is len.mat (len car.mat))) (err "mat must be a square matrix, use co-effs of 0 for equations which dont have a certain variable in them")
83+
len.mat)
84+
tmp (list)
85+
MAX 0
86+
i 0 j 0 k 0
87+
X (zeros N))
88+
(for i 0 (- N 1) (push (join mat.i (cons rhs.i ())) tmp))
89+
(let M rev.tmp
90+
;;elimination step
91+
(loop (= i 0) (<= i (- N 1)) (++ i)
92+
(= MAX i)
93+
(loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
94+
(if (> (abs:elt M (i j)) (abs:elt M (i MAX))) (= MAX j)))
95+
(if (isnt MAX i) (swap M.i M.MAX))
96+
(loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
97+
(loop (= k N) (>= k i) (-- k)
98+
(-- (elt M (k j)) (/ (* (elt M (k i)) (elt M (i j))) (elt M (i i))))))) ;;end of elimination step
99+
;;substitution
100+
(loop (= j (- N 1)) (>= j 0) (-- j)
101+
(= tmp 0.0)
102+
(loop (= k (+ j 1)) (<= k(- N 1)) (++ k) (++ tmp (* (elt M (k j)) X.k)))
103+
(= X.j (/ (- (elt M (N j)) tmp) (elt M (j j))))))
104+
X)
105+
(do (zap table-to-mat mat)
106+
(withs (N (if (no (is len.mat (len car.mat))) (err "mat must be a square matrix, use co-effs of 0 for equations which dont have a certain variable in them")
107+
len.mat)
108+
tmp (list)
109+
MAX 0
110+
i 0 j 0 k 0
111+
X (zeros N))
112+
(for i 0 (- N 1) (push (join mat.i (cons rhs.i ())) tmp))
113+
(let M (mat-to-table rev.tmp)
114+
;;elimination step
115+
(loop (= i 0) (<= i (- N 1)) (++ i)
116+
(= MAX i)
117+
(loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
118+
(if (> (abs:M (list i j)) (abs:M (list i MAX))) (= MAX j)))
119+
(if (isnt MAX i) (let temp ()
120+
(for a 0 N
121+
(= temp (M (list a i)))
122+
(= (M (list a i)) (M (list a MAX)))
123+
(= (M (list a MAX)) temp))))
124+
(loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
125+
(loop (= k N) (>= k i) (-- k)
126+
(-- (M (list k j)) (/ (* (M (list k i)) (M (list i j))) (M (list i i))))))) ;;end of elimination step
127+
;;substitution
128+
(loop (= j (- N 1)) (>= j 0) (-- j)
129+
(= tmp 0.0)
130+
(loop (= k (+ j 1)) (<= k(- N 1)) (++ k) (++ tmp (* (M (list k j)) X.k)))
131+
(= X.j (/ (- (M (list N j)) tmp) (M (list j j))))))
132+
X))))
87133

88134
;calculus fns
89135

0 commit comments

Comments
 (0)