module Kewar.Layout.Masking (mask, penalty1, penalty2, penalty3, penalty4, optimalMask, maskGrid) where

import Data.Array (bounds, elems, inRange, indices, (!))
import Data.Either (fromRight)
import Data.List (elemIndex, foldl', foldl1', groupBy)
import Data.Maybe (fromJust)
import Kewar.Layout.Types (Grid, Module (..), Position, cols, dimension, flipM, insert, rows)
import Kewar.Types (Exception (InvalidMask))
import Utils (consecutiveChunksOf, count)

mask :: Int -> (Position, Module) -> Either Exception (Position, Module)
mask :: Int -> (Position, Module) -> Either Exception (Position, Module)
mask Int
typ ((Int
c, Int
r), Module
m)
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ Int -> Bool
forall a. Integral a => a -> Bool
even (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c)
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ Int -> Bool
forall a. Integral a => a -> Bool
even Int
r
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ Integer -> Bool
forall a. Integral a => a -> Bool
even (Integer -> Bool) -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3)
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ ((Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ Int -> Bool
forall a. Integral a => a -> Bool
even ((Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3))
  | Int
typ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = Bool -> Either Exception (Position, Module)
forall undefined. Bool -> Either undefined (Position, Module)
flipIf (Bool -> Either Exception (Position, Module))
-> Bool -> Either Exception (Position, Module)
forall a b. (a -> b) -> a -> b
$ Int -> Bool
forall a. Integral a => a -> Bool
even ((Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3))
  | Bool
otherwise = Exception -> Either Exception (Position, Module)
forall a b. a -> Either a b
Left Exception
InvalidMask
  where
    flipIf :: Bool -> Either undefined (Position, Module)
    flipIf :: Bool -> Either undefined (Position, Module)
flipIf Bool
rule = (Position, Module) -> Either undefined (Position, Module)
forall a b. b -> Either a b
Right ((Position, Module) -> Either undefined (Position, Module))
-> (Position, Module) -> Either undefined (Position, Module)
forall a b. (a -> b) -> a -> b
$ if Bool
rule then ((Int
c, Int
r), Module -> Module
flipM Module
m) else ((Int
c, Int
r), Module
m)

sameModuleConsecutive :: [(Position, Module)] -> [[(Position, Module)]]
sameModuleConsecutive :: [(Position, Module)] -> [[(Position, Module)]]
sameModuleConsecutive = ((Position, Module) -> (Position, Module) -> Bool)
-> [(Position, Module)] -> [[(Position, Module)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(Position
_, Module
v) (Position
_, Module
v') -> Module
v Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
v')

penalty1 :: Grid -> Int
penalty1 :: Grid -> Int
penalty1 Grid
g = ([[(Position, Module)]] -> Int
forall (t :: * -> *). Foldable t => t [(Position, Module)] -> Int
calc ([[(Position, Module)]] -> Int)
-> (Grid -> [[(Position, Module)]]) -> Grid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid -> [[(Position, Module)]]
rows) Grid
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([[(Position, Module)]] -> Int
forall (t :: * -> *). Foldable t => t [(Position, Module)] -> Int
calc ([[(Position, Module)]] -> Int)
-> (Grid -> [[(Position, Module)]]) -> Grid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid -> [[(Position, Module)]]
cols) Grid
g
  where
    calc :: t [(Position, Module)] -> Int
calc t [(Position, Module)]
gs = (Int -> [(Position, Module)] -> Int)
-> Int -> t [(Position, Module)] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc [(Position, Module)]
r -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([(Position, Module)] -> Int) -> [[(Position, Module)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Position, Module)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
cost ([[(Position, Module)]] -> [Int])
-> [[(Position, Module)]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [(Position, Module)] -> [[(Position, Module)]]
sameModuleConsecutive [(Position, Module)]
r)) Int
0 t [(Position, Module)]
gs
    cost :: t a -> Int
cost t a
group
      | t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
group Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = Int
0
      | Bool
otherwise = t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
group Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2

penalty2 :: Grid -> Int
penalty2 :: Grid -> Int
penalty2 Grid
g = (Int -> [(Position, Module)] -> Int)
-> Int -> [[(Position, Module)]] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc [(Position, Module)]
b -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Position, Module)] -> Int
cost [(Position, Module)]
b) Int
0 [[(Position, Module)]]
boxes
  where
    bnds :: (Position, Position)
    bnds :: (Position, Position)
bnds = Grid -> (Position, Position)
forall i e. Array i e -> (i, i)
bounds Grid
g

    neighbors :: Position -> [Position]
    neighbors :: Position -> [Position]
neighbors (Int
a, Int
b) = [(Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) | Int
i <- [Int
0, Int
1], Int
j <- [Int
0, Int
1]]

    step :: [[(Position, Module)]] -> Position -> [[(Position, Module)]]
    step :: [[(Position, Module)]] -> Position -> [[(Position, Module)]]
step [[(Position, Module)]]
l (Int
a, Int
b)
      | (Position, Position) -> Position -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Position, Position)
bnds (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) = [[(Position, Module)]]
l [[(Position, Module)]]
-> [[(Position, Module)]] -> [[(Position, Module)]]
forall a. [a] -> [a] -> [a]
++ [(Position -> (Position, Module))
-> [Position] -> [(Position, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\Position
p -> (Position
p, Grid
g Grid -> Position -> Module
forall i e. Ix i => Array i e -> i -> e
! Position
p)) ([Position] -> [(Position, Module)])
-> [Position] -> [(Position, Module)]
forall a b. (a -> b) -> a -> b
$ Position -> [Position]
neighbors (Int
a, Int
b)]
      | Bool
otherwise = [[(Position, Module)]]
l

    boxes :: [[(Position, Module)]]
    boxes :: [[(Position, Module)]]
boxes = ([[(Position, Module)]] -> Position -> [[(Position, Module)]])
-> [[(Position, Module)]] -> [Position] -> [[(Position, Module)]]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[(Position, Module)]] -> Position -> [[(Position, Module)]]
step [] (Grid -> [Position]
forall i e. Ix i => Array i e -> [i]
indices Grid
g)

    cost :: [(Position, Module)] -> Int
    cost :: [(Position, Module)] -> Int
cost [(Position, Module)]
group
      | [[(Position, Module)]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Position, Module)] -> [[(Position, Module)]]
