{- |
In this approach I construct the board row by row from the bottom to the top.
In every step I maintain the necessary information
in order to know, what ships and positions and orientations
are allowed in the next row.
This information is stored in the Frontier.

possible optimization:
   "meet in the middle"
   compute counts for 5x10 boards and put them together,
   problem:
      for a given frontier there are many other half boards that may match
-}
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
-- type Count = Integer
-- type CountMap w = Map (CountMap.Key w) Count


-- * count all possible fleets on a board with given width

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


{- |
In this approach, the fleet contains all ships
also the ones at the frontier.
-}
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


-- * count fleets with an upper bound

{- |
Here we save memory and speed up the computation in the following way:
We stop searching deeper if

1. the fleet becomes larger than the requested fleet
    ("larger" means, that for at least one ship size
     the number of ships is larger than in the requested fleet)

2. the cumulated fleet becomes larger than the cumulated requested fleet
     This is necessary, since we do not know the final length
     of the vertical ships at the frontier.

In this approach,
the fleet does not contain the vertical ships at the frontier.
-}
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 =
--   foldMap is not efficient enough
--   foldl mappend mempty .    -- not efficient enough
   [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


{- |
This solves a different problem.
In this variant the ships are allowed to touch each other.
-}
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


-- * retrieve counts from count maps

{-# 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

{-
maybe this is not lazy enough and thus requires to much memory at once
-}
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


{-
*ShortenShip> let height=3::Int; width=10::Int; reqFleet = Fleet.fromList [(2,3),(3,1)]
(0.01 secs, 524480 bytes)

*ShortenShip> let counts = nest height (nextFrontier width) $ baseCase width in (Map.size counts, Fold.sum counts, Fold.maximum counts)
(658486,37986080,16640)
(77.32 secs, 9147062872 bytes)

*ShortenShip> let counts = nest height (nextFrontierBounded width reqFleet) $ baseCase width in (Map.size counts, Fold.sum counts, Fold.maximum counts)
(59485,870317,2295)
(41.05 secs, 4961028184 bytes)

This was computed, where we marked horizontal ships
instead of blocked columns.

*ShortenShip> let width=10::Int; reqFleet = Fleet.german
*ShortenShip> map Map.size $ iterate (nextFrontierBounded width reqFleet) $ baseCase width
[1,976,9441,129247,727781,Interrupted.

Here we switched to blocked columns and thus could merge some cases.
*ShortenShip> map Map.size $ iterate (nextFrontierBounded width reqFleet) $ baseCase width
[1,762,8712,110276,671283,Heap exhausted

Now merge symmetric cases.
*ShortenShip> map Map.size $ iterate (nextFrontierBounded width reqFleet) $ baseCase width
[1,400,4209,53897,331185,Heap exhausted

Now correctly stop searching, when we exceed the requested fleet
in a cumulative way.
*ShortenShip> map Map.size $ iterate (nextFrontierBounded width reqFleet) $ baseCase width
[1,400,2780,33861,156962,596354,1078596,
-}


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)]

{- | <http://math.stackexchange.com/questions/58769/how-many-ways-can-we-place-these-ships-on-this-board>
-}
count8x8 :: IO ()
count8x8 :: IO ()
count8x8 =
{-
   print $ countTouching (n8,8) Fleet.english
-}
   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

{-
0
0
0
24348
712180
8705828
50637316
193553688
571126760
-}

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


{- |
http://mathoverflow.net/questions/8374/battleship-permutations
-}
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

{-
width = 10
reqFleet = Fleet.english

0 (height 0)
0
0
28
3216
665992
7459236
49267288
212572080
703662748
1925751392 (height 10)
4558265312
9655606528
-}


countStandard :: IO ()
countStandard :: IO ()
countStandard =
   let -- reqFleet = Fleet.german
       reqFleet :: T
reqFleet = T
Fleet.english
       -- reqFleet = Fleet.fromList [(5,3), (3,3), (2,4)]
       -- reqFleet = Fleet.fromList [(5,1), (4,5), (2,4)]
       -- reqFleet = Fleet.fromList [(5,1), (4,2), (3,7)]
       -- reqFleet = Fleet.fromList [(5,1), (4,2), (3,3)]
       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

{-
width = 8

0 (height 0)
0
0
0
0
0
0
0
0
41590204
7638426604 (height 10)
362492015926
7519320122520
-}

{-
width = 9

0 (height 0)
0
0
0
0
0
0
3436
41590204 (height 8)
14057667720
810429191552
19372254431062
259204457356150 (height 12)
-}

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

{-
width = 10

0 (height 6)
13662566
7638426604
810429191552
26509655816984 (height 10)
430299058359872
4354180199012068
31106813918568460
170879359784006832
764137344189527328 (height 15)
2898295265655126580
9610725684470910308
28507470306925125256
76991108526373642970
191979866440965078136 (height 20)
446937970915638578082
980266021942073496100
2040665261937921277448
4057034306861698428948
7742825845480094358032
14247628010376642047600
25372084886315737302592
43866177282362611934648
73835392689835032947938
121284466564264656560792 (height 30)
194834219987709759902080
306653595670979763499532
473656349424114922202508
719020031938684168649088
1074093940268573906015112
1580772674048252559547360
2294422842530289843193622
3287462379238476844672168
4653704875700525771264888
6513595388626319121164932 (height 40)
9020479350315319743053840
12368062564291338311417712
16799237841455675768629728
22616472670702007858720088
30193972466229549593717002
39991855436006321943166520
52572598016253033812617552
68620034159721482069184188
88961217595210753573463188
114591483536481178478783072 (height 50)
146703075254771226052685400
186717731484777645553381392
236323662853505427847380798
297517379449112891075247688
372650867327049668352192392
464484649227692889820652980
576247304097610697944846232
711702061209803706344169808
875221127811075401295007088
1071868454331343083880616712 (height 60)
1307491688314503052228073010
1588824117417688619931354072
1923597453119688551212343968
2320666360224207858208417388
2790145692883833943588101532
3343561455750300075076754240
3994016569020196440013951912
4756372578636947840355038528
5647448517773937744162740838
6686238193004392201202597352 (height 70)
7894147238305325350349872920
9295251352289772187727329252
10916577208857975219414387488
12788407608848430883790544688
14944612520298020488691084672
17423007737631130160152847800
20265742975534986235203786842
23519721301486677943493929848
27237051901920789404168888688
31475538270909499207841886492 (height 80)
36299204007013709451418121380
41778858503698518338457830432
47992704921433432642323359608
55026992935361409746132575088
62976718861265404915127762062
71946375874530859216057441160
82050757151941778367149983272
93415814884501004073824213268
106179578231076248372025054888
120493133407586729455583375632 (height 90)
136521669234705095698870234640
154445591598700034393838411112
174461710415130814393910088578
196784502823670288688670584088
221647456484421865215555733952
249304496991752923240266671820
280031503570936389699101953452
314127917375817976286354988288
351918446862353195080976223688
393754874873229999431436186272 (height 100)

real    80m24.600s
user    76m33.675s
sys     2m22.601s
-}

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 =
            {-
            A single square is moved by any rotation or reflection.
            Two squares can have one symmetry.
            -}
            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 there is an odd sized ship without a partner
                 then there are no symmetries.
                 -}
                 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