[pair] Created pair package and implemented some functionsdev

1 files changed, 64 insertions, 0 deletions

diff --git a/src/pair.lisp b/src/pair.lisp
new file mode 100644
index 0000000..55b20e4
--- /dev/null
+++ b/src/pair.lisp
@@ -0,0 +1,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)))