module Search.Parameters where

import           AppPrelude           hiding ((/))
import           ClassyPrelude        ((/))

import           Models.Score

import qualified Data.Vector.Storable as Vector


futilityMargins :: Vector Score
futilityMargins :: Vector Score
futilityMargins = [Score] -> Vector Score
forall a. Storable a => [a] -> Vector a
Vector.fromList
  [Score
300, Score
600, Score
1200]


getLmrDepth :: Int -> Depth -> Depth
getLmrDepth :: Int -> Depth -> Depth
getLmrDepth Int
mvIdx Depth
depth =
  Depth -> Depth -> Depth
forall a. Ord a => a -> a -> a
min (Depth
depth Depth -> Depth -> Depth
forall a. Num a => a -> a -> a
- Depth
1) Depth
lmrDepth
  where
    lmrDepth :: Depth
lmrDepth = Double -> Depth
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
lmrFactor Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Depth -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Depth
depth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
                Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lmrFactor) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Depth -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Depth
depth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1))
    lmrFactor :: Double
lmrFactor = forall a. Ord a => a -> a -> a
min @Double Double
1 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mvIdx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
80)


initialAlpha :: Score
initialAlpha :: Score
initialAlpha = Score
minScore


initialBeta :: Score
initialBeta :: Score
initialBeta = Score
maxScore