{-|
Module      : IT.Algorithms
Description : Basic algorithms data structures
Copyright   : (c) Fabricio Olivetti de Franca, 2020
License     : GPL-3
Maintainer  : fabricio.olivetti@gmail.com
Stability   : experimental
Portability : POSIX

Definitions  for a Solution, Population of solutions, 
fitness function and mutation function.
-}
module IT.Algorithms where

import IT
import IT.Random
import IT.Metrics

import Control.DeepSeq
import qualified Numeric.LinearAlgebra as LA

-- | data type containing a solution, its fitness and weight vector 
--  'a' refers to the type of 'Expr', 'b' refers to a container of statistics.
data Solution = Sol { Solution -> Expr
_expr    :: Expr     -- ^ The IT expression of type a
                    , Solution -> [Double]
_fit     :: [Double] -- ^ Fitness and other measures for evaluating the expression
                    , Solution -> Double
_constr  :: Double   -- ^ Amount of Shape Constraint violation associated with the expression, always positive
                    , Solution -> Int
_len     :: Int      -- ^ Expression size as per https://github.com/EpistasisLab/regression-benchmark/blob/dev/CONTRIBUTING.md
                    , Solution -> Double
_penalty :: Double   -- ^ penalty of fitness
                    , Solution -> [Vector]
_weights :: [Vector] -- ^ Weights associated with the expression (they count towards the length)
                    }

instance Show Solution where
  show :: Solution -> String
show (Sol Expr
e [Double]
f Double
c Int
l Double
_ [Vector]
w) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Expression: "  , String
expr,    String
"\n"
                                , String
"Fitness: "    , String
fit,     String
"\n"
                                , String
"Weights: "    , String
weights, String
"\n"
                                , String
"Constraints: ", String
constr,  String
"\n"
                                , String
"Length: "     , String
len,     String
"\n"]
    where
      expr :: String
expr    = Expr -> [Double] -> String
toExprStr Expr
e (Vector -> [Double]
forall a. Storable a => Vector a -> [a]
LA.toList (Vector -> [Double]) -> Vector -> [Double]
forall a b. (a -> b) -> a -> b
$ [Vector] -> Vector
forall a. [a] -> a
head [Vector]
w)
      fit :: String
fit     = (Double -> String
forall a. Show a => a -> String
show (Double -> String) -> ([Double] -> Double) -> [Double] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Double
forall a. [a] -> a
head) [Double]
f
      weights :: String
weights = [Vector] -> String
forall a. Show a => a -> String
show [Vector]
w
      constr :: String
constr  = Double -> String
forall a. Show a => a -> String
show Double
c
      len :: String
len     = Int -> String
forall a. Show a => a -> String
show Int
l
  
-- | These instances are only to find the best and worst individuals
-- of a population.
instance Eq Solution where
  -- | 'Eq' instance to sort a sequence
  -- of solutions by fitness
  Solution
s1 == :: Solution -> Solution -> Bool
== Solution
s2 = ([Double] -> Double
forall a. [a] -> a
head([Double] -> Double)
-> (Solution -> [Double]) -> Solution -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Solution -> [Double]
_fit) Solution
s1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Solution -> Double
_penalty Solution
s1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== ([Double] -> Double
forall a. [a] -> a
head([Double] -> Double)
-> (Solution -> [Double]) -> Solution -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Solution -> [Double]
_fit) Solution
s2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Solution -> Double
_penalty Solution
s2

instance Ord Solution where
  -- | 'Ord' instance to sort a sequence
  -- of solutions by fitness
  Solution
s1 <= :: Solution -> Solution -> Bool
<= Solution
s2 = ([Double] -> Double
forall a. [a] -> a
head([Double] -> Double)
-> (Solution -> [Double]) -> Solution -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Solution -> [Double]
_fit) Solution
s1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Solution -> Double
_penalty Solution
s1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= ([Double] -> Double
forall a. [a] -> a
head([Double] -> Double)
-> (Solution -> [Double]) -> Solution -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Solution -> [Double]
_fit) Solution
s2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Solution -> Double
_penalty Solution
s2

-- | A population of 'Solution a b'
type Population = [Solution]

instance NFData Solution where
  rnf :: Solution -> ()
rnf Solution
_ = ()

-- | 'Fitness' function that takes a list of expressions and 
-- returns an evaluated population. 
-- This function is a good candidate for parallelization.
--type Fitness    a b = [Expr a] -> Population a b -- (Expr a, Double, b)
type Fitness = Expr -> Maybe Solution

-- | 'Constraint' is a function that receives an expression and its coefficients
-- and return the penalty associated with the constraint violation.
type Constraint = Expr -> [Double] -> Double

-- | 'Mutation' function with signature 'Solution a b -> Rnd (Solution a b)'
type Mutation = Expr -> Rnd Expr