next

AI.hs

@@ -6,6 +6,8 @@ import Eval
 import Lambda
 import GoalTransform
 
+import qualified Data.Array.IO as A
+
 cannon 1 = "dec"
 cannon 2 = "S dec dec"
 cannon n = "S(" ++ cannon (n-1) ++ ") dec"
@@ -14,5 +16,32 @@ keepalive func 0 = "S(" ++ func ++ ")(get)0"
 keepalive func 1 = "S(K(S(" ++ func ++ ")(get)))(succ)0"
 keepalive func slot = "S(" ++ func ++ ")(S (K get) (K " ++ show slot ++ "))0"
 
+findAliveSlot :: (Game -> Player) -> Turn Int
+findAliveSlot player = do
+	game <- getGame
+	slots <- liftIO $ A.getAssocs (fields $ player game)
+	let (slot, _):_ = filter (\(_, (_, vit)) -> vit > 0) slots
+	return slot
+
+findHighAliveSlot :: (Game -> Player) -> Turn Int
+findHighAliveSlot player = do
+	game <- getGame
+	slots <- liftIO $ A.getAssocs (fields $ player game)
+	let (slot, _):_ = filter (\(_, (_, vit)) -> vit > 0) $ reverse slots
+	return slot
+
 aimove :: Turn Goal
-aimove = return (Just 1, read $ keepalive (cannon 200) 1)
+aimove = do
+	target <- findAliveSlot opponent
+	let l = if (target == 255) then "S(dec)(S(get)(I))" else "S(S(K(dec))(K(" ++ show (255-target) ++ ")))(S(get)(I))"
+-- 	let l = if (target == 255) then "S(dec)(S(get)(I))" else "S(K(S(dec)(S(get)(I))))(K(" ++ show (255-target) ++ "))"
+	let pos = 1 -- if (target == 255) then 1 else 255-target
+	haveLoop <- satGoal (0, read l)
+	if haveLoop then do
+			haveLoop <- satGoal (pos, read l)
+			if haveLoop then do
+					return (Just pos, read (l ++ "0"))
+				else
+					return (Just pos, read "get 0")
+		else do
+			return (Just 0, read l)

GoalTransform.hs

@@ -4,6 +4,8 @@ module GoalTransform (
 	moveGoal,
 	evalMoves,
 	subgoals,
+	satGoal,
+	satGoals,
 ) where
 
 import Eval
@@ -44,7 +46,7 @@ _subgoals current pos (Apply t (Prim c)) = let m = MoveRight pos c in _subgoals
 _subgoals current pos (Apply t (Const 0)) = let m = MoveRight pos Card_Zero in _subgoals current pos t ++ [((pos, applyMove t m):current, m)]
 _subgoals current pos (Prim c) = evalMoves current pos Nothing [MoveRight pos c]
 _subgoals current 0 (Apply a b) = _subgoals current 1 (Apply a b) ++ copyTo ((1, Apply a b):current) 1 0 (Apply a b)
-_subgoals current pos (Apply a b) = _subgoals current pos a ++ _subgoals ((pos,a):current) (pos+1) b ++ copyTo ((pos,a):(pos+1, b):current) (pos+1) 0 b ++ evalMoves ((0, b):current) pos (Just a) [MoveLeft Card_K pos, MoveLeft Card_S pos, MoveRight pos Card_Get, MoveRight pos Card_Zero]
+_subgoals current pos (Apply a b) = _subgoals current pos a ++ _subgoals ((pos,a):current) (pos+1) b ++ copyTo ((pos,a):(pos+1, b):current) (pos+1) 0 b ++ evalMoves ((0, b):current) pos (Just a) [MoveLeft Card_K pos, MoveLeft Card_S pos, MoveRight pos Card_Get] ++ [((pos, Apply a b):current, MoveRight pos Card_Zero)]
 
 subgoals pos t = reverse $ _subgoals [] pos t