>From fd2f3bbc553a5282e3341fcb12bd1abd1019e421 Mon Sep 17 00:00:00 2001
From: tpapp <tkpapp@gmail.com>
Date: Wed, 4 Jan 2012 12:28:39 +0100
Subject: [PATCH] Made MEAN and MEDIAN generic, added DISPLACE-ARRAY.

Objects other than sequences have means and medians (eg probability
distributions, arrays, sequences/arrays wrapped in another object, etc), so it
makes sense to make these functions generic.

DISPLACE-ARRAY is a small utility function that is used in the implementation
of MEDIAN for arrays, but is also of general utility because it makes the
creation of displaced arrays simpler, dispensing with the need to specify the
element type, and offering sensible defaults when one wants vectors.

Also added tests for all the new functions/methods.
---
 arrays.lisp  |   10 ++++++++++
 numbers.lisp |   31 +++++++++++++++++++++++++------
 package.lisp |    1 +
 tests.lisp   |   29 +++++++++++++++++++++++++++++
 4 files changed, 65 insertions(+), 6 deletions(-)

diff --git a/arrays.lisp b/arrays.lisp
index 76c1879..4953ecd 100644
--- a/arrays.lisp
+++ b/arrays.lisp
@@ -16,3 +16,13 @@ arguments."
      (setf (row-major-aref new-array i)
            (row-major-aref array i)))
    new-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 03430cc..79e99fe 100644
--- a/numbers.lisp
+++ b/numbers.lisp
@@ -85,20 +85,39 @@ 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)))
+(defgeneric mean (object)
+  (:documentation "Returns the mean of OBJECT (eg a sequence or array of
+numbers).")
+  (:method ((object list))
+    (/ (reduce #'+ object) (length object)))
+  (:method ((object array))
+    (let ((n (array-total-size object)))
+      (/ (loop for index below n
+               summing (row-major-aref object index))
+         n))))
 
 (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) #'<))
+
+(defun median-in-place (vector)
+  "Return the median of VECTOR, sorting elements in place."
+  (check-type 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 (eg a sequence or array of
+numbers).")
+  (: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))))))
+
 (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 673ed30..8bdf060 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 babe0f4..0d35f19 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)
-- 
1.7.7.3