4a035356816e3658b8ab0890d5fdbc13668d27ab
2 (in-package :lineal.overload
)
4 (defmethod over-crop ((n integer
) (u tuple
))
5 (declare (ignore n
)) u
)
6 (defmethod over-crop ((u tuple
) (n integer
))
7 (declare (ignore n
)) u
)
9 (defmethod over-vcrop ((n integer
) (u tuple
))
12 (loop :with dim
= (min n
(tuple-dim u
))
13 :for elem
:in
(tuple-elems u
)
15 :collect elem
:into elems
17 (return (make-tuple :dim dim
:elems elems
)))))
19 (defmethod over-vcrop ((u tuple
) (n integer
))
21 (car (last (tuple-elems u
)))
22 (let ((dim (min n
(tuple-dim u
))))
24 :elems
(nthcdr (- (tuple-dim u
) dim
)
27 (defmethod over-crop ((n integer
) (a mtrix
))
30 :dim
(mtrix-dimcodom a
)
31 :elems
(mapcar #'car
(mtrix-elems a
)))
33 :with width
= (min n
(mtrix-dimdom a
))
34 :for row
:in
(mtrix-elems a
)
35 :collect
(loop :for elem
:in row
42 :dimcodom
(mtrix-dimcodom a
)
45 (defmethod over-crop ((a mtrix
) (n integer
))
48 :dim
(mtrix-dimcodom a
)
49 :elems
(mapcar (lambda (row) (car (last row
)))
52 :with width
= (min n
(mtrix-dimdom a
))
53 :with prune-count
= (- (mtrix-dimdom a
) width
)
54 :for row
:in
(mtrix-elems a
)
55 :collect
(nthcdr prune-count row
) :into rows
59 :dimcodom
(mtrix-dimcodom a
)
62 (defmethod over-vcrop ((n integer
) (a mtrix
))
63 (let ((height (min n
(mtrix-dimcodom a
))))
65 :dimdom
(mtrix-dimdom a
)
67 :elems
(loop :for row
:in
(mtrix-elems a
)
71 (defmethod over-vcrop ((a mtrix
) (n integer
))
72 (let ((height (min n
(mtrix-dimcodom a
))))
74 :dimdom
(mtrix-dimdom a
)
76 :elems
(nthcdr (- (mtrix-dimcodom a
) height
)
79 (defmethod over-crop :around
((a integer
) b
)
80 (if (plusp a
) (call-next-method a b
)
81 (throw 'over-ex
"Can only crop a positive number of columns.")))
82 (defmethod over-crop :around
(a (b integer
))
83 (if (plusp b
) (call-next-method a b
)
84 (throw 'over-ex
"Can only crop a positive number of columns.")))
86 (defmethod over-vcrop :around
((a integer
) b
)
87 (if (plusp a
) (call-next-method a b
)
88 (throw 'over-ex
"Can only vcrop a positive number of rows.")))
89 (defmethod over-vcrop :around
(a (b integer
))
90 (if (plusp b
) (call-next-method a b
)
91 (throw 'over-ex
"Can only vcrop a positive number of rows.")))
93 (defmethod over-crop (a b
)
95 (format nil
"crop usage: (crop [n] [thing]) ~
96 or (crop [thing] [n])~%where [n] is ~
97 the number of columns you want.")))
99 (defmethod over-vcrop (a b
)
101 (format nil
"vcrop usage: (vcrop [n] [thing]) ~
102 or (vcrop [thing] [n])~%where [n] is ~
103 the number of rows you want.")))