逆FizzBuzz

逆FizzBuzz問題 (Inverse FizzBuzz)というものがあるのを知ったので解いてみた。
結構力技。
あと、本当に合っているかは不明。

;; 逆FizzBuzzを解く関数
;; listは fizz,buzz,fizzbuzz のいずれかを要素に持つリスト
;;
;; 処理内容は、
;;   - 1: 開始数値を(1から15の範囲で)設定して、とりあえず解いてみる
;;   - 2: その15個の解の中から、一番短いものを選択する
;;   という簡単なもの。
;;
;; 解がない場合はnilを返す。
(defun ifizzbuzz (list)
  (select-min 
   (delete '() (loop FOR start FROM 1 TO 15   ; 開始数値を1〜15の範囲を試せば、全パターン網羅できる(はず)
                     COLLECT (ifizzbuzz-impl start list '())))))

;; リスト内で、一番短いリストを返す
(defun select-min (list-of-list)
  (first (sort list-of-list #'< :key #'length)))

;; 数値をfizzbuzzを表すシンボルに変換する
(defun get-fizzbuzz-type (n)
  (cond ((= (mod n 15) 0) 'fizzbuzz)
        ((= (mod n  5) 0) 'buzz)
        ((= (mod n  3) 0) 'fizz)
        (t                'none)))

;; nを開始とする連続する数値列が、listが示すfizzbuzz列に一致するかを判定する関数
;; 一致する場合は、その一致した数値列を返す。
(defun ifizzbuzz-impl (n list acc)
  (if (null list)
      (reverse acc)  ; 一致した
    (let ((type (get-fizzbuzz-type n)))
      (if (eq type 'none)           ; fizzbuzzと関係ない数値の場合は無条件で許可
          (ifizzbuzz-impl (1+ n) list (cons n acc))
        (when (eq (car list) type)  ; fizzbuzz系の数値の場合は、listの先頭要素と一致するもののみ許可
          (ifizzbuzz-impl (1+ n) (cdr list) (cons n acc)))))))

動作例。

> (ifizzbuzz '(fizz))
=> (3)

> (ifizzbuzz '(fizz buzz))
=> (9 10)

> (ifizzbuzz '(fizz buzz fizz))
=> (3 4 5 6)

> (ifizzbuzz '(fizz fizz buzz fizz fizzbuzz fizz))
=> (6 7 8 9 10 11 12 13 14 15 16 17 18)

> (ifizzbuzz '(buzz buzz))
=>NIL  ; 解無し

合ってそうには見える。