module MCSP.Heuristics.PSOBased (
    mcspSwarm,
    pso,
    partitionWeights,
    edgeSizeWeights,

    -- * Meta Parameters
    PSOIterations (..),
    PSOParticles (..),
    PSOSeed (..),
    PSOFirstBestIter (..),
    PSOPure (..),
    PSOCombine (..),
    PSOUpdaterWeigths (..),
    PSOInitialDistribution (..),
) where

import Control.Applicative (pure)
import Control.Monad ((>>=))
import Data.Bool (Bool (..))
import Data.Eq (Eq (..))
import Data.Foldable qualified as Foldable (length)
import Data.Foldable1 (foldMap1')
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.List qualified as List (take)
import Data.List.Extra (sumOn')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Ord (Ord (..))
import Data.Semigroup (Last (..), Min (..))
import Data.Vector.Unboxed (Vector, length, map)
import GHC.Float (Double)
import GHC.Num (negate, (-))
import Text.Show (Show)

import MCSP.Algorithms.PSO (
    PSOGuide (..),
    Swarm (..),
    Updater,
    Weight,
    globalGuideDirection,
    localGuideDirection,
    particleSwarmOptimization,
    randomVelocity,
    sortedValues,
 )
import MCSP.Algorithms.Vector (
    argSort,
    choice,
    choose,
    sort,
    sortLike,
    sumM,
    uniformSN,
    weighted,
    weightedN,
 )
import MCSP.Data.MatchingGraph (
    Edge,
    blockLen,
    compatibleEdges,
    edgeSet,
    mergeness,
    solution,
    toPartitions,
 )
import MCSP.Data.Meta (
    Meta,
    MetaInputVariable (..),
    MetaOutputVariable (..),
    evalMeta,
    getOrDefine,
    getVar,
    setVar,
    (<::),
 )
import MCSP.Data.Pair (Pair)
import MCSP.Data.String (String (Unboxed))
import MCSP.Data.String.Extra (Partition)
import MCSP.Heuristics.Combine (UseSingletons (..), combine, combineP)
import MCSP.Heuristics.Greedy (greedy)
import MCSP.System.Random (Random, Seed, generateWith)

-- --------------- --
-- Meta Parameters --

-- | The number of iterations to run the PSO algorithm.
newtype PSOIterations = PSOIterations Int
    deriving newtype (PSOIterations -> PSOIterations -> Bool
(PSOIterations -> PSOIterations -> Bool)
-> (PSOIterations -> PSOIterations -> Bool) -> Eq PSOIterations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOIterations -> PSOIterations -> Bool
== :: PSOIterations -> PSOIterations -> Bool
$c/= :: PSOIterations -> PSOIterations -> Bool
/= :: PSOIterations -> PSOIterations -> Bool
Eq, Eq PSOIterations
Eq PSOIterations =>
(PSOIterations -> PSOIterations -> Ordering)
-> (PSOIterations -> PSOIterations -> Bool)
-> (PSOIterations -> PSOIterations -> Bool)
-> (PSOIterations -> PSOIterations -> Bool)
-> (PSOIterations -> PSOIterations -> Bool)
-> (PSOIterations -> PSOIterations -> PSOIterations)
-> (PSOIterations -> PSOIterations -> PSOIterations)
-> Ord PSOIterations
PSOIterations -> PSOIterations -> Bool
PSOIterations -> PSOIterations -> Ordering
PSOIterations -> PSOIterations -> PSOIterations
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOIterations -> PSOIterations -> Ordering
compare :: PSOIterations -> PSOIterations -> Ordering
$c< :: PSOIterations -> PSOIterations -> Bool
< :: PSOIterations -> PSOIterations -> Bool
$c<= :: PSOIterations -> PSOIterations -> Bool
<= :: PSOIterations -> PSOIterations -> Bool
$c> :: PSOIterations -> PSOIterations -> Bool
> :: PSOIterations -> PSOIterations -> Bool
$c>= :: PSOIterations -> PSOIterations -> Bool
>= :: PSOIterations -> PSOIterations -> Bool
$cmax :: PSOIterations -> PSOIterations -> PSOIterations
max :: PSOIterations -> PSOIterations -> PSOIterations
$cmin :: PSOIterations -> PSOIterations -> PSOIterations
min :: PSOIterations -> PSOIterations -> PSOIterations
Ord, Length -> PSOIterations -> ShowS
[PSOIterations] -> ShowS
PSOIterations -> String
(Length -> PSOIterations -> ShowS)
-> (PSOIterations -> String)
-> ([PSOIterations] -> ShowS)
-> Show PSOIterations
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOIterations -> ShowS
showsPrec :: Length -> PSOIterations -> ShowS
$cshow :: PSOIterations -> String
show :: PSOIterations -> String
$cshowList :: [PSOIterations] -> ShowS
showList :: [PSOIterations] -> ShowS
Show)

instance MetaInputVariable PSOIterations where
    getVar :: Meta PSOIterations
getVar = PSOIterations -> Meta PSOIterations
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (Length -> PSOIterations
PSOIterations Length
100)

-- | The number of particles used at each iteration of the PSO algorithm.
newtype PSOParticles = PSOParticles Int
    deriving newtype (PSOParticles -> PSOParticles -> Bool
(PSOParticles -> PSOParticles -> Bool)
-> (PSOParticles -> PSOParticles -> Bool) -> Eq PSOParticles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOParticles -> PSOParticles -> Bool
== :: PSOParticles -> PSOParticles -> Bool
$c/= :: PSOParticles -> PSOParticles -> Bool
/= :: PSOParticles -> PSOParticles -> Bool
Eq, Eq PSOParticles
Eq PSOParticles =>
(PSOParticles -> PSOParticles -> Ordering)
-> (PSOParticles -> PSOParticles -> Bool)
-> (PSOParticles -> PSOParticles -> Bool)
-> (PSOParticles -> PSOParticles -> Bool)
-> (PSOParticles -> PSOParticles -> Bool)
-> (PSOParticles -> PSOParticles -> PSOParticles)
-> (PSOParticles -> PSOParticles -> PSOParticles)
-> Ord PSOParticles
PSOParticles -> PSOParticles -> Bool
PSOParticles -> PSOParticles -> Ordering
PSOParticles -> PSOParticles -> PSOParticles
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOParticles -> PSOParticles -> Ordering
compare :: PSOParticles -> PSOParticles -> Ordering
$c< :: PSOParticles -> PSOParticles -> Bool
< :: PSOParticles -> PSOParticles -> Bool
$c<= :: PSOParticles -> PSOParticles -> Bool
<= :: PSOParticles -> PSOParticles -> Bool
$c> :: PSOParticles -> PSOParticles -> Bool
> :: PSOParticles -> PSOParticles -> Bool
$c>= :: PSOParticles -> PSOParticles -> Bool
>= :: PSOParticles -> PSOParticles -> Bool
$cmax :: PSOParticles -> PSOParticles -> PSOParticles
max :: PSOParticles -> PSOParticles -> PSOParticles
$cmin :: PSOParticles -> PSOParticles -> PSOParticles
min :: PSOParticles -> PSOParticles -> PSOParticles
Ord, Length -> PSOParticles -> ShowS
[PSOParticles] -> ShowS
PSOParticles -> String
(Length -> PSOParticles -> ShowS)
-> (PSOParticles -> String)
-> ([PSOParticles] -> ShowS)
-> Show PSOParticles
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOParticles -> ShowS
showsPrec :: Length -> PSOParticles -> ShowS
$cshow :: PSOParticles -> String
show :: PSOParticles -> String
$cshowList :: [PSOParticles] -> ShowS
showList :: [PSOParticles] -> ShowS
Show)

instance MetaInputVariable PSOParticles where
    getVar :: Meta PSOParticles
getVar = PSOParticles -> Meta PSOParticles
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (Length -> PSOParticles
PSOParticles Length
200)

-- | Initial seed used for randomized operation in the PSO algorithm.
newtype PSOSeed = PSOSeed Seed
    deriving newtype (PSOSeed -> PSOSeed -> Bool
(PSOSeed -> PSOSeed -> Bool)
-> (PSOSeed -> PSOSeed -> Bool) -> Eq PSOSeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOSeed -> PSOSeed -> Bool
== :: PSOSeed -> PSOSeed -> Bool
$c/= :: PSOSeed -> PSOSeed -> Bool
/= :: PSOSeed -> PSOSeed -> Bool
Eq, Eq PSOSeed
Eq PSOSeed =>
(PSOSeed -> PSOSeed -> Ordering)
-> (PSOSeed -> PSOSeed -> Bool)
-> (PSOSeed -> PSOSeed -> Bool)
-> (PSOSeed -> PSOSeed -> Bool)
-> (PSOSeed -> PSOSeed -> Bool)
-> (PSOSeed -> PSOSeed -> PSOSeed)
-> (PSOSeed -> PSOSeed -> PSOSeed)
-> Ord PSOSeed
PSOSeed -> PSOSeed -> Bool
PSOSeed -> PSOSeed -> Ordering
PSOSeed -> PSOSeed -> PSOSeed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOSeed -> PSOSeed -> Ordering
compare :: PSOSeed -> PSOSeed -> Ordering
$c< :: PSOSeed -> PSOSeed -> Bool
< :: PSOSeed -> PSOSeed -> Bool
$c<= :: PSOSeed -> PSOSeed -> Bool
<= :: PSOSeed -> PSOSeed -> Bool
$c> :: PSOSeed -> PSOSeed -> Bool
> :: PSOSeed -> PSOSeed -> Bool
$c>= :: PSOSeed -> PSOSeed -> Bool
>= :: PSOSeed -> PSOSeed -> Bool
$cmax :: PSOSeed -> PSOSeed -> PSOSeed
max :: PSOSeed -> PSOSeed -> PSOSeed
$cmin :: PSOSeed -> PSOSeed -> PSOSeed
min :: PSOSeed -> PSOSeed -> PSOSeed
Ord, Length -> PSOSeed -> ShowS
[PSOSeed] -> ShowS
PSOSeed -> String
(Length -> PSOSeed -> ShowS)
-> (PSOSeed -> String) -> ([PSOSeed] -> ShowS) -> Show PSOSeed
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOSeed -> ShowS
showsPrec :: Length -> PSOSeed -> ShowS
$cshow :: PSOSeed -> String
show :: PSOSeed -> String
$cshowList :: [PSOSeed] -> ShowS
showList :: [PSOSeed] -> ShowS
Show)

instance MetaInputVariable PSOSeed where
    getVar :: Meta PSOSeed
getVar = PSOSeed -> Meta PSOSeed
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (Seed -> PSOSeed
PSOSeed Seed
defaultSeed)
      where
        defaultSeed :: Seed
defaultSeed = (Word64
0x7f166a5f52178da7, Word64
0xe190ca41e26454c3)

-- | Output for the first iteration that reached the best solution in PSO.
newtype PSOFirstBestIter = PSOFirstBestIter
    { PSOFirstBestIter -> Length
getFirstBestIter :: Int
    }
    deriving newtype (PSOFirstBestIter -> PSOFirstBestIter -> Bool
(PSOFirstBestIter -> PSOFirstBestIter -> Bool)
-> (PSOFirstBestIter -> PSOFirstBestIter -> Bool)
-> Eq PSOFirstBestIter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
== :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
$c/= :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
/= :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
Eq, Eq PSOFirstBestIter
Eq PSOFirstBestIter =>
(PSOFirstBestIter -> PSOFirstBestIter -> Ordering)
-> (PSOFirstBestIter -> PSOFirstBestIter -> Bool)
-> (PSOFirstBestIter -> PSOFirstBestIter -> Bool)
-> (PSOFirstBestIter -> PSOFirstBestIter -> Bool)
-> (PSOFirstBestIter -> PSOFirstBestIter -> Bool)
-> (PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter)
-> (PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter)
-> Ord PSOFirstBestIter
PSOFirstBestIter -> PSOFirstBestIter -> Bool
PSOFirstBestIter -> PSOFirstBestIter -> Ordering
PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOFirstBestIter -> PSOFirstBestIter -> Ordering
compare :: PSOFirstBestIter -> PSOFirstBestIter -> Ordering
$c< :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
< :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
$c<= :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
<= :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
$c> :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
> :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
$c>= :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
>= :: PSOFirstBestIter -> PSOFirstBestIter -> Bool
$cmax :: PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter
max :: PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter
$cmin :: PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter
min :: PSOFirstBestIter -> PSOFirstBestIter -> PSOFirstBestIter
Ord, Length -> PSOFirstBestIter -> ShowS
[PSOFirstBestIter] -> ShowS
PSOFirstBestIter -> String
(Length -> PSOFirstBestIter -> ShowS)
-> (PSOFirstBestIter -> String)
-> ([PSOFirstBestIter] -> ShowS)
-> Show PSOFirstBestIter
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOFirstBestIter -> ShowS
showsPrec :: Length -> PSOFirstBestIter -> ShowS
$cshow :: PSOFirstBestIter -> String
show :: PSOFirstBestIter -> String
$cshowList :: [PSOFirstBestIter] -> ShowS
showList :: [PSOFirstBestIter] -> ShowS
Show)

instance MetaOutputVariable PSOFirstBestIter

-- | Run PSO only, without using other heuristics.
newtype PSOPure = PSOPure Bool
    deriving newtype (PSOPure -> PSOPure -> Bool
(PSOPure -> PSOPure -> Bool)
-> (PSOPure -> PSOPure -> Bool) -> Eq PSOPure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOPure -> PSOPure -> Bool
== :: PSOPure -> PSOPure -> Bool
$c/= :: PSOPure -> PSOPure -> Bool
/= :: PSOPure -> PSOPure -> Bool
Eq, Eq PSOPure
Eq PSOPure =>
(PSOPure -> PSOPure -> Ordering)
-> (PSOPure -> PSOPure -> Bool)
-> (PSOPure -> PSOPure -> Bool)
-> (PSOPure -> PSOPure -> Bool)
-> (PSOPure -> PSOPure -> Bool)
-> (PSOPure -> PSOPure -> PSOPure)
-> (PSOPure -> PSOPure -> PSOPure)
-> Ord PSOPure
PSOPure -> PSOPure -> Bool
PSOPure -> PSOPure -> Ordering
PSOPure -> PSOPure -> PSOPure
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOPure -> PSOPure -> Ordering
compare :: PSOPure -> PSOPure -> Ordering
$c< :: PSOPure -> PSOPure -> Bool
< :: PSOPure -> PSOPure -> Bool
$c<= :: PSOPure -> PSOPure -> Bool
<= :: PSOPure -> PSOPure -> Bool
$c> :: PSOPure -> PSOPure -> Bool
> :: PSOPure -> PSOPure -> Bool
$c>= :: PSOPure -> PSOPure -> Bool
>= :: PSOPure -> PSOPure -> Bool
$cmax :: PSOPure -> PSOPure -> PSOPure
max :: PSOPure -> PSOPure -> PSOPure
$cmin :: PSOPure -> PSOPure -> PSOPure
min :: PSOPure -> PSOPure -> PSOPure
Ord, Length -> PSOPure -> ShowS
[PSOPure] -> ShowS
PSOPure -> String
(Length -> PSOPure -> ShowS)
-> (PSOPure -> String) -> ([PSOPure] -> ShowS) -> Show PSOPure
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOPure -> ShowS
showsPrec :: Length -> PSOPure -> ShowS
$cshow :: PSOPure -> String
show :: PSOPure -> String
$cshowList :: [PSOPure] -> ShowS
showList :: [PSOPure] -> ShowS
Show)

instance MetaInputVariable PSOPure where
    getVar :: Meta PSOPure
getVar = PSOPure -> Meta PSOPure
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (Bool -> PSOPure
PSOPure Bool
False)

-- | Run combine after on the partitions represented by the edge list.
newtype PSOCombine = PSOCombine Bool
    deriving newtype (PSOCombine -> PSOCombine -> Bool
(PSOCombine -> PSOCombine -> Bool)
-> (PSOCombine -> PSOCombine -> Bool) -> Eq PSOCombine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOCombine -> PSOCombine -> Bool
== :: PSOCombine -> PSOCombine -> Bool
$c/= :: PSOCombine -> PSOCombine -> Bool
/= :: PSOCombine -> PSOCombine -> Bool
Eq, Eq PSOCombine
Eq PSOCombine =>
(PSOCombine -> PSOCombine -> Ordering)
-> (PSOCombine -> PSOCombine -> Bool)
-> (PSOCombine -> PSOCombine -> Bool)
-> (PSOCombine -> PSOCombine -> Bool)
-> (PSOCombine -> PSOCombine -> Bool)
-> (PSOCombine -> PSOCombine -> PSOCombine)
-> (PSOCombine -> PSOCombine -> PSOCombine)
-> Ord PSOCombine
PSOCombine -> PSOCombine -> Bool
PSOCombine -> PSOCombine -> Ordering
PSOCombine -> PSOCombine -> PSOCombine
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOCombine -> PSOCombine -> Ordering
compare :: PSOCombine -> PSOCombine -> Ordering
$c< :: PSOCombine -> PSOCombine -> Bool
< :: PSOCombine -> PSOCombine -> Bool
$c<= :: PSOCombine -> PSOCombine -> Bool
<= :: PSOCombine -> PSOCombine -> Bool
$c> :: PSOCombine -> PSOCombine -> Bool
> :: PSOCombine -> PSOCombine -> Bool
$c>= :: PSOCombine -> PSOCombine -> Bool
>= :: PSOCombine -> PSOCombine -> Bool
$cmax :: PSOCombine -> PSOCombine -> PSOCombine
max :: PSOCombine -> PSOCombine -> PSOCombine
$cmin :: PSOCombine -> PSOCombine -> PSOCombine
min :: PSOCombine -> PSOCombine -> PSOCombine
Ord, Length -> PSOCombine -> ShowS
[PSOCombine] -> ShowS
PSOCombine -> String
(Length -> PSOCombine -> ShowS)
-> (PSOCombine -> String)
-> ([PSOCombine] -> ShowS)
-> Show PSOCombine
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOCombine -> ShowS
showsPrec :: Length -> PSOCombine -> ShowS
$cshow :: PSOCombine -> String
show :: PSOCombine -> String
$cshowList :: [PSOCombine] -> ShowS
showList :: [PSOCombine] -> ShowS
Show)

instance MetaInputVariable PSOCombine where
    getVar :: Meta PSOCombine
getVar = do
        PSOPure Bool
usePure <- Meta PSOPure
forall v. MetaInputVariable v => Meta v
getVar
        if Bool
usePure
            then PSOCombine -> Meta PSOCombine
forall a. a -> Meta a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> PSOCombine
PSOCombine Bool
False)
            else PSOCombine -> Meta PSOCombine
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (Bool -> PSOCombine
PSOCombine Bool
False)

-- | Weights used for the default particle updater in PSO.
data PSOUpdaterWeigths = PSOUpdaterWeigths {PSOUpdaterWeigths -> Weight
kE :: Weight, PSOUpdaterWeigths -> Weight
kL :: Weight, PSOUpdaterWeigths -> Weight
kG :: Weight}
    deriving stock (PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
(PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool)
-> Eq PSOUpdaterWeigths
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
== :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
$c/= :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
/= :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
Eq, Eq PSOUpdaterWeigths
Eq PSOUpdaterWeigths =>
(PSOUpdaterWeigths -> PSOUpdaterWeigths -> Ordering)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths)
-> (PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths)
-> Ord PSOUpdaterWeigths
PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
PSOUpdaterWeigths -> PSOUpdaterWeigths -> Ordering
PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Ordering
compare :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Ordering
$c< :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
< :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
$c<= :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
<= :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
$c> :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
> :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
$c>= :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
>= :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> Bool
$cmax :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths
max :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths
$cmin :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths
min :: PSOUpdaterWeigths -> PSOUpdaterWeigths -> PSOUpdaterWeigths
Ord, Length -> PSOUpdaterWeigths -> ShowS
[PSOUpdaterWeigths] -> ShowS
PSOUpdaterWeigths -> String
(Length -> PSOUpdaterWeigths -> ShowS)
-> (PSOUpdaterWeigths -> String)
-> ([PSOUpdaterWeigths] -> ShowS)
-> Show PSOUpdaterWeigths
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOUpdaterWeigths -> ShowS
showsPrec :: Length -> PSOUpdaterWeigths -> ShowS
$cshow :: PSOUpdaterWeigths -> String
show :: PSOUpdaterWeigths -> String
$cshowList :: [PSOUpdaterWeigths] -> ShowS
showList :: [PSOUpdaterWeigths] -> ShowS
Show)

