module Main where

import Control.Monad.State
import System.Random

import GeneA.Genetic
import GeneA.Genetic.Operators
import GeneA.Population
import GeneA.Prob

size    = 100
sRate   = 0.25
mRate   = 0.01
pSize   = 100
target  = 100
  
main = do
  putStr "Getting random number generator..."
  st <- getStdGen
  putStrLn "Ok"
  putStrLn "Running GA with the following parameters:"
  putStr   "  Target:          "  >> print target
  putStr   "  Mutation Rate:   "  >> print mRate
  putStr   "  Selection Rate:  "  >> print sRate
  putStr   "  Population Size: "  >> print pSize
  putStrLn "Running Evolution Process..."
  let population = evolve pSize st in
    case length $ populace population of
      0       -> putStrLn "Population Died..."
      1000    -> do putStrLn "Population maxed out. Best solution found:"
                    putStr   "  "
                    print (optimal population :: Chromo)
      _       -> do putStrLn "Optimal Solution Found:"
                    putStr   "  "
                    print (optimal population :: Chromo)

data Chromo = Chromo { base :: [Bool] }

instance Show Chromo where 
  show = show . map (\b -> if b then 1 else 0) . base

instance Eq Chromo where
  (==) x y = (fitness x == fitness y)

instance Ord Chromo where
  compare x y = compare (fitness x) (fitness y)

instance Genetic Chromo where
  fitness     = (1/) . fromIntegral . (target -) . sum . map fromEnum . base
  crossover   = cross
  mutate      = mute
  mkGenetic   = fmap Chromo $ getRandoms size
  selection   = truncation sRate

cross :: (Chromo, Chromo) -> Prob (Chromo, Chromo, Chromo, Chromo)
cross (p1,p2) = do
  pnt <- getRandomR (0, size-1)
  let (s1,s1') = splitAt pnt (base p1)
      (s2,s2') = splitAt pnt (base p2) in
      return (Chromo (s1++s2'), Chromo (s2++s1'), p1, p2)

mute :: Chromo -> Prob Chromo
mute (Chromo xs) = do
  is <- (getRandomRs (0,1) size :: Prob [Float])
  return . Chromo $ toggleAll xs is
  where toggleAll xs is = zipWith toggle xs is
        toggle x i = if i <= mRate then not x else x 
