-
Notifications
You must be signed in to change notification settings - Fork 0
/
Strategy.hs
50 lines (41 loc) · 2.02 KB
/
Strategy.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
{-# LANGUAGE FlexibleInstances #-}
-- | Contestant for the Freies Magazin programming contest.
-- Copyright 2009 Joachim Breitner
--
-- This file is part of hbejeweler
--
-- hbejeweler is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 2 of the License, or
-- (at your option) any later version.
-- hbejeweler is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
-- You should have received a copy of the GNU General Public License
-- along with hbejeweler. If not, see <http://www.gnu.org/licenses/>.
module Strategy where
import Data
import Data.List
import Data.Ord
import Data.Maybe
import Data.Tree.Game_tree.Game_tree
import Data.Tree.Game_tree.Negascout
depth = 3
instance Game_tree (GameSituation, Maybe Move) where
is_terminal t@(gs,_) = hitpoints (atTurn gs) <= 0
|| hitpoints (opponent gs) <= 0
|| null (children t)
children (gs,_) = concatMap (repeatMove gs) $
[ (applyMove move gs, Just move) | move <- possibleMoves (gameField gs) ]
node_value (gs,_) = -- (if even depth then id else negate) $ -- work around bug in game-tree?
-- (if We == turn gs then id else negate) $
playerValue (atTurn gs) - playerValue (opponent gs)
where playerValue (PlayerStats h s r y g p) | h <= 0 = -2000
| otherwise = 60 * h + 15 * s + 10 * r + 6 * y + 3 * g
repeatMove (GameSituation { turn = t }) (gs,mm)
| turn gs == t = concatMap (repeatMove gs) $
[ (applyMove move gs, mm) | move <- possibleMoves (gameField gs) ]
| otherwise = [(gs,mm)]
chooseMove :: GameSituation -> Move
chooseMove gs = fromJust $ snd $ head $ tail $ fst $ negascout (gs, Nothing) depth