some optimizations

src/Skat/AI/Rulebased.hs

@@ -19,7 +19,7 @@ import qualified Data.Map.Strict as M
 
 import Skat.Player
 import qualified Skat.Player.Utils as P
-import Skat.Pile
+import Skat.Pile hiding (isSkat)
 import Skat.Card
 import Skat.Utils
 import Skat (Skat, modifyp, mkSkatEnv) 
@@ -81,7 +81,7 @@ instance Player AIEnv where
     hand = getHand
     chooseCard p table fallen hand = runStateT (do
         modify $ setTable table
-        modify $ setHand hand
+        modify $ setHand (map toCard hand)
         modify $ setFallen fallen
         choose) p
     onCardPlayed p card = execStateT (do
@@ -142,20 +142,16 @@ analyzeTurn (c1, c2, c3) = do
         col2 = effectiveColour trCol (getCard c2)
         col3 = effectiveColour trCol (getCard c3)
     if col2 /= demanded
-        then origin c2 `hasNoLonger` demanded
+        then uorigin (getPile c2) `hasNoLonger` demanded
         else return ()
     if col3 /= demanded
-        then origin c3 `hasNoLonger` demanded
+        then uorigin (getPile c3) `hasNoLonger` demanded
         else return ()
 
 type Distribution = ([Card], [Card], [Card], [Card])
 
 toPiles :: [CardS Played] -> Distribution -> Piles
-toPiles table (h1, h2, h3, skt) = Piles (cs1 ++ cs2 ++ cs3) table ss
-    where cs1 = map (putAt Hand1) h1
-          cs2 = map (putAt Hand2) h2
-          cs3 = map (putAt Hand3) h3
-          ss  = map (putAt SkatP) skt
+toPiles table (h1, h2, h3, skt) = makePiles h1 h2 h3 table skt
 
 compareGuess :: (Card, [Option]) -> (Card, [Option]) -> Ordering
 compareGuess (c1, ops1) (c2, ops2)
@@ -227,7 +223,7 @@ onPlayed c = do
     let col = effectiveColour trCol (getCard c)
     case turnCol of
         Just demanded -> if col /= demanded
-            then origin c `hasNoLonger` demanded else return ()
+            then uorigin (getPile c) `hasNoLonger` demanded else return ()
         Nothing -> return ()
 
 choose :: MonadPlayer m => AI m Card
@@ -237,6 +233,19 @@ chooseStatistic :: MonadPlayer m => AI m Card
 chooseStatistic = do
     h <- gets getHand
     handCards <- gets myHand
+    table <- gets table
+    let tableNo = length table
+        left = 3 - tableNo
+        depth = case length handCards of
+            10 -> 3 + tableNo
+            9 -> 3 + tableNo
+            8 -> 3 + tableNo
+            7 -> 6 + tableNo
+            6 -> 9 + tableNo
+            5 -> 12 + tableNo
+            4 -> 15 + tableNo
+            _ -> 100
+    modify $ setDepth depth
     guess__ <- gets guess
     self <- get
     maySkat <- showSkat self
@@ -244,8 +253,7 @@ chooseStatistic = do
         guess = case maySkat of
             Just cs -> (cs `isSkat`) guess_
             Nothing -> guess_
-    table <- gets table
-    let ns = case length table of
+    let ns = case tableNo of
                 0 -> (0,  0,  0, 0)
                 1 -> (-1, 0, -1, 0)
                 2 -> (0,  0, -1, 0)
@@ -286,14 +294,13 @@ chooseOpen = do
     piles <- showPiles
     hand <- gets getHand
     let myCards = handCards hand piles
-    liftIO $ putStrLn $ show hand ++ " chooses from " ++ show myCards
     possible <- filterM (P.isAllowed myCards) myCards
     case length possible of
         0 -> do
             liftIO $ print hand
             liftIO $ print piles
             error "no cards left to choose from"
-        1 -> return $ head possible
+        1 -> return $ toCard $ head possible
         _ -> chooseSimulating
 
 chooseSimulating :: (MonadState AIEnv m, MonadPlayerOpen m)
@@ -303,11 +310,12 @@ chooseSimulating = do
     turnCol <- turnColour
     trumpCol <- trumpColour
     myHand <- gets getHand
+    depth <- gets simulationDepth
     let ps = Players (PL $ Stupid.Stupid Team Hand1)
                      (PL $ Stupid.Stupid Team Hand2)
                      (PL $ Stupid.Stupid Single Hand3)
         env = mkSkatEnv piles turnCol trumpCol ps myHand
-    liftIO $ evalStateT (Minmax.choose :: Skat Card) env
+    liftIO $ evalStateT (toCard <$> (Minmax.choose depth :: Skat (CardS Owner))) env
 
 simulate :: (MonadState AIEnv m, MonadPlayerOpen m)
          => Card -> m Int
@@ -329,7 +337,7 @@ simulate card = do
         env = mkSkatEnv piles turnCol trumpCol ps (next myHand)
     -- simulate the game after playing the given card
     (sgl, tm) <- liftIO $ evalStateT (do
-        modifyp $ playCard card
+        modifyp $ playCard myHand card
         turnGeneric playOpen depth) env
     let v = if myTeam == Single then (sgl, tm) else (tm, sgl)
     -- put the value into context for when not the whole game is
@@ -346,13 +354,13 @@ predictValue (own, others) = do
     --return $ own + pot
     return (own-others)
 
-potential :: (MonadState AIEnv m, MonadPlayerOpen m)
-          => [Card] -> m Int
+potential :: (MonadState AIEnv m, MonadPlayerOpen m, HasCard c)
+          => [c] -> m Int
 potential cs = do
     tr <- trumpColour
     let trs = filter (isTrump tr) cs
-        value = count cs
-    positions <- filter (==0) <$> mapM position cs
+        value = count . map toCard $ cs
+    positions <- filter (==0) <$> mapM (position . toCard) cs
     return $ length trs * 10 + value + length positions * 5
 
 position :: (MonadState AIEnv m, MonadPlayer m)