lisp/extrema.lisp @ 49280ba4e942 default tip

(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))))))