blob: 55b20e4b0c9fc489d117b7a354ba1d53eb0e5dfc (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(in-package :senzill.pair)
;;; Arithmetic operations
(defun pair-op (op p1 p2)
"Componentwise operation over arguments of both pairs"
(cons (apply op (list (car p1) (car p2)))
(apply op (list (cdr p1) (cdr p2)))))
(defun pair+ (p1 p2)
(pair-op #'+ p1 p2))
(defun pair- (p1 p2)
(pair-op #'- p1 p2))
(defun pair-scalar-pref-op (op scalar p)
"Operation with scalar over both components of pair. Scalar precedes pair."
(cons (apply op (list scalar (car p)))
(apply op (list scalar (cdr p)))))
(defun +pair (scalar p)
(pair-scalar-pref-op #'+ scalar p))
(defun *pair (scalar p)
(pair-scalar-pref-op #'* scalar p))
(defun pair-scalar-post-op (op scalar p)
"Operation with scalar over both components of pair. Scalar succeeds pair."
(cons (apply op (list (car p) scalar))
(apply op (list (cdr p) scalar))))
(defun -pair (p scalar)
(pair-scalar-post-op #'- scalar p))
(defun /pair (p scalar)
(pair-scalar-post-op #'/ scalar p))
(defun pair-round (p)
(cons (round (car p)) (round (cdr p))))
;;; Assignment macros
(defmacro pair+= (p1 p2)
`(setf ,p1 (pair+ ,p1 ,p2)))
;;; Comparison
(defun pair= (p1 p2 &key (compare-function #'=))
(and (apply pompare-function (list (car p1) (car p2)))
(apply pompare-function (list (cdr p1) (cdr p2)))))
;;; Binary vector operations
(defun norm (p)
"Eucledian norm of pair"
(sqrt (+ (* (car p) (car p)) (* (cdr p) (cdr p)))))
(defun dist-resize (p len)
(*pair (/ len (norm p)) p))
(defun dist-resize-by (p len)
(let* ((c-len (norm p))
(w-len (+ p-len len)))
(*pair (/ w-len p-len) p)))
|
