Tune evaluator for turkish rules.

refs #26.

Author: portnov

src/Core/Evaluator.hs

@@ -1,8 +1,11 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ExistentialQuantification #-}
 module Core.Evaluator
   ( SimpleEvaluator (..),
+    SimpleEvaluatorInterface (..),
+    SimpleEvaluatorSupport (..),
     defaultEvaluator
   ) where
 
@@ -14,11 +17,12 @@ import           Core.Types
 import           Core.Board
 
 data SimpleEvaluator = SimpleEvaluator {
-    seRules :: SomeRules,
+    seRules :: SimpleEvaluatorInterface,
     seUsePositionalScore :: Bool,
     seMobilityWeight :: ScoreBase,
     seCenterWeight :: ScoreBase,
     seOppositeSideWeight :: ScoreBase,
+    seBorderMenBad :: Bool,
     seBackedWeight :: ScoreBase,
     seAsymetryWeight :: ScoreBase,
     sePreKingWeight :: ScoreBase,
@@ -27,13 +31,26 @@ data SimpleEvaluator = SimpleEvaluator {
   }
   deriving (Show)
 
-defaultEvaluator :: GameRules rules => rules -> SimpleEvaluator
+class GameRules rules => SimpleEvaluatorSupport rules where
+  getBackDirections :: rules -> [PlayerDirection]
+  getBackDirections _ = [BackwardLeft, BackwardRight]
+
+  getForwardDirections :: rules -> [PlayerDirection]
+  getForwardDirections _ = [ForwardLeft, ForwardRight]
+
+data SimpleEvaluatorInterface = forall g. SimpleEvaluatorSupport g => SimpleEvaluatorInterface g
+
+instance Show SimpleEvaluatorInterface where
+  show (SimpleEvaluatorInterface rules) = rulesName rules
+
+defaultEvaluator :: SimpleEvaluatorSupport rules => rules -> SimpleEvaluator
 defaultEvaluator rules = SimpleEvaluator
-  { seRules              = SomeRules rules
+  { seRules              = SimpleEvaluatorInterface rules
   , seUsePositionalScore = True
   , seMobilityWeight     = 3
   , seCenterWeight       = 4
   , seOppositeSideWeight = 4
+  , seBorderMenBad       = True
   , seBackedWeight       = 2
   , seAsymetryWeight     = 1
   , sePreKingWeight      = 3
@@ -74,7 +91,7 @@ instance Default PreScore where
         }
 
 preEval :: SimpleEvaluator -> Side -> Board -> PreScore
-preEval (SimpleEvaluator { seRules = SomeRules rules, ..}) side board =
+preEval (SimpleEvaluator { seRules = SimpleEvaluatorInterface rules, ..}) side board =
   let
     kingCoef =
       -- King is much more useful when there are enough men to help it
@@ -108,13 +125,13 @@ preEval (SimpleEvaluator { seRules = SomeRules rules, ..}) side board =
         Just back -> isPieceAt back board side
 
     backedScoreOf addr =
-      length $ filter (isBackedAt addr) [BackwardLeft, BackwardRight]
+      length $ filter (isBackedAt addr) $ getBackDirections rules
 
     backedScore =
       fromIntegral $ sum $ map backedScoreOf $ allMyAddresses side board
 
     tempNumber (Label col row)
-      | col == 0 || col == ncols - 1 = 0
+      | seBorderMenBad && (col == 0 || col == ncols - 1) = 0
       | otherwise = case boardSide (boardOrientation rules) side of
         Top    -> nrows - row
         Bottom -> row + 1
@@ -123,7 +140,7 @@ preEval (SimpleEvaluator { seRules = SomeRules rules, ..}) side board =
     opponentSideCount =
       let (men, kings) = myLabelsCount' side board tempNumber in men
 
-    preKing board src = sum $ map check [ForwardLeft, ForwardRight]
+    preKing board src = sum $ map check $ getForwardDirections rules
       where
         check dir =
           case myNeighbour rules side dir src of

src/Rules/Brazilian.hs

@@ -18,6 +18,8 @@ newtype Brazilian = Brazilian GenericRules
 instance HasTopology Brazilian where
   boardTopology _ = Diagonal
 
+instance SimpleEvaluatorSupport Brazilian
+
 instance Show Brazilian where
   show = rulesName
 

src/Rules/Canadian.hs

@@ -20,6 +20,8 @@ instance Show Canadian where
 instance HasTopology Canadian where
   boardTopology _ = Diagonal
 
+instance SimpleEvaluatorSupport Canadian
+
 instance GameRules Canadian where
   boardSize _ = (12, 12)
 

src/Rules/Diagonal.hs

@@ -20,6 +20,8 @@ instance Show DiagonalRussian where
 instance HasTopology DiagonalRussian where
   boardTopology _ = Core.Types.Diagonal
 
+instance SimpleEvaluatorSupport DiagonalRussian
+
 instance GameRules DiagonalRussian where
   initBoard rnd r =
     let board = buildBoard rnd r (boardOrientation r) (8, 8)

src/Rules/English.hs

@@ -22,6 +22,8 @@ instance Show English where
 instance HasTopology English where
   boardTopology _ = Diagonal
 
+instance SimpleEvaluatorSupport English
+
 instance GameRules English where
   boardSize _ = boardSize Russian.russian
 

src/Rules/International.hs

@@ -23,6 +23,8 @@ instance Show International where
 instance HasTopology International where
   boardTopology _ = Diagonal
 
+instance SimpleEvaluatorSupport International
+
 instance GameRules International where
   boardSize _ = (10, 10)
 

src/Rules/Russian.hs

@@ -20,6 +20,8 @@ newtype Russian = Russian GenericRules
 instance Show Russian where
   show = rulesName
 
+instance SimpleEvaluatorSupport Russian
+
 instance HasTopology Russian where
   boardTopology _ = Diagonal
 

src/Rules/Simple.hs

@@ -18,6 +18,8 @@ newtype Simple = Simple GenericRules
 instance Show Simple where
   show = rulesName
 
+instance SimpleEvaluatorSupport Simple
+
 instance HasTopology Simple where
   boardTopology _ = Diagonal
 

src/Rules/Spancirety.hs

@@ -20,6 +20,8 @@ instance Show Spancirety where
 instance HasTopology Spancirety where
   boardTopology _ = Diagonal
 
+instance SimpleEvaluatorSupport Spancirety
+
 instance GameRules Spancirety where
   initBoard rnd r =
     let board = buildBoard rnd r (boardOrientation r) (8, 10)

src/Rules/Turkish.hs

@@ -23,6 +23,9 @@ instance Show Turkish where
 instance HasTopology Turkish where
   boardTopology _ = Orthogonal
 
+instance SimpleEvaluatorSupport Turkish where
+  getBackDirections _ = [Backward]
+
 instance GameRules Turkish where
   initBoard rnd r =
     let board = buildBoard rnd r (boardOrientation r) (8, 8)
@@ -34,7 +37,7 @@ instance GameRules Turkish where
 
   boardSize _ = (8, 8)
 
-  dfltEvaluator r = SomeEval $ defaultEvaluator r
+  dfltEvaluator r = SomeEval $ (defaultEvaluator r) {seKingCoef = 5, seHelpedKingCoef = 6, seBorderMenBad = False}
 
   boardNotation _ = chessNotation