{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Moo.GeneticAlgorithm.Continuous
(
module Moo.GeneticAlgorithm.Types
, getRandomGenomes
, uniformGenomes
, rouletteSelect
, stochasticUniversalSampling
, tournamentSelect
, withPopulationTransform
, withScale
, rankScale
, withFitnessSharing
, distance1, distance2, distanceInf
, bestFirst
, blendCrossover
, unimodalCrossover
, unimodalCrossoverRP
, simulatedBinaryCrossover
, module Moo.GeneticAlgorithm.Crossover
, gaussianMutate
, module Moo.GeneticAlgorithm.Random
, module Moo.GeneticAlgorithm.Run
) where
import Control.Monad (liftM, replicateM)
import Data.List (genericLength, foldl')
import Moo.GeneticAlgorithm.Crossover
import Moo.GeneticAlgorithm.LinAlg
import Moo.GeneticAlgorithm.Random
import Moo.GeneticAlgorithm.Selection
import Moo.GeneticAlgorithm.Types
import Moo.GeneticAlgorithm.Run
import Moo.GeneticAlgorithm.Utilities (getRandomGenomes)
uniformGenomes :: Int -> [(Double,Double)] -> [Genome Double]
uniformGenomes :: Int -> [(Double, Double)] -> [Genome Double]
uniformGenomes Int
popsize [(Double, Double)]
ranges =
let dims :: Genome Double
dims = ((Double, Double) -> Double) -> [(Double, Double)] -> Genome Double
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Double -> Double) -> (Double, Double) -> Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract) [(Double, Double)]
ranges :: [Double]
ndims :: Int
ndims = Genome Double -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Genome Double
dims :: Int
vol :: Double
vol = Genome Double -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product Genome Double
dims
mdim :: Double
mdim = Double
vol Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ndims) :: Double
msamples :: Double
msamples = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
popsize) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ndims) :: Double
ptsPerDim :: [Int]
ptsPerDim = (Double -> Int) -> Genome Double -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
d -> Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
msamplesDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
mdim) Genome Double
dims :: [Int]
ptsInLastDims :: Int
ptsInLastDims = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
ptsPerDim :: Int
ptsInFirstDim :: Int
ptsInFirstDim = Int
popsize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
ptsInLastDims :: Int
ptsPerDim' :: [Int]
ptsPerDim' = Int
ptsInFirstDim Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
ptsPerDim) :: [Int]
linspaces :: [Genome Double]
linspaces = ((Double, Double) -> Int -> Genome Double)
-> [(Double, Double)] -> [Int] -> [Genome Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Double, Double) -> Int -> Genome Double
linspace [(Double, Double)]
ranges [Int]
ptsPerDim' :: [[Double]]
in [Genome Double] -> [Genome Double] -> [Genome Double]
sproduct [[]] [Genome Double]
linspaces
where
linspace :: (Double, Double) -> Int -> [Double]
linspace :: (Double, Double) -> Int -> Genome Double
linspace (Double
lo, Double
hi) Int
n = (Int -> Double) -> [Int] -> Genome Double
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
hiDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
lo)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
sproduct :: [[Double]] -> [[Double]] -> [[Double]]
sproduct :: [Genome Double] -> [Genome Double] -> [Genome Double]
sproduct [Genome Double]
gs [] = [Genome Double]
gs
sproduct [Genome Double]
gs (Genome Double
l:[Genome Double]
ls) =
let gs' :: [Genome Double]
gs' = [Double
xDouble -> Genome Double -> Genome Double
forall a. a -> [a] -> [a]
:Genome Double
g | Genome Double
g<-[Genome Double]
gs, Double
x<-Genome Double
l]
in [Genome Double] -> [Genome Double] -> [Genome Double]
sproduct [Genome Double]
gs' [Genome Double]
ls
distance1 :: (Num a) => [a] -> [a] -> a
distance1 :: [a] -> [a] -> a
distance1 [a]
xs [a]
ys = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. Num a => a -> a
abs ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [a]
xs [a]
ys
distance2 :: (Floating a) => [a] -> [a] -> a
distance2 :: [a] -> [a] -> a
distance2 [a]
xs [a]
ys = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> ([a] -> a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)) ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [a]
xs [a]
ys
distanceInf :: (Real a) => [a] -> [a] -> a
distanceInf :: [a] -> [a] -> a
distanceInf [a]
xs [a]
ys = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. Num a => a -> a
abs ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [a]
xs [a]
ys
blendCrossover :: Double
-> CrossoverOp Double
blendCrossover :: Double -> CrossoverOp Double
blendCrossover Double
_ [] = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
blendCrossover Double
_ [Genome Double
celibate] = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[Genome Double
celibate])
blendCrossover Double
alpha (Genome Double
xs:Genome Double
ys:[Genome Double]
rest) = do
(Genome Double
xs',Genome Double
ys') <- [(Double, Double)] -> (Genome Double, Genome Double)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Double, Double)] -> (Genome Double, Genome Double))
-> RandT PureMT Identity [(Double, Double)]
-> RandT PureMT Identity (Genome Double, Genome Double)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ((Double, Double) -> RandT PureMT Identity (Double, Double))
-> [(Double, Double)] -> RandT PureMT Identity [(Double, Double)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Double
-> (Double, Double) -> RandT PureMT Identity (Double, Double)
forall b.
(Random b, Num b, Ord b) =>
b -> (b, b) -> RandT PureMT Identity (b, b)
blx Double
alpha) (Genome Double -> Genome Double -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip Genome Double
xs Genome Double
ys)
([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome Double
xs',Genome Double
ys'], [Genome Double]
rest)
where
blx :: b -> (b, b) -> RandT PureMT Identity (b, b)
blx b
a (b
x,b
y) =
let l :: b
l = b -> b -> b
forall a. Ord a => a -> a -> a
min b
x b
y b -> b -> b
forall a. Num a => a -> a -> a
- b
ab -> b -> b
forall a. Num a => a -> a -> a
*b
d
u :: b
u = b -> b -> b
forall a. Ord a => a -> a -> a
max b
x b
y b -> b -> b
forall a. Num a => a -> a -> a
+ b
ab -> b -> b
forall a. Num a => a -> a -> a
*b
d
d :: b
d = b -> b
forall a. Num a => a -> a
abs (b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
y)
in do
b
x' <- (b, b) -> Rand b
forall a. Random a => (a, a) -> Rand a
getRandomR (b
l, b
u)
b
y' <- (b, b) -> Rand b
forall a. Random a => (a, a) -> Rand a
getRandomR (b
l, b
u)
(b, b) -> RandT PureMT Identity (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
x', b
y')
unimodalCrossover :: Double
-> Double
-> CrossoverOp Double
unimodalCrossover :: Double -> Double -> CrossoverOp Double
unimodalCrossover Double
sigma_xi Double
sigma_eta (Genome Double
x1:Genome Double
x2:Genome Double
x3:[Genome Double]
rest) = do
let d :: Genome Double
d = Genome Double
x2 Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`minus` Genome Double
x1
let x_mean :: Genome Double
x_mean = Double
0.5 Double -> Genome Double -> Genome Double
forall a. Num a => a -> [a] -> [a]
`scale` (Genome Double
x1 Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`plus` Genome Double
x2)
let dist3 :: Double
dist3 =
let v31 :: Genome Double
v31 = Genome Double
x3 Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`minus` Genome Double
x1
v21 :: Genome Double
v21 = Genome Double
x2 Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`minus` Genome Double
x1
base :: Double
base = Genome Double -> Double
forall a. (Num a, Floating a) => [a] -> a
norm2 Genome Double
v21
area :: Double
area = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Genome Double -> Genome Double -> Double
forall a. Num a => [a] -> [a] -> a
dot Genome Double
v31 Genome Double
v31)Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Genome Double -> Genome Double -> Double
forall a. Num a => [a] -> [a] -> a
dot Genome Double
v21 Genome Double
v21) Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Genome Double -> Genome Double -> Double
forall a. Num a => [a] -> [a] -> a
dot Genome Double
v21 Genome Double
v31)Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)
h :: Double
h = Double
area Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
base
in if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
h
then Genome Double -> Double
forall a. (Num a, Floating a) => [a] -> a
norm2 Genome Double
v31
else Double
h
let n :: Int
n = Genome Double -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Genome Double
x1
(Genome Double
parCorr, [Genome Double]
orthCorrs) <-
if Genome Double -> Double
forall a. (Num a, Floating a) => [a] -> a
norm2 Genome Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e-6
then do
let exs :: [Genome Double]
exs = Int -> [Genome Double] -> [Genome Double]
forall a. Int -> [a] -> [a]
drop Int
1 ([Genome Double] -> [Genome Double])
-> (Genome Double -> [Genome Double])
-> Genome Double
-> [Genome Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Genome Double -> [Genome Double]
mkBasis (Genome Double -> [Genome Double])
-> Genome Double -> [Genome Double]
forall a b. (a -> b) -> a -> b
$ Genome Double
d
Int -> RandT PureMT Identity (Genome Double)
getNormals Int
n RandT PureMT Identity (Genome Double)
-> (Genome Double
-> RandT PureMT Identity (Genome Double, [Genome Double]))
-> RandT PureMT Identity (Genome Double, [Genome Double])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Double
xi:Genome Double
etas) -> let
xi' :: Double
xi' = Double
sigma_xi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xi
parCorr :: Genome Double
parCorr = Double
xi' Double -> Genome Double -> Genome Double
forall a. Num a => a -> [a] -> [a]
`scale` Genome Double
d
etas' :: Genome Double
etas' = (Double -> Double) -> Genome Double -> Genome Double
forall a b. (a -> b) -> [a] -> [b]
map (Double
dist3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sigma_eta Double -> Double -> Double
forall a. Num a => a -> a -> a
*) Genome Double
etas
orthCorrs :: [Genome Double]
orthCorrs = (Double -> Genome Double -> Genome Double)
-> Genome Double -> [Genome Double] -> [Genome Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Genome Double -> Genome Double
forall a. Num a => a -> [a] -> [a]
scale Genome Double
etas' [Genome Double]
exs
in (Genome Double, [Genome Double])
-> RandT PureMT Identity (Genome Double, [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Genome Double
parCorr, [Genome Double]
orthCorrs)
Genome Double
_ -> [Char] -> RandT PureMT Identity (Genome Double, [Genome Double])
forall a. HasCallStack => [Char] -> a
error [Char]
"Parameters too short"
else do
let exs :: [Genome Double]
exs = (Int -> Genome Double) -> [Int] -> [Genome Double]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Genome Double
forall a. Fractional a => Int -> Int -> [a]
basisVector Int
n) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
Genome Double
etas <- Int -> RandT PureMT Identity (Genome Double)
getNormals Int
n
let etas' :: Genome Double
etas' = (Double -> Double) -> Genome Double -> Genome Double
forall a b. (a -> b) -> [a] -> [b]
map (Double
dist3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sigma_eta Double -> Double -> Double
forall a. Num a => a -> a -> a
*) Genome Double
etas
let orthCorrs :: [Genome Double]
orthCorrs = (Double -> Genome Double -> Genome Double)
-> Genome Double -> [Genome Double] -> [Genome Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Genome Double -> Genome Double
forall a. Num a => a -> [a] -> [a]
scale Genome Double
etas' [Genome Double]
exs
let zeroCorr :: Genome Double
zeroCorr = Int -> Double -> Genome Double
forall a. Int -> a -> [a]
replicate Int
n Double
0.0
(Genome Double, [Genome Double])
-> RandT PureMT Identity (Genome Double, [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Genome Double
zeroCorr, [Genome Double]
orthCorrs)
let totalCorr :: Genome Double
totalCorr = (Genome Double -> Genome Double -> Genome Double)
-> Genome Double -> [Genome Double] -> Genome Double
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
plus Genome Double
parCorr [Genome Double]
orthCorrs
let child1 :: Genome Double
child1 = Genome Double
x_mean Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`minus` Genome Double
totalCorr
let child2 :: Genome Double
child2 = Genome Double
x_mean Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`plus` Genome Double
totalCorr
([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome Double
child1, Genome Double
child2], Genome Double
x3Genome Double -> [Genome Double] -> [Genome Double]
forall a. a -> [a] -> [a]
:[Genome Double]
rest)
where
getNormals :: Int -> RandT PureMT Identity (Genome Double)
getNormals Int
n = do
[(Double, Double)]
ps <- Int
-> RandT PureMT Identity (Double, Double)
-> RandT PureMT Identity [(Double, Double)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) RandT PureMT Identity (Double, Double)
getNormal2
Genome Double -> RandT PureMT Identity (Genome Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Genome Double -> RandT PureMT Identity (Genome Double))
-> (Genome Double -> Genome Double)
-> Genome Double
-> RandT PureMT Identity (Genome Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Genome Double -> Genome Double
forall a. Int -> [a] -> [a]
take Int
n (Genome Double -> RandT PureMT Identity (Genome Double))
-> Genome Double -> RandT PureMT Identity (Genome Double)
forall a b. (a -> b) -> a -> b
$ ((Double, Double) -> Genome Double)
-> [(Double, Double)] -> Genome Double
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Double
x,Double
y) -> [Double
x,Double
y]) [(Double, Double)]
ps
basisVector :: Int -> Int -> [a]
basisVector Int
n Int
i = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
0.0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
1] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
i a
0.0
mkBasis :: [Double] -> [[Double]]
mkBasis :: Genome Double -> [Genome Double]
mkBasis Genome Double
dir0 =
let n :: Int
n = Genome Double -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Genome Double
dir0
dims :: [Int]
dims = [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
ixs :: [Genome Double]
ixs = (Int -> Genome Double) -> [Int] -> [Genome Double]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Genome Double
forall a. Fractional a => Int -> Int -> [a]
basisVector Int
n) [Int]
dims
in (Genome Double -> Genome Double)
-> [Genome Double] -> [Genome Double]
forall a b. (a -> b) -> [a] -> [b]
map Genome Double -> Genome Double
forall a. (Num a, Floating a, Fractional a) => [a] -> [a]
normalize ([Genome Double] -> [Genome Double])
-> ([Genome Double] -> [Genome Double])
-> [Genome Double]
-> [Genome Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Genome Double] -> [Genome Double]
forall a. [a] -> [a]
reverse ([Genome Double] -> [Genome Double])
-> [Genome Double] -> [Genome Double]
forall a b. (a -> b) -> a -> b
$ (Genome Double -> [Genome Double] -> [Genome Double])
-> [Genome Double] -> [Genome Double] -> [Genome Double]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Genome Double -> [Genome Double] -> [Genome Double]
forall a. (Ord a, Floating a) => [a] -> [[a]] -> [[a]]
build [Genome Double
dir0] [Genome Double]
ixs
where
build :: [a] -> [[a]] -> [[a]]
build [a]
ix [[a]]
exs =
let projs :: [[a]]
projs = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> [a] -> [a]
forall a. (Num a, Fractional a) => [a] -> [a] -> [a]
proj [a]
ix) [[a]]
exs
rem :: [a]
rem = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [a] -> [a] -> [a]
forall a. Num a => [a] -> [a] -> [a]
minus [a]
ix [[a]]
projs
in if [a] -> a
forall a. (Num a, Floating a) => [a] -> a
norm2 [a]
rem a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1e-6 a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. (Num a, Floating a) => [a] -> a
norm2 [[a]]
exs)
then [[a]]
exs
else [a]
rem [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
exs
unimodalCrossover Double
_ Double
_ [] = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
unimodalCrossover Double
_ Double
_ (Genome Double
x1:Genome Double
x2:[]) = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome Double
x1,Genome Double
x2], [])
unimodalCrossover Double
_ Double
_ [Genome Double
celibate] = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Genome Double
celibate])
unimodalCrossoverRP :: CrossoverOp Double
unimodalCrossoverRP :: CrossoverOp Double
unimodalCrossoverRP [] = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
unimodalCrossoverRP parents :: [Genome Double]
parents@(Genome Double
x1:[Genome Double]
_) =
let n :: Double
n = Genome Double -> Double
forall i a. Num i => [a] -> i
genericLength Genome Double
x1
sigma_xi :: Double
sigma_xi = Double
0.5
sigma_eta :: Double
sigma_eta = Double
0.35 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt Double
n
in Double -> Double -> CrossoverOp Double
unimodalCrossover Double
sigma_xi Double
sigma_eta [Genome Double]
parents
simulatedBinaryCrossover :: Double
-> CrossoverOp Double
simulatedBinaryCrossover :: Double -> CrossoverOp Double
simulatedBinaryCrossover Double
n (Genome Double
x1:Genome Double
x2:[Genome Double]
rest) = do
let cdf :: Double -> Double
cdf Double
beta | Double
beta Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Double
0.0
| Double
beta Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1.0 = Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
betaDouble -> Double -> Double
forall a. Floating a => a -> a -> a
**(Double
nDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1)
| Bool
otherwise = Double
1.0Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
0.5Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
betaDouble -> Double -> Double
forall a. Floating a => a -> a -> a
**(Double
nDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1)
Double
u <- Rand Double
getDouble
let solve :: Double -> Double -> Double
solve Double
eps Double
u = Double -> Double -> Double
solve' Double
0.0 (Double -> Double
upperB Double
2.0)
where
upperB :: Double -> Double
upperB Double
b | Double -> Double
cdf Double
b Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
u = Double -> Double
upperB (Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
2)
| Bool
otherwise = Double
b
solve' :: Double -> Double -> Double
solve' Double
b1 Double
b2 =
let b :: Double
b = Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
b1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b2)
r :: Double
r = Double -> Double
cdf Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
u
in if Double -> Double
forall a. Num a => a -> a
abs Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
eps
then Double
b
else
if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
then Double -> Double -> Double
solve' Double
b1 Double
b
else Double -> Double -> Double
solve' Double
b Double
b2
let beta :: Double
beta = Double -> Double -> Double
solve Double
1e-6 Double
u
let xmean :: Genome Double
xmean = Double
0.5 Double -> Genome Double -> Genome Double
forall a. Num a => a -> [a] -> [a]
`scale` (Genome Double
x1 Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`plus` Genome Double
x2)
let deltax :: Genome Double
deltax = (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
beta) Double -> Genome Double -> Genome Double
forall a. Num a => a -> [a] -> [a]
`scale` (Genome Double
x2 Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`minus` Genome Double
x1)
let c1 :: Genome Double
c1 = Genome Double
xmean Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`plus` Genome Double
deltax
let c2 :: Genome Double
c2 = Genome Double
xmean Genome Double -> Genome Double -> Genome Double
forall a. Num a => [a] -> [a] -> [a]
`minus` Genome Double
deltax
([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome Double
c1,Genome Double
c2], [Genome Double]
rest)
simulatedBinaryCrossover Double
_ [Genome Double]
celibates = ([Genome Double], [Genome Double])
-> RandT PureMT Identity ([Genome Double], [Genome Double])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Genome Double]
celibates)
gaussianMutate :: Double
-> Double
-> MutationOp Double
gaussianMutate :: Double
-> Double -> Genome Double -> RandT PureMT Identity (Genome Double)
gaussianMutate Double
p Double
sigma Genome Double
vars = (Double -> Rand Double)
-> Genome Double -> RandT PureMT Identity (Genome Double)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Double -> Rand Double
mutate Genome Double
vars
where
mutate :: Double -> Rand Double
mutate = Double -> (Double -> Rand Double) -> Double -> Rand Double
forall a. Double -> (a -> Rand a) -> a -> Rand a
withProbability Double
p ((Double -> Rand Double) -> Double -> Rand Double)
-> (Double -> Rand Double) -> Double -> Rand Double
forall a b. (a -> b) -> a -> b
$ \Double
v -> do
Double
n <- Rand Double
getNormal
Double -> Rand Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sigmaDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
n)