0ada42a704f4a74a1e57581f08c539fe745250ce
[darcs-mirror-hbejeweler.git] / Strategy.hs
1 -- | Contestant for the Freies Magazin programming contest.
2 -- Copyright 2009 Joachim Breitner
3 --
4 -- This file is part of hbejeweler
5 --
6 --  hbejeweler is free software: you can redistribute it and/or modify
7 --  it under the terms of the GNU General Public License as published by
8 --  the Free Software Foundation, either version 2 of the License, or
9 --  (at your option) any later version.
10
11 --  hbejeweler is distributed in the hope that it will be useful,
12 --  but WITHOUT ANY WARRANTY; without even the implied warranty of
13 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 --  GNU General Public License for more details.
15
16 --  You should have received a copy of the GNU General Public License
17 --  along with hbejeweler.  If not, see <http://www.gnu.org/licenses/>.
18
19 module Strategy where
20
21 import Data
22 import Data.List
23 import Data.Ord
24 import Data.Tree.Game_tree.Game_tree
25 import Data.Tree.Game_tree.Negascout
26
27 depth = 3
28
29 instance Game_tree GameSituation where
30   is_terminal gs =    hitpoints (atTurn gs) <= 0
31                    || hitpoints (opponent gs) <= 0
32                    || null (children gs)
33   children gs = [ applyMove move gs | move <- possibleMoves (gameField gs) ]
34   node_value gs = (if We == turn gs then id else negate) $
35                   playerValue (atTurn gs) - playerValue (opponent gs)
36     where playerValue (PlayerStats h s r y g p) | h <= 0    = -200
37                                                 | otherwise = 5 * h + s
38                    
39 chooseMove :: GameSituation -> Move
40 chooseMove gs = fst $ maximumBy (comparing snd) $
41                 [ (move, snd (alpha_beta_search (applyMove move gs) depth))
42                   | move <- possibleMoves (gameField gs) ]
43
44