aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/packages.lisp16
-rw-r--r--src/pair.lisp64
2 files changed, 80 insertions, 0 deletions
diff --git a/src/packages.lisp b/src/packages.lisp
index ca6df6b..c13d8df 100644
--- a/src/packages.lisp
+++ b/src/packages.lisp
@@ -21,6 +21,22 @@
:integer-to-list)
(:documentation "List functions"))
+(defpackage senzill.pair
+ (:use cl)
+ (:export :pair+
+ :pair-
+ :+pair
+ :*pair
+ :-pair
+ :/pair
+ :pair+=
+ :pair=
+ :pair-round
+ :norm
+ :dist-resize
+ :dist-resize-by)
+ (:documentation "Dotted pair functions"))
+
(defpackage senzill.io
(:use :cl)
(:export :doread-lines
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)))