Ledger Nano X - The secure hardware wallet
SHARE
TWEET

Monad levelgen-bench

a guest Jul 30th, 2013 83 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# LANGUAGE BangPatterns #-}
  2. module Main where
  3.  
  4. import Random.Xorshift
  5. import Control.Monad.State
  6.  
  7. import Text.Printf
  8. import Data.List.Split (chunksOf)
  9. import Data.Ord (comparing)
  10. import qualified Data.Vector as V
  11.  
  12. import Debug.Trace
  13.  
  14. type Pos = (Int, Int)
  15.  
  16. data Tile = Wall | Space
  17.           deriving (Show)
  18.  
  19. data Room = Room { rPos :: !Pos
  20.                  , rw, rh :: !Int
  21.                  } deriving(Show)
  22.              
  23. data Lev = Lev { lRooms :: !(V.Vector Room)
  24.                , lTiles :: [Tile]
  25.                  }
  26.  
  27. levDim, minWid, maxWid :: Int
  28. levDim = 50
  29. minWid = 2
  30. maxWid = 8
  31.  
  32. checkBound :: Room -> Bool
  33. checkBound Room { rPos = (x,y), rw = w, rh = h } =
  34.     x<=0 || y<=0 || x+w >= levDim || y+h >= levDim
  35.  
  36. checkColl :: Room -> V.Vector Room -> Bool
  37. checkColl room = V.any (roomHitRoom room)
  38.  
  39. roomHitRoom :: Room -> Room -> Bool
  40. roomHitRoom Room {rPos=(x,y), rw= w, rh= h} Room {rPos=( x2, y2), rw= w2, rh= h2}
  41.     = not ((x2+w2+1) < x || x2 > (x+w+1)
  42.         || (y2+h2+1) < y || y2 > (y+h+1))
  43.  
  44. inRoom :: Pos -> Room -> Bool
  45. inRoom (x, y) (Room (rx, ry) rw rh) =
  46.         (rx <= x) && (x < rx + rw)
  47.     &&  (ry <= y) && (y < ry + rh)
  48.  
  49. showTiles :: [Tile] -> String
  50. showTiles = unlines . chunksOf levDim . map toChar
  51.   where
  52.     toChar t = case t of
  53.         Wall  -> '0'
  54.         Space -> '1'
  55.  
  56. type MyRandomGen = State Xorshift
  57.  
  58. genRandom :: MyRandomGen Int
  59. genRandom = do
  60.   gen <- get
  61.   let (rv, gen') = next gen
  62.  put gen'
  63.   return rv
  64.  
  65. myRandList :: Xorshift -> ([Int], Xorshift)
  66. myRandList g =
  67.   let (i, g') = next g
  68.      (rest, g'') = myRandList g'
  69.   in ((i : rest), g'')
  70.  
  71. genRooms :: Int -> V.Vector Room -> MyRandomGen (V.Vector Room)
  72. genRooms 0 done = return done
  73. genRooms !n rsDone = do
  74.   [r1,r2] <- sequence $ replicate 2 genRandom
  75.   let x = r1 `rem` levDim
  76.       y = r2 `rem` levDim
  77.       w = r1 `rem` maxWid + minWid
  78.       h = r2 `rem` maxWid + minWid
  79.       tr = Room {rPos=(x,y), rw= w, rh= h}
  80.   if (checkBound tr) || (checkColl tr rsDone)
  81.     then genRooms (n-1) rsDone
  82.     else genRooms (n-1) (V.cons tr rsDone)
  83.      
  84.  
  85. genLevs' :: Int -> V.Vector Lev -> MyRandomGen (V.Vector Lev)
  86. genLevs' 0 done = return done
  87. genLevs' n ldone = do
  88.  rs <- genRooms 50000 V.empty
  89.  let tiles = map (toTile rs) [1 .. levDim ^ 2] in
  90.    genLevs' (n-1) ( V.cons Lev{lRooms = rs, lTiles = tiles} ldone)
  91.   where
  92.     toTile rs n = if (V.any (toPos n `inRoom`) rs) then Space else Wall
  93.     toPos n = let (y, x) = quotRem n levDim in (x, y)
  94.  
  95.  
  96. biggestLev :: V.Vector Lev -> Lev
  97. biggestLev = V.maximumBy (comparing (V.length . lRooms))
  98.    
  99. main :: IO ()
  100. main = do
  101.   gen <- newXorshift
  102.   let levs = evalState (genLevs' 100 V.empty) gen
  103.  putStr $ showTiles $ lTiles $ biggestLev levs
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top