Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Loops in plan in fitness, too

  • Loading branch information...
commit 80a98859899d8b4e751ae911b2597300e43065c1 1 parent 6e3c3ea
Mihai Maruseac authored
Showing with 44 additions and 8 deletions.
  1. +9 −3 Maze/GUI.hs
  2. +35 −5 Maze/Plan.hs
View
12 Maze/GUI.hs
@@ -49,7 +49,8 @@ notFinished = (False, 0, 0)
-- simulation ended
end :: IORType -> FinishInfo
end r = (True, cGuy r,
- fitness (guyPos r) (guyTime r) (endPoint r) (endTime r) (guysBestDist r))
+ fitness (guyPos r) (guyTime r) (endPoint r) (endTime r) (guysBestDist r)
+ (guyBlocks r) ((plans r) V.! (cGuy r)))
{-
Type of the IORef used.
@@ -62,6 +63,7 @@ data IORType = IORCT
, guyPos :: Point
, guyTime :: Time
, guysBestDist :: Int
+ , guyBlocks :: Int
, plans :: V.Vector Plan
, gen :: Maybe StdGen
, model :: Maybe (ListStore ListStoreType)
@@ -70,7 +72,7 @@ data IORType = IORCT
, generation :: Int
, mRate :: Double
}
-empty = IORCT Nothing (0, 0) 0 0 (0, 0) 0 1000 V.empty Nothing Nothing Nothing (-100) 0 0.0
+empty = IORCT Nothing (0, 0) 0 0 (0, 0) 0 1000 0 V.empty Nothing Nothing Nothing (-100) 0 0.0
{-
Real evolution function. Will update IORType record.
@@ -84,6 +86,7 @@ evolveFunc r@(IORCT
, guyPos = pos
, guyTime = t
, guysBestDist = bd
+ , guyBlocks = bl
, plans = ps
})
-- normal case: in the middle of simulation
@@ -92,13 +95,16 @@ evolveFunc r@(IORCT
{ guyPos = p
, guyTime = t'
, guysBestDist = min bd $ manhattan p endp
+ , guyBlocks = if p == pos then bl + 1 else bl
} , notFinished)
-- simulation ended
| t == endt || pos == endp = (r
{ guyPos = (1, 1)
, guyTime = 0
, cGuy = guy + 1
- , guysBestDist = (snd endp) * (snd endp)}, end r)
+ , guysBestDist = (snd endp) * (snd endp)
+ , guyBlocks = 0
+ }, end r)
{-
Evolution.
View
40 Maze/Plan.hs
@@ -71,10 +71,40 @@ getRandomDir = do
return $ toEnum r
{-
+Fitness weights
+-}
+fTIME = 100
+fDIST = -3
+fBDIST = -10
+fBLOCKS = -1
+fLOOPS = -2
+
+{-
Computes the fitness of a plan.
-}
-fitness :: Point -> Time -> Point -> Time -> Int -> Fitness
-fitness p t ep et bd = 100 * (et - t) - 3 * manhattan p ep - 10 * bd
+fitness :: Point -> Time -> Point -> Time -> Int -> Int -> Plan -> Fitness
+fitness p t ep et bd bl pl
+ = fTIME * (et - t)
+ + fDIST * manhattan p ep
+ + fBLOCKS * bd
+ + fBLOCKS * bl
+ + fLOOPS * (loops . V.toList $ pl)
+
+{-
+Get the number of loops contained in a plan.
+-}
+loops :: [Cardinal] -> Int
+loops pl = getLoopsAux . map cartez $ pl
+ where
+ cartez E = (1, 0)
+ cartez W = (-1, 0)
+ cartez S = (0, 1)
+ cartez N = (0, -1)
+ getLoopsAux (c:cs) = getLoops c cs + getLoopsAux cs
+ getLoopsAux [] = 0
+ getLoops c (c':cs) = if c == (0, 0) then 1 else getLoops (c |+| c') cs
+ getLoops _ [] = 0
+ (x, y) |+| (x', y') = (x + x', y + y')
{-
Gets the manhattan distance between two points.
@@ -87,14 +117,14 @@ Returns a new population from an older one, via crossover and mutation.
-}
newPopulation :: V.Vector (Plan, Fitness) -> Double -> State StdGen (V.Vector Plan)
newPopulation p mRate = do
- let b1:b2:sp = sortBy (\(x, y) (x', y') -> y' `compare` y) $ V.toList p
+ let sp = sortBy (\(x, y) (x', y') -> y' `compare` y) $ V.toList p
let len = length sp
let slots = V.fromList $ getSlots 1 1 $ reverse sp
let numSlots = snd . V.last $ slots
ps <- replicateM len (selectFromPopulation numSlots slots)
nps <- mapM cross $ group2 ps
- newPlans <- mapM (mutate mRate) $ fst b2 : ungroup2 nps
- return $ V.fromList $ fst b1 : newPlans
+ newPlans <- mapM (mutate mRate) $ ungroup2 nps
+ trace (show $ fst $ sp !! 0) $return $ V.fromList $ newPlans
{-
Does the crossover between two chromosomes.
Please sign in to comment.
Something went wrong with that request. Please try again.