instance MetaInputVariable PSOUpdaterWeigths where
    getVar :: Meta PSOUpdaterWeigths
getVar = PSOUpdaterWeigths -> Meta PSOUpdaterWeigths
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (PSOUpdaterWeigths -> Meta PSOUpdaterWeigths)
-> PSOUpdaterWeigths -> Meta PSOUpdaterWeigths
forall a b. (a -> b) -> a -> b
$ PSOUpdaterWeigths {kE :: Weight
kE = Weight
2.0, kL :: Weight
kL = Weight
0.1, kG :: Weight
kG = Weight
0.1}

-- | Distribution weights used to generate the initial particles for PSO.
data PSOInitialDistribution = PSOInitialDistribution Double Double Double Double
    deriving stock (PSOInitialDistribution -> PSOInitialDistribution -> Bool
(PSOInitialDistribution -> PSOInitialDistribution -> Bool)
-> (PSOInitialDistribution -> PSOInitialDistribution -> Bool)
-> Eq PSOInitialDistribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
== :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
$c/= :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
/= :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
Eq, Eq PSOInitialDistribution
Eq PSOInitialDistribution =>
(PSOInitialDistribution -> PSOInitialDistribution -> Ordering)
-> (PSOInitialDistribution -> PSOInitialDistribution -> Bool)
-> (PSOInitialDistribution -> PSOInitialDistribution -> Bool)
-> (PSOInitialDistribution -> PSOInitialDistribution -> Bool)
-> (PSOInitialDistribution -> PSOInitialDistribution -> Bool)
-> (PSOInitialDistribution
    -> PSOInitialDistribution -> PSOInitialDistribution)
-> (PSOInitialDistribution
    -> PSOInitialDistribution -> PSOInitialDistribution)
-> Ord PSOInitialDistribution
PSOInitialDistribution -> PSOInitialDistribution -> Bool
PSOInitialDistribution -> PSOInitialDistribution -> Ordering
PSOInitialDistribution
-> PSOInitialDistribution -> PSOInitialDistribution
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PSOInitialDistribution -> PSOInitialDistribution -> Ordering
compare :: PSOInitialDistribution -> PSOInitialDistribution -> Ordering
$c< :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
< :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
$c<= :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
<= :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
$c> :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
> :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
$c>= :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
>= :: PSOInitialDistribution -> PSOInitialDistribution -> Bool
$cmax :: PSOInitialDistribution
-> PSOInitialDistribution -> PSOInitialDistribution
max :: PSOInitialDistribution
-> PSOInitialDistribution -> PSOInitialDistribution
$cmin :: PSOInitialDistribution
-> PSOInitialDistribution -> PSOInitialDistribution
min :: PSOInitialDistribution
-> PSOInitialDistribution -> PSOInitialDistribution
Ord, Length -> PSOInitialDistribution -> ShowS
[PSOInitialDistribution] -> ShowS
PSOInitialDistribution -> String
(Length -> PSOInitialDistribution -> ShowS)
-> (PSOInitialDistribution -> String)
-> ([PSOInitialDistribution] -> ShowS)
-> Show PSOInitialDistribution
forall a.
(Length -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Length -> PSOInitialDistribution -> ShowS
showsPrec :: Length -> PSOInitialDistribution -> ShowS
$cshow :: PSOInitialDistribution -> String
show :: PSOInitialDistribution -> String
$cshowList :: [PSOInitialDistribution] -> ShowS
showList :: [PSOInitialDistribution] -> ShowS
Show)

instance MetaInputVariable PSOInitialDistribution where
    getVar :: Meta PSOInitialDistribution
getVar = do
        PSOPure Bool
usePure <- Meta PSOPure
forall v. MetaInputVariable v => Meta v
getVar
        if Bool
usePure
            then PSOInitialDistribution -> Meta PSOInitialDistribution
forall a. a -> Meta a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double -> Double -> Double -> PSOInitialDistribution
PSOInitialDistribution Double
0 Double
0 Double
0 Double
0)
            else PSOInitialDistribution -> Meta PSOInitialDistribution
