vindinum - board entities as enum
This commit is contained in:
2
haskell/minimax/.gitignore
vendored
Normal file
2
haskell/minimax/.gitignore
vendored
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
.stack-work/
|
||||||
|
*~
|
||||||
3
haskell/minimax/ChangeLog.md
Normal file
3
haskell/minimax/ChangeLog.md
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
# Changelog for minimax
|
||||||
|
|
||||||
|
## Unreleased changes
|
||||||
30
haskell/minimax/LICENSE
Normal file
30
haskell/minimax/LICENSE
Normal file
@@ -0,0 +1,30 @@
|
|||||||
|
Copyright Author name here (c) 2020
|
||||||
|
|
||||||
|
All rights reserved.
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
* Redistributions of source code must retain the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
* Redistributions in binary form must reproduce the above
|
||||||
|
copyright notice, this list of conditions and the following
|
||||||
|
disclaimer in the documentation and/or other materials provided
|
||||||
|
with the distribution.
|
||||||
|
|
||||||
|
* Neither the name of Author name here nor the names of other
|
||||||
|
contributors may be used to endorse or promote products derived
|
||||||
|
from this software without specific prior written permission.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||||
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||||
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||||
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||||
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||||
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||||
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||||
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
1
haskell/minimax/README.md
Normal file
1
haskell/minimax/README.md
Normal file
@@ -0,0 +1 @@
|
|||||||
|
# minimax
|
||||||
2
haskell/minimax/Setup.hs
Normal file
2
haskell/minimax/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
import Distribution.Simple
|
||||||
|
main = defaultMain
|
||||||
6
haskell/minimax/app/Main.hs
Normal file
6
haskell/minimax/app/Main.hs
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Lib
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = someFunc
|
||||||
62
haskell/minimax/minimax.cabal
Normal file
62
haskell/minimax/minimax.cabal
Normal file
@@ -0,0 +1,62 @@
|
|||||||
|
cabal-version: 1.12
|
||||||
|
|
||||||
|
-- This file has been generated from package.yaml by hpack version 0.31.2.
|
||||||
|
--
|
||||||
|
-- see: https://github.com/sol/hpack
|
||||||
|
--
|
||||||
|
-- hash: 1a92bf809b96295b9e0acbb0e9595442d6bfc44923f46027b8c604aa6700076e
|
||||||
|
|
||||||
|
name: minimax
|
||||||
|
version: 0.1.0.0
|
||||||
|
description: Please see the README on GitHub at <https://github.com/githubuser/minimax#readme>
|
||||||
|
homepage: https://github.com/githubuser/minimax#readme
|
||||||
|
bug-reports: https://github.com/githubuser/minimax/issues
|
||||||
|
author: Author name here
|
||||||
|
maintainer: example@example.com
|
||||||
|
copyright: 2020 Author name here
|
||||||
|
license: BSD3
|
||||||
|
license-file: LICENSE
|
||||||
|
build-type: Simple
|
||||||
|
extra-source-files:
|
||||||
|
README.md
|
||||||
|
ChangeLog.md
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: https://github.com/githubuser/minimax
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Lib
|
||||||
|
other-modules:
|
||||||
|
Paths_minimax
|
||||||
|
hs-source-dirs:
|
||||||
|
src
|
||||||
|
build-depends:
|
||||||
|
base >=4.7 && <5
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable minimax-exe
|
||||||
|
main-is: Main.hs
|
||||||
|
other-modules:
|
||||||
|
Paths_minimax
|
||||||
|
hs-source-dirs:
|
||||||
|
app
|
||||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
base >=4.7 && <5
|
||||||
|
, minimax
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite minimax-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Spec.hs
|
||||||
|
other-modules:
|
||||||
|
Paths_minimax
|
||||||
|
hs-source-dirs:
|
||||||
|
test
|
||||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
base >=4.7 && <5
|
||||||
|
, minimax
|
||||||
|
default-language: Haskell2010
|
||||||
48
haskell/minimax/package.yaml
Normal file
48
haskell/minimax/package.yaml
Normal file
@@ -0,0 +1,48 @@
|
|||||||
|
name: minimax
|
||||||
|
version: 0.1.0.0
|
||||||
|
github: "githubuser/minimax"
|
||||||
|
license: BSD3
|
||||||
|
author: "Author name here"
|
||||||
|
maintainer: "example@example.com"
|
||||||
|
copyright: "2020 Author name here"
|
||||||
|
|
||||||
|
extra-source-files:
|
||||||
|
- README.md
|
||||||
|
- ChangeLog.md
|
||||||
|
|
||||||
|
# Metadata used when publishing your package
|
||||||
|
# synopsis: Short description of your package
|
||||||
|
# category: Web
|
||||||
|
|
||||||
|
# To avoid duplicated efforts in documentation and dealing with the
|
||||||
|
# complications of embedding Haddock markup inside cabal files, it is
|
||||||
|
# common to point users to the README.md file.
|
||||||
|
description: Please see the README on GitHub at <https://github.com/githubuser/minimax#readme>
|
||||||
|
|
||||||
|
dependencies:
|
||||||
|
- base >= 4.7 && < 5
|
||||||
|
|
||||||
|
library:
|
||||||
|
source-dirs: src
|
||||||
|
|
||||||
|
executables:
|
||||||
|
minimax-exe:
|
||||||
|
main: Main.hs
|
||||||
|
source-dirs: app
|
||||||
|
ghc-options:
|
||||||
|
- -threaded
|
||||||
|
- -rtsopts
|
||||||
|
- -with-rtsopts=-N
|
||||||
|
dependencies:
|
||||||
|
- minimax
|
||||||
|
|
||||||
|
tests:
|
||||||
|
minimax-test:
|
||||||
|
main: Spec.hs
|
||||||
|
source-dirs: test
|
||||||
|
ghc-options:
|
||||||
|
- -threaded
|
||||||
|
- -rtsopts
|
||||||
|
- -with-rtsopts=-N
|
||||||
|
dependencies:
|
||||||
|
- minimax
|
||||||
6
haskell/minimax/src/Lib.hs
Normal file
6
haskell/minimax/src/Lib.hs
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
module Lib
|
||||||
|
( someFunc
|
||||||
|
) where
|
||||||
|
|
||||||
|
someFunc :: IO ()
|
||||||
|
someFunc = putStrLn "someFunc"
|
||||||
66
haskell/minimax/stack.yaml
Normal file
66
haskell/minimax/stack.yaml
Normal file
@@ -0,0 +1,66 @@
|
|||||||
|
# This file was automatically generated by 'stack init'
|
||||||
|
#
|
||||||
|
# Some commonly used options have been documented as comments in this file.
|
||||||
|
# For advanced use and comprehensive documentation of the format, please see:
|
||||||
|
# https://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||||
|
|
||||||
|
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||||
|
# A snapshot resolver dictates the compiler version and the set of packages
|
||||||
|
# to be used for project dependencies. For example:
|
||||||
|
#
|
||||||
|
# resolver: lts-3.5
|
||||||
|
# resolver: nightly-2015-09-21
|
||||||
|
# resolver: ghc-7.10.2
|
||||||
|
#
|
||||||
|
# The location of a snapshot can be provided as a file or url. Stack assumes
|
||||||
|
# a snapshot provided as a file might change, whereas a url resource does not.
|
||||||
|
#
|
||||||
|
# resolver: ./custom-snapshot.yaml
|
||||||
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
|
resolver: lts-15.8
|
||||||
|
|
||||||
|
# User packages to be built.
|
||||||
|
# Various formats can be used as shown in the example below.
|
||||||
|
#
|
||||||
|
# packages:
|
||||||
|
# - some-directory
|
||||||
|
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||||
|
# subdirs:
|
||||||
|
# - auto-update
|
||||||
|
# - wai
|
||||||
|
packages:
|
||||||
|
- .
|
||||||
|
# Dependency packages to be pulled from upstream that are not in the resolver.
|
||||||
|
# These entries can reference officially published versions as well as
|
||||||
|
# forks / in-progress versions pinned to a git hash. For example:
|
||||||
|
#
|
||||||
|
# extra-deps:
|
||||||
|
# - acme-missiles-0.3
|
||||||
|
# - git: https://github.com/commercialhaskell/stack.git
|
||||||
|
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
#
|
||||||
|
# extra-deps: []
|
||||||
|
|
||||||
|
# Override default flag values for local packages and extra-deps
|
||||||
|
# flags: {}
|
||||||
|
|
||||||
|
# Extra package databases containing global packages
|
||||||
|
# extra-package-dbs: []
|
||||||
|
|
||||||
|
# Control whether we use the GHC we find on the path
|
||||||
|
# system-ghc: true
|
||||||
|
#
|
||||||
|
# Require a specific version of stack, using version ranges
|
||||||
|
# require-stack-version: -any # Default
|
||||||
|
# require-stack-version: ">=2.1"
|
||||||
|
#
|
||||||
|
# Override the architecture used by stack, especially useful on Windows
|
||||||
|
# arch: i386
|
||||||
|
# arch: x86_64
|
||||||
|
#
|
||||||
|
# Extra directories used by stack for building
|
||||||
|
# extra-include-dirs: [/path/to/dir]
|
||||||
|
# extra-lib-dirs: [/path/to/dir]
|
||||||
|
#
|
||||||
|
# Allow a newer minor version of GHC than the snapshot specifies
|
||||||
|
# compiler-check: newer-minor
|
||||||
12
haskell/minimax/stack.yaml.lock
Normal file
12
haskell/minimax/stack.yaml.lock
Normal file
@@ -0,0 +1,12 @@
|
|||||||
|
# This file was autogenerated by Stack.
|
||||||
|
# You should not edit this file by hand.
|
||||||
|
# For more information, please see the documentation at:
|
||||||
|
# https://docs.haskellstack.org/en/stable/lock_files
|
||||||
|
|
||||||
|
packages: []
|
||||||
|
snapshots:
|
||||||
|
- completed:
|
||||||
|
size: 492015
|
||||||
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/8.yaml
|
||||||
|
sha256: 926bc3d70249dd0ba05277ff00943c0addb35b627cb641752669e7cf771310d0
|
||||||
|
original: lts-15.8
|
||||||
2
haskell/minimax/test/Spec.hs
Normal file
2
haskell/minimax/test/Spec.hs
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
main :: IO ()
|
||||||
|
main = putStrLn "Test suite not yet implemented"
|
||||||
8
haskell/minimax/workspace.code-workspace
Normal file
8
haskell/minimax/workspace.code-workspace
Normal file
@@ -0,0 +1,8 @@
|
|||||||
|
{
|
||||||
|
"folders": [
|
||||||
|
{
|
||||||
|
"path": "."
|
||||||
|
}
|
||||||
|
],
|
||||||
|
"settings": {}
|
||||||
|
}
|
||||||
@@ -30,6 +30,8 @@ dependencies:
|
|||||||
- random
|
- random
|
||||||
- containers >=0.5 && <0.7
|
- containers >=0.5 && <0.7
|
||||||
- haskell-src-exts
|
- haskell-src-exts
|
||||||
|
- vector
|
||||||
|
- mtl
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
|
|||||||
@@ -1,26 +1,25 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}
|
{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}
|
||||||
module Player
|
module Player
|
||||||
( runMain
|
( runMain
|
||||||
|
, Board
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import System.Random
|
import System.Random
|
||||||
import Data.Char (digitToInt)
|
import Data.Char (digitToInt)
|
||||||
import Data.List (minimumBy)
|
import Data.List as L
|
||||||
|
|
||||||
import BotRunner
|
import BotRunner
|
||||||
import Graph
|
import Graph
|
||||||
|
import Simulation.Data
|
||||||
|
import Simulation.Board (simulate)
|
||||||
|
|
||||||
data BoardEntity = BSpawnPoint Int | BWall | BTavern | BMine | BEmpty deriving (Show, Eq)
|
|
||||||
type Board = [[BoardEntity]]
|
|
||||||
type IndexedBoard = [(Pos, BoardEntity)]
|
|
||||||
type Pos = (Int, Int)
|
|
||||||
|
|
||||||
-- Id, Pos, life, gold
|
-- Id, Pos, life, gold
|
||||||
data Entity
|
data Entity
|
||||||
= Hero Int Pos Int Int
|
= EHero Int Pos Int Int
|
||||||
| Mine Int Pos
|
| EMine Int Pos
|
||||||
|
|
||||||
runMain :: IO ()
|
runMain :: IO ()
|
||||||
runMain = runBot True bot
|
runMain = runBot True bot
|
||||||
@@ -34,14 +33,14 @@ bot readLine writeLine = do
|
|||||||
let size = read input_line :: Int
|
let size = read input_line :: Int
|
||||||
|
|
||||||
board' <- replicateM size getLine
|
board' <- replicateM size getLine
|
||||||
let board :: Board = map (\br -> map (\se -> if
|
let board :: Board = fmap (\br -> fmap (\se -> if
|
||||||
| se == '.' -> BEmpty
|
| se == '.' -> Air
|
||||||
| se == '#' -> BWall
|
| se == '#' -> Wall
|
||||||
| se == 'T' -> BTavern
|
| se == 'T' -> Tavern
|
||||||
| se == 'M' -> BMine
|
| se == 'M' -> Mine
|
||||||
| otherwise -> BSpawnPoint $ digitToInt se) br) board'
|
| otherwise -> SpawnPoint) br) board' -- TODO: $ digitToInt se) br) board'
|
||||||
input_line <- getLine
|
input_line <- getLine
|
||||||
let iBoard :: IndexedBoard = concatMap (\(i_r, br) -> map (\(i_c, bc) -> ((i_c, i_r), bc)) br) $ zip [0..9] $ map (zip [0..9]) board
|
let iBoard :: IndexedBoard = Prelude.concatMap (\(i_r, br) -> fmap (\(i_c, bc) -> ((i_c, i_r), bc)) br) $ zip [0..9] $ map (zip [0..9]) board
|
||||||
|
|
||||||
let myId = read input_line :: Int -- ID of your hero
|
let myId = read input_line :: Int -- ID of your hero
|
||||||
|
|
||||||
@@ -60,41 +59,37 @@ bot readLine writeLine = do
|
|||||||
let life = read (input!!4) :: Int -- the life of a hero (-1 for mines)
|
let life = read (input!!4) :: Int -- the life of a hero (-1 for mines)
|
||||||
let gold = read (input!!5) :: Int -- the gold of a hero (-1 for mines)
|
let gold = read (input!!5) :: Int -- the gold of a hero (-1 for mines)
|
||||||
pure $ if entitytype == "HERO"
|
pure $ if entitytype == "HERO"
|
||||||
then Hero id (x,y) life gold
|
then EHero id (x,y) life gold
|
||||||
else Mine id (x,y)
|
else EMine id (x,y)
|
||||||
|
|
||||||
let heroes = filter (\e -> case e of
|
let heroes = filter (\e -> case e of
|
||||||
Hero _ _ _ _ -> True
|
EHero _ _ _ _ -> True
|
||||||
_ -> False) entities
|
_ -> False) entities
|
||||||
let hero = head $ filter (\e -> case e of
|
let hero = head $ filter (\e -> case e of
|
||||||
Hero id _ _ _ -> id == myId
|
EHero id _ _ _ -> id == myId
|
||||||
_ -> False) heroes
|
_ -> False) heroes
|
||||||
let mines = filter (\e -> case e of
|
let mines = filter (\e -> case e of
|
||||||
Mine oId _ -> oId /= myId
|
EMine oId _ -> oId /= myId
|
||||||
_ -> False) entities
|
_ -> False) entities
|
||||||
let minMine = minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) mines
|
let minEMine = L.minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) mines
|
||||||
let minTavernPos = minimumBy (\p1 p2 -> compare (dist p1 (posFromEntity hero)) (dist p2 (posFromEntity hero))) $ map (\(p, be) -> p) $ filter (\(p, be) -> isTavern be) iBoard
|
let minTavernPos = L.minimumBy (\p1 p2 -> compare (dist p1 (posFromEntity hero)) (dist p2 (posFromEntity hero))) $ map (\(p, be) -> p) $ filter (\(p, be) -> isTavern be) iBoard
|
||||||
-- hPrint stderr minMine
|
|
||||||
|
|
||||||
-- WAIT | NORTH | EAST | SOUTH | WEST
|
|
||||||
r <- randomRIO (0,3) :: IO Int
|
|
||||||
let dir = if r == 0
|
|
||||||
then "NORTH"
|
|
||||||
else if r == 1
|
|
||||||
then "EAST"
|
|
||||||
else if r == 2
|
|
||||||
then "SOUTH"
|
|
||||||
else
|
|
||||||
"WEST"
|
|
||||||
|
|
||||||
putStrLn $ case life hero of
|
let myMines = filter (\e -> case e of
|
||||||
Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minMine
|
EMine oId _ -> oId == myId
|
||||||
Nothing -> moveToEntity minMine
|
_ -> False) entities
|
||||||
|
|
||||||
|
let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ length myMines)
|
||||||
|
hPrint stderr val
|
||||||
|
putStrLn $ moveToPos pos
|
||||||
|
|
||||||
|
-- putStrLn $ case life hero of
|
||||||
|
-- Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minEMine
|
||||||
|
-- Nothing -> moveToEntity minEMine
|
||||||
|
|
||||||
moveToEntity :: Entity -> String
|
moveToEntity :: Entity -> String
|
||||||
moveToEntity e = case e of
|
moveToEntity e = case e of
|
||||||
Hero _ p _ _ -> cout p
|
EHero _ p _ _ -> cout p
|
||||||
Mine _ p -> cout p
|
EMine _ p -> cout p
|
||||||
where cout (x,y) = "MOVE " <> (show x) <> " " <> (show y)
|
where cout (x,y) = "MOVE " <> (show x) <> " " <> (show y)
|
||||||
|
|
||||||
moveToPos :: (Int, Int) -> String
|
moveToPos :: (Int, Int) -> String
|
||||||
@@ -104,15 +99,19 @@ dist :: Pos -> Pos -> Int
|
|||||||
dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)
|
dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)
|
||||||
|
|
||||||
life :: Entity -> Maybe Int
|
life :: Entity -> Maybe Int
|
||||||
life (Hero _ _ l _) = Just l
|
life (EHero _ _ l _) = Just l
|
||||||
life _ = Nothing
|
life _ = Nothing
|
||||||
|
|
||||||
posFromEntity :: Entity -> (Int, Int)
|
posFromEntity :: Entity -> (Int, Int)
|
||||||
posFromEntity (Hero _ p _ _) = p
|
posFromEntity (EHero _ p _ _) = p
|
||||||
posFromEntity (Mine _ p) = p
|
posFromEntity (EMine _ p) = p
|
||||||
|
|
||||||
|
gameState :: Entity -> Int -> (Int, Int, Int)
|
||||||
|
gameState (EHero _ _ l g) mines = (g, l, mines)
|
||||||
|
gameState (EMine _ _) mines = (-1, -1, mines)
|
||||||
|
|
||||||
isTavern :: BoardEntity -> Bool
|
isTavern :: BoardEntity -> Bool
|
||||||
isTavern BTavern = True
|
isTavern Tavern = True
|
||||||
isTavern _ = False
|
isTavern _ = False
|
||||||
|
|
||||||
addEdge' :: Ord v => Graph v -> [v] -> Graph v
|
addEdge' :: Ord v => Graph v -> [v] -> Graph v
|
||||||
|
|||||||
88
haskell/vindinium/src/Simulation/Board.hs
Normal file
88
haskell/vindinium/src/Simulation/Board.hs
Normal file
@@ -0,0 +1,88 @@
|
|||||||
|
module Simulation.Board
|
||||||
|
( simulate
|
||||||
|
) where
|
||||||
|
|
||||||
|
-- import Prelude
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
import Control.Monad.State as S
|
||||||
|
import Control.Monad.State.Class
|
||||||
|
import Data.List as L
|
||||||
|
import Simulation.Data
|
||||||
|
|
||||||
|
spawnPoint = fromEnum SpawnPoint
|
||||||
|
wall = fromEnum Wall
|
||||||
|
tavern = fromEnum Tavern
|
||||||
|
mine = fromEnum Mine
|
||||||
|
air = fromEnum Air
|
||||||
|
|
||||||
|
size = 10 -- TODO: Allow for variable board sizes
|
||||||
|
searchDepth = 6
|
||||||
|
|
||||||
|
fromPlayerBoard :: Board -> BoardInternal
|
||||||
|
fromPlayerBoard pBoardInternal = fmap (fmap $ fromEnum) asVector
|
||||||
|
where asVector = V.fromList $ fmap V.fromList pBoardInternal
|
||||||
|
|
||||||
|
emptyBoard :: BoardInternal
|
||||||
|
emptyBoard = V.generate 9 (\_ -> V.replicate 9 air)
|
||||||
|
|
||||||
|
-- All valid board positions are possible. For example the player could move
|
||||||
|
-- back and forth between two fields infinitely
|
||||||
|
-- Caution: if the player moved inside a Tavern or Mine he needs to be reset to his initial position afterwards
|
||||||
|
-- TODO: Check if tailrec
|
||||||
|
simulate :: Board -> Pos -> GameState -> (Int, Pos)
|
||||||
|
simulate board pos = evalState sim
|
||||||
|
where sim = simulateMove (fromPlayerBoard board) pos searchDepth (-1,-1)
|
||||||
|
|
||||||
|
simulateMove :: BoardInternal -> Pos -> Int -> Pos -> State GameState (Int, Pos)
|
||||||
|
simulateMove board pos depth prevPos
|
||||||
|
| depth == 0 = do
|
||||||
|
evalMove board pos
|
||||||
|
gold <- evalGameState
|
||||||
|
pure $ (gold, pos)
|
||||||
|
| otherwise = do
|
||||||
|
evalMove board pos
|
||||||
|
let bPos = boardPos board pos
|
||||||
|
let pos' = if bPos == tavern || bPos == mine then prevPos else pos -- move back out of tavern/mine
|
||||||
|
vals <- S.mapM (\pos'' -> simulateMove board pos'' (depth-1) pos') moves
|
||||||
|
-- let valsWithPos = zip (fmap fst vals) moves -- return poss of current move, not of submoves
|
||||||
|
-- pure $ L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) valsWithPos
|
||||||
|
pure $ L.maximumBy (\(v1, _) (v2, _) -> compare v1 v2) vals
|
||||||
|
where
|
||||||
|
moves :: [Pos]
|
||||||
|
moves = filter (posValid board) $ possibleMoves pos
|
||||||
|
|
||||||
|
-- update State according to hero position on board
|
||||||
|
-- executed every move
|
||||||
|
evalMove :: BoardInternal -> Pos -> State GameState ()
|
||||||
|
evalMove board pos
|
||||||
|
| entity == Air = modify (\(gold, life, mines) -> (gold+mines, life-1, mines))
|
||||||
|
| entity == SpawnPoint = modify (\(gold, life, mines) -> (gold+mines, life-1, mines))
|
||||||
|
| entity == Tavern = modify ( \(gold, life, mines) -> (gold+mines-2, min 100 (life+50), mines) ) -- TODO: Check if life is +19
|
||||||
|
| entity == Mine = modify (\(gold, life, mines) -> (gold+mines, life-1, mines))
|
||||||
|
| entity == Wall = pure () -- should never happen
|
||||||
|
where
|
||||||
|
entity = toEnum $ boardPos board pos
|
||||||
|
|
||||||
|
-- retuns the evalutaion of the current move
|
||||||
|
-- executed if maximum depth is reached
|
||||||
|
evalGameState :: State GameState Int
|
||||||
|
evalGameState = do
|
||||||
|
(gold, _, _) <- get
|
||||||
|
pure gold
|
||||||
|
|
||||||
|
-- get BoardInternalEntity Enum of Pos on BoardInternal
|
||||||
|
boardPos :: BoardInternal -> Pos -> BoardEntityEnum
|
||||||
|
boardPos board (x,y) = fromEnum $ (board V.! x) V.! y
|
||||||
|
|
||||||
|
posValid :: BoardInternal -> Pos -> Bool
|
||||||
|
posValid board pos@(x,y) = onBoardInternal && boardPos' /= wall
|
||||||
|
where
|
||||||
|
boardPos' = boardPos board pos
|
||||||
|
onBoardInternal = x >= 0 && x < size && y >= 0 && y < size
|
||||||
|
|
||||||
|
possibleMoves :: Pos -> [Pos]
|
||||||
|
possibleMoves (x,y) = [ (x+1, y), (x, y+1), (x-1, y), (x, y-1) ]
|
||||||
|
|
||||||
|
|
||||||
|
data Tree v = Node v (Tree v) | Leaf v
|
||||||
|
|
||||||
15
haskell/vindinium/src/Simulation/Data.hs
Normal file
15
haskell/vindinium/src/Simulation/Data.hs
Normal file
@@ -0,0 +1,15 @@
|
|||||||
|
module Simulation.Data where
|
||||||
|
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
|
||||||
|
data BoardEntity = SpawnPoint | Wall | Tavern | Mine | Air deriving (Show, Eq, Enum)
|
||||||
|
type BoardEntityEnum = Int
|
||||||
|
|
||||||
|
type Board = [[BoardEntity]]
|
||||||
|
type IndexedBoard = [(Pos, BoardEntity)]
|
||||||
|
|
||||||
|
type BoardInternal = V.Vector (V.Vector BoardEntityEnum)
|
||||||
|
type Pos = (Int, Int)
|
||||||
|
|
||||||
|
-- (gold, life, numMines)
|
||||||
|
type GameState = (Int, Int, Int)
|
||||||
@@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 830ab1dfe911ba97d355d8cb635f3c8cb20a911f05b8cbcb68139e102b99cfd5
|
-- hash: 817a86041a7dd560036682aca70efb443076dda509e4bb85d122ed1d611907a1
|
||||||
|
|
||||||
name: stackproject
|
name: stackproject
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
@@ -32,6 +32,8 @@ library
|
|||||||
Debug
|
Debug
|
||||||
Graph
|
Graph
|
||||||
Player
|
Player
|
||||||
|
Simulation.Board
|
||||||
|
Simulation.Data
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_stackproject
|
Paths_stackproject
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
@@ -46,7 +48,9 @@ library
|
|||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
, haskell-src-exts
|
, haskell-src-exts
|
||||||
|
, mtl
|
||||||
, random
|
, random
|
||||||
|
, vector
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable stackproject-exe
|
executable stackproject-exe
|
||||||
@@ -66,8 +70,10 @@ executable stackproject-exe
|
|||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
, haskell-src-exts
|
, haskell-src-exts
|
||||||
|
, mtl
|
||||||
, random
|
, random
|
||||||
, stackproject
|
, stackproject
|
||||||
|
, vector
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite stackproject-test
|
test-suite stackproject-test
|
||||||
@@ -88,6 +94,8 @@ test-suite stackproject-test
|
|||||||
, directory
|
, directory
|
||||||
, filepath
|
, filepath
|
||||||
, haskell-src-exts
|
, haskell-src-exts
|
||||||
|
, mtl
|
||||||
, random
|
, random
|
||||||
, stackproject
|
, stackproject
|
||||||
|
, vector
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
Reference in New Issue
Block a user