Skip to content

Commit c24768b

Browse files
vaibhavsagarvaibhavsagar
committed
Add 'battleship/' from commit '125e53f829aed3e18a398434f6d907039a6fea13'
git-subtree-dir: battleship git-subtree-mainline: ac18c59 git-subtree-split: 125e53f
2 parents ac18c59 + 125e53f commit c24768b

File tree

8 files changed

+388
-0
lines changed

8 files changed

+388
-0
lines changed

‎battleship/.gitignore

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
.ipynb_checkpoints
2+
.stack-work

‎battleship/Battleship.hs

+104
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,104 @@
1+
{-# LANGUAGE ScopedTypeVariables #-}
2+
3+
module Battleship where
4+
5+
import Control.Applicative ((<|>))
6+
import Control.Monad (replicateM)
7+
import Control.Monad.Trans.State.Strict
8+
import Data.Bool (bool)
9+
import System.Random (randomRIO)
10+
import qualified Data.Map.Strict as M
11+
import qualified Data.Set as S
12+
13+
data Row = R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10
14+
deriving (Bounded, Eq, Ord, Enum, Show)
15+
16+
data Col = Ca | Cb | Cc | Cd | Ce | Cf | Cg | Ch | Ci | Cj
17+
deriving (Bounded, Eq, Ord, Enum, Show)
18+
19+
data Coord = Coord Row Col deriving (Eq, Show, Ord)
20+
21+
data Ship = Patrol | Cruiser | Submarine | BattleShip | Carrier
22+
deriving (Eq, Ord, Show, Enum)
23+
24+
data Move = Miss | Hit deriving (Eq, Show)
25+
26+
data Player = Player1 | Player2 deriving (Eq, Show)
27+
28+
type Coords = S.Set Coord
29+
30+
type Board = M.Map Ship Coords
31+
32+
data Status = Won Player | InPlay deriving (Show)
33+
34+
data Game = Game
35+
{ player1Board :: Board
36+
, player1Track :: Coords
37+
, player2Board :: Board
38+
, player2Track :: Coords
39+
} deriving (Eq, Show)
40+
41+
safeToEnum :: forall a. (Enum a, Bounded a) => Int -> Maybe a
42+
safeToEnum from = bool (Just $ toEnum from) Nothing
43+
$ from < fromEnum (minBound :: a) || from > fromEnum (maxBound :: a)
44+
45+
safeFromTo :: (Enum a, Bounded a) => Int -> Int -> Maybe [a]
46+
safeFromTo from to = traverse safeToEnum [from..to]
47+
48+
makeHorizontal :: (Int, Int) -> Ship -> Maybe Coords
49+
makeHorizontal (x, y) ship = let
50+
len = fromEnum ship + 1
51+
rows = replicateM len (safeToEnum y)
52+
cols = safeFromTo x (x+len)
53+
in S.fromList . map (uncurry Coord) <$> (zip <$> rows <*> cols)
54+
55+
makeVertical :: (Int, Int) -> Ship -> Maybe Coords
56+
makeVertical (x, y) ship = let
57+
len = fromEnum ship + 1
58+
rows = safeFromTo y (y+len)
59+
cols = replicateM len (safeToEnum x)
60+
in S.fromList . map (uncurry Coord) <$> (zip <$> rows <*> cols)
61+
62+
place :: Ship -> Coords -> Board -> Board
63+
place = M.insert
64+
65+
allCoords :: Board -> Coords
66+
allCoords = S.unions . M.elems
67+
68+
pair :: IO (Int, Int)
69+
pair = (,) <$> r <*> r where r = randomRIO (0,9)
70+
71+
genBoard' :: [Ship] -> Board -> IO Board
72+
genBoard' [] board = return board
73+
genBoard' (s:ss) board = pair >>= \p ->
74+
case makeHorizontal p s <|> makeVertical p s of
75+
Just cs | S.null $ S.intersection cs (allCoords board) ->
76+
genBoard' ss $ place s cs board
77+
_ -> genBoard' (s:ss) board
78+
79+
genBoard :: IO Board
80+
genBoard = genBoard' [Carrier, BattleShip, Submarine, Patrol, Cruiser] M.empty
81+
82+
makeAttackingMove :: Player -> Coord -> State Game Move
83+
makeAttackingMove Player1 coord = get >>= \game -> let
84+
move = bool Miss Hit (coord `S.member` allCoords (player2Board game))
85+
p1t = S.insert coord $ player1Track game
86+
in put game {player1Track = p1t} >> return move
87+
makeAttackingMove Player2 coord = get >>= \game -> let
88+
move = bool Miss Hit (coord `S.member` allCoords (player1Board game))
89+
p2t = S.insert coord $ player2Track game
90+
in put game {player2Track = p2t} >> return move
91+
92+
status :: State Game Status
93+
status = get >>= \game -> let
94+
p1b = allCoords $ player1Board game
95+
p2t = S.intersection (player2Track game) p1b
96+
p2b = allCoords $ player2Board game
97+
p1t = S.intersection (player2Track game) p2b
98+
in return $ case () of
99+
_ | p1t == p2b -> Won Player1
100+
| p2t == p1b -> Won Player2
101+
| otherwise -> InPlay
102+
103+
emptyGame :: Game
104+
emptyGame = Game M.empty S.empty M.empty S.empty

‎battleship/LICENSE

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright Vaibhav Sagar (c) 2016
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of Vaibhav Sagar nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎battleship/README.md

Whitespace-only changes.

‎battleship/Setup.hs

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

‎battleship/battleship.cabal

+28
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
name: battleship
2+
version: 0.1.0.0
3+
synopsis: Initial project template from stack
4+
description: Please see README.md
5+
homepage: https://github.com/vaibhavsagar/battleship#readme
6+
license: BSD3
7+
license-file: LICENSE
8+
author: Vaibhav Sagar
9+
maintainer: [email protected]
10+
copyright: 2016 Vaibhav Sagar
11+
category: Web
12+
build-type: Simple
13+
-- extra-source-files:
14+
cabal-version: >=1.10
15+
16+
library
17+
hs-source-dirs: .
18+
exposed-modules: Battleship
19+
build-depends: base >= 4.7 && < 5
20+
, containers
21+
, transformers
22+
, random
23+
default-language: Haskell2010
24+
25+
26+
source-repository head
27+
type: git
28+
location: https://github.com/vaibhavsagar/battleship

‎battleship/notebooks/Battleship.ipynb

+156
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,156 @@
1+
{
2+
"cells": [
3+
{
4+
"cell_type": "code",
5+
"execution_count": 1,
6+
"metadata": {
7+
"collapsed": false,
8+
"deletable": true,
9+
"editable": true
10+
},
11+
"outputs": [],
12+
"source": [
13+
"import Battleship\n",
14+
"import Control.Monad.Trans.State.Strict\n",
15+
"import qualified Data.Set as S\n",
16+
"import qualified Data.Map.Strict as M"
17+
]
18+
},
19+
{
20+
"cell_type": "code",
21+
"execution_count": 2,
22+
"metadata": {
23+
"collapsed": false,
24+
"deletable": true,
25+
"editable": true
26+
},
27+
"outputs": [
28+
{
29+
"data": {
30+
"text/plain": [
31+
"(Hit,Game {player1Board = fromList [(Patrol,fromList [Coord R7 Ce]),(Cruiser,fromList [Coord R9 Cg,Coord R9 Ch]),(Submarine,fromList [Coord R5 Cg,Coord R5 Ch,Coord R5 Ci]),(BattleShip,fromList [Coord R4 Ce,Coord R4 Cf,Coord R4 Cg,Coord R4 Ch]),(Carrier,fromList [Coord R1 Ca,Coord R1 Cb,Coord R1 Cc,Coord R1 Cd,Coord R1 Ce])], player1Track = fromList [Coord R4 Ci], player2Board = fromList [(Patrol,fromList [Coord R2 Ch]),(Cruiser,fromList [Coord R8 Cf,Coord R8 Cg]),(Submarine,fromList [Coord R7 Ce,Coord R7 Cf,Coord R7 Cg]),(BattleShip,fromList [Coord R3 Ci,Coord R4 Ci,Coord R5 Ci,Coord R6 Ci]),(Carrier,fromList [Coord R3 Cj,Coord R4 Cj,Coord R5 Cj,Coord R6 Cj,Coord R7 Cj])], player2Track = fromList []})"
32+
]
33+
},
34+
"metadata": {},
35+
"output_type": "display_data"
36+
},
37+
{
38+
"data": {
39+
"text/plain": [
40+
"(InPlay,Game {player1Board = fromList [(Patrol,fromList [Coord R7 Ce]),(Cruiser,fromList [Coord R9 Cg,Coord R9 Ch]),(Submarine,fromList [Coord R5 Cg,Coord R5 Ch,Coord R5 Ci]),(BattleShip,fromList [Coord R4 Ce,Coord R4 Cf,Coord R4 Cg,Coord R4 Ch]),(Carrier,fromList [Coord R1 Ca,Coord R1 Cb,Coord R1 Cc,Coord R1 Cd,Coord R1 Ce])], player1Track = fromList [Coord R4 Ci], player2Board = fromList [(Patrol,fromList [Coord R2 Ch]),(Cruiser,fromList [Coord R8 Cf,Coord R8 Cg]),(Submarine,fromList [Coord R7 Ce,Coord R7 Cf,Coord R7 Cg]),(BattleShip,fromList [Coord R3 Ci,Coord R4 Ci,Coord R5 Ci,Coord R6 Ci]),(Carrier,fromList [Coord R3 Cj,Coord R4 Cj,Coord R5 Cj,Coord R6 Cj,Coord R7 Cj])], player2Track = fromList []})"
41+
]
42+
},
43+
"metadata": {},
44+
"output_type": "display_data"
45+
}
46+
],
47+
"source": [
48+
"randomBoard1 <- genBoard\n",
49+
"randomBoard2 <- genBoard\n",
50+
"board' = runState (makeAttackingMove Player1 (Coord R4 Ci)) emptyGame {player1Board = randomBoard1, player2Board = randomBoard2}\n",
51+
"board'\n",
52+
"runState status (snd board')"
53+
]
54+
},
55+
{
56+
"cell_type": "code",
57+
"execution_count": 3,
58+
"metadata": {
59+
"collapsed": false,
60+
"deletable": true,
61+
"editable": true
62+
},
63+
"outputs": [
64+
{
65+
"data": {
66+
"text/plain": [
67+
"#####.....\n",
68+
"..........\n",
69+
"..........\n",
70+
"....####..\n",
71+
"......###.\n",
72+
"..........\n",
73+
"....#.....\n",
74+
"..........\n",
75+
"......##..\n",
76+
".........."
77+
]
78+
},
79+
"metadata": {},
80+
"output_type": "display_data"
81+
},
82+
{
83+
"data": {
84+
"text/plain": [
85+
"..........\n",
86+
".......#..\n",
87+
"........##\n",
88+
"........##\n",
89+
"........##\n",
90+
"........##\n",
91+
"....###..#\n",
92+
".....##...\n",
93+
"..........\n",
94+
".........."
95+
]
96+
},
97+
"metadata": {},
98+
"output_type": "display_data"
99+
}
100+
],
101+
"source": [
102+
"everyCoord :: [[Coord]]\n",
103+
"everyCoord = [[Coord (toEnum i) (toEnum j) |j <- [0..9]] | i <- [0..9]]\n",
104+
"\n",
105+
"displayBoard board = let\n",
106+
" allC = allCoords board\n",
107+
" fill = \\p -> if (p `S.member` allC) then '#' else '.'\n",
108+
" occ = map (map fill) everyCoord\n",
109+
" in unlines occ\n",
110+
"\n",
111+
"putStr $ displayBoard randomBoard1\n",
112+
"putStr $ displayBoard randomBoard2"
113+
]
114+
},
115+
{
116+
"cell_type": "code",
117+
"execution_count": 21,
118+
"metadata": {
119+
"collapsed": false,
120+
"deletable": true,
121+
"editable": true
122+
},
123+
"outputs": [],
124+
"source": [
125+
"map :: (a -> b) -> [a] -> [b]\n",
126+
"map f xs = foldr ((:) . f) [] xs"
127+
]
128+
},
129+
{
130+
"cell_type": "code",
131+
"execution_count": null,
132+
"metadata": {
133+
"collapsed": true,
134+
"deletable": true,
135+
"editable": true
136+
},
137+
"outputs": [],
138+
"source": []
139+
}
140+
],
141+
"metadata": {
142+
"kernelspec": {
143+
"display_name": "Haskell",
144+
"language": "haskell",
145+
"name": "haskell"
146+
},
147+
"language_info": {
148+
"codemirror_mode": "ihaskell",
149+
"file_extension": ".hs",
150+
"name": "haskell",
151+
"version": "8.0.2"
152+
}
153+
},
154+
"nbformat": 4,
155+
"nbformat_minor": 0
156+
}

‎battleship/stack.yaml

+66
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
# This file was automatically generated by 'stack init'
2+
#
3+
# Some commonly used options have been documented as comments in this file.
4+
# For advanced use and comprehensive documentation of the format, please see:
5+
# http://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+
# A snapshot resolver dictates the compiler version and the set of packages
9+
# to be used for project dependencies. For example:
10+
#
11+
# resolver: lts-3.5
12+
# resolver: nightly-2015-09-21
13+
# resolver: ghc-7.10.2
14+
# resolver: ghcjs-0.1.0_ghc-7.10.2
15+
# resolver:
16+
# name: custom-snapshot
17+
# location: "./custom-snapshot.yaml"
18+
resolver: lts-6.30
19+
20+
# User packages to be built.
21+
# Various formats can be used as shown in the example below.
22+
#
23+
# packages:
24+
# - some-directory
25+
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
26+
# - location:
27+
# git: https://github.com/commercialhaskell/stack.git
28+
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
29+
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
30+
# extra-dep: true
31+
# subdirs:
32+
# - auto-update
33+
# - wai
34+
#
35+
# A package marked 'extra-dep: true' will only be built if demanded by a
36+
# non-dependency (i.e. a user package), and its test suites and benchmarks
37+
# will not be run. This is useful for tweaking upstream packages.
38+
packages:
39+
- '.'
40+
# Dependency packages to be pulled from upstream that are not in the resolver
41+
# (e.g., acme-missiles-0.3)
42+
extra-deps: []
43+
44+
# Override default flag values for local packages and extra-deps
45+
flags: {}
46+
47+
# Extra package databases containing global packages
48+
extra-package-dbs: []
49+
50+
# Control whether we use the GHC we find on the path
51+
# system-ghc: true
52+
#
53+
# Require a specific version of stack, using version ranges
54+
# require-stack-version: -any # Default
55+
# require-stack-version: ">=1.2"
56+
#
57+
# Override the architecture used by stack, especially useful on Windows
58+
# arch: i386
59+
# arch: x86_64
60+
#
61+
# Extra directories used by stack for building
62+
# extra-include-dirs: [/path/to/dir]
63+
# extra-lib-dirs: [/path/to/dir]
64+
#
65+
# Allow a newer minor version of GHC than the snapshot specifies
66+
# compiler-check: newer-minor

0 commit comments

Comments
 (0)