Browse Source

Merge branch 'vm' of bitbucket.org:lilik/icfp2015 into vm

vm
kaos 9 years ago
parent
commit
0bb6b5d120
41 changed files with 220 additions and 71 deletions
  1. +1
    -0
      solutions/0.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000723.strategy2b
  2. +1
    -0
      solutions/0.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002073.strategy2b
  3. +1
    -0
      solutions/10.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000358.strategy2b
  4. +1
    -0
      solutions/11.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002499.strategy2b
  5. +1
    -0
      solutions/11.12877.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001622.strategy2b
  6. +1
    -0
      solutions/11.16526.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002548.strategy2b
  7. +1
    -0
      solutions/11.19558.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001657.strategy2b
  8. +1
    -0
      solutions/11.20528.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001773.strategy2b
  9. +1
    -0
      solutions/12.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003106.strategy2b
  10. +1
    -0
      solutions/12.1155.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002942.strategy2b
  11. +1
    -0
      solutions/12.12700.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002925.strategy2b
  12. +1
    -0
      solutions/12.18660.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002904.strategy2b
  13. +1
    -0
      solutions/12.19102.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002813.strategy2b
  14. +1
    -0
      solutions/12.24103.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002828.strategy2b
  15. +1
    -0
      solutions/12.24762.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003154.strategy2b
  16. +1
    -0
      solutions/12.24803.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001713.strategy2b
  17. +1
    -0
      solutions/12.29992.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002773.strategy2b
  18. +1
    -0
      solutions/12.5864.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002373.strategy2b
  19. +1
    -0
      solutions/18.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002731.strategy2b
  20. +1
    -0
      solutions/19.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000941.strategy2b
  21. +1
    -0
      solutions/20.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002328.strategy2b
  22. +1
    -0
      solutions/21.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000339.strategy2b
  23. +1
    -0
      solutions/22.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000340.strategy2b
  24. +1
    -0
      solutions/23.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000771.strategy2b
  25. +1
    -0
      solutions/24.18.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002521.strategy2b
  26. +101
    -32
      src/Datatypes/Game.hs
  27. +2
    -2
      src/Main0.hs
  28. +7
    -6
      src/Strategy0.hs
  29. +67
    -0
      src/TestSolution.hs
  30. +7
    -28
      src/VM.hs
  31. +1
    -0
      submitted/0.json
  32. +1
    -0
      submitted/10.json
  33. +1
    -1
      submitted/11.json
  34. +1
    -1
      submitted/12.json
  35. +1
    -0
      submitted/18.json
  36. +1
    -0
      submitted/19.json
  37. +1
    -1
      submitted/20.json
  38. +1
    -0
      submitted/21.json
  39. +1
    -0
      submitted/22.json
  40. +1
    -0
      submitted/23.json
  41. +1
    -0
      submitted/24.json

+ 1
- 0
solutions/0.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000723.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ia! ia!ia! ia!ia! ia!ia! ia!aei!ia! ia!aei!allei!alei!lei!kei!l", "problemId": 0}

+ 1
- 0
solutions/0.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002073.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ia! ia!ia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ia! ia!necronomiconyuggothei!ia! ia!klkkkllkbei!lei!", "problemId": 0}

+ 1
- 0
solutions/10.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000358.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "dei!kdei!bei!pdaei!ppdlakbbei!ppdlakei!ppdladpppddppppkppkl", "problemId": 10}

+ 1
- 0
solutions/11.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002499.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.yuggothei!necronomiconbdpppdei!pkbbei!dei!", "problemId": 11}

+ 1
- 0
solutions/11.12877.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001622.strategy2b View File

@ -0,0 +1 @@
{"seed": 12877, "tag": "strategy2b", "solution": "cthulhu r'lyehyogsothothia! ia!ia! ia!necronomiconei!ldappdpkppdei!l", "problemId": 11}

+ 1
- 0
solutions/11.16526.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002548.strategy2b View File

