As a implementation of a genetic algorithm, I use simple-genetic-algorithm, that is, ahem, simple to use compared to some other packages. I've modified it, though, to use MonadRandom instead of having to thread through the RandomGen, so if you want to run the code make sure to take the version from my fork in the MonadRandom branch, until these changes are released by the maintainer on Hackage.
To use a genetic algorithm, we need two things: a representation of the structure we want to evolve that is suitable for the genetic transformations, and the implementation of these transformations (crossover and mutation) themselves.
For the first task, we convert the network to simple vectors:
-- | Convert a network for only vectors structures
toVectors :: (Floating (Vector a), Container Vector a, Floating a) =>
Network a -> [([Vector a],Vector a)]
toVectors = map (tovs . layerToShowable) . layers
where
tovs (ShowableLayer ws bs) = (toRows ws,bs)
-- | Convert back to a network given a network definition and vector structures
fromVectors :: (Floating (Vector a), Container Vector a, Floating a) =>
LayerDefinition a -> [([Vector a],Vector a)] -> Network a
fromVectors ld = Network . map ((\sl-> showableToLayer (sl,ld)) . frvs)
where
frvs (vs,v)=ShowableLayer (fromRows vs) v
Note that we need a LayerDefinition to rebuild the network from the Vectors. Currently each layer of the network has the same definition and the algorithm does NOT evolve this structure, only the weights and biases.
We're going to keep that information along with some Worlds that we use for fitness testing:
-- | Store the network information as vectors
data NetworkData = NetworkData [([Vector Float],Vector Float)] [World]
deriving (Show,Read,Eq,Ord)
Then we can implement the Chromosome class. Crossover takes the average of all weights and biases of the two parents, mutation changes one value randomly. Of course other implementations could be found.
-- | Chromosome instance
instance Chromosome NetworkData where
-- Take average
crossover (NetworkData xs ws) (NetworkData ys _) =
return [ NetworkData (Prelude.zipWith zipW xs ys) ws]
where
zipW (vs1,v1) (vs2,v2) = (Prelude.zipWith zipW1 vs1 vs2,zipW1 v1 v2)
zipW1 = V.zipWith (\x y -> (x + y) / 2)
-- Mutate one weight randomly
mutation (NetworkData xs ws) = do
xs' <- font="" r1="" randomchange="" xs="">
return $ NetworkData xs' ws
where
randomChange _ [] = return []
randomChange f xs2 = do
idx <- -="" 1="" font="" getrandomr="" length="" xs2="">
mapM (\(i,x)->if i==idx then f x else return x) $ zip [0..] xs2
r1 (vs,v) = do
(v3:vs2) <- font="" r2="" randomchange="" v:vs="">
return (vs2,v3)
r2 v2 = do
idx2 <- -="" 1="" font="" getrandomr="" v.length="" v2="">
dx <- 20="" font="" getrandomr="" nbsp="">
return $ v2 V.// [(idx2,dx)]
-- calculate fitness
fitness (NetworkData xs ws) = sum (map (fitWorld xs) ws) / fromIntegral (length ws)
For the fitness function we calculate the fitness for each given world and average it. I'm not trying to be too clever with that code.
For each world we run the food searching algorithm from each corners, and evaluate how far we are from the target, and if we reached it how long it took us. So networks that find the food will always rank higher than the ones who don't, and the quicker among them will rank higher again.
-- | Calculate fitness on a given world
fitWorld :: [([Vector Float],Vector Float)] -> World -> Double
fitWorld dat w = sum (map fitCorner $ corners $ wSize w) / 4
where
fitCorner pos =
let network = fromVectors layerDef dat
poss = algSteps w (neuralAlg w network) 50 pos
endSmell = currentSmell w $ last poss
possLength = length poss
in fitFormula w endSmell possLength (distance pos $ wFood w)
-- | Fitness formula
fitFormula :: World -> Int -> Int -> Int -> Double
fitFormula w endSmell possLenth dist = case fromIntegral endSmell / fromIntegral (wSmell w) of
1 -> 2 + (fromIntegral dist / fromIntegral possLenth)
n -> n
Then we just need a stop condition: either a maximum number of generations or reaching the maximum possible fitness (shortest path found from all corners)
-- | Maximum for the fitness
maxFit :: Double
maxFit = fitFormula (World undefined undefined 10 undefined) 10 10 10
-- | Stop function
stopf :: NetworkData -> Int -> IO Bool
stopf nd gen= return $ gen > 300 || fitness nd == maxFit
And code to generate random networks
-- | Build a random network data
buildNetworkData :: (Monad m,RandomGen g) => [World] -> RandT g m NetworkData
buildNetworkData ws= do
g <- font="" getsplit="">
let n = buildNetwork g
return $ NetworkData (toVectors n) ws
We can then evolve our population of networks, say on two worlds, w and w2:
runGAIO 64 0.1 (buildNetworkData [w,w2]) stopf
And we get after a couple of minutes a network that can find the food from another point that the tested corners:
Iteration:1
##########
#........#
#........#
#........#
#...X....#
#........#
#........#
#........#
#.......@#
#........#
#........#
##########
Iteration:2
##########
#........#
#........#
#........#
#...X....#
#........#
#........#
#......@.#
#........#
#........#
#........#
##########
Iteration:3
##########
#........#
#........#
#........#
#...X....#
#........#
#.....@..#
#........#
#........#
#........#
#........#
##########
Iteration:4
##########
#........#
#........#
#........#
#...X....#
#....@...#
#........#
#........#
#........#
#........#
#........#
##########
Iteration:5
##########
#........#
#........#
#........#
#...@....#
#........#
#........#
#........#
#........#
#........#
#........#
##########
Yummy!
Interested in all this? I recommend the ai-junkie tutorial, then! My code is of course on github. Feedback and suggestions welcome!
