Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Style fixes

  • Loading branch information...
commit 93bec3e10b0d3357f3ecea846b919dbeda2baa9d 1 parent 2d74d4b
Mihai Maruseac authored
Showing with 34 additions and 53 deletions.
  1. +1 −2  Maze.hs
  2. +12 −16 Maze/GUI.hs
  3. +11 −14 Maze/Maze.hs
  4. +8 −19 Maze/Plan.hs
  5. +2 −2 Maze/Types.hs
View
3  Maze.hs
@@ -2,6 +2,5 @@ module Maze
(module Maze.GUI
) where
--- TODO: import only mazeGUI, hide others
-import Maze.GUI
+import Maze.GUI (mazeGUI)
View
28 Maze/GUI.hs
@@ -1,19 +1,17 @@
-module Maze.GUI
+module Maze.GUI (mazeGUI)
where
--- TODO export only mazeGUI, hide others
-
import qualified Array as A
import qualified Data.Vector as V
-import Control.Monad.State
-import Control.Monad.Trans (liftIO)
-import Data.IORef
+import Control.Monad.State (when, runState)
+import Data.IORef (IORef, readIORef, writeIORef, newIORef)
import Data.List ((\\))
import Data.Maybe (fromJust)
+import System.Random (randomR, StdGen, mkStdGen)
+
import Graphics.Rendering.Cairo
import Graphics.UI.Gtk hiding (Point)
-import System.Random
import Maze.Maze
import Maze.Types
@@ -101,7 +99,7 @@ evolveFunc r@(IORCT
{ guyPos = (1, 1)
, guyTime = 0
, cGuy = guy + 1
- , guysBestDist = (snd endp) * (snd endp)
+ , guysBestDist = snd endp * snd endp
, guyVis = []
}, end r)
@@ -120,10 +118,7 @@ evolve ref gl csl fl dw = do
case fI of
(True, i, f) -> do
listStoreSetValue m i (i + 1, f)
- if i == l - 1
- then do
- finishStep ref
- else return ()
+ when (i == l - 1) $ finishStep ref
_ -> return () -- ignore
-- 3. Invalidate drawing area and draw
(w, h) <- widgetGetSize dw
@@ -171,9 +166,10 @@ finishStep ref = do
{-
Main window loop.
-}
+mazeGUI :: IO ()
mazeGUI = do
-- 1. Get empty IORef
- ref <- newIORef $ empty
+ ref <- newIORef empty
-- 2. Init GTK
initGUI
window <- windowNew
@@ -227,7 +223,7 @@ buildToolbar b r dw gl csl fl = do
-- 3. Add widgets
let addF = addBtnToToolbar tb tp -- helper function
bNew <- addF stockNew "Starts a new population, with a new maze"
- bNew `onToolButtonClicked` (onNew r dw gl csl fl)
+ bNew `onToolButtonClicked` onNew r dw gl csl fl
bAbout <- addF stockAbout "About this program"
bAbout `onToolButtonClicked` onAbout
addSeparator tb
@@ -400,8 +396,8 @@ Draws wall for a single cell.
drawWalls :: Maze -> Int -> Double -> Double -> Point -> Render ()
drawWalls m s dx dy p@(x, y) = mapM_ (renderOneWall dx dy y' x') walls
where
- x' = dx * (fromIntegral x) + if x == 1 then 1 else if x == s then -1 else 0
- y' = dy * (fromIntegral y) + if y == 1 then 1 else if y == s then -1 else 0
+ x' = dx * fromIntegral x + if x == 1 then 1 else if x == s then -1 else 0
+ y' = dy * fromIntegral y + if y == 1 then 1 else if y == s then -1 else 0
frees = (\(C l) -> l) $ m A.! p
l = if y == 1 then if x == 1 then [] else [N] else [W]
walls = ([N, E, S, W] \\ frees) \\ l
View
25 Maze/Maze.hs
@@ -1,13 +1,10 @@
-module Maze.Maze
+module Maze.Maze (genMaze)
where
--- TODO: export only genMaze, hide others
-
-import Array
-import Control.Arrow
-import Control.Monad.State
-import Data.Array.ST
-import System.Random
+import Control.Arrow (first, second)
+import Control.Monad.State (state, State)
+import Data.Array.ST (runSTArray, newListArray, readArray, writeArray)
+import System.Random (StdGen, randomR)
import Maze.Types
@@ -26,15 +23,15 @@ build :: Length -> Length -> [Point] -> [Point] -> Maze
build sx sy ews ups = runSTArray $ do
m <- newListArray ((1, 1), (sy, sx)) $ repeat $ C [E, W]
-- 1. Block eastern walls (including first row's end)
- mapM (blockCell m E) $ (sx, 1) : ews
+ mapM_ (blockCell m E) $ (sx, 1) : ews
-- 2. Block western walls of corridors
- mapM (blockCell m W) $ map (first (+1)) $ filter (fst . first (/= sx)) $ ews
+ mapM_ (blockCell m W . first (+1)) $ filter (fst . first (/= sx)) ews
-- 3. Block starts of rows.
- mapM (blockCell m W) $ map (\y -> (1, y)) [1 .. sy]
+ mapM_ (blockCell m W . (\y -> (1, y))) [1 .. sy]
-- 4. Open northwards.
- mapM (openCell m N) $ ups
+ mapM_ (openCell m N) ups
-- 5. Open southwards
- mapM (openCell m S) $ map (second (\x -> x - 1)) ups
+ mapM_ (openCell m S . second (subtract 1)) ups
return m
{-
@@ -65,7 +62,7 @@ gRP c sx y
{-
Block one cell from the maze, represented as an array.
-}
--- blockCell :: (MArray a Cell m) => a Size Cell -> Cardinal -> Size -> m ()
+-- blockCell :: Data.Array.MArray Size Cell -> Cardinal -> Size -> m ()
blockCell m d (x, y) = do
e <- readArray m (y, x)
writeArray m (y, x) $ block e d
View
27 Maze/Plan.hs
@@ -1,23 +1,18 @@
-module Maze.Plan
+module Maze.Plan (doStep, manhattan, fitness, newPopulation,
+ getRandomInitialPlans)
where
--- TODO: limit the exported symbols
-
-import Control.Arrow
-import Control.Monad.State
-import Data.Array.ST
+import Control.Arrow (first, second)
+import Control.Monad.State (state, State, replicateM)
import Data.List (sortBy)
-import System.Random
+import System.Random (randomR, StdGen, random)
import qualified Array as A
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
-import Maze.Maze
import Maze.Types
-import Debug.Trace
-
{- The environment when testing a chromosome. -}
type Env = (Maze, Plan)
@@ -35,7 +30,6 @@ doStep (m, p) (pos, t) = (takeAct (m A.! pos) (p V.! t) pos, t + 1)
Take one action.
-}
takeAct :: Cell -> Cardinal -> Point -> Point
---takeAct (C l) d p = if d `elem` l then move d p else p
takeAct c@(C l) d p = if d `elem` l then move d p else takeAct c (next d) p
where
next W = N
@@ -80,7 +74,6 @@ Fitness weights
fTIME = 100
fDIST = -3
fBDIST = -5
-fAREA = 0
fVIS = 50
fCOL = 20
@@ -92,12 +85,8 @@ fitness p t ep et bd vis
= fTIME * (et - t)
+ fDIST * manhattan p ep
+ fBDIST * bd
- + fAREA * mc * mr
+ fVIS * length vis
- + fCOL * mc
- where
- mr = maximum (map snd vis)
- mc = maximum (map fst vis)
+ + fCOL * maximum (map fst vis)
{-
Gets the manhattan distance between two points.
@@ -117,7 +106,7 @@ newPopulation p mRate = do
ps <- replicateM len (selectFromPopulation numSlots slots)
nps <- mapM cross $ group2 ps
newPlans <- mapM (mutate mRate) $ ungroup2 nps
- return $ V.fromList $ (map fst [s, s']) ++ newPlans
+ return $ V.fromList $ map fst [s, s'] ++ newPlans
{-
Does the crossover between two chromosomes.
@@ -160,7 +149,7 @@ selectFromPopulation m ps = do
Finds the actual chromosome via roulette.
-}
findRoulette :: Int -> V.Vector (Plan, Int) -> Plan
-findRoulette ix ps = fst . V.head $ V.dropWhile (\(x, y) -> ix > y) ps
+findRoulette ix = fst . V.head . V.dropWhile (\(x, y) -> ix > y)
{-
Gets the slots for each vector.
View
4 Maze/Types.hs
@@ -1,8 +1,8 @@
module Maze.Types
where
-import Array
-import Data.Vector
+import Array (Array)
+import Data.Vector (Vector)
{-
Common types are presented in this file.
Please sign in to comment.
Something went wrong with that request. Please try again.