f7091b444c04e59b0109d32bce295a2dcc9e8cd1
2 (defmethod over-crop ((n integer
) (u tuple
))
3 (declare (ignore n
)) u
)
4 (defmethod over-crop ((u tuple
) (n integer
))
5 (declare (ignore n
)) u
)
7 (defmethod over-crop ((u list
) n
)
8 (declare (ignore n
)) u
)
9 (defmethod over-crop (n (u list
))
10 (declare (ignore n
)) u
)
12 (defmethod over-vcrop ((n integer
) (u tuple
))
15 (loop :with dim
= (min n
(tuple-dim u
))
16 :for elem
:in
(tuple-elems u
)
18 :collect elem
:into elems
20 (return (make-tuple :dim dim
:elems elems
)))))
22 (defmethod over-vcrop (n (u list
))
23 (over-vcrop n
(tuple-list u
)))
26 (defmethod over-vcrop ((u tuple
) (n integer
))
28 (car (last (tuple-elems u
)))
29 (let ((dim (min n
(tuple-dim u
))))
31 :elems
(nthcdr (- (tuple-dim u
) dim
)
34 (defmethod over-vcrop ((u list
) n
)
35 (over-vcrop (tuple-list u
) n
))
38 (defmethod over-crop ((n integer
) (a mtrix
))
41 :dim
(mtrix-dimcodom a
)
42 :elems
(mapcar #'car
(mtrix-elems a
)))
44 :with width
= (min n
(mtrix-dimdom a
))
45 :for row
:in
(mtrix-elems a
)
46 :collect
(loop :for elem
:in row
53 :dimcodom
(mtrix-dimcodom a
)
56 (defmethod over-crop ((a mtrix
) (n integer
))
59 :dim
(mtrix-dimcodom a
)
60 :elems
(mapcar (lambda (row) (car (last row
)))
63 :with width
= (min n
(mtrix-dimdom a
))
64 :with prune-count
= (- (mtrix-dimdom a
) width
)
65 :for row
:in
(mtrix-elems a
)
66 :collect
(nthcdr prune-count row
) :into rows
70 :dimcodom
(mtrix-dimcodom a
)
73 (defmethod over-vcrop ((n integer
) (a mtrix
))
74 (let ((height (min n
(mtrix-dimcodom a
))))
76 :dimdom
(mtrix-dimdom a
)
78 :elems
(loop :for row
:in
(mtrix-elems a
)
82 (defmethod over-vcrop ((a mtrix
) (n integer
))
83 (let ((height (min n
(mtrix-dimcodom a
))))
85 :dimdom
(mtrix-dimdom a
)
87 :elems
(nthcdr (- (mtrix-dimcodom a
) height
)
90 (defmethod over-crop :around
((a integer
) b
)
91 (if (plusp a
) (call-next-method a b
)
92 (throw 'over-ex
"Can only crop a positive number of columns.")))
93 (defmethod over-crop :around
(a (b integer
))
94 (if (plusp b
) (call-next-method a b
)
95 (throw 'over-ex
"Can only crop a positive number of columns.")))
97 (defmethod over-vcrop :around
((a integer
) b
)
98 (if (plusp a
) (call-next-method a b
)
99 (throw 'over-ex
"Can only vcrop a positive number of rows.")))
100 (defmethod over-vcrop :around
(a (b integer
))
101 (if (plusp b
) (call-next-method a b
)
102 (throw 'over-ex
"Can only vcrop a positive number of rows.")))
104 (defmethod over-crop (a b
)
106 (format nil
"crop usage: (crop [n] [thing]) ~
107 or (crop [thing] [n])~%where [n] is ~
108 the number of columns you want.")))
110 (defmethod over-vcrop (a b
)
112 (format nil
"vcrop usage: (vcrop [n] [thing]) ~
113 or (vcrop [thing] [n])~%where [n] is ~
114 the number of rows you want.")))