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

{-
110984 157686 189232 183236 181578 181578 183236 189232 157686 110984
157686 190520 213246 203776 201766 201766 203776 213246 190520 157686
189232 213246 232008 221676 220274 220274 221676 232008 213246 189232
183236 203776 221676 211572 210458 210458 211572 221676 203776 183236
181578 201766 220274 210458 209428 209428 210458 220274 201766 181578
181578 201766 220274 210458 209428 209428 210458 220274 201766 181578
183236 203776 221676 211572 210458 210458 211572 221676 203776 183236
189232 213246 232008 221676 220274 220274 221676 232008 213246 189232
157686 190520 213246 203776 201766 201766 203776 213246 190520 157686
110984 157686 189232 183236 181578 181578 183236 189232 157686 110984

real    0m37.341s
user    0m37.162s
sys     0m0.128s
-}

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