minesweeper-solver.hy

; https://www.reddit.com/r/mylittleprogramming/comments/335gc2/particularly_perplexing_programming_puzzle_2/

(require kodhy.macros)

(import
  [hy [HySymbol]]
  [kodhy.util [ret]]
  [minesweeper [*]]) ; http://pastebin.com/HgHkuKZj, http://pastebin.com/u0Xg0JGz

(defmacro g [method-name &optional a1 a2]
  (import re)
  (setv method-name (HySymbol (+ "."
    (re.sub r"_([0-9a-zA-Z])" (fn [m] (.upper (.group m 1)))
      (str method-name)))))
  (cond
    [(not (none? a2))
      `(~method-name grid ~a1 ~a2)]
    [(not (none? a1)) (do
      (unless (or (none? a1) (instance? HySymbol a1))
        (raise (ValueError a1)))
      `(~method-name grid (first ~a1) (second ~a1)))]
    [True
      `(~method-name grid)]))

(defn solve [grid]
  (setv mines (set))
  (setv cleared (set))

  ; Start at the center.
  (g guess (// (g n-rows) 2) (// (g n-cols) 2))

  ; Main loop.
  (while (not (g solved?)) (block

    (for [visible (g iter-visible)]
      (when (in visible cleared)
        (continue))
      (setv ns (list (g iter-neighbors visible)))
      (setv n-mines-around (g n-mines-around visible))
      ; Clear all neighbors of 0-marked cells.
      (when (= n-mines-around 0)
        (for [neighbor ns]
          (when (not (g visible? neighbor))
            (g guess neighbor)))
        (.add cleared visible)
        (ret))
      ; Clear all unmarked neighbors of n-marked cells with
      ; exactly n marked neighbors.
      (when (= n-mines-around (len (filt (in it mines) ns)))
        (for [neighbor ns]
          (when (and (not (g visible? neighbor)) (not-in neighbor mines))
            (g guess neighbor)))
        (.add cleared visible)
        (ret))
      ; Mark all neighbors of n-marked cells with exactly n
      ; hidden neighbors.
      (when (= n-mines-around (g n-hidden-around visible))
        (for [neighbor ns]
          (when (and (not (g visible? neighbor)) (not-in neighbor mines))
            (.add mines neighbor)))
        (.add cleared visible)
        (ret)))

    ; Well, shoot, we're in an ambiguous situation. Choose a
    ; square that might not have a mine in it and hope for the
    ; best.

    (setv x (block

      (setv mine-probs {})
      (for [visible (g iter-visible)]
        (setv ns (list (g iter-neighbors visible)))
        (setv n-mines-around (g n-mines-around visible))
        (setv n-known (len (filt (in it mines) ns)))
        (when (> n-mines-around n-known)
          (setv maybes (filt
            (and (not (g visible? it)) (not-in it mines))
            ns))
          (for [m maybes]
            (setv (get mine-probs m) (max
              (.get mine-probs m 0)
              (/ (- n-mines-around n-known) (len maybes)))))))

      (setv uninformed-mine-prob (/
        (- (g n-mines) (len mines))
        (len (filt (not-in it mines) (g iter-hidden)))))

      (setv interior (list (g iter-interior)))

      (when (not mine-probs)
;        (print "no mine-probs")
        (ret (first interior)))

;      (print "(min (.values mine-probs))" (min (.values mine-probs)))
;      (print "uninformed-mine-prob" uninformed-mine-prob)

      (if (or (not interior) (< (min (.values mine-probs)) uninformed-mine-prob))
        (ret (first (first (kwc sorted (.items mine-probs) :key second))))
        ; Otherwise, select from the interior. Get the closest
        ; interior square to the "maybe" squares.
        (first (kwc sorted interior :key (fn [x] (sum (amap
          (+
            (abs (- (first x) (first it)))
            (abs (- (second x) (second it))))
          (.keys mine-probs)))))))))

;    (display grid mines x)
;    (print "")

    (g guess x))))

(defn display [grid mines spot]
  (for [r (range (g n-rows))]
    (print (.join "" (amap (cond
      [(= (, r it) spot)
        "*"]
      [(in (, r it) mines)
        "m"]
      [(not (g visible? r it))
        "?"]
      [(g n-mines-around r it)
        (str (g n-mines-around r it))]
      [True
        "."])
     (range (g n-cols)))))))

(import random)
(random.seed 8)
(testSolver solve)