FizzBuzz 問題いろいろ

FizzBuzz 問題をやたらややこしいやり方で解いてみよう。
# 普通に解く
素直な方法で普通に解きます。
## プログラム
```
(define nil '())

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

(define (fizz-buzz n)
  (flatmap
   (lambda (x)
     (cond ((= (remainder x 15) 0) '(FizzBuzz))
           ((= (remainder x 5) 0) '(Buzz))
           ((= (remainder x 3) 0) '(Fizz))
           (else (list x))))
   (enumerate-interval 1 n)))
```
## 実行
リストの要素がたくさんある場合は、表示を省略する仕様になっているため、print 手続きを使って全体を表示するようにしています。
```
gosh> (print (fizz-buzz 100))
(1 2 Fizz 4 Buzz Fizz 7 8 Fizz Buzz 11 Fizz 13 14 FizzBuzz 16 17 Fizz 19 Buzz Fizz 22 23 Fizz Buzz 26 Fizz 28 29 FizzBuzz 31 32 Fizz 34 Buzz Fizz 37 38 Fizz Buzz 41 Fizz 43 44 FizzBuzz 46 47 Fizz 49 Buzz Fizz 52 53 Fizz Buzz 56 Fizz 58 59 FizzBuzz 61 62 Fizz 64 Buzz Fizz 67 68 Fizz Buzz 71 Fizz 73 74 FizzBuzz 76 77 Fizz 79 Buzz Fizz 82 83 Fizz Buzz 86 Fizz 88 89 FizzBuzz 91 92 Fizz 94 Buzz Fizz 97 98 Fizz Buzz)
#<undef>
```
# 無限ストリームで解く
ストリームについては、「計算機プログラムの構造と解釈」第3章5節を、無限ストリームについては同書の第3章5.2節を参照してください。
https://sicp.iijlab.net/fulltext/x350.html
## プログラム
```
(define nil '())
(define the-empty-stream nil)

(define (stream-null? stream)
  (null? stream))

(define (stream-car stream) (car stream))

(define (stream-cdr stream) (force (cdr stream)))

(define (cons-stream a b)
  (cons a b))
                     
(define (stream-ref s n)
  (if (= n 0)
      (stream-car s)
      (stream-ref (stream-cdr s) (- n 1))))

(define (stream-map proc . argstreams)
  (if (stream-null? (car argstreams))
      the-empty-stream
      (cons-stream
       (apply proc (map stream-car argstreams))
       (delay
         (apply stream-map
                (cons proc (map stream-cdr argstreams)))))))

(define (stream-for-each proc s)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s))
             (stream-for-each proc (stream-cdr s)))))

(define (display-stream s)
  (stream-for-each display-line s))

(define (display-line x)
  (display x)
  (newline))

(define (stream-enumerate-interval low high)
  (if (> low high)
      the-empty-stream
      (cons-stream
       low
       (delay (stream-enumerate-interval (+ low 1) high)))))

(define fizz-buzz
  (stream-map
   (lambda (x)
     (cond ((= (remainder x 15) 0) 'FizzBuzz)
           ((= (remainder x 5) 0) 'Buzz)
           ((= (remainder x 3) 0) 'Fizz)
           (else x)))
   (stream-enumerate-interval 1 100)))
```
## 実行
```
gosh> (display-stream fizz-buzz)
1
2
Fizz
4
Buzz
Fizz
7
8
Fizz
Buzz
11
Fizz
13
14
FizzBuzz

(長いので中略)

FizzBuzz
91
92
Fizz
94
Buzz
Fizz
97
98
Fizz
Buzz
done
```
# コルーチンで解く
コルーチンについては Gauche 本を読むのが良いでしょう。
リンクがやたら長いのでw、各々 amazon で「Gauche」を検索して書籍を購入してください。
Gauche でプログラムを書く方なら持っていて損は無いです。
## プログラム
```
(use util.queue)

(define *tasks* (make-queue))

(define-syntax define-coroutine
  (syntax-rules ()
    ((_ (routine yield) body ...)
     (define (routine)
       (call/cc (lambda (return)
                  (define (yield)
                    (call/cc (lambda (cont)
                               (enqueue! *tasks* cont)
                               (return))))
                  body ...))
       ((dequeue! *tasks*))))
    ((_ (routine yield exit) body ...)
     (define (routine)
       (call/cc (lambda (escape)
                  (call/cc (lambda (return)
                             (define (yield)
                               (call/cc (lambda (cont)
                                          (enqueue! *tasks* cont)
                                          (return))))
                             (define (exit)
                               (call/cc (lambda (cont)
                                          (enqueue! *tasks* cont)
                                          (escape))))
                             body ...))
                  ((dequeue! *tasks*))))))))

(define (coroutine-init! . rs)
  (set! *tasks* (make-queue))
  (for-each (lambda (r)
              (enqueue! *tasks* r))
            rs))

(define (coroutine-add! r) (enqueue! *tasks* r))
(define (coroutine-del!) (dequeue! *tasks*))
(define (coroutine-restart!) ((dequeue! *tasks*)))
(define (coroutine-skip!) (coroutine-add! (coroutine-del!)))

;; FizzBuzz

(define (print-fizz-buzz limit)
  (define (devidable? m n) (= (remainder m n) 0))
  (define (fizz? n) (devidable? n 3))
  (define (buzz? n) (devidable? n 5))
  (define (fizz-buzz? n) (and (fizz? n) (buzz? n)))
 
  (define *output* (cons 0 ""))
  (define (request-output! priority output)
    (and (> priority (car *output*))
         (set! *output* (cons priority output))))
  (define (init-request!) (set! *output* (cons 0 "")))
  (define (get-request-output) (cdr *output*))
  
  (define-coroutine (cr-number yield)
    (let lp ((c 0))
      (inc! c)
      (request-output! 10 c)
      (yield)
      (lp c)))

  (define-coroutine (cr-fizz yield)
    (let lp ((c 0))
      (inc! c)
      (and (fizz? c) (request-output! 30 'fizz))
      (yield)
      (lp c)))

  (define-coroutine (cr-buzz yield)
    (let lp ((c 0))
      (inc! c)
      (and (buzz? c) (request-output! 20 'buzz))
      (yield)
      (lp c)))

  (define-coroutine (cr-fizz-buzz yield)
    (let lp ((c 0))
      (inc! c)
      (and (fizz-buzz? c) (request-output! 40 'fizz-buzz))
      (yield)
      (lp c)))

  (define-coroutine (cr-limitter yield exit)
    (let lp ((c 0))
      (inc! c)
      (if (> c limit)
          (begin (newline) (exit))
          (yield))
      (lp c)))

  (define-coroutine (cr-printer yield)
    (let lp ()
      (display (get-request-output))
      (display " ")
      (init-request!)
      (yield)
      (lp)))

  (coroutine-init! cr-fizz cr-buzz cr-fizz-buzz cr-limitter cr-printer)
  (cr-number))
```
## 実行
```
gosh> (print-fizz-buzz 100)
1 2 fizz 4 buzz fizz 7 8 fizz buzz 11 fizz 13 14 fizz-buzz 16 17 fizz 19 buzz fizz 22 23 fizz buzz 26 fizz 28 29 fizz-buzz 31 32 fizz 34 buzz fizz 37 38 fizz buzz 41 fizz 43 44 fizz-buzz 46 47 fizz 49 buzz fizz 52 53 fizz buzz 56 fizz 58 59 fizz-buzz 61 62 fizz 64 buzz fizz 67 68 fizz buzz 71 fizz 73 74 fizz-buzz 76 77 fizz 79 buzz fizz 82 83 fizz buzz 86 fizz 88 89 fizz-buzz 91 92 fizz 94 buzz fizz 97 98 fizz buzz 
```

わざわざややこしい方法で実装する必要はまったく無いのですが、同じ問題をいろいろな観点から実装してみるることに意義があると思われます。知らんけど。