module Combinatorics.Battleship.Count.ShortenShip.Distribution where

import qualified Combinatorics.Battleship.Count.ShortenShip as ShortenShip
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, Zero, Succ, N10, Size(Size), size)
import Combinatorics.Battleship.Count.ShortenShip (countBoundedFromMap)

import Foreign.Storable (Storable, sizeOf, alignment, poke, peek)
import Foreign.Ptr (Ptr, castPtr)

import Control.Monad.HT (void)
import Control.Monad (when)
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData, rnf, ($!!))

import qualified Data.StorableVector as SV
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Tuple.HT (mapFst)
import Data.Word (Word64)

import qualified Test.QuickCheck.Monadic as QCM
import qualified Test.QuickCheck as QC


{- |
We need to encode the height in the type
since the Storable instance requires that the size of the binary data
can be infered from the Distribution type.
-}
newtype Distr w h a = Distr {Distr w h a -> Vector a
getDistr :: SV.Vector a}

instance (Storable a) => NFData (Distr w h a) where
   rnf :: Distr w h a -> ()
rnf = Vector a -> ()
forall a. NFData a => a -> ()
rnf (Vector a -> ()) -> (Distr w h a -> Vector a) -> Distr w h a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Distr w h a -> Vector a
forall w h a. Distr w h a -> Vector a
getDistr

countFromDistr :: (Storable a) => Distr w h a -> a
countFromDistr :: Distr w h a -> a
countFromDistr = Vector a -> a
forall a. Storable a => Vector a -> a
SV.head (Vector a -> a) -> (Distr w h a -> Vector a) -> Distr w h a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Distr w h a -> Vector a
forall w h a. Distr w h a -> Vector a
getDistr

rowsFromDistr :: (Storable a) => Size w -> Distr w h a -> [Row w a]
rowsFromDistr :: Size w -> Distr w h a -> [Row w a]
rowsFromDistr (Size Int
width) =
   (Vector a -> Row w a) -> [Vector a] -> [Row w a]
