2 (defun over-cat (&rest args
)
5 (throw 'over-ex
"Can't cat nothing.")))
7 (defun over-vcat (&rest args
)
10 (throw 'over-ex
"Can't vcat nothing.")))
23 (arem (gensym)) (brem (gensym))
27 (,arem
,s-arows
(cdr ,arem
))
28 (,brem
,s-brows
(cdr ,brem
))
29 (,finished nil
(not (and ,arem
,brem
))))
34 (let* (,@(when s-bwidth
`((,width
,s-bwidth
)))
36 (mapcar #'(lambda (,arow
) ,s-cat
) ,arem
))
38 (let* (,@(when s-awidth
`((,width
,s-awidth
)))
40 (mapcar #'(lambda (,brow
) ,s-cat
) ,brem
)))))
42 (let ((,arow
(car ,arem
))
44 (setq ,row
,s-cat
)))))
47 (defmethod cat2 ((a number
) (b number
))
48 (make-mtrix :dimdom
2 :dimcodom
1
49 :elems
(list (list a b
))))
51 (defmethod vcat2 ((a number
) (b number
))
52 (make-tuple :dim
2 :elems
(list a b
)))
54 (defmethod cat2 ((k number
) (u tuple
))
55 (make-mtrix :dimdom
2 :dimcodom
(tuple-dim u
)
56 :elems
(mapcar #'(lambda (x) (list k x
))
59 (defmethod cat2 ((u tuple
) (k number
))
60 (make-mtrix :dimdom
2 :dimcodom
(tuple-dim u
)
61 :elems
(mapcar #'(lambda (x) (list x k
))
64 (defmethod vcat2 ((k number
) (u tuple
))
65 (make-tuple :dim
(1+ (tuple-dim u
))
66 :elems
(cons k
(tuple-elems u
))))
68 (defmethod vcat2 ((u tuple
) (k number
))
69 (make-tuple :dim
(1+ (tuple-dim u
))
70 :elems
`(,@(tuple-elems u
) ,k
)))
72 ;V Align two tuples into a column matrix.V
73 (defmethod cat2 ((u tuple
) (v tuple
))
75 ((uelem (tuple-elems u
))
76 (velem (tuple-elems v
))
81 :dimcodom
(max (tuple-dim u
)
85 ;V Merge two tuples together into one long vector.V
86 (defmethod vcat2 ((u tuple
) (v tuple
))
87 (make-tuple :dim
(+ (tuple-dim u
) (tuple-dim v
))
88 :elems
(append (tuple-elems u
)
91 ;V Add a column vector /u/ to V
92 ;V the left side of matrix /a/.V
93 (defmethod cat2 ((u tuple
) (a mtrix
))
95 ((uelem (tuple-elems u
))
96 (arow (mtrix-elems a
))
102 (make-list width
:initial-element
0)))
103 (make-mtrix :dimdom
(1+ (mtrix-dimdom a
))
104 :dimcodom
(max (tuple-dim u
)
108 (defmethod cat2 ((a mtrix
) (u tuple
))
110 ((arow (mtrix-elems a
))
111 (uelem (tuple-elems u
))
116 (make-list width
:initial-element
0))
118 (make-mtrix :dimdom
(1+ (mtrix-dimdom a
))
119 :dimcodom
(mtrix-dimcodom a
)
122 (defmethod cat2 ((a mtrix
) (b mtrix
))
124 ((arow (mtrix-elems a
))
125 (brow (mtrix-elems b
))
130 (make-list width
:initial-element
0))
132 (make-list width
:initial-element
0)))
133 (make-mtrix :dimdom
(+ (mtrix-dimdom a
)
135 :dimcodom
(max (mtrix-dimcodom a
)
139 (defmethod vcat2 ((u tuple
) (a mtrix
))
140 (let ((uwid (tuple-dim u
))
141 (awid (mtrix-dimdom a
))
142 (rows (cons (tuple-elems u
)
148 (make-list (- awid uwid
)
149 :initial-element
0)))
150 (unless (= uwid awid
)
151 (shiftf awid uwid
(- uwid awid
))
158 (make-list uwid
:initial-element
0)))
160 (make-mtrix :dimdom awid
161 :dimcodom
(1+ (mtrix-dimcodom a
))
164 (defmethod vcat2 ((a mtrix
) (u tuple
))
165 (let ((awid (mtrix-dimdom a
))
166 (uwid (tuple-dim u
)))
168 :dimcodom
(1+ (mtrix-dimcodom a
))
172 ,(append (tuple-elems u
)
173 (make-list (- awid uwid
)
174 :initial-element
0)))
176 `(,@(mtrix-elems a
) ,(tuple-elems u
))
178 (shiftf awid uwid
(- uwid awid
))
181 (arem (mtrix-elems a
) (cdr arem
)))
183 (rplacd tail
(cons (tuple-elems u
) nil
))
189 uwid
:initial-element
0)))))))
192 ;V Join a column of /k/'s onto the left of /a/.V
193 (defmethod cat2 ((k number
) (a mtrix
))
195 :dimdom
(1+ (mtrix-dimdom a
))
196 :dimcodom
(mtrix-dimcodom a
)
197 :elems
(mapcar #'(lambda (row) (cons k row
))
200 ;V Join a column of /k/'s onto the right of /a/.V
201 (defmethod cat2 ((a mtrix
) (k number
))
203 :dimdom
(1+ (mtrix-dimdom a
))
204 :dimcodom
(mtrix-dimcodom a
)
205 :elems
(mapcar #'(lambda (row) `(,@row
,k
))
208 ;V Join a row of /k/'s onto the top of /a/.V
209 (defmethod vcat2 ((k number
) (a mtrix
))
211 :dimdom
(mtrix-dimdom a
)
212 :dimcodom
(1+ (mtrix-dimcodom a
))
213 :elems
(cons (make-list (mtrix-dimdom a
)
217 ;V Join a row of /k/'s onto the bottom of /a/.V
218 (defmethod vcat2 ((a mtrix
) (k number
))
220 :dimdom
(mtrix-dimdom a
)
221 :dimcodom
(1+ (mtrix-dimcodom a
))
222 :elems
`(,@(mtrix-elems a
)
223 ,(make-list (mtrix-dimdom a
)
224 :initial-element k
))))
226 (defmethod vcat2 ((a mtrix
) (b mtrix
))
227 (let* ((awid (mtrix-dimdom a
))
228 (bwid (mtrix-dimdom b
))
229 (finwid (max awid bwid
))
230 (zeros (make-list (abs (- awid bwid
))
231 :initial-element
0)))
234 :dimcodom
(+ (mtrix-dimcodom a
)
237 (if (= awid finwid
) (mtrix-elems a
)
238 (mapcar #'(lambda (row)
241 (if (= bwid finwid
) (mtrix-elems b
)
242 (mapcar #'(lambda (row)
244 (mtrix-elems b
)))))))