sameModuleConsecutive [(Position, Module)]
group) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int
3
      | Bool
otherwise = Int
0

penalty3 :: Grid -> Int
penalty3 :: Grid -> Int
penalty3 Grid
g = ([[Module]] -> Int
forall (t :: * -> *). Foldable t => t [Module] -> Int
calc ([[Module]] -> Int) -> (Grid -> [[Module]]) -> Grid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Position, Module)] -> [Module])
-> [[(Position, Module)]] -> [[Module]]
forall a b. (a -> b) -> [a] -> [b]
map [(Position, Module)] -> [Module]
forall a b. [(a, b)] -> [b]
modules ([[(Position, Module)]] -> [[Module]])
-> (Grid -> [[(Position, Module)]]) -> Grid -> [[Module]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid -> [[(Position, Module)]]
rows) Grid
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([[Module]] -> Int
forall (t :: * -> *). Foldable t => t [Module] -> Int
calc ([[Module]] -> Int) -> (Grid -> [[Module]]) -> Grid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Position, Module)] -> [Module])
-> [[(Position, Module)]] -> [[Module]]
forall a b. (a -> b) -> [a] -> [b]
map [(Position, Module)] -> [Module]
forall a b. [(a, b)] -> [b]
modules ([[(Position, Module)]] -> [[Module]])
-> (Grid -> [[(Position, Module)]]) -> Grid -> [[Module]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid -> [[(Position, Module)]]
cols) Grid
g
  where
    -- Patterns to be matched
    pattern1 :: [Module]
pattern1 = [Module
Black, Module
White, Module
Black, Module
Black, Module
Black, Module
White, Module
Black, Module
White, Module
White, Module
White, Module
White]
    pattern2 :: [Module]
pattern2 = [Module
White, Module
White, Module
White, Module
White, Module
Black, Module
White, Module
Black, Module
Black, Module
Black, Module
White, Module
Black]

    matches :: [Module] -> Int
    matches :: [Module] -> Int
