Advertisement
Guest User

Nim

a guest
Nov 13th, 2014
201
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (ns nim.core
  2.   (:require [clojure.string :as string])
  3.   (:gen-class))
  4.  
  5. (defn winning-heaps? [heaps]
  6.   (let [sum (reduce + heaps)]
  7.     (and
  8.      (or
  9.       (and (every? #(> 2 %) heaps) (odd? sum))
  10.       (zero? (reduce bit-xor heaps)))
  11.      (not (zero? sum)))))
  12.  
  13. (defn new-heaps [n min max]
  14.   (let [heaps (vec (repeatedly n #(+ min (rand-int (- (inc max) min)))))]
  15.     (if (winning-heaps? heaps)
  16.       (let [first-row (nth heaps 0)]
  17.         (if (== first-row max)
  18.           (assoc heaps 0 (dec first-row))
  19.           (assoc heaps 0 (inc first-row))))
  20.       heaps)))
  21.  
  22. (defn all-moves [heaps]
  23.   (->> heaps
  24.        (map-indexed (fn [index heap]
  25.                       (for [new-heap (range heap)]
  26.                         (assoc heaps index new-heap))))
  27.        (apply concat)))
  28.  
  29. (defn best-move [heaps]
  30.   (if (winning-heaps? heaps)
  31.     (first (for [new-heaps (all-moves heaps)
  32.                  :when (= (reduce + new-heaps) (dec (reduce + heaps)))] new-heaps))
  33.     (first (for [new-heaps (all-moves heaps)
  34.                  :when (winning-heaps? new-heaps)] new-heaps))))
  35.  
  36. (defn legal-move? [heaps move]
  37.   (some #(= move %) (all-moves heaps)))
  38.  
  39. (defn game-over? [heaps]
  40.   (every? zero? heaps))
  41.  
  42. (defn heap-string
  43.   [heaps]
  44.   (string/join (map-indexed (fn [row count]
  45.                                       (str row ": " (string/join (repeat count "I")) "\n"))
  46.                                     heaps)))
  47. (defn prompt
  48.   [msg]
  49.   (print (str msg " "))
  50.   (flush)
  51.   (read-line))
  52.  
  53. (defn prompt-int
  54.   [msg]
  55.   (try
  56.     (Integer. (prompt msg))
  57.     (catch Exception e (prompt-int msg))))
  58.  
  59. (defn input-move
  60.   [heaps]
  61.   (println (heap-string heaps))
  62.   (let [row (prompt-int "From which row do you want to remove?")
  63.         amount (prompt-int "How many do you want to leave?")]
  64.     (when (and (neg? row) (>= row (count heaps)))
  65.       (println "Illegal move!")
  66.       (input-move heaps))
  67.     (let [new-heaps (assoc heaps row amount)]
  68.       (if-not (legal-move? heaps new-heaps)
  69.         (do
  70.           (println "Illegal move!")
  71.           (input-move heaps))
  72.         new-heaps))))
  73.  
  74. (defn -main
  75.   [& args]
  76.   (loop [myturn false
  77.          heaps (new-heaps 3 3 9)]
  78.     (cond
  79.      (and (game-over? heaps) myturn) (println "You lost!")
  80.      (and (game-over? heaps) (not myturn)) (println "You won!")
  81.      :else (if myturn
  82.              (recur false (best-move heaps))
  83.              (recur true (input-move heaps))))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement