module Combinatorics.Battleship.Enumeration where
import Combinatorics.Battleship
(Fleet, ShipSize, Orientation(..), Ship(Ship), Board(Board), )
import Combinatorics (tuples)
import Data.Map (Map, )
import Data.Set (Set, )
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.Trans.Class as MT
import Control.Monad (liftM2, guard, when, )
import Data.List.HT (tails, )
import Data.Bool.HT (if', )
import qualified System.IO as IO
insertShip :: Ship -> Board -> Board
insertShip :: Ship -> Board -> Board
insertShip Ship
ship (Board (Int, Int)
bnds Set (Int, Int)
set) =
(Int, Int) -> Set (Int, Int) -> Board
Board (Int, Int)
bnds (Set (Int, Int) -> Board) -> Set (Int, Int) -> Board
forall a b. (a -> b) -> a -> b
$ Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Int, Int)
set (Set (Int, Int) -> Set (Int, Int))
-> Set (Int, Int) -> Set (Int, Int)
forall a b. (a -> b) -> a -> b
$ Ship -> Set (Int, Int)
shipArea Ship
ship
shipArea :: Ship -> Set (Int, Int)
shipArea :: Ship -> Set (Int, Int)
shipArea (Ship Int
size Orientation
orient (Int
x,Int
y)) =
[(Int, Int)] -> Set (Int, Int)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(Int, Int)] -> Set (Int, Int)) -> [(Int, Int)] -> Set (Int, Int)
forall a b. (a -> b) -> a -> b
$
case Orientation
orient of
Orientation
Horizontal -> (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Int
y) [Int
x .. Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
Orientation
Vertical -> (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) Int
x) [Int
y .. Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
reduceSpace :: Ship -> Board -> Board
reduceSpace :: Ship -> Board -> Board
reduceSpace Ship
ship (Board (Int, Int)
bnds Set (Int, Int)
set) =
(Int, Int) -> Set (Int, Int) -> Board
Board (Int, Int)
bnds (Set (Int, Int) -> Board) -> Set (Int, Int) -> Board
forall a b. (a -> b) -> a -> b
$
Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (Int, Int)
set (Set (Int, Int) -> Set (Int, Int))
-> Set (Int, Int) -> Set (Int, Int)
forall a b. (a -> b) -> a -> b
$
Ship -> Set (Int, Int)
shipOutline Ship
ship
shipOutline :: Ship -> Set (Int, Int)
shipOutline :: Ship -> Set (Int, Int)
shipOutline (Ship Int
size Orientation
orient (Int
x,Int
y)) =
[(Int, Int)] -> Set (Int, Int)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(Int, Int)] -> Set (Int, Int)) -> [(Int, Int)] -> Set (Int, Int)
forall a b. (a -> b) -> a -> b
$
case Orientation
orient of
Orientation
Horizontal -> (Int -> Int -> (Int, Int)) -> [Int] -> [Int] -> [(Int, Int)]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
size] [Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1]
Orientation
Vertical -> (Int -> Int -> (Int, Int)) -> [Int] -> [Int] -> [(Int, Int)]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1] [Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
size]
data Box = Box (Int, Int) (Int, Int)
shipBounds :: Ship -> Box
shipBounds :: Ship -> Box
shipBounds (Ship Int
size Orientation
orient (Int
x,Int
y)) =
case Orientation
orient of
Orientation
Horizontal -> (Int, Int) -> (Int, Int) -> Box
Box (Int
x,Int
y) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
y)
Orientation
Vertical -> (Int, Int) -> (Int, Int) -> Box
Box (Int
x,Int
y) (Int
x, Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
moveShip :: (Int, Int) -> Ship -> Ship
moveShip :: (Int, Int) -> Ship -> Ship
moveShip (Int
dx,Int
dy) (Ship Int
size Orientation
orient (Int
x,Int
y)) =
Int -> Orientation -> (Int, Int) -> Ship
Ship Int
size Orientation
orient (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dx, Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dy)
mergeBox :: Box -> Box -> Box
mergeBox :: Box -> Box -> Box
mergeBox (Box (Int
a0x,Int
a0y) (Int
a1x,Int
a1y)) (Box (Int
b0x,Int
b0y) (Int
b1x,Int
b1y)) =
(Int, Int) -> (Int, Int) -> Box
Box (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a0x Int
b0x, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a0y Int
b0y) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a1x Int
b1x, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a1y Int
b1y)
intersectBox :: Box -> Box -> Box
intersectBox :: Box -> Box -> Box
intersectBox (Box (Int
a0x,Int
a0y) (Int
a1x,Int
a1y)) (Box (Int
b0x,Int
b0y) (Int
b1x,Int
b1y)) =
(Int, Int) -> (Int, Int) -> Box
Box (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a0x Int
b0x, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a0y Int
b0y) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a1x Int
b1x, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a1y Int
b1y)
boxSizes :: Box -> (Int, Int)
boxSizes :: Box -> (Int, Int)
boxSizes (Box (Int
a0x,Int
a0y) (Int
a1x,Int
a1y)) = (Int
a1x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a0x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
a1y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a0y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
emptyBoard :: (Int, Int) -> Board
emptyBoard :: (Int, Int) -> Board
emptyBoard (Int, Int)
bnds = (Int, Int) -> Set (Int, Int) -> Board
Board (Int, Int)
bnds Set (Int, Int)
forall a. Set a
Set.empty
fullBoard :: (Int, Int) -> Board
fullBoard :: (Int, Int) -> Board
fullBoard bnds :: (Int, Int)
bnds@(Int
width,Int
height) =
(Int, Int) -> Set (Int, Int) -> Board
Board (Int, Int)
bnds (Set (Int, Int) -> Board) -> Set (Int, Int) -> Board
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Set (Int, Int)
forall a. Eq a => [a] -> Set a
Set.fromAscList ([(Int, Int)] -> Set (Int, Int)) -> [(Int, Int)] -> Set (Int, Int)
forall a b. (a -> b) -> a -> b
$
(Int -> Int -> (Int, Int)) -> [Int] -> [Int] -> [(Int, Int)]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Int
0 .. Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
boardFromShips :: (Int, Int) -> [Ship] -> Board
boardFromShips :: (Int, Int) -> [Ship] -> Board
boardFromShips (Int, Int)
bnds =
(Board -> Ship -> Board) -> Board -> [Ship] -> Board
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Ship -> Board -> Board) -> Board -> Ship -> Board
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ship -> Board -> Board
insertShip) ((Int, Int) -> Board
emptyBoard (Int, Int)
bnds)
formatBoard :: Board -> String
formatBoard :: Board -> String
formatBoard (Board (Int
width,Int
height) Set (Int, Int)
set) =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
(\Int
y ->
(Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map
(\Int
x -> if (Int, Int) -> Set (Int, Int) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Int
x,Int
y) Set (Int, Int)
set then Char
'x' else Char
'.')
[Int
0 .. Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
[Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
charmapFromShip :: Ship -> Map (Int, Int) Char
charmapFromShip :: Ship -> Map (Int, Int) Char
charmapFromShip (Ship Int
size Orientation
orient (Int
x,Int
y)) =
[((Int, Int), Char)] -> Map (Int, Int) Char
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([((Int, Int), Char)] -> Map (Int, Int) Char)
-> [((Int, Int), Char)] -> Map (Int, Int) Char
forall a b. (a -> b) -> a -> b
$
case Orientation
orient of
Orientation
Horizontal ->
((Int
x,Int
y), Char
'<') ((Int, Int), Char) -> [((Int, Int), Char)] -> [((Int, Int), Char)]
forall a. a -> [a] -> [a]
:
(Int -> ((Int, Int), Char)) -> [Int] -> [((Int, Int), Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> ((Int
k,Int
y), Char
'-')) [Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2] [((Int, Int), Char)]
-> [((Int, Int), Char)] -> [((Int, Int), Char)]
forall a. [a] -> [a] -> [a]
++
((Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
y), Char
'>') ((Int, Int), Char) -> [((Int, Int), Char)] -> [((Int, Int), Char)]
forall a. a -> [a] -> [a]
:
[]
Orientation
Vertical ->
((Int
x,Int
y), Char
'A') ((Int, Int), Char) -> [((Int, Int), Char)] -> [((Int, Int), Char)]
forall a. a -> [a] -> [a]
:
(Int -> ((Int, Int), Char)) -> [Int] -> [((Int, Int), Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> ((Int
x,Int
k), Char
'|')) [Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2] [((Int, Int), Char)]
-> [((Int, Int), Char)] -> [((Int, Int), Char)]
forall a. [a] -> [a] -> [a]
++
((Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Char
'V') ((Int, Int), Char) -> [((Int, Int), Char)] -> [((Int, Int), Char)]
forall a. a -> [a] -> [a]
:
[]
formatShips :: (Int, Int) -> [Ship] -> String
formatShips :: (Int, Int) -> [Ship] -> String
formatShips (Int
width,Int
height) [Ship]
ships =
let charMap :: Map (Int, Int) Char
charMap = [Map (Int, Int) Char] -> Map (Int, Int) Char
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map (Int, Int) Char] -> Map (Int, Int) Char)
-> [Map (Int, Int) Char] -> Map (Int, Int) Char
forall a b. (a -> b) -> a -> b
$ (Ship -> Map (Int, Int) Char) -> [Ship] -> [Map (Int, Int) Char]
forall a b. (a -> b) -> [a] -> [b]
map Ship -> Map (Int, Int) Char
charmapFromShip [Ship]
ships
in [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
(\Int
y ->
(Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map
(\Int
x -> Char -> (Int, Int) -> Map (Int, Int) Char -> Char
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Char
'.' (Int
x,Int
y) Map (Int, Int) Char
charMap)
[Int
0 .. Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
[Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
tryShip ::
Bool -> Ship -> MS.StateT (Set (Int,Int)) [] Ship
tryShip :: Bool -> Ship -> StateT (Set (Int, Int)) [] Ship
tryShip Bool
outline Ship
ship = do
Bool -> StateT (Set (Int, Int)) [] ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT (Set (Int, Int)) [] ())
-> StateT (Set (Int, Int)) [] Bool -> StateT (Set (Int, Int)) [] ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Set (Int, Int) -> Bool) -> StateT (Set (Int, Int)) [] Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (Set (Int, Int) -> Set (Int, Int) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf (Ship -> Set (Int, Int)
shipArea Ship
ship))
(Set (Int, Int) -> Set (Int, Int)) -> StateT (Set (Int, Int)) [] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify ((Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int))
-> Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Bool
-> (Ship -> Set (Int, Int))
-> (Ship -> Set (Int, Int))
-> Ship
-> Set (Int, Int)
forall a. Bool -> a -> a -> a
if' Bool
outline Ship -> Set (Int, Int)
shipOutline Ship -> Set (Int, Int)
shipArea Ship
ship))
Ship -> StateT (Set (Int, Int)) [] Ship
forall (m :: * -> *) a. Monad m => a -> m a
return Ship
ship
tryShipsOfOneSize ::
Bool -> Int -> Int ->
MS.StateT (Set (Int,Int)) [] [Ship]
tryShipsOfOneSize :: Bool -> Int -> Int -> StateT (Set (Int, Int)) [] [Ship]
tryShipsOfOneSize Bool
outline Int
size Int
number =
((Orientation, (Int, Int)) -> StateT (Set (Int, Int)) [] Ship)
-> [(Orientation, (Int, Int))] -> StateT (Set (Int, Int)) [] [Ship]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Ship -> StateT (Set (Int, Int)) [] Ship
tryShip Bool
outline (Ship -> StateT (Set (Int, Int)) [] Ship)
-> ((Orientation, (Int, Int)) -> Ship)
-> (Orientation, (Int, Int))
-> StateT (Set (Int, Int)) [] Ship
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Orientation -> (Int, Int) -> Ship)
-> (Orientation, (Int, Int)) -> Ship
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Orientation -> (Int, Int) -> Ship
Ship Int
size))
([(Orientation, (Int, Int))] -> StateT (Set (Int, Int)) [] [Ship])
-> StateT (Set (Int, Int)) [] [(Orientation, (Int, Int))]
-> StateT (Set (Int, Int)) [] [Ship]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[(Orientation, (Int, Int))]]
-> StateT (Set (Int, Int)) [] [(Orientation, (Int, Int))]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift
([[(Orientation, (Int, Int))]]
-> StateT (Set (Int, Int)) [] [(Orientation, (Int, Int))])
-> StateT (Set (Int, Int)) [] [[(Orientation, (Int, Int))]]
-> StateT (Set (Int, Int)) [] [(Orientation, (Int, Int))]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Set (Int, Int) -> [[(Orientation, (Int, Int))]])
-> StateT (Set (Int, Int)) [] [[(Orientation, (Int, Int))]]
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (Int -> [(Orientation, (Int, Int))] -> [[(Orientation, (Int, Int))]]
forall a. Int -> [a] -> [[a]]
tuples Int
number ([(Orientation, (Int, Int))] -> [[(Orientation, (Int, Int))]])
-> (Set (Int, Int) -> [(Orientation, (Int, Int))])
-> Set (Int, Int)
-> [[(Orientation, (Int, Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Orientation -> (Int, Int) -> (Orientation, (Int, Int)))
-> [Orientation] -> [(Int, Int)] -> [(Orientation, (Int, Int))]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Orientation
Vertical, Orientation
Horizontal] ([(Int, Int)] -> [(Orientation, (Int, Int))])
-> (Set (Int, Int) -> [(Int, Int)])
-> Set (Int, Int)
-> [(Orientation, (Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Int, Int) -> [(Int, Int)]
forall a. Set a -> [a]
Set.toList)
fleetFromSizes :: [ShipSize] -> Fleet
fleetFromSizes :: [Int] -> Fleet
fleetFromSizes = (Int -> Int -> Int) -> [(Int, Int)] -> Fleet
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([(Int, Int)] -> Fleet)
-> ([Int] -> [(Int, Int)]) -> [Int] -> Fleet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Int
1)
standardFleet :: Fleet
standardFleet :: Fleet
standardFleet = [(Int, Int)] -> Fleet
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int
5,Int
1), (Int
4,Int
2), (Int
3,Int
3), (Int
2,Int
4)]
configurationsInFragment :: Bool -> Fleet -> Set (Int,Int) -> [[Ship]]
configurationsInFragment :: Bool -> Fleet -> Set (Int, Int) -> [[Ship]]
configurationsInFragment Bool
outline Fleet
fleet Set (Int, Int)
set =
StateT (Set (Int, Int)) [] [Ship] -> Set (Int, Int) -> [[Ship]]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT
(([[Ship]] -> [Ship])
-> StateT (Set (Int, Int)) [] [[Ship]]
-> StateT (Set (Int, Int)) [] [Ship]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Ship]] -> [Ship]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (StateT (Set (Int, Int)) [] [[Ship]]
-> StateT (Set (Int, Int)) [] [Ship])
-> StateT (Set (Int, Int)) [] [[Ship]]
-> StateT (Set (Int, Int)) [] [Ship]
forall a b. (a -> b) -> a -> b
$
((Int, Int) -> StateT (Set (Int, Int)) [] [Ship])
-> [(Int, Int)] -> StateT (Set (Int, Int)) [] [[Ship]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> Int -> StateT (Set (Int, Int)) [] [Ship])
-> (Int, Int) -> StateT (Set (Int, Int)) [] [Ship]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Bool -> Int -> Int -> StateT (Set (Int, Int)) [] [Ship]
tryShipsOfOneSize Bool
outline)) ([(Int, Int)] -> StateT (Set (Int, Int)) [] [[Ship]])
-> [(Int, Int)] -> StateT (Set (Int, Int)) [] [[Ship]]
forall a b. (a -> b) -> a -> b
$
Fleet -> [(Int, Int)]
forall k a. Map k a -> [(k, a)]
Map.toDescList Fleet
fleet)
Set (Int, Int)
set
configurations :: (Int,Int) -> Fleet -> [[Ship]]
configurations :: (Int, Int) -> Fleet -> [[Ship]]
configurations (Int, Int)
bnds Fleet
fleet =
Bool -> Fleet -> Set (Int, Int) -> [[Ship]]
configurationsInFragment Bool
True Fleet
fleet (Set (Int, Int) -> [[Ship]]) -> Set (Int, Int) -> [[Ship]]
forall a b. (a -> b) -> a -> b
$
case (Int, Int) -> Board
fullBoard (Int, Int)
bnds of Board (Int, Int)
_ Set (Int, Int)
set -> Set (Int, Int)
set
configurationsTouching :: (Int,Int) -> Fleet -> [[Ship]]
configurationsTouching :: (Int, Int) -> Fleet -> [[Ship]]
configurationsTouching (Int, Int)
bnds Fleet
fleet =
Bool -> Fleet -> Set (Int, Int) -> [[Ship]]
configurationsInFragment Bool
False Fleet
fleet (Set (Int, Int) -> [[Ship]]) -> Set (Int, Int) -> [[Ship]]
forall a b. (a -> b) -> a -> b
$
case (Int, Int) -> Board
fullBoard (Int, Int)
bnds of Board (Int, Int)
_ Set (Int, Int)
set -> Set (Int, Int)
set
enumerateStandard :: IO ()
enumerateStandard :: IO ()
enumerateStandard =
let bnds :: (Int, Int)
bnds = (Int
10, Int
10)
in ([Ship] -> IO ()) -> [[Ship]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> ([Ship] -> String) -> [Ship] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [Ship] -> String
formatShips (Int, Int)
bnds) ([[Ship]] -> IO ()) -> [[Ship]] -> IO ()
forall a b. (a -> b) -> a -> b
$
Int -> [[Ship]] -> [[Ship]]
forall a. Int -> [a] -> [a]
take Int
100 ([[Ship]] -> [[Ship]]) -> [[Ship]] -> [[Ship]]
forall a b. (a -> b) -> a -> b
$
(Int, Int) -> Fleet -> [[Ship]]
configurations (Int, Int)
bnds Fleet
standardFleet
count :: (Int,Int) -> Fleet -> IO ()
count :: (Int, Int) -> Fleet -> IO ()
count (Int, Int)
bnds Fleet
fleet =
do Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
IO.stdout BufferMode
IO.LineBuffering
((Integer, [[Ship]]) -> IO ()) -> [(Integer, [[Ship]])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(\(Integer
n,[[Ship]]
configs) ->
case [[Ship]]
configs of
[] -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"number of configurations: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
n::Integer)
([Ship]
c:[[Ship]]
_) ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
n Integer
1000000 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Integer -> IO ()
forall a. Show a => a -> IO ()
print Integer
n
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Ship] -> String
formatShips (Int, Int)
bnds [Ship]
c) ([(Integer, [[Ship]])] -> IO ()) -> [(Integer, [[Ship]])] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Integer] -> [[[Ship]]] -> [(Integer, [[Ship]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([[[Ship]]] -> [(Integer, [[Ship]])])
-> [[[Ship]]] -> [(Integer, [[Ship]])]
forall a b. (a -> b) -> a -> b
$ [[Ship]] -> [[[Ship]]]
forall a. [a] -> [[a]]
tails ([[Ship]] -> [[[Ship]]]) -> [[Ship]] -> [[[Ship]]]
forall a b. (a -> b) -> a -> b
$
(Int, Int) -> Fleet -> [[Ship]]
configurationsTouching (Int, Int)
bnds Fleet
fleet
count8x8 :: IO ()
count8x8 :: IO ()
count8x8 = (Int, Int) -> Fleet -> IO ()
count (Int
8, Int
8) ([(Int, Int)] -> Fleet
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int
2,Int
1), (Int
3,Int
2), (Int
4,Int
1), (Int
5,Int
1)])
main :: IO ()
main :: IO ()
main = IO ()
count8x8