vindinum - board entities as enum

This commit is contained in:
weiss
2020-04-21 22:05:41 +02:00
parent 49481147ff
commit fbe7b56be0
18 changed files with 403 additions and 43 deletions

2
haskell/minimax/.gitignore vendored Normal file
View File

@@ -0,0 +1,2 @@
.stack-work/
*~

View File

@@ -0,0 +1,3 @@
# Changelog for minimax
## Unreleased changes

30
haskell/minimax/LICENSE Normal file
View 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.

View File

@@ -0,0 +1 @@
# minimax

2
haskell/minimax/Setup.hs Normal file
View File

@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@@ -0,0 +1,6 @@
module Main where
import Lib
main :: IO ()
main = someFunc

View 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

View 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

View File

@@ -0,0 +1,6 @@
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"

View 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

View 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

View File

@@ -0,0 +1,2 @@
main :: IO ()
main = putStrLn "Test suite not yet implemented"

View File

@@ -0,0 +1,8 @@
{
"folders": [
{
"path": "."
}
],
"settings": {}
}

View File

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

View File

@@ -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 let myMines = filter (\e -> case e of
r <- randomRIO (0,3) :: IO Int EMine oId _ -> oId == myId
let dir = if r == 0 _ -> False) entities
then "NORTH"
else if r == 1
then "EAST"
else if r == 2
then "SOUTH"
else
"WEST"
putStrLn $ case life hero of let (val, pos) = simulate board (posFromEntity hero) (gameState hero $ length myMines)
Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minMine hPrint stderr val
Nothing -> moveToEntity minMine 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

View 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

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

View File

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