Permalink
Browse files

Everything works!

  • Loading branch information...
mthvedt committed Sep 23, 2011
1 parent 6fcfb4b commit caea9b7c60644ce3100780d7294bf56ae20d074d
Showing with 99 additions and 76 deletions.
  1. +1 −0 .gitignore
  2. BIN src/battleship/.DS_Store
  3. +28 −24 src/battleship/ai.clj
  4. +39 −3 src/battleship/core.clj
  5. +31 −49 src/battleship/game.clj
View
@@ -5,3 +5,4 @@ pom.xml
.lein-failures
.lein-deps-sum
*.swp
+.DS_Store
View
Binary file not shown.
View
@@ -6,50 +6,53 @@
; Helper for infinite-seq. Given a square on a board, tells what the AI
; is "allowed to know" about it. A square may have one of the given pieces,
; not have a ship (blocked), or be unknown.
-(defn get-knowledge [square pieces-map]
+(defn get-knowledge [square mypieces]
(if (= :struck (:state square))
- (if (nil? (get pieces-map (:piece square)))
+ (if (nil? (get mypieces (:piece square)))
:blocked ; There's a sunk ship or no ship here
:has-ship) ; We know there's an unsunk ship here
:unknown)) ; We don't know what's here
(def all-coordinates (for [x (range 10) y (range 10)] [x y]))
-(defn knowledge-map [known-board pieces-map]
+(defn knowledge-map [known-board mypieces]
(zipmap all-coordinates
(for [[x y] all-coordinates]
- (get-knowledge (get-square known-board x y) pieces-map))))
+ (get-knowledge (get-square known-board x y) mypieces))))
; Square validator (see 'place-all-pieces) that rejects any square
; which is known to be blocked.
(defn blocked-square-validator [kmap]
- (fn [_ x y] (not (= :blocked (get kmap [x y])))))
+ (fn [_ x y]
+ ; (print "v" x y (not (= :blocked (get kmap [x y]))))
+ (not (= :blocked (get kmap [x y])))))
; Makes sure that, for some board, all squares known to have a ship
; do in fact have a ship.
(defn struck-square-checker [candidate-board kmap]
- (loop [coordinate (first all-coordinates)
- coordinates (rest all-coordinates)]
- (if (nil? coordinate)
- true ; loop over
- (let [[x y] coordinate]
- (if (= :has-ship (get kmap coordinate))
- (if (nil? (:piece (get-square candidate-board x y)))
- false ; square should have a ship, but it didn't
- (recur (first coordinates) (rest coordinates)))
- (recur (first coordinates) (rest coordinates)))))))
+ (let [rval (loop [coordinate (first all-coordinates)
+ coordinates (rest all-coordinates)]
+ (if (nil? coordinate)
+ true ; loop over
+ (let [[x y] coordinate]
+ (if (= :has-ship (get kmap coordinate))
+ (if (nil? (:piece (get-square candidate-board x y)))
+ false ; square should have a ship, but it didn't
+ (recur (first coordinates) (rest coordinates)))
+ (recur (first coordinates) (rest coordinates))))))]
+ rval))
; Given a known-board, containing struck and unstruck squares,
; and pieces, containing unsunk ships;
; generates an infinite sequence of possible boards
; that match these criteria.
-(defn infinite-boards [known-board pieces-map]
- (let [kmap (knowledge-map known-board pieces-map)]
- (println kmap)
+(defn infinite-boards [known-board mypieces]
+ (let [kmap (knowledge-map known-board mypieces)]
+ ;(println (sort kmap))
+ ;(println mypieces)
(filter #(struck-square-checker % kmap)
- (repeatedly #(place-all-pieces
- newboard pieces
- (blocked-square-validator kmap))))))
+ (repeatedly #(place-all-pieces newboard mypieces
+ (blocked-square-validator kmap))))))
; 1 if we might want to shoot that square, 0 otherwise
(defn is-target [square]
@@ -69,11 +72,12 @@
; to play much better with eager seqs than lazy ones.
(defn get-distribution [boardseq]
(reduce (fn [running-count board]
+ ;(println "reducing")
(doall (map (fn [running-count-row row]
(doall (map + running-count-row
(map is-target row))))
running-count board)))
- (repeat (repeat 0.0)) boardseq))
+ (repeat (repeat 0)) boardseq))
; Gets the most valuable target to fire upon. Returns the coordinates.
(defn get-target-from-dist [theboard dist]
@@ -88,5 +92,5 @@
(defn get-target [theboard theseq search-size]
(let [dist (get-distribution (take search-size theseq))]
- (dorun (map println dist))
- (get-target-from-dist theboard dist)))
+ ;(dorun (map println dist))
+ (get-target-from-dist theboard dist)))
View
@@ -22,12 +22,15 @@
["submarine" 3]
["destroyer" 2]])
+(def pieces-map (reduce conj {} pieces))
+
; places a piece on the board, or nil if it can't be placed according
; to the given validator fn
; the validator function should take in the original board, x, and y
(defn place-piece [board0 [piecename piecelen] x0 y0 is-horizontal validator]
(let [xstep (if is-horizontal 1 0)
ystep (if is-horizontal 0 1)]
+ ;(print "p:" x0 y0 is-horizontal)
(loop [board board0 x x0 y y0 i 0]
(if (= i piecelen)
board
@@ -38,6 +41,7 @@
; try once to place a piece, return nil if failed
(defn randomly-try-place-piece [board [piecename piecelen] validator]
+ ;(print "rtpp:" piecename piecelen)
(let [is-horizontal (= (rand-int 2) 0)
coord-a (rand-int board-size)
; subtract piecelen; make sure the piece doesn't overflow off the board
@@ -50,6 +54,7 @@
; works by making an infinite sequence of randomly-try-place-piece calls
; and pulling the first one
(defn randomly-place-piece [board piece validator]
+ ;(print "rpp:" piece)
(first (remove nil? (repeatedly
#(randomly-try-place-piece board piece validator)))))
@@ -59,6 +64,37 @@
#(nil? (:piece (get-square % %2 %3)))))
; Places all the given pieces on teh given board according
; to a given validator.
- ([board pieces validator] (reduce
- #(randomly-place-piece % %2 validator)
- board pieces)))
+ ([board mypieces validator] ;(print "a")
+ (reduce
+ #(randomly-place-piece % %2 validator)
+ board mypieces)))
+
+(defn get-square-str [{piece :piece, state :state} pieces is-friendly]
+ (case state
+ :struck (if (nil? piece) "."
+ (if (zero? (get pieces piece)) "#"
+ "*"))
+ :unstruck (if (and is-friendly (not (nil? piece))) "O" " ")))
+
+; Concatenate all the things then apply str. Not the same as C 'strcat'
+(defn strcat [& things] (apply str (apply concat things)))
+
+; A sequence of strs (lines) representing a board
+; each str has the same length, making this a 13x13 char grid
+(defn get-board-strs [board pieces is-friendly]
+ (let [top-bottom-border (strcat " +" (repeat board-size "-") "+")]
+ (concat
+ [(strcat " " (range 10) " ")]
+ [top-bottom-border]
+ (map (fn [char-num row]
+ (strcat [(char char-num)] "|"
+ (map #(get-square-str %
+ pieces
+ is-friendly)
+ row) "|"))
+ (range (int \A) (int \K)) board)
+ [top-bottom-border])))
+
+; good for debugging
+(defn print-board [board]
+ (dorun (map println (get-board-strs board pieces true))))
View
@@ -6,54 +6,26 @@
(defrecord DecoratedBoard [board pieces action])
(defn new-decorated-board []
- (DecoratedBoard. (place-all-pieces newboard) (reduce conj {} pieces) nil))
+ (DecoratedBoard. (place-all-pieces newboard) pieces-map nil))
; Returns a str representing a square
-(defn get-square-str [{piece :piece, state :state} pieces is-friendly]
- (case state
- :struck (if (nil? piece) "."
- (if (zero? (get pieces piece)) "#"
- "*"))
- :unstruck (if (and is-friendly (not (nil? piece))) "O" " ")))
-
-; Concatenate all the things then apply str. Not the same as C 'strcat'
-(defn strcat [& things] (apply str (apply concat things)))
-
-; A sequence of strs (lines) representing a board
-; each str has the same length, making this a 13x13 char grid
-(defn get-board-strs [dboard is-friendly]
- (let [top-bottom-border (strcat " +" (repeat board-size "-") "+")]
- (concat
- [(strcat " " (range 10) " ")]
- [top-bottom-border]
- (map (fn [char-num row]
- (strcat [(char char-num)] "|"
- (map #(get-square-str %
- (:pieces dboard)
- is-friendly)
- row) "|"))
- (range (int \A) (int \K)) (:board dboard))
- [top-bottom-border])))
-
-; good for debugging
-(defn print-board [board]
- (dorun (map println (get-board-strs (DecoratedBoard. board nil nil) true))))
-
(defn print-message [dboard is-friendly]
nil)
; If all pieces have no HP, the game is over for that player
-(defn board-won? [dboard]
+(defn board-lost? [dboard]
(zero? (apply + (vals (:pieces dboard)))))
(defn game-won? [game]
- (or (board-won? (:board1 game)) (board-won? (:board2 game))))
+ (or (board-lost? (:board1 game)) (board-lost? (:board2 game))))
+; 0 for nobody, 1 for player, 2 for computer
(defn get-winner [game]
- (if (board-won? {:board1 game})
- 1
- (if (board-won? {:board2 game}) 2 0)))
+ (if (board-lost? (:board1 game))
+ 2
+ (if (board-lost? (:board2 game)) 1 0)))
+; canonically, board1 is player's board (he fires upon board2)
(defrecord Game [board1 board2])
(defn newgame []
(Game. (new-decorated-board)
@@ -71,16 +43,17 @@
:missed "It's a miss."
:struck "It's a hit!"
:sunk (str (if is-player
- "You sunk my "
- "I sunk your ") (first more) "!")))))
+ "***You sunk my "
+ "***I sunk your ") (first more) "!***")))))
; Print a game to *out*
(defn printgame [{dboard1 :board1, dboard2 :board2}]
(print-message dboard2 true) (print-message dboard1 false)
(println (str "My board" " " "Your board"))
(dorun (map println
- (get-board-strs dboard2 false) (repeat " ")
- (get-board-strs dboard1 true))))
+ (get-board-strs (:board dboard2) (:pieces dboard2) false)
+ (repeat " ")
+ (get-board-strs (:board dboard1) (:pieces dboard1) true))))
; Helper fns for 'fire
(defn miss [dboard x y target]
@@ -110,7 +83,7 @@
(miss dboard x y target)
(hit dboard x y target))))
-(def ai-search 50)
+(def ai-search 100)
; Turn for the AI. Returns [modified game, modified ai-dist]
(defn do-computer-turn [game]
@@ -120,23 +93,25 @@
board1
; remove all dead pieces from the 'pieces set'
; before passing to infinite-boards
- (reduce conj {}
- (remove #(= 0 (second %)) (:pieces dboard1))))
- [x y] (get-target board1 board-samples 1000)
+ (select-keys pieces-map
+ (map first
+ (remove #(= 0 (second %))
+ (:pieces dboard1)))))
+ [x y] (get-target board1 board-samples ai-search)
was-occupied (not (nil? (:piece (get-square board1 x y))))
newdboard1 (fire dboard1 x y)]
(assoc game :board1 newdboard1)))
; Helper fns for the battleship main loop
; All fns below interact with the in and out streamsh
(defn is-valid-coord [coordinate]
- (or (>= coordinate 0) (< coordinate 10)))
+ (and (>= coordinate 0) (< coordinate 10)))
(defn print-endgame [game]
(let [winner (get-winner game)]
(if (= winner 1)
- (println "***YOU WIN!***")
- (println "***YOU LOSE!***"))))
+ (println "*** YOU WIN! ***")
+ (println "*** YOU LOSE! ***"))))
; Parse input and fire
(defn do-player-turn [game]
@@ -153,6 +128,13 @@
(do
(println "Please input valid coordinates.")
(recur game)) ; Go back to beginning, try again
+ (not (nil? (nth (concat (filter #(not (Character/isWhitespace %))
+ input-line)
+ (repeat nil)) ; prevent NPE
+ 2))) ; more than 2 things were input
+ (do
+ (println "Please input just a letter and a number.")
+ (recur game))
true
(let [uppercase-letter (if (>= (int letter) (int \a))
(char (- (int letter) 32))
@@ -172,13 +154,13 @@
(println
"Welcome to Battleship. Input some coordinates to fire, or 'Q' to quit.")
(loop [game (newgame)]
- (dotimes [i 10] (println))
+ (dotimes [i 8] (println))
(printgame game)
(if (game-won? game)
(print-endgame game) ; do not recur, terminate
(let [game (do-player-turn game)]
(cond
(nil? game) nil
- (game-won? game) (print-endgame game)
+ (game-won? game) (do (printgame game) (print-endgame game))
true (recur (do-computer-turn game))))))
(flush))

0 comments on commit caea9b7

Please sign in to comment.