racket · Metaxal · Mar 21, 2020 · Mar 22, 2020 · Apr 4, 2020 · Apr 4, 2020
diff --git a/pkgs/racket-doc/scribblings/reference/pairs.scrbl b/pkgs/racket-doc/scribblings/reference/pairs.scrbl
@@ -1398,6 +1398,56 @@ See also @racket[max].
   (argmax car '((3 pears) (1 banana) (2 apples)))
   (argmax car '((3 pears) (3 oranges)))]}
 
+
+@defproc[(best+key+index [lst (and/c pair? list?)]
+                         [better? (-> any/c any/c any/c)]
+                         [#:key key (-> any/c any/c) values])
+         (values any/c any/c exact-nonnegative-integer?)]{
+Returns the element @racket[x] of @racket[lst], the value @racket[k]=@racket[(key x)]
+and the position of @racket[x] in @racket[lst] such that @racket[k] is the best
+value in @racket[lst] according to @racket[better?]—where @racket[(better? a b)]
+means that @racket[a] is better than @racket[b].
+That is, there is no element following @racket[x] in @racket[lst] such that
+@racket[(better? (key y) (key x))] is true.
+
+Note that this means that if @racket[better?] is @racket[<] for example, then the @emph{first}
+smallest element is returned, but if @racket[better?] is @racket[<=], then the @emph{last} smallest
+element is returned instead.
+
+@mz-examples[#:eval list-eval
+  (best+key+index '(15 30 10 20 10) <)
+  (best+key+index '(15 30 10 20 10) <=)
+  (best+key+index '(15 30 10 20 10) < #:key -)
+  (best+key+index '(15 30 10 20 10) >=)]
+@history[#:added "7.6.0.18"]}
+
+
+@defproc*[([(best [lst (and/c pair? list?)]
+                  [better? (-> any/c any/c any/c)]
+                  [#:key key (-> any/c any/c) values])
+            any/c]
+            [(best-key [lst (and/c pair? list?)]
+                      [better? (-> any/c any/c any/c)]
+                      [#:key key (-> any/c any/c) values])
+             any/c]
+            [(best-index [lst (and/c pair? list?)]
+                        [better? (-> any/c any/c any/c)]
+                        [#:key key (-> any/c any/c) values])
+             exact-nonnegative-integer?])]{
+Like @racket[best+key+index] but return only one value, respectively the
+element @racket[x] of the list @racket[lst], its value @racket[(key x)]
+and its index.
+
+@mz-examples[#:eval list-eval
+  (best       '((3 "pears") (1 "banana") (2 "apples")) string<? #:key second)
+  (best-key   '((3 "pears") (1 "banana") (2 "apples")) string<? #:key second)
+  (best       '((3 "pears") (1 "banana") (2 "apples")) > #:key first)
+  (best-index '((3 "pears") (1 "banana") (2 "apples")) > #:key first)
+  (best '((a . 5) (b . 10) (a . 10)) > #:key cdr)
+  (best '((a . 5) (b . 10) (a . 10)) >= #:key cdr)]
+@history[#:added "7.6.0.18"]}
+
+
 @defproc[(group-by [key (-> any/c any/c)]
                    [lst list?]
                    [same? (any/c any/c . -> . any/c) equal?])

diff --git a/pkgs/racket-test-core/tests/racket/list.rktl b/pkgs/racket-test-core/tests/racket/list.rktl
@@ -192,6 +192,34 @@
   (test '(x x) make-list 2 'x)
   (err/rt-test (make-list -3 'x)))
 
+;; ---------- best+key+index ----------
+
+(let ()
+  (define l '(3 3 1 2 3 6 7 2 1 6 7 2))
+
+  (define (check-best l better? x v i #:key [key values])
+    (test
+     (list x v i)
+     call-with-values
+     (λ () (best+key+index l better? #:key key))
+     list)
+    (test x best l better? #:key key)
+    (test v best-key l better? #:key key)
+    (test i best-index l better? #:key key))
+
+  (check-best l <  1 1 2)
+  (check-best l <= 1 1 8)
+  (check-best l >  1 -1 2 #:key -)
+  (check-best l >= 1 -1 8 #:key -)
+
+  (check-best l >  7 7 6)
+  (check-best l >= 7 7 10)
+  (check-best l <  7 -7 6 #:key -)
+  (check-best l <= 7 -7 10 #:key -)
+
+  (check-best l < 3 0 0 #:key (λ (x) (abs (- x 3))))
+  (check-best l <= 3 0 4 #:key (λ (x) (abs (- x 3)))))
+
 ;; ---------- take/drop/splt-at[-right] ----------
 (let ()
   (define (vals f)

diff --git a/racket/collects/racket/list.rkt b/racket/collects/racket/list.rkt
@@ -54,6 +54,10 @@
          in-combinations
          permutations
          in-permutations
+         best+key+index
+         best
+         best-key
+         best-index
          argmin
          argmax
          group-by
@@ -765,6 +769,47 @@
 (define (argmin f xs) (mk-min < 'argmin f xs))
 (define (argmax f xs) (mk-min > 'argmax f xs))
 
+(define (mk-best+index name xs better? key)
+  (unless (and (procedure? better?) (procedure-arity-includes? better? 2))
+    (raise-argument-error name "(any/c any/c . -> . any/c)" better?))
+  (unless (and (procedure? key)
+               (procedure-arity-includes? key 1))
+    (raise-argument-error name "(any/c . -> . any/c)" 0 key xs))
+  (unless (and (pair? xs) ; not empty
+               (list? xs))
+    (raise-argument-error name "(and/c list? (not/c empty?))" 1 key xs))
+  (define first-x (car xs))
+  (let loop ([best-x first-x]
+             [best-val (key first-x)]
+             [best-idx 0]
+             [xs (cdr xs)]
+             [idx 1])
+    (cond
+      [(null? xs)
+       (values best-x best-val best-idx)]
+      [else
+       (define x (car xs))
+       (define x-val (key x))
+       (if (better? x-val best-val)
+           (loop x      x-val    idx      (cdr xs) (+ idx 1))
+           (loop best-x best-val best-idx (cdr xs) (+ idx 1)))])))
+
+;; Same interface as sort, and generalizes argmin/argmax.
+(define (best+key+index xs better? #:key [key values])
+  (mk-best+index 'best+key+index xs better? key))
+;; The following convenience functions return a single value.
+;; (The 3 functions that return 2-of-3 values will not provided.)
+(define (best xs better? #:key [key values])
+  (let-values ([(best-x best-val best-idx) (mk-best+index 'best xs better? key)])
+    best-x))
+;; `best-key` with `key=values` is just `best`.
+(define (best-key xs better? #:key [key values])
+  (let-values ([(best-x best-val best-idx) (mk-best+index 'best-key xs better? key)])
+    best-val))
+(define (best-index xs better? #:key [key values])
+  (let-values ([(best-x best-val best-idx) (mk-best+index 'best-index xs better? key)])
+    best-idx))
+
 ;; (x -> y) (listof x) [(y y -> bool)] -> (listof (listof x))
 ;; groups together elements that are considered equal
 ;; =? should be reflexive, transitive and commutative