icfp/icfp14
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

next

Browse Source
This commit is contained in:
Stefan Bühler 2011-06-19 15:19:08 +02:00
parent 820ed868df
commit 402bbe79e0
2 changed files with 33 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
AI.hs
View File

@ -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)

4
GoalTransform.hs
View File

@ -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