forall v. MetaInputVariable v => v -> Meta v
getOrDefine (Double -> Double -> Double -> Double -> PSOInitialDistribution
PSOInitialDistribution Double
1 Double
3 Double
3 Double
3)

-- -------------------- --
-- Edge List Operations --
-- -------------------- --

-- | Default updater consider local best, global best and random components.
defaultUpdater :: PSOUpdaterWeigths -> Updater Edge
defaultUpdater :: PSOUpdaterWeigths -> Updater Edge
defaultUpdater PSOUpdaterWeigths {Weight
kE :: PSOUpdaterWeigths -> Weight
kL :: PSOUpdaterWeigths -> Weight
kG :: PSOUpdaterWeigths -> Weight
kE :: Weight
kL :: Weight
kG :: Weight
..} =
    NonEmpty (Random (Vector Weight)) -> Random (Vector Weight)
forall a (m :: * -> *).
(Unbox a, Num a, Monad m) =>
NonEmpty (m (Vector a)) -> m (Vector a)
sumM
        [ Random (Vector Weight)
forall a. UpdaterContext a => Random (Vector Weight)
randomVelocity Random (Vector Weight)
-> (Vector Weight -> Random (Vector Weight))
-> Random (Vector Weight)
forall a b. Random a -> (a -> Random b) -> Random b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Weight -> Vector Weight -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
a -> Vector a -> Random (Vector a)
weighted Weight
kE,
          Weight -> Vector Weight -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
a -> Vector a -> Random (Vector a)
weighted Weight
kL Vector Weight
forall a. UpdaterContext a => Vector Weight
localGuideDirection,
          Weight -> Vector Weight -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
a -> Vector a -> Random (Vector a)
weighted Weight
kG Vector Weight
forall a. UpdaterContext a => Vector Weight
globalGuideDirection
        ]

