From 73b23b27998906ec479a995434ca5b664f0c0912 Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Mon, 28 Nov 2022 20:25:09 +0100
Subject: sample: just shuffle if fewer elements are requested than available

---
 mew.scm        | 12 +++++++++---
 mew.svnwiki    |  8 ++++----
 tests/test.mew |  2 ++
 3 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/mew.scm b/mew.scm
index 8507634..7f491b9 100644
--- a/mew.scm
+++ b/mew.scm
@@ -450,8 +450,14 @@
         ((o)
          ((gen-get o) (rand (len o))))
         ((o k)
-         (if (or (<= k 0) (< (len o) k))
-           #()
+         (cond
+          ((= k 0)        (empty o))
+          ((<= (len o) k) (let ((r (into #() o)))
+                            (shuffle! r)
+                            (if (vector? o)
+                              r
+                              (into (empty o) r))))
+          (else
            ;; Algorithm L with additional shuffle at the end.
            ;; https://dl.acm.org/doi/pdf/10.1145/198429.198435
            (let ((geto (gen-get o))
@@ -472,7 +478,7 @@
              (if (vector? o)
                r
                (into (empty o) r)))))
-         )))
+         ))))
 
   (define range
     (case-lambda
diff --git a/mew.svnwiki b/mew.svnwiki
index 60db721..6de85b1 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -541,11 +541,11 @@ Returns a random key/value pair of the hash-table {{<obj>}}.
 
 <procedure>(sample <obj> <N>)</procedure>
 
-Returns a random list/vector/string consisting of {{<N>}} elements of
-the list/vector/string {{<obj>}}, without replacement.
+Returns a random list/vector/string consisting of up to {{<N>}}
+elements of the list/vector/string {{<obj>}}, without replacement.
 
-Returns a random hash-table consisting of {{<N>}} key/value pairs of
-the hash-table {{<obj>}}, without replacement.
+Returns a random hash-table consisting of up to {{<N>}} key/value
+pairs of the hash-table {{<obj>}}, without replacement.
 
 
 == Special syntax
diff --git a/tests/test.mew b/tests/test.mew
index e3a527a..4bcce7f 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -47,6 +47,8 @@
   (test #t ((one-of '(1 . 2) '(3 . 4)) (sample (tbl 1 2 3 4))))
   (test #t (string? (sample "foobar" 3)))
   (test 3 (len (sample "foobar" 3)))
+  (test 2 (len (sample "fb" 3)))
+  (test "" (sample "foobar" 0))
   (test "ooo" (sample "ooooo" 3))
   (test #(1 2 3) (sort (sample #(1 2 3) 3) <)))
 
-- 
cgit 1.4.1