2 (defun over-cat (&rest args
)
5 (reduce #'cat2 args
:from-end t
)
7 (throw 'over-ex
"Can't cat nothing.")))
9 (defun over-vcat (&rest args
)
12 (reduce #'vcat2 args
:from-end t
)
14 (throw 'over-ex
"Can't vcat nothing.")))
16 (defmethod cat2 ((u list
) v
)
17 (cat2 (tuple-list u
) v
))
19 (defmethod cat2 (u (v list
))
20 (cat2 u
(tuple-list v
)))
22 (defmethod vcat2 ((u list
) v
)
23 (vcat2 (tuple-list u
) v
))
25 (defmethod vcat2 (u (v list
))
26 (vcat2 u
(tuple-list v
)))
39 (arem (gensym)) (brem (gensym))
43 (,arem
,s-arows
(cdr ,arem
))
44 (,brem
,s-brows
(cdr ,brem
))
45 (,finished nil
(not (and ,arem
,brem
))))
50 (let* (,@(when s-bwidth
`((,width
,s-bwidth
)))
52 (mapcar #'(lambda (,arow
) ,s-cat
) ,arem
))
54 (let* (,@(when s-awidth
`((,width
,s-awidth
)))
56 (mapcar #'(lambda (,brow
) ,s-cat
) ,brem
)))))
58 (let ((,arow
(car ,arem
))
60 (setq ,row
,s-cat
)))))
63 (defmethod cat2 ((a number
) (b number
))
64 (make-mtrix :dimdom
2 :dimcodom
1
65 :elems
(list (list a b
))))
67 (defmethod vcat2 ((a number
) (b number
))
68 (make-tuple :dim
2 :elems
(list a b
)))
70 (defmethod cat2 ((k number
) (u tuple
))
71 (make-mtrix :dimdom
2 :dimcodom
(tuple-dim u
)
72 :elems
(mapcar #'(lambda (x) (list k x
))
75 (defmethod cat2 ((u tuple
) (k number
))
76 (make-mtrix :dimdom
2 :dimcodom
(tuple-dim u
)
77 :elems
(mapcar #'(lambda (x) (list x k
))
80 (defmethod vcat2 ((k number
) (u tuple
))
81 (make-tuple :dim
(1+ (tuple-dim u
))
82 :elems
(cons k
(tuple-elems u
))))
84 (defmethod vcat2 ((u tuple
) (k number
))
85 (make-tuple :dim
(1+ (tuple-dim u
))
86 :elems
`(,@(tuple-elems u
) ,k
)))
88 ;V Align two tuples into a column matrix.V
89 (defmethod cat2 ((u tuple
) (v tuple
))
91 ((uelem (tuple-elems u
))
92 (velem (tuple-elems v
))
97 :dimcodom
(max (tuple-dim u
)
101 ;V Merge two tuples together into one long vector.V
102 (defmethod vcat2 ((u tuple
) (v tuple
))
103 (make-tuple :dim
(+ (tuple-dim u
) (tuple-dim v
))
104 :elems
(append (tuple-elems u
)
107 ;V Add a column vector /u/ to V
108 ;V the left side of matrix /a/.V
109 (defmethod cat2 ((u tuple
) (a mtrix
))
111 ((uelem (tuple-elems u
))
112 (arow (mtrix-elems a
))
118 (make-list width
:initial-element
0)))
119 (make-mtrix :dimdom
(1+ (mtrix-dimdom a
))
120 :dimcodom
(max (tuple-dim u
)
124 (defmethod cat2 ((a mtrix
) (u tuple
))
126 ((arow (mtrix-elems a
))
127 (uelem (tuple-elems u
))
132 (make-list width
:initial-element
0))
134 (make-mtrix :dimdom
(1+ (mtrix-dimdom a
))
135 :dimcodom
(mtrix-dimcodom a
)
138 (defmethod cat2 ((a mtrix
) (b mtrix
))
140 ((arow (mtrix-elems a
))
141 (brow (mtrix-elems b
))
146 (make-list width
:initial-element
0))
148 (make-list width
:initial-element
0)))
149 (make-mtrix :dimdom
(+ (mtrix-dimdom a
)
151 :dimcodom
(max (mtrix-dimcodom a
)
155 (defmethod vcat2 ((u tuple
) (a mtrix
))
156 (let ((uwid (tuple-dim u
))
157 (awid (mtrix-dimdom a
))
158 (rows (cons (tuple-elems u
)
164 (make-list (- awid uwid
)
165 :initial-element
0)))
166 (unless (= uwid awid
)
167 (shiftf awid uwid
(- uwid awid
))
174 (make-list uwid
:initial-element
0)))
176 (make-mtrix :dimdom awid
177 :dimcodom
(1+ (mtrix-dimcodom a
))
180 (defmethod vcat2 ((a mtrix
) (u tuple
))
181 (let ((awid (mtrix-dimdom a
))
182 (uwid (tuple-dim u
)))
184 :dimcodom
(1+ (mtrix-dimcodom a
))
188 ,(append (tuple-elems u
)
189 (make-list (- awid uwid
)
190 :initial-element
0)))
192 `(,@(mtrix-elems a
) ,(tuple-elems u
))
194 (shiftf awid uwid
(- uwid awid
))
197 (arem (mtrix-elems a
) (cdr arem
)))
199 (rplacd tail
(cons (tuple-elems u
) nil
))
205 uwid
:initial-element
0)))))))
208 ;V Join a column of /k/'s onto the left of /a/.V
209 (defmethod cat2 ((k number
) (a mtrix
))
211 :dimdom
(1+ (mtrix-dimdom a
))
212 :dimcodom
(mtrix-dimcodom a
)
213 :elems
(mapcar #'(lambda (row) (cons k row
))
216 ;V Join a column of /k/'s onto the right of /a/.V
217 (defmethod cat2 ((a mtrix
) (k number
))
219 :dimdom
(1+ (mtrix-dimdom a
))
220 :dimcodom
(mtrix-dimcodom a
)
221 :elems
(mapcar #'(lambda (row) `(,@row
,k
))
224 ;V Join a row of /k/'s onto the top of /a/.V
225 (defmethod vcat2 ((k number
) (a mtrix
))
227 :dimdom
(mtrix-dimdom a
)
228 :dimcodom
(1+ (mtrix-dimcodom a
))
229 :elems
(cons (make-list (mtrix-dimdom a
)
233 ;V Join a row of /k/'s onto the bottom of /a/.V
234 (defmethod vcat2 ((a mtrix
) (k number
))
236 :dimdom
(mtrix-dimdom a
)
237 :dimcodom
(1+ (mtrix-dimcodom a
))
238 :elems
`(,@(mtrix-elems a
)
239 ,(make-list (mtrix-dimdom a
)
240 :initial-element k
))))
242 (defmethod vcat2 ((a mtrix
) (b mtrix
))
243 (let* ((awid (mtrix-dimdom a
))
244 (bwid (mtrix-dimdom b
))
245 (finwid (max awid bwid
))
246 (zeros (make-list (abs (- awid bwid
))
247 :initial-element
0)))
250 :dimcodom
(+ (mtrix-dimcodom a
)
253 (if (= awid finwid
) (mtrix-elems a
)
254 (mapcar #'(lambda (row)
257 (if (= bwid finwid
) (mtrix-elems b
)
258 (mapcar #'(lambda (row)
260 (mtrix-elems b
)))))))