forall a b. (a -> b) -> [a] -> [b]
map Vector a -> Row w a
forall w a. Vector a -> Row w a
Row ([Vector a] -> [Row w a])
-> (Distr w h a -> [Vector a]) -> Distr w h a -> [Row w a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector a -> [Vector a]
forall a. Storable a => Int -> Vector a -> [Vector a]
SV.sliceVertical Int
width (Vector a -> [Vector a])
-> (Distr w h a -> Vector a) -> Distr w h a -> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
SV.tail (Vector a -> Vector a)
-> (Distr w h a -> Vector a) -> Distr w h a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Distr w h a -> Vector a
forall w h a. Distr w h a -> Vector a
getDistr

heightType :: Size h -> Distr w h a -> Distr w h a
heightType :: Size h -> Distr w h a -> Distr w h a
heightType Size h
_ = Distr w h a -> Distr w h a
forall a. a -> a
id


newtype Size2 w h = Size2 Int

size2FromSizes :: Size w -> Size h -> Size2 w h
size2FromSizes :: Size w -> Size h -> Size2 w h
size2FromSizes (Size Int
width) (Size Int
height) = Int -> Size2 w h
forall w h. Int -> Size2 w h
Size2 (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
height)

size2 :: (Nat w, Nat h) => Size2 w h
size2 :: Size2 w h
size2 = Size w -> Size h -> Size2 w h
forall w h. Size w -> Size h -> Size2 w h
size2FromSizes Size w
forall n. Nat n => Size n
size Size h
forall n. Nat n => Size n
size


instance (Nat w, Nat h, Storable a) => Storable (Distr w h a) where
   sizeOf :: Distr w h a -> Int
sizeOf = Size2 w h -> Distr w h a -> Int
forall a w h. Storable a => Size2 w h -> Distr w h a -> Int
sizeOfWithSize Size2 w h
forall w h. (Nat w, Nat h) => Size2 w h
size2
   alignment :: Distr w h a -> Int
alignment (Distr Vector a
xs) = a -> Int
forall a. Storable a => a -> Int
alignment (Vector a -> a
forall a. Storable a => Vector a -> a
SV.head Vector a
xs)
   poke :: Ptr (Distr w h a) -> Distr w h a -> IO ()
poke Ptr (Distr w h a)
ptr (Distr Vector a
xs) = Ptr a -> Vector a -> IO ()
forall a. Storable a => Ptr a -> Vector a -> IO ()
SV.poke (Ptr (Distr w h a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Distr w h a)
ptr) Vector a
xs
   peek :: Ptr (Distr w h a) -> IO (Distr w h a)
peek = Size2 w h -> Ptr (Distr w h a) -> IO (Distr w h a)
forall a w h.
Storable a =>
Size2 w h -> Ptr (Distr w h a) -> IO (Distr w h a)
peekWithSize Size2 w h
forall w h. (Nat w, Nat h) => Size2 w h
size2

-- not correct if padding is needed
sizeOfWithSize :: (Storable a) => Size2 w h -> Distr w h a -> Int
sizeOfWithSize :: Size2 w h -> Distr w h a -> Int
sizeOfWithSize (Size2 Int
n) (Distr Vector a
xs) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (Vector a -> a
forall a. Storable a => Vector a -> a
SV.head Vector a
xs)

peekWithSize ::
   (Storable a) => Size2 w h -> Ptr (Distr w h a) -> IO (Distr w h a)
peekWithSize :: Size2 w h -> Ptr (Distr w h a) -> IO (Distr w h a)
peekWithSize (Size2 Int
n) Ptr (Distr w h a)
ptr = (Vector a -> Distr w h a) -> IO (Vector a) -> IO (Distr w h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> Distr w h a
forall w h a. Vector a -> Distr w h a
Distr (IO (Vector a) -> IO (Distr w h a))
-> IO (Vector a) -> IO (Distr w h a)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr a -> IO (Vector a)
forall a. Storable a => Int -> Ptr a -> IO (Vector a)
SV.peek Int
n (Ptr (Distr w h a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Distr w h a)
ptr)

instance
      (Nat w, Nat h, Counter.C a, Storable a) => Counter.C (Distr w h a) where
   zero :: Distr w h a
zero = Size2 w h -> a -> Distr w h a
forall a w h. Storable a => Size2 w h -> a -> Distr w h a
constant Size2 w h
forall w h. (Nat w, Nat h) => Size2 w h
size2 a
forall a. C a => a
Counter.zero
   one :: Distr w h a
one = Size2 w h -> a -> Distr w h a
forall a w h. Storable a => Size2 w h -> a -> Distr w h a
constant Size2 w h
forall w h. (Nat w, Nat h) => Size2 w h
size2 a
forall a. C a => a
Counter.one
   add :: Distr w h a -> Distr w h a -> Distr w h a
add (Distr Vector a
x) (Distr Vector a
y) = Vector a -> Distr w h a
forall w h a. Vector a -> Distr w h a
Distr (Vector a -> Distr w h a) -> Vector a -> Distr w h a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Vector a -> Vector a -> Vector a
forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith a -> a -> a
forall a. C a => a -> a -> a
Counter.add Vector a
x Vector a
y

constant :: (Storable a) => Size2 w h -> a -> Distr w h a
constant :: Size2 w h -> a -> Distr w h a
constant (Size2 Int
n) = Vector a -> Distr w h a
forall w h a. Vector a -> Distr w h a
Distr (Vector a -> Distr w h a) -> (a -> Vector a) -> a -> Distr w h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Vector a
forall a. Storable a => Int -> a -> Vector a
SV.replicate Int
n


newtype Row w a = Row {Row w a -> Vector a
getRow :: SV.Vector a}

avg :: (Integral a) => a -> a -> a
avg :: a -> a -> a
avg a
x a
y =
   case a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
y) a
2 of
      (a
z,a
0) -> a
z
      (a, a)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"avg: odd sum"

symmetric :: (Integral a, Storable a) => Row w a -> Row w a
symmetric :: Row w a -> Row w a
symmetric (Row Vector a
xs) = Vector a -> Row w a
forall w a. Vector a -> Row w a
Row (Vector a -> Row w a) -> Vector a -> Row w a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Vector a -> Vector a -> Vector a
forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith a -> a -> a
forall a. Integral a => a -> a -> a
avg Vector a
xs (Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
SV.reverse Vector a
xs)


type Count = Word64
type CountMap = CountMap.T Count

{-# SPECIALISE
   CountMap.mergeMany :: [CountDistrMap N10 Zero] -> CountDistrMap N10 Zero
  #-}

type CountDistr w h = Distr w h Count
type CountDistrMap w h = CountMap.T w (CountDistr w h)
type CountDistrPath w h = CountMap.Path w (CountDistr w h)


rowFromFrontier :: (Nat w) => Size w -> Count -> Frontier.T w -> Row w Count
rowFromFrontier :: Size w -> Count -> T w -> Row w Count
rowFromFrontier Size w
width Count
cnt =
   Vector Count -> Row w Count
forall w a. Vector a -> Row w a
Row (Vector Count -> Row w Count)
-> (T w -> Vector Count) -> T w -> Row w Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Size w -> (Use -> Count) -> T w -> Vector Count
forall w a.
(Nat w, Storable a) =>
Size w -> (Use -> a) -> T w -> Vector a
Frontier.mapToVector Size w
width (\Use
x -> if Use
x Use -> Use -> Bool
forall a. Eq a => a -> a -> Bool
== Use
Frontier.Free then Count
0 else Count
cnt)

addRowToDistr :: Row w Count -> CountDistr w h -> CountDistr w (Succ h)
addRowToDistr :: Row w Count -> CountDistr w h -> CountDistr w (Succ h)
addRowToDistr (Row Vector Count
row) (Distr Vector Count
xs) =
   Vector Count -> CountDistr w (Succ h)
forall w h a. Vector a -> Distr w h a
Distr (Vector Count -> CountDistr w (Succ h))
-> Vector Count -> CountDistr w (Succ h)
forall a b. (a -> b) -> a -> b
$ [Vector Count] -> Vector Count
forall a. Storable a => [Vector a] -> Vector a
SV.concat [Int -> Vector Count -> Vector Count
forall a. Storable a => Int -> Vector a -> Vector a
SV.take Int
1 Vector Count
xs, Vector Count
row, Vector Count -> Vector Count
forall a. Storable a => Vector a -> Vector a
SV.tail Vector Count
xs]

addFrontierToDistr ::
   (Nat w) => Frontier.T w -> CountDistr w h -> CountDistr w (Succ h)
addFrontierToDistr :: T w -> CountDistr w h -> CountDistr w (Succ h)
addFrontierToDistr T w
frontier CountDistr w h
cntDistr =
   Row w Count -> CountDistr w h -> CountDistr w (Succ h)
forall w h. Row w Count -> CountDistr w h -> CountDistr w (Succ h)
addRowToDistr (Size w -> Count -> T w -> Row w Count
forall w. Nat w => Size w -> Count -> T w -> Row w Count
rowFromFrontier Size w
forall n. Nat n => Size n
size (CountDistr w h -> Count
forall a w h. Storable a => Distr w h a -> a
countFromDistr CountDistr w h
cntDistr) T w
frontier) CountDistr w h
cntDistr


baseCase :: (Nat w) => CountDistrMap w Zero
baseCase :: CountDistrMap w Zero
baseCase = Key w -> CountDistr w Zero -> CountDistrMap w Zero
forall a w. Storable a => Key w -> a -> T w a
CountMap.singleton (T w
forall w. T w
Frontier.empty, T
Fleet.empty) CountDistr w Zero
forall a. C a => a
Counter.one

nextFrontierBoundedExternal ::
   (Nat w, Nat h) =>
   Size w -> Fleet.T -> CountDistrPath w (Succ h) -> CountDistrMap w h -> IO ()
nextFrontierBoundedExternal :: Size w
-> T -> CountDistrPath w (Succ h) -> CountDistrMap w h -> IO ()
nextFrontierBoundedExternal Size w
width T
maxFleet CountDistrPath w (Succ h)
dst =
   CountDistrPath w (Succ h)
-> [[KeyCount w (CountDistr w (Succ h))]] -> IO ()
forall a w.
(C a, Storable a) =>
Path w a -> [[KeyCount w a]] -> IO ()
CountMap.writeSorted CountDistrPath w (Succ h)
dst ([[KeyCount w (CountDistr w (Succ h))]] -> IO ())
-> (CountDistrMap w h -> [[KeyCount w (CountDistr w (Succ h))]])
-> CountDistrMap w h
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([((T w, T), CountDistr w h)]
 -> [KeyCount w (CountDistr w (Succ h))])
-> [[((T w, T), CountDistr w h)]]
-> [[KeyCount w (CountDistr w (Succ h))]]
forall a b. (a -> b) -> [a] -> [b]
map
      ((((T w, T), CountDistr w h)
 -> [KeyCount w (CountDistr w (Succ h))])
-> [((T w, T), CountDistr w h)]
-> [KeyCount w (CountDistr w (Succ h))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
         (\((T w
frontier,T
fleet), CountDistr w h
cntDistr) ->
            ((T w, T) -> KeyCount w (CountDistr w (Succ h)))
-> [(T w, T)] -> [KeyCount w (CountDistr w (Succ h))]
forall a b. (a -> b) -> [a] -> [b]
map (\(T w, T)
key ->
                  ((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
forall w. Nat w => T w -> T w
ShortenShip.canonicalFrontier (T w -> T w) -> (T w -> T w) -> T w -> T w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size w -> T w -> T w
forall w. Size w -> T w -> T w
Frontier.dilate Size w
width)
                     (T w, T)
key,
                   T w -> CountDistr w h -> CountDistr w (Succ h)
forall w h. Nat w => T w -> CountDistr w h -> CountDistr w (Succ h)
addFrontierToDistr ((T w, T) -> T w
forall a b. (a, b) -> a
fst (T w, T)
key) CountDistr w h
cntDistr)) ([(T w, T)] -> [KeyCount w (CountDistr w (Succ h))])
-> [(T w, T)] -> [KeyCount w (CountDistr w (Succ h))]
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)]
ShortenShip.transitionFrontierBounded
               Size w
width T
maxFleet T w
frontier T
fleet)) ([[((T w, T), CountDistr w h)]]
 -> [[KeyCount w (CountDistr w (Succ h))]])
-> (CountDistrMap w h -> [[((T w, T), CountDistr w h)]])
-> CountDistrMap w h
-> [[KeyCount w (CountDistr w (Succ h))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int
-> [((T w, T), CountDistr w h)] -> [[((T w, T), CountDistr w h)]]
forall a. Int -> [a] -> [[a]]
ListHT.sliceVertical Int
bucketSize ([((T w, T), CountDistr w h)] -> [[((T w, T), CountDistr w h)]])
-> (CountDistrMap w h -> [((T w, T), CountDistr w h)])
-> CountDistrMap w h
-> [[((T w, T), CountDistr w h)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   CountDistrMap w h -> [((T w, T), CountDistr w h)]
forall a w. Storable a => T w a -> [KeyCount w a]
CountMap.toAscList

bucketSize :: Int
bucketSize :: Int
bucketSize = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
11::Int)

tmpPath :: Size h -> CountDistrPath w h
tmpPath :: Size h -> CountDistrPath w h
tmpPath (Size Int
height) = Int -> CountDistrPath w h
forall w a. Int -> Path w a
ShortenShip.tmpPath Int
height

reportCount :: (Nat w, Nat h) => Fleet.T -> CountDistrPath w h -> IO ()
reportCount :: T -> CountDistrPath w h -> IO ()
reportCount T
fleet CountDistrPath w h
path = do
   [Char] -> IO ()
putStrLn [Char]
""
   CountDistr w h
cd <- T -> T w (CountDistr w h) -> CountDistr w h
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
fleet (T w (CountDistr w h) -> CountDistr w h)
-> IO (T w (CountDistr w h)) -> IO (CountDistr w h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CountDistrPath w h -> IO (T w (CountDistr w h))
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile CountDistrPath w h
path
   Count -> IO ()
forall a. Show a => a -> IO ()
print (Count -> IO ()) -> Count -> IO ()
forall a b. (a -> b) -> a -> b
$ CountDistr w h -> Count
forall a w h. Storable a => Distr w h a -> a
countFromDistr CountDistr w h
cd
   [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
      (Row w Count -> [Char]) -> [Row w Count] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]] -> [Char]
unwords ([[Char]] -> [Char])
-> (Row w Count -> [[Char]]) -> Row w Count -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Count -> [Char]) -> [Count] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Count -> [Char]
forall a. Show a => a -> [Char]
show ([Count] -> [[Char]])
-> (Row w Count -> [Count]) -> Row w Count -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Count -> [Count]
forall a. Storable a => Vector a -> [a]
SV.unpack (Vector Count -> [Count])
-> (Row w Count -> Vector Count) -> Row w Count -> [Count]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row w Count -> Vector Count
forall w a. Row w a -> Vector a
getRow (Row w Count -> Vector Count)
-> (Row w Count -> Row w Count) -> Row w Count -> Vector Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row w Count -> Row w Count
forall a w. (Integral a, Storable a) => Row w a -> Row w a
symmetric) ([Row w Count] -> [[Char]]) -> [Row w Count] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
      Size w -> CountDistr w h -> [Row w Count]
forall a w h. Storable a => Size w -> Distr w h a -> [Row w a]
rowsFromDistr Size w
forall n. Nat n => Size n
size CountDistr w h
cd

withReport ::
   (Nat w, Nat h) =>
   Bool -> Fleet.T -> (CountDistrPath w h -> IO ()) -> IOCountDistrPath w h
withReport :: Bool -> T -> (CountDistrPath w h -> IO ()) -> IOCountDistrPath w h
withReport Bool
report T
fleet CountDistrPath w h -> IO ()
act =
   IO (CountDistrPath w h) -> IOCountDistrPath w h
forall w h. IO (CountDistrPath w h) -> IOCountDistrPath w h
IOCountDistrPath (IO (CountDistrPath w h) -> IOCountDistrPath w h)
-> IO (CountDistrPath w h) -> IOCountDistrPath w h
forall a b. (a -> b) -> a -> b
$
   case Size h -> CountDistrPath w h
forall h w. Size h -> CountDistrPath w h
tmpPath Size h
forall n. Nat n => Size n
size of
      CountDistrPath w h
path -> do
         CountDistrPath w h -> IO ()
act CountDistrPath w h
path
         Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
report (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ T -> CountDistrPath w h -> IO ()
forall w h. (Nat w, Nat h) => T -> CountDistrPath w h -> IO ()
reportCount T
fleet CountDistrPath w h
path
         CountDistrPath w h -> IO (CountDistrPath w h)
forall (m :: * -> *) a. Monad m => a -> m a
return CountDistrPath w h
path

newtype
   IOCountDistrPath w h =
      IOCountDistrPath {IOCountDistrPath w h -> IO (CountDistrPath w h)
runIOCountDistrPath :: IO (CountDistrPath w h)}

distributionBoundedExternal ::
   (Nat w, Nat h) => Bool -> Fleet.T -> IO (CountDistrPath w h)
distributionBoundedExternal :: Bool -> T -> IO (CountDistrPath w h)
distributionBoundedExternal Bool
report T
fleet =
   IOCountDistrPath w h -> IO (CountDistrPath w h)
forall w h. IOCountDistrPath w h -> IO (CountDistrPath w h)
runIOCountDistrPath (IOCountDistrPath w h -> IO (CountDistrPath w h))
-> IOCountDistrPath w h -> IO (CountDistrPath w h)
forall a b. (a -> b) -> a -> b
$
   IOCountDistrPath w Zero
-> (forall m. Nat m => IOCountDistrPath w (Succ m))
-> IOCountDistrPath w h
forall n (f :: * -> *).
Nat n =>
f Zero -> (forall m. Nat m => f (Succ m)) -> f n
Size.switch
      (Bool
-> T -> (CountDistrPath w Zero -> IO ()) -> IOCountDistrPath w Zero
forall w h.
(Nat w, Nat h) =>
Bool -> T -> (CountDistrPath w h -> IO ()) -> IOCountDistrPath w h
withReport Bool
report T
fleet ((CountDistrPath w Zero -> IO ()) -> IOCountDistrPath w Zero)
-> (CountDistrPath w Zero -> IO ()) -> IOCountDistrPath w Zero
forall a b. (a -> b) -> a -> b
$ \CountDistrPath w Zero
path ->
         CountDistrPath w Zero -> T w (CountDistr w Zero) -> IO ()
forall a w. Storable a => Path w a -> T w a -> IO ()
CountMap.writeFile CountDistrPath w Zero
path T w (CountDistr w Zero)
forall w. Nat w => CountDistrMap w Zero
baseCase)
      (Bool
-> T
-> (CountDistrPath w (Succ m) -> IO ())
-> IOCountDistrPath w (Succ m)
forall w h.
(Nat w, Nat h) =>
Bool -> T -> (CountDistrPath w h -> IO ()) -> IOCountDistrPath w h
withReport Bool
report T
fleet ((CountDistrPath w (Succ m) -> IO ())
 -> IOCountDistrPath w (Succ m))
-> (CountDistrPath w (Succ m) -> IO ())
-> IOCountDistrPath w (Succ m)
forall a b. (a -> b) -> a -> b
$ \CountDistrPath w (Succ m)
path ->
         Size w
-> T -> CountDistrPath w (Succ m) -> CountDistrMap w m -> IO ()
forall w h.
(Nat w, Nat h) =>
Size w
-> T -> CountDistrPath w (Succ h) -> CountDistrMap w h -> IO ()
nextFrontierBoundedExternal Size w
forall n. Nat n => Size n
size T
fleet CountDistrPath w (Succ m)
path
            (CountDistrMap w m -> IO ()) -> IO (CountDistrMap w m) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path w (CountDistr w m) -> IO (CountDistrMap w m)
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile
            (Path w (CountDistr w m) -> IO (CountDistrMap w m))
-> IO (Path w (CountDistr w m)) -> IO (CountDistrMap w m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> T -> IO (Path w (CountDistr w m))
forall w h. (Nat w, Nat h) => Bool -> T -> IO (CountDistrPath w h)
distributionBoundedExternal Bool
report T
fleet)


countExternal :: IO ()
countExternal :: IO ()
countExternal =
   IO (CountDistrPath N10 N10) -> IO ()
forall (m :: * -> *) a. Monad m => m a -> m ()
void (Bool -> T -> IO (CountDistrPath N10 N10)
forall w h. (Nat w, Nat h) => Bool -> T -> IO (CountDistrPath w h)
distributionBoundedExternal Bool
True T
Fleet.german :: IO (CountDistrPath N10 N10))



distributionExternalList ::
   (Nat w, Nat h) => Size w -> Size h -> Fleet.T -> IO (Count, [[Count]])
distributionExternalList :: Size w -> Size h -> T -> IO (Count, [[Count]])
distributionExternalList Size w
w Size h
h T
fleet = do
   CountDistr w h
cdm <-
      (CountDistr w h -> IO (CountDistr w h)
forall (m :: * -> *) a. Monad m => a -> m a
return (CountDistr w h -> IO (CountDistr w h))
-> CountDistr w h -> IO (CountDistr w h)
forall a b. NFData a => (a -> b) -> a -> b
$!!) (CountDistr w h -> IO (CountDistr w h))
-> (T w (CountDistr w h) -> CountDistr w h)
-> T w (CountDistr w h)
-> IO (CountDistr w h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T w (CountDistr w h) -> CountDistr w h
forall a w. (C a, Storable a) => T -> T w a -> a
countBoundedFromMap T
fleet (T w (CountDistr w h) -> IO (CountDistr w h))
-> IO (T w (CountDistr w h)) -> IO (CountDistr w h)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      Path w (CountDistr w h) -> IO (T w (CountDistr w h))
forall a w. Storable a => Path w a -> IO (T w a)
CountMap.readFile (Path w (CountDistr w h) -> IO (T w (CountDistr w h)))
-> IO (Path w (CountDistr w h)) -> IO (T w (CountDistr w h))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> T -> IO (Path w (CountDistr w h))
forall w h. (Nat w, Nat h) => Bool -> T -> IO (CountDistrPath w h)
distributionBoundedExternal Bool
False T
fleet
   (Count, [[Count]]) -> IO (Count, [[Count]])
forall (m :: * -> *) a. Monad m => a -> m a
return
      (CountDistr w h -> Count
forall a w h. Storable a => Distr w h a -> a
countFromDistr CountDistr w h
cdm,
       (Row w Count -> [Count]) -> [Row w Count] -> [[Count]]
forall a b. (a -> b) -> [a] -> [b]
map (Vector Count -> [Count]
forall a. Storable a => Vector a -> [a]
SV.unpack (Vector Count -> [Count])
-> (Row w Count -> Vector Count) -> Row w Count -> [Count]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row w Count -> Vector Count
forall w a. Row w a -> Vector a
getRow (Row w Count -> Vector Count)
-> (Row w Count -> Row w Count) -> Row w Count -> Vector Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row w Count -> Row w Count
forall a w. (Integral a, Storable a) => Row w a -> Row w a
symmetric) ([Row w Count] -> [[Count]]) -> [Row w Count] -> [[Count]]
forall a b. (a -> b) -> a -> b
$
       Size w -> CountDistr w h -> [Row w Count]
forall a w h. Storable a => Size w -> Distr w h a -> [Row w a]
rowsFromDistr Size w
w (CountDistr w h -> [Row w Count])
-> CountDistr w h -> [Row w Count]
forall a b. (a -> b) -> a -> b
$ Size h -> CountDistr w h -> CountDistr w h
forall h w a. Size h -> Distr w h a -> Distr w h a
heightType Size h
h CountDistr w h
cdm)

propCountExternalTotal :: QC.Property
propCountExternalTotal :: Property
propCountExternalTotal =
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
6)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
width ->
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
10)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
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
ShortenShip.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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
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 -> 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,[[Count]]
cd) <- IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]]))
-> IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall a b. (a -> b) -> a -> b
$ Size n -> Size n -> T -> IO (Count, [[Count]])
forall w h.
(Nat w, Nat h) =>
Size w -> Size h -> T -> IO (Count, [[Count]])
distributionExternalList Size n
w Size n
h 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
$
         Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger Count
