First draft of stats usage.

refs #6.

Author: portnov

src/AI/AlphaBeta.hs

@@ -229,7 +229,8 @@ cachedScoreAB var params side dp alpha beta board = do
 
     Nothing -> do
       (score, moves) <- Metrics.timed "ai.score.board" $ scoreAB var params side dp alpha beta board
-      lift $ putAiCache params board dp side score moves var
+      when (alpha == loose && beta == win) $
+          lift $ putAiCache params board dp side score moves var
       return score
 
 isTargetDepth :: DepthParams -> Bool
@@ -379,7 +380,7 @@ scoreAB var params side dp alpha beta board
           beta'  = if maximize
                      then beta
                      else min beta best
-      (score,_) <- scoreAB var params (opposite side) dp' alpha' beta' board'
+      score <- cachedScoreAB var params (opposite side) dp' alpha' beta' board'
       $trace "{}| score for side {}: {}" (indent, show side, show score)
       pop
       best <- getBest

src/AI/AlphaBeta/Cache.hs

@@ -176,22 +176,37 @@ lookupAiCache params board depth side handle = do
         return cached
 --         return $ Just $ CacheItemSide $ fixSign $ cisScore result
       Nothing -> do
-        mbValue <- runStorage handle $ event "file lookup" $ lookupFile board depth side
-        case mbValue of
-          Nothing -> do
+        (mbCached, mbStats) <- runStorage handle $ event "file lookup" $ lookupFile board depth side
+        let mbStats' = join $ checkStats `fmap` mbStats
+        case (mbCached, mbStats') of
+          (Nothing, Nothing) -> do
             Metrics.increment "cache.miss"
             return Nothing
-          Just value -> do
+          (Nothing, Just stats) -> do
+            Metrics.increment "cache.hit.stats"
+            return $ Just $ CacheItemSide $ avg stats
+          (Just score, Nothing) -> do
             Metrics.increment "cache.hit.file"
-            putAiCache' params board depth side value handle
-            return mbValue
+            putAiCache' params board depth side (CacheItemSide score) handle
+            return $ Just $ CacheItemSide score
+          (Just _, Just stats) -> do
+            Metrics.increment "cache.hit.stats"
+            return $ Just $ CacheItemSide $ avg stats
 
   where 
     queueCleanup bc bk = return ()
 --     queueCleanup bc bk = do
 --       let key = (bc, bk)
 --       now <- liftIO $ getTime Monotonic
 --       liftIO $ atomically $ putCleanupQueue (aichCleanupQueue handle) key now
+
+    avg :: Stats -> Score
+    avg s = statsSumScore s `div` statsCount s
+
+    checkStats :: Stats -> Maybe Stats
+    checkStats s
+      | statsCount s < 10 = Nothing
+      | otherwise = Just s
 
     lookupMemory :: (BoardCounts, BoardKey) -> Side -> Checkers (Maybe CacheItemSide)
     lookupMemory (bc, bk) side = Metrics.timed "cache.lookup.memory" $ do

src/AI/AlphaBeta/Persistent.hs

@@ -306,16 +306,21 @@ lookupFileB bstr = do
             else loop nextBlockNumber (B.tail bstr)
 
 
-lookupFile :: Board -> DepthParams -> Side -> Storage (Maybe CacheItemSide)
+-- | Returns: (cached result, stats
+lookupFile :: Board -> DepthParams -> Side -> Storage (Maybe Score, Maybe Stats)
 lookupFile board depth side = Metrics.timed "cache.lookup.file" $ do
-  mbItem <- lookupFileB (encodeBoard board)
-  case mbItem of
-    Nothing -> return Nothing
-    Just item -> case M.lookup depth (boardScores item) of
-                   Nothing -> return Nothing
-                   Just ci -> case side of
-                                First -> return $ ciFirst ci
-                                Second -> return $ ciSecond ci
+  mbRecord <- lookupFileB (encodeBoard board)
+  case mbRecord of
+    Nothing -> return (Nothing, Nothing)
+    Just record -> do
+      let cached =
+            case M.lookup depth (boardScores record) of
+               Nothing -> Nothing
+               Just ci -> case side of
+                            First -> cisScore `fmap` ciFirst ci
+                            Second -> cisScore `fmap` ciSecond ci
+          stats = boardStats record
+      return (cached, stats)
 
 lookupStatsFile :: Board -> Storage (Maybe Stats)
 lookupStatsFile board = Metrics.timed "stats.lookup.file" $ do
@@ -489,3 +494,19 @@ checkDataFile path = withFile path ReadMode $ \file -> do
         record <- Data.Store.decodeIO bstr :: IO PerBoardData
         printf "Block #%d: data: %s\n" i (show record)
 
+checkDataFile' :: FilePath -> IO ()
+checkDataFile' path = withFile path ReadMode $ \file -> do
+  nBlocks <- readDataIO file :: IO DataBlockNumber
+  forM_ [0 .. nBlocks - 1] $ \i -> do
+      let start = fromIntegral $ calcDataBlockOffset i
+      hSeek file AbsoluteSeek start
+      size <- readDataIO file :: IO Word16
+      when (size > 0) $ do
+        bstr <- B.hGet file (fromIntegral size)
+        record <- Data.Store.decodeIO bstr :: IO PerBoardData
+        case boardStats record of
+          Nothing -> return ()
+          Just stats -> 
+            when (statsCount stats > 10) $
+              printf "Block #%d: data: %s\n" i (show record)
+

src/Learn.hs

@@ -115,7 +115,7 @@ learnPdn ai@(AlphaBeta params rules eval) path = do
   forM_ (zip [1.. ] pdn) $ \(i, gameRec) -> do
     -- liftIO $ print pdn
     $info "Processing game {}/{}..." (i :: Int, n)
-    doLearn' rules eval cache params gameRec
+    doLearn rules eval cache params gameRec
     -- saveAiCache rules params cache
     return ()
 

src/Main.hs

@@ -44,7 +44,7 @@ main = do
           withLogContext (LogContextFrame [] (include defaultLogFilter)) $
             learnPdn ai path
 
-    ["dump", path] -> checkDataFile path
+    ["dump", path] -> checkDataFile' path
 
 --     ["test"] -> do
 --       let rules = russian