-- | Produce random weights for an edge set such that a given
-- partition would be the result of creating a solution using those weights.
--
-- >>> let ps = (["a", "ba", "b"], ["a", "b", "ba"])
-- >>> let es = [((0,0),2),((1,2),2),((2,0),2)]
-- >>> compatibleEdges ps es
-- [False,True,False]
--
-- >>> generateWith (1,2) $ partitionWeights ps es
-- [0.6502342,-0.8818351,7.536712e-2]
partitionWeights :: Pair (Partition a) -> Vector Edge -> Random (Vector Weight)
partitionWeights :: forall a.
Pair (Partition a) -> Vector Edge -> Random (Vector Weight)
partitionWeights Pair (Partition a)
p Vector Edge
es = Weight -> Vector Weight -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
a -> Vector a -> Random (Vector a)
weightedN Weight
1 (Vector Weight -> Random (Vector Weight))
-> Vector Weight -> Random (Vector Weight)
forall a b. (a -> b) -> a -> b
$ Weight -> Weight -> Vector Bool -> Vector Weight
forall a. Unbox a => a -> a -> Vector Bool -> Vector a
choose Weight
1 (-Weight
1) (Pair (Partition a) -> Vector Edge -> Vector Bool
forall a. Pair (Partition a) -> Vector Edge -> Vector Bool
compatibleEdges Pair (Partition a)
p Vector Edge
es)

