Inverse FizzBuzz in Common Lisp

inverse-fizzbuzz.lisp

;; http://www.jasq.org/2/post/2012/05/inverse-fizzbuzz.html
;; http://d.hatena.ne.jp/matarillo/20120515/p1

#.(progn
    (ql:quickload :optima)
    (ql:quickload :alexandria)
    (ql:quickload :cl-test-more)
    (values))

(setq *print-circle* t)

(defpackage fizzbuzz
  (:use :cl
        :optima)
  (:export :fizzbuzzp
           :to-fizzbuzz))
(in-package :fizzbuzz)

(defun fizzbuzzp (x)
  (or (= 0 (mod x 3))
      (= 0 (mod x 5))))

(defun to-fizzbuzz (x)
  (match `(,(mod x 3) . ,(mod x 5))
    ((cons 0 0) :Fizzbuzz)
    ((cons 0 _) :Fizz)
    ((cons _ 0) :Buzz)))

(loop for i from 1 upto 100
      if (fizzbuzzp i)
        collect (to-fizzbuzz i))

(defpackage inverse-fizzbuzz
  (:use :cl
        :fizzbuzz)
  (:import-from :alexandria
                :circular-list)
  (:export :inverse-fizzbuzz))
(in-package :inverse-fizzbuzz)

(defparameter *fizzbuzz-list*
              (apply #'circular-list
                     (loop for i from 1 to 15 collect (to-fizzbuzz i))))

(defun nthcar-nonnil (n list)
  (loop while (> n 0)
        while list
        if (car list)
          do (decf n)
        collect (pop list)))

(defun matchp (input list)
  (when (car list)
    (let ((head-list (nthcar-nonnil (length input) list)))
      (and (equal input
                  (remove nil head-list))
           head-list))))

(defun inverse-fizzbuzz (input)
  (car
   (sort
    (loop for i from 1 upto 15
          for fizzbuzz-list = *fizzbuzz-list* then (cdr fizzbuzz-list)
          for result = (matchp input fizzbuzz-list)
          if result
            collect (cons i (+ i (1- (length result)))))
    (lambda (a b)
      (< (- (cdr a) (car a))
         (- (cdr b) (car b)))))))

(defpackage inverse-fizzbuzz-test
  (:use :cl
        :inverse-fizzbuzz
        :cl-test-more)
  (:export :run))
(in-package :inverse-fizzbuzz-test)

(defun run ()
  (is (inverse-fizzbuzz '(:fizz))
      '(3 . 3))
  (is (inverse-fizzbuzz '(:buzz))
      '(5 . 5))
  (is (inverse-fizzbuzz '(:fizz :fizz :buzz))
      '(6 . 10))
  (is (inverse-fizzbuzz '(:fizz :buzz))
      '(9 . 10))
  (is (inverse-fizzbuzz '(:buzz :fizz))
      '(5 . 6))
  (is (inverse-fizzbuzz '(:fizz :buzz :fizz))
      '(3 . 6))
  (is (inverse-fizzbuzz '(:fizz :fizz))
      '(6 . 9)))