c
          Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Num a => a -> a -> a
(*)) ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ T -> [(Int, Int)]
Fleet.toList T
fleet)
         Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==
         ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ ([Count] -> Integer) -> [[Count]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger (Count -> Integer) -> ([Count] -> Count) -> [Count] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Count] -> Count
forall a. C a => [a] -> a
Counter.sum) [[Count]]
cd)

propCountExternalSimple :: QC.Property
propCountExternalSimple :: Property
propCountExternalSimple =
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
6)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
width ->
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
10)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
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
ShortenShip.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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
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 -> 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,[[Count]]
_cd) <- IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]]))
-> IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall a b. (a -> b) -> a -> b
$ Size n -> Size n -> T -> IO (Count, [[Count]])
forall w h.
(Nat w, Nat h) =>
Size w -> Size h -> T -> IO (Count, [[Count]])
distributionExternalList Size n
w Size n
h T
fleet
      Count
ce <- 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, Int) -> T -> IO Count
forall w. Nat w => (Size w, Int) -> T -> IO Count
ShortenShip.countExternalReturn (Size n
w,Int
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
$ Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger Count
ce Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Count -> Integer
forall a. Integ a => a -> Integer
Counter.toInteger Count
c

propCountExternalSymmetric :: QC.Property
propCountExternalSymmetric :: Property
propCountExternalSymmetric =
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
6)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
sz ->
   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
