module Combinatorics.Battleship.Count.ShortenShip where
import qualified Combinatorics.Battleship.Count.CountMap as CountMap
import qualified Combinatorics.Battleship.Count.Counter as Counter
import qualified Combinatorics.Battleship.Count.Frontier as Frontier
import qualified Combinatorics.Battleship.Fleet as Fleet
import qualified Combinatorics.Battleship.Size as Size
import Combinatorics.Battleship.Size (Nat, Size(Size), n6, n8, n10, )
import qualified Control.Monad.Trans.State.Strict as MS
import Control.Monad (when, guard, zipWithM_, forM_, )
import Control.Applicative (Alternative, (<|>), )
import Foreign.Storable (Storable, )
import Data.Word (Word64, )
import qualified Data.Map as Map
import qualified Data.List.Match as Match
import qualified Data.List.HT as ListHT
import qualified Data.Foldable as Fold
import Data.Map (Map, )
import Data.Monoid (mappend, )
import Data.Tuple.HT (mapFst, mapSnd, )
import Data.Function.HT (nest, )
import Data.List (intercalate, )
import Text.Printf (printf, )
import qualified Test.QuickCheck.Monadic as QCM
import qualified Test.QuickCheck as QC
type Count = Counter.Composed Word64 Word64
type CountMap w = CountMap.T w Count
type CountMapPath w = CountMap.Path w Count
baseCase :: Size w -> CountMap w
baseCase :: Size w -> CountMap w
baseCase Size w
_size =
Key w -> Count -> CountMap w
forall a w. Storable a => Key w -> a -> T w a
CountMap.singleton (T w
forall w. T w
Frontier.empty, T
Fleet.empty) Count
forall a. C a => a
Counter.one
asumTakeFrontier ::
(Nat w, Alternative f) =>
Frontier.T w -> Frontier.Position -> Size w -> [f a] -> f a
asumTakeFrontier :: T w -> Position -> Size w -> [f a] -> f a
asumTakeFrontier T w
frontier Position
pos (Size Position
size) =
[f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Fold.asum ([f a] -> f a) -> ([f a] -> [f a]) -> [f a] -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Position] -> [f a] -> [f a]
forall b a. [b] -> [a] -> [a]
Match.take ((Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (T w -> Position -> Bool
forall w. Nat w => T w -> Position -> Bool
Frontier.isFree T w
frontier) [Position
pos .. Position
sizePosition -> Position -> Position
forall a. Num a => a -> a -> a
-Position
1])
widthRange :: (Nat w) => Size w -> [Int]
widthRange :: Size w -> [Position]
widthRange (Size Position
size) = Position -> [Position] -> [Position]
forall a. Position -> [a] -> [a]
take Position
size [Position
0 ..]
atEnd :: Size w -> Int -> Bool
atEnd :: Size w -> Position -> Bool
atEnd (Size Position
size) Position
pos = Position
posPosition -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>=Position
size
maxShipSize :: Fleet.ShipSize
maxShipSize :: Position
maxShipSize = Position -> Position -> Position
forall a. Ord a => a -> a -> a
min Position
Fleet.maxSize Position
Frontier.maxShipSize
guardCumulativeSubset :: Fleet.T -> MS.StateT (Frontier.T w, Fleet.T) [] ()
guardCumulativeSubset :: T -> StateT (T w, T) [] ()
guardCumulativeSubset T
cumMaxFleet = do
(T w
frontier, T
fleet) <- StateT (T w, T) [] (T w, T)
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
Bool -> StateT (T w, T) [] ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT (T w, T) [] ()) -> Bool -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$
T -> T -> Bool
Fleet.subset
(T -> T
Fleet.cumulate (T -> T) -> T -> T
forall a b. (a -> b) -> a -> b
$ T w -> T -> T
forall w. T w -> T -> T
addFrontierFleet T w
frontier T
fleet)
T
cumMaxFleet
newShip ::
Fleet.T -> Fleet.T ->
Fleet.ShipSize -> MS.StateT (Frontier.T w, Fleet.T) [] ()
newShip :: T -> T -> Position -> StateT (T w, T) [] ()
newShip T
cumMaxFleet T
maxFleet Position
shipSize = do
((T w, T) -> (T w, T)) -> StateT (T w, T) [] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (((T w, T) -> (T w, T)) -> StateT (T w, T) [] ())
-> ((T w, T) -> (T w, T)) -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$ (T -> T) -> (T w, T) -> (T w, T)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((T -> T) -> (T w, T) -> (T w, T))
-> (T -> T) -> (T w, T) -> (T w, T)
forall a b. (a -> b) -> a -> b
$ Position -> T -> T
Fleet.inc Position
shipSize
Bool -> StateT (T w, T) [] ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT (T w, T) [] ())
-> (T -> Bool) -> T -> StateT (T w, T) [] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T -> T -> Bool) -> T -> T -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip T -> T -> Bool
Fleet.subset T
maxFleet (T -> StateT (T w, T) [] ())
-> StateT (T w, T) [] T -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((T w, T) -> T) -> StateT (T w, T) [] T
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (T w, T) -> T
forall a b. (a, b) -> b
snd
T -> StateT (T w, T) [] ()
forall w. T -> StateT (T w, T) [] ()
guardCumulativeSubset T
cumMaxFleet
insertVertical ::
(Nat w) =>
Fleet.T -> Int ->
Frontier.Position -> MS.StateT (Frontier.T w, Fleet.T) [] ()
insertVertical :: T -> Position -> Position -> StateT (T w, T) [] ()
insertVertical T
cumMaxFleet Position
n Position
pos = do
((T w, T) -> (T w, T)) -> StateT (T w, T) [] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (((T w, T) -> (T w, T)) -> StateT (T w, T) [] ())
-> ((T w, T) -> (T w, T)) -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$ (T w -> T w) -> (T w, T) -> (T w, T)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T w -> T w) -> (T w, T) -> (T w, T))
-> (T w -> T w) -> (T w, T) -> (T w, T)
forall a b. (a -> b) -> a -> b
$ Position -> Use -> T w -> T w
forall w. Nat w => Position -> Use -> T w -> T w
Frontier.insertNew Position
pos (Position -> Use
Frontier.Vertical Position
n)
T -> StateT (T w, T) [] ()
forall w. T -> StateT (T w, T) [] ()
guardCumulativeSubset T
cumMaxFleet
nextFrontier :: (Nat w) => Size w -> CountMap w -> CountMap w
nextFrontier :: Size w -> CountMap w -> CountMap w
nextFrontier Size w
width =
[CountMap w] -> CountMap w
forall a w. (C a, Storable a) => [T w a] -> T w a
CountMap.mergeMany ([CountMap w] -> CountMap w)
-> (CountMap w -> [CountMap w]) -> CountMap w -> CountMap w
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((T w, T), Count) -> CountMap w)
-> [((T w, T), Count)] -> [CountMap w]
forall a b. (a -> b) -> [a] -> [b]
map
(\((T w
frontier,T
fleet), Count
cnt) ->
[((T w, T), Count)] -> CountMap w
forall a w. (C a, Storable a) => [KeyCount w a] -> T w a
CountMap.fromList ([((T w, T), Count)] -> CountMap w)
-> [((T w, T), Count)] -> CountMap w
forall a b. (a -> b) -> a -> b
$
((T w, T) -> ((T w, T), Count))
-> [(T w, T)] -> [((T w, T), Count)]
forall a b. (a -> b) -> [a] -> [b]
map (((T w, T) -> Count -> ((T w, T), Count))
-> Count -> (T w, T) -> ((T w, T), Count)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Count
cnt) ([(T w, T)] -> [((T w, T), Count)])
-> [(T w, T)] -> [((T w, T), Count)]
forall a b. (a -> b) -> a -> b
$ [(T w, T)] -> [(T w, T)]
forall w fleet. Nat w => [(T w, fleet)] -> [(T w, fleet)]
mergeSymmetricFrontiers ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
((T w, T) -> (T w, T)) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T w -> T w) -> (T w, T) -> (T w, T)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Size w -> T w -> T w
forall w. Size w -> T w -> T w
Frontier.dilate Size w
width)) ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
Size w -> T w -> T -> [(T w, T)]
forall w. Nat w => Size w -> T w -> T -> [(T w, T)]
transitionFrontier Size w
width T w
frontier T
fleet) ([((T w, T), Count)] -> [CountMap w])
-> (CountMap w -> [((T w, T), Count)])
-> CountMap w
-> [CountMap w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> [((T w, T), Count)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
transitionFrontier ::
(Nat w) => Size w -> Frontier.T w -> Fleet.T -> [(Frontier.T w, Fleet.T)]
transitionFrontier :: Size w -> T w -> T -> [(T w, T)]
transitionFrontier Size w
width T w
oldFrontier =
let go :: Position -> StateT (T w, T) m ()
go Position
pos =
Bool -> StateT (T w, T) m () -> StateT (T w, T) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Size w -> Position -> Bool
forall w. Size w -> Position -> Bool
atEnd Size w
width Position
pos) (StateT (T w, T) m () -> StateT (T w, T) m ())
-> StateT (T w, T) m () -> StateT (T w, T) m ()
forall a b. (a -> b) -> a -> b
$ do
let insertVert :: Position -> StateT (T w, b) m ()
insertVert Position
n =
((T w, b) -> (T w, b)) -> StateT (T w, b) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (((T w, b) -> (T w, b)) -> StateT (T w, b) m ())
-> ((T w, b) -> (T w, b)) -> StateT (T w, b) m ()
forall a b. (a -> b) -> a -> b
$ (T w -> T w) -> (T w, b) -> (T w, b)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T w -> T w) -> (T w, b) -> (T w, b))
-> (T w -> T w) -> (T w, b) -> (T w, b)
forall a b. (a -> b) -> a -> b
$
Position -> Use -> T w -> T w
forall w. Nat w => Position -> Use -> T w -> T w
Frontier.insertNew Position
pos (Position -> Use
Frontier.Vertical Position
n)
let updateFleet :: (b -> b) -> StateT (a, b) m ()
updateFleet = ((a, b) -> (a, b)) -> StateT (a, b) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (((a, b) -> (a, b)) -> StateT (a, b) m ())
-> ((b -> b) -> (a, b) -> (a, b)) -> (b -> b) -> StateT (a, b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b) -> (a, b) -> (a, b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd
(T w
frontier,T
fleet) <- StateT (T w, T) m (T w, T)
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
case T w -> Position -> Use
forall w. Nat w => T w -> Position -> Use
Frontier.lookup T w
oldFrontier Position
pos of
Use
Frontier.Blocked -> Position -> StateT (T w, T) m ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
Frontier.Vertical Position
n ->
Position -> StateT (T w, T) m ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2)
StateT (T w, T) m ()
-> StateT (T w, T) m () -> StateT (T w, T) m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do Bool -> StateT (T w, T) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Position
n Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
maxShipSize)
Position -> StateT (T w, T) m ()
forall (m :: * -> *) w b.
(Monad m, Nat w) =>
Position -> StateT (T w, b) m ()
insertVert (Position
nPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
(T -> T) -> StateT (T w, T) m ()
forall b a. (b -> b) -> StateT (a, b) m ()
updateFleet (Position -> T -> T
Fleet.inc (Position
nPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1) (T -> T) -> (T -> T) -> T -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> T -> T
Fleet.dec Position
n)
Position -> StateT (T w, T) m ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2))
Use
Frontier.Free ->
Position -> StateT (T w, T) m ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
StateT (T w, T) m ()
-> StateT (T w, T) m () -> StateT (T w, T) m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do Position -> StateT (T w, T) m ()
forall (m :: * -> *) w b.
(Monad m, Nat w) =>
Position -> StateT (T w, b) m ()
insertVert Position
1
(T -> T) -> StateT (T w, T) m ()
forall b a. (b -> b) -> StateT (a, b) m ()
updateFleet (Position -> T -> T
Fleet.inc Position
1)
Position -> StateT (T w, T) m ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2))
StateT (T w, T) m ()
-> StateT (T w, T) m () -> StateT (T w, T) m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(T w
-> Position
-> Size w
-> [StateT (T w, T) m ()]
-> StateT (T w, T) m ()
forall w (f :: * -> *) a.
(Nat w, Alternative f) =>
T w -> Position -> Size w -> [f a] -> f a
asumTakeFrontier T w
oldFrontier Position
pos Size w
width ([StateT (T w, T) m ()] -> StateT (T w, T) m ())
-> [StateT (T w, T) m ()] -> StateT (T w, T) m ()
forall a b. (a -> b) -> a -> b
$
(Position -> Position -> T w -> StateT (T w, T) m ())
-> [Position] -> [Position] -> [T w] -> [StateT (T w, T) m ()]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
(\Position
newPos Position
shipSize T w
newFrontierUpdate -> do
(T w, T) -> StateT (T w, T) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put (T w
newFrontierUpdate, T
fleet)
(T -> T) -> StateT (T w, T) m ()
forall b a. (b -> b) -> StateT (a, b) m ()
updateFleet (Position -> T -> T
Fleet.inc Position
shipSize)
Position -> StateT (T w, T) m ()
go Position
newPos)
[Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2 ..]
[Position
1 .. Position
Fleet.maxSize]
([T w] -> [T w]
forall a. [a] -> [a]
tail ([T w] -> [T w]) -> [T w] -> [T w]
forall a b. (a -> b) -> a -> b
$
(T w -> Position -> T w) -> T w -> [Position] -> [T w]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
((Position -> T w -> T w) -> T w -> Position -> T w
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Size w -> Position -> T w -> T w
forall w. Nat w => Size w -> Position -> T w -> T w
Frontier.blockBounded Size w
width))
T w
frontier [Position
pos ..]))
in StateT (T w, T) [] () -> (T w, T) -> [(T w, T)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
MS.execStateT (Position -> StateT (T w, T) [] ()
forall (m :: * -> *).
MonadPlus m =>
Position -> StateT (T w, T) m ()
go Position
0) ((T w, T) -> [(T w, T)]) -> (T -> (T w, T)) -> T -> [(T w, T)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) T w
forall w. T w
Frontier.empty
count :: (Nat w) => (Size w, Int) -> Fleet.T -> Count
count :: (Size w, Position) -> T -> Count
count (Size w
width,Position
height) T
reqFleet =
[Count] -> Count
forall a. C a => [a] -> a
Counter.sum ([Count] -> Count) -> [Count] -> Count
forall a b. (a -> b) -> a -> b
$
(((T w, T), Count) -> Count) -> [((T w, T), Count)] -> [Count]
forall a b. (a -> b) -> [a] -> [b]
map ((T w, T), Count) -> Count
forall a b. (a, b) -> b
snd ([((T w, T), Count)] -> [Count]) -> [((T w, T), Count)] -> [Count]
forall a b. (a -> b) -> a -> b
$
(((T w, T), Count) -> Bool)
-> [((T w, T), Count)] -> [((T w, T), Count)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((T w
_front,T
fleet), Count
_) -> T
fleet T -> T -> Bool
forall a. Eq a => a -> a -> Bool
== T
reqFleet) ([((T w, T), Count)] -> [((T w, T), Count)])
-> [((T w, T), Count)] -> [((T w, T), Count)]
forall a b. (a -> b) -> a -> b
$
T w Count -> [((T w, T), Count)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList (T w Count -> [((T w, T), Count)])
-> T w Count -> [((T w, T), Count)]
forall a b. (a -> b) -> a -> b
$
Position -> (T w Count -> T w Count) -> T w Count -> T w Count
forall a. Position -> (a -> a) -> a -> a
nest Position
height (Size w -> T w Count -> T w Count
forall w. Nat w => Size w -> CountMap w -> CountMap w
nextFrontier Size w
width) (T w Count -> T w Count) -> T w Count -> T w Count
forall a b. (a -> b) -> a -> b
$ Size w -> T w Count
forall w. Size w -> CountMap w
baseCase Size w
width
nextFrontierBounded :: (Nat w) => Size w -> Fleet.T -> CountMap w -> CountMap w
nextFrontierBounded :: Size w -> T -> CountMap w -> CountMap w
nextFrontierBounded Size w
width T
maxFleet =
[CountMap w] -> CountMap w
forall a w. (C a, Storable a) => [T w a] -> T w a
CountMap.mergeMany ([CountMap w] -> CountMap w)
-> (CountMap w -> [CountMap w]) -> CountMap w -> CountMap w
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((T w, T), Count) -> CountMap w)
-> [((T w, T), Count)] -> [CountMap w]
forall a b. (a -> b) -> [a] -> [b]
map
(\((T w
frontier,T
fleet), Count
cnt) ->
[((T w, T), Count)] -> CountMap w
forall a w. (C a, Storable a) => [KeyCount w a] -> T w a
CountMap.fromList ([((T w, T), Count)] -> CountMap w)
-> [((T w, T), Count)] -> CountMap w
forall a b. (a -> b) -> a -> b
$
((T w, T) -> ((T w, T), Count))
-> [(T w, T)] -> [((T w, T), Count)]
forall a b. (a -> b) -> [a] -> [b]
map (((T w, T) -> Count -> ((T w, T), Count))
-> Count -> (T w, T) -> ((T w, T), Count)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Count
cnt) ([(T w, T)] -> [((T w, T), Count)])
-> [(T w, T)] -> [((T w, T), Count)]
forall a b. (a -> b) -> a -> b
$ [(T w, T)] -> [(T w, T)]
forall w fleet. Nat w => [(T w, fleet)] -> [(T w, fleet)]
mergeSymmetricFrontiers ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
((T w, T) -> (T w, T)) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T w -> T w) -> (T w, T) -> (T w, T)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Size w -> T w -> T w
forall w. Size w -> T w -> T w
Frontier.dilate Size w
width)) ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
Size w -> T -> T w -> T -> [(T w, T)]
forall w. Nat w => Size w -> T -> T w -> T -> [(T w, T)]
transitionFrontierBounded Size w
width T
maxFleet T w
frontier T
fleet) ([((T w, T), Count)] -> [CountMap w])
-> (CountMap w -> [((T w, T), Count)])
-> CountMap w
-> [CountMap w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> [((T w, T), Count)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
nextFrontierBoundedExternal ::
(Nat w) => Size w -> Fleet.T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierBoundedExternal :: Size w -> T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierBoundedExternal Size w
width T
maxFleet CountMapPath w
path =
CountMapPath w -> [[KeyCount w Count]] -> IO ()
forall a w.
(C a, Storable a) =>
Path w a -> [[KeyCount w a]] -> IO ()
CountMap.writeSorted CountMapPath w
path ([[KeyCount w Count]] -> IO ())
-> (CountMap w -> [[KeyCount w Count]]) -> CountMap w -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([KeyCount w Count] -> [KeyCount w Count])
-> [[KeyCount w Count]] -> [[KeyCount w Count]]
forall a b. (a -> b) -> [a] -> [b]
map
((KeyCount w Count -> [KeyCount w Count])
-> [KeyCount w Count] -> [KeyCount w Count]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\((T w
frontier,T
fleet), Count
cnt) ->
((T w, T) -> KeyCount w Count) -> [(T w, T)] -> [KeyCount w Count]
forall a b. (a -> b) -> [a] -> [b]
map (((T w, T) -> Count -> KeyCount w Count)
-> Count -> (T w, T) -> KeyCount w Count
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Count
cnt) ([(T w, T)] -> [KeyCount w Count])
-> [(T w, T)] -> [KeyCount w Count]
forall a b. (a -> b) -> a -> b
$ [(T w, T)] -> [(T w, T)]
forall w fleet. Nat w => [(T w, fleet)] -> [(T w, fleet)]
mergeSymmetricFrontiers ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
((T w, T) -> (T w, T)) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T w -> T w) -> (T w, T) -> (T w, T)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Size w -> T w -> T w
forall w. Size w -> T w -> T w
Frontier.dilate Size w
width)) ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
Size w -> T -> T w -> T -> [(T w, T)]
forall w. Nat w => Size w -> T -> T w -> T -> [(T w, T)]
transitionFrontierBounded Size w
width T
maxFleet T w
frontier T
fleet)) ([[KeyCount w Count]] -> [[KeyCount w Count]])
-> (CountMap w -> [[KeyCount w Count]])
-> CountMap w
-> [[KeyCount w Count]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Position -> [KeyCount w Count] -> [[KeyCount w Count]]
forall a. Position -> [a] -> [[a]]
ListHT.sliceVertical Position
bucketSize ([KeyCount w Count] -> [[KeyCount w Count]])
-> (CountMap w -> [KeyCount w Count])
-> CountMap w
-> [[KeyCount w Count]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> [KeyCount w Count]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
transitionFrontierBounded ::
(Nat w) =>
Size w -> Fleet.T -> Frontier.T w -> Fleet.T ->
[(Frontier.T w, Fleet.T)]
transitionFrontierBounded :: Size w -> T -> T w -> T -> [(T w, T)]
transitionFrontierBounded Size w
width T
maxFleet T w
oldFrontier =
let cumMaxFleet :: T
cumMaxFleet = T -> T
Fleet.cumulate T
maxFleet
go :: Position -> StateT (T w, T) [] ()
go Position
pos =
Bool -> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Size w -> Position -> Bool
forall w. Size w -> Position -> Bool
atEnd Size w
width Position
pos) (StateT (T w, T) [] () -> StateT (T w, T) [] ())
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$ do
(T w
frontier,T
fleet) <- StateT (T w, T) [] (T w, T)
forall (m :: * -> *) s. Monad m => StateT s m s
MS.get
case T w -> Position -> Use
forall w. Nat w => T w -> Position -> Use
Frontier.lookup T w
oldFrontier Position
pos of
Use
Frontier.Blocked -> Position -> StateT (T w, T) [] ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
Frontier.Vertical Position
n ->
(T -> T -> Position -> StateT (T w, T) [] ()
forall w. T -> T -> Position -> StateT (T w, T) [] ()
newShip T
cumMaxFleet T
maxFleet Position
n
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Bool -> StateT (T w, T) [] ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Position
n Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
maxShipSize) StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
T -> Position -> Position -> StateT (T w, T) [] ()
forall w.
Nat w =>
T -> Position -> Position -> StateT (T w, T) [] ()
insertVertical T
cumMaxFleet (Position
nPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1) Position
pos)
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Position -> StateT (T w, T) [] ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2))
Use
Frontier.Free ->
Position -> StateT (T w, T) [] ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(T -> Position -> Position -> StateT (T w, T) [] ()
forall w.
Nat w =>
T -> Position -> Position -> StateT (T w, T) [] ()
insertVertical T
cumMaxFleet Position
1 Position
pos StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Position -> StateT (T w, T) [] ()
go (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2))
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(T w
-> Position
-> Size w
-> [StateT (T w, T) [] ()]
-> StateT (T w, T) [] ()
forall w (f :: * -> *) a.
(Nat w, Alternative f) =>
T w -> Position -> Size w -> [f a] -> f a
asumTakeFrontier T w
oldFrontier Position
pos Size w
width ([StateT (T w, T) [] ()] -> StateT (T w, T) [] ())
-> [StateT (T w, T) [] ()] -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$
(Position -> Position -> T w -> StateT (T w, T) [] ())
-> [Position] -> [Position] -> [T w] -> [StateT (T w, T) [] ()]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
(\Position
newPos Position
shipSize T w
frontierUpdate -> do
(T w, T) -> StateT (T w, T) [] ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MS.put (T w
frontierUpdate,T
fleet)
T -> T -> Position -> StateT (T w, T) [] ()
forall w. T -> T -> Position -> StateT (T w, T) [] ()
newShip T
cumMaxFleet T
maxFleet Position
shipSize
Position -> StateT (T w, T) [] ()
go Position
newPos)
[Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
2 ..]
[Position
1 .. Position
Fleet.maxSize]
([T w] -> [T w]
forall a. [a] -> [a]
tail ([T w] -> [T w]) -> [T w] -> [T w]
forall a b. (a -> b) -> a -> b
$
(T w -> Position -> T w) -> T w -> [Position] -> [T w]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
((Position -> T w -> T w) -> T w -> Position -> T w
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Size w -> Position -> T w -> T w
forall w. Nat w => Size w -> Position -> T w -> T w
Frontier.blockBounded Size w
width))
T w
frontier [Position
pos ..]))
in StateT (T w, T) [] () -> (T w, T) -> [(T w, T)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
MS.execStateT (Position -> StateT (T w, T) [] ()
go Position
0) ((T w, T) -> [(T w, T)]) -> (T -> (T w, T)) -> T -> [(T w, T)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) T w
forall w. T w
Frontier.empty
countBounded :: (Nat w) => (Size w, Int) -> Fleet.T -> Count
countBounded :: (Size w, Position) -> T -> Count
countBounded (Size w
width,Position
height) T
reqFleet =
T -> T w Count -> Count
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
reqFleet (T w Count -> Count) -> T w Count -> Count
forall a b. (a -> b) -> a -> b
$
Position -> (T w Count -> T w Count) -> T w Count -> T w Count
forall a. Position -> (a -> a) -> a -> a
nest Position
height (Size w -> T -> T w Count -> T w Count
forall w. Nat w => Size w -> T -> CountMap w -> CountMap w
nextFrontierBounded Size w
width T
reqFleet) (T w Count -> T w Count) -> T w Count -> T w Count
forall a b. (a -> b) -> a -> b
$ Size w -> T w Count
forall w. Size w -> CountMap w
baseCase Size w
width
nextFrontierTouching :: (Nat w) => Size w -> Fleet.T -> CountMap w -> CountMap w
nextFrontierTouching :: Size w -> T -> CountMap w -> CountMap w
nextFrontierTouching Size w
width T
maxFleet =
[CountMap w] -> CountMap w
forall a w. (C a, Storable a) => [T w a] -> T w a
CountMap.mergeMany ([CountMap w] -> CountMap w)
-> (CountMap w -> [CountMap w]) -> CountMap w -> CountMap w
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((T w, T), Count) -> CountMap w)
-> [((T w, T), Count)] -> [CountMap w]
forall a b. (a -> b) -> [a] -> [b]
map
(\((T w
frontier,T
fleet), Count
cnt) ->
[((T w, T), Count)] -> CountMap w
forall a w. (C a, Storable a) => [KeyCount w a] -> T w a
CountMap.fromList ([((T w, T), Count)] -> CountMap w)
-> [((T w, T), Count)] -> CountMap w
forall a b. (a -> b) -> a -> b
$
((T w, T) -> ((T w, T), Count))
-> [(T w, T)] -> [((T w, T), Count)]
forall a b. (a -> b) -> [a] -> [b]
map (((T w, T) -> Count -> ((T w, T), Count))
-> Count -> (T w, T) -> ((T w, T), Count)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Count
cnt) ([(T w, T)] -> [((T w, T), Count)])
-> [(T w, T)] -> [((T w, T), Count)]
forall a b. (a -> b) -> a -> b
$ [(T w, T)] -> [(T w, T)]
forall w fleet. Nat w => [(T w, fleet)] -> [(T w, fleet)]
mergeSymmetricFrontiers ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
Size w -> T -> T w -> T -> [(T w, T)]
forall w. Nat w => Size w -> T -> T w -> T -> [(T w, T)]
transitionFrontierTouching Size w
width T
maxFleet T w
frontier T
fleet) ([((T w, T), Count)] -> [CountMap w])
-> (CountMap w -> [((T w, T), Count)])
-> CountMap w
-> [CountMap w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> [((T w, T), Count)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
nextFrontierTouchingExternal ::
(Nat w) => Size w -> Fleet.T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierTouchingExternal :: Size w -> T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierTouchingExternal Size w
width T
maxFleet CountMapPath w
path =
CountMapPath w -> [[KeyCount w Count]] -> IO ()
forall a w.
(C a, Storable a) =>
Path w a -> [[KeyCount w a]] -> IO ()
CountMap.writeSorted CountMapPath w
path ([[KeyCount w Count]] -> IO ())
-> (CountMap w -> [[KeyCount w Count]]) -> CountMap w -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([KeyCount w Count] -> [KeyCount w Count])
-> [[KeyCount w Count]] -> [[KeyCount w Count]]
forall a b. (a -> b) -> [a] -> [b]
map
((KeyCount w Count -> [KeyCount w Count])
-> [KeyCount w Count] -> [KeyCount w Count]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\((T w
frontier,T
fleet), Count
cnt) ->
((T w, T) -> KeyCount w Count) -> [(T w, T)] -> [KeyCount w Count]
forall a b. (a -> b) -> [a] -> [b]
map (((T w, T) -> Count -> KeyCount w Count)
-> Count -> (T w, T) -> KeyCount w Count
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Count
cnt) ([(T w, T)] -> [KeyCount w Count])
-> [(T w, T)] -> [KeyCount w Count]
forall a b. (a -> b) -> a -> b
$ [(T w, T)] -> [(T w, T)]
forall w fleet. Nat w => [(T w, fleet)] -> [(T w, fleet)]
mergeSymmetricFrontiers ([(T w, T)] -> [(T w, T)]) -> [(T w, T)] -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$
Size w -> T -> T w -> T -> [(T w, T)]
forall w. Nat w => Size w -> T -> T w -> T -> [(T w, T)]
transitionFrontierTouching Size w
width T
maxFleet T w
frontier T
fleet)) ([[KeyCount w Count]] -> [[KeyCount w Count]])
-> (CountMap w -> [[KeyCount w Count]])
-> CountMap w
-> [[KeyCount w Count]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Position -> [KeyCount w Count] -> [[KeyCount w Count]]
forall a. Position -> [a] -> [[a]]
ListHT.sliceVertical Position
bucketSize ([KeyCount w Count] -> [[KeyCount w Count]])
-> (CountMap w -> [KeyCount w Count])
-> CountMap w
-> [[KeyCount w Count]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> [KeyCount w Count]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
transitionFrontierTouching ::
(Nat w) =>
Size w -> Fleet.T -> Frontier.T w -> Fleet.T -> [(Frontier.T w, Fleet.T)]
transitionFrontierTouching :: Size w -> T -> T w -> T -> [(T w, T)]
transitionFrontierTouching Size w
width T
maxFleet T w
oldFrontier =
let cumMaxFleet :: T
cumMaxFleet = T -> T
Fleet.cumulate T
maxFleet
finishVerticals :: Position -> StateT (T w, T) [] ()
finishVerticals Position
pos =
case T w -> Position -> Use
forall w. Nat w => T w -> Position -> Use
Frontier.lookup T w
oldFrontier Position
pos of
Use
Frontier.Blocked ->
[Char] -> StateT (T w, T) [] ()
forall a. HasCallStack => [Char] -> a
error [Char]
"in touching mode there must be no blocked fields"
Frontier.Vertical Position
n ->
(Bool -> StateT (T w, T) [] ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Position
n Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
maxShipSize) StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
T -> Position -> Position -> StateT (T w, T) [] ()
forall w.
Nat w =>
T -> Position -> Position -> StateT (T w, T) [] ()
insertVertical T
cumMaxFleet (Position
nPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1) Position
pos)
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
T -> T -> Position -> StateT (T w, T) [] ()
forall w. T -> T -> Position -> StateT (T w, T) [] ()
newShip T
cumMaxFleet T
maxFleet Position
n
Use
Frontier.Free -> () -> StateT (T w, T) [] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
startNewShips :: Position -> StateT (T w, T) [] ()
startNewShips Position
pos =
Bool -> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Size w -> Position -> Bool
forall w. Size w -> Position -> Bool
atEnd Size w
width Position
pos) (StateT (T w, T) [] () -> StateT (T w, T) [] ())
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$ do
T w
frontier <- ((T w, T) -> T w) -> StateT (T w, T) [] (T w)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (T w, T) -> T w
forall a b. (a, b) -> a
fst
case T w -> Position -> Use
forall w. Nat w => T w -> Position -> Use
Frontier.lookup T w
frontier Position
pos of
Use
Frontier.Blocked ->
[Char] -> StateT (T w, T) [] ()
forall a. HasCallStack => [Char] -> a
error [Char]
"finishVerticals must not block fields"
Frontier.Vertical Position
_ ->
Position -> StateT (T w, T) [] ()
startNewShips (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
Use
Frontier.Free ->
Position -> StateT (T w, T) [] ()
startNewShips (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1)
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(T -> Position -> Position -> StateT (T w, T) [] ()
forall w.
Nat w =>
T -> Position -> Position -> StateT (T w, T) [] ()
insertVertical T
cumMaxFleet Position
1 Position
pos StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Position -> StateT (T w, T) [] ()
startNewShips (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1))
StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(T w
-> Position
-> Size w
-> [StateT (T w, T) [] ()]
-> StateT (T w, T) [] ()
forall w (f :: * -> *) a.
(Nat w, Alternative f) =>
T w -> Position -> Size w -> [f a] -> f a
asumTakeFrontier T w
frontier Position
pos Size w
width ([StateT (T w, T) [] ()] -> StateT (T w, T) [] ())
-> [StateT (T w, T) [] ()] -> StateT (T w, T) [] ()
forall a b. (a -> b) -> a -> b
$
(Position -> StateT (T w, T) [] ())
-> [Position] -> [StateT (T w, T) [] ()]
forall a b. (a -> b) -> [a] -> [b]
map
(\Position
shipSize ->
T -> T -> Position -> StateT (T w, T) [] ()
forall w. T -> T -> Position -> StateT (T w, T) [] ()
newShip T
cumMaxFleet T
maxFleet Position
shipSize StateT (T w, T) [] ()
-> StateT (T w, T) [] () -> StateT (T w, T) [] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Position -> StateT (T w, T) [] ()
startNewShips (Position
posPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
shipSize)) ([Position] -> [StateT (T w, T) [] ()])
-> [Position] -> [StateT (T w, T) [] ()]
forall a b. (a -> b) -> a -> b
$
[Position
1 .. Position
Fleet.maxSize])
in \T
fleet -> (StateT (T w, T) [] () -> (T w, T) -> [(T w, T)])
-> (T w, T) -> StateT (T w, T) [] () -> [(T w, T)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (T w, T) [] () -> (T w, T) -> [(T w, T)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
MS.execStateT (T w
forall w. T w
Frontier.empty, T
fleet) (StateT (T w, T) [] () -> [(T w, T)])
-> StateT (T w, T) [] () -> [(T w, T)]
forall a b. (a -> b) -> a -> b
$ do
(Position -> StateT (T w, T) [] ())
-> [Position] -> StateT (T w, T) [] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Position -> StateT (T w, T) [] ()
forall w. Nat w => Position -> StateT (T w, T) [] ()
finishVerticals (Size w -> [Position]
forall w. Nat w => Size w -> [Position]
widthRange Size w
width)
Position -> StateT (T w, T) [] ()
startNewShips Position
0
countTouching :: (Nat w) => (Size w, Int) -> Fleet.T -> Count
countTouching :: (Size w, Position) -> T -> Count
countTouching (Size w
width,Position
height) T
reqFleet =
T -> T w Count -> Count
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
reqFleet (T w Count -> Count) -> T w Count -> Count
forall a b. (a -> b) -> a -> b
$
Position -> (T w Count -> T w Count) -> T w Count -> T w Count
forall a. Position -> (a -> a) -> a -> a
nest Position
height (Size w -> T -> T w Count -> T w Count
forall w. Nat w => Size w -> T -> CountMap w -> CountMap w
nextFrontierTouching Size w
width T
reqFleet) (T w Count -> T w Count) -> T w Count -> T w Count
forall a b. (a -> b) -> a -> b
$ Size w -> T w Count
forall w. Size w -> CountMap w
baseCase Size w
width
canonicalFrontier :: (Nat w) => Frontier.T w -> Frontier.T w
canonicalFrontier :: T w -> T w
canonicalFrontier T w
fr = T w -> T w -> T w
forall a. Ord a => a -> a -> a
min T w
fr (T w -> T w
forall w. Nat w => T w -> T w
Frontier.reverse T w
fr)
mergeSymmetricFrontiers ::
(Nat w) => [(Frontier.T w, fleet)] -> [(Frontier.T w, fleet)]
mergeSymmetricFrontiers :: [(T w, fleet)] -> [(T w, fleet)]
mergeSymmetricFrontiers = ((T w, fleet) -> (T w, fleet)) -> [(T w, fleet)] -> [(T w, fleet)]
forall a b. (a -> b) -> [a] -> [b]
map ((T w -> T w) -> (T w, fleet) -> (T w, fleet)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst T w -> T w
forall w. Nat w => T w -> T w
canonicalFrontier)
fleetAtFrontier :: Frontier.T w -> Fleet.T
fleetAtFrontier :: T w -> T
fleetAtFrontier =
(Use -> T) -> T w -> T
forall m w. Monoid m => (Use -> m) -> T w -> m
Frontier.foldMap
(\Use
use ->
case Use
use of
Frontier.Vertical Position
n -> Position -> Position -> T
Fleet.singleton Position
n Position
1
Use
_ -> T
Fleet.empty)
addFrontierFleet :: Frontier.T w -> Fleet.T -> Fleet.T
addFrontierFleet :: T w -> T -> T
addFrontierFleet T w
frontier = T -> T -> T
forall a. Monoid a => a -> a -> a
mappend (T -> T -> T) -> T -> T -> T
forall a b. (a -> b) -> a -> b
$ T w -> T
forall w. T w -> T
fleetAtFrontier T w
frontier
{-# SPECIALISE countBoundedFromMap :: Fleet.T -> CountMap w -> Count #-}
countBoundedFromMap ::
(Counter.C a, Storable a) => Fleet.T -> CountMap.T w a -> a
countBoundedFromMap :: T -> T w a -> a
countBoundedFromMap T
reqFleet =
[a] -> a
forall a. C a => [a] -> a
Counter.sum ([a] -> a) -> (T w a -> [a]) -> T w a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((T w, T), a) -> a) -> [((T w, T), a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((T w, T), a) -> a
forall a b. (a, b) -> b
snd ([((T w, T), a)] -> [a])
-> (T w a -> [((T w, T), a)]) -> T w a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((T w, T), a) -> Bool) -> [((T w, T), a)] -> [((T w, T), a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((T w
front,T
fleet), a
_) ->
T w -> T -> T
forall w. T w -> T -> T
addFrontierFleet T w
front T
fleet T -> T -> Bool
forall a. Eq a => a -> a -> Bool
== T
reqFleet) ([((T w, T), a)] -> [((T w, T), a)])
-> (T w a -> [((T w, T), a)]) -> T w a -> [((T w, T), a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T w a -> [((T w, T), a)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
countBoundedFleetsFromMap :: CountMap w -> Map Fleet.T Integer
countBoundedFleetsFromMap :: CountMap w -> Map T Integer
countBoundedFleetsFromMap =
(Integer -> Integer -> Integer) -> [(T, Integer)] -> Map T Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) ([(T, Integer)] -> Map T Integer)
-> (CountMap w -> [(T, Integer)]) -> CountMap w -> Map T Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((T w, T), Count) -> (T, Integer))
-> [((T w, T), Count)] -> [(T, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (\((T w
front,T
fleet), Count
cnt) ->
(T w -> T -> T
forall w. T w -> T -> T
addFrontierFleet T w
front T
fleet,
Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger Count
cnt)) ([((T w, T), Count)] -> [(T, Integer)])
-> (CountMap w -> [((T w, T), Count)])
-> CountMap w
-> [(T, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> [((T w, T), Count)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList
countBoundedFleetsFromMap_ :: CountMap w -> Map Fleet.T Integer
countBoundedFleetsFromMap_ :: CountMap w -> Map T Integer
countBoundedFleetsFromMap_ =
(Integer -> Integer -> Integer)
-> ((T w, T) -> T) -> Map (T w, T) Integer -> Map T Integer
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) ((T w -> T -> T) -> (T w, T) -> T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T w -> T -> T
forall w. T w -> T -> T
addFrontierFleet) (Map (T w, T) Integer -> Map T Integer)
-> (CountMap w -> Map (T w, T) Integer)
-> CountMap w
-> Map T Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Count -> Integer) -> Map (T w, T) Count -> Map (T w, T) Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger (Map (T w, T) Count -> Map (T w, T) Integer)
-> (CountMap w -> Map (T w, T) Count)
-> CountMap w
-> Map (T w, T) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap w -> Map (T w, T) Count
forall a w. Storable a => T w a -> Map (Key w) a
CountMap.toMap
countSingleKind :: IO ()
countSingleKind :: IO ()
countSingleKind =
((Position, Position) -> IO ()) -> [(Position, Position)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(Count -> IO ()
forall a. Show a => a -> IO ()
print (Count -> IO ())
-> ((Position, Position) -> Count) -> (Position, Position) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size N10, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size N10
n10,Position
10) (T -> Count)
-> ((Position, Position) -> T) -> (Position, Position) -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Position, Position)] -> T
Fleet.fromList ([(Position, Position)] -> T)
-> ((Position, Position) -> [(Position, Position)])
-> (Position, Position)
-> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Position, Position)
-> [(Position, Position)] -> [(Position, Position)]
forall a. a -> [a] -> [a]
:[]))
[(Position
5,Position
1), (Position
4,Position
2), (Position
3,Position
3), (Position
2,Position
4)]
count8x8 :: IO ()
count8x8 :: IO ()
count8x8 =
let reqFleet :: T
reqFleet = T
Fleet.english
width :: Size N8
width = Size N8
n8
height :: Position
height = Position
8
in CountMap N8
-> (T -> Path N8 Count -> CountMap N8 -> IO ())
-> Position
-> T
-> IO ()
forall a w.
(C a, Storable a, Show a) =>
CountMap w
-> (T -> Path w a -> T w a -> IO ()) -> Position -> T -> IO ()
reportCounts
(Size N8 -> CountMap N8
forall w. Size w -> CountMap w
baseCase Size N8
width) (Size N8 -> T -> Path N8 Count -> CountMap N8 -> IO ()
forall w.
Nat w =>
Size w -> T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierTouchingExternal Size N8
width)
Position
height T
reqFleet
countTouchingExternalReturn ::
Nat w => (Size w, Int) -> Fleet.T -> IO Count
countTouchingExternalReturn :: (Size w, Position) -> T -> IO Count
countTouchingExternalReturn (Size w
width, Position
height) =
CountMap w
-> (T -> Path w Count -> CountMap w -> IO ())
-> Position
-> T
-> IO Count
forall a w.
(C a, Storable a) =>
CountMap w
-> (T -> Path w a -> T w a -> IO ()) -> Position -> T -> IO a
countExternalGen (Size w -> CountMap w
forall w. Size w -> CountMap w
baseCase Size w
width) (Size w -> T -> Path w Count -> CountMap w -> IO ()
forall w.
Nat w =>
Size w -> T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierTouchingExternal Size w
width) Position
height
count10x10 :: IO ()
count10x10 :: IO ()
count10x10 =
Count -> IO ()
forall a. Show a => a -> IO ()
print (Count -> IO ()) -> Count -> IO ()
forall a b. (a -> b) -> a -> b
$ (Size N10, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size N10
n10,Position
10) T
Fleet.english
countStandard :: IO ()
countStandard :: IO ()
countStandard =
let
reqFleet :: T
reqFleet = T
Fleet.english
width :: Size N10
width = Size N10
n10
height :: Position
height = Position
12
in (T N10 Count -> IO ()) -> [T N10 Count] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Count -> IO ()
forall a. Show a => a -> IO ()
print (Count -> IO ()) -> (T N10 Count -> Count) -> T N10 Count -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T N10 Count -> Count
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
reqFleet) ([T N10 Count] -> IO ()) -> [T N10 Count] -> IO ()
forall a b. (a -> b) -> a -> b
$
Position -> [T N10 Count] -> [T N10 Count]
forall a. Position -> [a] -> [a]
take (Position
heightPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
1) ([T N10 Count] -> [T N10 Count]) -> [T N10 Count] -> [T N10 Count]
forall a b. (a -> b) -> a -> b
$
(T N10 Count -> T N10 Count) -> T N10 Count -> [T N10 Count]
forall a. (a -> a) -> a -> [a]
iterate (Size N10 -> T -> T N10 Count -> T N10 Count
forall w. Nat w => Size w -> T -> CountMap w -> CountMap w
nextFrontierBounded Size N10
width T
reqFleet) (T N10 Count -> [T N10 Count]) -> T N10 Count -> [T N10 Count]
forall a b. (a -> b) -> a -> b
$
Size N10 -> T N10 Count
forall w. Size w -> CountMap w
baseCase Size N10
width
bucketSize :: Int
bucketSize :: Position
bucketSize = Position
2Position -> Position -> Position
forall a b. (Num a, Integral b) => a -> b -> a
^(Position
14::Int)
tmpPath :: Int -> CountMap.Path w a
tmpPath :: Position -> Path w a
tmpPath = [Char] -> Path w a
forall w a. [Char] -> Path w a
CountMap.Path ([Char] -> Path w a)
-> (Position -> [Char]) -> Position -> Path w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Position -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"/tmp/battleship%02d"
writeTmpCountMap :: Int -> CountMap w -> IO ()
writeTmpCountMap :: Position -> CountMap w -> IO ()
writeTmpCountMap = Path w Count -> CountMap w -> IO ()
forall a w. Storable a => Path w a -> T w a -> IO ()
CountMap.writeFile (Path w Count -> CountMap w -> IO ())
-> (Position -> Path w Count) -> Position -> CountMap w -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Path w Count
forall w a. Position -> Path w a
tmpPath
writeTmps :: IO ()
writeTmps :: IO ()
writeTmps =
let width :: Size N10
width = Size N10
n10
in (Position -> T N10 Count -> IO ())
-> [Position] -> [T N10 Count] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Position -> T N10 Count -> IO ()
forall w. Position -> CountMap w -> IO ()
writeTmpCountMap [Position
0 ..] ([T N10 Count] -> IO ()) -> [T N10 Count] -> IO ()
forall a b. (a -> b) -> a -> b
$
(T N10 Count -> T N10 Count) -> T N10 Count -> [T N10 Count]
forall a. (a -> a) -> a -> [a]
iterate (Size N10 -> T -> T N10 Count -> T N10 Count
forall w. Nat w => Size w -> T -> CountMap w -> CountMap w
nextFrontierBounded Size N10
width T
Fleet.german) (T N10 Count -> [T N10 Count]) -> T N10 Count -> [T N10 Count]
forall a b. (a -> b) -> a -> b
$
Size N10 -> T N10 Count
forall w. Size w -> CountMap w
baseCase Size N10
width
countExternalGen ::
(Counter.C a, Storable a) =>
CountMap w ->
(Fleet.T -> CountMap.Path w a -> CountMap.T w a -> IO ()) ->
Int -> Fleet.T -> IO a
countExternalGen :: CountMap w
-> (T -> Path w a -> T w a -> IO ()) -> Position -> T -> IO a
countExternalGen CountMap w
base T -> Path w a -> T w a -> IO ()
next Position
height T
fleet = do
Position -> CountMap w -> IO ()
forall w. Position -> CountMap w -> IO ()
writeTmpCountMap Position
0 CountMap w
base
let pathPairs :: [(Path w a, Path w a)]
pathPairs = (Path w a -> Path w a -> (Path w a, Path w a))
-> [Path w a] -> [(Path w a, Path w a)]
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent (,) ([Path w a] -> [(Path w a, Path w a)])
-> [Path w a] -> [(Path w a, Path w a)]
forall a b. (a -> b) -> a -> b
$ (Position -> Path w a) -> [Position] -> [Path w a]
forall a b. (a -> b) -> [a] -> [b]
map Position -> Path w a
forall w a. Position -> Path w a
tmpPath [Position
0 .. Position
height]
[(Path w a, Path w a)] -> ((Path w a, Path w a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Path w a, Path w a)]
forall w a. [(Path w a, Path w a)]
pathPairs (((Path w a, Path w a) -> IO ()) -> IO ())
-> ((Path w a, Path w a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Path w a
src,Path w a
dst) ->
T -> Path w a -> T w a -> IO ()
next T
fleet Path w a
dst (T w a -> IO ()) -> IO (T w a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path w a -> IO (T w a)
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile Path w a
src
(T Any a -> a) -> IO (T Any a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T -> T Any a -> a
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
fleet) (IO (T Any a) -> IO a) -> IO (T Any a) -> IO a
forall a b. (a -> b) -> a -> b
$ Path Any a -> IO (T Any a)
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile (Path Any a -> IO (T Any a)) -> Path Any a -> IO (T Any a)
forall a b. (a -> b) -> a -> b
$ Position -> Path Any a
forall w a. Position -> Path w a
tmpPath Position
height
countExternalReturn ::
Nat w => (Size w, Int) -> Fleet.T -> IO Count
countExternalReturn :: (Size w, Position) -> T -> IO Count
countExternalReturn (Size w
width, Position
height) =
CountMap w
-> (T -> Path w Count -> CountMap w -> IO ())
-> Position
-> T
-> IO Count
forall a w.
(C a, Storable a) =>
CountMap w
-> (T -> Path w a -> T w a -> IO ()) -> Position -> T -> IO a
countExternalGen (Size w -> CountMap w
forall w. Size w -> CountMap w
baseCase Size w
width) (Size w -> T -> Path w Count -> CountMap w -> IO ()
forall w.
Nat w =>
Size w -> T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierBoundedExternal Size w
width) Position
height
reportCounts ::
(Counter.C a, Storable a, Show a) =>
CountMap w ->
(Fleet.T -> CountMap.Path w a -> CountMap.T w a -> IO ()) ->
Int -> Fleet.T -> IO ()
reportCounts :: CountMap w
-> (T -> Path w a -> T w a -> IO ()) -> Position -> T -> IO ()
reportCounts CountMap w
base T -> Path w a -> T w a -> IO ()
next Position
height T
fleet = do
Position -> CountMap w -> IO ()
forall w. Position -> CountMap w -> IO ()
writeTmpCountMap Position
0 CountMap w
base
let pathPairs :: [(Path w a, Path w a)]
pathPairs = (Path w a -> Path w a -> (Path w a, Path w a))
-> [Path w a] -> [(Path w a, Path w a)]
forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent (,) ([Path w a] -> [(Path w a, Path w a)])
-> [Path w a] -> [(Path w a, Path w a)]
forall a b. (a -> b) -> a -> b
$ (Position -> Path w a) -> [Position] -> [Path w a]
forall a b. (a -> b) -> [a] -> [b]
map Position -> Path w a
forall w a. Position -> Path w a
tmpPath [Position
0 .. Position
height]
[(Path w a, Path w a)] -> ((Path w a, Path w a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Path w a, Path w a)]
forall w a. [(Path w a, Path w a)]
pathPairs (((Path w a, Path w a) -> IO ()) -> IO ())
-> ((Path w a, Path w a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Path w a
src,Path w a
dst) -> do
T -> Path w a -> T w a -> IO ()
next T
fleet Path w a
dst (T w a -> IO ()) -> IO (T w a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path w a -> IO (T w a)
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile Path w a
src
a -> IO ()
forall a. Show a => a -> IO ()
print (a -> IO ()) -> (T w a -> a) -> T w a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T w a -> a
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
fleet (T w a -> IO ()) -> IO (T w a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path w a -> IO (T w a)
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile Path w a
dst
countExternal :: IO ()
countExternal :: IO ()
countExternal =
let width :: Size N10
width = Size N10
n10
height :: Position
height = Position
10
in T N10 Count
-> (T -> Path N10 Count -> T N10 Count -> IO ())
-> Position
-> T
-> IO ()
forall a w.
(C a, Storable a, Show a) =>
CountMap w
-> (T -> Path w a -> T w a -> IO ()) -> Position -> T -> IO ()
reportCounts
(Size N10 -> T N10 Count
forall w. Size w -> CountMap w
baseCase Size N10
width) (Size N10 -> T -> Path N10 Count -> T N10 Count -> IO ()
forall w.
Nat w =>
Size w -> T -> CountMapPath w -> CountMap w -> IO ()
nextFrontierBoundedExternal Size N10
width)
Position
height T
Fleet.german
countFleets :: IO ()
countFleets :: IO ()
countFleets =
([Char] -> IO ()) -> Map T [Char] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Fold.mapM_ [Char] -> IO ()
putStrLn (Map T [Char] -> IO ())
-> (CountMap Any -> Map T [Char]) -> CountMap Any -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(T -> Integer -> [Char]) -> Map T Integer -> Map T [Char]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
(\T
fleet Integer
cnt ->
[Char]
"|-\n| " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" || "
((Position -> [Char]) -> [Position] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((\Position
n -> if Position
nPosition -> Position -> Bool
forall a. Eq a => a -> a -> Bool
==Position
0 then [Char]
" " else Position -> [Char]
forall a. Show a => a -> [Char]
show Position
n) (Position -> [Char])
-> (Position -> Position) -> Position -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Position -> Position
Fleet.lookup T
fleet) [Position
2..Position
5]
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
cnt])) (Map T Integer -> Map T [Char])
-> (CountMap Any -> Map T Integer) -> CountMap Any -> Map T [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(T -> Integer -> Bool) -> Map T Integer -> Map T Integer
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\T
fleet Integer
_cnt -> T -> T -> Bool
Fleet.subset T
fleet T
Fleet.german) (Map T Integer -> Map T Integer)
-> (CountMap Any -> Map T Integer) -> CountMap Any -> Map T Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CountMap Any -> Map T Integer
forall w. CountMap w -> Map T Integer
countBoundedFleetsFromMap (CountMap Any -> IO ()) -> IO (CountMap Any) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Path Any Count -> IO (CountMap Any)
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile (Position -> Path Any Count
forall w a. Position -> Path w a
tmpPath Position
10)
printMapSizes :: IO ()
printMapSizes :: IO ()
printMapSizes =
(T N10 Count -> IO ()) -> [T N10 Count] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Position -> IO ()
forall a. Show a => a -> IO ()
print (Position -> IO ())
-> (T N10 Count -> Position) -> T N10 Count -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T N10 Count -> Position
forall w a. T w a -> Position
CountMap.size) ([T N10 Count] -> IO ()) -> [T N10 Count] -> IO ()
forall a b. (a -> b) -> a -> b
$
(T N10 Count -> T N10 Count) -> T N10 Count -> [T N10 Count]
forall a. (a -> a) -> a -> [a]
iterate (Size N10 -> T -> T N10 Count -> T N10 Count
forall w. Nat w => Size w -> T -> CountMap w -> CountMap w
nextFrontierBounded Size N10
n10 T
Fleet.german) (T N10 Count -> [T N10 Count]) -> T N10 Count -> [T N10 Count]
forall a b. (a -> b) -> a -> b
$
Size N10 -> T N10 Count
forall w. Size w -> CountMap w
baseCase Size N10
n10
genShip :: QC.Gen Fleet.ShipSize
genShip :: Gen Position
genShip = (Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
1, Position
maxShipSize)
genFleet :: QC.Gen Fleet.T
genFleet :: Gen T
genFleet = ([Position] -> T) -> Gen [Position] -> Gen T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Position] -> T
Fleet.fromSizes (Gen [Position] -> Gen T) -> Gen [Position] -> Gen T
forall a b. (a -> b) -> a -> b
$ (Position -> Gen Position -> Gen [Position])
-> Gen Position -> Position -> Gen [Position]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Position -> Gen Position -> Gen [Position]
forall a. Position -> Gen a -> Gen [a]
QC.vectorOf Gen Position
genShip (Position -> Gen [Position]) -> Gen Position -> Gen [Position]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
4)
propCountSymmetry :: QC.Property
propCountSymmetry :: Property
propCountSymmetry =
Gen T -> (T -> [T]) -> (T -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Bool) -> Property) -> (T -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
let d :: Integer
d =
case Position -> Position -> Position
forall a. Integral a => a -> a -> a
mod ([Position] -> Position
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Position] -> Position) -> [Position] -> Position
forall a b. (a -> b) -> a -> b
$ ((Position, Position) -> Position)
-> [(Position, Position)] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map ((Position -> Position -> Position)
-> (Position, Position) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Position -> Position -> Position
forall a. Num a => a -> a -> a
(*)) ([(Position, Position)] -> [Position])
-> [(Position, Position)] -> [Position]
forall a b. (a -> b) -> a -> b
$ T -> [(Position, Position)]
Fleet.toList T
fleet) Position
4 of
Position
0 -> Integer
1
Position
2 -> Integer
2
Position
_ ->
if (Position -> Bool) -> [Position] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Position -> Bool
forall a. Integral a => a -> Bool
odd ([Position] -> Bool) -> [Position] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Position, Position) -> Position)
-> [(Position, Position)] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map ((Position -> Position -> Position)
-> (Position, Position) -> Position
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Position -> Position -> Position
forall a. Num a => a -> a -> a
(*)) ([(Position, Position)] -> [Position])
-> [(Position, Position)] -> [Position]
forall a b. (a -> b) -> a -> b
$ T -> [(Position, Position)]
Fleet.toList T
fleet
then Integer
8
else Integer
4
in Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger (Count -> Integer) -> Count -> Integer
forall a b. (a -> b) -> a -> b
$ (Size N6, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size N6
n6,Position
6) T
fleet) Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
propCountTransposed :: QC.Property
propCountTransposed :: Property
propCountTransposed =
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
4)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
width ->
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
8)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
height ->
Gen T -> (T -> [T]) -> (T -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Bool) -> Property) -> (T -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
Position -> (forall n. Nat n => Size n -> Bool) -> Bool
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
width ((forall n. Nat n => Size n -> Bool) -> Bool)
-> (forall n. Nat n => Size n -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Size n
w ->
Position -> (forall n. Nat n => Size n -> Bool) -> Bool
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
height ((forall n. Nat n => Size n -> Bool) -> Bool)
-> (forall n. Nat n => Size n -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Size n
h ->
(Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size n
w,Position
height) T
fleet Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== (Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size n
h,Position
width) T
fleet
propCountBounded :: QC.Property
propCountBounded :: Property
propCountBounded =
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
4)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
width ->
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
10)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
height ->
Gen T -> (T -> [T]) -> (T -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Bool) -> Property) -> (T -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
Position -> (forall n. Nat n => Size n -> Bool) -> Bool
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
width ((forall n. Nat n => Size n -> Bool) -> Bool)
-> (forall n. Nat n => Size n -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Size n
w ->
(Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
count (Size n
w,Position
height) T
fleet Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== (Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size n
w,Position
height) T
fleet
propCountTouchingTransposed :: QC.Property
propCountTouchingTransposed :: Property
propCountTouchingTransposed =
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
4)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
width ->
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
6)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
height ->
Position -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
width ((forall n. Nat n => Size n -> Property) -> Property)
-> (forall n. Nat n => Size n -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Size n
w ->
Position -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
height ((forall n. Nat n => Size n -> Property) -> Property)
-> (forall n. Nat n => Size n -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Size n
h ->
Gen T -> (T -> [T]) -> (T -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Bool) -> Property) -> (T -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
(Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countTouching (Size n
w,Position
height) T
fleet Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== (Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countTouching (Size n
h,Position
width) T
fleet
propCountMoreTouching :: QC.Property
propCountMoreTouching :: Property
propCountMoreTouching =
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
6)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
width ->
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
10)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
height ->
Gen T -> (T -> [T]) -> (T -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Bool) -> Property) -> (T -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
Position -> (forall n. Nat n => Size n -> Bool) -> Bool
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
width ((forall n. Nat n => Size n -> Bool) -> Bool)
-> (forall n. Nat n => Size n -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Size n
w ->
(Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countBounded (Size n
w,Position
height) T
fleet Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
<= (Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countTouching (Size n
w,Position
height) T
fleet
propCountExternal :: QC.Property
propCountExternal :: Property
propCountExternal =
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
4)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
width ->
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
10)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
height ->
Gen T -> (T -> [T]) -> (T -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Property) -> Property) -> (T -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
Position -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
width ((forall n. Nat n => Size n -> Property) -> Property)
-> (forall n. Nat n => Size n -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Size n
w -> PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
QCM.monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Count
c <- IO Count -> PropertyM IO Count
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO Count -> PropertyM IO Count) -> IO Count -> PropertyM IO Count
forall a b. (a -> b) -> a -> b
$ (Size n, Position) -> T -> IO Count
forall w. Nat w => (Size w, Position) -> T -> IO Count
countExternalReturn (Size n
w,Position
height) T
fleet
Bool -> PropertyM IO ()
forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QCM.assert (Bool -> PropertyM IO ()) -> Bool -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$ (Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
count (Size n
w,Position
height) T
fleet Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
c
propCountTouchingExternal :: QC.Property
propCountTouchingExternal :: Property
propCountTouchingExternal =
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
4)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
width ->
Gen Position
-> (Position -> [Position]) -> (Position -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Position, Position) -> Gen Position
forall a. Random a => (a, a) -> Gen a
QC.choose (Position
0,Position
10)) Position -> [Position]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Position -> Property) -> Property)
-> (Position -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Position
height ->
Gen T -> (T -> [T]) -> (T -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink Gen T
genFleet T -> [T]
forall a. Arbitrary a => a -> [a]
QC.shrink ((T -> Property) -> Property) -> (T -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \T
fleet ->
Position -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Position -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Position
width ((forall n. Nat n => Size n -> Property) -> Property)
-> (forall n. Nat n => Size n -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Size n
w -> PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
QCM.monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Count
c <- IO Count -> PropertyM IO Count
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO Count -> PropertyM IO Count) -> IO Count -> PropertyM IO Count
forall a b. (a -> b) -> a -> b
$ (Size n, Position) -> T -> IO Count
forall w. Nat w => (Size w, Position) -> T -> IO Count
countTouchingExternalReturn (Size n
w,Position
height) T
fleet
Bool -> PropertyM IO ()
forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QCM.assert (Bool -> PropertyM IO ()) -> Bool -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$ (Size n, Position) -> T -> Count
forall w. Nat w => (Size w, Position) -> T -> Count
countTouching (Size n
w,Position
height) T
fleet Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
c