matches [Module]
l = [[Module]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Module]] -> Int) -> [[Module]] -> Int
forall a b. (a -> b) -> a -> b
$ ([Module] -> Bool) -> [[Module]] -> [[Module]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Module]
i -> [Module]
i [Module] -> [Module] -> Bool
forall a. Eq a => a -> a -> Bool
== [Module]
pattern1 Bool -> Bool -> Bool
|| [Module]
i [Module] -> [Module] -> Bool
forall a. Eq a => a -> a -> Bool
== [Module]
pattern2) ([[Module]] -> [[Module]]) -> [[Module]] -> [[Module]]
forall a b. (a -> b) -> a -> b
$ Int -> [Module] -> [[Module]]
forall a. Int -> [a] -> [[a]]
consecutiveChunksOf Int
11 [Module]
l

    modules :: [(a, b)] -> [b]
    modules :: [(a, b)] -> [b]
modules [(a, b)]
l = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
l

    calc :: t [Module] -> Int
calc t [Module]
gs = Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> [Module] -> Int) -> Int -> t [Module] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
s [Module]
g' -> Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Module] -> Int
matches [Module]
g') Int
0 t [Module]
gs

penalty4 :: Grid -> Int
penalty4 :: Grid -> Int
penalty4 Grid
g = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10
  where
    total :: Int
total = Grid -> Int
dimension Grid
g
    blacks :: Int
blacks = (Module -> Bool) -> [Module] -> Int
forall a. (a -> Bool) -> [a] -> Int
count (Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
Black) (Grid -> [Module]
forall i e. Array i e -> [e]
elems Grid
g)
    ratio :: Int
ratio = (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
blacks) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
total
    q :: Int
q = Int
ratio Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
5
    m :: Int
m = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> Int -> Int
forall a. Num a => a -> a
abs (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5) [Int
ratio Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q, Int
ratio Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5]

penalty :: Grid -> Int
penalty :: Grid -> Int
penalty Grid
g = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Grid -> Int
penalty1 Grid
g, Grid -> Int
penalty2 Grid
g, Grid -> Int
penalty3 Grid
g, Grid -> Int
penalty4 Grid
g]

maskGrid :: Grid -> [Position] -> Int -> Grid
maskGrid :: Grid -> [Position] -> Int -> Grid
maskGrid Grid
g [Position]
ps Int
n = Grid -> [(Position, Module)] -> Grid
insert Grid
g ((Position -> (Position, Module))
-> [Position] -> [(Position, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\Position
p -> (Position, Module)
-> Either Exception (Position, Module) -> (Position, Module)
forall b a. b -> Either a b -> b
fromRight (Position
p, Grid
g Grid -> Position -> Module
forall i e. Ix i => Array i e -> i -> e
! Position
p) (Either Exception (Position, Module) -> (Position, Module))
-> Either Exception (Position, Module) -> (Position, Module)
forall a b. (a -> b) -> a -> b
$ Int -> (Position, Module) -> Either Exception (Position, Module)
mask Int
n (Position
p, Grid
g Grid -> Position -> Module
forall i e. Ix i => Array i e -> i -> e
! Position
p)) [Position]
ps)

optimalMask :: [Position] -> Grid -> (Grid, Int)
optimalMask :: [Position] -> Grid -> (Grid, Int)
optimalMask [Position]
forbiddenLocations Grid
grid = ([Grid]
masked [Grid] -> Int -> Grid
forall a. [a] -> Int -> a
!! Int
minMask, Int
minMask)
  where
    locations :: [Position]
locations = (Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
filter (Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Position]
forbiddenLocations) (Grid -> [Position]
forall i e. Ix i => Array i e -> [i]
indices Grid
grid)
    masked :: [Grid]
masked = (Int -> Grid) -> [Int] -> [Grid]
forall a b. (a -> b) -> [a] -> [b]
map (Grid -> [Position] -> Int -> Grid
maskGrid Grid
grid [Position]
locations) [Int
0 .. Int
7]
    penalties :: [Int]
penalties = (Grid -> Int) -> [Grid] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Grid -> Int
penalty [Grid]
masked
    minMask :: Int
minMask = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ((Int -> Int -> Int) -> [Int] -> Int
forall a. (a -> a -> a) -> [a] -> a
foldl1' Int -> Int -> Int
forall a. Ord a => a -> a -> a
min [Int]
penalties) [Int]
penalties