-- | Produce random weights for an edge set sorted in such a way
-- that longer edges are prioritized.
-- >>> generateWith (1,2) $ edgeSizeWeights [((0,0),4),((1,2),1),((2,0),10)]
-- [0.30046844,0.7636702,-0.84926575]
edgeSizeWeights :: Vector Edge -> Random (Vector Weight)
edgeSizeWeights :: Vector Edge -> Random (Vector Weight)
edgeSizeWeights Vector Edge
es = do
    Vector Weight
weights <- Vector Weight -> Vector Weight
forall a. (Unbox a, Ord a) => Vector a -> Vector a
sort (Vector Weight -> Vector Weight)
-> Random (Vector Weight) -> Random (Vector Weight)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Length -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
Length -> Random (Vector a)
uniformSN (Vector Edge -> Length
forall a. Unbox a => Vector a -> Length
length Vector Edge
es)
    let indices :: Vector Length
indices = Vector Length -> Vector Length
forall a. (Unbox a, Ord a) => Vector a -> Vector Length
argSort (Vector Length -> Vector Length) -> Vector Length -> Vector Length
forall a b. (a -> b) -> a -> b
$ (Edge -> Length) -> Vector Edge -> Vector Length
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
map (Length -> Length
forall a. Num a => a -> a
negate (Length -> Length) -> (Edge -> Length) -> Edge -> Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge -> Length
blockLen) Vector Edge
es
    pure $ Vector Weight -> Vector Length -> Vector Weight
