Module optTestFunctions

  USE global_constants ! brings in a lot of constants and kind params
  USE objectiveFunctions

  Implicit NONE

  Enum, BIND(c)

     ENUMERATOR :: ROSENBROCK_TEST=1, DEJONG_TEST, RASTRIGIN_TEST,      & 
                   ACKLEY_TEST, GREIWANK_TEST, MICHAELWICZ_TEST

  End Enum

  Type, EXTENDS(objective_function_t) :: objtest_t

    Integer(C_ENUM) :: test

  Contains

     Procedure :: fun=>objTestFuns

  End Type
      
Contains

   Function rosenbrock(x) Result(objval)

     Implicit NONE

     Real(RK), Intent(IN) :: X(:)
     Real(RK)             :: objval
    
     Integer(IK) :: i, n
    
     n = SIZE(X,1) 
     objval = ZERO
     
     Do i=1,n-1
       objval = objval + (ONE-X(i))**2 + HUNDRED*(X(i+1)- X(i)*X(i))**2
     EndDo

   End Function rosenbrock

   Function deJong(x) Result(objval)

     Implicit NONE

     Real(RK), Intent(IN) :: X(:)
     Real(RK)             :: objval
    
     objval = DOT_PRODUCT(X,X)
   
   End Function deJong

   Function rastrigin(x) Result(objval)

     Implicit NONE

     Real(RK), Intent(IN) :: X(:)
     Real(RK)             :: objval
   
     Integer(IK) :: i, n

     n = SIZE(X,1)
     objval = TEN*REAL(n,RK)

     Do i= 1,n
       objval = objval + X(i)**2 - TEN*COS(TWOPI*X(i))
     EndDo 
   
   End Function rastrigin

   Function ackley(x) Result(objval)

     Implicit NONE

     Real(RK), Intent(IN) :: X(:)
     Real(RK)             :: objval
   
     Integer(IK) :: n
     Real(RK)    :: s1, s2

     n = SIZE(X,1) 
     s1 = SUM((X(:)**2))
     s1 = -0.2_RK*SQRT(s1/REAL(n,RK))
     s2 = SUM(COS(TWOPI*X(:)))/REAL(n,RK)

     objval = -TWENTY*EXP(s1) - EXP(s2) + TWENTY + EXP(ONE) 
 
   End Function ackley 

   Function greiwank(x) Result(objval)

     Implicit NONE

     Real(RK), Intent(IN) :: X(:)
     Real(RK)             :: objval
 
     Integer(IK) :: i,n 
     Real(RK) :: s1, s2 

     n = SIZE(X,1)
     s1 = SUM((X(:)**2))/4000.0_RK
     s2 = ONE
     Do i=1,n
       s2 = s2*(COS(X(i)/SQRT(REAL(i,RK))))
     EndDo
     objval = s1 - s2 + ONE
 
   End Function greiwank
 
   Function michaelwicz(x) Result(f)

     Implicit NONE

     Real(RK), Intent(IN) :: x(:)
     Real(RK)             :: f

     Integer :: j, m
     Real(RK) :: fact

     m = SIZE(x) 

     f = ZERO
     Do j=1,m
       fact = REAL(j,RK)
       f = f - SIN(x(j))*(SIN(fact*(x(j)*x(j))/PI))**20
     EndDo

     
   End Function michaelwicz

   Function objTestFuns(this, x) Result(f)

     Implicit NONE

     Class(objtest_t), Intent(INOUT) :: this
     Real(RK),         Intent(IN)    :: x(:)
     Real(RK)                        :: f

     Select CASE (this%test)

       CASE (ROSENBROCK_TEST)

         f = rosenbrock(x)

       CASE (DEJONG_TEST)

         f = deJong(x)

       CASE (RASTRIGIN_TEST)

         f = rastrigin(x)

       CASE(ACKLEY_TEST)

         f = ackley(x)

       CASE(GREIWANK_TEST)

         f = greiwank(x)

       CASE(MICHAELWICZ_TEST)

         f = michaelwicz(x)

     End Select

  End Function objTestFuns

End Module optTestFunctions