Bowling kata (chicken scheme)

all-at-once.scm

#!/usr/bin/env csi -ss
(use test)
(use srfi-1)

(define (compute-bowling-score input)
  (define (pins-knocked-down input-offset)
    (case (string-ref input input-offset)
      ((#\X) 10)
      ((#\-) 0)
      ((#\/)
       (- 10 (pins-knocked-down (- input-offset 1))))
      (else
	(- (char->integer (string-ref input input-offset))
	   (char->integer #\0)))))

  (let loop ((input-offset 0)
	     (frame-number 0)
	     (score-so-far 0)
	     (this-throw-multiplier 1)
	     (next-throw-multiplier 1))
    (cond
      ((>= input-offset (string-length input))
       score-so-far)
      ((>= frame-number 10)
       (loop (+ 1 input-offset)
	     (+ 1 frame-number)
	     (+ (* (- this-throw-multiplier 1) (pins-knocked-down input-offset))
		score-so-far)
	     next-throw-multiplier
	     1))
      ((and (< (+ 1 input-offset) (string-length input))
	    (char=? #\/ (string-ref input (+ 1 input-offset))))
       (loop (+ 2 input-offset)
	     (+ 1 frame-number)
	     (+ (+ (* this-throw-multiplier (pins-knocked-down input-offset))
		   (* next-throw-multiplier (pins-knocked-down (+ 1 input-offset))))
		score-so-far)
	     2
	     1))
      ((char=? #\X (string-ref input input-offset))
       (loop (+ 1 input-offset)
	     (+ 1 frame-number)
	     (+ (* this-throw-multiplier 10) score-so-far)
	     (+ 1 next-throw-multiplier)
	     2))
      (else
       (loop (+ 2 input-offset)
	     (+ 1 frame-number)
	     (+ (+ (* this-throw-multiplier (pins-knocked-down input-offset))
		   (* next-throw-multiplier (pins-knocked-down (+ 1 input-offset))))
		score-so-far)
	     1
	     1)))))

(test 0 (compute-bowling-score "--------------------"))
(test 1 (compute-bowling-score "1-------------------"))
(test 7 (compute-bowling-score "7-------------------"))
(test 8 (compute-bowling-score "35------------------"))
(test 10 (compute-bowling-score "X------------------"))
(test 10 (compute-bowling-score "2/------------------"))
(test 14 (compute-bowling-score "2/2-----------------"))
(test 20 (compute-bowling-score "X23----------------"))
(test 57 (compute-bowling-score "XX9---------------"))
(test 300 (compute-bowling-score "XXXXXXXXXXXX"))
(test 293 (compute-bowling-score "XXXXXXXXXXX3"))
(test 150 (compute-bowling-score "5/5/5/5/5/5/5/5/5/5/5"))
(test-exit)

bowling.scm

#!/usr/bin/env csi -ss
(use test)
(use srfi-1)

(define (value-of-digit digit)
  (- (char->integer digit) (char->integer #\0)))

(define (number-of-pins-knocked-down throw previous-number-of-pins)
  (case throw
    ((#\-) 0)
    ((#\X) 10)
    ((#\/) (- 10 previous-number-of-pins))
    (else
      (value-of-digit throw))))

(define (string->frames input)

  (define (end-of-input?)
    (= 0 (string-length input)))

  (define (strike?)
    (char=? #\X (string-ref input 0)))

  (define (input-without-first n)
    (substring input n (string-length input)))

  (define (rest-of-input)
    (if (strike?)
      (input-without-first 1)
      (input-without-first 2)))

  (define (first-throw-pins)
    (number-of-pins-knocked-down (string-ref input 0) #f))

  (define (second-throw-pins)
    (number-of-pins-knocked-down (string-ref input 1) (first-throw-pins)))

  (define (this-non-strike-frame)
    (cons (first-throw-pins) (second-throw-pins)))

  (define (this-frame)
    (if (strike?)
      '(10 . 0)
      (this-non-strike-frame)))

  (define (rest-of-frames)
    (string->frames (rest-of-input)))

  (define (this-frame-and-rest-of-frames)
    (append (list (this-frame)) (rest-of-frames)))

  (if (end-of-input?)
    '()
    (this-frame-and-rest-of-frames)))

(test '((2 . 4)) (string->frames "24"))
(test '((3 . 7)) (string->frames "3/"))
(test '((10 . 0)) (string->frames "X"))
(test '((2 . 4) (4 . 2)) (string->frames "2442"))
(test '((10 . 0) (2 . 4)) (string->frames "X24"))
(test '((3 . 7) (10 . 0) (2 . 4)) (string->frames "3/X24"))

(define (first-throw frame)
  (car frame))

(define (second-throw frame)
  (cdr frame))

(define (strike? frame)
  (= 10 (first-throw frame)))

(define (total-pins-knocked-down frame)
  (+ (first-throw frame) (second-throw frame)))

(define (spare? frame)
  (and (not (strike? frame))
       (= 10 (total-pins-knocked-down frame))))

(define (frame-score frame rest-of-frames)
  (define (one-more-throw)
    (first-throw (car rest-of-frames)))

  (define (two-more-throws)
    (if (strike? (car rest-of-frames))
      (+ 10 (first-throw (cadr rest-of-frames)))
      (+ (first-throw (car rest-of-frames))
	 (second-throw (car rest-of-frames)))))

  (define extra-throws
    (cond
      ((strike? frame)
	(two-more-throws))
      ((spare? frame)
	(one-more-throw))
      (else
	0)))

  (+ (total-pins-knocked-down frame) extra-throws))

(define (compute-bowling-score input)
  (let loop ((frames (string->frames input))
	     (score 0))
    (if (null? frames)
      score
      (let* ((this-frame (car frames))
	     (rest-of-frames (cdr frames))
	     (this-frame-score (frame-score this-frame rest-of-frames)))
	(loop (cdr frames) (+ this-frame-score score))))))

(test 0 (compute-bowling-score "--------------------"))
(test 1 (compute-bowling-score "1-------------------"))
(test 7 (compute-bowling-score "7-------------------"))
(test 8 (compute-bowling-score "35------------------"))
(test 10 (compute-bowling-score "X------------------"))
(test 10 (compute-bowling-score "2/------------------"))
(test 14 (compute-bowling-score "2/2-----------------"))
(test 20 (compute-bowling-score "X23----------------"))
(test 57 (compute-bowling-score "XX9---------------"))

(test-exit)