forall a b.
(Unbox a, Unbox b, Ord b) =>
Vector a -> Vector b -> Vector a
sortLike Vector Weight
weights Vector Length
indices

-- | Generates the initial weights for a particle.
initialWeights ::
    Ord a =>
    PSOPure
    -> PSOInitialDistribution
    -> Pair (String a)
    -> Vector Edge
    -> Random (Vector Weight)
initialWeights :: forall a.
Ord a =>
PSOPure
-> PSOInitialDistribution
-> Pair (String a)
-> Vector Edge
-> Random (Vector Weight)
initialWeights (PSOPure Bool
True) PSOInitialDistribution
_ Pair (String a)
_ Vector Edge
edges = Length -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
Length -> Random (Vector a)
uniformSN (Length -> Random (Vector Weight))
-> Length -> Random (Vector Weight)
forall a b. (a -> b) -> a -> b
$ Vector Edge -> Length
forall a. Unbox a => Vector a -> Length
length Vector Edge
edges
initialWeights (PSOPure Bool
False) (PSOInitialDistribution Double
d1 Double
d2 Double
d3 Double
d4) Pair (String a)
strs Vector Edge
edges =
    NonEmpty (Double, Random (Vector Weight)) -> Random (Vector Weight)
forall a. NonEmpty (Double, Random a) -> Random a
choice
        [ (Double
d1, Length -> Random (Vector Weight)
forall a.
(Unbox a, Variate a, Num a) =>
Length -> Random (Vector a)
uniformSN (Length -> Random (Vector Weight))
-> Length -> Random (Vector Weight)
forall a b. (a -> b) -> a -> b
$ Vector Edge -> Length
forall a. Unbox a => Vector a -> Length
length Vector Edge
edges),
          (Double
d2, Vector Edge -> Random (Vector Weight)
edgeSizeWeights Vector Edge
edges),
          (Double
d3, Pair (Partition a) -> Vector Edge -> Random (Vector Weight)
forall a.
Pair (Partition a) -> Vector Edge -> Random (Vector Weight)
partitionWeights (Meta (Pair (Partition a)) -> Pair (Partition a)
forall a. Meta a -> a
evalMeta (Meta (Pair (Partition a)) -> Pair (Partition a))
-> Meta (Pair (Partition a)) -> Pair (Partition a)
forall a b. (a -> b) -> a -> b
$ Pair (String a) -> Meta (Pair (Partition a))
forall {a}. Ord a => Pair (String a) -> Meta (Pair (Partition a))
combineS Pair (String a)
strs) Vector Edge
edges),
          (Double
d4, Pair (Partition a) -> Vector Edge -> Random (Vector Weight)
forall a.
Pair (Partition a) -> Vector Edge -> Random (Vector Weight)
partitionWeights (Meta (Pair (Partition a)) -> Pair (Partition a)
forall a. Meta a -> a
evalMeta (Meta (Pair (Partition a)) -> Pair (Partition a))
-> Meta (Pair (Partition a)) -> Pair (Partition a)
forall a b. (a -> b) -> a -> b
$ Pair (String a) -> Meta (Pair (Partition a))
forall {a}. Ord a => Pair (String a) -> Meta (Pair (Partition a))
greedy Pair (String a)
strs) Vector Edge
edges)
        ]
  where
    combineS :: Pair (String a) -> Meta (Pair (Partition a))
combineS Pair (String a)
s = Pair (String a) -> Meta (Pair (Partition a))
forall {a}. Ord a => Pair (String a) -> Meta (Pair (Partition a))
combine Pair (String a)
s Meta (Pair (Partition a))
-> UseSingletons -> Meta (Pair (Partition a))
forall v a. MetaInputVariable v => Meta a -> v -> Meta a
<:: Bool -> UseSingletons
UseSingletons Bool
True

-- | Resolve the partitions of an edge list and run combine on that.
combineEdges :: Ord a => Pair (String a) -> Vector Edge -> Pair (Partition a)
combineEdges :: forall a.
Ord a =>
Pair (String a) -> Vector Edge -> Pair (Partition a)
combineEdges strs :: Pair (String a)
strs@(String a
Unboxed, String a
_) Vector Edge
edges =
    Meta (Pair (Partition a)) -> Pair (Partition a)
