(define fibo
  (lambda (n) (letrec ((fib-inner (lambda (n) (cond
                                                ((= n 1) '(1))
                                                ((= n 2) '(1 1))
                                                (else (let ((last (fib-inner (- n 1))))
                                                        (cons (+ (car last) (cadr last)) last)))))))
                (reverse (fib-inner n)))))

(define unique
  (letrec ((contains? (lambda (lst val) (cond ((null? lst) #f) ((= (car lst) val) #t) (else (contains? (cdr lst) val))))))
    (lambda (lst)
      (if (null? lst)
          lst
          (let ((ulst (unique (cdr lst)))) ; Gah, this should be tail recursive
            (if (contains? ulst (car lst))
                ulst
                (cons (car lst) ulst)))))))
                             
(define stable-unique
  (lambda (lst) (reverse (unique (reverse lst)))))

(define transpose (lambda (lst) (apply map list lst)))

(define symbol=? eq?)
(define count= (lambda (lst val) (apply + (map (lambda (x) (if (eq? x val) 1 0)) lst))))

(define compile-moves
  (lambda (moves) (if (null? moves)
                      '(- - - - - - - - -)
                      (let ((move (car moves)) (part-board (compile-moves (cdr moves))))
                        (append (reverse (list-tail (reverse part-board) (- (length part-board) (car move))))
                                (list (cadr move))
                                (list-tail part-board (+ (car move) 1))
                                )))))

(define is-cells-win?
  (lambda (board cell1 cell2 cell3) (let ((c1 (list-ref board cell1)) (c2 (list-ref board cell2)) (c3 (list-ref board cell3)))
                                      (and (symbol=? c1 c2)
                                           (symbol=? c2 c3)
                                           (not (symbol=? c1 '-))
                                           c1
                                           ))))
; 0 1 2
; 3 4 5
; 6 7 8
(define WIN-CELLS
  '((0 1 2)
    (3 4 5)
    (6 7 8)
    (0 3 6)
    (1 4 7)
    (2 5 8)
    (0 4 8)
    (2 4 6)
    ))

(define is-win?
  (lambda (board) (let* ((wins (apply map (lambda lst (apply is-cells-win? board lst)) (apply map list WIN-CELLS))) 
                         (xs (> (count= wins 'x) 0))
                         (os (> (count= wins 'o) 0))
                        )
                    (cond
                      ((and xs os) 'b)
                      (xs 'x)
                      (os 'o)
                      (else #f)
                     )))) 

(define board-ok?
  (lambda (board) (let ((cx (count= board 'x)) (co (count= board 'o)) (w? (is-win? board)))
                    (cond
                       ((eq? w? 'b) #f)
                       ((eq? w? 'x) (= cx (+ co 1)))
                       ((eq? w? 'o) (= cx co))
                       (else (or (= cx co) (= cx (+ co 1))))
                      )
                     )))

(define base-encode
  (lambda (n rad) (let ((x (floor (/ n rad))) (y (modulo n rad)))
                    (if (= x 0)
                        (number->string y)
                        (string-append (base-encode x rad) (number->string y))))))
(define base-decode string->number)

(define CHAR-MAP
  '((- #\0) (x #\1) (o #\2)))

(define board->string
  (lambda (board) (list->string (map (lambda (c) (cadr (assq c CHAR-MAP))) board))))

(define string->board
  (lambda (str) (letrec ((expand-list (lambda (lst) (cond 
                                                      ((> (length lst) 9) #f)
                                                      ((= (length lst) 9) lst)
                                                      (else (expand-list (cons '- lst)))))))
                  (expand-list (map (lambda (c) (cadr (assq c (map reverse CHAR-MAP)))) (string->list str))))))

(define next-board
  (lambda (board) (string->board (base-encode (+ (base-decode (board->string board) 3) 1) 3))))

(define valid-boards
  (lambda () (letrec ((find-boards 
                      (lambda (board) (if board
                                          (let ((next (next-board board)))
                                            (if (board-ok? board)
                                                (cons board (find-boards next))
                                                (find-boards next)))
                                          '()))
                      ))
               (find-boards '(- - -  - - -  - - -)))))


(define remove-duplicates stable-unique)
(define ttt-legal-boards valid-boards)