module Combinatorics.Battleship.SetCover where
import qualified Combinatorics.Battleship.Fleet as Fleet
import Combinatorics.Battleship (Ship(Ship), ShipSize, Orientation(..), )
import qualified Math.SetCover.BitSet as BitSet
import qualified Math.SetCover.Exact as ESC
import qualified Data.Map as Map; import Data.Map (Map)
import qualified Data.Set as Set; import Data.Set (Set)
import System.Random (RandomGen, randomR, mkStdGen)
import Text.Printf (printf)
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import qualified Control.Functor.HT as FuncHT
import Control.DeepSeq (force)
import Control.Monad (liftM, liftM2, when, mplus)
import qualified Data.StorableVector as SV
import qualified Data.Foldable as Fold
import qualified Data.List as List
import Data.Foldable (foldMap, forM_)
import Data.Maybe.HT (toMaybe)
import Data.Maybe (mapMaybe, catMaybes)
import Data.Tuple.HT (mapFst)
import Data.Word (Word64)
shipShape :: Ship -> Map (Int, Int) Bool
shipShape :: Ship -> Map (Int, Int) Bool
shipShape (Ship Int
size Orientation
orient (Int
x,Int
y)) =
[((Int, Int), Bool)] -> Map (Int, Int) Bool
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([((Int, Int), Bool)] -> Map (Int, Int) Bool)
-> [((Int, Int), Bool)] -> Map (Int, Int) Bool
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> ((Int, Int), Bool))
-> [(Int, Int)] -> [((Int, Int), Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int) -> Bool -> ((Int, Int), Bool))
-> Bool -> (Int, Int) -> ((Int, Int), Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Bool
True) ([(Int, Int)] -> [((Int, Int), Bool)])
-> [(Int, Int)] -> [((Int, Int), Bool)]
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]
shipReserve :: Ship -> Set (Int, Int)
shipReserve :: Ship -> Set (Int, Int)
shipReserve (Ship Int
size Orientation
orient (Int
x,Int
y)) =
let lx :: Int
lx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
ly :: Int
ly = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
in [(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
lx .. 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
ly .. Int
y]
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
lx .. Int
x] [Int
ly .. Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
type AssignShip = ESC.Assign (ShipSize, Map (Int, Int) Bool) (Set (Int, Int))
assignsShip :: [ShipSize] -> (Int, Int) -> [AssignShip]
assignsShip :: [Int] -> (Int, Int) -> [AssignShip]
assignsShip [Int]
sizes (Int
width, Int
height) = do
Int
size <- [Int]
sizes
[AssignShip] -> [AssignShip] -> [AssignShip]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
(do
Int
x <- [Int
0 .. Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
size]
Int
y <- [Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
let horizShip :: Ship
horizShip = Int -> Orientation -> (Int, Int) -> Ship
Ship Int
size Orientation
Horizontal (Int
x,Int
y)
[(Int, Map (Int, Int) Bool) -> Set (Int, Int) -> AssignShip
forall label set. label -> set -> Assign label set
ESC.assign (Int
size, Ship -> Map (Int, Int) Bool
shipShape Ship
horizShip) (Ship -> Set (Int, Int)
shipReserve Ship
horizShip)])
(do
Int
x <- [Int
0 .. Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
Int
y <- [Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
size]
let vertShip :: Ship
vertShip = Int -> Orientation -> (Int, Int) -> Ship
Ship Int
size Orientation
Vertical (Int
x,Int
y)
[(Int, Map (Int, Int) Bool) -> Set (Int, Int) -> AssignShip
forall label set. label -> set -> Assign label set
ESC.assign (Int
size, Ship -> Map (Int, Int) Bool
shipShape Ship
vertShip) (Ship -> Set (Int, Int)
shipReserve Ship
vertShip)])
boardCoords :: (Int, Int) -> [(Int, Int)]
boardCoords :: (Int, Int) -> [(Int, Int)]
boardCoords (Int
width, Int
height) =
(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 -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
width [Int
0..]) (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
height [Int
0..])
assignsSquare ::
(Int, Int) ->
[ESC.Assign (Maybe ShipSize, Map (Int, Int) Bool) (Set (Int, Int))]
assignsSquare :: (Int, Int)
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
assignsSquare (Int
width, Int
height) = do
(Int, Int)
p <- (Int, Int) -> [(Int, Int)]
boardCoords (Int
width, Int
height)
[(Maybe Int, Map (Int, Int) Bool)
-> Set (Int, Int)
-> Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
forall label set. label -> set -> Assign label set
ESC.assign (Maybe Int
forall a. Maybe a
Nothing, (Int, Int) -> Bool -> Map (Int, Int) Bool
forall k a. k -> a -> Map k a
Map.singleton (Int, Int)
p Bool
False) ((Int, Int) -> Set (Int, Int)
forall a. a -> Set a
Set.singleton (Int, Int)
p)]
assigns ::
[ShipSize] -> (Int, Int) ->
[ESC.Assign (Maybe ShipSize, Map (Int, Int) Bool) (Set (Int, Int))]
assigns :: [Int]
-> (Int, Int)
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
assigns [Int]
sizes (Int, Int)
boardSize =
(AssignShip
-> Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)))
-> [AssignShip]
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map
(\AssignShip
asn -> AssignShip
asn{label :: (Maybe Int, Map (Int, Int) Bool)
ESC.label = (Int -> Maybe Int)
-> (Int, Map (Int, Int) Bool) -> (Maybe Int, Map (Int, Int) Bool)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Int -> Maybe Int
forall a. a -> Maybe a
Just (AssignShip -> (Int, Map (Int, Int) Bool)
forall label set. Assign label set -> label
ESC.label AssignShip
asn)})
([Int] -> (Int, Int) -> [AssignShip]
assignsShip [Int]
sizes (Int, Int)
boardSize) [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
forall a. [a] -> [a] -> [a]
++
(Int, Int)
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
assignsSquare (Int, Int)
boardSize
formatBoard :: (Int, Int) -> Map (Int, Int) Bool -> String
formatBoard :: (Int, Int) -> Map (Int, Int) Bool -> String
formatBoard (Int
width, Int
height) Map (Int, Int) Bool
set =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(Int -> Int -> Char) -> [Int] -> [Int] -> [String]
forall (f :: * -> *) (g :: * -> *) a b c.
(Functor f, Functor g) =>
(a -> b -> c) -> f a -> g b -> f (g c)
FuncHT.outerProduct
(\Int
y Int
x ->
case (Int, Int) -> Map (Int, Int) Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
x,Int
y) Map (Int, Int) Bool
set of
Maybe Bool
Nothing -> Char
'_'
Just Bool
False -> Char
'.'
Just Bool
True -> Char
'x')
[Int
0 .. Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Int
0 .. Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
printState :: (Int, Int) -> ESC.State (ship, Map (Int, Int) Bool) set -> IO ()
printState :: (Int, Int) -> State (ship, Map (Int, Int) Bool) set -> IO ()
printState (Int, Int)
boardSize =
(Int, Int) -> Map (Int, Int) Bool -> IO ()
printBoard (Int, Int)
boardSize (Map (Int, Int) Bool -> IO ())
-> (State (ship, Map (Int, Int) Bool) set -> Map (Int, Int) Bool)
-> State (ship, Map (Int, Int) Bool) set
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Assign (ship, Map (Int, Int) Bool) set -> Map (Int, Int) Bool)
-> [Assign (ship, Map (Int, Int) Bool) set] -> Map (Int, Int) Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((ship, Map (Int, Int) Bool) -> Map (Int, Int) Bool
forall a b. (a, b) -> b
snd ((ship, Map (Int, Int) Bool) -> Map (Int, Int) Bool)
-> (Assign (ship, Map (Int, Int) Bool) set
-> (ship, Map (Int, Int) Bool))
-> Assign (ship, Map (Int, Int) Bool) set
-> Map (Int, Int) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign (ship, Map (Int, Int) Bool) set
-> (ship, Map (Int, Int) Bool)
forall label set. Assign label set -> label
ESC.label) ([Assign (ship, Map (Int, Int) Bool) set] -> Map (Int, Int) Bool)
-> (State (ship, Map (Int, Int) Bool) set
-> [Assign (ship, Map (Int, Int) Bool) set])
-> State (ship, Map (Int, Int) Bool) set
-> Map (Int, Int) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (ship, Map (Int, Int) Bool) set
-> [Assign (ship, Map (Int, Int) Bool) set]
forall label set. State label set -> [Assign label set]
ESC.usedSubsets
printBoard :: (Int, Int) -> Map (Int, Int) Bool -> IO ()
printBoard :: (Int, Int) -> Map (Int, Int) Bool -> IO ()
printBoard (Int, Int)
boardSize = String -> IO ()
putStr (String -> IO ())
-> (Map (Int, Int) Bool -> String) -> Map (Int, Int) Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> (Map (Int, Int) Bool -> String) -> Map (Int, Int) Bool -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Map (Int, Int) Bool -> String
formatBoard (Int, Int)
boardSize
standardBoardSize :: (Int, Int)
standardBoardSize :: (Int, Int)
standardBoardSize = (Int
10, Int
10)
standardFleetList :: [(ShipSize, Fleet.NumberOfShips)]
standardFleetList :: [(Int, Int)]
standardFleetList = [(Int
5,Int
1), (Int
4,Int
2), (Int
3,Int
3), (Int
2,Int
4)]
enumerateFirst :: IO ()
enumerateFirst :: IO ()
enumerateFirst = do
let boardSize :: (Int, Int)
boardSize = (Int, Int)
standardBoardSize
(State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)) -> IO ())
-> [State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
((Int, Int)
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)) -> IO ()
forall ship set.
(Int, Int) -> State (ship, Map (Int, Int) Bool) set -> IO ()
printState (Int, Int)
boardSize)
(State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
-> [State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
forall set label. Set set => State label set -> [State label set]
ESC.step (State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
-> [State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))])
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
-> [State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
forall a b. (a -> b) -> a -> b
$ [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
forall set label. Set set => [Assign label set] -> State label set
ESC.initState ([Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)))
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
forall a b. (a -> b) -> a -> b
$ [Int]
-> (Int, Int)
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
assigns (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
standardFleetList) (Int, Int)
boardSize)
enumerateMixed :: IO ()
enumerateMixed :: IO ()
enumerateMixed = do
let boardSize :: (Int, Int)
boardSize = (Int, Int)
standardBoardSize
let fleetList :: [(Int, Int)]
fleetList = [(Int, Int)]
standardFleetList
let fleet :: T
fleet = [(Int, Int)] -> T
Fleet.fromList [(Int, Int)]
fleetList
let loop :: State (Maybe Int, Map (Int, Int) Bool) set -> IO ()
loop State (Maybe Int, Map (Int, Int) Bool) set
state =
let usedFleet :: T
usedFleet =
[(Int, Int)] -> T
Fleet.fromList ([(Int, Int)] -> T) -> [(Int, Int)] -> T
forall a b. (a -> b) -> a -> b
$ (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) ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$
(Assign (Maybe Int, Map (Int, Int) Bool) set -> Maybe Int)
-> [Assign (Maybe Int, Map (Int, Int) Bool) set] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Maybe Int, Map (Int, Int) Bool) -> Maybe Int
forall a b. (a, b) -> a
fst ((Maybe Int, Map (Int, Int) Bool) -> Maybe Int)
-> (Assign (Maybe Int, Map (Int, Int) Bool) set
-> (Maybe Int, Map (Int, Int) Bool))
-> Assign (Maybe Int, Map (Int, Int) Bool) set
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assign (Maybe Int, Map (Int, Int) Bool) set
-> (Maybe Int, Map (Int, Int) Bool)
forall label set. Assign label set -> label
ESC.label) ([Assign (Maybe Int, Map (Int, Int) Bool) set] -> [Int])
-> [Assign (Maybe Int, Map (Int, Int) Bool) set] -> [Int]
forall a b. (a -> b) -> a -> b
$ State (Maybe Int, Map (Int, Int) Bool) set
-> [Assign (Maybe Int, Map (Int, Int) Bool) set]
forall label set. State label set -> [Assign label set]
ESC.usedSubsets State (Maybe Int, Map (Int, Int) Bool) set
state
in Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (T -> T -> Bool
Fleet.subset T
usedFleet T
fleet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
if T
usedFleet T -> T -> Bool
forall a. Eq a => a -> a -> Bool
== T
fleet
then (Int, Int) -> State (Maybe Int, Map (Int, Int) Bool) set -> IO ()
forall ship set.
(Int, Int) -> State (ship, Map (Int, Int) Bool) set -> IO ()
printState (Int, Int)
boardSize State (Maybe Int, Map (Int, Int) Bool) set
state
else (State (Maybe Int, Map (Int, Int) Bool) set -> IO ())
-> [State (Maybe Int, Map (Int, Int) Bool) set] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ State (Maybe Int, Map (Int, Int) Bool) set -> IO ()
loop (State (Maybe Int, Map (Int, Int) Bool) set
-> [State (Maybe Int, Map (Int, Int) Bool) set]
forall set label. Set set => State label set -> [State label set]
ESC.step State (Maybe Int, Map (Int, Int) Bool) set
state)
State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)) -> IO ()
forall set.
Set set =>
State (Maybe Int, Map (Int, Int) Bool) set -> IO ()
loop (State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)) -> IO ())
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
forall set label. Set set => [Assign label set] -> State label set
ESC.initState ([Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int)))
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
-> State (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))
forall a b. (a -> b) -> a -> b
$ [Int]
-> (Int, Int)
-> [Assign (Maybe Int, Map (Int, Int) Bool) (Set (Int, Int))]
assigns (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
fleetList) (Int, Int)
boardSize
type AssignShipBitSet =
ESC.Assign (ShipSize, Map (Int, Int) Bool) (BitSet.Set Integer)
enumerateGen ::
(Monad m) =>
([AssignShipBitSet] -> m AssignShipBitSet) ->
(Int, Int) -> [(ShipSize, Int)] -> m (Map (Int, Int) Bool)
enumerateGen :: ([AssignShipBitSet] -> m AssignShipBitSet)
-> (Int, Int) -> [(Int, Int)] -> m (Map (Int, Int) Bool)
enumerateGen [AssignShipBitSet] -> m AssignShipBitSet
sel (Int, Int)
boardSize [(Int, Int)]
fleetList = do
let layoutShip :: Int -> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
layoutShip Int
shipSize = do
State (Int, Map (Int, Int) Bool) (Set Integer)
state <- StateT
(State (Int, Map (Int, Int) Bool) (Set Integer))
m
(State (Int, Map (Int, Int) Bool) (Set Integer))
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
AssignShipBitSet
place <-
m AssignShipBitSet
-> StateT
(State (Int, Map (Int, Int) Bool) (Set Integer)) m AssignShipBitSet
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m AssignShipBitSet
-> StateT
(State (Int, Map (Int, Int) Bool) (Set Integer))
m
AssignShipBitSet)
-> m AssignShipBitSet
-> StateT
(State (Int, Map (Int, Int) Bool) (Set Integer)) m AssignShipBitSet
forall a b. (a -> b) -> a -> b
$ [AssignShipBitSet] -> m AssignShipBitSet
sel ([AssignShipBitSet] -> m AssignShipBitSet)
-> [AssignShipBitSet] -> m AssignShipBitSet
forall a b. (a -> b) -> a -> b
$ (AssignShipBitSet -> Bool)
-> [AssignShipBitSet] -> [AssignShipBitSet]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
shipSizeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool)
-> (AssignShipBitSet -> Int) -> AssignShipBitSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Map (Int, Int) Bool) -> Int
forall a b. (a, b) -> a
fst ((Int, Map (Int, Int) Bool) -> Int)
-> (AssignShipBitSet -> (Int, Map (Int, Int) Bool))
-> AssignShipBitSet
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssignShipBitSet -> (Int, Map (Int, Int) Bool)
forall label set. Assign label set -> label
ESC.label) ([AssignShipBitSet] -> [AssignShipBitSet])
-> [AssignShipBitSet] -> [AssignShipBitSet]
forall a b. (a -> b) -> a -> b
$
State (Int, Map (Int, Int) Bool) (Set Integer)
-> [AssignShipBitSet]
forall label set. State label set -> [Assign label set]
ESC.availableSubsets State (Int, Map (Int, Int) Bool) (Set Integer)
state
State (Int, Map (Int, Int) Bool) (Set Integer)
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put (State (Int, Map (Int, Int) Bool) (Set Integer)
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ())
-> State (Int, Map (Int, Int) Bool) (Set Integer)
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
forall a b. (a -> b) -> a -> b
$ AssignShipBitSet
-> State (Int, Map (Int, Int) Bool) (Set Integer)
-> State (Int, Map (Int, Int) Bool) (Set Integer)
forall set label.
Set set =>
Assign label set -> State label set -> State label set
ESC.updateState AssignShipBitSet
place State (Int, Map (Int, Int) Bool) (Set Integer)
state
(State (Int, Map (Int, Int) Bool) (Set Integer)
-> Map (Int, Int) Bool)
-> m (State (Int, Map (Int, Int) Bool) (Set Integer))
-> m (Map (Int, Int) Bool)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((AssignShipBitSet -> Map (Int, Int) Bool)
-> [AssignShipBitSet] -> Map (Int, Int) Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Int, Map (Int, Int) Bool) -> Map (Int, Int) Bool
forall a b. (a, b) -> b
snd ((Int, Map (Int, Int) Bool) -> Map (Int, Int) Bool)
-> (AssignShipBitSet -> (Int, Map (Int, Int) Bool))
-> AssignShipBitSet
-> Map (Int, Int) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssignShipBitSet -> (Int, Map (Int, Int) Bool)
forall label set. Assign label set -> label
ESC.label) ([AssignShipBitSet] -> Map (Int, Int) Bool)
-> (State (Int, Map (Int, Int) Bool) (Set Integer)
-> [AssignShipBitSet])
-> State (Int, Map (Int, Int) Bool) (Set Integer)
-> Map (Int, Int) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (Int, Map (Int, Int) Bool) (Set Integer)
-> [AssignShipBitSet]
forall label set. State label set -> [Assign label set]
ESC.usedSubsets) (m (State (Int, Map (Int, Int) Bool) (Set Integer))
-> m (Map (Int, Int) Bool))
-> m (State (Int, Map (Int, Int) Bool) (Set Integer))
-> m (Map (Int, Int) Bool)
forall a b. (a -> b) -> a -> b
$
StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
-> State (Int, Map (Int, Int) Bool) (Set Integer)
-> m (State (Int, Map (Int, Int) Bool) (Set Integer))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
MS.execStateT
((Int
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ())
-> [Int]
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
layoutShip ([Int]
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ())
-> [Int]
-> StateT (State (Int, Map (Int, Int) Bool) (Set Integer)) m ()
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> [Int]) -> [(Int, Int)] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> Int -> [Int]) -> (Int, Int) -> [Int]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Int -> [Int]) -> (Int, Int) -> [Int])
-> (Int -> Int -> [Int]) -> (Int, Int) -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> [Int]) -> Int -> Int -> [Int]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate) [(Int, Int)]
fleetList) (State (Int, Map (Int, Int) Bool) (Set Integer)
-> m (State (Int, Map (Int, Int) Bool) (Set Integer)))
-> State (Int, Map (Int, Int) Bool) (Set Integer)
-> m (State (Int, Map (Int, Int) Bool) (Set Integer))
forall a b. (a -> b) -> a -> b
$
[AssignShipBitSet]
-> State (Int, Map (Int, Int) Bool) (Set Integer)
forall set label. Set set => [Assign label set] -> State label set
ESC.initState ([AssignShipBitSet]
-> State (Int, Map (Int, Int) Bool) (Set Integer))
-> [AssignShipBitSet]
-> State (Int, Map (Int, Int) Bool) (Set Integer)
forall a b. (a -> b) -> a -> b
$
[AssignShip] -> [AssignShipBitSet]
forall a label.
Ord a =>
[Assign label (Set a)] -> [Assign label (Set Integer)]
ESC.bitVectorFromSetAssigns ([AssignShip] -> [AssignShipBitSet])
-> [AssignShip] -> [AssignShipBitSet]
forall a b. (a -> b) -> a -> b
$ [Int] -> (Int, Int) -> [AssignShip]
assignsShip (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
fleetList) (Int, Int)
boardSize
enumerateShip :: IO ()
enumerateShip :: IO ()
enumerateShip = do
let boardSize :: (Int, Int)
boardSize = (Int, Int)
standardBoardSize
let fleetList :: [(Int, Int)]
fleetList = [(Int, Int)]
standardFleetList
(Map (Int, Int) Bool -> IO ()) -> [Map (Int, Int) Bool] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int, Int) -> Map (Int, Int) Bool -> IO ()
printBoard (Int, Int)
boardSize) ([Map (Int, Int) Bool] -> IO ()) -> [Map (Int, Int) Bool] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([AssignShipBitSet] -> [AssignShipBitSet])
-> (Int, Int) -> [(Int, Int)] -> [Map (Int, Int) Bool]
forall (m :: * -> *).
Monad m =>
([AssignShipBitSet] -> m AssignShipBitSet)
-> (Int, Int) -> [(Int, Int)] -> m (Map (Int, Int) Bool)
enumerateGen [AssignShipBitSet] -> [AssignShipBitSet]
forall a. a -> a
id (Int, Int)
boardSize [(Int, Int)]
fleetList
select :: (RandomGen g) => [a] -> MS.StateT g Maybe a
select :: [a] -> StateT g Maybe a
select [a]
xs = (g -> Maybe (a, g)) -> StateT g Maybe a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT ((g -> Maybe (a, g)) -> StateT g Maybe a)
-> (g -> Maybe (a, g)) -> StateT g Maybe a
forall a b. (a -> b) -> a -> b
$ \g
g ->
Bool -> (a, g) -> Maybe (a, g)
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs) ((a, g) -> Maybe (a, g)) -> (a, g) -> Maybe (a, g)
forall a b. (a -> b) -> a -> b
$ (Int -> a) -> (Int, g) -> (a, g)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ([a]
xs[a] -> Int -> a
forall a. [a] -> Int -> a
!!) ((Int, g) -> (a, g)) -> (Int, g) -> (a, g)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) g
g
enumerateRandom :: IO ()
enumerateRandom :: IO ()
enumerateRandom = do
let boardSize :: (Int, Int)
boardSize = (Int, Int)
standardBoardSize
let fleetList :: [(Int, Int)]
fleetList = [(Int, Int)]
standardFleetList
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
seed ->
(Map (Int, Int) Bool -> IO ())
-> Maybe (Map (Int, Int) Bool) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Fold.mapM_ ((Int, Int) -> Map (Int, Int) Bool -> IO ()
printBoard (Int, Int)
boardSize) (Maybe (Map (Int, Int) Bool) -> IO ())
-> Maybe (Map (Int, Int) Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$
StateT StdGen Maybe (Map (Int, Int) Bool)
-> StdGen -> Maybe (Map (Int, Int) Bool)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT
(([AssignShipBitSet] -> StateT StdGen Maybe AssignShipBitSet)
-> (Int, Int)
-> [(Int, Int)]
-> StateT StdGen Maybe (Map (Int, Int) Bool)
forall (m :: * -> *).
Monad m =>
([AssignShipBitSet] -> m AssignShipBitSet)
-> (Int, Int) -> [(Int, Int)] -> m (Map (Int, Int) Bool)
enumerateGen [AssignShipBitSet] -> StateT StdGen Maybe AssignShipBitSet
forall g a. RandomGen g => [a] -> StateT g Maybe a
select (Int, Int)
boardSize [(Int, Int)]
fleetList)
(Int -> StdGen
mkStdGen Int
seed)
listsFromBoard :: (Num a) => (a -> b) -> (Int, Int) -> Map (Int, Int) a -> [[b]]
listsFromBoard :: (a -> b) -> (Int, Int) -> Map (Int, Int) a -> [[b]]
listsFromBoard a -> b
f (Int
width, Int
height) Map (Int, Int) a
set =
(Int -> Int -> b) -> [Int] -> [Int] -> [[b]]
forall (f :: * -> *) (g :: * -> *) a b c.
(Functor f, Functor g) =>
(a -> b -> c) -> f a -> g b -> f (g c)
FuncHT.outerProduct
(\Int
y Int
x -> a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> (Int, Int) -> Map (Int, Int) a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
0 (Int
x,Int
y) Map (Int, Int) a
set)
(Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
height [Int
0..]) (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
width [Int
0..])
formatDistr :: (Int, Int) -> Map (Int, Int) Float -> String
formatDistr :: (Int, Int) -> Map (Int, Int) Float -> String
formatDistr (Int, Int)
boardSize Map (Int, Int) Float
set =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (Float -> String)
-> (Int, Int) -> Map (Int, Int) Float -> [[String]]
forall a b.
Num a =>
(a -> b) -> (Int, Int) -> Map (Int, Int) a -> [[b]]
listsFromBoard (String -> Float -> String
forall r. PrintfType r => String -> r
printf String
"%.3f") (Int, Int)
boardSize Map (Int, Int) Float
set
formatAbsDistr :: (Int, Int) -> Map (Int, Int) Word64 -> String
formatAbsDistr :: (Int, Int) -> Map (Int, Int) Word64 -> String
formatAbsDistr (Int, Int)
boardSize Map (Int, Int) Word64
set =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (Word64 -> String)
-> (Int, Int) -> Map (Int, Int) Word64 -> [[String]]
forall a b.
Num a =>
(a -> b) -> (Int, Int) -> Map (Int, Int) a -> [[b]]
listsFromBoard (String -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"%d") (Int, Int)
boardSize Map (Int, Int) Word64
set
sumMaps :: [Map (Int, Int) Int] -> Map (Int, Int) Int
sumMaps :: [Map (Int, Int) Int] -> Map (Int, Int) Int
sumMaps = (Map (Int, Int) Int -> Map (Int, Int) Int -> Map (Int, Int) Int)
-> Map (Int, Int) Int -> [Map (Int, Int) Int] -> Map (Int, Int) Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((Map (Int, Int) Int -> Map (Int, Int) Int
forall a. NFData a => a -> a
force (Map (Int, Int) Int -> Map (Int, Int) Int)
-> (Map (Int, Int) Int -> Map (Int, Int) Int)
-> Map (Int, Int) Int
-> Map (Int, Int) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Map (Int, Int) Int -> Map (Int, Int) Int)
-> Map (Int, Int) Int -> Map (Int, Int) Int)
-> (Map (Int, Int) Int -> Map (Int, Int) Int -> Map (Int, Int) Int)
-> Map (Int, Int) Int
-> Map (Int, Int) Int
-> Map (Int, Int) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int)
-> Map (Int, Int) Int -> Map (Int, Int) Int -> Map (Int, Int) Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)) Map (Int, Int) Int
forall k a. Map k a
Map.empty
sumMapsStorable ::
(Int, Int) -> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
sumMapsStorable :: (Int, Int) -> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
sumMapsStorable (Int, Int)
boardSize =
[((Int, Int), Word64)] -> Map (Int, Int) Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Int, Int), Word64)] -> Map (Int, Int) Word64)
-> ([Map (Int, Int) Word64] -> [((Int, Int), Word64)])
-> [Map (Int, Int) Word64]
-> Map (Int, Int) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [Word64] -> [((Int, Int), Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int, Int) -> [(Int, Int)]
boardCoords (Int, Int)
boardSize) ([Word64] -> [((Int, Int), Word64)])
-> ([Map (Int, Int) Word64] -> [Word64])
-> [Map (Int, Int) Word64]
-> [((Int, Int), Word64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> [Word64]
forall a. Storable a => Vector a -> [a]
SV.unpack (Vector Word64 -> [Word64])
-> ([Map (Int, Int) Word64] -> Vector Word64)
-> [Map (Int, Int) Word64]
-> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
let zeroBoard :: Map (Int, Int) Word64
zeroBoard = [((Int, Int), Word64)] -> Map (Int, Int) Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Int, Int), Word64)] -> Map (Int, Int) Word64)
-> [((Int, Int), Word64)] -> Map (Int, Int) Word64
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> ((Int, Int), Word64))
-> [(Int, Int)] -> [((Int, Int), Word64)]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int) -> Word64 -> ((Int, Int), Word64))
-> Word64 -> (Int, Int) -> ((Int, Int), Word64)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Word64
0) ((Int, Int) -> [(Int, Int)]
boardCoords (Int, Int)
boardSize)
numSquares :: Int
numSquares = (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (Int, Int)
boardSize
checkLength :: Vector a -> Vector a
checkLength Vector a
x =
if Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numSquares
then Vector a
x
else String -> Vector a
forall a. HasCallStack => String -> a
error String
"invalid keys in counter board"
in (Vector Word64 -> Vector Word64 -> Vector Word64)
-> Vector Word64 -> [Vector Word64] -> Vector Word64
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((Vector Word64 -> Vector Word64
forall a. NFData a => a -> a
force (Vector Word64 -> Vector Word64)
-> (Vector Word64 -> Vector Word64)
-> Vector Word64
-> Vector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Vector Word64 -> Vector Word64)
-> Vector Word64 -> Vector Word64)
-> (Vector Word64 -> Vector Word64 -> Vector Word64)
-> Vector Word64
-> Vector Word64
-> Vector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64)
-> Vector Word64 -> Vector Word64 -> Vector Word64
forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+)) (Int -> Word64 -> Vector Word64
forall a. Storable a => Int -> a -> Vector a
SV.replicate Int
numSquares Word64
0) ([Vector Word64] -> Vector Word64)
-> ([Map (Int, Int) Word64] -> [Vector Word64])
-> [Map (Int, Int) Word64]
-> Vector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Map (Int, Int) Word64 -> Vector Word64)
-> [Map (Int, Int) Word64] -> [Vector Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Vector Word64 -> Vector Word64
forall a. Vector a -> Vector a
checkLength (Vector Word64 -> Vector Word64)
-> (Map (Int, Int) Word64 -> Vector Word64)
-> Map (Int, Int) Word64
-> Vector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Vector Word64
forall a. Storable a => [a] -> Vector a
SV.pack ([Word64] -> Vector Word64)
-> (Map (Int, Int) Word64 -> [Word64])
-> Map (Int, Int) Word64
-> Vector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Int, Int) Word64 -> [Word64]
forall k a. Map k a -> [a]
Map.elems (Map (Int, Int) Word64 -> [Word64])
-> (Map (Int, Int) Word64 -> Map (Int, Int) Word64)
-> Map (Int, Int) Word64
-> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Int, Int) Word64
-> Map (Int, Int) Word64 -> Map (Int, Int) Word64)
-> Map (Int, Int) Word64
-> Map (Int, Int) Word64
-> Map (Int, Int) Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map (Int, Int) Word64
-> Map (Int, Int) Word64 -> Map (Int, Int) Word64
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Int, Int) Word64
zeroBoard)
estimateDistribution :: IO ()
estimateDistribution :: IO ()
estimateDistribution = do
let boardSize :: (Int, Int)
boardSize = (Int, Int)
standardBoardSize
let fleetList :: [(Int, Int)]
fleetList = [(Int, Int)]
standardFleetList
let num :: Int
num = Int
100000
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) Float -> String
formatDistr (Int, Int)
boardSize (Map (Int, Int) Float -> String) -> Map (Int, Int) Float -> String
forall a b. (a -> b) -> a -> b
$
(Word64 -> Float) -> Map (Int, Int) Word64 -> Map (Int, Int) Float
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Word64
n -> Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num) (Map (Int, Int) Word64 -> Map (Int, Int) Float)
-> Map (Int, Int) Word64 -> Map (Int, Int) Float
forall a b. (a -> b) -> a -> b
$
(Int, Int) -> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
sumMapsStorable (Int, Int)
boardSize ([Map (Int, Int) Word64] -> Map (Int, Int) Word64)
-> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
forall a b. (a -> b) -> a -> b
$
(Map (Int, Int) Bool -> Map (Int, Int) Word64)
-> [Map (Int, Int) Bool] -> [Map (Int, Int) Word64]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> Word64) -> Map (Int, Int) Bool -> Map (Int, Int) Word64
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Bool
b -> if Bool
b then Word64
1 else Word64
0)) ([Map (Int, Int) Bool] -> [Map (Int, Int) Word64])
-> [Map (Int, Int) Bool] -> [Map (Int, Int) Word64]
forall a b. (a -> b) -> a -> b
$
Int -> [Map (Int, Int) Bool] -> [Map (Int, Int) Bool]
forall a. Int -> [a] -> [a]
take Int
num ([Map (Int, Int) Bool] -> [Map (Int, Int) Bool])
-> [Map (Int, Int) Bool] -> [Map (Int, Int) Bool]
forall a b. (a -> b) -> a -> b
$ [Maybe (Map (Int, Int) Bool)] -> [Map (Int, Int) Bool]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Map (Int, Int) Bool)] -> [Map (Int, Int) Bool])
-> [Maybe (Map (Int, Int) Bool)] -> [Map (Int, Int) Bool]
forall a b. (a -> b) -> a -> b
$
((Int -> Maybe (Map (Int, Int) Bool))
-> [Int] -> [Maybe (Map (Int, Int) Bool)])
-> [Int]
-> (Int -> Maybe (Map (Int, Int) Bool))
-> [Maybe (Map (Int, Int) Bool)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Maybe (Map (Int, Int) Bool))
-> [Int] -> [Maybe (Map (Int, Int) Bool)]
forall a b. (a -> b) -> [a] -> [b]
map [Int
0..] ((Int -> Maybe (Map (Int, Int) Bool))
-> [Maybe (Map (Int, Int) Bool)])
-> (Int -> Maybe (Map (Int, Int) Bool))
-> [Maybe (Map (Int, Int) Bool)]
forall a b. (a -> b) -> a -> b
$ \Int
seed ->
StateT StdGen Maybe (Map (Int, Int) Bool)
-> StdGen -> Maybe (Map (Int, Int) Bool)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT
(([AssignShipBitSet] -> StateT StdGen Maybe AssignShipBitSet)
-> (Int, Int)
-> [(Int, Int)]
-> StateT StdGen Maybe (Map (Int, Int) Bool)
forall (m :: * -> *).
Monad m =>
([AssignShipBitSet] -> m AssignShipBitSet)
-> (Int, Int) -> [(Int, Int)] -> m (Map (Int, Int) Bool)
enumerateGen [AssignShipBitSet] -> StateT StdGen Maybe AssignShipBitSet
forall g a. RandomGen g => [a] -> StateT g Maybe a
select (Int, Int)
boardSize [(Int, Int)]
fleetList)
(Int -> StdGen
mkStdGen Int
seed)
exactDistribution :: IO ()
exactDistribution :: IO ()
exactDistribution = do
let boardSize :: (Int, Int)
boardSize = (Int, Int)
standardBoardSize
let fleetList :: [(Int, Int)]
fleetList = [(Int
2,Int
1), (Int
3,Int
2)]
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) Word64 -> String
formatAbsDistr (Int, Int)
boardSize (Map (Int, Int) Word64 -> String)
-> Map (Int, Int) Word64 -> String
forall a b. (a -> b) -> a -> b
$
(Int, Int) -> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
sumMapsStorable (Int, Int)
boardSize ([Map (Int, Int) Word64] -> Map (Int, Int) Word64)
-> [Map (Int, Int) Word64] -> Map (Int, Int) Word64
forall a b. (a -> b) -> a -> b
$
(Map (Int, Int) Bool -> Map (Int, Int) Word64)
-> [Map (Int, Int) Bool] -> [Map (Int, Int) Word64]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> Word64) -> Map (Int, Int) Bool -> Map (Int, Int) Word64
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Bool
b -> if Bool
b then Word64
1 else Word64
0)) ([Map (Int, Int) Bool] -> [Map (Int, Int) Word64])
-> [Map (Int, Int) Bool] -> [Map (Int, Int) Word64]
forall a b. (a -> b) -> a -> b
$
([AssignShipBitSet] -> [AssignShipBitSet])
-> (Int, Int) -> [(Int, Int)] -> [Map (Int, Int) Bool]
forall (m :: * -> *).
Monad m =>
([AssignShipBitSet] -> m AssignShipBitSet)
-> (Int, Int) -> [(Int, Int)] -> m (Map (Int, Int) Bool)
enumerateGen [AssignShipBitSet] -> [AssignShipBitSet]
forall a. a -> a
id (Int, Int)
boardSize [(Int, Int)]
fleetList
tikzBrightnessField :: (Double,Double) -> [[Double]] -> String
tikzBrightnessField :: (Double, Double) -> [[Double]] -> String
tikzBrightnessField (Double
lower,Double
upper) [[Double]]
xs =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(Int -> [Double] -> String) -> [Int] -> [[Double]] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\Int
num [Double]
row ->
String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"\\brightnessrow{%d}{%s}" Int
num (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d") ([Int] -> [String]) -> [Int] -> [String]
forall a b. (a -> b) -> a -> b
$
(Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
val -> Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
100Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
valDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
lower)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
upperDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
lower)) :: Int) [Double]
row)
[Int
0::Int ..] [[Double]]
xs