forall a. Meta a -> a
evalMeta (Meta (Pair (Partition a)) -> Pair (Partition a))
-> Meta (Pair (Partition a)) -> Pair (Partition a)
forall a b. (a -> b) -> a -> b
$ Pair (Partition a) -> Meta (Pair (Partition a))
forall a.
(Unbox a, Ord a) =>
Pair (Partition a) -> Meta (Pair (Partition a))
combineP Pair (Partition a)
partitions Meta (Pair (Partition a))
-> UseSingletons -> Meta (Pair (Partition a))
forall v a. MetaInputVariable v => Meta a -> v -> Meta a
<:: Bool -> UseSingletons
UseSingletons Bool
True
  where
    partitions :: Pair (Partition a)
partitions = Pair (String a) -> Solution -> Pair (Partition a)
forall a. Pair (String a) -> Solution -> Pair (Partition a)
toPartitions Pair (String a)
strs (Solution -> Pair (Partition a)) -> Solution -> Pair (Partition a)
forall a b. (a -> b) -> a -> b
$ Vector Edge -> Solution
solution Vector Edge
edges

-- | Calculate the mergeness of a given partition.
mergenessOf :: Pair (Partition a) -> Int
mergenessOf :: forall a. Pair (Partition a) -> Length
mergenessOf (Partition a
x, Partition a
y) = Partition a -> Length
forall {t :: * -> *} {a}. Foldable t => [t a] -> Length
mness Partition a
x Length -> Length -> Length
forall a. Ord a => a -> a -> a
`min` Partition a -> Length
forall {t :: * -> *} {a}. Foldable t => [t a] -> Length
mness Partition a
y
  where
    mness :: [t a] -> Length
mness [t a]
p = (t a -> Length) -> [t a] -> Length
forall b a. Num b => (a -> b) -> [a] -> b
sumOn' t a -> Length
forall a. t a -> Length
forall (t :: * -> *) a. Foldable t => t a -> Length
Foldable.length [t a]
p Length -> Length -> Length
forall a. Num a => a -> a -> a
- [t a] -> Length
forall a. [a] -> Length
forall (t :: * -> *) a. Foldable t => t a -> Length
Foldable.length [t a]
p

-- | The grading function for PSO.
objective :: Ord a => PSOCombine -> Pair (String a) -> Vector Edge -> Int
objective :: forall a.
Ord a =>
PSOCombine -> Pair (String a) -> Vector Edge -> Length
objective (PSOCombine Bool
True) Pair (String a)
strs = Pair (Partition a) -> Length
forall a. Pair (Partition a) -> Length
mergenessOf (Pair (Partition a) -> Length)
-> (Vector Edge -> Pair (Partition a)) -> Vector Edge -> Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair (String a) -> Vector Edge -> Pair (Partition a)
forall a.
Ord a =>
Pair (String a) -> Vector Edge -> Pair (Partition a)
combineEdges Pair (String a)
strs
objective (PSOCombine Bool
False) Pair (String a)
_ = Solution -> Length
mergeness (Solution -> Length)
-> (Vector Edge -> Solution) -> Vector Edge -> Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Edge -> Solution
solution

-- --------- --
-- Heuristic --
-- --------- --

-- | Create an iterated PSO swarm for the MCSP problem.
mcspSwarm :: Ord a => Pair (String a) -> Meta (Random (NonEmpty (Swarm Edge)))
mcspSwarm :: forall a.
Ord a =>
Pair (String a) -> Meta (Random (NonEmpty (Swarm Edge)))
mcspSwarm strs :: Pair (String a)
strs@(Pair (String a) -> Vector Edge
forall a. Eq a => Pair (String a) -> Vector Edge
edgeSet -> Vector Edge
edges) = do
    PSOIterations Length
iterations <- Meta PSOIterations
forall v. MetaInputVariable v => Meta v
getVar
    PSOParticles Length
particles <- Meta PSOParticles
forall v. MetaInputVariable v => Meta v
getVar
    PSOPure
usePure <- Meta PSOPure
forall v. MetaInputVariable v => Meta v
getVar
    PSOCombine
runCombine <- Meta PSOCombine
forall v. MetaInputVariable v => Meta v
getVar
    PSOUpdaterWeigths
updaterWeights <- Meta PSOUpdaterWeigths
forall v. MetaInputVariable v => Meta v
getVar
    PSOInitialDistribution
initialDistribution <- Meta PSOInitialDistribution
forall v. MetaInputVariable v => Meta v
getVar

    let ?eval = PSOCombine -> Pair (String a) -> Vector Edge -> Length
forall a.
Ord a =>
PSOCombine -> Pair (String a) -> Vector Edge -> Length
objective PSOCombine
runCombine Pair (String a)
strs
    let ?values = ?values::Vector Edge
Vector Edge
edges
    let initial :: Random (Vector Weight)
initial = PSOPure
-> PSOInitialDistribution
-> Pair (String a)
-> Vector Edge
-> Random (Vector Weight)
forall a.
Ord a =>
PSOPure
-> PSOInitialDistribution
-> Pair (String a)
-> Vector Edge
-> Random (Vector Weight)
initialWeights PSOPure
usePure PSOInitialDistribution
initialDistribution Pair (String a)
strs Vector Edge
edges
    Random (NonEmpty (Swarm Edge))
-> Meta (Random (NonEmpty (Swarm Edge)))
forall a. a -> Meta a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Random (NonEmpty (Swarm Edge))
 -> Meta (Random (NonEmpty (Swarm Edge))))
-> Random (NonEmpty (Swarm Edge))
-> Meta (Random (NonEmpty (Swarm Edge)))
forall a b. (a -> b) -> a -> b
$
        Length -> NonEmpty (Swarm Edge) -> NonEmpty (Swarm Edge)
forall {a}. Length -> NonEmpty a -> NonEmpty a
take Length
iterations
            (NonEmpty (Swarm Edge) -> NonEmpty (Swarm Edge))
