逆FizzBuzz問題

逆FizzBuzz問題なるものを発見した。元ネタ５月だから遅れること２ヶ月くらいか。
逆FizzBuzz問題をTrieでトライ - athosの日記

とりあえず、Schemeで解いてみた。(#0=記法をサポートしてれば、どの処理系でも動くはず・・・)

#!/bin/env sash
(import (rnrs) (srfi :2 and-let*))

(define (inverse-fizzbuzz ls)
  (define one-cycle-count 7)
  (define inverse-fizzbuzz-list
    '#0=((fizz . 3) (buzz . 5)  (fizz . 6)
  (fizz . 9) (buzz . 10) (fizz . 12)
  (fizzbuzz . 15) . #0#))
  (define (check-input ls)
    (let* ((len (length ls)) (max-try (ceiling (/ len one-cycle-count))))
      (define (count-up s c) (if (eq? (car s) 'fizzbuzz) (+ c 1) c))
      (let loop2 ((in ls) (tmpl inverse-fizzbuzz-list)
    (r '()) (times 0)
    (matched? #f) (tried 0))
 (cond ((null? in) (reverse! r))
       ((eq? (car in) (caar tmpl))
        (loop2 (cdr in) (cdr tmpl)
        (cons (+ (cdar tmpl) (* 15 times)) r)
        (count-up (car tmpl) times)
        #t
        (count-up (car tmpl) tried)))
       ((> tried max-try) #f)
       (else (loop2 ls 
      (if matched? tmpl (cdr tmpl))
      '() 0 #f
      (count-up (car tmpl) tried)))))))
  (and-let* ((r (check-input ls)))
    (cons (car r) (last-pair r))))

(print (inverse-fizzbuzz '(fizz)))
(print (inverse-fizzbuzz '(buzz)))
(print (inverse-fizzbuzz '(fizz buzz)))
(print (inverse-fizzbuzz '(buzz fizz fizz)))
(print (inverse-fizzbuzz '(fizz fizz buzz)))
(print (inverse-fizzbuzz '(fizz buzz fizz fizzbuzz)))
(print (inverse-fizzbuzz '(fizz fizzbuzz fizz)))
(print (inverse-fizzbuzz '(fizz fizzbuzz fizz fizz)))

reverse!はSRFI-1だったかな？まぁいいか。
あんまり美しくないなぁ。最初はSRFI-41使ってパターンマッチ的に解こうかなぁとも思ったんだけど、不正なリストを渡された際にどうしようかなぁとか思ってやめた。

家事と家事の合間に解いたのにしては上出来だと思う・・・