Paste number 140815:

Paste number 140815:
Pasted by: StrmSrfr
When:4 years, 5 months ago
Share:Tweet this! |
Paste contents:
Raw Source | XML | Display As
(defvar *winners*; I'd probably preprocess this, but this is more like the Python
   (cl-ppcre:split "\\s+"
     "washington adams jefferson jefferson madison madison monroe 
monroe adams jackson jackson vanburen harrison polk taylor pierce buchanan 
lincoln lincoln grant grant hayes garfield cleveland harrison cleveland mckinley
 mckinley roosevelt taft wilson wilson harding coolidge hoover roosevelt 
roosevelt roosevelt roosevelt truman eisenhower eisenhower kennedy johnson nixon 
nixon carter reagan reagan bush clinton clinton bush bush obama obama")
   :test #'string=))

(defvar *losers*
    (cl-ppcre:split "\\s+"
      "clinton jefferson adams pinckney pinckney clinton king adams 
jackson adams clay vanburen vanburen clay cass scott fremont breckinridge 
mcclellan seymour greeley tilden hancock blaine cleveland harrison bryan bryan 
parker bryan roosevelt hughes cox davis smith hoover landon wilkie dewey dewey 
stevenson stevenson nixon goldwater humphrey mcgovern ford carter mondale 
dukakis bush dole gore kerry mccain romney")
    :test #'string=)
   *winners* :test #'string=))

(defun verify (re winners losers)
  (let*((test (alexandria:curry #'cl-ppcre:scan re))
        (misses (remove-if test winners))
        (false-positives (remove-if-not test losers)))
    (values (and (null misses) (null false-positives))

(defun dotify (string)
  (case (length string)
    (0 nil)
    (1 (list string "."))
     (mapcan (lambda (s)
               (list (concatenate 'string "." s)
                     (concatenate 'string (subseq string 0 1) s)))
             (dotify (subseq string 1))))))

(defun matches (regex strings)
  (remove-if-not (alexandria:curry #'cl-ppcre:scan regex)

(defun subparts (word &optional (max 4))
  (let ((len (length word)))
    (when (plusp max)
      (append (loop for start from 0
                   and end from max to len
                   collecting (subseq word start end))
              (subparts word (1- max))))))

(defun candidate-components (winners losers)
  (let ((parts (remove-duplicates
                (alexandria:mappend #'dotify
                                    (alexandria:mappend #'subparts
                                  :test #'string=))
        (wholes (mapcar (lambda (s)
                          (concatenate 'string "^" s "$"))
    (union wholes (remove-if (alexandria:rcurry #'matches losers)
           :test #'string=)))

(defun find-max (sequence &key (key #'identity))
  (case (length sequence)
    (0 nil)
    (1 (elt sequence 0))
     (let ((first (elt sequence 0))
           (rest (find-max (subseq sequence 1) :key key)))
       (if (< (funcall key first) (funcall key rest))

(defun findregex (winners losers)
  (let ((pool (candidate-components winners losers))
       with best
       while winners
       do (progn
            (setf best (find-max pool
                                 :key (lambda (c)
                                        (- (* 3 (length (matches c winners)))
                                           (length c)))))
            (push best cover)
            (setf pool (remove best pool :test #'string=)
                  winners (set-difference winners (matches best winners)
                                          :test #'string=))))
    (format nil "~{~A~^|~}" cover)))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.