-> Random (NonEmpty (Swarm Edge)) -> Random (NonEmpty (Swarm Edge))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Updater Edge
-> Random (Vector Weight)
-> Length
-> Random (NonEmpty (Swarm Edge))
forall a.
PSOContext a =>
Updater a
-> Random (Vector Weight) -> Length -> Random (NonEmpty (Swarm a))
particleSwarmOptimization (PSOUpdaterWeigths -> Updater Edge
defaultUpdater PSOUpdaterWeigths
updaterWeights) Random (Vector Weight)
initial Length
particles
  where
    take :: Length -> NonEmpty a -> NonEmpty a
take Length
n (a
x :| [a]
xs) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Length -> [a] -> [a]
forall a. Length -> [a] -> [a]
List.take (Length
n Length -> Length -> Length
forall a. Num a => a -> a -> a
- Length
1) [a]
xs

-- | Extract information about the PSO execution.
evalPso :: Ord a => Pair (String a) -> NonEmpty (Swarm Edge) -> Meta (Pair (Partition a), Int)
evalPso :: forall a.
Ord a =>
Pair (String a)
-> NonEmpty (Swarm Edge) -> Meta (Pair (Partition a), Length)
evalPso Pair (String a)
strs NonEmpty (Swarm Edge)
swarms = do
    PSOCombine Bool
runCombine <- Meta PSOCombine
forall v. MetaInputVariable v => Meta v
getVar
    let partitions :: Pair (Partition a)
partitions =
            if Bool
runCombine
                then Pair (String a) -> Vector Edge -> Pair (Partition a)
forall a.
Ord a =>
Pair (String a) -> Vector Edge -> Pair (Partition a)
combineEdges Pair (String a)
strs (Vector Edge -> Pair (Partition a))
-> Vector Edge -> Pair (Partition a)
forall a b. (a -> b) -> a -> b
$ PSOGuide Edge -> Vector Edge
forall a. PSOGuide a -> Vector a
sortedValues PSOGuide Edge
guide
                else Pair (String a) -> Solution -> Pair (Partition a)
forall a. Pair (String a) -> Solution -> Pair (Partition a)
toPartitions Pair (String a)
strs (Solution -> Pair (Partition a)) -> Solution -> Pair (Partition a)
forall a b. (a -> b) -> a -> b
$ Vector Edge -> Solution
solution (Vector Edge -> Solution) -> Vector Edge -> Solution
forall a b. (a -> b) -> a -> b
$ PSOGuide Edge -> Vector Edge
forall a. PSOGuide a -> Vector a
sortedValues PSOGuide Edge
guide
    (Pair (Partition a), Length) -> Meta (Pair (Partition a), Length)
forall a. a -> Meta a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair (Partition a)
partitions, Length
firstBestIter)
  where
    optimal :: Swarm a -> (Min (Length, Length), Last (PSOGuide a))
optimal Swarm a
swarm =
        -- get the global guide with maximum grade and minimum iteration
        ( (Length, Length) -> Min (Length, Length)
forall a. a -> Min a
Min (-PSOGuide a -> Length
forall a. PSOGuide a -> Length
guideGrade (Swarm a -> PSOGuide a
forall a. Swarm a -> PSOGuide a
gGuide Swarm a
swarm), Swarm a -> Length
forall a. Swarm a -> Length
iteration Swarm a
swarm),
          -- and get the last guide
          PSOGuide a -> Last (PSOGuide a)
forall a. a -> Last a
Last (Swarm a -> PSOGuide a
forall a. Swarm a -> PSOGuide a
gGuide Swarm a
swarm)
        )
    (Min (Length
_, Length
firstBestIter), Last PSOGuide Edge
guide) = (Swarm Edge -> (Min (Length, Length), Last (PSOGuide Edge)))
-> NonEmpty (Swarm Edge)
-> (Min (Length, Length), Last (PSOGuide Edge))
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1' Swarm Edge -> (Min (Length, Length), Last (PSOGuide Edge))
forall {a}. Swarm a -> (Min (Length, Length), Last (PSOGuide a))
optimal NonEmpty (Swarm Edge)
swarms

-- | PSO heuristic.
pso :: Ord a => Pair (String a) -> Meta (Pair (Partition a))
pso :: forall {a}. Ord a => Pair (String a) -> Meta (Pair (Partition a))
pso Pair (String a)
strs = do
    PSOSeed Seed
seed <- Meta PSOSeed
forall v. MetaInputVariable v => Meta v
getVar

    NonEmpty (Swarm Edge)
swarms <- Seed -> Random (NonEmpty (Swarm Edge)) -> NonEmpty (Swarm Edge)
forall a. Seed -> Random a -> a
generateWith Seed
seed (Random (NonEmpty (Swarm Edge)) -> NonEmpty (Swarm Edge))
-> Meta (Random (NonEmpty (Swarm Edge)))
-> Meta (NonEmpty (Swarm Edge))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pair (String a) -> Meta (Random (NonEmpty (Swarm Edge)))
forall a.
Ord a =>
Pair (String a) -> Meta (Random (NonEmpty (Swarm Edge)))
mcspSwarm Pair (String a)
strs
    (Pair (Partition a)
partitions, Length
firstBestIter) <- Pair (String a)
-> NonEmpty (Swarm Edge) -> Meta (Pair (Partition a), Length)
forall a.
Ord a =>
Pair (String a)
-> NonEmpty (Swarm Edge) -> Meta (Pair (Partition a), Length)
evalPso Pair (String a)
strs NonEmpty (Swarm Edge)
swarms

    PSOFirstBestIter -> Meta ()
forall v. MetaOutputVariable v => v -> Meta ()
setVar (Length -> PSOFirstBestIter
PSOFirstBestIter Length
firstBestIter)
    pure Pair (Partition a)
partitions