(use-modules (srfi srfi-1))

(define move cons)
(define move->row car)
(define move->col cdr)

(define (move-eq? a b)
  (and (eq? (move->row a)
            (move->row b))
       (eq? (move->col a)
            (move->col b))))

(define corner-moves
  (list (move 0 0)   ; top left
        (move 0 7)   ; top right
        (move 7 0)   ; bottom left
        (move 7 7))) ; bottom right

(define (in-next-row? a b)
  (eq? (+ 1 (move->row a))
       (move->row b)))

(define (in-previous-row? a b)
  (eq? (- 1 (move->row a))
       (move->row b)))

(define (in-next-col? a b)
  (eq? (+ 1 (move->col a))
       (move->row b)))

(define (in-previous-col? a b)
  (eq? (- 1 (move->col a))
       (move->row b)))

(define (corner-move? m)
  (member m corner-moves move-eq?))

; We always want to get a corner move
(define (corner-score m)
  (if (corner-move? m)
    1
    0))

(define (adjacent-to-corner? m)
  (any (lambda (corner)
         (or (and (eq? (move->col m)
                       (move->col corner))
                  (in-next-row? corner m))
             (and (eq? (move->row m)
                       (move->row corner))
                  (in-next-col? corner m))
             (and (eq? (move->col m)
                       (move->col corner))
                  (in-previous-row? corner m))
             (and (eq? (move->row m)
                       (move->row corner))
                  (in-previous-col? corner m))
             (and (in-next-row? corner m)
                  (in-next-col? corner m))
             (and (in-previous-row? corner m)
                  (in-previous-col? corner m))
             (and (in-previous-row? corner m)
                  (in-next-col? corner m))
             (and (in-next-row? corner m)
                  (in-previous-col? corner m))))
       corner-moves))

; Discourage going near a corner, which could allow opponent to go there
(define (near-corner-score m)
  (if (adjacent-to-corner? m)
    1
    0))

(define (is-edge? m)
  (or (eq? 0 (move->row m))
      (eq? 7 (move->row m))
      (eq? 0 (move->col m))
      (eq? 7 (move->col m))))

(define (edge-score m)
  (if (is-edge? m)
    1
    0))

(define (adjacent-to-edge? m)
  (or (eq? 1 (move->row m))
      (eq? 6 (move->row m))
      (eq? 1 (move->col m))
      (eq? 6 (move->col m))))

(define (near-edge-score m)
  (if (adjacent-to-edge? m)
    1
    0))

(define (available-moves-for-opponent-after-move m)
  (length (valid-moves (apply-move m) (other-player))))

(define (maximum-flips-on-opponents-next-turn m)
  (let ((board-after-move (apply-move m)))
    (reduce
      max
      0
      (map (lambda (n)
             (flipped-by-move n board-after-move (other-player)))
           (valid-moves board-after-move (other-player))))))

; Score is the sum of some weighted conditions for a move
(define (move->score m)
  (+ (* (corner-score m)                             100)
     (* (near-corner-score m)                         -5)
     (* (edge-score m)                                 4)
     (* (near-edge-score m)                           -3)
     (* (flipped-by-move m)                            3)
     (* (available-moves-for-opponent-after-move m) -0.1)
     (* (maximum-flips-on-opponents-next-turn m)      -1)))

(define (score-sort a b)
  (> (move->score a)
     (move->score b)))

(first (sort (valid-moves)
             score-sort))