Scheme:FizzBuzz

Scheme:FizzBuzz

Fizz-Buzz問題

(define-syntax aa
  (syntax-rules ()
    ((_ current v next)
     (define-syntax current
       (syntax-rules ()
         ((_)
          #f)
         ((_ elem . rest)
          (begin
            (print v)
            (next . rest))))))
    ((_ current next)
     (define-syntax current
       (syntax-rules ()
         ((_)
          #f)
         ((_ elem . rest)
          (begin
            (print elem)
            (next . rest))))))))

(define-syntax ab
  (syntax-rules (!)
    ((_ v)
     #f)
    ((_ current ! msg next rest ...)
     (begin
       (aa current msg next)
       (ab next rest ...)))
    ((_ current next rest ...)
     (begin
       (aa current next)
       (ab next rest ...)))))

(ab a1 a2 a3 ! "Fizz" a4 a5 ! "Buzz" 
    a6 ! "Fizz" a7 a8 a9 ! "Fizz" a10 ! "Buzz" 
    a11 a12 ! "Fizz" a13 a14 a15 ! "FizzBuzz" 
    a1)

(a1     1  2  3  4  5  6  7  8  9 
    10 11 12 13 14 15 16 17 18 19 
    20 21 22 23 24 25 26 27 28 29 
    30 31 32 33 34 35 36 37 38 39 
    40 41 42 43 44 45 46 47 48 49 
    50 51 52 53 54 55 56 57 58 59 
    60 61 62 63 64 65 66 67 68 69 
    70 71 72 73 74 75 76 77 78 79 
    80 81 82 83 84 85 86 87 88 89 
    90 91 92 93 94 95 96 97 98 99 
    100)
(use srfi-1) (use srfi-13) (use util.match)
(define (foo m s) (match-lambda ((n . t) (if (= 0 (modulo n m)) (cons n (string-append s t)) (cons n t)))))
(define bar (match-lambda ((n . s) (if (string-null? s) (x->string n) s))))
(define fizz (foo 3 "Fizz"))
(define buzz (foo 5 "Buzz"))
(define (fizz-buzz xs) (map (compose bar (compose fizz (compose buzz (cut cons <> "")))) xs))
(use srfi-1)

(define-syntax fizz-buzz
  (syntax-rules ()
    ((_ ((num word)) x)
     (if (zero? (modulo x num)) word x))
    ((_ ((num word) (num1 word1) ...) x)
     (if (zero? (modulo x num))
         (string-append
          word
          (let ((a (fizz-buzz ((num1 word1) ...) x)))
            (if (number? a) "" a)))
         x))))

(for-each
 (lambda(x)
   (display (fizz-buzz ((3 "Fizz")(5 "Buzz")) x))
   (newline))
 (iota 100 1 1))
(use srfi-1)

(define (fizzbuzz)
  (define fizz (circular-list #f #f "fizz"))
  (define buzz (circular-list #f #f #f #f "buzz"))
  (map (lambda (f b i)
         (or (and f b (string-append f b)) f b i))
       fizz buzz (iota 100 1)))

(print (fizzbuzz))
(use srfi-1)

(define (dividable? x y) (= (modulo x y) 0))
(define fizzbuzz-spec
  `((,(lambda (x) (and (dividable? x 3) (dividable? x 5))) . "FizzBuzz")
    (,(cut dividable? <> 3) . "Fizz")
    (,(cut dividable? <> 5) . "Buzz")))

(define (fizzbuzz spec)
  (lambda (x)
    (cond
     ((find (lambda (pair) ((car pair) x)) spec) => cdr)
     (else x))))

(for-each print (unfold (pa$ < 100) (fizzbuzz fizzbuzz-spec) (pa$ + 1) 1))
(loop for i from 1 to 100
 collect
 (cond
  ((= 0 (mod i 15)) "FizzBuzz")
  ((= 0 (mod i 3)) "Fizz")
  ((= 0 (mod i 5)) "Buzz")
  (t i)))
(use srfi-1)
(use srfi-11)
(use text.tree)
(use gauche.sequence)

;; (fizz 0 '(3 "Fizz" 5 "Buzz") #f)
;; => ("fizz") or ("fizz" "Buzz") or 0
(define (fizz n lst has)
  (cond ((null? lst)
         (if has '() n))
        ((= 0 (remainder n (car lst)))
         (cons (cadr lst) (fizz n (cddr lst) #t)))
        (else
         (fizz n (cddr lst) has))))

;; input: (fizzbuzz 1 100 '(3 "fizz" 5 "buzz" ...))
(define (fizzbuzz start end preds)
  (map (cut fizz <> preds #f) (iota (- (+ end 1) start ) start)))

;; (parse-args '("10" "300" "3" "buz" "5" "foo"))
;; => (10 300 (3 "buz" 5 "foo"))
(define (parse-args args)
  (values (string->number (car args)) (string->number (cadr args))
          (map-with-index
           (lambda (i x)
             (if (= 0 (remainder i 2))
                 (string->number x)
                 x))
           (cddr args))))

;; input: 1 100 3 Fizz 5 Buzz ...
(define (main args)
  (if (> 4 (length args))
      (begin (print "ex: 1 100 3 Fizz 5 Buzz")(exit 1))
      (let-values (((start end preds) (parse-args (cdr args))))
        (for-each (lambda (x)
                    (if (pair? x) (begin (write-tree x) (newline))
                        (print x)))
                  (fizzbuzz start end preds)))))
More ...