; 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)