diff --git a/arrays.lisp b/arrays.lisp index 76c18791ad5f416acafb9a119b401329b9dbf78e..1f30150757692d480e267e11ad67f23cbf731141 100644 --- a/arrays.lisp +++ b/arrays.lisp @@ -16,3 +16,14 @@ arguments." (setf (row-major-aref new-array i) (row-major-aref array i))) new-array)) + +(declaim (inline displace-array)) +(defun displace-array (array &key (offset 0) + (dimensions (- (array-total-size array) + offset))) + "Return an array displaced to ARRAY with the given OFFSET and DIMENSIONS. +Default arguments displace to a vector." + (make-array dimensions + :displaced-to array + :displaced-index-offset offset + :element-type (array-element-type array))) diff --git a/numbers.lisp b/numbers.lisp index 03430cc2eec9e103bbf159435b75a20aaf1673b9..7340f26caecc302e50ed52d1409ac55806fbb4a5 100644 --- a/numbers.lisp +++ b/numbers.lisp @@ -84,21 +84,58 @@ Examples: interpolation coefficient V." (+ a (* v (- b a)))) -(declaim (inline mean)) -(defun mean (sample) - "Returns the mean of SAMPLE. SAMPLE must be a sequence of numbers." - (/ (reduce #'+ sample) (length sample))) - -(declaim (inline median)) -(defun median (sample) - "Returns median of SAMPLE. SAMPLE must be a sequence of real numbers." - (let* ((vector (sort (copy-sequence 'vector sample) #'<)) +(defgeneric mean (object) + (:documentation "Returns the mean of OBJECT. +Predefined methods work on sequences and arrays of numbers. Users can +define new methods.") + (:method ((object list)) + (let ((sum 0) + (count 0)) + (declare (fixnum count)) + (dolist (elt object) + (incf sum elt) + (incf count)) + (/ sum count))) + (:method ((object vector)) + ;; Need a separate method for vectors, since + ;; they could have fill-pointers which we need to respect. + (let ((n (length object))) + (/ (loop for index below n + summing (aref object index)) + n))) + (:method ((object array)) + (let ((n (array-total-size object))) + (/ (loop for index below n + summing (row-major-aref object index)) + n))) + (:method ((object sequence)) + ;; For implementations supporting custom sequence types. + (/ (reduce #'+ object) (length object)))) + +(defun median-in-place (vector) + (declare (vector vector)) + (let* ((vector (sort vector #'<)) (length (length vector)) (middle (truncate length 2))) (if (oddp length) (aref vector middle) (/ (+ (aref vector middle) (aref vector (1- middle))) 2)))) +(defgeneric median (object) + (:documentation + "Returns median of OBJECT. +Predefined methods work on sequences and arrays of numbers. Users can +define new methods.") + (:method ((object list)) + (median-in-place (copy-sequence 'vector object))) + (:method ((object array)) + (median-in-place (copy-sequence 'vector (if (vectorp object) + object + (displace-array object))))) + (:method ((object sequence)) + ;; For implementations supporting custom sequence types. + (median-in-place (copy-sequence 'vector object)))) + (declaim (inline variance)) (defun variance (sample &key (biased t)) "Variance of SAMPLE. Returns the biased variance if BIASED is true (the default), diff --git a/package.lisp b/package.lisp index 673ed30ac89146b8595568c397ac2cce29c89d6a..8bdf06058771ce9d73f161e119a57cd70921e33d 100644 --- a/package.lisp +++ b/package.lisp @@ -101,6 +101,7 @@ #:array-index #:array-length #:copy-array + #:displace-array ;; Sequences #:copy-sequence #:deletef diff --git a/tests.lisp b/tests.lisp index bd2725ffac0b8528efc13e28db5ed23a42be184c..7d7d1cabb54c393b5f966fc22e26a9193fc26cbc 100644 --- a/tests.lisp +++ b/tests.lisp @@ -47,6 +47,24 @@ (typep copy 'simple-array))) t) +(deftest displace-array.1 + (displace-array #2A((1 2) + (3 4))) + #(1 2 3 4)) + +(deftest displace-array.2 + (displace-array #2A((1 2) + (3 4)) + :offset 1) + #(2 3 4)) + +(deftest displace-array.3 + (displace-array #2A((1 2) + (3 4)) + :offset 1 + :dimensions '(3 1)) + #2A((2) (3) (4))) + (deftest array-index.1 (typep 0 'array-index) t) @@ -958,6 +976,12 @@ (mean '(1 2 10)) 13/3) +(deftest mean.4 + (mean #2A((1 2 3) + (4 5 6) + (7 8 9))) + 5) + (deftest median.1 (median '(100 0 99 1 98 2 97)) 97) @@ -966,6 +990,11 @@ (median '(100 0 99 1 98 2 97 96)) 193/2) +(deftest median.3 + (median #2A((100 0 99 1) + (98 2 97 96))) + 193/2) + (deftest variance.1 (variance (list 1 2 3)) 2/3)