ShortenShip.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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
sz ((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
n -> 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,[[Count]]
cd) <- IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]]))
-> IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall a b. (a -> b) -> a -> b
$ Size n -> Size n -> T -> IO (Count, [[Count]])
forall w h.
(Nat w, Nat h) =>
Size w -> Size h -> T -> IO (Count, [[Count]])
distributionExternalList Size n
n Size n
n 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
$ [[Count]]
cd [[Count]] -> [[Count]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Count]] -> [[Count]]
forall a. [[a]] -> [[a]]
List.transpose [[Count]]
cd

propCountExternalTransposed :: QC.Property
propCountExternalTransposed :: Property
propCountExternalTransposed =
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
6)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
width ->
   Gen Int -> (Int -> [Int]) -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrink ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
6)) Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
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
ShortenShip.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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
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 ->
   Int -> (forall n. Nat n => Size n -> Property) -> Property
forall a. Int -> (forall n. Nat n => Size n -> a) -> a
Size.reifyInt Int
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 -> 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
c0,[[Count]]
cd0) <- IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]]))
-> IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall a b. (a -> b) -> a -> b
$ Size n -> Size n -> T -> IO (Count, [[Count]])
forall w h.
(Nat w, Nat h) =>
Size w -> Size h -> T -> IO (Count, [[Count]])
distributionExternalList Size n
w Size n
h T
fleet
      (Count
c1,[[Count]]
cd1) <- IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QCM.run (IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]]))
-> IO (Count, [[Count]]) -> PropertyM IO (Count, [[Count]])
forall a b. (a -> b) -> a -> b
$ Size n -> Size n -> T -> IO (Count, [[Count]])
forall w h.
(Nat w, Nat h) =>
Size w -> Size h -> T -> IO (Count, [[Count]])
distributionExternalList Size n
h Size n
w 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
$ Count
c0 Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
c1
      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
$ [[Count]] -> [[Count]]
forall a. [[a]] -> [[a]]
List.transpose [[Count]]
cd0 [[Count]] -> [[Count]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Count]]
cd1