@ -0,0 +1 @@
{"seed": 16526, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconia! ia!necronomiconyogsothothyuggothei!necronomiconcthulhu r'lyehnecronomiconia! ia!ia! ia!pcthulhu r'lyehei!pei!aei!adei!kpddppaei!ddbbei!kaei!l", "problemId": 11}

+ 1
- 0
solutions/11.19558.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001657.strategy2b View File

@ -0,0 +1 @@
{"seed": 19558, "tag": "strategy2b", "solution": "cthulhu r'lyehia! ia!ia! ia!necronomiconei!aei!llei!ei!aei!aadaaddei!ayuggoth", "problemId": 11}

+ 1
- 0
solutions/11.20528.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001773.strategy2b View File

@ -0,0 +1 @@
{"seed": 20528, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconia! ia!necronomiconei!ia! ia!necronomiconei!dei!paei!l", "problemId": 11}

+ 1
- 0
solutions/12.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003106.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!ia! ia!acthulhu r'lyehyuggothei!aei!akei!pdpkppdei!l", "problemId": 12}

+ 1
- 0
solutions/12.1155.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002942.strategy2b View File

@ -0,0 +1 @@
{"seed": 1155, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ia! ia!necronomiconei!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!llnecronomiconei!ia! ia!aei!ayogsothothei!aei!alkei!kei!aei!l", "problemId": 12}

+ 1
- 0
solutions/12.12700.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002925.strategy2b View File

@ -0,0 +1 @@
{"seed": 12700, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!necronomiconnecronomiconei!kei!kkaaei!aei!necronomiconia! ia!dei!aei!dei!kbei!", "problemId": 12}

+ 1
- 0
solutions/12.18660.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002904.strategy2b View File

@ -0,0 +1 @@
{"seed": 18660, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!necronomiconei!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconcthulhu r'lyehcthulhu r'lyehnecronomiconnecronomiconcthulhu r'lyehpia! ia!ia! ia!kaia! ia!ia! ia!necronomicondei!aei!dbei!", "problemId": 12}

+ 1
- 0
solutions/12.19102.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002813.strategy2b View File

@ -0,0 +1 @@
{"seed": 19102, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconia! ia!aei!llei!abei!", "problemId": 12}

+ 1
- 0
solutions/12.24103.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002828.strategy2b View File

@ -0,0 +1 @@
{"seed": 24103, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!ia! ia!necronomiconcthulhu r'lyehyuggothcthulhu r'lyehcthulhu r'lyehcthulhu r'lyehia! ia!ia! ia!cthulhu r'lyehyogsothothnecronomiconlllei!aallei!ablldei!aei!pdaakppkppdaei!aei!l", "problemId": 12}

+ 1
- 0
solutions/12.24762.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003154.strategy2b View File

@ -0,0 +1 @@
{"seed": 24762, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!necronomiconia! ia!ia! ia!ia! ia!ia! ia!lei!alalei!lei!ldei!aei!k", "problemId": 12}

+ 1
- 0
solutions/12.24803.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001713.strategy2b View File

@ -0,0 +1 @@
{"seed": 24803, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconia! ia!adei!aei!akaei!pdaaei!pppdei!l", "problemId": 12}

+ 1
- 0
solutions/12.29992.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002773.strategy2b View File

@ -0,0 +1 @@
{"seed": 29992, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconei!ia! ia!ia! ia!ia! ia!ia! ia!ia! ia!ayogsothothei!ayuggothei!aei!pppdei!kei!", "problemId": 12}

+ 1
- 0
solutions/12.5864.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002373.strategy2b View File

@ -0,0 +1 @@
{"seed": 5864, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothyuggothia! ia!necronomiconei!aei!allei!dei!kei!l", "problemId": 12}

+ 1
- 0
solutions/18.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002731.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ia! ia!ia! ia!john bigboote r'lyehyogsothothnecronomiconei!john bigbooteyuggothjohn bigbootejohn bigbootenecronomiconia! ia!ia! ia!ia! ia!john bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootenecronomiconnecronomiconia! ia!ia! ia!aabbblbblei!ablia! ia!ia! ia!ia! ia!aei!l", "problemId": 18}

+ 1
- 0
solutions/19.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000941.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ia! ia!ia! ia!ia! ia!ei!ia! ia!ia! ia!ia! ia!ia! ia!ia! ia!ia! ia!ia! ia!aia! ia!ei!ei!pia! ia!aei!pia! ia!lppia! ia!ppia! ia!pabpppia! ia!ppabppppia! ia!ppppia! ia!pppabpppppia! ia!ppppabppppppaaei!ppppppaaei!pppppaabppppppabpppppppppppppppppppppppppppppppppppl", "problemId": 19}

+ 1
- 0
solutions/20.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002328.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothlyuggothklalia! ia!adei!l", "problemId": 20}

+ 1
- 0
solutions/21.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000339.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ei!aei!ei!abppabpppaalei!ppaalabpppaalbpppaabpppabppppppppppppppl", "problemId": 21}

+ 1
- 0
solutions/22.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000340.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ei!dbei!bei!pakpadpppdbddei!ppppkppkl", "problemId": 22}

+ 1
- 0
solutions/23.0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000771.strategy2b View File

@ -0,0 +1 @@
{"seed": 0, "tag": "strategy2b", "solution": "ia! ia!ppkbblei!kbblbdbkkbbbei!bbei!bbei!ppkl", "problemId": 23}

+ 1
- 0
solutions/24.18.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002521.strategy2b View File

@ -0,0 +1 @@
{"seed": 18, "tag": "strategy2b", "solution": "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ia! ia!ia! ia!ia! ia!ia! ia!aei!alllabbbakkkbdbbbbkkkpdpkkei!kkia! ia!akei!lbbknecronomiconyogsothothnecronomiconyuggothkei!kyuggothei!aei!d", "problemId": 24}

+ 101
- 32
src/Datatypes/Game.hs View File

@ -1,4 +1,4 @@
module Datatypes.Game (Game(..), Command(..), completed, new, cacheToScore, updateCache, powerPhrases, phraseConverter) where -- FIXME exports
module Datatypes.Game (Game(..), Command(..), isCompleted, new, notifyCommand, powerCounterToScore, powerPhrasesAsCommands, commandsToString) where -- FIXME exports
import Data.Hashable (hash) import Data.Hashable (hash)
import qualified Data.List as List import qualified Data.List as List
@ -12,16 +12,16 @@ import Datatypes.Unit (Unit)
import qualified Datatypes.Unit as Unit import qualified Datatypes.Unit as Unit
data Command = MoveW data Command = MoveW
| MoveSE
| MoveE | MoveE
| MoveSW | MoveSW
| MoveSE
| RotateClockwise | RotateClockwise
| RotateCounterclockwise | RotateCounterclockwise
deriving (Show,Eq,Ord) deriving (Show,Eq,Ord)
type UnitHash = Int type UnitHash = Int
type PhrasesCache = Map [Command] Int
type PowerCounter = Map String Int
data Game = Game { data Game = Game {
board :: Board, board :: Board,
@ -30,12 +30,12 @@ data Game = Game {
oldLines :: Int, oldLines :: Int,
score :: Int, score :: Int,
history :: [Command], history :: [Command],
phrasesCache :: PhrasesCache
powerCounter :: PowerCounter
} }
deriving Show deriving Show
completed :: Game -> Bool
completed game = null $ units game
isCompleted :: Game -> Bool
isCompleted game = null $ units game
new :: Board -> [Unit] -> Game new :: Board -> [Unit] -> Game
new b us = Game { new b us = Game {
@ -45,31 +45,100 @@ new b us = Game {
oldLines = 0, oldLines = 0,
score = 0, score = 0,
history = [], history = [],
phrasesCache = Map.empty
powerCounter = Map.empty
} where (c:cs) = map (flip Unit.centeredIn b) us } where (c:cs) = map (flip Unit.centeredIn b) us
phraseConverter :: [Command] -> String
phraseConverter s = if s == reverse [MoveE, MoveSW, MoveW]
then "ei!"
else if s == reverse [MoveSW, MoveSW, MoveW, MoveSE, MoveSW, MoveSW, MoveW]
then "ia! ia!"
else "PUPPA"
powerPhrases :: [[Command]]
powerPhrases = [
reverse [MoveE, MoveSW, MoveW],
reverse [MoveSW, MoveSW, MoveW, MoveSE, MoveSW, MoveSW, MoveW]
]
updateCache :: PhrasesCache -> [Command] -> PhrasesCache
updateCache cache history = innerUpdate cache history powerPhrases where
innerUpdate cache _ [] = cache
innerUpdate cache history (p:ps) = innerUpdate (updatedCache cache history p) history ps
updatedCache c h p | p `List.isPrefixOf` h = if Map.member p c
then Map.update (\a -> Just $ a + 1) p c
else Map.insert p 1 c
updatedCache c _ _ = c
cacheToScore :: PhrasesCache -> Int
cacheToScore items = sum $ map evalScore (Map.toAscList items) where
evalScore (phrase, count) = 2 * (length phrase) * count + if count > 0 then 300 else 0
powerPhrases :: Map String [Command]
powerPhrases = Map.fromList $ map (\x -> (x, stringToCommands x)) keys where
keys = ["ei!", "ia! ia!", "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.", " r'lyeh", "yogsothoth", "necronomicon", "yuggoth", "john bigboote"]
powerPhrasesAsCommands :: [[Command]]
powerPhrasesAsCommands = map snd $ Map.toList powerPhrases
reversedPowerPhrases :: [([Command], String)]
reversedPowerPhrases = swapTuples . Map.toList $ powerPhrases where
swapTuples = map (\(s, cs) -> (reverse cs, s))
notifyCommand :: Game -> Command -> Game
notifyCommand game command =
game { history = newHistory, powerCounter = newPowerCounter } where
newHistory = command:(history game)
newPowerCounter = updatePowerCounter (powerCounter game) newHistory
updatePowerCounter :: PowerCounter -> [Command] -> PowerCounter
updatePowerCounter counter history =
innerUpdate counter reversedPowerPhrases where
innerUpdate :: PowerCounter -> [([Command], String)] -> PowerCounter
innerUpdate c [] = c
innerUpdate c (p:ps) = innerUpdate (checkPrefix c p) ps
checkPrefix m (p, s) = if p `List.isPrefixOf` history
then incrementMember m s
else m
incrementMember m s = Map.insertWith (\_ old -> old + 1) s 1 m
powerCounterToScore :: PowerCounter -> Int
powerCounterToScore items = sum $ map evalScore (Map.toAscList items) where
evalScore (phrase, count) = 2 * (length phrase) * count + (if count > 0 then 300 else 0)
stringToCommands :: String -> [Command]
stringToCommands str = reverse (convert str []) where
convert [] acc = acc
convert ('p':cs) acc = convert cs (MoveW:acc)
convert ('\'':cs) acc = convert cs (MoveW:acc)
convert ('!':cs) acc = convert cs (MoveW:acc)
convert ('.':cs) acc = convert cs (MoveW:acc)
convert ('0':cs) acc = convert cs (MoveW:acc)
convert ('3':cs) acc = convert cs (MoveW:acc)
convert ('b':cs) acc = convert cs (MoveE:acc)
convert ('c':cs) acc = convert cs (MoveE:acc)
convert ('e':cs) acc = convert cs (MoveE:acc)
convert ('f':cs) acc = convert cs (MoveE:acc)
convert ('y':cs) acc = convert cs (MoveE:acc)
convert ('2':cs) acc = convert cs (MoveE:acc)
convert ('a':cs) acc = convert cs (MoveSW:acc)
convert ('g':cs) acc = convert cs (MoveSW:acc)
convert ('h':cs) acc = convert cs (MoveSW:acc)
convert ('i':cs) acc = convert cs (MoveSW:acc)
convert ('j':cs) acc = convert cs (MoveSW:acc)
convert ('4':cs) acc = convert cs (MoveSW:acc)
convert ('l':cs) acc = convert cs (MoveSE:acc)
convert ('m':cs) acc = convert cs (MoveSE:acc)
convert ('n':cs) acc = convert cs (MoveSE:acc)
convert ('o':cs) acc = convert cs (MoveSE:acc)
convert (' ':cs) acc = convert cs (MoveSE:acc)
convert ('5':cs) acc = convert cs (MoveSE:acc)
convert ('d':cs) acc = convert cs (RotateClockwise:acc)
convert ('q':cs) acc = convert cs (RotateClockwise:acc)
convert ('r':cs) acc = convert cs (RotateClockwise:acc)
convert ('v':cs) acc = convert cs (RotateClockwise:acc)
convert ('z':cs) acc = convert cs (RotateClockwise:acc)
convert ('1':cs) acc = convert cs (RotateClockwise:acc)
convert ('k':cs) acc = convert cs (RotateCounterclockwise:acc)
convert ('s':cs) acc = convert cs (RotateCounterclockwise:acc)
convert ('t':cs) acc = convert cs (RotateCounterclockwise:acc)
convert ('u':cs) acc = convert cs (RotateCounterclockwise:acc)
convert ('w':cs) acc = convert cs (RotateCounterclockwise:acc)
convert ('x':cs) acc = convert cs (RotateCounterclockwise:acc)
convert ('\t':cs) acc = convert cs acc
convert ('\n':cs) acc = convert cs acc
convert ('\r':cs) acc = convert cs acc
commandsToString :: [Command] -> String
commandsToString [] = ""
commandsToString cmds@(c:cs) =
case smartConvert cmds (map (\(a, b) -> (b, a)) $ Map.toList powerPhrases) of
Just word -> word ++ (commandsToString (drop (length word) cmds))
Nothing -> dumbConvert c : commandsToString cs
where
dumbConvert MoveW = 'p'
dumbConvert MoveE = 'b'
dumbConvert MoveSW = 'a'
dumbConvert MoveSE = 'l'
dumbConvert RotateClockwise = 'd'
dumbConvert RotateCounterclockwise = 'k'
smartConvert _ [] = Nothing
smartConvert cmds (p:ps) =
let (encoded, word) = p
in if encoded `List.isPrefixOf` cmds
then Just word
else smartConvert cmds ps

+ 2
- 2
src/Main0.hs View File

@ -12,7 +12,7 @@ import Datatypes
import Opt import Opt
import JSONDeser import JSONDeser
import Strategy0 import Strategy0
import VM (cmdToString)
import Datatypes.Game (commandsToString)
import Datatypes.Game (Command) import Datatypes.Game (Command)
data JSONSer = JSONSer { problemId :: Int, data JSONSer = JSONSer { problemId :: Int,
@ -39,7 +39,7 @@ main = do args <- getArgs
packAll :: Int -> [Int] -> [[Command]] -> [JSONSer] packAll :: Int -> [Int] -> [[Command]] -> [JSONSer]
packAll id seeds commandLists = zipWith (\x y -> JSONSer id x "lilik0" y) seeds commandStrings packAll id seeds commandLists = zipWith (\x y -> JSONSer id x "lilik0" y) seeds commandStrings
where where
commandStrings = map cmdToString commandLists
commandStrings = map commandsToString commandLists
scoredata :: Int -> [Int] -> [Int] -> String scoredata :: Int -> [Int] -> [Int] -> String
scoredata id seeds points = pretty scoredata id seeds points = pretty


+ 7
- 6
src/Strategy0.hs View File

@ -6,25 +6,26 @@ import Data.Maybe (isJust)
import Datatypes import Datatypes
import Datatypes.Game (Command(..)) import Datatypes.Game (Command(..))
import qualified Datatypes.Unit as Unit
import qualified Datatypes.Game as Game import qualified Datatypes.Game as Game
import VM import VM
commandsList :: [Command] commandsList :: [Command]
commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise] commandsList = [MoveSE, MoveSW, MoveW, MoveE, RotateClockwise, RotateCounterclockwise]
type Queue = PQ.MaxPQueue Int Game
type Queue = PQ.MaxPQueue (Int, Int, Int) Game
fullScore :: Game -> Int fullScore :: Game -> Int
fullScore game = Game.score game + (Game.cacheToScore $ Game.phrasesCache game)
fullScore game = Game.score game + (Game.powerCounterToScore $ Game.powerCounter game)
strat0 :: Game -> ([Command],Int) strat0 :: Game -> ([Command],Int)
strat0 game = let firstQueue = PQ.singleton (fullScore game) game
strat0 game = let firstQueue = PQ.singleton (fullScore game, -(length $ Game.units game), snd . Unit.pivot . head . Game.units $ game) game
(incomplete, completed) = findBest maxIter firstQueue [] (incomplete, completed) = findBest maxIter firstQueue []
(_, bestIncomplete) = PQ.findMax incomplete (_, bestIncomplete) = PQ.findMax incomplete
resultGame = findListMax (bestIncomplete:completed) resultGame = findListMax (bestIncomplete:completed)
in (reverse (Game.history resultGame), fullScore resultGame) in (reverse (Game.history resultGame), fullScore resultGame)
where where
maxIter = 50000
maxIter = 300000
findListMax :: [Game] -> Game findListMax :: [Game] -> Game
findListMax (x:xs) = innerFindListMax x xs where findListMax (x:xs) = innerFindListMax x xs where
@ -40,7 +41,7 @@ partition p items = innerPartition items [] [] where
tryPowerPhrases :: Game -> [(Game, Notes)] tryPowerPhrases :: Game -> [(Game, Notes)]
tryPowerPhrases game = validResults where tryPowerPhrases game = validResults where
allResults = map (innerExpand (game, OK)) Game.powerPhrases
allResults = map (innerExpand (game, OK)) Game.powerPhrasesAsCommands
validResults = map (\(Just x) -> x) $ filter (\x -> isJust x) allResults validResults = map (\(Just x) -> x) $ filter (\x -> isJust x) allResults
innerExpand (game, note) [] = Just (game, note) innerExpand (game, note) [] = Just (game, note)
innerExpand (game, note) [p] = let nn@(newGame, newNote) = step game p innerExpand (game, note) [p] = let nn@(newGame, newNote) = step game p
@ -69,5 +70,5 @@ findBest i queue completed =
Lock _ -> updateCollections rs (pushToQueue q g) l Lock _ -> updateCollections rs (pushToQueue q g) l
GameOver -> updateCollections rs q (pushToList l g) GameOver -> updateCollections rs q (pushToList l g)
_ -> updateCollections rs q l _ -> updateCollections rs q l
pushToQueue q x = PQ.insert (fullScore x) x q
pushToQueue q x = PQ.insert (fullScore x, -(length $ Game.units x), snd . Unit.pivot . head . Game.units $ x) x q
pushToList c x = x : c pushToList c x = x : c

+ 67
- 0
src/TestSolution.hs View File

@ -0,0 +1,67 @@
{-# LANGUAGE DeriveGeneric #-}
module Main where
import GHC.Generics
import Data.Aeson
import Data.Aeson.Types
import qualified Data.List as List
import System.Environment
import qualified Data.ByteString.Lazy.Char8 as BS
import System.IO
import Datatypes
import Opt
import JSONDeser
import Strategy0
import Datatypes.Game (commandsToString)
import Datatypes.Game (Command)
import PowerPhrases (charToCommand)
import qualified Datatypes.Game as Game
import Datatypes.Game (Game)
import VM (step, Notes(..))
data JSONSer = JSONSer { problemId :: Int,
seed :: Int,
tag :: String,
solution :: String
} deriving (Show, Generic)
instance FromJSON JSONSer
instance ToJSON JSONSer
testVM :: Game -> String -> ([Notes], Int, Game)
testVM game strCmds = buildResult game commands [] where
commands = [c | (Just c) <- (map charToCommand strCmds)]
buildResult game [] notes = (reverse notes, Game.score game + (Game.powerCounterToScore $ Game.powerCounter game), game)
buildResult game (c:cs) notes = let (newGame, note) = step game c
in if elem note [ErrorSamePosition, ErrorGameEnded]
then (reverse (note:notes), 0, newGame)
else buildResult newGame cs (note:notes)
main :: IO ()
main = do args <- getArgs
opt <- parseArgs args
file <- return ((optFile opt) !! 0)
seed <- return (optSeedNumber opt)
(Just commands) <- return (optPowerPhrase opt)
str <- BS.readFile file
(_, gmseed) <- return (readInput str)
let (Just (s, g)) = List.find (\(s, g) -> s == seed) gmseed
(notes, score, ng) <- return $ testVM g commands
putStrLn ("Commands: " ++ show (Game.commandsToString . reverse . Game.history $ ng))
putStrLn ("Notes: " ++ show notes)
putStrLn ("Score: " ++ show score)
packAll :: Int -> [Int] -> [[Command]] -> [JSONSer]
packAll id seeds commandLists = zipWith (\x y -> JSONSer id x "lilik0" y) seeds commandStrings
where
commandStrings = map commandsToString commandLists
scoredata :: Int -> [Int] -> [Int] -> String
scoredata id seeds points = pretty
where
pretty = foldl (\x (a,b,c) -> (show a) ++ " " ++ (show b) ++ " " ++ (show c) ++ "\n" ++ x) "" zipdata
zipdata = zip3 ids seeds points
ids = replicate (length seeds) id

+ 7
- 28
src/VM.hs View File

@ -20,23 +20,6 @@ data Notes = OK
| ErrorGameEnded | ErrorGameEnded
deriving (Show,Eq) deriving (Show,Eq)
cmdToString :: [Command] -> String
cmdToString [] = ""
cmdToString cmds@(s:ss) = case smartConvert cmds of
Just word -> word ++ cmdToString (drop (length word) cmds)
Nothing -> dumbConvert s : cmdToString ss
dumbConvert MoveW = 'p'
dumbConvert MoveE = 'b'
dumbConvert MoveSW = 'a'
dumbConvert MoveSE = 'l'
dumbConvert RotateClockwise = 'd'
dumbConvert RotateCounterclockwise = 'k'
smartConvert cmds = innerSmartConvert cmds Game.powerPhrases where
innerSmartConvert _ [] = Nothing
innerSmartConvert cmds (p:ps) = if (reverse p) `List.isPrefixOf` cmds
then Just $ Game.phraseConverter p
else innerSmartConvert cmds ps
moveScore :: Int -> Int -> Int -> Int moveScore :: Int -> Int -> Int -> Int
moveScore size lines linesOld = points + lineBonus where moveScore size lines linesOld = points + lineBonus where
points = size + 100 * ((1 + lines) * lines) `div` 2 points = size + 100 * ((1 + lines) * lines) `div` 2
@ -44,22 +27,18 @@ moveScore size lines linesOld = points + lineBonus where
then floor (fromIntegral ((linesOld - 1) * points) / 100) then floor (fromIntegral ((linesOld - 1) * points) / 100)
else 0 else 0
checkSpawn :: Game -> Game
checkSpawn game@(Game { units = [] }) = game
checkSpawn game@(Game { units = (u:us), board = b }) =
if u `Unit.collidesWith` b
then game { Game.units = [] }
else game
lockUnit :: Game -> Game lockUnit :: Game -> Game
lockUnit game = game { lockUnit game = game {
board = newBoard, board = newBoard,
units = otherUnits,
units = newUnits otherUnits,
visitedUnits = initialVisitedUnits otherUnits, visitedUnits = initialVisitedUnits otherUnits,
oldLines = clearedLines, oldLines = clearedLines,
score = Game.score game + newScore score = Game.score game + newScore
} where } where
(currentUnit:otherUnits) = Game.units game (currentUnit:otherUnits) = Game.units game
newUnits [] = []
newUnits (u:us) | u `Unit.collidesWith` newBoard = []
newUnits us = us
mergedBoard = currentUnit `Unit.mergeWith` (Game.board game) mergedBoard = currentUnit `Unit.mergeWith` (Game.board game)
(newBoard, clearedLines) = Board.clearLines mergedBoard (newBoard, clearedLines) = Board.clearLines mergedBoard
size = Set.size $ Unit.members currentUnit size = Set.size $ Unit.members currentUnit
@ -75,17 +54,17 @@ step game command =
board = Game.board game board = Game.board game
shouldLock = newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board shouldLock = newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board
newVisitedUnits = Set.insert (hash newUnit) (Game.visitedUnits game) newVisitedUnits = Set.insert (hash newUnit) (Game.visitedUnits game)
updatedGame = (checkSpawn $ lockUnit game) { history = command:(Game.history game), phrasesCache = Game.updateCache (Game.phrasesCache game) (command:(Game.history game)) }
updatedGame = Game.notifyCommand (lockUnit game) command
in in
if shouldLock if shouldLock
then then
if Game.completed updatedGame
if Game.isCompleted updatedGame
then (updatedGame, GameOver) then (updatedGame, GameOver)
else (updatedGame, Lock (Game.oldLines updatedGame)) else (updatedGame, Lock (Game.oldLines updatedGame))
else else
if Set.member (hash newUnit) (Game.visitedUnits game) if Set.member (hash newUnit) (Game.visitedUnits game)
then (game { units = newUnit:otherUnits }, ErrorSamePosition) then (game { units = newUnit:otherUnits }, ErrorSamePosition)
else (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits, history = command:(Game.history game), phrasesCache = Game.updateCache (Game.phrasesCache game) (command:(Game.history game))}, OK)
else (Game.notifyCommand (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits }) command, OK)
applyCommand :: Unit -> Command -> Unit applyCommand :: Unit -> Command -> Unit
applyCommand unit MoveW = Unit.map move unit where applyCommand unit MoveW = Unit.map move unit where


+ 1
- 0
submitted/0.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2b","solution":"ia! ia!ia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ia! ia!necronomiconyuggothei!ia! ia!klkkkllkbei!lei!","problemId":0}]

+ 1
- 0
submitted/10.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2b","solution":"dei!kdei!bei!pdaei!ppdlakbbei!ppdlakei!ppdladpppddppppkppkl","problemId":10}]

+ 1
- 1
submitted/11.json View File

@ -1 +1 @@
[{"seed":0,"tag":"strategy2","solution":"kkkkkkkkkbdpdadlkkkklkkklkbkkaddbkakpkkkkkpddddpddddpkkkkkpkkkkpkkaddddbkkkkkbkkkkkbkkkkbkkkkkbkbkkkkkbddbkbddplkkbddakkpddpkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkklddddbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbdddakkbdbkei!dei!pdpkpdpkpdpkppdei!l","problemId":11},{"seed":12877,"tag":"strategy2","solution":"kkkkkkkbbpdakkkbddbkkaddbkakkbkkkkaddbkbddpakkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkaddddbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkakkkkkbdddakkbdbkei!dei!pdpkpdpkpdpkppdei!l","problemId":11},{"seed":16526,"tag":"strategy2","solution":"kkkkkkkkkbkkkadddbkkkaddbkakkkkkbkaddbkbddpakkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkaddddbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkakkkkkbdddakkbdbkei!dei!pdpkpdpkpdpkppdei!l","problemId":11},{"seed":19558,"tag":"strategy2","solution":"kkkkbbbkpdpkkpkpdddbkakkpddakkkkbkkkkkbkkkkkakkkkkbkkkkkbkkbkkkkkbkbkkkkkbddbkbddpakkbddakkbddakkpddpkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkklddddbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbdddakkbdbkei!dei!pdpkpdpkpdpkppdei!l","problemId":11},{"seed":20528,"tag":"strategy2","solution":"kkkkkkkkkbkkkadddbkkkaddbkakkkkkbkaddbkbddpakkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkkkpkkkaddddbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkkkkkbkakkkkkbdddakkbdbkei!dei!pdpkpdpkpdpkppdei!l","problemId":11}]
[{"seed":0,"tag":"strategy2b","solution":"ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothia! ia!ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.yuggothei!necronomiconbdpppdei!pkbbei!dei!","problemId":11},{"seed":12877,"tag":"strategy2b","solution":"cthulhu r'lyehyogsothothia! ia!ia! ia!necronomiconei!ldappdpkppdei!l","problemId":11},{"seed":16526,"tag":"strategy2b","solution":"ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconia! ia!necronomiconyogsothothyuggothei!necronomiconcthulhu r'lyehnecronomiconia! ia!ia! ia!pcthulhu r'lyehei!pei!aei!adei!kpddppaei!ddbbei!kaei!l","problemId":11},{"seed":19558,"tag":"strategy2b","solution":"cthulhu r'lyehia! ia!ia! ia!necronomiconei!aei!llei!ei!aei!aadaaddei!ayuggoth","problemId":11},{"seed":20528,"tag":"strategy2b","solution":"ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconia! ia!necronomiconei!ia! ia!necronomiconei!dei!paei!l","problemId":11}]

+ 1
- 1
submitted/12.json
File diff suppressed because it is too large
View File


+ 1
- 0
submitted/18.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2b","solution":"ia! ia!ia! ia!john bigboote r'lyehyogsothothnecronomiconei!john bigbooteyuggothjohn bigbootejohn bigbootenecronomiconia! ia!ia! ia!ia! ia!john bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootejohn bigbootenecronomiconnecronomiconia! ia!ia! ia!aabbblbblei!ablia! ia!ia! ia!ia! ia!aei!l","problemId":18}]

+ 1
- 0
submitted/19.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2","solution":"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbpppppppppppppppppppppppppppppppppppbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbpppppppppppppppppppppppppppppppppppbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbpppppppppppppppppppppppppppppppppppbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbpppppppppppppppppppppppppppppppppppbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbpppppppppppppppppppppppppppppppppppbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbpppppppppppppppppppppppppppppppppppbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbppppppppppppppppppppabbbbbbbbbbbbei!ppppppppppppplbbbbbbbbbbbbbei!ppppppppppppplbbbbbbbbbbbbbei!ppppppppppppplbbbbei!lbbia! ia!l","problemId":19}]

+ 1
- 1
submitted/20.json View File

@ -1 +1 @@
[{"seed":0,"tag":"strategy2","solution":"kpaalpaakpaalpaakppaalpaakkdddbkkbdddbkkkkkakkkkkbddddbkbdddbkkkbddbkkaddbkbdbkadbkadpkpdpkpddpkkpddpkkpddddbkakkkbddbkkbddakbdakbbbbei!pppdpkpdpkpddei!kkbdbkbdbkbbbbei!pppdpkpdpkpdpkpdpkpdppppplbbbbbbbbbbbei!l","problemId":20}]
[{"seed":0,"tag":"strategy2b","solution":"ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.necronomiconyogsothothlyuggothklalia! ia!adei!l","problemId":20}]

+ 1
- 0
submitted/21.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2b","solution":"ei!aei!ei!abppabpppaalei!ppaalabpppaalbpppaabpppabppppppppppppppl","problemId":21}]

+ 1
- 0
submitted/22.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2b","solution":"ei!dbei!bei!pakpadpppdbddei!ppppkppkl","problemId":22}]

+ 1
- 0
submitted/23.json View File

@ -0,0 +1 @@
[{"seed":0,"tag":"strategy2b","solution":"ia! ia!ppkbblei!kbblbdbkkbbbei!bbei!bbei!ppkl","problemId":23}]

+ 1
- 0
submitted/24.json View File

@ -0,0 +1 @@
[{"seed":18,"tag":"strategy2b","solution":"ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.ia! ia!ia! ia!ia! ia!ia! ia!aei!alllabbbakkkbdbbbbkkkpdpkkei!kkia! ia!akei!lbbknecronomiconyogsothothnecronomiconyuggothkei!kyuggothei!aei!d","problemId":24}]

Loading…
Cancel
Save