From 73da0a88d4f5faa1f369034ae66d1f4cc25af8a7 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Tue, 29 Jun 2021 21:09:41 +0900
Subject: [PATCH] scan for appropriate 2nd element to take the mean with when
 calling vector-find-median on an even length vector (issue #754)

---
 lib/srfi/132/sort.scm | 18 ++++++++++++++----
 lib/srfi/132/test.sld |  2 ++
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/lib/srfi/132/sort.scm b/lib/srfi/132/sort.scm
index 25230620..7844eaa5 100644
--- a/lib/srfi/132/sort.scm
+++ b/lib/srfi/132/sort.scm
@@ -158,6 +158,14 @@
      ((odd? len) (vector-ref vec mid))
      (else (mean (vector-ref vec (- mid 1)) (vector-ref vec mid))))))
 
+(define (vector-max less vec lo hi largest)
+  (cond
+   ((>= lo hi) largest)
+   ((less largest (vector-ref vec lo))
+    (vector-max less vec (+ lo 1) hi (vector-ref vec lo)))
+   (else
+    (vector-max less vec (+ lo 1) hi largest))))
+
 (define (vector-find-median < vec knil . o)
   (let* ((vec (vector-copy vec))
          (len (vector-length vec))
@@ -166,7 +174,9 @@
     (cond
      ((zero? len) knil)
      (else
-      (vector-separate! < vec mid)
-      (cond
-       ((odd? len) (vector-ref vec mid))
-       (else (mean (vector-ref vec (- mid 1)) (vector-ref vec mid))))))))
+      (let ((mid-elt (vector-select! < vec mid)))
+        (cond
+         ((odd? len) mid-elt)
+         (else
+          (mean (vector-max < vec 0 (- mid 1) (vector-ref vec (- mid 1)))
+                mid-elt))))))))
diff --git a/lib/srfi/132/test.sld b/lib/srfi/132/test.sld
index b030d2a5..c3daedca 100644
--- a/lib/srfi/132/test.sld
+++ b/lib/srfi/132/test.sld
@@ -683,4 +683,6 @@
       (test 21
           (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
             (vector-select! < v 3 4 8)))
+      (test 17.0
+          (vector-find-median < '#(18. 11. 20. 15. 16. 9. 24. 15. 21. 20.) 0))
       (test-end))))