(require (lib "1.ss" "srfi"))
(define HEIGHT 5)
(define WIDTH 5)

(define-struct move (color h w))
(define (show-move m) (printf "~a ~a,~a\n" (move-color m) (add1 (move-h m)) (add1 (move-w m))))
(define (randomly-select l)
  (let ((i (random (length l))))
    (values (list-ref l i) (append (take l i) (drop l (add1 i))))))
(define (neighbors p)
  (let ((x (car p))
        (y (cadr p)))
    (list (list x (add1 y))
          (list x (sub1 y))
          (list (add1 x) y)
          (list (sub1 x) y))))

(define (num-open-neighbors p b) (apply + (map b (neighbors p))))
(define (color-for-square p b) (if (even? (num-open-neighbors p b)) #\R #\B))
(define (place p b) (lambda (p2) (if (equal? p p2) 0 (b p2))))

(define (solve board)
  (define unplaced
    (let loop ((i 0) (j 0))
      (cond
        [(>= i HEIGHT) '()]
        [(>= j WIDTH) (loop (add1 i) 0)]
        [else (cons (list i j) (loop i (add1 j)))])))
  (define (place-pieces ps b)
    (cond
      [(null? ps) '()]
      [else
       (let-values ([(point rest) (randomly-select ps)])
         (cons (apply make-move (color-for-square point b) point)
               (place-pieces rest (place point b))))]))
  (place-pieces unplaced board))

(define initial-board
  (lambda (p)
    (let ((x (car p)) (y (cadr p)))
      (if (and (>= x 0) (>= y 0) (< x HEIGHT) (< y WIDTH))
          1
          0))))

(for-each show-move (solve initial-board))