# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1764861330 18000
# Node ID 502c03ce389d63d09d52fc7ed58cb523b2be36c9
# Parent  afc77c6b25b1ebd496c6612d57c250ec9185bd4f
More

diff -r afc77c6b25b1 -r 502c03ce389d lisp/extrema.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/extrema.lisp	Thu Dec 04 10:15:30 2025 -0500
@@ -0,0 +1,131 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload '(:adopt :iterate :losh :alexandria :conserve)
+                :silent t))
+
+(defpackage :extrema
+  (:use :cl :iterate :losh)
+  (:export :toplevel :*ui*))
+
+(in-package :extrema)
+
+
+;;;; Functionality ------------------------------------------------------------
+(defun run (stream field n &key reverse numeric)
+  (iterate
+    (with results = (list))
+    (with predicate = (if numeric
+                        (if reverse
+                          #'>
+                          #'<)
+                        (if reverse
+                          #'string>
+                          #'string<)))
+    (for line :in-stream stream :using #'read-line)
+    (for fields = (conserve:read-row line))
+    (for i :from 0)
+    (when (null fields)
+      (next-iteration))
+    (for val = (parse-integer (nth (1- field) fields)))
+    (for initial = (< i n))
+    (when (or initial
+              (if numeric
+                (if reverse
+                  (funcall predicate val (car (first results)))
+                  (< val (car (first results))))
+                (if reverse
+                  (string> val (car (first results)))
+                  (string< val (car (first results))))))
+      (setf results (merge 'list
+                           (list (cons val line))
+                           (if initial results (rest results))
+                           #'<
+                           :key #'car)))
+    (finally (map nil (lambda (r) (write-line (cdr r)))
+                  (nreverse results)))))
+
+
+;;;; User Interface -----------------------------------------------------------
+(defparameter *examples*
+  '(("Do the equivalent of `sort -nr -k 4 | head -n 100`:" .
+     "extrema -nr -k 4 -l 100")))
+
+
+(defparameter *option/help*
+  (adopt:make-option 'help
+    :help "Display help and exit."
+    :long "help"
+    :short #\h
+    :reduce (constantly t)))
+
+(defparameter *o/field*
+  (adopt:make-option 'field
+    :result-key 'field
+    :long "key"
+    :short #\k
+    :parameter "FIELD"
+    :help "Key (1-indexed) to compare (default 1)."
+    :initial-value 1
+    :key #'parse-integer
+    :reduce #'adopt:last))
+
+(defparameter *o/lines*
+  (adopt:make-option 'n
+    :result-key 'n
+    :short #\l
+    :long "lines"
+    :parameter "N"
+    :help "Collect the top N results (default 10)."
+    :initial-value 10
+    :key #'parse-integer
+    :reduce #'adopt:last))
+
+(adopt:defparameters (*o/numeric* *o/no-numeric*)
+  (adopt:make-boolean-options 'numeric
+    :result-key 'numeric
+    :short #\n
+    :long "numeric"
+    :help "Parse keys as integers for comparison."
+    :help-no "Compare keys lexicographically (the default)."))
+
+(adopt:defparameters (*o/reverse* *o/no-reverse*)
+  (adopt:make-boolean-options 'reverse
+    :result-key 'reverse
+    :short #\r
+    :long "reverse"
+    :help "Collect smallest elements instead of largest."
+    :help-no "Collect largest elements (the default)."))
+
+
+
+(adopt:define-string *help*
+  "extrema processes lines of standard input and prints the top N")
+
+
+(defparameter *ui*
+  (adopt:make-interface
+    :name "extrema"
+    :usage "[OPTIONS]"
+    :summary "a more efficient `sort | head`"
+    :help *help*
+    :examples *examples*
+    :contents (list *option/help*
+                    *o/field*
+                    *o/lines*
+                    *o/reverse*
+                    *o/no-reverse*
+                    *o/numeric*
+                    *o/no-numeric*
+                    )))
+
+(defun toplevel ()
+  (adopt::quit-on-ctrl-c ()
+    (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*)
+      (when (gethash 'help options)
+        (adopt:print-help-and-exit *ui*))
+      (handler-case
+          (progn (assert (null arguments) () "No arguments accepted.")
+                 (run *standard-input*
+                      (gethash 'field options)
+                      (gethash 'n options)
+                      :reverse (gethash 'reverse options)))
+        (error (e) (adopt:print-error-and-exit e))))))