1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
(= lines '((1 2 3) (1 4 7) (1 5 9) (2 5 8) (3 5 7) (3 6 9) (4 5 6) (7 8 9)))

(def lsets<= (s1 s2) (all [mem _ s2] s1))

(def reach? (line mark pool)
  (let marked (map [if (mem _ mark) t nil] line)
    (if (and (is (count nil marked) 1) (mem (line (pos nil marked)) pool))
          (line (pos nil marked))
        nil)))

(def random-player (smark rmark pool)
  (if (is pool nil) 'd
      (withs (picked (random-elt pool) rm (cons picked rmark) rp (rem picked pool))
        (if (some [lsets<= _ rm] lines) 'r
            (smart-player smark rm rp)))))

(def smart-player (smark rmark pool)
  (if (is pool nil) 'd
      (let rr (rem nil (map [reach? _ rmark pool] lines))
        (if (isnt nil (rem nil (map [reach? _ smark pool] lines))) 's
            (isnt nil rr) (random-player (cons (car rr) smark) rmark (rem (car rr) pool))
            (odd (len pool)) (senkou smark rmark pool)
            (koukou smark rmark pool)))))

(def senkou (smark rmark pool)
  (if (is (len pool) 9) (random-player (cons 1 smark) rmark (rem 1 pool))
      (is (len pool) 7)
        (let m (if (lsets<= '(2 3) pool) 3 7)
          (random-player (cons m smark) rmark (rem m pool)))
      (is (len pool) 1) 'd
      (let m (if (lsets<= '(4 7) pool) 7 9)
        (random-player (cons m smark) rmark (rem m pool)))))

(def koukou (smark rmark pool)
  (let rf (last rmark)
    (if (mem rf '(1 3 7 9))
          (pat1379 smark rmark pool)
        (mem rf '(2 4))
          (pat24 smark rmark pool)
        (mem rf '(6 8))
          (pat68 smark rmark pool)
        (pat5 smark rmark pool))))

(def pat1379 (smark rmark pool)
  (if (is (len pool) 8) 
        (random-player (cons 5 smark) rmark (rem 5 pool))
      (is (len pool) 6)
        (let m (if (some [mem _ rmark] '(2 6)) 3
                   (some [mem _ rmark] '(4 8)) 7 2)
          (random-player (cons m smark) rmark (rem m pool)))
      (is (len pool) 4)
        (let m (if (some [mem _ rmark] '(2 8)) 4 2)
          (random-player (cons m smark) rmark (rem m pool)))
      (let picked (random-elt pool)
        (random-player (cons picked smark) rmark (rem picked pool)))))

(def pat24 (smark rmark pool)
  (if (is (len pool) 8)
        (random-player (cons 1 smark) rmark (rem 1 pool))
      (is (len pool) 6)
        (let m (if (lsets<= '(2 9) rmark) 7
                   (lsets<= '(4 9) rmark) 3 5)
          (random-player (cons m smark) rmark (rem m pool)))
      (is (len pool) 4)
        (let m (if (lsets<= '(2 4 9) rmark) (if (mem 5 pool) 5 (mem 3 pool) 3 7)
                   (lsets<= '(2 5 9) rmark) 7
                   (lsets<= '(5 4 9) rmark) 3)
          (random-player (cons m smark) rmark (rem m pool)))
      (let picked (random-elt pool)
        (random-player (cons picked smark) rmark (rem picked pool))))))

(def pat68 (smark rmark pool)
  (if (is (len pool) 8)
        (random-player (cons 9 smark) rmark (rem 9 pool))
      (is (len pool) 6)
        (let m (if (lsets<= '(1 6) rmark) 7
                   (lsets<= '(1 8) rmark) 3 5)
          (random-player (cons m smark) rmark (rem m pool)))
      (is (len pool) 4)
        (let m (if (lsets<= '(1 6 8) rmark) (if (mem 5 pool) 5 (mem 3 pool) 3 7)
                   (lsets<= '(1 5 8) rmark) 3
                   (lsets<= '(1 5 6) rmark) 7)
          (random-player (cons m smark) rmark (rem m pool)))
      (let picked (random-elt pool)
        (random-player (cons picked smark) rmark (rem picked pool))))))

(def pat5 (smark rmark pool)
  (if (is (len pool) 8) 
        (random-player (cons 1 smark) rmark (rem 1 pool))
      (is (len pool) 6)
        (random-player (cons 3 smark) rmark (rem 3 pool))
      (let picked (random-elt pool)
        (random-player (cons picked smark) rmark (rem picked pool)))))

(def nplay-ox (n sente)
  (let wl (map (fn (_) (sente nil nil (range 1 9))) (range 1 n))
    (prn "smart-player win: " (count 's wl))
    (prn "random-player win: " (count 'r wl))
    (prn "draw: " (count 'd wl))
    nil))